summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog269
-rw-r--r--INSTALL11
-rw-r--r--INSTALL.BZR10
-rw-r--r--Makefile.in47
-rw-r--r--admin/CPP-DEFINES26
-rw-r--r--admin/ChangeLog48
-rw-r--r--admin/bzrmerge.el3
-rw-r--r--admin/charsets/mule-charsets.el2
-rw-r--r--admin/notes/bugtracker15
-rw-r--r--admin/notes/bzr26
-rw-r--r--admin/notes/exit-value2
-rw-r--r--admin/unidata/Makefile.in5
-rw-r--r--admin/unidata/makefile.w32-in7
-rw-r--r--admin/unidata/unidata-gen.el437
-rw-r--r--autogen/Makefile.in481
-rw-r--r--autogen/aclocal.m410
-rw-r--r--autogen/config.in79
-rwxr-xr-xautogen/configure6846
-rw-r--r--config.bat2
-rw-r--r--configure.in282
-rw-r--r--doc/emacs/ChangeLog224
-rw-r--r--doc/emacs/Makefile.in2
-rw-r--r--doc/emacs/ack.texi20
-rw-r--r--doc/emacs/buffers.texi7
-rw-r--r--doc/emacs/building.texi6
-rw-r--r--doc/emacs/calendar.texi12
-rw-r--r--doc/emacs/cmdargs.texi48
-rw-r--r--doc/emacs/custom.texi323
-rw-r--r--doc/emacs/dired.texi18
-rw-r--r--doc/emacs/display.texi39
-rw-r--r--doc/emacs/emacs.texi76
-rw-r--r--doc/emacs/files.texi3
-rw-r--r--doc/emacs/fixit.texi11
-rw-r--r--doc/emacs/fortran-xtra.texi13
-rw-r--r--doc/emacs/frames.texi241
-rw-r--r--doc/emacs/glossary.texi5
-rw-r--r--doc/emacs/help.texi15
-rw-r--r--doc/emacs/indent.texi2
-rw-r--r--doc/emacs/killing.texi344
-rw-r--r--doc/emacs/kmacro.texi4
-rw-r--r--doc/emacs/macos.texi4
-rw-r--r--doc/emacs/major.texi237
-rw-r--r--doc/emacs/makefile.w32-in2
-rw-r--r--doc/emacs/mark.texi15
-rw-r--r--doc/emacs/mini.texi8
-rw-r--r--doc/emacs/misc.texi198
-rw-r--r--doc/emacs/modes.texi410
-rw-r--r--doc/emacs/msdog.texi76
-rw-r--r--doc/emacs/mule.texi85
-rw-r--r--doc/emacs/picture-xtra.texi3
-rw-r--r--doc/emacs/programs.texi9
-rw-r--r--doc/emacs/regs.texi26
-rw-r--r--doc/emacs/rmail.texi12
-rw-r--r--doc/emacs/screen.texi32
-rw-r--r--doc/emacs/search.texi13
-rw-r--r--doc/emacs/text.texi195
-rw-r--r--doc/emacs/trouble.texi11
-rw-r--r--doc/emacs/windows.texi8
-rw-r--r--doc/emacs/xresources.texi24
-rw-r--r--doc/lispref/ChangeLog255
-rw-r--r--doc/lispref/commands.texi35
-rw-r--r--doc/lispref/compile.texi2
-rw-r--r--doc/lispref/control.texi2
-rw-r--r--doc/lispref/customize.texi235
-rw-r--r--doc/lispref/display.texi89
-rw-r--r--doc/lispref/elisp.texi10
-rw-r--r--doc/lispref/files.texi9
-rw-r--r--doc/lispref/frames.texi80
-rw-r--r--doc/lispref/functions.texi13
-rw-r--r--doc/lispref/help.texi17
-rw-r--r--doc/lispref/keymaps.texi91
-rw-r--r--doc/lispref/lists.texi8
-rw-r--r--doc/lispref/minibuf.texi39
-rw-r--r--doc/lispref/modes.texi77
-rw-r--r--doc/lispref/nonascii.texi41
-rw-r--r--doc/lispref/numbers.texi117
-rw-r--r--doc/lispref/objects.texi16
-rw-r--r--doc/lispref/os.texi8
-rw-r--r--doc/lispref/processes.texi42
-rw-r--r--doc/lispref/searching.texi6
-rw-r--r--doc/lispref/streams.texi6
-rw-r--r--doc/lispref/strings.texi22
-rw-r--r--doc/lispref/syntax.texi4
-rw-r--r--doc/lispref/text.texi111
-rw-r--r--doc/lispref/tips.texi9
-rw-r--r--doc/lispref/variables.texi64
-rw-r--r--doc/lispref/vol1.texi4
-rw-r--r--doc/lispref/vol2.texi4
-rw-r--r--doc/lispref/windows.texi14
-rw-r--r--doc/man/ChangeLog8
-rw-r--r--doc/man/emacsclient.16
-rw-r--r--doc/misc/ChangeLog380
-rw-r--r--doc/misc/Makefile.in2
-rw-r--r--doc/misc/cc-mode.texi150
-rw-r--r--doc/misc/cl.texi42
-rw-r--r--doc/misc/dired-x.texi4
-rw-r--r--doc/misc/ede.texi2
-rw-r--r--doc/misc/ediff.texi12
-rw-r--r--doc/misc/eshell.texi2
-rw-r--r--doc/misc/gnus.texi76
-rw-r--r--doc/misc/org.texi20
-rw-r--r--doc/misc/rcirc.texi8
-rw-r--r--doc/misc/texinfo.tex115
-rw-r--r--doc/misc/tramp.texi13
-rw-r--r--doc/misc/widget.texi1
-rw-r--r--etc/ChangeLog115
-rw-r--r--etc/MH-E-NEWS32
-rw-r--r--etc/NEWS261
-rw-r--r--etc/PROBLEMS2
-rw-r--r--etc/TODO6
-rw-r--r--etc/compilation.txt11
-rw-r--r--etc/images/newsticker/README8
-rw-r--r--etc/images/newsticker/browse-url.xpm66
-rw-r--r--etc/images/newsticker/get-all.xpm97
-rw-r--r--etc/images/newsticker/mark-immortal.xpm120
-rw-r--r--etc/images/newsticker/mark-read.xpm71
-rw-r--r--etc/images/newsticker/narrow.xpm75
-rw-r--r--etc/images/newsticker/next-feed.xpm84
-rw-r--r--etc/images/newsticker/next-item.xpm69
-rw-r--r--etc/images/newsticker/prev-feed.xpm79
-rw-r--r--etc/images/newsticker/prev-item.xpm66
-rw-r--r--etc/images/newsticker/update.xpm64
-rw-r--r--etc/themes/dichromacy-theme.el126
-rw-r--r--etc/themes/light-blue-theme.el2
-rw-r--r--etc/themes/manoj-dark-theme.el700
-rw-r--r--etc/themes/misterioso-theme.el2
-rw-r--r--etc/themes/tango-dark-theme.el3
-rw-r--r--etc/themes/tango-theme.el3
-rw-r--r--etc/themes/tsdh-dark-theme.el6
-rw-r--r--etc/themes/tsdh-light-theme.el6
-rw-r--r--etc/themes/wheatgrass-theme.el3
-rw-r--r--etc/themes/wombat-theme.el2
-rw-r--r--etc/tutorials/TUTORIAL.zh2
-rw-r--r--leim/CXTERM-DIC/4Corner.tit1
-rw-r--r--leim/CXTERM-DIC/ARRAY30.tit1
-rw-r--r--leim/CXTERM-DIC/CCDOSPY.tit1
-rw-r--r--leim/CXTERM-DIC/ECDICT.tit1
-rw-r--r--leim/CXTERM-DIC/ETZY.tit1
-rw-r--r--leim/CXTERM-DIC/PY-b5.tit1
-rw-r--r--leim/CXTERM-DIC/Punct-b5.tit1
-rw-r--r--leim/CXTERM-DIC/Punct.tit1
-rw-r--r--leim/CXTERM-DIC/QJ-b5.tit1
-rw-r--r--leim/CXTERM-DIC/QJ.tit1
-rw-r--r--leim/CXTERM-DIC/SW.tit1
-rw-r--r--leim/CXTERM-DIC/TONEPY.tit1
-rw-r--r--leim/CXTERM-DIC/ZOZY.tit1
-rw-r--r--leim/ChangeLog28
-rw-r--r--leim/MISC-DIC/cangjie-table.b51
-rw-r--r--leim/MISC-DIC/cangjie-table.cns1
-rw-r--r--leim/MISC-DIC/pinyin.map1
-rw-r--r--leim/MISC-DIC/ziranma.cin1
-rw-r--r--leim/Makefile.in3
-rw-r--r--leim/SKK-DIC/SKK-JISYO.L2
-rw-r--r--leim/makefile.w32-in1
-rw-r--r--leim/quail/ipa-praat.el346
-rw-r--r--leim/quail/persian.el296
-rw-r--r--lib-src/ChangeLog69
-rw-r--r--lib-src/Makefile.in59
-rw-r--r--lib-src/emacsclient.c32
-rw-r--r--lib-src/etags.c16
-rw-r--r--lib-src/fakemail.c744
-rw-r--r--lib-src/make-docfile.c2
-rw-r--r--lib-src/makefile.w32-in19
-rw-r--r--lib-src/movemail.c35
-rw-r--r--lib-src/update-game-score.c5
-rw-r--r--lib/alloca.in.h56
-rw-r--r--lib/allocator.h9
-rw-r--r--lib/careadlinkat.c10
-rw-r--r--lib/careadlinkat.h5
-rw-r--r--lib/dup2.c132
-rw-r--r--lib/ftoastr.c14
-rw-r--r--lib/getopt.c93
-rw-r--r--lib/getopt.in.h10
-rw-r--r--lib/getopt_.h4
-rw-r--r--lib/gnulib.mk474
-rw-r--r--lib/intprops.h303
-rw-r--r--lib/makefile.w32-in33
-rw-r--r--lib/pthread_sigmask.c29
-rw-r--r--lib/sha1.c427
-rw-r--r--lib/sha1.h92
-rw-r--r--lib/sha256.c569
-rw-r--r--lib/sha256.h91
-rw-r--r--lib/sha512.c619
-rw-r--r--lib/sha512.h95
-rw-r--r--lib/signal.in.h428
-rw-r--r--lib/sigprocmask.c329
-rw-r--r--lib/stat.c8
-rw-r--r--lib/stdarg.in.h10
-rw-r--r--lib/stddef.in.h14
-rw-r--r--lib/stdint.in.h110
-rw-r--r--lib/stdio.in.h48
-rw-r--r--lib/stdlib.in.h10
-rw-r--r--lib/strtoll.c33
-rw-r--r--lib/sys_stat.in.h10
-rw-r--r--lib/time.in.h4
-rw-r--r--lib/u64.h158
-rw-r--r--lib/unistd.in.h169
-rw-r--r--lib/verify.h23
-rw-r--r--lisp/ChangeLog3285
-rw-r--r--lisp/ChangeLog.142
-rw-r--r--lisp/ChangeLog.152
-rw-r--r--lisp/ChangeLog.62
-rw-r--r--lisp/abbrev.el40
-rw-r--r--lisp/allout-widgets.el51
-rw-r--r--lisp/allout.el258
-rw-r--r--lisp/arc-mode.el91
-rw-r--r--lisp/autoinsert.el2
-rw-r--r--lisp/battery.el28
-rw-r--r--lisp/bindings.el25
-rw-r--r--lisp/bookmark.el10
-rw-r--r--lisp/bs.el15
-rw-r--r--lisp/buff-menu.el16
-rw-r--r--lisp/button.el5
-rw-r--r--lisp/calc/calc-alg.el19
-rw-r--r--lisp/calc/calc-ext.el38
-rw-r--r--lisp/calc/calc.el27
-rw-r--r--lisp/calculator.el14
-rw-r--r--lisp/calendar/appt.el342
-rw-r--r--lisp/calendar/cal-html.el13
-rw-r--r--lisp/calendar/calendar.el225
-rw-r--r--lisp/calendar/diary-lib.el145
-rw-r--r--lisp/calendar/timeclock.el6
-rw-r--r--lisp/cedet/ChangeLog23
-rw-r--r--lisp/cedet/ede.el2
-rw-r--r--lisp/cedet/ede/pmake.el2
-rw-r--r--lisp/cedet/semantic.el4
-rw-r--r--lisp/cedet/semantic/complete.el2
-rw-r--r--lisp/cedet/semantic/db.el2
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el2
-rw-r--r--lisp/comint.el35
-rw-r--r--lisp/cus-dep.el7
-rw-r--r--lisp/cus-edit.el74
-rw-r--r--lisp/cus-face.el51
-rw-r--r--lisp/cus-start.el15
-rw-r--r--lisp/cus-theme.el77
-rw-r--r--lisp/custom.el100
-rw-r--r--lisp/dabbrev.el3
-rw-r--r--lisp/dired-aux.el54
-rw-r--r--lisp/dired-x.el28
-rw-r--r--lisp/dired.el133
-rw-r--r--lisp/disp-table.el20
-rw-r--r--lisp/doc-view.el7
-rw-r--r--lisp/dos-w32.el8
-rw-r--r--lisp/dynamic-setting.el2
-rw-r--r--lisp/emacs-lisp/advice.el15
-rw-r--r--lisp/emacs-lisp/authors.el2
-rw-r--r--lisp/emacs-lisp/autoload.el59
-rw-r--r--lisp/emacs-lisp/avl-tree.el714
-rw-r--r--lisp/emacs-lisp/benchmark.el5
-rw-r--r--lisp/emacs-lisp/byte-run.el30
-rw-r--r--lisp/emacs-lisp/bytecomp.el72
-rw-r--r--lisp/emacs-lisp/cconv.el10
-rw-r--r--lisp/emacs-lisp/chart.el6
-rw-r--r--lisp/emacs-lisp/checkdoc.el5
-rw-r--r--lisp/emacs-lisp/cl-indent.el181
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el61
-rw-r--r--lisp/emacs-lisp/debug.el19
-rw-r--r--lisp/emacs-lisp/derived.el10
-rw-r--r--lisp/emacs-lisp/disass.el8
-rw-r--r--lisp/emacs-lisp/eieio.el19
-rw-r--r--lisp/emacs-lisp/elp.el6
-rw-r--r--lisp/emacs-lisp/find-func.el21
-rw-r--r--lisp/emacs-lisp/lisp-mode.el119
-rw-r--r--lisp/emacs-lisp/lisp.el19
-rw-r--r--lisp/emacs-lisp/macroexp.el10
-rw-r--r--lisp/emacs-lisp/re-builder.el12
-rw-r--r--lisp/emacs-lisp/rx.el17
-rw-r--r--lisp/emacs-lisp/smie.el28
-rw-r--r--lisp/emacs-lisp/syntax.el5
-rw-r--r--lisp/emacs-lisp/tcover-unsafep.el6
-rw-r--r--lisp/emacs-lisp/testcover.el4
-rw-r--r--lisp/emacs-lisp/timer.el81
-rw-r--r--lisp/emacs-lock.el277
-rw-r--r--lisp/emulation/cua-rect.el58
-rw-r--r--lisp/emulation/tpu-edt.el6
-rw-r--r--lisp/emulation/viper-cmd.el7
-rw-r--r--lisp/emulation/viper-util.el6
-rw-r--r--lisp/emulation/viper.el23
-rw-r--r--lisp/erc/ChangeLog21
-rw-r--r--lisp/erc/erc-pcomplete.el9
-rw-r--r--lisp/erc/erc.el83
-rw-r--r--lisp/eshell/em-glob.el8
-rw-r--r--lisp/eshell/em-ls.el9
-rw-r--r--lisp/eshell/em-pred.el65
-rw-r--r--lisp/eshell/em-smart.el1
-rw-r--r--lisp/faces.el110
-rw-r--r--lisp/files.el444
-rw-r--r--lisp/find-dired.el3
-rw-r--r--lisp/follow.el46
-rw-r--r--lisp/font-lock.el15
-rw-r--r--lisp/frame.el200
-rw-r--r--lisp/fringe.el2
-rw-r--r--lisp/gnus/ChangeLog569
-rw-r--r--lisp/gnus/ChangeLog.22
-rw-r--r--lisp/gnus/auth-source.el454
-rw-r--r--lisp/gnus/gnus-agent.el4
-rw-r--r--lisp/gnus/gnus-art.el23
-rw-r--r--lisp/gnus/gnus-cus.el26
-rw-r--r--lisp/gnus/gnus-delay.el3
-rw-r--r--lisp/gnus/gnus-draft.el3
-rw-r--r--lisp/gnus/gnus-fun.el5
-rw-r--r--lisp/gnus/gnus-group.el93
-rw-r--r--lisp/gnus/gnus-html.el10
-rw-r--r--lisp/gnus/gnus-int.el7
-rw-r--r--lisp/gnus/gnus-msg.el90
-rw-r--r--lisp/gnus/gnus-registry.el64
-rw-r--r--lisp/gnus/gnus-srvr.el6
-rw-r--r--lisp/gnus/gnus-start.el34
-rw-r--r--lisp/gnus/gnus-sum.el56
-rw-r--r--lisp/gnus/gnus-util.el11
-rw-r--r--lisp/gnus/gnus.el31
-rw-r--r--lisp/gnus/message.el33
-rw-r--r--lisp/gnus/mm-bodies.el3
-rw-r--r--lisp/gnus/mm-decode.el14
-rw-r--r--lisp/gnus/mm-util.el59
-rw-r--r--lisp/gnus/mml1991.el53
-rw-r--r--lisp/gnus/mml2015.el12
-rw-r--r--lisp/gnus/nndraft.el30
-rw-r--r--lisp/gnus/nnimap.el54
-rw-r--r--lisp/gnus/nnir.el204
-rw-r--r--lisp/gnus/nnmh.el4
-rw-r--r--lisp/gnus/nntp.el14
-rw-r--r--lisp/gnus/nnvirtual.el9
-rw-r--r--lisp/gnus/plstore.el438
-rw-r--r--lisp/gnus/pop3.el6
-rw-r--r--lisp/gnus/registry.el79
-rw-r--r--lisp/gnus/shr.el51
-rw-r--r--lisp/gnus/smiley.el4
-rw-r--r--lisp/gnus/spam-stat.el9
-rw-r--r--lisp/gnus/spam.el69
-rw-r--r--lisp/help-fns.el41
-rw-r--r--lisp/help-mode.el17
-rw-r--r--lisp/help.el318
-rw-r--r--lisp/hilit-chg.el5
-rw-r--r--lisp/hl-line.el24
-rw-r--r--lisp/icomplete.el5
-rw-r--r--lisp/ido.el2
-rw-r--r--lisp/ielm.el2
-rw-r--r--lisp/image-dired.el2
-rw-r--r--lisp/image-mode.el132
-rw-r--r--lisp/image.el196
-rw-r--r--lisp/info-look.el106
-rw-r--r--lisp/info.el32
-rw-r--r--lisp/international/ccl.el8
-rw-r--r--lisp/international/characters.el18
-rw-r--r--lisp/international/charprop.el13
-rw-r--r--lisp/international/mule-cmds.el83
-rw-r--r--lisp/international/quail.el45
-rw-r--r--lisp/international/uni-bidi.elbin9287 -> 8719 bytes
-rw-r--r--lisp/international/uni-category.elbin12450 -> 11396 bytes
-rw-r--r--lisp/international/uni-combining.elbin8881 -> 8369 bytes
-rw-r--r--lisp/international/uni-comment.elbin2276 -> 2386 bytes
-rw-r--r--lisp/international/uni-decimal.elbin2483 -> 1869 bytes
-rw-r--r--lisp/international/uni-decomposition.elbin27823 -> 28459 bytes
-rw-r--r--lisp/international/uni-digit.elbin2790 -> 2187 bytes
-rw-r--r--lisp/international/uni-lowercase.elbin5387 -> 5347 bytes
-rw-r--r--lisp/international/uni-mirrored.elbin7904 -> 10452 bytes
-rw-r--r--lisp/international/uni-name.elbin157287 -> 158765 bytes
-rw-r--r--lisp/international/uni-numeric.elbin4258 -> 3688 bytes
-rw-r--r--lisp/international/uni-old-name.elbin19338 -> 19692 bytes
-rw-r--r--lisp/international/uni-titlecase.elbin5477 -> 5434 bytes
-rw-r--r--lisp/international/uni-uppercase.elbin5473 -> 5430 bytes
-rw-r--r--lisp/isearch.el44
-rw-r--r--lisp/iswitchb.el9
-rw-r--r--lisp/jka-cmpr-hook.el2
-rw-r--r--lisp/jka-compr.el11
-rw-r--r--lisp/kermit.el2
-rw-r--r--lisp/ldefs-boot.el1046
-rw-r--r--lisp/loadhist.el49
-rw-r--r--lisp/loadup.el30
-rw-r--r--lisp/longlines.el6
-rw-r--r--lisp/mail/emacsbug.el88
-rw-r--r--lisp/mail/feedmail.el1026
-rw-r--r--lisp/mail/footnote.el32
-rw-r--r--lisp/mail/mail-utils.el2
-rw-r--r--lisp/mail/mailabbrev.el1
-rw-r--r--lisp/mail/mspools.el12
-rw-r--r--lisp/mail/rmail.el117
-rw-r--r--lisp/mail/rmailmm.el87
-rw-r--r--lisp/mail/sendmail.el134
-rw-r--r--lisp/mail/smtpmail.el656
-rw-r--r--lisp/mail/supercite.el4
-rw-r--r--lisp/man.el8
-rw-r--r--lisp/menu-bar.el154
-rw-r--r--lisp/mh-e/ChangeLog89
-rw-r--r--lisp/mh-e/mh-acros.el7
-rw-r--r--lisp/mh-e/mh-alias.el13
-rw-r--r--lisp/mh-e/mh-comp.el5
-rw-r--r--lisp/mh-e/mh-compat.el28
-rw-r--r--lisp/mh-e/mh-e.el16
-rw-r--r--lisp/mh-e/mh-folder.el13
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-inc.el12
-rw-r--r--lisp/mh-e/mh-junk.el6
-rw-r--r--lisp/mh-e/mh-letter.el22
-rw-r--r--lisp/mh-e/mh-mime.el17
-rw-r--r--lisp/mh-e/mh-scan.el2
-rw-r--r--lisp/mh-e/mh-search.el15
-rw-r--r--lisp/mh-e/mh-seq.el3
-rw-r--r--lisp/mh-e/mh-show.el4
-rw-r--r--lisp/mh-e/mh-speed.el8
-rw-r--r--lisp/mh-e/mh-utils.el6
-rw-r--r--lisp/mh-e/mh-xface.el21
-rw-r--r--lisp/minibuffer.el638
-rw-r--r--lisp/misc.el2
-rw-r--r--lisp/mouse-sel.el31
-rw-r--r--lisp/mouse.el37
-rw-r--r--lisp/mpc.el6
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/net/ange-ftp.el54
-rw-r--r--lisp/net/browse-url.el21
-rw-r--r--lisp/net/dbus.el48
-rw-r--r--lisp/net/eudc-export.el4
-rw-r--r--lisp/net/eudc-hotlist.el4
-rw-r--r--lisp/net/eudc.el18
-rw-r--r--lisp/net/eudcb-bbdb.el49
-rw-r--r--lisp/net/eudcb-ldap.el8
-rw-r--r--lisp/net/ldap.el2
-rw-r--r--lisp/net/network-stream.el134
-rw-r--r--lisp/net/newst-backend.el25
-rw-r--r--lisp/net/newst-plainview.el136
-rw-r--r--lisp/net/newst-reader.el866
-rw-r--r--lisp/net/newst-treeview.el130
-rw-r--r--lisp/net/rcirc.el196
-rw-r--r--lisp/net/soap-client.el10
-rw-r--r--lisp/net/tramp-cache.el92
-rw-r--r--lisp/net/tramp-cmds.el13
-rw-r--r--lisp/net/tramp-compat.el20
-rw-r--r--lisp/net/tramp-ftp.el20
-rw-r--r--lisp/net/tramp-gvfs.el6
-rw-r--r--lisp/net/tramp-sh.el190
-rw-r--r--lisp/net/tramp-smb.el18
-rw-r--r--lisp/net/tramp.el74
-rw-r--r--lisp/net/webjump.el10
-rw-r--r--lisp/newcomment.el4
-rw-r--r--lisp/nxml/nxml-mode.el6
-rw-r--r--lisp/nxml/rng-maint.el8
-rw-r--r--lisp/nxml/rng-xsd.el2
-rw-r--r--lisp/obsolete/old-emacs-lock.el102
-rw-r--r--lisp/org/ChangeLog8
-rw-r--r--lisp/org/org-agenda.el2
-rw-r--r--lisp/org/org-ascii.el96
-rw-r--r--lisp/org/org-attach.el8
-rw-r--r--lisp/org/org-exp.el2
-rw-r--r--lisp/org/org-html.el134
-rw-r--r--lisp/org/org-mouse.el16
-rw-r--r--lisp/org/org-src.el2
-rw-r--r--lisp/org/org-table.el2
-rw-r--r--lisp/org/org-wl.el2
-rw-r--r--lisp/org/org.el12
-rw-r--r--lisp/pcmpl-linux.el13
-rw-r--r--lisp/pcmpl-rpm.el6
-rw-r--r--lisp/pcomplete.el223
-rw-r--r--lisp/play/5x5.el511
-rw-r--r--lisp/play/animate.el41
-rw-r--r--lisp/play/fortune.el2
-rw-r--r--lisp/play/hanoi.el13
-rw-r--r--lisp/printing.el19
-rw-r--r--lisp/proced.el15
-rw-r--r--lisp/progmodes/cc-defs.el2
-rw-r--r--lisp/progmodes/cc-engine.el29
-rw-r--r--lisp/progmodes/cc-fonts.el204
-rw-r--r--lisp/progmodes/cc-guess.el574
-rw-r--r--lisp/progmodes/cc-langs.el13
-rw-r--r--lisp/progmodes/cc-mode.el67
-rw-r--r--lisp/progmodes/cc-styles.el9
-rw-r--r--lisp/progmodes/cc-vars.el3
-rw-r--r--lisp/progmodes/cfengine.el270
-rw-r--r--lisp/progmodes/compile.el15
-rw-r--r--lisp/progmodes/cperl-mode.el29
-rw-r--r--lisp/progmodes/delphi.el24
-rw-r--r--lisp/progmodes/etags.el8
-rw-r--r--lisp/progmodes/f90.el145
-rw-r--r--lisp/progmodes/flymake.el17
-rw-r--r--lisp/progmodes/fortran.el1
-rw-r--r--lisp/progmodes/gdb-mi.el1064
-rw-r--r--lisp/progmodes/grep.el32
-rw-r--r--lisp/progmodes/gud.el13
-rw-r--r--lisp/progmodes/hideshow.el27
-rw-r--r--lisp/progmodes/idlw-help.el2
-rw-r--r--lisp/progmodes/idlw-shell.el10
-rw-r--r--lisp/progmodes/js.el6
-rw-r--r--lisp/progmodes/ld-script.el29
-rw-r--r--lisp/progmodes/make-mode.el44
-rw-r--r--lisp/progmodes/meta-mode.el52
-rw-r--r--lisp/progmodes/mixal-mode.el5
-rw-r--r--lisp/progmodes/octave-inf.el23
-rw-r--r--lisp/progmodes/octave-mod.el8
-rw-r--r--lisp/progmodes/pascal.el75
-rw-r--r--lisp/progmodes/ps-mode.el2
-rw-r--r--lisp/progmodes/python.el20
-rw-r--r--lisp/progmodes/sql.el1169
-rw-r--r--lisp/progmodes/verilog-mode.el16
-rw-r--r--lisp/progmodes/vhdl-mode.el2
-rw-r--r--lisp/progmodes/which-func.el10
-rw-r--r--lisp/ps-print.el2
-rw-r--r--lisp/rect.el11
-rw-r--r--lisp/register.el46
-rw-r--r--lisp/repeat.el4
-rw-r--r--lisp/replace.el111
-rw-r--r--lisp/scroll-bar.el3
-rw-r--r--lisp/select.el11
-rw-r--r--lisp/server.el48
-rw-r--r--lisp/ses.el1074
-rw-r--r--lisp/sha1.el441
-rw-r--r--lisp/shell.el91
-rw-r--r--lisp/simple.el246
-rw-r--r--lisp/startup.el197
-rw-r--r--lisp/subr.el120
-rw-r--r--lisp/tabify.el28
-rw-r--r--lisp/tar-mode.el3
-rw-r--r--lisp/term.el4
-rw-r--r--lisp/term/ns-win.el6
-rw-r--r--lisp/term/w32console.el1
-rw-r--r--lisp/term/xterm.el161
-rw-r--r--lisp/terminal.el4
-rw-r--r--lisp/textmodes/artist.el4
-rw-r--r--lisp/textmodes/bibtex.el1671
-rw-r--r--lisp/textmodes/css-mode.el4
-rw-r--r--lisp/textmodes/fill.el3
-rw-r--r--lisp/textmodes/flyspell.el11
-rw-r--r--lisp/textmodes/reftex-dcr.el2
-rw-r--r--lisp/textmodes/reftex-parse.el55
-rw-r--r--lisp/textmodes/rst.el11
-rw-r--r--lisp/textmodes/texnfo-upd.el2
-rw-r--r--lisp/thingatpt.el75
-rw-r--r--lisp/thumbs.el2
-rw-r--r--lisp/time.el49
-rw-r--r--lisp/tool-bar.el3
-rw-r--r--lisp/type-break.el51
-rw-r--r--lisp/url/ChangeLog44
-rw-r--r--lisp/url/url-cache.el1
-rw-r--r--lisp/url/url-cookie.el12
-rw-r--r--lisp/url/url-future.el126
-rw-r--r--lisp/url/url-http.el27
-rw-r--r--lisp/url/url-queue.el4
-rw-r--r--lisp/vc/add-log.el18
-rw-r--r--lisp/vc/diff-mode.el23
-rw-r--r--lisp/vc/diff.el8
-rw-r--r--lisp/vc/ediff-diff.el2
-rw-r--r--lisp/vc/ediff-util.el14
-rw-r--r--lisp/vc/ediff.el2
-rw-r--r--lisp/vc/log-view.el4
-rw-r--r--lisp/vc/smerge-mode.el11
-rw-r--r--lisp/vc/vc-annotate.el1
-rw-r--r--lisp/vc/vc-arch.el2
-rw-r--r--lisp/vc/vc-bzr.el30
-rw-r--r--lisp/vc/vc-dir.el1
-rw-r--r--lisp/vc/vc.el84
-rw-r--r--lisp/view.el247
-rw-r--r--lisp/w32-fns.el2
-rw-r--r--lisp/wid-edit.el109
-rw-r--r--lisp/window.el7465
-rw-r--r--lisp/winner.el2
-rw-r--r--lisp/woman.el12
-rw-r--r--lisp/x-dnd.el17
-rw-r--r--lwlib/ChangeLog10
-rw-r--r--lwlib/Makefile.in11
-rw-r--r--m4/alloca.m4121
-rw-r--r--m4/c-strtod.m410
-rw-r--r--m4/dup2.m476
-rw-r--r--m4/filemode.m43
-rw-r--r--m4/getloadavg.m478
-rw-r--r--m4/getopt.m4120
-rw-r--r--m4/gl-comp.m4142
-rw-r--r--m4/gnulib-common.m457
-rw-r--r--m4/inttypes.m44
-rw-r--r--m4/lstat.m437
-rw-r--r--m4/md5.m44
-rw-r--r--m4/mktime.m469
-rw-r--r--m4/pthread_sigmask.m427
-rw-r--r--m4/readlink.m49
-rw-r--r--m4/sha1.m413
-rw-r--r--m4/sha256.m412
-rw-r--r--m4/sha512.m412
-rw-r--r--m4/signal_h.m477
-rw-r--r--m4/signalblocking.m425
-rw-r--r--m4/stat.m414
-rw-r--r--m4/stdint.m44
-rw-r--r--m4/strftime.m44
-rw-r--r--m4/strtoimax.m423
-rw-r--r--m4/strtoll.m424
-rw-r--r--m4/strtoull.m45
-rw-r--r--m4/strtoumax.m47
-rw-r--r--m4/symlink.m44
-rw-r--r--m4/time_r.m44
-rw-r--r--m4/unistd_h.m48
-rwxr-xr-xmake-dist21
-rw-r--r--msdos/ChangeLog28
-rw-r--r--msdos/sed1v2.inp13
-rw-r--r--msdos/sed1x.inp2
-rw-r--r--msdos/sedlibmk.inp5
-rw-r--r--nt/ChangeLog14
-rw-r--r--nt/README.W329
-rw-r--r--nt/config.nt8
-rw-r--r--nt/inc/stdint.h6
-rw-r--r--src/ChangeLog2939
-rw-r--r--src/ChangeLog.62
-rw-r--r--src/ChangeLog.92
-rw-r--r--src/Makefile.in289
-rw-r--r--src/alloc.c329
-rw-r--r--src/bidi.c8
-rw-r--r--src/buffer.c742
-rw-r--r--src/buffer.h28
-rw-r--r--src/bytecode.c32
-rw-r--r--src/callint.c74
-rw-r--r--src/callproc.c56
-rw-r--r--src/casefiddle.c5
-rw-r--r--src/casetab.c6
-rw-r--r--src/category.c16
-rw-r--r--src/category.h2
-rw-r--r--src/ccl.c295
-rw-r--r--src/character.c56
-rw-r--r--src/character.h71
-rw-r--r--src/charset.c59
-rw-r--r--src/charset.h50
-rw-r--r--src/chartab.c587
-rw-r--r--src/cm.c3
-rw-r--r--src/cmds.c19
-rw-r--r--src/coding.c40
-rw-r--r--src/composite.c318
-rw-r--r--src/composite.h20
-rw-r--r--src/data.c559
-rw-r--r--src/dbusbind.c301
-rw-r--r--src/deps.mk3
-rw-r--r--src/dired.c75
-rw-r--r--src/dispextern.h61
-rw-r--r--src/dispnew.c118
-rw-r--r--src/doc.c10
-rw-r--r--src/doprnt.c8
-rw-r--r--src/editfns.c1077
-rw-r--r--src/emacs.c51
-rw-r--r--src/emacsgtkfixed.c166
-rw-r--r--src/emacsgtkfixed.h60
-rw-r--r--src/eval.c170
-rw-r--r--src/fileio.c246
-rw-r--r--src/filelock.c89
-rw-r--r--src/floatfns.c5
-rw-r--r--src/fns.c701
-rw-r--r--src/font.c149
-rw-r--r--src/font.h75
-rw-r--r--src/fontset.c12
-rw-r--r--src/frame.c306
-rw-r--r--src/frame.h3
-rw-r--r--src/fringe.c65
-rw-r--r--src/ftfont.c11
-rw-r--r--src/gmalloc.c9
-rw-r--r--src/gnutls.c113
-rw-r--r--src/gtkutil.c105
-rw-r--r--src/gtkutil.h1
-rw-r--r--src/image.c696
-rw-r--r--src/indent.c61
-rw-r--r--src/insdel.c82
-rw-r--r--src/intervals.c53
-rw-r--r--src/keyboard.c77
-rw-r--r--src/keyboard.h8
-rw-r--r--src/keymap.c601
-rw-r--r--src/keymap.h4
-rw-r--r--src/lisp.h242
-rw-r--r--src/lisp.mk160
-rw-r--r--src/lread.c324
-rw-r--r--src/m/iris4d.h26
-rw-r--r--src/macros.c25
-rw-r--r--src/makefile.w32-in1642
-rw-r--r--src/mem-limits.h7
-rw-r--r--src/menu.c10
-rw-r--r--src/menu.h5
-rw-r--r--src/minibuf.c269
-rw-r--r--src/msdos.c5
-rw-r--r--src/nsfns.m12
-rw-r--r--src/nsgui.h5
-rw-r--r--src/nsimage.m4
-rw-r--r--src/nsmenu.m3
-rw-r--r--src/nsselect.m8
-rw-r--r--src/nsterm.h46
-rw-r--r--src/nsterm.m73
-rw-r--r--src/print.c58
-rw-r--r--src/process.c290
-rw-r--r--src/puresize.h2
-rw-r--r--src/ralloc.c2
-rw-r--r--src/regex.c17
-rw-r--r--src/s/irix6-5.h7
-rw-r--r--src/scroll.c8
-rw-r--r--src/search.c6
-rw-r--r--src/sound.c14
-rw-r--r--src/syntax.c11
-rw-r--r--src/sysdep.c51
-rw-r--r--src/systime.h8
-rw-r--r--src/term.c62
-rw-r--r--src/termcap.c59
-rw-r--r--src/termhooks.h22
-rw-r--r--src/terminal.c8
-rw-r--r--src/textprop.c76
-rw-r--r--src/tparam.c5
-rw-r--r--src/undo.c22
-rw-r--r--src/unexelf.c3
-rw-r--r--src/unexhp9k800.c172
-rw-r--r--src/vm-limit.c5
-rw-r--r--src/w32.c11
-rw-r--r--src/w32fns.c22
-rw-r--r--src/w32gui.h4
-rw-r--r--src/w32inevt.c5
-rw-r--r--src/w32menu.c3
-rw-r--r--src/w32proc.c1
-rw-r--r--src/w32select.c1
-rw-r--r--src/w32term.c60
-rw-r--r--src/w32term.h6
-rw-r--r--src/widget.c31
-rw-r--r--src/widgetprv.h5
-rw-r--r--src/window.c5048
-rw-r--r--src/window.h134
-rw-r--r--src/xdisp.c458
-rw-r--r--src/xfaces.c344
-rw-r--r--src/xfns.c99
-rw-r--r--src/xfont.c4
-rw-r--r--src/xgselect.c10
-rw-r--r--src/xmenu.c46
-rw-r--r--src/xrdb.c76
-rw-r--r--src/xselect.c1428
-rw-r--r--src/xsettings.c475
-rw-r--r--src/xsmfns.c12
-rw-r--r--src/xterm.c165
-rw-r--r--src/xterm.h23
-rw-r--r--test/ChangeLog5
-rw-r--r--test/automated/ert-x-tests.el2
-rw-r--r--test/automated/gnus-tests.el35
-rw-r--r--test/eshell.el2
728 files changed, 54097 insertions, 30025 deletions
diff --git a/ChangeLog b/ChangeLog
index ee27f4c1492..f9cadda71aa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,272 @@
+2011-07-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.in (GSETTINGS): Check for gio-2.0 >= 2.26.
+
+2011-07-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * configure.in (LD_SWITCH_SYSTEM_TEMACS): Add -fno-pie on Darwin
+ so as to suppress address randomization (Bug#8395).
+
+2011-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/stdint.in.h: Merge from gnulib (Bug#9025).
+ This fixes a build problem on older Mac OS X hosts.
+
+ * m4/pthread_sigmask.m4 (gl_FUNC_PTHREAD_SIGMASK): Omit gl_THREADLIB
+ test, which runs afoul of Automake installations where, for example,
+ /usr/share/aclocal contains a copy of gl_THREADLIB.
+ Problem reported by Sven Joachim in
+ <http://lists.gnu.org/archive/html/emacs-devel/2011-07/msg00529.html>.
+ This is just a quick temporary fix, specific to Emacs; I'll work
+ with the other gnulib maintainers to get a more-permanent fix.
+
+ Add gnulib's strtoimax module, needed on Solaris 8.
+ * Makefile.in (GNULIB_MODULES): Add strtoimax.
+ * lib/strtoll.c, m4/strtoimax.m4, m4/strtoll.m4: New files,
+ automatically imported from gnulib.
+ * lib/gnulib.mk, m4/gl-comp.m4: Regenerate.
+
+2011-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add gnulib support for pthread_sigmask (Bug#9010).
+ * Makefile.in (GNULIB_MODULES): Add pthread_sigmask.
+ * configure.in (AC_TYPE_UID_T): New dummy macro.
+ Configure gnulib after adjusting LIBS,
+ so that gnulib can assume the libraries in LIBS.
+ * lib/signal.in.h, m4/pthread_sigmask.m4, m4/signal_h.m4:
+ * lib/pthread_sigprocmask.c, lib/sigprocmask.c, m4/signalblocking.m4:
+ * lib/pthread_sigmask.c:
+ New files, automatically imported from gnulib.
+ * lib/gnulib.mk, m4/gl-comp.m4: Automatically-imported update
+ due to the above changes.
+ * .bzrignore: Add lib/signal.h.
+
+ * lib/getopt.c, lib/unistd.in.h, m4/getopt.m4: Merge from gnulib.
+
+2011-07-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in (maintainer-mode): Reflect default in help string.
+
+2011-07-07 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * configure.in: Remove reference to iris4d.h.
+
+2011-07-05 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.in (HAVE_GCONF): Allow both HAVE_GCONF and HAVE_GSETTINGS.
+
+2011-07-01 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (SETTINGS_CFLAGS, SETTINGS_LIBS) [HAVE_GCONF]: Fix typo.
+
+2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * configure.in (HAVE_GSETTINGS): Fix syntax for GSETTINGS tests,
+ which made ./configure infloop.
+
+2011-06-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.in (gsettings): New option and check for GSettings.
+
+2011-06-29 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Try to test for the required crt*.o files.
+
+2011-06-27 Bill Wohler <wohler@newt.com>
+
+ * .bzrignore: Add lisp/mh-e/mh-autoloads.el and lisp/mh-e/mh-cus-load.el.
+
+2011-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use gnulib's dup2 module instead of rolling our own.
+ * Makefile.in (GNULIB_MODULES): Add dup2.
+ * configure.in: Do not check for dup2; gnulib does that now.
+ * lib/dup2.c, m4/dup2.m4: New files, from gnulib.
+
+2011-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/getopt.c, lib/stat.c, m4/gl-comp.m4: Merge from gnulib.
+
+2011-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use gnulib's alloca-opt module.
+ * .bzrignore: Add lib/alloca.h.
+ * Makefile.in (GNULIB_MODULES): Add alloca-opt.
+ * configure.in (AC_FUNC_ALLOCA): Remove almost all the alloca stuff,
+ as gnulib now does that for us. Put alloca check in config.h.
+ Include <alloca.h> before any other include file, for AIX 3.
+ * lib/gnulib.mk, m4/gl-comp.m4: Regenerate.
+ * lib/alloca.in.h, m4/alloca.m4: New files, from gnulib.
+
+2011-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * m4/sha256.m4:
+ * m4/sha512.m4:
+ * m4/gl-comp.m4:
+ * lib/u64.h:
+ * lib/sha256.c:
+ * lib/sha256.h:
+ * lib/sha512.c:
+ * lib/sha512.h:
+ * lib/makefile.w32-in (GNULIBOBJS):
+ * lib/gnulib.mk:
+ * Makefile.in (GNULIB_MODULES): Add crypto/sha256 and
+ crypto/sha512 modules from gnulib.
+
+2011-06-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/unistd.in.h, m4/getloadavg.m4: Merge from gnulib.
+
+2011-06-17 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Restore the behavior of checking crt-dir only
+ when the user specified it (not all platforms use it).
+
+2011-06-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * m4/lstat.m4: Merge from gnulib (Bug#8878).
+
+2011-06-16 Miles Bader <miles@gnu.org>
+
+ * configure.in: Try to determine CRT_DIR automatically when
+ using gcc.
+
+2011-06-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/ftoastr.c, lib/stdio.in.h, lib/verify.h:
+ * lib/gnulib.mk, m4/c-strtod.m4, m4/filemode.m4, m4/getloadavg.m4:
+ * m4/getopt.m4, m4/gl-comp.m4, m4/lstat.m4, m4/md5.m4, m4/mktime.m4:
+ * m4/readlink.m4, m4/sha1.m4, m4/stat.m4, m4/strftime.m4:
+ * m4/strtoull.m4, m4/strtoumax.m4, m4/symlink.m4, m4/time_r.m4:
+ Merge from gnulib.
+
+2011-06-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.in: Add emacsgtkfixed.o to GTK_OBJ if HAVE_GTK3.
+
+2011-06-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/gnulib.mk, m4/gnulib-common.m4: Merge from gnulib.
+
+2011-06-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Add --with-wide-int.
+ * INSTALL: Mention this.
+
+2011-06-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * lib/careadlinkat.c, lib/careadlinkat.h, m4/gnulib-common.m4: Merge.
+
+2011-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/allocator.h, lib/careadlinkat.c: Merge from gnulib.
+
+2011-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use 'inline', not 'INLINE'.
+ * configure.in (INLINE): Remove.
+
+2011-05-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Adjust to recent gnulib change for @GUARD_PREFIX@.
+ * lib/makefile.w32-in (getopt_h): Substitute @GUARD_PREFIX@, too.
+ All uses of _GL_ for guard prefixes in lib/*.h replaced with
+ _@GUARD_PREFIX@_.
+
+2011-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/getopt.c, lib/intprops.h: Merge from gnulib.
+
+2011-05-24 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (check): Just give a message if no test/ directory.
+
+ * configure.in: Avoid using variables inside AC_CONFIG_FILES.
+
+ * configure.in (OPT_MAKEFILES_IN): Remove.
+ (SUBDIR_MAKEFILES): New variable, passed to AC_CONFIG_FILES.
+ (SUBDIR_MAKEFILES_IN): New output variable.
+ * Makefile.in (OPT_MAKEFILES_IN): Remove.
+ (SUBDIR_MAKEFILES_IN): Let configure set it.
+
+2011-05-24 Leo Liu <sdl.web@gmail.com>
+
+ * m4/sha1.m4:
+ * m4/gl-comp.m4:
+ * lib/sha1.h:
+ * lib/sha1.c:
+ * lib/makefile.w32-in (GNULIBOBJS):
+ * lib/gnulib.mk:
+ * Makefile.in (GNULIB_MODULES): Add crypto/sha1 module.
+
+2011-05-24 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Remove test for already configured source directory.
+ AM_INIT_AUTOMAKE has already done a more stringent test. (Bug#953)
+
+ * Makefile.in (TAGS, tags, check): Pass MFLAGS to sub-makes.
+
+2011-05-24 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: Don't distribute test/. (Bug#8107)
+ * configure.in (OPT_MAKEFILES_IN): New output variable.
+ (AC_CONFIG_FILES): Conditionally include test/automated/Makefile.
+ * Makefile.in (OPT_MAKEFILES_IN): New, set by configure.
+ (SUBDIR_MAKEFILES_IN): Use $OPT_MAKEFILES_IN.
+ (check): Give an explicit error if test/ is not present.
+
+ * Makefile.in (SUBDIR_MAKEFILES_IN): New variable.
+ (SUBDIR_MAKEFILES): Derive from $SUBDIR_MAKEFILES_IN.
+ (Makefile): Use $SUBDIR_MAKEFILES_IN.
+
+2011-05-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/verify.h: Merge from gnulib.
+
+2011-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/intprops.h, lib/stdint.in.h, m4/mktime.m4, m4/readlink.m4:
+ Merge from gnulib.
+
+2011-05-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (AUTOMAKE_INPUTS): Add $(srcdir)/lib/gnulib.mk.
+
+2011-05-20 Eli Zaretskii <eliz@gnu.org>
+
+ * .bzrignore: Add lib/stdio.in-h, lib/stdbool.h, and lib/stdint.h.
+
+ * config.bat: Concatenate lisp.mk onto the end of src/Makefile.
+
+2011-05-20 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (lisp_frag): New output file.
+
+2011-05-19 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (NS_SUPPORT, MOUSE_SUPPORT, TOOLTIP_SUPPORT)
+ (WINDOW_SUPPORT): Remove output variables that are no longer used.
+
+2011-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/gnulib.mk:
+ * lib/intprops.h:
+ * lib/unistd.in.h:
+ * m4/inttypes.m4:
+ * m4/stdint.m4:
+ * m4/unistd_h.m4: Sync from gnulib.
+
+2011-05-14 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Treat failure to find an X toolkit the same way we treat
+ failure to find X and image support.
+
+2011-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (src, install-arch-indep, bootstrap-clean)
+ (check-declare): Shell portability fixes. (Bug#8642)
+
2011-05-09 Teodor Zlatanov <tzz@lifelogs.com>
* configure.in: Require GnuTLS 2.6.x or higher.
diff --git a/INSTALL b/INSTALL
index 27a148a32d4..03682d19b10 100644
--- a/INSTALL
+++ b/INSTALL
@@ -208,7 +208,8 @@ The names of the packages that you need varies according to the
GNU/Linux distribution that you use, and the options that you want to
configure Emacs with. On Debian-based systems, you can install all the
packages needed to build the installed version of Emacs with a command
-like `apt-get build-dep emacs23'.
+like `apt-get build-dep emacs23'. On Red Hat systems, the
+corresponding command is `yum-builddep emacs'.
DETAILED BUILDING AND INSTALLATION:
@@ -308,6 +309,10 @@ systems which support that.
Use --without-sound to disable sound support.
+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.
+
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
@@ -704,8 +709,8 @@ 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 `fakemail', `hexl', `movemail', `profile', `rcs2log',
- and `vcdiff' are used by Emacs; they do need to be copied.
+- The programs `hexl', `movemail', `profile', `rcs2log', and `vcdiff'
+ 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 `make-docfile' and `test-distrib' were
diff --git a/INSTALL.BZR b/INSTALL.BZR
index 93229ec7a79..664aab1c765 100644
--- a/INSTALL.BZR
+++ b/INSTALL.BZR
@@ -68,10 +68,12 @@ etc.) before "make bootstrap" or "make"; the rest of the procedure is
applicable to those systems as well.
Because the Bazaar version of Emacs is a work in progress, it will
-sometimes fail to build. Please wait a day or so (and check the bug
-and development mailing list archives) before reporting such problems.
-In most cases, the problem is known about and is just waiting for
-someone to fix it.
+sometimes fail to build. Please wait a day or so (and check the
+archives of the emacs-buildstatus, emacs-devel, and bug-gnu-emacs
+mailing lists) before reporting such problems. In most cases, the
+problem is known about and is just waiting for someone to fix it.
+This is especially true for Lisp compilation errors, which are almost
+never platform-specific.
diff --git a/Makefile.in b/Makefile.in
index a8cdd6a901d..ce7f3f1a3d8 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -265,7 +265,8 @@ EMACSFULL = `echo emacs-${version}${EXEEXT} | sed '$(TRANSFORM)'`
SUBDIR = lib lib-src src lisp
# The subdir makefiles created by config.status.
-SUBDIR_MAKEFILES = lib/Makefile lib-src/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispref/Makefile doc/lispintro/Makefile src/Makefile oldXMenu/Makefile lwlib/Makefile leim/Makefile lisp/Makefile test/automated/Makefile
+SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
+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.
@@ -331,9 +332,12 @@ DOS_gnulib_comp.m4 = gl-comp.m4
# $(gnulib_srcdir) (relative to $(srcdir) and should have build tools
# as per $(gnulib_srcdir)/DEPENDENCIES.
GNULIB_MODULES = \
- careadlinkat crypto/md5 dtoastr filemode getloadavg getopt-gnu \
- ignore-value intprops lstat mktime readlink \
- socklen stdarg stdio strftime strtoumax symlink sys_stat
+ 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 = \
--conditional-dependencies --import --no-changelog --no-vc-files \
--makefile-name=gnulib.mk
@@ -373,7 +377,7 @@ src: Makefile FRC
LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="$$boot"; \
fi;
if [ -r .bzr/checkout/dirstate ]; then \
- vcswitness="$$(pwd)/.bzr/checkout/dirstate"; \
+ vcswitness="`pwd`/.bzr/checkout/dirstate"; \
fi; \
cd $@; $(MAKE) all $(MFLAGS) \
CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
@@ -388,19 +392,7 @@ blessmail: Makefile src FRC
# 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 \
- $(srcdir)/src/Makefile.in \
- $(srcdir)/lib/Makefile.in \
- $(srcdir)/lib-src/Makefile.in \
- $(srcdir)/doc/emacs/Makefile.in \
- $(srcdir)/doc/misc/Makefile.in \
- $(srcdir)/doc/lispref/Makefile.in \
- $(srcdir)/doc/lispintro/Makefile.in \
- $(srcdir)/oldXMenu/Makefile.in \
- $(srcdir)/lwlib/Makefile.in \
- $(srcdir)/leim/Makefile.in \
- $(srcdir)/lisp/Makefile.in \
- $(srcdir)/test/automated/Makefile.in
+ $(srcdir)/Makefile.in $(SUBDIR_MAKEFILES_IN)
./config.status
# Don't erase config.status if make is interrupted while refreshing it.
@@ -422,7 +414,7 @@ ACLOCAL_INPUTS = @MAINT@ $(srcdir)/m4/$(DOS_gnulib_comp.m4)
$(srcdir)/aclocal.m4: $(ACLOCAL_INPUTS)
cd $(srcdir) && aclocal -I m4
-AUTOMAKE_INPUTS = @MAINT@ $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am
+AUTOMAKE_INPUTS = @MAINT@ $(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
am--refresh: $(srcdir)/aclocal.m4 $(srcdir)/configure $(srcdir)/src/config.in
@@ -623,7 +615,7 @@ install-arch-indep: mkdir info install-etc
fi; \
cd ${srcdir}/info ; \
for elt in $(INFO_FILES); do \
- test "$(HAVE_MAKEINFO)" = "no" && ! test -e $$elt && continue; \
+ 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; \
@@ -639,7 +631,7 @@ install-arch-indep: mkdir info install-etc
if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd $(DESTDIR)${infodir} && /bin/pwd)` ]; \
then \
for elt in $(INFO_FILES); do \
- test "$(HAVE_MAKEINFO)" = "no" && ! test -e $$elt && continue; \
+ test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \
(cd $${thisdir}; \
${INSTALL_INFO} --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
done; \
@@ -829,7 +821,7 @@ bootstrap-clean: FRC
-(cd doc/lispintro && $(MAKE) $(MFLAGS) maintainer-clean)
(cd leim; $(MAKE) $(MFLAGS) maintainer-clean)
(cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean)
- [ ! -e config.log ] || mv -f config.log config.log~
+ [ ! -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.
@@ -866,10 +858,15 @@ extraclean:
# The src subdir knows how to do the right thing
# even when the build directory and source dir are different.
TAGS tags: lib lib-src src
- cd src; $(MAKE) tags
+ cd src; $(MAKE) $(MFLAGS) tags
check:
- cd test/automated; $(MAKE) check
+ @if test ! -d test/automated; then \
+ echo "You do not seem to have the test/ directory."; \
+ echo "Maybe you are using a release tarfile, rather than a repository checkout."; \
+ else \
+ cd test/automated && $(MAKE) $(MFLAGS) check; \
+ fi
dist:
cd ${srcdir}; ./make-dist
@@ -944,7 +941,7 @@ bootstrap: bootstrap-clean FRC
.PHONY: check-declare
check-declare:
- @if [ ! -e $(srcdir)/src/emacs ]; then \
+ @if [ ! -f $(srcdir)/src/emacs ]; then \
echo "You must build Emacs to use this command"; \
exit 1; \
fi
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 7f6a18f7d54..6e0f736a06f 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -53,8 +53,6 @@ CLASH_DETECTION
COFF
FIRST_PTY_LETTER
HAVE_PTYS
-HAVE_TERMIO
-HAVE_TERMIOS
INTERRUPT_INPUT
NARROWPROTO
SEPCHAR
@@ -175,7 +173,6 @@ HAVE_SYS_SYSTEMINFO_H
HAVE_SYS_TIMEB_H
HAVE_SYS_TIME_H
HAVE_TCATTR
-HAVE_TERMIOS_H
HAVE_TIMEVAL
HAVE_TM_ZONE
HAVE_TZSET
@@ -258,14 +255,9 @@ USG5_4
USG_SUBTTY_WORKS
VALBITS
WRETCODE
-XINT
XOS_NEEDS_TIME_H
-XPNTR
-XSET
-XUINT
_AIX
_ARCH_PPC64
-_CALLBACK_
_FILE_OFFSET_BITS
_LP64
_MALLOC_INTERNAL
@@ -273,21 +265,6 @@ _NAIVE_DOS_REGS
_VARARGS_
_WINSOCKAPI_
_WINSOCK_H
-__ELF__
-__FreeBSD__
-__GNUC__
-__GNU_LIBRARY__
-__GNUC_MINOR__
-__NetBSD__
-__OpenBSD__
-__STDC__
-__arch64__
-__cplusplus
-__hpux
-__ia64__
-__linux__
-__mc68000__
-__mips__
_longjmp
_setjmp
_start
@@ -323,9 +300,7 @@ getenv
getpid
getuid
gmtime
-i386
index
-init_process
isatty
kill
link
@@ -333,7 +308,6 @@ linux
localtime
logb
lseek
-m68k
malloc
mkdir
mktemp
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 853c1941a92..dbbe38ce617 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,47 @@
+2011-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * unidata/makefile.w32-in (charprop-SH, charprop-CMD):
+ Duplicate change in Makefile.in (2011-07-06T22:43:48Z!handa@m17n.org).
+
+2011-07-06 Kenichi Handa <handa@m17n.org>
+
+ * 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).
+ New entry `mirroring'.
+ (unidata-prop-default, unidata-prop-val-list): New subst.
+ (unidata-get-character, unidata-put-character): Delete them.
+ (unidata-gen-table-character): New arg IGNORE. Adjusted for the
+ above changes.
+ (unidata-get-symbol, unidata-get-integer, unidata-get-numeric)
+ (unidata-put-symbol, unidata-put-integer, unidata-put-numeric):
+ Delete them.
+ (unidata-encode-val): Assume that the first element of VAL-LIST is
+ a cons (nil . 0).
+ (unidata-gen-table): Change argument DEFAULT-VALUE to VAL-LIST.
+ Always store the encoded value.
+ (unidata-gen-table-symbol): New args DEFAULT-VALUE and VAL-LIST.
+ Set the 1st and the 2nd extra slots to index numbers for C
+ functions.
+ (unidata-gen-table-integer): Likewise.
+ (unidata-gen-table-numeric): Likewise.
+ (unidata-gen-table-name): New arg IGNORE.
+ (unidata-gen-table-decomposition): Likewise.
+ (unidata-describe-general-category): Add the case nil to the
+ description alist.
+ (unidata-gen-mirroring-list): New function.
+ (unidata-gen-files): New arg DATA-DIR. Adjusted for the change of
+ unidata-prop-alist. Handle the case of storing multiple
+ char-tables in a file.
+
+ * unidata/Makefile.in (${DSTDIR}/charprop.el): New arg to
+ unidata-gen-files.
+
+2011-05-21 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-resolve): Suppress prompts about file-locals.
+
2011-03-07 Chong Yidong <cyd@stupidchicken.com>
* Version 23.3 released.
@@ -183,7 +227,7 @@
* unidata/BidiMirroring.txt: New file from
http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt.
- * unidata/Makefile.in: (../../src/bidimirror.h): New target.
+ * unidata/Makefile.in (../../src/bidimirror.h): New target.
(all): Depend on ../../src/biditype.h and ../../src/bidimirror.h.
* unidata/makefile.w32-in (../../src/bidimirror.h): New target.
@@ -232,7 +276,7 @@
* quick-install-emacs: Use more portable shell syntax.
- * quick-install-emacs: (AVOID): Be more picky about files we avoid
+ * quick-install-emacs (AVOID): Be more picky about files we avoid
installing.
2010-02-14 Juanma Barranquero <lekktu@gmail.com>
diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index 33cbae22a6c..583f0d88866 100644
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -146,7 +146,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 (find-file-noselect file)
+ (with-current-buffer (let ((enable-local-variables :safe))
+ (find-file-noselect file))
(if (buffer-modified-p)
(error "Unsaved changes in %s" (current-buffer)))
(save-excursion
diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el
index 59969c3df28..9ac08bef724 100644
--- a/admin/charsets/mule-charsets.el
+++ b/admin/charsets/mule-charsets.el
@@ -1,4 +1,4 @@
-;; mule-charsets.el -- Generate Mule-orignal charset maps.
+;; mule-charsets.el -- Generate Mule-original charset maps.
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker
index f2805eae443..04721e4cec3 100644
--- a/admin/notes/bugtracker
+++ b/admin/notes/bugtracker
@@ -63,13 +63,16 @@ quiet@debbugs.gnu.org.
** How do I reply to an existing bug report?
Reply to 123@debbugs.gnu.org, replacing 123 with the number
of the bug you are interested in. NB this only sends mail to the
-bug-list, it does NOT (?) send a CC to the original bug submitter.
+bug-list, it does NOT send a CC to the original bug submitter.
So you need to explicitly CC him/her (and anyone else you like).
+(This works the same way as all the Emacs mailing lists. We generally
+don't assume anyone who posts to a list is subscribed to it, so we
+cc everyone on replies.)
(Many people think the submitter SHOULD be automatically subscribed
to subsequent discussion, but this does not seem to be implemented.
-See http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=37078)
-See also http://debbugs.gnu.org/5439
+See http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=37078
+See also http://debbugs.gnu.org/5439 )
Do NOT send a separate copy to the bug list address, since this may
generate a new report. The only time to send mail to the bug list
@@ -85,9 +88,9 @@ The "owner@debbugs.gnu.org" entry is there because it appears in the
"Resent-To" header. For a long time Rmail erroneously included such
headers in replies. If you correspond with an Rmail user on a bug,
these addresses may end up in the Cc. Mailing to them does nothing
-but create duplicates and errors. (It is possible you might want to
-have a dialog with the owner address, outside of normal bug
-reporting.)
+but create duplicates and errors. (It is possible, but unlikely, that
+you might want to have a dialog with the owner address, outside of
+normal bug reporting.)
** When reporting a bug, to send a Cc to another address
(e.g. bug-cc-mode@gnu.org), do NOT just use a Cc: header.
diff --git a/admin/notes/bzr b/admin/notes/bzr
index f4907063d0b..2fdbc2854f8 100644
--- a/admin/notes/bzr
+++ b/admin/notes/bzr
@@ -76,9 +76,8 @@ a similar way with unbound ones.
(this will be included by default in bzr 2.4 onwards):
cd ~/.bazaar/plugins
-# The following is an improved version of: lp:bzr-changelog-merge
-bzr branch lp:~spiv/bzr-changelog-merge/non-head-edits-723968
-mv bzr-changelog-merge changelog_merge
+bzr branch http://bazaar.launchpad.net/~spiv/bzr-changelog-merge/trunk
+mv trunk changelog_merge
This should make merging ChangeLogs smoother. It merges new entries
to the top of the file, rather than trying to fit them in mid-way
@@ -180,3 +179,24 @@ where revision N+1 is the one where file was removed.
You could also try `bzr add --file-ids-from', if you have a copy of
another branch where file still exists.
+
+* Loggerhead
+
+Loggerhead is the bzr tool for viewing a repository over http (similar
+to ViewVC). The central version is at http://bzr.savannah.gnu.org/lh/emacs,
+but if you just like the way this interface presents data, then if
+you have your own copy of the repository, you can operate your own
+Loggerhead server in stand-alone mode, and so help to reduce the load
+on Savannah:
+
+ bzr branch lp:loggerhead ~/.bazaar/plugins/loggerhead
+ cd /path/to/emacs/bzr
+ bzr serve --http
+
+You may need to install some Python dependencies to get this command to work.
+For example, on RHEL6 I needed:
+
+ yum install python-paste python-simplejson
+ yum --enablerepo=epel install python-simpletal
+
+Then point your web-browser to http://127.0.0.1:8080/ .
diff --git a/admin/notes/exit-value b/admin/notes/exit-value
index e59bb614b9b..cad6862c8aa 100644
--- a/admin/notes/exit-value
+++ b/admin/notes/exit-value
@@ -10,7 +10,7 @@ different dispatch model that is not explained further here).
From the point of view of the program, nowadays stdlib.h on both type of
systems provides macros `EXIT_SUCCESS' and `EXIT_FAILURE' that should DTRT.
-NB: The numerical values of these macros DO NOT need to fulfill the the exit
+NB: The numerical values of these macros DO NOT need to fulfill the exit
value requirements outlined in the first paragraph! That is the job of the
`exit' function. Thus, this kind of construct shows misunderstanding:
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index 04f2f1d4380..e1fe247631f 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -33,9 +33,10 @@ unidata.txt: UnicodeData.txt
${DSTDIR}/charprop.el: unidata-gen.elc unidata.txt
ELC=`/bin/pwd`/unidata-gen.elc; \
- DATA=`/bin/pwd`/unidata.txt; \
+ DATADIR=`/bin/pwd`; \
+ DATA=unidata.txt; \
cd ${DSTDIR}; \
- ${RUNEMACS} -batch --load $${ELC} -f unidata-gen-files $${DATA}
+ ${RUNEMACS} -batch --load $${ELC} -f unidata-gen-files $${DATADIR} $${DATA}
../../src/biditype.h: UnicodeData.txt
gawk -F";" -f biditype.awk $< > $@
diff --git a/admin/unidata/makefile.w32-in b/admin/unidata/makefile.w32-in
index 1f9f276a35c..6a877e0c1d0 100644
--- a/admin/unidata/makefile.w32-in
+++ b/admin/unidata/makefile.w32-in
@@ -41,12 +41,13 @@ unidata.txt: UnicodeData.txt
charprop-SH: unidata-gen.elc unidata.txt
ELC=$(CURDIR)/unidata-gen.elc; \
- DATA=$(CURDIR)/unidata.txt; \
+ DATADIR=$(CURDIR); \
+ DATA=unidata.txt; \
cd $(DSTDIR); \
- $(RUNEMACS) --load $${ELC} -f unidata-gen-files $${DATA}
+ $(RUNEMACS) --load $${ELC} -f unidata-gen-files $${DATADIR} $${DATA}
charprop-CMD: unidata-gen.elc unidata.txt
- $(RUNEMACS) --eval $(ARGQUOTE)(cd $(DQUOTE)$(DSTDIR)$(DQUOTE))$(ARGQUOTE) --load $(CURDIR)/unidata-gen.elc -f unidata-gen-files $(CURDIR)/unidata.txt
+ $(RUNEMACS) --eval $(ARGQUOTE)(cd $(DQUOTE)$(DSTDIR)$(DQUOTE))$(ARGQUOTE) --load $(CURDIR)/unidata-gen.elc -f unidata-gen-files $(CURDIR) unidata.txt
${DSTDIR}/charprop.el: charprop-$(SHELLTYPE)
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 9f898668526..ab1dcd134ac 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -33,24 +33,25 @@
;;
;; charprop.el
;; It contains a series of forms of this format:
-;; (char-code-property-register PROP FILE)
+;; (define-char-code-property PROP FILE)
;; where PROP is a symbol representing a character property
-;; (name, generic-category, etc), and FILE is a name of one of
+;; (name, general-category, etc), and FILE is a name of one of
;; the following files.
;;
;; uni-name.el, uni-category.el, uni-combining.el, uni-bidi.el,
;; uni-decomposition.el, uni-decimal.el, uni-digit.el, uni-numeric.el,
;; uni-mirrored.el, uni-old-name.el, uni-comment.el, uni-uppercase.el,
;; uni-lowercase.el, uni-titlecase.el
-;; They each contain a single form of this format:
-;; (char-code-property-register PROP CHAR-TABLE)
+;; They contain one or more forms of this format:
+;; (define-char-code-property PROP CHAR-TABLE)
;; where PROP is the same as above, and CHAR-TABLE is a
;; char-table containing property values in a compressed format.
;;
;; When they are installed in .../lisp/international/, the file
;; "charprop.el" is preloaded in loadup.el. The other files are
-;; automatically loaded when the functions `get-char-code-property'
-;; and `put-char-code-property' are called.
+;; automatically loaded when the Lisp functions
+;; `get-char-code-property' and `put-char-code-property', and C
+;; function uniprop_table are called.
;;
;; FORMAT OF A CHAR TABLE
;;
@@ -62,17 +63,22 @@
;; data in a char-table as below.
;;
;; If succeeding 128*N characters have the same property value, we
-;; store that value for them. Otherwise, compress values for
-;; succeeding 128 characters into a single string and store it as a
-;; value for those characters. The way of compression depends on a
-;; property. See the section "SIMPLE TABLE", "RUN-LENGTH TABLE",
-;; and "WORD-LIST TABLE".
-
-;; The char table has four extra slots:
+;; store that value (or the encoded one) for them. Otherwise,
+;; compress values (or the encoded ones) for succeeding 128
+;; characters into a single string and store it for those
+;; characters. The way of compression depends on a property. See
+;; the section "SIMPLE TABLE", "RUN-LENGTH TABLE", and "WORD-LIST
+;; TABLE".
+
+;; The char table has five extra slots:
;; 1st: property symbol
-;; 2nd: function to call to get a property value
-;; 3nd: function to call to put a property value
-;; 4th: function to call to get a description of a property value
+;; 2nd: function to call to get a property value,
+;; or an index number of C function to decode the value,
+;; or nil if the value can be directly got from the table.
+;; 3nd: function to call to put a property value,
+;; or an index number of C function to encode the value,
+;; or nil if the value can be directly stored in the table.
+;; 4th: function to call to get a description of a property value, or nil
;; 5th: data referred by the above functions
;; List of elements of this form:
@@ -82,6 +88,11 @@
(defvar unidata-list nil)
+;; Name of the directory containing files of Unicode Character
+;; Database.
+
+(defvar unidata-dir nil)
+
(defun unidata-setup-list (unidata-text-file)
(let* ((table (list nil))
(tail table)
@@ -90,6 +101,7 @@
("^<.*Surrogate" . nil)
("^<.*Private Use" . PRIVATE\ USE)))
val char name)
+ (setq unidata-text-file (expand-file-name unidata-text-file unidata-dir))
(or (file-readable-p unidata-text-file)
(error "File not readable: %s" unidata-text-file))
(with-temp-buffer
@@ -134,12 +146,17 @@
(setq unidata-list (cdr table))))
;; Alist of this form:
-;; (PROP INDEX GENERATOR FILENAME)
+;; (PROP INDEX GENERATOR FILENAME DOCSTRING DESCRIBER VAL-LIST)
;; PROP: character property
-;; INDEX: index to each element of unidata-list for PROP
+;; INDEX: index to each element of unidata-list for PROP.
+;; It may be a function that generates an alist of character codes
+;; vs. the corresponding property values.
;; GENERATOR: function to generate a char-table
;; FILENAME: filename to store the char-table
+;; DOCSTRING: docstring for the property
;; DESCRIBER: function to call to get a description string of property value
+;; DEFAULT: the default value of the property
+;; VAL-LIST: list of specially ordered property values
(defconst unidata-prop-alist
'((name
@@ -152,7 +169,12 @@ Property value is a string.")
Property value is one of the following symbols:
Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn"
- unidata-describe-general-category)
+ unidata-describe-general-category
+ nil
+ ;; The order of elements must be in sync with unicode_category_t
+ ;; in src/character.h.
+ (Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po
+ Sm Sc Sk So Zs Zl Zp Cc Cf Cs Co Cn))
(canonical-combining-class
3 unidata-gen-table-integer "uni-combining.el"
"Unicode canonical combining class.
@@ -164,7 +186,11 @@ Property value is an integer."
Property value is one of the following symbols:
L, LRE, LRO, R, AL, RLE, RLO, PDF, EN, ES, ET,
AN, CS, NSM, BN, B, S, WS, ON"
- unidata-describe-bidi-class)
+ unidata-describe-bidi-class
+ L
+ ;; The order of elements must be in sync with bidi_type_t in
+ ;; src/dispextern.h.
+ (L R EN AN BN B AL LRE LRO RLE RLO PDF ES ET CS NSM S WS ON))
(decomposition
5 unidata-gen-table-decomposition "uni-decomposition.el"
"Unicode decomposition mapping.
@@ -188,7 +214,7 @@ Property value is an integer or a floating point.")
(mirrored
9 unidata-gen-table-symbol "uni-mirrored.el"
"Unicode bidi mirrored flag.
-Property value is a symbol `Y' or `N'.")
+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.
@@ -211,7 +237,12 @@ Property value is a character."
14 unidata-gen-table-character "uni-titlecase.el"
"Unicode simple titlecase mapping.
Property value is a character."
- string)))
+ string)
+ (mirroring
+ unidata-gen-mirroring-list unidata-gen-table-character "uni-mirrored.el"
+ "Unicode bidi-mirroring characters.
+Property value is a character that has the corresponding mirroring image,
+or nil for non-mirrored character.")))
;; Functions to access the above data.
(defsubst unidata-prop-index (prop) (nth 1 (assq prop unidata-prop-alist)))
@@ -219,6 +250,8 @@ Property value is a character."
(defsubst unidata-prop-file (prop) (nth 3 (assq prop unidata-prop-alist)))
(defsubst unidata-prop-docstring (prop) (nth 4 (assq prop unidata-prop-alist)))
(defsubst unidata-prop-describer (prop) (nth 5 (assq prop unidata-prop-alist)))
+(defsubst unidata-prop-default (prop) (nth 6 (assq prop unidata-prop-alist)))
+(defsubst unidata-prop-val-list (prop) (nth 7 (assq prop unidata-prop-alist)))
;; SIMPLE TABLE
@@ -227,52 +260,34 @@ Property value is a character."
;; values of succeeding character codes are usually different, we use
;; a char-table described here to store such values.
;;
-;; If succeeding 128 characters has no property, a char-table has the
-;; symbol t for them. Otherwise a char-table has a string of the
-;; following format for them.
+;; A char-table divides character code space (#x0..#x3FFFFF) into
+;; #x8000 blocks (each block contains 128 characters).
+
+;; If all characters of a block have no property, a char-table has the
+;; symbol nil for that block. Otherwise a char-table has a string of
+;; the following format for it.
;;
-;; The first character of the string is FIRST-INDEX.
-;; The Nth (N > 0) character of the string is a property value of the
-;; character (BLOCK-HEAD + FIRST-INDEX + N - 1), where BLOCK-HEAD is
-;; the first of the characters in the block.
+;; The first character of the string is ?\001.
+;; The second character of the string is FIRST-INDEX.
+;; The Nth (N > 1) character of the string is a property value of the
+;; character (BLOCK-HEAD + FIRST-INDEX + N - 2), where BLOCK-HEAD is
+;; the first character of the block.
;;
-;; The 4th extra slot of a char-table is nil.
-
-(defun unidata-get-character (char val table)
- (cond
- ((characterp val)
- val)
+;; This kind of char-table has these extra slots:
+;; 1st: the property symbol
+;; 2nd: nil
+;; 3rd: 0 (corresponding to uniprop_encode_character in chartab.c)
+;; 4th to 5th: nil
- ((stringp val)
- (let* ((len (length val))
- (block-head (lsh (lsh char -7) 7))
- (vec (make-vector 128 nil))
- (first-index (aref val 0)))
- (dotimes (i (1- len))
- (let ((elt (aref val (1+ i))))
- (if (> elt 0)
- (aset vec (+ first-index i) elt))))
- (dotimes (i 128)
- (aset table (+ block-head i) (aref vec i)))
- (aref vec (- char block-head))))))
-
-(defun unidata-put-character (char val table)
- (or (characterp val)
- (not val)
- (error "Not a character nor nil: %S" val))
- (let ((current-val (aref table char)))
- (unless (eq current-val val)
- (if (stringp current-val)
- (funcall (char-table-extra-slot table 1) char current-val table))
- (aset table char val))))
-
-(defun unidata-gen-table-character (prop)
+(defun unidata-gen-table-character (prop &rest ignore)
(let ((table (make-char-table 'char-code-property-table))
(prop-idx (unidata-prop-index prop))
(vec (make-vector 128 0))
(tail unidata-list)
elt range val idx slot)
- (set-char-table-range table (cons 0 (max-char)) t)
+ (if (functionp prop-idx)
+ (setq tail (funcall prop-idx)
+ prop-idx 1))
(while tail
(setq elt (car tail) tail (cdr tail))
(setq range (car elt)
@@ -301,7 +316,7 @@ Property value is a character."
(setq first-index last-index)))
(setq tail (cdr tail)))
(when first-index
- (let ((str (string first-index))
+ (let ((str (string 1 first-index))
c)
(while (<= first-index last-index)
(setq str (format "%s%c" str (or (aref vec first-index) 0))
@@ -309,184 +324,78 @@ Property value is a character."
(set-char-table-range table (cons start limit) str))))))
(set-char-table-extra-slot table 0 prop)
- (byte-compile 'unidata-get-character)
- (byte-compile 'unidata-put-character)
- (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-character))
- (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-character))
-
+ (set-char-table-extra-slot table 2 0)
table))
;; RUN-LENGTH TABLE
;;
-;; If the type of character property value is symbol, integer,
-;; boolean, or character, we use a char-table described here to store
-;; the values.
+;; If many characters of successive character codes have the same
+;; property value, we use a char-table described here to store the
+;; values.
;;
-;; The 4th extra slot is a vector of property values (VAL-TABLE), and
-;; values for succeeding 128 characters are encoded into this
-;; character sequence:
+;; At first, instead of a value itself, we store an index number to
+;; the VAL-TABLE (5th extra slot) in the table. We call that index
+;; number as VAL-CODE here after.
+;;
+;; A char-table divides character code space (#x0..#x3FFFFF) into
+;; #x8000 blocks (each block contains 128 characters).
+;;
+;; If all characters of a block have the same value, a char-table has
+;; VAL-CODE for that block. Otherwise a char-table has a string of
+;; the following format for that block.
+;;
+;; The first character of the string is ?\002.
+;; The following characters has this form:
;; ( VAL-CODE RUN-LENGTH ? ) +
;; where:
-;; VAL-CODE (0..127):
-;; (VAL-CODE - 1) is an index into VAL-TABLE.
-;; The value 0 means no-value.
+;; VAL-CODE (0..127): index into VAL-TABLE.
;; RUN-LENGTH (130..255):
;; (RUN-LENGTH - 128) specifies how many characters have the same
;; value. If omitted, it means 1.
-
-
-;; Return a symbol-type character property value of CHAR. VAL is the
-;; current value of (aref TABLE CHAR).
-
-(defun unidata-get-symbol (char val table)
- (let ((val-table (char-table-extra-slot table 4)))
- (cond ((symbolp val)
- val)
- ((stringp val)
- (let ((first-char (lsh (lsh char -7) 7))
- (str val)
- (len (length val))
- (idx 0)
- this-val count)
- (set-char-table-range table (cons first-char (+ first-char 127))
- nil)
- (while (< idx len)
- (setq val (aref str idx) idx (1+ idx)
- count (if (< idx len) (aref str idx) 1))
- (setq val (and (> val 0) (aref val-table (1- val)))
- count (if (< count 128)
- 1
- (prog1 (- count 128) (setq idx (1+ idx)))))
- (dotimes (i count)
- (if val
- (aset table first-char val))
- (if (= first-char char)
- (setq this-val val))
- (setq first-char (1+ first-char))))
- this-val))
- ((> val 0)
- (aref val-table (1- val))))))
-
-;; Return a integer-type character property value of CHAR. VAL is the
-;; current value of (aref TABLE CHAR).
-
-(defun unidata-get-integer (char val table)
- (let ((val-table (char-table-extra-slot table 4)))
- (cond ((integerp val)
- val)
- ((stringp val)
- (let ((first-char (lsh (lsh char -7) 7))
- (str val)
- (len (length val))
- (idx 0)
- this-val count)
- (while (< idx len)
- (setq val (aref str idx) idx (1+ idx)
- count (if (< idx len) (aref str idx) 1))
- (setq val (and (> val 0) (aref val-table (1- val)))
- count (if (< count 128)
- 1
- (prog1 (- count 128) (setq idx (1+ idx)))))
- (dotimes (i count)
- (aset table first-char val)
- (if (= first-char char)
- (setq this-val val))
- (setq first-char (1+ first-char))))
- this-val)))))
-
-;; Return a numeric-type (integer or float) character property value
-;; of CHAR. VAL is the current value of (aref TABLE CHAR).
-
-(defun unidata-get-numeric (char val table)
- (cond
- ((numberp val)
- val)
- ((stringp val)
- (let ((val-table (char-table-extra-slot table 4))
- (first-char (lsh (lsh char -7) 7))
- (str val)
- (len (length val))
- (idx 0)
- this-val count)
- (while (< idx len)
- (setq val (aref str idx) idx (1+ idx)
- count (if (< idx len) (aref str idx) 1))
- (setq val (and (> val 0) (aref val-table (1- val)))
- count (if (< count 128)
- 1
- (prog1 (- count 128) (setq idx (1+ idx)))))
- (dotimes (i count)
- (aset table first-char val)
- (if (= first-char char)
- (setq this-val val))
- (setq first-char (1+ first-char))))
- this-val))))
-
-;; Store VAL (symbol) as a character property value of CHAR in TABLE.
-
-(defun unidata-put-symbol (char val table)
- (or (symbolp val)
- (error "Not a symbol: %S" val))
- (let ((current-val (aref table char)))
- (unless (eq current-val val)
- (if (stringp current-val)
- (funcall (char-table-extra-slot table 1) char current-val table))
- (aset table char val))))
-
-;; Store VAL (integer) as a character property value of CHAR in TABLE.
-
-(defun unidata-put-integer (char val table)
- (or (integerp val)
- (not val)
- (error "Not an integer nor nil: %S" val))
- (let ((current-val (aref table char)))
- (unless (eq current-val val)
- (if (stringp current-val)
- (funcall (char-table-extra-slot table 1) char current-val table))
- (aset table char val))))
-
-;; Store VAL (integer or float) as a character property value of CHAR
-;; in TABLE.
-
-(defun unidata-put-numeric (char val table)
- (or (numberp val)
- (not val)
- (error "Not a number nor nil: %S" val))
- (let ((current-val (aref table char)))
- (unless (equal current-val val)
- (if (stringp current-val)
- (funcall (char-table-extra-slot table 1) char current-val table))
- (aset table char val))))
+;;
+;; This kind of char-table has these extra slots:
+;; 1st: the property symbol
+;; 2nd: 0 (corresponding to uniprop_decode_value in chartab.c)
+;; 3rd: 1..3 (corresponding to uniprop_encode_xxx in chartab.c)
+;; 4th: function or nil
+;; 5th: VAL-TABLE
;; Encode the character property value VAL into an integer value by
;; VAL-LIST. By side effect, VAL-LIST is modified.
;; VAL-LIST has this form:
-;; (t (VAL1 . VAL-CODE1) (VAL2 . VAL-CODE2) ...)
-;; If VAL is one of VALn, just return VAL-CODEn. Otherwise,
-;; VAL-LIST is modified to this:
-;; (t (VAL . (1+ VAL-CODE1)) (VAL1 . VAL-CODE1) (VAL2 . VAL-CODE2) ...)
+;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ...)
+;; If VAL is one of VALn, just return n.
+;; Otherwise, VAL-LIST is modified to this:
+;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ... (VAL . n+1))
(defun unidata-encode-val (val-list val)
(let ((slot (assoc val val-list))
val-code)
(if slot
(cdr slot)
- (setq val-code (if (cdr val-list) (1+ (cdr (nth 1 val-list))) 1))
- (setcdr val-list (cons (cons val val-code) (cdr val-list)))
+ (setq val-code (length val-list))
+ (nconc val-list (list (cons val val-code)))
val-code)))
;; Generate a char-table for the character property PROP.
-(defun unidata-gen-table (prop val-func default-value)
+(defun unidata-gen-table (prop val-func default-value val-list)
(let ((table (make-char-table 'char-code-property-table))
(prop-idx (unidata-prop-index prop))
- (val-list (list t))
(vec (make-vector 128 0))
tail elt range val val-code idx slot
prev-range-data)
- (set-char-table-range table (cons 0 (max-char)) default-value)
+ (setq val-list (cons nil (copy-sequence val-list)))
+ (setq tail val-list val-code 0)
+ ;; Convert (nil A B ...) to ((nil . 0) (A . 1) (B . 2) ...)
+ (while tail
+ (setcar tail (cons (car tail) val-code))
+ (setq tail (cdr tail) val-code (1+ val-code)))
+ (setq default-value (unidata-encode-val val-list default-value))
+ (set-char-table-range table t default-value)
+ (set-char-table-range table nil default-value)
(setq tail unidata-list)
(while tail
(setq elt (car tail) tail (cdr tail))
@@ -495,7 +404,7 @@ Property value is a character."
(setq val-code (if val (unidata-encode-val val-list val)))
(if (consp range)
(when val-code
- (set-char-table-range table range val)
+ (set-char-table-range table range val-code)
(let ((from (car range)) (to (cdr range)))
;; If RANGE doesn't end at the char-table boundary (each
;; 128 characters), we may have to carry over the data
@@ -534,7 +443,7 @@ Property value is a character."
(if val-code
(aset vec (- range start) val-code))
(setq tail (cdr tail)))
- (setq str "" val-code -1 count 0)
+ (setq str "\002" val-code -1 count 0)
(mapc #'(lambda (x)
(if (= val-code x)
(setq count (1+ count))
@@ -549,7 +458,7 @@ Property value is a character."
vec)
(if (= count 128)
(if val
- (set-char-table-range table (cons start limit) val))
+ (set-char-table-range table (cons start limit) val-code))
(if (= val-code 0)
(set-char-table-range table (cons start limit) str)
(if (> count 2)
@@ -559,34 +468,29 @@ Property value is a character."
(setq str (concat str (string val-code)))))
(set-char-table-range table (cons start limit) str))))))
- (setq val-list (nreverse (cdr val-list)))
(set-char-table-extra-slot table 0 prop)
(set-char-table-extra-slot table 4 (vconcat (mapcar 'car val-list)))
table))
-(defun unidata-gen-table-symbol (prop)
+(defun unidata-gen-table-symbol (prop default-value val-list)
(let ((table (unidata-gen-table prop
#'(lambda (x) (and (> (length x) 0)
(intern x)))
- 0)))
- (byte-compile 'unidata-get-symbol)
- (byte-compile 'unidata-put-symbol)
- (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-symbol))
- (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-symbol))
+ default-value val-list)))
+ (set-char-table-extra-slot table 1 0)
+ (set-char-table-extra-slot table 2 1)
table))
-(defun unidata-gen-table-integer (prop)
+(defun unidata-gen-table-integer (prop default-value val-list)
(let ((table (unidata-gen-table prop
#'(lambda (x) (and (> (length x) 0)
(string-to-number x)))
- t)))
- (byte-compile 'unidata-get-integer)
- (byte-compile 'unidata-put-integer)
- (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-integer))
- (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-integer))
+ default-value val-list)))
+ (set-char-table-extra-slot table 1 0)
+ (set-char-table-extra-slot table 2 1)
table))
-(defun unidata-gen-table-numeric (prop)
+(defun unidata-gen-table-numeric (prop default-value val-list)
(let ((table (unidata-gen-table prop
#'(lambda (x)
(if (string-match "/" x)
@@ -595,11 +499,9 @@ Property value is a character."
(substring x (match-end 0))))
(if (> (length x) 0)
(string-to-number x))))
- t)))
- (byte-compile 'unidata-get-numeric)
- (byte-compile 'unidata-put-numeric)
- (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-numeric))
- (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-numeric))
+ default-value val-list)))
+ (set-char-table-extra-slot table 1 0)
+ (set-char-table-extra-slot table 2 2)
table))
@@ -892,7 +794,6 @@ Property value is a character."
word-table
block-list block-word-table block-end
tail elt range val idx slot)
- (set-char-table-range table (cons 0 (max-char)) 0)
(setq tail unidata-list)
(setq block-end -1)
(while tail
@@ -1025,7 +926,7 @@ Property value is a character."
idx (1+ i)))))
(nreverse (cons (intern (substring str idx)) l))))))
-(defun unidata-gen-table-name (prop)
+(defun unidata-gen-table-name (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-name))
(word-tables (char-table-extra-slot table 4)))
(byte-compile 'unidata-get-name)
@@ -1064,7 +965,7 @@ Property value is a character."
(nreverse l)))))
-(defun unidata-gen-table-decomposition (prop)
+(defun unidata-gen-table-decomposition (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-decomposition))
(word-tables (char-table-extra-slot table 4)))
(byte-compile 'unidata-get-decomposition)
@@ -1080,7 +981,8 @@ Property value is a character."
(defun unidata-describe-general-category (val)
(cdr (assq val
- '((Lu . "Letter, Uppercase")
+ '((nil . "Uknown")
+ (Lu . "Letter, Uppercase")
(Ll . "Letter, Lowercase")
(Lt . "Letter, Titlecase")
(Lm . "Letter, Modifier")
@@ -1171,6 +1073,19 @@ Property value is a character."
(string ?'))))
val " "))
+(defun unidata-gen-mirroring-list ()
+ (let ((head (list nil))
+ tail)
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name "BidiMirroring.txt" unidata-dir))
+ (goto-char (point-min))
+ (setq tail head)
+ (while (re-search-forward "^\\([0-9A-F]+\\);\\s +\\([0-9A-F]+\\)" nil t)
+ (let ((char (string-to-number (match-string 1) 16))
+ (mirror (match-string 2)))
+ (setq tail (setcdr tail (list (list char mirror)))))))
+ (cdr head)))
+
;; Verify if we can retrieve correct values from the generated
;; char-tables.
@@ -1212,13 +1127,21 @@ Property value is a character."
;; The entry function. It generates files described in the header
;; comment of this file.
-(defun unidata-gen-files (&optional unidata-text-file)
- (or unidata-text-file
- (setq unidata-text-file (car command-line-args-left)
+(defun unidata-gen-files (&optional data-dir unidata-text-file)
+ (or data-dir
+ (setq data-dir (car command-line-args-left)
+ command-line-args-left (cdr command-line-args-left)
+ unidata-text-file (car command-line-args-left)
command-line-args-left (cdr command-line-args-left)))
- (unidata-setup-list unidata-text-file)
(let ((coding-system-for-write 'utf-8-unix)
- (charprop-file "charprop.el"))
+ (charprop-file "charprop.el")
+ (unidata-dir data-dir))
+ (dolist (elt unidata-prop-alist)
+ (let* ((prop (car elt))
+ (file (unidata-prop-file prop)))
+ (if (file-exists-p file)
+ (delete-file file))))
+ (unidata-setup-list unidata-text-file)
(with-temp-file charprop-file
(insert ";; Automatically generated by unidata-gen.el.\n")
(dolist (elt unidata-prop-alist)
@@ -1227,31 +1150,41 @@ Property value is a character."
(file (unidata-prop-file prop))
(docstring (unidata-prop-docstring prop))
(describer (unidata-prop-describer prop))
+ (default-value (unidata-prop-default prop))
+ (val-list (unidata-prop-val-list prop))
table)
;; Filename in this comment line is extracted by sed in
;; Makefile.
(insert (format ";; FILE: %s\n" file))
(insert (format "(define-char-code-property '%S %S\n %S)\n"
prop file docstring))
- (with-temp-file file
+ (with-temp-buffer
(message "Generating %s..." file)
- (setq table (funcall generator prop))
+ (when (file-exists-p file)
+ (insert-file-contents file)
+ (goto-char (point-max))
+ (search-backward ";; Local Variables:"))
+ (setq table (funcall generator prop default-value val-list))
(when describer
(unless (subrp (symbol-function describer))
(byte-compile describer)
(setq describer (symbol-function describer)))
(set-char-table-extra-slot table 3 describer))
- (insert ";; Copyright (C) 1991-2009 Unicode, Inc.
-;; This file was generated from the Unicode data file at
-;; http://www.unicode.org/Public/UNIDATA/UnicodeData.txt.
-;; See lisp/international/README for the copyright and permission notice.\n"
- (format "(define-char-code-property '%S %S %S)\n"
- prop table docstring)
- ";; Local Variables:\n"
- ";; coding: utf-8\n"
- ";; no-byte-compile: t\n"
- ";; End:\n\n"
- (format ";; %s ends here\n" file)))))
+ (if (bobp)
+ (insert ";; Copyright (C) 1991-2009 Unicode, Inc.
+;; This file was generated from the Unicode data files at
+;; http://www.unicode.org/Public/UNIDATA/.
+;; See lisp/international/README for the copyright and permission notice.\n"))
+ (insert (format "(define-char-code-property '%S %S %S)\n"
+ prop table docstring))
+ (if (eobp)
+ (insert ";; Local Variables:\n"
+ ";; coding: utf-8\n"
+ ";; no-byte-compile: t\n"
+ ";; End:\n\n"
+ (format ";; %s ends here\n" file)))
+ (write-file file)
+ (message "Generating %s...done" file))))
(message "Writing %s..." charprop-file)
(insert ";; Local Variables:\n"
";; coding: utf-8\n"
diff --git a/autogen/Makefile.in b/autogen/Makefile.in
index 16b2aeb92a0..3348d3a4c02 100644
--- a/autogen/Makefile.in
+++ b/autogen/Makefile.in
@@ -24,7 +24,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=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime 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=. --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
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
@@ -48,29 +48,34 @@ host_triplet = @host@
DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \
$(srcdir)/gnulib.mk COPYING
@gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE@am__append_1 = gettext.h
-@gl_GNULIB_ENABLED_verify_TRUE@am__append_2 = verify.h
subdir = lib
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \
- $(top_srcdir)/m4/c-strtod.m4 $(top_srcdir)/m4/extensions.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/gnulib-common.m4 \
$(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.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/readlink.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/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/strtoull.m4 \
- $(top_srcdir)/m4/strtoumax.m4 $(top_srcdir)/m4/symlink.m4 \
- $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/time_h.m4 \
- $(top_srcdir)/m4/time_r.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/multiarch.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/ssize_t.m4 $(top_srcdir)/m4/st_dm_mode.m4 \
+ $(top_srcdir)/m4/stat.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/time_h.m4 $(top_srcdir)/m4/time_r.m4 \
+ $(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \
+ $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.in
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
@@ -82,11 +87,13 @@ AR = ar
ARFLAGS = cru
libgnu_a_AR = $(AR) $(ARFLAGS)
am__DEPENDENCIES_1 =
-am__libgnu_a_SOURCES_DIST = allocator.c careadlinkat.c dtoastr.c \
- gettext.h ignore-value.h verify.h
+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__objects_1 =
am_libgnu_a_OBJECTS = allocator.$(OBJEXT) careadlinkat.$(OBJEXT) \
- dtoastr.$(OBJEXT) $(am__objects_1) $(am__objects_1)
+ md5.$(OBJEXT) sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \
+ dtoastr.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \
+ strftime.$(OBJEXT)
libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS)
depcomp = $(SHELL) $(top_srcdir)/depcomp
am__depfiles_maybe = depfiles
@@ -102,6 +109,7 @@ CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
ALLOCA = @ALLOCA@
+ALLOCA_H = @ALLOCA_H@
ALSA_CFLAGS = @ALSA_CFLAGS@
ALSA_LIBS = @ALSA_LIBS@
AMTAR = @AMTAR@
@@ -208,6 +216,7 @@ GNULIB_GETS = @GNULIB_GETS@
GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@
GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@
GNULIB_GRANTPT = @GNULIB_GRANTPT@
+GNULIB_GROUP_MEMBER = @GNULIB_GROUP_MEMBER@
GNULIB_IMAXABS = @GNULIB_IMAXABS@
GNULIB_IMAXDIV = @GNULIB_IMAXDIV@
GNULIB_LCHMOD = @GNULIB_LCHMOD@
@@ -239,6 +248,7 @@ GNULIB_POPEN = @GNULIB_POPEN@
GNULIB_PREAD = @GNULIB_PREAD@
GNULIB_PRINTF = @GNULIB_PRINTF@
GNULIB_PRINTF_POSIX = @GNULIB_PRINTF_POSIX@
+GNULIB_PTHREAD_SIGMASK = @GNULIB_PTHREAD_SIGMASK@
GNULIB_PTSNAME = @GNULIB_PTSNAME@
GNULIB_PUTC = @GNULIB_PUTC@
GNULIB_PUTCHAR = @GNULIB_PUTCHAR@
@@ -258,6 +268,9 @@ GNULIB_RMDIR = @GNULIB_RMDIR@
GNULIB_RPMATCH = @GNULIB_RPMATCH@
GNULIB_SCANF = @GNULIB_SCANF@
GNULIB_SETENV = @GNULIB_SETENV@
+GNULIB_SIGACTION = @GNULIB_SIGACTION@
+GNULIB_SIGNAL_H_SIGPIPE = @GNULIB_SIGNAL_H_SIGPIPE@
+GNULIB_SIGPROCMASK = @GNULIB_SIGPROCMASK@
GNULIB_SLEEP = @GNULIB_SLEEP@
GNULIB_SNPRINTF = @GNULIB_SNPRINTF@
GNULIB_SPRINTF_POSIX = @GNULIB_SPRINTF_POSIX@
@@ -301,6 +314,8 @@ GNULIB_WRITE = @GNULIB_WRITE@
GNULIB__EXIT = @GNULIB__EXIT@
GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@
GREP = @GREP@
+GSETTINGS_CFLAGS = @GSETTINGS_CFLAGS@
+GSETTINGS_LIBS = @GSETTINGS_LIBS@
GTK_CFLAGS = @GTK_CFLAGS@
GTK_LIBS = @GTK_LIBS@
GTK_OBJ = @GTK_OBJ@
@@ -354,6 +369,7 @@ HAVE_GETOPT_H = @HAVE_GETOPT_H@
HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@
HAVE_GETSUBOPT = @HAVE_GETSUBOPT@
HAVE_GRANTPT = @HAVE_GRANTPT@
+HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@
HAVE_INTTYPES_H = @HAVE_INTTYPES_H@
HAVE_LCHMOD = @HAVE_LCHMOD@
HAVE_LCHOWN = @HAVE_LCHOWN@
@@ -376,7 +392,9 @@ HAVE_NANOSLEEP = @HAVE_NANOSLEEP@
HAVE_OS_H = @HAVE_OS_H@
HAVE_PIPE = @HAVE_PIPE@
HAVE_PIPE2 = @HAVE_PIPE2@
+HAVE_POSIX_SIGNALBLOCKING = @HAVE_POSIX_SIGNALBLOCKING@
HAVE_PREAD = @HAVE_PREAD@
+HAVE_PTHREAD_SIGMASK = @HAVE_PTHREAD_SIGMASK@
HAVE_PTSNAME = @HAVE_PTSNAME@
HAVE_PWRITE = @HAVE_PWRITE@
HAVE_RANDOM_H = @HAVE_RANDOM_H@
@@ -387,9 +405,13 @@ HAVE_REALPATH = @HAVE_REALPATH@
HAVE_RENAMEAT = @HAVE_RENAMEAT@
HAVE_RPMATCH = @HAVE_RPMATCH@
HAVE_SETENV = @HAVE_SETENV@
+HAVE_SIGACTION = @HAVE_SIGACTION@
+HAVE_SIGHANDLER_T = @HAVE_SIGHANDLER_T@
+HAVE_SIGINFO_T = @HAVE_SIGINFO_T@
HAVE_SIGNED_SIG_ATOMIC_T = @HAVE_SIGNED_SIG_ATOMIC_T@
HAVE_SIGNED_WCHAR_T = @HAVE_SIGNED_WCHAR_T@
HAVE_SIGNED_WINT_T = @HAVE_SIGNED_WINT_T@
+HAVE_SIGSET_T = @HAVE_SIGSET_T@
HAVE_SLEEP = @HAVE_SLEEP@
HAVE_STDINT_H = @HAVE_STDINT_H@
HAVE_STRPTIME = @HAVE_STRPTIME@
@@ -397,6 +419,7 @@ HAVE_STRTOD = @HAVE_STRTOD@
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_SYMLINK = @HAVE_SYMLINK@
HAVE_SYMLINKAT = @HAVE_SYMLINKAT@
HAVE_SYS_BITYPES_H = @HAVE_SYS_BITYPES_H@
@@ -405,6 +428,7 @@ HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@
HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_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@
HAVE_UNISTD_H = @HAVE_UNISTD_H@
HAVE_UNLINKAT = @HAVE_UNLINKAT@
HAVE_UNLOCKPT = @HAVE_UNLOCKPT@
@@ -471,6 +495,7 @@ LIBXT_OTHER = @LIBXT_OTHER@
LIBX_OTHER = @LIBX_OTHER@
LIB_GCC = @LIB_GCC@
LIB_MATH = @LIB_MATH@
+LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
LIB_STANDARD = @LIB_STANDARD@
LTLIBINTL = @LTLIBINTL@
LTLIBOBJS = @LTLIBOBJS@
@@ -480,10 +505,10 @@ MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MKDEPDIR = @MKDEPDIR@
MKDIR_P = @MKDIR_P@
-MOUSE_SUPPORT = @MOUSE_SUPPORT@
M_FILE = @M_FILE@
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@
NEXT_AS_FIRST_DIRECTIVE_STDARG_H = @NEXT_AS_FIRST_DIRECTIVE_STDARG_H@
NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@
NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@
@@ -494,6 +519,7 @@ 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_GETOPT_H = @NEXT_GETOPT_H@
NEXT_INTTYPES_H = @NEXT_INTTYPES_H@
+NEXT_SIGNAL_H = @NEXT_SIGNAL_H@
NEXT_STDARG_H = @NEXT_STDARG_H@
NEXT_STDDEF_H = @NEXT_STDDEF_H@
NEXT_STDINT_H = @NEXT_STDINT_H@
@@ -504,7 +530,6 @@ NEXT_TIME_H = @NEXT_TIME_H@
NEXT_UNISTD_H = @NEXT_UNISTD_H@
NS_OBJ = @NS_OBJ@
NS_OBJC_OBJ = @NS_OBJC_OBJ@
-NS_SUPPORT = @NS_SUPPORT@
OBJEXT = @OBJEXT@
OLDXMENU = @OLDXMENU@
OLDXMENU_DEPS = @OLDXMENU_DEPS@
@@ -578,6 +603,7 @@ REPLACE_PERROR = @REPLACE_PERROR@
REPLACE_POPEN = @REPLACE_POPEN@
REPLACE_PREAD = @REPLACE_PREAD@
REPLACE_PRINTF = @REPLACE_PRINTF@
+REPLACE_PTHREAD_SIGMASK = @REPLACE_PTHREAD_SIGMASK@
REPLACE_PUTENV = @REPLACE_PUTENV@
REPLACE_PWRITE = @REPLACE_PWRITE@
REPLACE_READ = @REPLACE_READ@
@@ -615,6 +641,8 @@ REPLACE_WCTOMB = @REPLACE_WCTOMB@
REPLACE_WRITE = @REPLACE_WRITE@
RSVG_CFLAGS = @RSVG_CFLAGS@
RSVG_LIBS = @RSVG_LIBS@
+SETTINGS_CFLAGS = @SETTINGS_CFLAGS@
+SETTINGS_LIBS = @SETTINGS_LIBS@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@
@@ -625,13 +653,13 @@ STDBOOL_H = @STDBOOL_H@
STDDEF_H = @STDDEF_H@
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@
TOOLKIT_LIBW = @TOOLKIT_LIBW@
-TOOLTIP_SUPPORT = @TOOLTIP_SUPPORT@
UINT32_MAX_LT_UINTMAX_MAX = @UINT32_MAX_LT_UINTMAX_MAX@
UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@
UNEXEC_OBJ = @UNEXEC_OBJ@
@@ -641,7 +669,6 @@ VERSION = @VERSION@
VMLIMIT_OBJ = @VMLIMIT_OBJ@
WCHAR_T_SUFFIX = @WCHAR_T_SUFFIX@
WIDGET_OBJ = @WIDGET_OBJ@
-WINDOW_SUPPORT = @WINDOW_SUPPORT@
WINT_T_SUFFIX = @WINT_T_SUFFIX@
XFT_CFLAGS = @XFT_CFLAGS@
XFT_LIBS = @XFT_LIBS@
@@ -731,36 +758,41 @@ 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 = arg-nonnull.h c++defs.h $(GETOPT_H) inttypes.h \
- $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \
- stdlib.h sys/stat.h time.h unistd.h warn-on-use.h
-EXTRA_DIST = allocator.h $(top_srcdir)/./arg-nonnull.h \
- $(top_srcdir)/./c++defs.h careadlinkat.h md5.c md5.h dosname.h \
- ftoastr.c ftoastr.h filemode.c filemode.h getloadavg.c \
- getopt.c getopt.in.h getopt1.c getopt_int.h intprops.h \
- inttypes.in.h lstat.c mktime-internal.h mktime.c readlink.c \
- stat.c stdarg.in.h stdbool.in.h stddef.in.h stdint.in.h \
- stdio.in.h stdlib.in.h strftime.c strftime.h strtol.c \
- strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \
- sys_stat.in.h time.in.h time_r.c unistd.in.h \
+BUILT_SOURCES = $(ALLOCA_H) arg-nonnull.h c++defs.h $(GETOPT_H) \
+ inttypes.h signal.h $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) \
+ $(STDINT_H) stdio.h stdlib.h sys/stat.h time.h unistd.h \
+ warn-on-use.h
+EXTRA_DIST = alloca.in.h allocator.h $(top_srcdir)/./arg-nonnull.h \
+ $(top_srcdir)/./c++defs.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 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 \
$(top_srcdir)/./warn-on-use.h
MOSTLYCLEANDIRS = sys
-MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \
- c++defs.h c++defs.h-t getopt.h getopt.h-t inttypes.h \
- inttypes.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 warn-on-use.h warn-on-use.h-t
+MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t arg-nonnull.h \
+ arg-nonnull.h-t c++defs.h c++defs.h-t getopt.h getopt.h-t \
+ inttypes.h inttypes.h-t signal.h signal.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 warn-on-use.h \
+ warn-on-use.h-t
noinst_LIBRARIES = libgnu.a
DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src
-libgnu_a_SOURCES = allocator.c careadlinkat.c dtoastr.c \
- $(am__append_1) ignore-value.h $(am__append_2)
+libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c sha256.c \
+ sha512.c dtoastr.c filemode.c $(am__append_1) strftime.c
libgnu_a_LIBADD = $(gl_LIBOBJS)
libgnu_a_DEPENDENCIES = $(gl_LIBOBJS)
-EXTRA_libgnu_a_SOURCES = md5.c ftoastr.c filemode.c getloadavg.c \
- getopt.c getopt1.c lstat.c mktime.c readlink.c stat.c \
- strftime.c strtol.c strtoul.c strtoull.c strtoimax.c \
- strtoumax.c symlink.c time_r.c
+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
ARG_NONNULL_H = arg-nonnull.h
CXXDEFS_H = c++defs.h
WARN_ON_USE_H = warn-on-use.h
@@ -816,6 +848,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@
@@ -824,11 +857,17 @@ distclean-compile:
@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)/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.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@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtol.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoll.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoul.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoull.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoumax.Po@am__quote@
@@ -1049,6 +1088,17 @@ uninstall-am:
mostlyclean-generic mostlyclean-local pdf pdf-am ps ps-am tags \
uninstall uninstall-am
+
+# We need the following in order to create <alloca.h> when the system
+# doesn't have one that works with the given compiler.
+@GL_GENERATE_ALLOCA_H_TRUE@alloca.h: alloca.in.h $(top_builddir)/config.status
+@GL_GENERATE_ALLOCA_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
+@GL_GENERATE_ALLOCA_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+@GL_GENERATE_ALLOCA_H_TRUE@ cat $(srcdir)/alloca.in.h; \
+@GL_GENERATE_ALLOCA_H_TRUE@ } > $@-t && \
+@GL_GENERATE_ALLOCA_H_TRUE@ mv -f $@-t $@
+@GL_GENERATE_ALLOCA_H_FALSE@alloca.h: $(top_builddir)/config.status
+@GL_GENERATE_ALLOCA_H_FALSE@ rm -f $@
# The arg-nonnull.h that gets inserted into generated .h files is the same as
# build-aux/arg-nonnull.h, except that it has the copyright header cut off.
arg-nonnull.h: $(top_srcdir)/./arg-nonnull.h
@@ -1071,7 +1121,8 @@ c++defs.h: $(top_srcdir)/./c++defs.h
getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
- sed -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_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' \
@@ -1114,12 +1165,43 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_N
} > $@-t && \
mv $@-t $@
+# We need the following in order to create <signal.h> when the system
+# doesn't have a complete one.
+signal.h: signal.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_SIGNAL_H''@|$(NEXT_SIGNAL_H)|g' \
+ -e 's|@''GNULIB_PTHREAD_SIGMASK''@|$(GNULIB_PTHREAD_SIGMASK)|g' \
+ -e 's/@''GNULIB_SIGNAL_H_SIGPIPE''@/$(GNULIB_SIGNAL_H_SIGPIPE)/g' \
+ -e 's/@''GNULIB_SIGPROCMASK''@/$(GNULIB_SIGPROCMASK)/g' \
+ -e 's/@''GNULIB_SIGACTION''@/$(GNULIB_SIGACTION)/g' \
+ -e 's|@''HAVE_POSIX_SIGNALBLOCKING''@|$(HAVE_POSIX_SIGNALBLOCKING)|g' \
+ -e 's|@''HAVE_PTHREAD_SIGMASK''@|$(HAVE_PTHREAD_SIGMASK)|g' \
+ -e 's|@''HAVE_SIGSET_T''@|$(HAVE_SIGSET_T)|g' \
+ -e 's|@''HAVE_SIGINFO_T''@|$(HAVE_SIGINFO_T)|g' \
+ -e 's|@''HAVE_SIGACTION''@|$(HAVE_SIGACTION)|g' \
+ -e 's|@''HAVE_STRUCT_SIGACTION_SA_SIGACTION''@|$(HAVE_STRUCT_SIGACTION_SA_SIGACTION)|g' \
+ -e 's|@''HAVE_TYPE_VOLATILE_SIG_ATOMIC_T''@|$(HAVE_TYPE_VOLATILE_SIG_ATOMIC_T)|g' \
+ -e 's|@''HAVE_SIGHANDLER_T''@|$(HAVE_SIGHANDLER_T)|g' \
+ -e 's|@''REPLACE_PTHREAD_SIGMASK''@|$(REPLACE_PTHREAD_SIGMASK)|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)/signal.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# 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
@GL_GENERATE_STDARG_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
@GL_GENERATE_STDARG_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
-@GL_GENERATE_STDARG_H_TRUE@ sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+@GL_GENERATE_STDARG_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''NEXT_STDARG_H''@|$(NEXT_STDARG_H)|g' \
@@ -1145,7 +1227,8 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_N
@GL_GENERATE_STDDEF_H_TRUE@stddef.h: stddef.in.h $(top_builddir)/config.status
@GL_GENERATE_STDDEF_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
@GL_GENERATE_STDDEF_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
-@GL_GENERATE_STDDEF_H_TRUE@ sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+@GL_GENERATE_STDDEF_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \
@@ -1162,7 +1245,8 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_N
@GL_GENERATE_STDINT_H_TRUE@stdint.h: stdint.in.h $(top_builddir)/config.status
@GL_GENERATE_STDINT_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
@GL_GENERATE_STDINT_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
-@GL_GENERATE_STDINT_H_TRUE@ sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \
+@GL_GENERATE_STDINT_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \
@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
@@ -1199,62 +1283,63 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_N
stdio.h: stdio.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|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STDIO_H''@|$(NEXT_STDIO_H)|g' \
- -e 's|@''GNULIB_DPRINTF''@|$(GNULIB_DPRINTF)|g' \
- -e 's|@''GNULIB_FCLOSE''@|$(GNULIB_FCLOSE)|g' \
- -e 's|@''GNULIB_FFLUSH''@|$(GNULIB_FFLUSH)|g' \
- -e 's|@''GNULIB_FGETC''@|$(GNULIB_FGETC)|g' \
- -e 's|@''GNULIB_FGETS''@|$(GNULIB_FGETS)|g' \
- -e 's|@''GNULIB_FOPEN''@|$(GNULIB_FOPEN)|g' \
- -e 's|@''GNULIB_FPRINTF''@|$(GNULIB_FPRINTF)|g' \
- -e 's|@''GNULIB_FPRINTF_POSIX''@|$(GNULIB_FPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_FPURGE''@|$(GNULIB_FPURGE)|g' \
- -e 's|@''GNULIB_FPUTC''@|$(GNULIB_FPUTC)|g' \
- -e 's|@''GNULIB_FPUTS''@|$(GNULIB_FPUTS)|g' \
- -e 's|@''GNULIB_FREAD''@|$(GNULIB_FREAD)|g' \
- -e 's|@''GNULIB_FREOPEN''@|$(GNULIB_FREOPEN)|g' \
- -e 's|@''GNULIB_FSCANF''@|$(GNULIB_FSCANF)|g' \
- -e 's|@''GNULIB_FSEEK''@|$(GNULIB_FSEEK)|g' \
- -e 's|@''GNULIB_FSEEKO''@|$(GNULIB_FSEEKO)|g' \
- -e 's|@''GNULIB_FTELL''@|$(GNULIB_FTELL)|g' \
- -e 's|@''GNULIB_FTELLO''@|$(GNULIB_FTELLO)|g' \
- -e 's|@''GNULIB_FWRITE''@|$(GNULIB_FWRITE)|g' \
- -e 's|@''GNULIB_GETC''@|$(GNULIB_GETC)|g' \
- -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_PERROR''@|$(GNULIB_PERROR)|g' \
- -e 's|@''GNULIB_POPEN''@|$(GNULIB_POPEN)|g' \
- -e 's|@''GNULIB_PRINTF''@|$(GNULIB_PRINTF)|g' \
- -e 's|@''GNULIB_PRINTF_POSIX''@|$(GNULIB_PRINTF_POSIX)|g' \
- -e 's|@''GNULIB_PUTC''@|$(GNULIB_PUTC)|g' \
- -e 's|@''GNULIB_PUTCHAR''@|$(GNULIB_PUTCHAR)|g' \
- -e 's|@''GNULIB_PUTS''@|$(GNULIB_PUTS)|g' \
- -e 's|@''GNULIB_REMOVE''@|$(GNULIB_REMOVE)|g' \
- -e 's|@''GNULIB_RENAME''@|$(GNULIB_RENAME)|g' \
- -e 's|@''GNULIB_RENAMEAT''@|$(GNULIB_RENAMEAT)|g' \
- -e 's|@''GNULIB_SCANF''@|$(GNULIB_SCANF)|g' \
- -e 's|@''GNULIB_SNPRINTF''@|$(GNULIB_SNPRINTF)|g' \
- -e 's|@''GNULIB_SPRINTF_POSIX''@|$(GNULIB_SPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_STDIO_H_NONBLOCKING''@|$(GNULIB_STDIO_H_NONBLOCKING)|g' \
- -e 's|@''GNULIB_STDIO_H_SIGPIPE''@|$(GNULIB_STDIO_H_SIGPIPE)|g' \
- -e 's|@''GNULIB_TMPFILE''@|$(GNULIB_TMPFILE)|g' \
- -e 's|@''GNULIB_VASPRINTF''@|$(GNULIB_VASPRINTF)|g' \
- -e 's|@''GNULIB_VDPRINTF''@|$(GNULIB_VDPRINTF)|g' \
- -e 's|@''GNULIB_VFPRINTF''@|$(GNULIB_VFPRINTF)|g' \
- -e 's|@''GNULIB_VFPRINTF_POSIX''@|$(GNULIB_VFPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_VFSCANF''@|$(GNULIB_VFSCANF)|g' \
- -e 's|@''GNULIB_VSCANF''@|$(GNULIB_VSCANF)|g' \
- -e 's|@''GNULIB_VPRINTF''@|$(GNULIB_VPRINTF)|g' \
- -e 's|@''GNULIB_VPRINTF_POSIX''@|$(GNULIB_VPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_VSNPRINTF''@|$(GNULIB_VSNPRINTF)|g' \
- -e 's|@''GNULIB_VSPRINTF_POSIX''@|$(GNULIB_VSPRINTF_POSIX)|g' \
+ -e 's/@''GNULIB_DPRINTF''@/$(GNULIB_DPRINTF)/g' \
+ -e 's/@''GNULIB_FCLOSE''@/$(GNULIB_FCLOSE)/g' \
+ -e 's/@''GNULIB_FFLUSH''@/$(GNULIB_FFLUSH)/g' \
+ -e 's/@''GNULIB_FGETC''@/$(GNULIB_FGETC)/g' \
+ -e 's/@''GNULIB_FGETS''@/$(GNULIB_FGETS)/g' \
+ -e 's/@''GNULIB_FOPEN''@/$(GNULIB_FOPEN)/g' \
+ -e 's/@''GNULIB_FPRINTF''@/$(GNULIB_FPRINTF)/g' \
+ -e 's/@''GNULIB_FPRINTF_POSIX''@/$(GNULIB_FPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_FPURGE''@/$(GNULIB_FPURGE)/g' \
+ -e 's/@''GNULIB_FPUTC''@/$(GNULIB_FPUTC)/g' \
+ -e 's/@''GNULIB_FPUTS''@/$(GNULIB_FPUTS)/g' \
+ -e 's/@''GNULIB_FREAD''@/$(GNULIB_FREAD)/g' \
+ -e 's/@''GNULIB_FREOPEN''@/$(GNULIB_FREOPEN)/g' \
+ -e 's/@''GNULIB_FSCANF''@/$(GNULIB_FSCANF)/g' \
+ -e 's/@''GNULIB_FSEEK''@/$(GNULIB_FSEEK)/g' \
+ -e 's/@''GNULIB_FSEEKO''@/$(GNULIB_FSEEKO)/g' \
+ -e 's/@''GNULIB_FTELL''@/$(GNULIB_FTELL)/g' \
+ -e 's/@''GNULIB_FTELLO''@/$(GNULIB_FTELLO)/g' \
+ -e 's/@''GNULIB_FWRITE''@/$(GNULIB_FWRITE)/g' \
+ -e 's/@''GNULIB_GETC''@/$(GNULIB_GETC)/g' \
+ -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_PERROR''@/$(GNULIB_PERROR)/g' \
+ -e 's/@''GNULIB_POPEN''@/$(GNULIB_POPEN)/g' \
+ -e 's/@''GNULIB_PRINTF''@/$(GNULIB_PRINTF)/g' \
+ -e 's/@''GNULIB_PRINTF_POSIX''@/$(GNULIB_PRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_PUTC''@/$(GNULIB_PUTC)/g' \
+ -e 's/@''GNULIB_PUTCHAR''@/$(GNULIB_PUTCHAR)/g' \
+ -e 's/@''GNULIB_PUTS''@/$(GNULIB_PUTS)/g' \
+ -e 's/@''GNULIB_REMOVE''@/$(GNULIB_REMOVE)/g' \
+ -e 's/@''GNULIB_RENAME''@/$(GNULIB_RENAME)/g' \
+ -e 's/@''GNULIB_RENAMEAT''@/$(GNULIB_RENAMEAT)/g' \
+ -e 's/@''GNULIB_SCANF''@/$(GNULIB_SCANF)/g' \
+ -e 's/@''GNULIB_SNPRINTF''@/$(GNULIB_SNPRINTF)/g' \
+ -e 's/@''GNULIB_SPRINTF_POSIX''@/$(GNULIB_SPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_STDIO_H_NONBLOCKING''@/$(GNULIB_STDIO_H_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_STDIO_H_SIGPIPE''@/$(GNULIB_STDIO_H_SIGPIPE)/g' \
+ -e 's/@''GNULIB_TMPFILE''@/$(GNULIB_TMPFILE)/g' \
+ -e 's/@''GNULIB_VASPRINTF''@/$(GNULIB_VASPRINTF)/g' \
+ -e 's/@''GNULIB_VDPRINTF''@/$(GNULIB_VDPRINTF)/g' \
+ -e 's/@''GNULIB_VFPRINTF''@/$(GNULIB_VFPRINTF)/g' \
+ -e 's/@''GNULIB_VFPRINTF_POSIX''@/$(GNULIB_VFPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_VFSCANF''@/$(GNULIB_VFSCANF)/g' \
+ -e 's/@''GNULIB_VSCANF''@/$(GNULIB_VSCANF)/g' \
+ -e 's/@''GNULIB_VPRINTF''@/$(GNULIB_VPRINTF)/g' \
+ -e 's/@''GNULIB_VPRINTF_POSIX''@/$(GNULIB_VPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_VSNPRINTF''@/$(GNULIB_VSNPRINTF)/g' \
+ -e 's/@''GNULIB_VSPRINTF_POSIX''@/$(GNULIB_VSPRINTF_POSIX)/g' \
< $(srcdir)/stdio.in.h | \
sed -e 's|@''HAVE_DECL_FPURGE''@|$(HAVE_DECL_FPURGE)|g' \
-e 's|@''HAVE_DECL_FSEEKO''@|$(HAVE_DECL_FSEEKO)|g' \
@@ -1313,38 +1398,39 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H)
stdlib.h: stdlib.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|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \
- -e 's|@''GNULIB__EXIT''@|$(GNULIB__EXIT)|g' \
- -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \
- -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \
- -e 's|@''GNULIB_CANONICALIZE_FILE_NAME''@|$(GNULIB_CANONICALIZE_FILE_NAME)|g' \
- -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \
- -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \
- -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \
- -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \
- -e 's|@''GNULIB_MBTOWC''@|$(GNULIB_MBTOWC)|g' \
- -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \
- -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \
- -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \
- -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \
- -e 's|@''GNULIB_MKSTEMPS''@|$(GNULIB_MKSTEMPS)|g' \
- -e 's|@''GNULIB_PTSNAME''@|$(GNULIB_PTSNAME)|g' \
- -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|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' \
- -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \
- -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \
- -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \
- -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \
- -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \
- -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \
- -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \
- -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \
- -e 's|@''GNULIB_WCTOMB''@|$(GNULIB_WCTOMB)|g' \
+ -e 's/@''GNULIB__EXIT''@/$(GNULIB__EXIT)/g' \
+ -e 's/@''GNULIB_ATOLL''@/$(GNULIB_ATOLL)/g' \
+ -e 's/@''GNULIB_CALLOC_POSIX''@/$(GNULIB_CALLOC_POSIX)/g' \
+ -e 's/@''GNULIB_CANONICALIZE_FILE_NAME''@/$(GNULIB_CANONICALIZE_FILE_NAME)/g' \
+ -e 's/@''GNULIB_GETLOADAVG''@/$(GNULIB_GETLOADAVG)/g' \
+ -e 's/@''GNULIB_GETSUBOPT''@/$(GNULIB_GETSUBOPT)/g' \
+ -e 's/@''GNULIB_GRANTPT''@/$(GNULIB_GRANTPT)/g' \
+ -e 's/@''GNULIB_MALLOC_POSIX''@/$(GNULIB_MALLOC_POSIX)/g' \
+ -e 's/@''GNULIB_MBTOWC''@/$(GNULIB_MBTOWC)/g' \
+ -e 's/@''GNULIB_MKDTEMP''@/$(GNULIB_MKDTEMP)/g' \
+ -e 's/@''GNULIB_MKOSTEMP''@/$(GNULIB_MKOSTEMP)/g' \
+ -e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
+ -e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
+ -e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
+ -e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/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' \
+ -e 's/@''GNULIB_RPMATCH''@/$(GNULIB_RPMATCH)/g' \
+ -e 's/@''GNULIB_SETENV''@/$(GNULIB_SETENV)/g' \
+ -e 's/@''GNULIB_STRTOD''@/$(GNULIB_STRTOD)/g' \
+ -e 's/@''GNULIB_STRTOLL''@/$(GNULIB_STRTOLL)/g' \
+ -e 's/@''GNULIB_STRTOULL''@/$(GNULIB_STRTOULL)/g' \
+ -e 's/@''GNULIB_SYSTEM_POSIX''@/$(GNULIB_SYSTEM_POSIX)/g' \
+ -e 's/@''GNULIB_UNLOCKPT''@/$(GNULIB_UNLOCKPT)/g' \
+ -e 's/@''GNULIB_UNSETENV''@/$(GNULIB_UNSETENV)/g' \
+ -e 's/@''GNULIB_WCTOMB''@/$(GNULIB_WCTOMB)/g' \
< $(srcdir)/stdlib.in.h | \
sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \
-e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \
@@ -1394,22 +1480,23 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
$(AM_V_at)$(MKDIR_P) sys
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
- sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \
- -e 's|@''GNULIB_FCHMODAT''@|$(GNULIB_FCHMODAT)|g' \
- -e 's|@''GNULIB_FSTATAT''@|$(GNULIB_FSTATAT)|g' \
- -e 's|@''GNULIB_FUTIMENS''@|$(GNULIB_FUTIMENS)|g' \
- -e 's|@''GNULIB_LCHMOD''@|$(GNULIB_LCHMOD)|g' \
- -e 's|@''GNULIB_LSTAT''@|$(GNULIB_LSTAT)|g' \
- -e 's|@''GNULIB_MKDIRAT''@|$(GNULIB_MKDIRAT)|g' \
- -e 's|@''GNULIB_MKFIFO''@|$(GNULIB_MKFIFO)|g' \
- -e 's|@''GNULIB_MKFIFOAT''@|$(GNULIB_MKFIFOAT)|g' \
- -e 's|@''GNULIB_MKNOD''@|$(GNULIB_MKNOD)|g' \
- -e 's|@''GNULIB_MKNODAT''@|$(GNULIB_MKNODAT)|g' \
- -e 's|@''GNULIB_STAT''@|$(GNULIB_STAT)|g' \
- -e 's|@''GNULIB_UTIMENSAT''@|$(GNULIB_UTIMENSAT)|g' \
+ -e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \
+ -e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
+ -e 's/@''GNULIB_FUTIMENS''@/$(GNULIB_FUTIMENS)/g' \
+ -e 's/@''GNULIB_LCHMOD''@/$(GNULIB_LCHMOD)/g' \
+ -e 's/@''GNULIB_LSTAT''@/$(GNULIB_LSTAT)/g' \
+ -e 's/@''GNULIB_MKDIRAT''@/$(GNULIB_MKDIRAT)/g' \
+ -e 's/@''GNULIB_MKFIFO''@/$(GNULIB_MKFIFO)/g' \
+ -e 's/@''GNULIB_MKFIFOAT''@/$(GNULIB_MKFIFOAT)/g' \
+ -e 's/@''GNULIB_MKNOD''@/$(GNULIB_MKNOD)/g' \
+ -e 's/@''GNULIB_MKNODAT''@/$(GNULIB_MKNODAT)/g' \
+ -e 's/@''GNULIB_STAT''@/$(GNULIB_STAT)/g' \
+ -e 's/@''GNULIB_UTIMENSAT''@/$(GNULIB_UTIMENSAT)/g' \
-e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \
-e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \
-e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \
@@ -1442,15 +1529,16 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
time.h: time.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|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_TIME_H''@|$(NEXT_TIME_H)|g' \
- -e 's|@''GNULIB_MKTIME''@|$(GNULIB_MKTIME)|g' \
- -e 's|@''GNULIB_NANOSLEEP''@|$(GNULIB_NANOSLEEP)|g' \
- -e 's|@''GNULIB_STRPTIME''@|$(GNULIB_STRPTIME)|g' \
- -e 's|@''GNULIB_TIMEGM''@|$(GNULIB_TIMEGM)|g' \
- -e 's|@''GNULIB_TIME_R''@|$(GNULIB_TIME_R)|g' \
+ -e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \
+ -e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \
+ -e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \
+ -e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \
+ -e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \
-e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \
-e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
@@ -1474,54 +1562,56 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
unistd.h: unistd.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|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_H)|g' \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_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_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \
- -e 's|@''GNULIB_CHOWN''@|$(GNULIB_CHOWN)|g' \
- -e 's|@''GNULIB_CLOSE''@|$(GNULIB_CLOSE)|g' \
- -e 's|@''GNULIB_DUP2''@|$(GNULIB_DUP2)|g' \
- -e 's|@''GNULIB_DUP3''@|$(GNULIB_DUP3)|g' \
- -e 's|@''GNULIB_ENVIRON''@|$(GNULIB_ENVIRON)|g' \
- -e 's|@''GNULIB_EUIDACCESS''@|$(GNULIB_EUIDACCESS)|g' \
- -e 's|@''GNULIB_FACCESSAT''@|$(GNULIB_FACCESSAT)|g' \
- -e 's|@''GNULIB_FCHDIR''@|$(GNULIB_FCHDIR)|g' \
- -e 's|@''GNULIB_FCHOWNAT''@|$(GNULIB_FCHOWNAT)|g' \
- -e 's|@''GNULIB_FSYNC''@|$(GNULIB_FSYNC)|g' \
- -e 's|@''GNULIB_FTRUNCATE''@|$(GNULIB_FTRUNCATE)|g' \
- -e 's|@''GNULIB_GETCWD''@|$(GNULIB_GETCWD)|g' \
- -e 's|@''GNULIB_GETDOMAINNAME''@|$(GNULIB_GETDOMAINNAME)|g' \
- -e 's|@''GNULIB_GETDTABLESIZE''@|$(GNULIB_GETDTABLESIZE)|g' \
- -e 's|@''GNULIB_GETGROUPS''@|$(GNULIB_GETGROUPS)|g' \
- -e 's|@''GNULIB_GETHOSTNAME''@|$(GNULIB_GETHOSTNAME)|g' \
- -e 's|@''GNULIB_GETLOGIN''@|$(GNULIB_GETLOGIN)|g' \
- -e 's|@''GNULIB_GETLOGIN_R''@|$(GNULIB_GETLOGIN_R)|g' \
- -e 's|@''GNULIB_GETPAGESIZE''@|$(GNULIB_GETPAGESIZE)|g' \
- -e 's|@''GNULIB_GETUSERSHELL''@|$(GNULIB_GETUSERSHELL)|g' \
- -e 's|@''GNULIB_LCHOWN''@|$(GNULIB_LCHOWN)|g' \
- -e 's|@''GNULIB_LINK''@|$(GNULIB_LINK)|g' \
- -e 's|@''GNULIB_LINKAT''@|$(GNULIB_LINKAT)|g' \
- -e 's|@''GNULIB_LSEEK''@|$(GNULIB_LSEEK)|g' \
- -e 's|@''GNULIB_PIPE''@|$(GNULIB_PIPE)|g' \
- -e 's|@''GNULIB_PIPE2''@|$(GNULIB_PIPE2)|g' \
- -e 's|@''GNULIB_PREAD''@|$(GNULIB_PREAD)|g' \
- -e 's|@''GNULIB_PWRITE''@|$(GNULIB_PWRITE)|g' \
- -e 's|@''GNULIB_READ''@|$(GNULIB_READ)|g' \
- -e 's|@''GNULIB_READLINK''@|$(GNULIB_READLINK)|g' \
- -e 's|@''GNULIB_READLINKAT''@|$(GNULIB_READLINKAT)|g' \
- -e 's|@''GNULIB_RMDIR''@|$(GNULIB_RMDIR)|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_NONBLOCKING''@|$(GNULIB_UNISTD_H_NONBLOCKING)|g' \
- -e 's|@''GNULIB_UNISTD_H_SIGPIPE''@|$(GNULIB_UNISTD_H_SIGPIPE)|g' \
- -e 's|@''GNULIB_UNLINK''@|$(GNULIB_UNLINK)|g' \
- -e 's|@''GNULIB_UNLINKAT''@|$(GNULIB_UNLINKAT)|g' \
- -e 's|@''GNULIB_USLEEP''@|$(GNULIB_USLEEP)|g' \
- -e 's|@''GNULIB_WRITE''@|$(GNULIB_WRITE)|g' \
+ -e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \
+ -e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \
+ -e 's/@''GNULIB_DUP2''@/$(GNULIB_DUP2)/g' \
+ -e 's/@''GNULIB_DUP3''@/$(GNULIB_DUP3)/g' \
+ -e 's/@''GNULIB_ENVIRON''@/$(GNULIB_ENVIRON)/g' \
+ -e 's/@''GNULIB_EUIDACCESS''@/$(GNULIB_EUIDACCESS)/g' \
+ -e 's/@''GNULIB_FACCESSAT''@/$(GNULIB_FACCESSAT)/g' \
+ -e 's/@''GNULIB_FCHDIR''@/$(GNULIB_FCHDIR)/g' \
+ -e 's/@''GNULIB_FCHOWNAT''@/$(GNULIB_FCHOWNAT)/g' \
+ -e 's/@''GNULIB_FSYNC''@/$(GNULIB_FSYNC)/g' \
+ -e 's/@''GNULIB_FTRUNCATE''@/$(GNULIB_FTRUNCATE)/g' \
+ -e 's/@''GNULIB_GETCWD''@/$(GNULIB_GETCWD)/g' \
+ -e 's/@''GNULIB_GETDOMAINNAME''@/$(GNULIB_GETDOMAINNAME)/g' \
+ -e 's/@''GNULIB_GETDTABLESIZE''@/$(GNULIB_GETDTABLESIZE)/g' \
+ -e 's/@''GNULIB_GETGROUPS''@/$(GNULIB_GETGROUPS)/g' \
+ -e 's/@''GNULIB_GETHOSTNAME''@/$(GNULIB_GETHOSTNAME)/g' \
+ -e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \
+ -e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \
+ -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_LCHOWN''@/$(GNULIB_LCHOWN)/g' \
+ -e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \
+ -e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \
+ -e 's/@''GNULIB_LSEEK''@/$(GNULIB_LSEEK)/g' \
+ -e 's/@''GNULIB_PIPE''@/$(GNULIB_PIPE)/g' \
+ -e 's/@''GNULIB_PIPE2''@/$(GNULIB_PIPE2)/g' \
+ -e 's/@''GNULIB_PREAD''@/$(GNULIB_PREAD)/g' \
+ -e 's/@''GNULIB_PWRITE''@/$(GNULIB_PWRITE)/g' \
+ -e 's/@''GNULIB_READ''@/$(GNULIB_READ)/g' \
+ -e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \
+ -e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \
+ -e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/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_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \
+ -e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \
+ -e 's/@''GNULIB_UNLINKAT''@/$(GNULIB_UNLINKAT)/g' \
+ -e 's/@''GNULIB_USLEEP''@/$(GNULIB_USLEEP)/g' \
+ -e 's/@''GNULIB_WRITE''@/$(GNULIB_WRITE)/g' \
< $(srcdir)/unistd.in.h | \
sed -e 's|@''HAVE_CHOWN''@|$(HAVE_CHOWN)|g' \
-e 's|@''HAVE_DUP2''@|$(HAVE_DUP2)|g' \
@@ -1537,6 +1627,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \
-e 's|@''HAVE_GETLOGIN''@|$(HAVE_GETLOGIN)|g' \
-e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \
+ -e 's|@''HAVE_GROUP_MEMBER''@|$(HAVE_GROUP_MEMBER)|g' \
-e 's|@''HAVE_LCHOWN''@|$(HAVE_LCHOWN)|g' \
-e 's|@''HAVE_LINK''@|$(HAVE_LINK)|g' \
-e 's|@''HAVE_LINKAT''@|$(HAVE_LINKAT)|g' \
diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4
index 31be6a87141..90ed7c0a99f 100644
--- a/autogen/aclocal.m4
+++ b/autogen/aclocal.m4
@@ -985,7 +985,9 @@ AC_SUBST([am__untar])
]) # _AM_PROG_TAR
m4_include([m4/00gnulib.m4])
+m4_include([m4/alloca.m4])
m4_include([m4/c-strtod.m4])
+m4_include([m4/dup2.m4])
m4_include([m4/extensions.m4])
m4_include([m4/filemode.m4])
m4_include([m4/getloadavg.m4])
@@ -999,7 +1001,13 @@ m4_include([m4/lstat.m4])
m4_include([m4/md5.m4])
m4_include([m4/mktime.m4])
m4_include([m4/multiarch.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])
@@ -1011,6 +1019,8 @@ m4_include([m4/stdint.m4])
m4_include([m4/stdio_h.m4])
m4_include([m4/stdlib_h.m4])
m4_include([m4/strftime.m4])
+m4_include([m4/strtoimax.m4])
+m4_include([m4/strtoll.m4])
m4_include([m4/strtoull.m4])
m4_include([m4/strtoumax.m4])
m4_include([m4/symlink.m4])
diff --git a/autogen/config.in b/autogen/config.in
index 860c509cd3e..e7764e1ae24 100644
--- a/autogen/config.in
+++ b/autogen/config.in
@@ -104,7 +104,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `alarm' function. */
#undef HAVE_ALARM
-/* Define to 1 if you have `alloca', as a function or macro. */
+/* 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 you have <alloca.h> and it should be used (not on Ultrix).
@@ -159,6 +160,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
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. */
+#undef HAVE_DECL_STRTOLL
+
/* Define to 1 if you have the declaration of `strtoull', and to 0 if you
don't. */
#undef HAVE_DECL_STRTOULL
@@ -303,6 +312,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* 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
@@ -588,6 +600,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <pthread.h> header file. */
#undef HAVE_PTHREAD_H
+/* Define to 1 if you have the `pthread_sigmask' function. */
+#undef HAVE_PTHREAD_SIGMASK
+
/* Define to 1 if you have the <pty.h> header file. */
#undef HAVE_PTY_H
@@ -657,6 +672,9 @@ 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 the system has the type `sigset_t'. */
+#undef HAVE_SIGSET_T
+
/* Define to 1 if you have sound support. */
#undef HAVE_SOUND
@@ -693,6 +711,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* 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. */
#undef HAVE_STRTOULL
@@ -1034,9 +1058,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* 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 */
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
#undef STACK_DIRECTION
/* Define to 1 if the `S_IS*' macros in <sys/stat.h> do not work properly. */
@@ -1101,6 +1125,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
'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
@@ -1261,6 +1288,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
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
+
+/* 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
+
/* Define as a macro for copying va_list variables. */
#undef va_copy
@@ -1273,21 +1314,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#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
-/* If using GNU, then support inline function declarations. */
-/* Don't try to switch on inline handling as detected by AC_C_INLINE
- generally, because even if non-gcc compilers accept `inline', they
- may reject `extern inline'. */
-#if defined (__GNUC__)
-#define INLINE __inline__
-#else
-#define INLINE
-#endif
-
/* `subprocesses' should be defined if you want to
have code for asynchronous subprocesses
(as used in M-x compile and M-x shell).
@@ -1359,20 +1396,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <string.h>
#include <stdlib.h>
-#ifdef HAVE_ALLOCA_H
-# include <alloca.h>
-#elif defined __GNUC__
-# define alloca __builtin_alloca
-#elif defined _AIX
-# define alloca __alloca
-#else
-# include <stddef.h>
-# ifdef __cplusplus
-extern "C"
-# endif
-void *alloca (size_t);
-#endif
-
#ifndef HAVE_STRCHR
#define strchr(a, b) index (a, b)
#endif
diff --git a/autogen/configure b/autogen/configure
index ca8be082e03..f751caec1f5 100755
--- a/autogen/configure
+++ b/autogen/configure
@@ -603,61 +603,10 @@ am__EXEEXT_FALSE
am__EXEEXT_TRUE
LTLIBOBJS
LIBOBJS
-WINDOW_SUPPORT
-TOOLTIP_SUPPORT
-MOUSE_SUPPORT
+SUBDIR_MAKEFILES_IN
LIB_GCC
LD_FIRSTFLAG
LD_SWITCH_SYSTEM_TEMACS
-POST_ALLOC_OBJ
-PRE_ALLOC_OBJ
-CYGWIN_OBJ
-RALLOC_OBJ
-OLDXMENU_DEPS
-LIBX_OTHER
-LIBXMENU
-OLDXMENU
-OLDXMENU_TARGET
-LIBXT_OTHER
-TOOLKIT_LIBW
-WIDGET_OBJ
-XOBJ
-XMENU_OBJ
-FONT_OBJ
-OTHER_FILES
-GNU_OBJC_CFLAGS
-ns_appsrc
-ns_appresdir
-ns_appbindir
-ns_appdir
-S_FILE
-M_FILE
-X_TOOLKIT_TYPE
-C_SWITCH_X_SYSTEM
-C_SWITCH_X_SITE
-LD_SWITCH_X_SITE
-gameuser
-gamedir
-bitmapdir
-archlibdir
-etcdir
-x_default_search_path
-lisppath
-locallisppath
-lispdir
-srcdir
-canonical
-configuration
-version
-KRB4LIB
-DESLIB
-KRB5LIB
-CRYPTOLIB
-COM_ERRLIB
-LIBRESOLV
-LIBHESIOD
-TERMCAP_OBJ
-LIBS_TERMCAP
LIBGNU_LTLIBDEPS
LIBGNU_LIBDEPS
gltests_WITNESS
@@ -665,8 +614,12 @@ gl_GNULIB_ENABLED_verify_FALSE
gl_GNULIB_ENABLED_verify_TRUE
gl_GNULIB_ENABLED_strtoull_FALSE
gl_GNULIB_ENABLED_strtoull_TRUE
+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_be453cec5eecf5731a274f2de7f2db36_FALSE
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE
gl_GNULIB_ENABLED_dosname_FALSE
@@ -800,6 +753,22 @@ GL_GENERATE_STDARG_H_TRUE
STDARG_H
NEXT_AS_FIRST_DIRECTIVE_STDARG_H
NEXT_STDARG_H
+NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H
+NEXT_SIGNAL_H
+REPLACE_PTHREAD_SIGMASK
+HAVE_SIGHANDLER_T
+HAVE_TYPE_VOLATILE_SIG_ATOMIC_T
+HAVE_STRUCT_SIGACTION_SA_SIGACTION
+HAVE_SIGACTION
+HAVE_SIGINFO_T
+HAVE_SIGSET_T
+HAVE_PTHREAD_SIGMASK
+HAVE_POSIX_SIGNALBLOCKING
+GNULIB_SIGACTION
+GNULIB_SIGPROCMASK
+GNULIB_SIGNAL_H_SIGPIPE
+GNULIB_PTHREAD_SIGMASK
+LIB_PTHREAD_SIGMASK
REPLACE_TIMEGM
REPLACE_NANOSLEEP
REPLACE_MKTIME
@@ -896,6 +865,72 @@ PRAGMA_COLUMNS
PRAGMA_SYSTEM_HEADER
INCLUDE_NEXT_AS_FIRST_DIRECTIVE
INCLUDE_NEXT
+GETLOADAVG_LIBS
+REPLACE_WCTOMB
+REPLACE_UNSETENV
+REPLACE_STRTOD
+REPLACE_SETENV
+REPLACE_REALPATH
+REPLACE_REALLOC
+REPLACE_PUTENV
+REPLACE_MKSTEMP
+REPLACE_MBTOWC
+REPLACE_MALLOC
+REPLACE_CANONICALIZE_FILE_NAME
+REPLACE_CALLOC
+HAVE_DECL_UNSETENV
+HAVE_UNLOCKPT
+HAVE_SYS_LOADAVG_H
+HAVE_STRUCT_RANDOM_DATA
+HAVE_STRTOULL
+HAVE_STRTOLL
+HAVE_STRTOD
+HAVE_DECL_SETENV
+HAVE_SETENV
+HAVE_RPMATCH
+HAVE_REALPATH
+HAVE_RANDOM_R
+HAVE_RANDOM_H
+HAVE_PTSNAME
+HAVE_MKSTEMPS
+HAVE_MKSTEMP
+HAVE_MKOSTEMPS
+HAVE_MKOSTEMP
+HAVE_MKDTEMP
+HAVE_GRANTPT
+HAVE_GETSUBOPT
+HAVE_DECL_GETLOADAVG
+HAVE_CANONICALIZE_FILE_NAME
+HAVE_ATOLL
+HAVE__EXIT
+GNULIB_WCTOMB
+GNULIB_UNSETENV
+GNULIB_UNLOCKPT
+GNULIB_SYSTEM_POSIX
+GNULIB_STRTOULL
+GNULIB_STRTOLL
+GNULIB_STRTOD
+GNULIB_SETENV
+GNULIB_RPMATCH
+GNULIB_REALPATH
+GNULIB_REALLOC_POSIX
+GNULIB_RANDOM_R
+GNULIB_PUTENV
+GNULIB_PTSNAME
+GNULIB_MKSTEMPS
+GNULIB_MKSTEMP
+GNULIB_MKOSTEMPS
+GNULIB_MKOSTEMP
+GNULIB_MKDTEMP
+GNULIB_MBTOWC
+GNULIB_MALLOC_POSIX
+GNULIB_GRANTPT
+GNULIB_GETSUBOPT
+GNULIB_GETLOADAVG
+GNULIB_CANONICALIZE_FILE_NAME
+GNULIB_CALLOC_POSIX
+GNULIB_ATOLL
+GNULIB__EXIT
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS
UNISTD_H_HAVE_WINSOCK2_H
REPLACE_WRITE
@@ -947,6 +982,7 @@ HAVE_PIPE
HAVE_LINKAT
HAVE_LINK
HAVE_LCHOWN
+HAVE_GROUP_MEMBER
HAVE_GETPAGESIZE
HAVE_GETLOGIN
HAVE_GETHOSTNAME
@@ -984,6 +1020,7 @@ GNULIB_LSEEK
GNULIB_LINKAT
GNULIB_LINK
GNULIB_LCHOWN
+GNULIB_GROUP_MEMBER
GNULIB_GETUSERSHELL
GNULIB_GETPAGESIZE
GNULIB_GETLOGIN_R
@@ -1004,78 +1041,64 @@ GNULIB_DUP3
GNULIB_DUP2
GNULIB_CLOSE
GNULIB_CHOWN
-GETLOADAVG_LIBS
-REPLACE_WCTOMB
-REPLACE_UNSETENV
-REPLACE_STRTOD
-REPLACE_SETENV
-REPLACE_REALPATH
-REPLACE_REALLOC
-REPLACE_PUTENV
-REPLACE_MKSTEMP
-REPLACE_MBTOWC
-REPLACE_MALLOC
-REPLACE_CANONICALIZE_FILE_NAME
-REPLACE_CALLOC
-HAVE_DECL_UNSETENV
-HAVE_UNLOCKPT
-HAVE_SYS_LOADAVG_H
-HAVE_STRUCT_RANDOM_DATA
-HAVE_STRTOULL
-HAVE_STRTOLL
-HAVE_STRTOD
-HAVE_DECL_SETENV
-HAVE_SETENV
-HAVE_RPMATCH
-HAVE_REALPATH
-HAVE_RANDOM_R
-HAVE_RANDOM_H
-HAVE_PTSNAME
-HAVE_MKSTEMPS
-HAVE_MKSTEMP
-HAVE_MKOSTEMPS
-HAVE_MKOSTEMP
-HAVE_MKDTEMP
-HAVE_GRANTPT
-HAVE_GETSUBOPT
-HAVE_DECL_GETLOADAVG
-HAVE_CANONICALIZE_FILE_NAME
-HAVE_ATOLL
-HAVE__EXIT
-GNULIB_WCTOMB
-GNULIB_UNSETENV
-GNULIB_UNLOCKPT
-GNULIB_SYSTEM_POSIX
-GNULIB_STRTOULL
-GNULIB_STRTOLL
-GNULIB_STRTOD
-GNULIB_SETENV
-GNULIB_RPMATCH
-GNULIB_REALPATH
-GNULIB_REALLOC_POSIX
-GNULIB_RANDOM_R
-GNULIB_PUTENV
-GNULIB_PTSNAME
-GNULIB_MKSTEMPS
-GNULIB_MKSTEMP
-GNULIB_MKOSTEMPS
-GNULIB_MKOSTEMP
-GNULIB_MKDTEMP
-GNULIB_MBTOWC
-GNULIB_MALLOC_POSIX
-GNULIB_GRANTPT
-GNULIB_GETSUBOPT
-GNULIB_GETLOADAVG
-GNULIB_CANONICALIZE_FILE_NAME
-GNULIB_CALLOC_POSIX
-GNULIB_ATOLL
-GNULIB__EXIT
+GL_GENERATE_ALLOCA_H_FALSE
+GL_GENERATE_ALLOCA_H_TRUE
+ALLOCA_H
+ALLOCA
GL_COND_LIBTOOL_FALSE
GL_COND_LIBTOOL_TRUE
+POST_ALLOC_OBJ
+PRE_ALLOC_OBJ
+CYGWIN_OBJ
+RALLOC_OBJ
+OLDXMENU_DEPS
+LIBX_OTHER
+LIBXMENU
+OLDXMENU
+OLDXMENU_TARGET
+LIBXT_OTHER
+TOOLKIT_LIBW
+WIDGET_OBJ
+XOBJ
+XMENU_OBJ
+FONT_OBJ
+OTHER_FILES
+GNU_OBJC_CFLAGS
+ns_appsrc
+ns_appresdir
+ns_appbindir
+ns_appdir
+S_FILE
+M_FILE
+X_TOOLKIT_TYPE
+C_SWITCH_X_SYSTEM
+C_SWITCH_X_SITE
+LD_SWITCH_X_SITE
+gameuser
+gamedir
+bitmapdir
+archlibdir
+etcdir
+x_default_search_path
+lisppath
+locallisppath
+lispdir
+srcdir
+canonical
+configuration
+version
+KRB4LIB
+DESLIB
+KRB5LIB
+CRYPTOLIB
+COM_ERRLIB
+LIBRESOLV
+LIBHESIOD
+TERMCAP_OBJ
+LIBS_TERMCAP
BLESSMAIL_TARGET
LIBS_MAIL
liblockfile
-ALLOCA
LIBXML2_LIBS
LIBXML2_CFLAGS
LIBXSM
@@ -1100,8 +1123,12 @@ LIBXTR6
LIBGNUTLS_LIBS
LIBGNUTLS_CFLAGS
LIBSELINUX_LIBS
+SETTINGS_LIBS
+SETTINGS_CFLAGS
GCONF_LIBS
GCONF_CFLAGS
+GSETTINGS_LIBS
+GSETTINGS_CFLAGS
DBUS_OBJ
DBUS_LIBS
DBUS_CFLAGS
@@ -1116,7 +1143,6 @@ VMLIMIT_OBJ
GMALLOC_OBJ
HAVE_XSERVER
LIB_STANDARD
-NS_SUPPORT
NS_OBJC_OBJ
NS_OBJ
TEMACS_LDFLAGS2
@@ -1130,9 +1156,9 @@ ALSA_LIBS
ALSA_CFLAGS
PKG_CONFIG
LIBSOUND
+CRT_DIR
START_FILES
LIB_MATH
-CRT_DIR
LIBS_SYSTEM
C_SWITCH_SYSTEM
UNEXEC_OBJ
@@ -1236,6 +1262,7 @@ PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files='deps_frag
+lisp_frag
ns_frag'
ac_user_opts='
enable_option_checking
@@ -1249,6 +1276,7 @@ with_mailhost
with_sound
with_sync_input
with_x_toolkit
+with_wide_int
with_xpm
with_jpeg
with_tiff
@@ -1267,6 +1295,7 @@ with_ns
with_gpm
with_dbus
with_gconf
+with_gsettings
with_selinux
with_gnutls
with_makeinfo
@@ -1923,8 +1952,8 @@ Optional Features:
--disable-ns-self-contained
disable self contained build under NeXTstep
--enable-asserts compile code with asserts enabled
- --enable-maintainer-mode
- enable make rules and dependencies not useful (and
+ --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
@@ -1962,6 +1991,7 @@ Optional Packages:
--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-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
--without-tiff don't compile with TIFF image support
@@ -1982,6 +2012,7 @@ Optional Packages:
console
--without-dbus don't compile with D-Bus support
--without-gconf don't compile with GConf support
+ --without-gsettings don't compile with GSettings support
--without-selinux don't compile with SELinux support
--without-gnutls don't use -lgnutls for SSL/TLS support
--without-makeinfo don't require makeinfo for building manuals
@@ -2560,6 +2591,60 @@ $as_echo "$ac_res" >&6; }
} # ac_fn_c_check_func
+# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
+# -------------------------------------------
+# Tests whether TYPE exists after having included INCLUDES, setting cache
+# variable VAR accordingly.
+ac_fn_c_check_type ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+else
+ eval "$3=no"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+if (sizeof ($2))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+if (sizeof (($2)))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+ eval "$3=yes"
+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=\$$3
+ { $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_type
+
# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES
# --------------------------------------------
# Tries to find the compile-time value of EXPR in a program that includes
@@ -2737,60 +2822,6 @@ rm -f conftest.val
as_fn_set_status $ac_retval
} # ac_fn_c_compute_int
-
-# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
-# -------------------------------------------
-# Tests whether TYPE exists after having included INCLUDES, setting cache
-# variable VAR accordingly.
-ac_fn_c_check_type ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-$as_echo_n "checking for $2... " >&6; }
-if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- eval "$3=no"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-if (sizeof ($2))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-if (sizeof (($2)))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
-
-else
- eval "$3=yes"
-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=\$$3
- { $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_type
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
@@ -3078,6 +3109,7 @@ 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_func_list " readlinkat"
+as_fn_append ac_func_list " dup2"
gl_getopt_required=GNU
as_fn_append ac_header_list " getopt.h"
as_fn_append ac_header_list " wchar.h"
@@ -3085,6 +3117,7 @@ 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_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"
@@ -3823,6 +3856,20 @@ fi
+# Check whether --with-wide-int was given.
+if test "${with_wide_int+set}" = set; then :
+ withval=$with_wide_int;
+else
+ with_wide_int=no
+fi
+
+if test "$with_wide_int" = yes; then
+
+$as_echo "#define WIDE_EMACS_INT 1" >>confdefs.h
+
+fi
+
+
# Check whether --with-xpm was given.
if test "${with_xpm+set}" = set; then :
withval=$with_xpm;
@@ -3970,6 +4017,14 @@ else
fi
+# Check whether --with-gsettings was given.
+if test "${with_gsettings+set}" = set; then :
+ withval=$with_gsettings;
+else
+ with_gsettings=yes
+fi
+
+
# Check whether --with-selinux was given.
if test "${with_selinux+set}" = set; then :
withval=$with_selinux;
@@ -4216,23 +4271,6 @@ case "${srcdir}" in
* ) srcdir="`(cd ${srcdir}; pwd)`" ;;
esac
-#### Check if the source directory already has a configured system in it.
-if test `pwd` != `(cd ${srcdir} && pwd)` \
- && test -f "${srcdir}/src/config.h" ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: The directory tree \`${srcdir}' is being used
- as a build directory right now; it has been configured in its own
- right. To configure in another directory as well, you MUST
- use GNU make. If you do not have GNU make, then you must
- now do \`make distclean' in ${srcdir},
- and then run $0 again." >&5
-$as_echo "$as_me: WARNING: The directory tree \`${srcdir}' is being used
- as a build directory right now; it has been configured in its own
- right. To configure in another directory as well, you MUST
- use GNU make. If you do not have GNU make, then you must
- now do \`make distclean' in ${srcdir},
- and then run $0 again." >&2;}
-fi
-
#### Given the configuration name, set machfile and opsysfile to the
#### names of the m/*.h and s/*.h files we should use.
@@ -4461,7 +4499,7 @@ case "${canonical}" in
## Silicon Graphics machines
## Iris 4D
mips-sgi-irix6.5 )
- machine=iris4d opsys=irix6-5
+ opsys=irix6-5
# 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).
@@ -6536,13 +6574,18 @@ esac
+ # Code from module alloca-opt:
# Code from module allocator:
# Code from module arg-nonnull:
# Code from module c++defs:
# Code from module careadlinkat:
# 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 dup2:
# Code from module extensions:
# Code from module filemode:
@@ -6557,7 +6600,10 @@ esac
# Code from module lstat:
# Code from module mktime:
# Code from module multiarch:
+ # Code from module pthread_sigmask:
# Code from module readlink:
+ # Code from module signal:
+ # Code from module sigprocmask:
# Code from module socklen:
# Code from module ssize_t:
# Code from module stat:
@@ -6569,12 +6615,15 @@ esac
# Code from module stdio:
# Code from module stdlib:
# Code from module strftime:
+ # Code from module strtoimax:
+ # Code from module strtoll:
# Code from module strtoull:
# Code from module strtoumax:
# Code from module symlink:
# Code from module sys_stat:
# Code from module time:
# Code from module time_r:
+ # Code from module u64:
# Code from module unistd:
# Code from module verify:
# Code from module warn-on-use:
@@ -7432,6 +7481,8 @@ fi
# Suppress obsolescent Autoconf test for size_t; Emacs assumes C89 or better.
+# 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 :
@@ -7633,42 +7684,6 @@ fi
-## If user specified a crt-dir, use that unconditionally.
-if test "X$CRT_DIR" = "X"; then
-
- case "$canonical" in
- x86_64-*-linux-gnu* | s390x-*-linux-gnu*)
- ## On x86-64 and s390x GNU/Linux distributions, the standard library
- ## can be in a variety of places. We only try /usr/lib64 and /usr/lib.
- ## For anything else (eg /usr/lib32), it is up the user to specify
- ## the location (bug#5655).
- ## Test for crtn.o, not just the directory, because sometimes the
- ## directory exists but does not have the relevant files (bug#1287).
- ## FIXME better to test for binary compatibility somehow.
- test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64
- ;;
-
- powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;;
- esac
-
- case "$opsys" in
- hpux10-20) CRT_DIR=/lib ;;
- esac
-
- ## Default is /usr/lib.
- test "X$CRT_DIR" = "X" && CRT_DIR=/usr/lib
-
-else
-
- ## Some platforms don't use any of these files, so it is not
- ## appropriate to put this test outside the if block.
- test -e $CRT_DIR/crtn.o || test -e $CRT_DIR/crt0.o || \
- as_fn_error "crt*.o not found in specified location." "$LINENO" 5
-
-fi
-
-
-
LIB_MATH=-lm
LIB_STANDARD=
START_FILES=
@@ -7709,6 +7724,99 @@ esac
+crt_files=
+
+for file in x $LIB_STANDARD $START_FILES; do
+ case "$file" in
+ *CRT_DIR*) crt_files="$crt_files `echo $file | sed -e 's|.*/||'`" ;;
+ esac
+done
+
+if test "x$crt_files" != x; then
+
+ ## If user specified a crt-dir, use that unconditionally.
+ crt_gcc=no
+
+ if test "X$CRT_DIR" = "X"; then
+
+ CRT_DIR=/usr/lib # default
+
+ case "$canonical" in
+ x86_64-*-linux-gnu* | s390x-*-linux-gnu*)
+ ## On x86-64 and s390x GNU/Linux distributions, the standard library
+ ## can be in a variety of places. We only try /usr/lib64 and /usr/lib.
+ ## For anything else (eg /usr/lib32), it is up the user to specify
+ ## the location (bug#5655).
+ ## Test for crtn.o, not just the directory, because sometimes the
+ ## directory exists but does not have the relevant files (bug#1287).
+ ## FIXME better to test for binary compatibility somehow.
+ test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64
+ ;;
+
+ powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;;
+ esac
+
+ case "$opsys" in
+ hpux10-20) CRT_DIR=/lib ;;
+ esac
+
+ test "x${GCC}" = xyes && crt_gcc=yes
+
+ fi # CRT_DIR = ""
+
+ crt_missing=
+
+ for file in $crt_files; do
+
+ ## If we're using gcc, try to determine it automatically by asking
+ ## gcc. [If this doesn't work, CRT_DIR will remain at the
+ ## system-dependent default from above.]
+ if test $crt_gcc = yes && test ! -e $CRT_DIR/$file; then
+
+ crt_file=`$CC --print-file-name=$file 2>/dev/null`
+ case "$crt_file" in
+ */*)
+ CRT_DIR=`$as_dirname -- "$crt_file" ||
+$as_expr X"$crt_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$crt_file" : 'X\(//\)[^/]' \| \
+ X"$crt_file" : 'X\(//\)$' \| \
+ X"$crt_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$crt_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ ;;
+ esac
+ fi
+
+ crt_gcc=no
+
+ test -e $CRT_DIR/$file || crt_missing="$crt_missing $file"
+ done # $crt_files
+
+ test "x$crt_missing" = x || \
+ as_fn_error "Required file(s) not found:$crt_missing
+Try using the --with-crt-dir option." "$LINENO" 5
+
+fi # crt_files != ""
+
+
+
+
@@ -9081,6 +9189,10 @@ deps_frag=$srcdir/src/$deps_frag
+lisp_frag=$srcdir/src/lisp.mk
+
+
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5
$as_echo_n "checking for long file names... " >&6; }
if test "${ac_cv_sys_long_file_names+set}" = set; then :
@@ -9458,7 +9570,6 @@ fi
ns_frag=/dev/null
NS_OBJ=
NS_OBJC_OBJ=
-NS_SUPPORT=
if test "${HAVE_NS}" = yes; then
window_system=nextstep
with_xft=no
@@ -9471,7 +9582,6 @@ if test "${HAVE_NS}" = yes; then
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"
- NS_SUPPORT="\${lispsource}/emacs-lisp/easymenu.elc \${lispsource}/term/ns-win.elc"
fi
CFLAGS="$tmp_CFLAGS"
CPPFLAGS="$tmp_CPPFLAGS"
@@ -9480,7 +9590,6 @@ CPPFLAGS="$tmp_CPPFLAGS"
-
case "${window_system}" in
x11 )
HAVE_X_WINDOWS=yes
@@ -10482,6 +10591,7 @@ fi
HAVE_GTK=no
+GTK_OBJ=
if test "${with_gtk3}" = "yes"; then
GLIB_REQUIRED=2.28
GTK_REQUIRED=3.0
@@ -10587,6 +10697,7 @@ $as_echo "no" >&6; }
$as_echo "#define HAVE_GTK3 1" >>confdefs.h
+ GTK_OBJ=emacsgtkfixed.o
fi
if test "$pkg_check_gtk" != "yes"; then
@@ -10696,7 +10807,6 @@ $as_echo "no" >&6; }
fi
fi
-GTK_OBJ=
if test x"$pkg_check_gtk" = xyes; then
@@ -10725,7 +10835,7 @@ done
$as_echo "#define USE_GTK 1" >>confdefs.h
- GTK_OBJ=gtkutil.o
+ GTK_OBJ="gtkutil.o $GTK_OBJ"
USE_X_TOOLKIT=none
if $PKG_CONFIG --atleast-version=2.10 gtk+-2.0; then
:
@@ -10978,6 +11088,111 @@ done
fi
+HAVE_GSETTINGS=no
+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
+ 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 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; }
+ 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"`
+
+ 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_GSETTINGS=yes
+ else
+ HAVE_GSETTINGS=no
+ fi
+
+ if test "$HAVE_GSETTINGS" = "yes"; then
+
+$as_echo "#define HAVE_GSETTINGS 1" >>confdefs.h
+
+ SETTINGS_CFLAGS="$GSETTINGS_CFLAGS"
+ SETTINGS_LIBS="$GSETTINGS_LIBS"
+ fi
+fi
+
HAVE_GCONF=no
if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
@@ -11078,7 +11293,17 @@ $as_echo "no" >&6; }
$as_echo "#define HAVE_GCONF 1" >>confdefs.h
- for ac_func in g_type_init
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS"
+ fi
+fi
+
+if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
+ SAVE_CFLAGS="$CFLAGS"
+ SAVE_LDFLAGS="$LDFLAGS"
+ CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
+ LDFLAGS="$SETTINGS_LIBS $LDFLAGS"
+ for ac_func in g_type_init
do :
ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init"
if test "x$ac_cv_func_g_type_init" = x""yes; then :
@@ -11089,9 +11314,13 @@ _ACEOF
fi
done
- fi
+ CFLAGS="$SAVE_CFLAGS"
+ LDFLAGS="$SAVE_LDFLAGS"
fi
+
+
+
HAVE_LIBSELINUX=no
LIBSELINUX_LIBS=
if test "${with_selinux}" = "yes"; then
@@ -11199,23 +11428,23 @@ fi
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 gnutls >= 2.2.4" >&5
-$as_echo_n "checking for gnutls >= 2.2.4... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gnutls >= 2.6.0" >&5
+$as_echo_n "checking for gnutls >= 2.6.0... " >&6; }
- if $PKG_CONFIG --exists "gnutls >= 2.2.4" 2>&5; then
+ if $PKG_CONFIG --exists "gnutls >= 2.6.0" 2>&5; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&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.2.4"|sed -e 's,///*,/,g'`
+ LIBGNUTLS_CFLAGS=`$PKG_CONFIG --cflags "gnutls >= 2.6.0"|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.2.4"|sed -e 's,///*,/,g'`
+ LIBGNUTLS_LIBS=`$PKG_CONFIG --libs "gnutls >= 2.6.0"|sed -e 's,///*,/,g'`
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_LIBS" >&5
$as_echo "$LIBGNUTLS_LIBS" >&6; }
else
@@ -11225,7 +11454,7 @@ $as_echo "no" >&6; }
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.2.4"`
+ LIBGNUTLS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gnutls >= 2.6.0"`
fi
@@ -11395,9 +11624,11 @@ $as_echo "yes; using Lucid toolkit" >&6; }
elif test x"${USE_X_TOOLKIT}" = xLUCID; then
as_fn_error "Lucid toolkit requires X11/Xaw include files" "$LINENO" 5
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no; do not use toolkit by default" >&5
-$as_echo "no; do not use toolkit by default" >&6; }
- USE_X_TOOLKIT=none
+ as_fn_error "No X toolkit could be found.
+If you are sure you want Emacs compiled without an X toolkit, pass
+ --with-x-toolkit=no
+to configure. Otherwise, install the development libraries for the toolkit
+that you want to use (e.g. Gtk+) and re-run configure." "$LINENO" 5
fi
fi
fi
@@ -12925,7 +13156,6 @@ fi
### Use -lgpm if available, unless `--with-gpm=no'.
HAVE_GPM=no
LIBGPM=
-MOUSE_SUPPORT=
if test "${with_gpm}" != "no"; then
ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default"
if test "x$ac_cv_header_gpm_h" = x""yes; then :
@@ -12978,8 +13208,6 @@ fi
$as_echo "#define HAVE_GPM 1" >>confdefs.h
LIBGPM=-lgpm
- ## May be reset below.
- MOUSE_SUPPORT="\$(GPM_MOUSE_SUPPORT)"
fi
fi
@@ -13275,201 +13503,6 @@ $as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h
fi
-# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
-# for constant arguments. Useless!
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5
-$as_echo_n "checking for working alloca.h... " >&6; }
-if test "${ac_cv_working_alloca_h+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <alloca.h>
-int
-main ()
-{
-char *p = (char *) alloca (2 * sizeof (int));
- if (p) return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_working_alloca_h=yes
-else
- ac_cv_working_alloca_h=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: $ac_cv_working_alloca_h" >&5
-$as_echo "$ac_cv_working_alloca_h" >&6; }
-if test $ac_cv_working_alloca_h = yes; then
-
-$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5
-$as_echo_n "checking for alloca... " >&6; }
-if test "${ac_cv_func_alloca_works+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef __GNUC__
-# define alloca __builtin_alloca
-#else
-# ifdef _MSC_VER
-# include <malloc.h>
-# define alloca _alloca
-# else
-# ifdef HAVE_ALLOCA_H
-# include <alloca.h>
-# else
-# ifdef _AIX
- #pragma alloca
-# else
-# ifndef alloca /* predefined by HP cc +Olibcalls */
-char *alloca ();
-# endif
-# endif
-# endif
-# endif
-#endif
-
-int
-main ()
-{
-char *p = (char *) alloca (1);
- if (p) return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_func_alloca_works=yes
-else
- ac_cv_func_alloca_works=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: $ac_cv_func_alloca_works" >&5
-$as_echo "$ac_cv_func_alloca_works" >&6; }
-
-if test $ac_cv_func_alloca_works = yes; then
-
-$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h
-
-else
- # The SVR3 libPW and SVR4 libucb both contain incompatible functions
-# that cause trouble. Some versions do not even contain alloca or
-# contain a buggy version. If you still want to use their alloca,
-# use ar to extract alloca.o from them instead of compiling alloca.c.
-
-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; }
-if test "${ac_cv_os_cray+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#if defined CRAY && ! defined CRAY2
-webecray
-#else
-wenotbecray
-#endif
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "webecray" >/dev/null 2>&1; then :
- ac_cv_os_cray=yes
-else
- ac_cv_os_cray=no
-fi
-rm -f conftest*
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5
-$as_echo "$ac_cv_os_cray" >&6; }
-if test $ac_cv_os_cray = yes; then
- for ac_func in _getb67 GETB67 getb67; 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 CRAY_STACKSEG_END $ac_func
-_ACEOF
-
- break
-fi
-
- done
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5
-$as_echo_n "checking stack direction for C alloca... " >&6; }
-if test "${ac_cv_c_stack_direction+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- ac_cv_c_stack_direction=0
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-find_stack_direction ()
-{
- static char *addr = 0;
- auto char dummy;
- if (addr == 0)
- {
- addr = &dummy;
- return find_stack_direction ();
- }
- else
- return (&dummy > addr) ? 1 : -1;
-}
-
-int
-main ()
-{
- return find_stack_direction () < 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_c_stack_direction=1
-else
- ac_cv_c_stack_direction=-1
-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_c_stack_direction" >&5
-$as_echo "$ac_cv_c_stack_direction" >&6; }
-cat >>confdefs.h <<_ACEOF
-#define STACK_DIRECTION $ac_cv_c_stack_direction
-_ACEOF
-
-
-fi
-
-
-if test x"$ac_cv_func_alloca_works" != xyes; then
- as_fn_error "a system implementation of alloca is required " "$LINENO" 5
-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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5
@@ -13739,7 +13772,7 @@ esac
-for ac_func in gethostname getdomainname dup2 \
+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 \
@@ -13910,7 +13943,1766 @@ $as_echo "#define GETPGRP_VOID 1" >>confdefs.h
fi
-# Configure gnulib.
+# UNIX98 PTYs.
+for ac_func in grantpt
+do :
+ ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt"
+if test "x$ac_cv_func_grantpt" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GRANTPT 1
+_ACEOF
+
+fi
+done
+
+
+# PTY-related GNU extensions.
+for ac_func in getpt
+do :
+ ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt"
+if test "x$ac_cv_func_getpt" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GETPT 1
+_ACEOF
+
+fi
+done
+
+
+# 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
+{ $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. */
+
+/* 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; 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_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 :
+
+else
+ ac_cv_search_tputs=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+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"
+
+else
+ have_tputs_et_al=false
+fi
+
+if test "$have_tputs_et_al" != true; then
+ as_fn_error "I couldn't find termcap functions (tputs and friends).
+Maybe some development libraries/packages are missing? Try installing
+libncurses-dev(el), libterminfo-dev(el) or similar." "$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=
+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
+ ;;
+
+ freebsd)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5
+$as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; }
+ if test "${emacs_cv_freebsd_terminfo+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <osreldate.h>
+int
+main ()
+{
+#if __FreeBSD_version < 400000
+fail;
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_freebsd_terminfo=yes
+else
+ emacs_cv_freebsd_terminfo=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_freebsd_terminfo" >&5
+$as_echo "$emacs_cv_freebsd_terminfo" >&6; }
+
+ if test $emacs_cv_freebsd_terminfo = yes; then
+ TERMINFO=yes
+ LIBS_TERMCAP="-lncurses"
+ else
+ LIBS_TERMCAP="-ltermcap"
+ fi
+ ;;
+
+ netbsd)
+ if test $ac_cv_search_tputs = -lterminfo; then
+ TERMINFO=yes
+ LIBS_TERMCAP="-lterminfo"
+ else
+ LIBS_TERMCAP="-ltermcap"
+ fi
+ ;;
+
+esac
+
+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.
+ 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
+
+$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
+
+
+
+
+# Do we have res_init, for detecting changes in /etc/resolv.conf?
+resolv=no
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <netinet/in.h>
+#include <arpa/nameser.h>
+#include <resolv.h>
+int
+main ()
+{
+return res_init();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ have_res_init=yes
+else
+ have_res_init=no
+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
+$as_echo_n "checking for res_init with -lresolv... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <netinet/in.h>
+#include <arpa/nameser.h>
+#include <resolv.h>
+int
+main ()
+{
+return res_init();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ have_res_init=yes
+else
+ have_res_init=no
+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 "$have_res_init" >&6; }
+ if test "$have_res_init" = yes ; then
+ resolv=yes
+ fi
+ LIBS="$OLIBS"
+fi
+
+if test "$have_res_init" = yes; then
+
+$as_echo "#define HAVE_RES_INIT 1" >>confdefs.h
+
+fi
+
+# Do we need the Hesiod library to provide the support routines?
+LIBHESIOD=
+if test "$with_hesiod" != no ; then
+ # Don't set $LIBS here -- see comments above. FIXME which comments?
+ ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send"
+if test "x$ac_cv_func_res_send" = x""yes; then :
+
+else
+ ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send"
+if test "x$ac_cv_func___res_send" = x""yes; then :
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5
+$as_echo_n "checking for res_send in -lresolv... " >&6; }
+if test "${ac_cv_lib_resolv_res_send+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lresolv $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 res_send ();
+int
+main ()
+{
+return res_send ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_resolv_res_send=yes
+else
+ ac_cv_lib_resolv_res_send=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_resolv_res_send" >&5
+$as_echo "$ac_cv_lib_resolv_res_send" >&6; }
+if test "x$ac_cv_lib_resolv_res_send" = x""yes; then :
+ resolv=yes
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5
+$as_echo_n "checking for __res_send in -lresolv... " >&6; }
+if test "${ac_cv_lib_resolv___res_send+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lresolv $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 __res_send ();
+int
+main ()
+{
+return __res_send ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_resolv___res_send=yes
+else
+ ac_cv_lib_resolv___res_send=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_resolv___res_send" >&5
+$as_echo "$ac_cv_lib_resolv___res_send" >&6; }
+if test "x$ac_cv_lib_resolv___res_send" = x""yes; then :
+ resolv=yes
+fi
+
+fi
+
+fi
+
+fi
+
+ if test "$resolv" = yes ; then
+ RESOLVLIB=-lresolv
+ else
+ RESOLVLIB=
+ fi
+ ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost"
+if test "x$ac_cv_func_hes_getmailhost" = x""yes; then :
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5
+$as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; }
+if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lhesiod $RESOLVLIB $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 hes_getmailhost ();
+int
+main ()
+{
+return hes_getmailhost ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_hesiod_hes_getmailhost=yes
+else
+ ac_cv_lib_hesiod_hes_getmailhost=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_hesiod_hes_getmailhost" >&5
+$as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; }
+if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then :
+ hesiod=yes
+else
+ :
+fi
+
+fi
+
+
+ if test x"$hesiod" = xyes; then
+
+$as_echo "#define HAVE_LIBHESIOD 1" >>confdefs.h
+
+ LIBHESIOD=-lhesiod
+ fi
+fi
+
+
+# Do we need libresolv (due to res_init or Hesiod)?
+if test "$resolv" = yes ; then
+
+$as_echo "#define HAVE_LIBRESOLV 1" >>confdefs.h
+
+ LIBRESOLV=-lresolv
+else
+ LIBRESOLV=
+fi
+
+
+# These tell us which Kerberos-related libraries to use.
+COM_ERRLIB=
+CRYPTOLIB=
+KRB5LIB=
+DESLIB=
+KRB4LIB=
+
+if test "${with_kerberos}" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5
+$as_echo_n "checking for com_err in -lcom_err... " >&6; }
+if test "${ac_cv_lib_com_err_com_err+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lcom_err $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 com_err ();
+int
+main ()
+{
+return com_err ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_com_err_com_err=yes
+else
+ ac_cv_lib_com_err_com_err=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_com_err_com_err" >&5
+$as_echo "$ac_cv_lib_com_err_com_err" >&6; }
+if test "x$ac_cv_lib_com_err_com_err" = x""yes; then :
+ have_com_err=yes
+else
+ have_com_err=no
+fi
+
+ if test $have_com_err = yes; then
+ COM_ERRLIB=-lcom_err
+ LIBS="$COM_ERRLIB $LIBS"
+
+$as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h
+
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5
+$as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; }
+if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lcrypto $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 mit_des_cbc_encrypt ();
+int
+main ()
+{
+return mit_des_cbc_encrypt ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_crypto_mit_des_cbc_encrypt=yes
+else
+ ac_cv_lib_crypto_mit_des_cbc_encrypt=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_crypto_mit_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then :
+ have_crypto=yes
+else
+ have_crypto=no
+fi
+
+ if test $have_crypto = yes; then
+ CRYPTOLIB=-lcrypto
+ LIBS="$CRYPTOLIB $LIBS"
+
+$as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h
+
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5
+$as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; }
+if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lk5crypto $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 mit_des_cbc_encrypt ();
+int
+main ()
+{
+return mit_des_cbc_encrypt ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_k5crypto_mit_des_cbc_encrypt=yes
+else
+ ac_cv_lib_k5crypto_mit_des_cbc_encrypt=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_k5crypto_mit_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then :
+ have_k5crypto=yes
+else
+ have_k5crypto=no
+fi
+
+ if test $have_k5crypto = yes; then
+ CRYPTOLIB=-lk5crypto
+ LIBS="$CRYPTOLIB $LIBS"
+
+$as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h
+
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5
+$as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; }
+if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lkrb5 $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 krb5_init_context ();
+int
+main ()
+{
+return krb5_init_context ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_krb5_krb5_init_context=yes
+else
+ ac_cv_lib_krb5_krb5_init_context=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_krb5_krb5_init_context" >&5
+$as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; }
+if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then :
+ have_krb5=yes
+else
+ have_krb5=no
+fi
+
+ if test $have_krb5=yes; then
+ KRB5LIB=-lkrb5
+ LIBS="$KRB5LIB $LIBS"
+
+$as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h
+
+ fi
+ if test "${with_kerberos5}" = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5
+$as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; }
+if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldes425 $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 des_cbc_encrypt ();
+int
+main ()
+{
+return des_cbc_encrypt ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_des425_des_cbc_encrypt=yes
+else
+ ac_cv_lib_des425_des_cbc_encrypt=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_des425_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then :
+ have_des425=yes
+else
+ have_des425=no
+fi
+
+ if test $have_des425 = yes; then
+ DESLIB=-ldes425
+ LIBS="$DESLIB $LIBS"
+
+$as_echo "#define HAVE_LIBDES425 1" >>confdefs.h
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5
+$as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; }
+if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldes $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 des_cbc_encrypt ();
+int
+main ()
+{
+return des_cbc_encrypt ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_des_des_cbc_encrypt=yes
+else
+ ac_cv_lib_des_des_cbc_encrypt=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_des_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then :
+ have_des=yes
+else
+ have_des=no
+fi
+
+ if test $have_des = yes; then
+ DESLIB=-ldes
+ LIBS="$DESLIB $LIBS"
+
+$as_echo "#define HAVE_LIBDES 1" >>confdefs.h
+
+ fi
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5
+$as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; }
+if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lkrb4 $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 krb_get_cred ();
+int
+main ()
+{
+return krb_get_cred ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_krb4_krb_get_cred=yes
+else
+ ac_cv_lib_krb4_krb_get_cred=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_krb4_krb_get_cred" >&5
+$as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; }
+if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then :
+ have_krb4=yes
+else
+ have_krb4=no
+fi
+
+ if test $have_krb4 = yes; then
+ KRB4LIB=-lkrb4
+ LIBS="$KRB4LIB $LIBS"
+
+$as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5
+$as_echo_n "checking for krb_get_cred in -lkrb... " >&6; }
+if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lkrb $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 krb_get_cred ();
+int
+main ()
+{
+return krb_get_cred ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_krb_krb_get_cred=yes
+else
+ ac_cv_lib_krb_krb_get_cred=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_krb_krb_get_cred" >&5
+$as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; }
+if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then :
+ have_krb=yes
+else
+ have_krb=no
+fi
+
+ if test $have_krb = yes; then
+ KRB4LIB=-lkrb
+ LIBS="$KRB4LIB $LIBS"
+
+$as_echo "#define HAVE_LIBKRB 1" >>confdefs.h
+
+ fi
+ fi
+ fi
+
+ if test "${with_kerberos5}" != no; then
+ for ac_header in krb5.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default"
+if test "x$ac_cv_header_krb5_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KRB5_H 1
+_ACEOF
+ ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include <krb5.h>
+"
+if test "x$ac_cv_member_krb5_error_text" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_KRB5_ERROR_TEXT 1
+_ACEOF
+
+
+fi
+ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include <krb5.h>
+"
+if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_KRB5_ERROR_E_TEXT 1
+_ACEOF
+
+
+fi
+
+fi
+
+done
+
+ else
+ for ac_header in des.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default"
+if test "x$ac_cv_header_des_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_DES_H 1
+_ACEOF
+
+else
+ for ac_header in kerberosIV/des.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROSIV_DES_H 1
+_ACEOF
+
+else
+ for ac_header in kerberos/des.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberos_des_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROS_DES_H 1
+_ACEOF
+
+fi
+
+done
+
+fi
+
+done
+
+fi
+
+done
+
+ for ac_header in krb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default"
+if test "x$ac_cv_header_krb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KRB_H 1
+_ACEOF
+
+else
+ for ac_header in kerberosIV/krb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROSIV_KRB_H 1
+_ACEOF
+
+else
+ for ac_header in kerberos/krb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROS_KRB_H 1
+_ACEOF
+
+fi
+
+done
+
+fi
+
+done
+
+fi
+
+done
+
+ fi
+ for ac_header in com_err.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default"
+if test "x$ac_cv_header_com_err_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_COM_ERR_H 1
+_ACEOF
+
+fi
+
+done
+
+fi
+
+
+
+
+
+
+
+# Solaris requires -lintl if you want strerror (which calls dgettext)
+# to return localized messages.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dgettext in -lintl" >&5
+$as_echo_n "checking for dgettext in -lintl... " >&6; }
+if test "${ac_cv_lib_intl_dgettext+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lintl $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 dgettext ();
+int
+main ()
+{
+return dgettext ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_intl_dgettext=yes
+else
+ ac_cv_lib_intl_dgettext=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_intl_dgettext" >&5
+$as_echo "$ac_cv_lib_intl_dgettext" >&6; }
+if test "x$ac_cv_lib_intl_dgettext" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBINTL 1
+_ACEOF
+
+ LIBS="-lintl $LIBS"
+
+fi
+
+
+{ $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 :
+ $as_echo_n "(cached) " >&6
+else
+ if test x$ac_cv_func_tzset = xyes; then
+if test "$cross_compiling" = yes; then :
+ # If we have tzset, assume the worst when cross-compiling.
+emacs_cv_localtime_cache=yes
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <time.h>
+char TZ_GMT0[] = "TZ=GMT0";
+char TZ_PST8[] = "TZ=PST8";
+main()
+{
+ time_t now = time ((time_t *) 0);
+ int hour_GMT0, hour_unset;
+ if (putenv (TZ_GMT0) != 0)
+ exit (1);
+ hour_GMT0 = localtime (&now)->tm_hour;
+ unsetenv("TZ");
+ hour_unset = localtime (&now)->tm_hour;
+ if (putenv (TZ_PST8) != 0)
+ exit (1);
+ if (localtime (&now)->tm_hour == hour_GMT0)
+ exit (1);
+ unsetenv("TZ");
+ if (localtime (&now)->tm_hour != hour_unset)
+ exit (1);
+ exit (0);
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ emacs_cv_localtime_cache=no
+else
+ emacs_cv_localtime_cache=yes
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+else
+ # If we lack tzset, report that localtime does not cache TZ,
+ # since we can't invalidate the cache if we don't have tzset.
+ emacs_cv_localtime_cache=no
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_localtime_cache" >&5
+$as_echo "$emacs_cv_localtime_cache" >&6; }
+if test $emacs_cv_localtime_cache = yes; then
+
+$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 :
+
+else
+ ok_so_far=no
+fi
+
+if test $ok_so_far = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default"
+if test "x$ac_cv_header_netinet_in_h" = x""yes; then :
+
+else
+ ok_so_far=no
+fi
+
+
+fi
+if test $ok_so_far = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default"
+if test "x$ac_cv_header_arpa_inet_h" = x""yes; then :
+
+else
+ ok_so_far=no
+fi
+
+
+fi
+if test $ok_so_far = yes; then
+
+$as_echo "#define HAVE_INET_SOCKETS 1" >>confdefs.h
+
+fi
+
+if test -f /usr/lpp/X11/bin/smt.exp; then
+
+$as_echo "#define HAVE_AIX_SMT_EXP 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system supports dynamic ptys" >&5
+$as_echo_n "checking whether system supports dynamic ptys... " >&6; }
+if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+
+$as_echo "#define HAVE_DEV_PTMX 1" >>confdefs.h
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+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 :
+
+else
+
+cat >>confdefs.h <<_ACEOF
+#define pid_t int
+_ACEOF
+
+fi
+
+for ac_header in vfork.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default"
+if test "x$ac_cv_header_vfork_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_VFORK_H 1
+_ACEOF
+
+fi
+
+done
+
+for ac_func in fork vfork
+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
+
+if test "x$ac_cv_func_fork" = xyes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5
+$as_echo_n "checking for working fork... " >&6; }
+if test "${ac_cv_func_fork_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ ac_cv_func_fork_works=cross
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+
+ /* By Ruediger Kuhlmann. */
+ return fork () < 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_fork_works=yes
+else
+ ac_cv_func_fork_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_fork_works" >&5
+$as_echo "$ac_cv_func_fork_works" >&6; }
+
+else
+ ac_cv_func_fork_works=$ac_cv_func_fork
+fi
+if test "x$ac_cv_func_fork_works" = xcross; then
+ case $host in
+ *-*-amigaos* | *-*-msdosdjgpp*)
+ # Override, as these systems have only a dummy fork() stub
+ ac_cv_func_fork_works=no
+ ;;
+ *)
+ ac_cv_func_fork_works=yes
+ ;;
+ esac
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5
+$as_echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;}
+fi
+ac_cv_func_vfork_works=$ac_cv_func_vfork
+if test "x$ac_cv_func_vfork" = xyes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5
+$as_echo_n "checking for working vfork... " >&6; }
+if test "${ac_cv_func_vfork_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ ac_cv_func_vfork_works=cross
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Thanks to Paul Eggert for this test. */
+$ac_includes_default
+#include <sys/wait.h>
+#ifdef HAVE_VFORK_H
+# include <vfork.h>
+#endif
+/* On some sparc systems, changes by the child to local and incoming
+ argument registers are propagated back to the parent. The compiler
+ is told about this with #include <vfork.h>, but some compilers
+ (e.g. gcc -O) don't grok <vfork.h>. Test for this by using a
+ static variable whose address is put into a register that is
+ clobbered by the vfork. */
+static void
+#ifdef __cplusplus
+sparc_address_test (int arg)
+# else
+sparc_address_test (arg) int arg;
+#endif
+{
+ static pid_t child;
+ if (!child) {
+ child = vfork ();
+ if (child < 0) {
+ perror ("vfork");
+ _exit(2);
+ }
+ if (!child) {
+ arg = getpid();
+ write(-1, "", 0);
+ _exit (arg);
+ }
+ }
+}
+
+int
+main ()
+{
+ pid_t parent = getpid ();
+ pid_t child;
+
+ sparc_address_test (0);
+
+ child = vfork ();
+
+ if (child == 0) {
+ /* Here is another test for sparc vfork register problems. This
+ test uses lots of local variables, at least as many local
+ variables as main has allocated so far including compiler
+ temporaries. 4 locals are enough for gcc 1.40.3 on a Solaris
+ 4.1.3 sparc, but we use 8 to be safe. A buggy compiler should
+ reuse the register of parent for one of the local variables,
+ since it will think that parent can't possibly be used any more
+ in this routine. Assigning to the local variable will thus
+ munge parent in the parent process. */
+ pid_t
+ p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(),
+ p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid();
+ /* Convince the compiler that p..p7 are live; otherwise, it might
+ use the same hardware register for all 8 local variables. */
+ if (p != p1 || p != p2 || p != p3 || p != p4
+ || p != p5 || p != p6 || p != p7)
+ _exit(1);
+
+ /* On some systems (e.g. IRIX 3.3), vfork doesn't separate parent
+ from child file descriptors. If the child closes a descriptor
+ before it execs or exits, this munges the parent's descriptor
+ as well. Test for this by closing stdout in the child. */
+ _exit(close(fileno(stdout)) != 0);
+ } else {
+ int status;
+ struct stat st;
+
+ while (wait(&status) != child)
+ ;
+ return (
+ /* Was there some problem with vforking? */
+ child < 0
+
+ /* Did the child fail? (This shouldn't happen.) */
+ || status
+
+ /* Did the vfork/compiler bug occur? */
+ || parent != getpid()
+
+ /* Did the file descriptor bug occur? */
+ || fstat(fileno(stdout), &st) != 0
+ );
+ }
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_vfork_works=yes
+else
+ ac_cv_func_vfork_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_vfork_works" >&5
+$as_echo "$ac_cv_func_vfork_works" >&6; }
+
+fi;
+if test "x$ac_cv_func_fork_works" = xcross; then
+ ac_cv_func_vfork_works=$ac_cv_func_vfork
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5
+$as_echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;}
+fi
+
+if test "x$ac_cv_func_vfork_works" = xyes; then
+
+$as_echo "#define HAVE_WORKING_VFORK 1" >>confdefs.h
+
+else
+
+$as_echo "#define vfork fork" >>confdefs.h
+
+fi
+if test "x$ac_cv_func_fork_works" = xyes; then
+
+$as_echo "#define HAVE_WORKING_FORK 1" >>confdefs.h
+
+fi
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5
+$as_echo_n "checking for nl_langinfo and CODESET... " >&6; }
+if test "${emacs_cv_langinfo_codeset+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <langinfo.h>
+int
+main ()
+{
+char* cs = nl_langinfo(CODESET);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_langinfo_codeset=yes
+else
+ emacs_cv_langinfo_codeset=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_langinfo_codeset" >&5
+$as_echo "$emacs_cv_langinfo_codeset" >&6; }
+if test $emacs_cv_langinfo_codeset = yes; then
+
+$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5
+$as_echo_n "checking for mbstate_t... " >&6; }
+if test "${ac_cv_type_mbstate_t+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+# include <wchar.h>
+int
+main ()
+{
+mbstate_t x; return sizeof x;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_type_mbstate_t=yes
+else
+ ac_cv_type_mbstate_t=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_mbstate_t" >&5
+$as_echo "$ac_cv_type_mbstate_t" >&6; }
+ if test $ac_cv_type_mbstate_t = yes; then
+
+$as_echo "#define HAVE_MBSTATE_T 1" >>confdefs.h
+
+ else
+
+$as_echo "#define mbstate_t int" >>confdefs.h
+
+ fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5
+$as_echo_n "checking for C restricted array declarations... " >&6; }
+if test "${emacs_cv_c_restrict_arr+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+void fred (int x[__restrict]);
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_c_restrict_arr=yes
+else
+ emacs_cv_c_restrict_arr=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_c_restrict_arr" >&5
+$as_echo "$emacs_cv_c_restrict_arr" >&6; }
+if test "$emacs_cv_c_restrict_arr" = yes; then
+
+$as_echo "#define __restrict_arr __restrict" >>confdefs.h
+
+fi
+
+
+
+# Set up the CFLAGS for real compilation, so we can substitute it.
+CFLAGS="$REAL_CFLAGS"
+CPPFLAGS="$REAL_CPPFLAGS"
+
+## Hack to detect a buggy GCC version.
+if test "x$GCC" = xyes \
+ && test x"`$CC --version 2> /dev/null | grep 'gcc.* 4.5.0'`" != x \
+ && test x"`echo $CFLAGS | grep '\-O[23]'`" != x \
+ && test x"`echo $CFLAGS | grep '\-fno-optimize-sibling-calls'`" = x; then
+ as_fn_error "GCC 4.5.0 has problems compiling Emacs; see etc/PROBLEMS'." "$LINENO" 5
+fi
+
+version=$PACKAGE_VERSION
+
+### Specify what sort of things we'll be editing into Makefile and config.h.
+### Use configuration here uncanonicalized to avoid exceeding size limits.
+
+
+## Unused?
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+## 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.
+
+
+
+
+## Used in lwlib/Makefile.in.
+
+if test -n "${machfile}"; then
+ M_FILE="\$(srcdir)/${machfile}"
+else
+ M_FILE=
+fi
+S_FILE="\$(srcdir)/${opsysfile}"
+
+
+
+
+
+
+
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define EMACS_CONFIGURATION "${canonical}"
+_ACEOF
+
+
+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}"
+_ACEOF
+
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define config_opsysfile "${opsysfile}"
+_ACEOF
+
+
+XMENU_OBJ=
+XOBJ=
+FONT_OBJ=
+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"
+ FONT_OBJ=xfont.o
+ if test "$HAVE_XFT" = "yes"; then
+ FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
+ elif test "$HAVE_FREETYPE" = "yes"; then
+ FONT_OBJ="$FONT_OBJ ftfont.o ftxfont.o"
+ fi
+
+fi
+
+
+
+
+WIDGET_OBJ=
+MOTIF_LIBW=
+if test "${USE_X_TOOLKIT}" != "none" ; then
+ WIDGET_OBJ=widget.o
+
+$as_echo "#define USE_X_TOOLKIT 1" >>confdefs.h
+
+ if test "${USE_X_TOOLKIT}" = "LUCID"; then
+
+$as_echo "#define USE_LUCID 1" >>confdefs.h
+
+ elif test "${USE_X_TOOLKIT}" = "MOTIF"; then
+
+$as_echo "#define USE_MOTIF 1" >>confdefs.h
+
+ MOTIF_LIBW=-lXm
+ case "$opsys" in
+ gnu-linux)
+ ## Paul Abrahams <abrahams at equinox.shaysnet.com> says this is needed.
+ MOTIF_LIBW="$MOTIF_LIBW -lXpm"
+ ;;
+
+ unixware)
+ ## Richard Anthony Ryan <ryanr at ellingtn.ftc.nrcs.usda.gov>
+ ## says -lXimp is needed in UNIX_SV ... 4.2 1.1.2.
+ MOTIF_LIBW="MOTIF_LIBW -lXimp"
+ ;;
+
+ aix4-2)
+ ## olson@mcs.anl.gov says -li18n is needed by -lXm.
+ MOTIF_LIBW="$MOTIF_LIBW -li18n"
+ ;;
+ esac
+ MOTIF_LIBW="$MOTIF_LIBW $LIBXP"
+ fi
+fi
+
+
+TOOLKIT_LIBW=
+case "$USE_X_TOOLKIT" in
+ MOTIF) TOOLKIT_LIBW="$MOTIF_LIBW" ;;
+ LUCID) TOOLKIT_LIBW="$LUCID_LIBW" ;;
+ none) test "x$HAVE_GTK" = "xyes" && TOOLKIT_LIBW="$GTK_LIBS" ;;
+esac
+
+
+if test "$USE_X_TOOLKIT" = "none"; then
+ LIBXT_OTHER="\$(LIBXSM)"
+ OLDXMENU_TARGET="really-oldXMenu"
+else
+ LIBXT_OTHER="\$(LIBXMU) -lXt \$(LIBXTR6) -lXext"
+ OLDXMENU_TARGET="really-lwlib"
+fi
+
+
+## The X Menu stuff is present in the X10 distribution, but missing
+## from X11. If we have X10, just use the installed library;
+## otherwise, use our own copy.
+if test "${HAVE_X11}" = "yes" ; then
+
+$as_echo "#define HAVE_X11 1" >>confdefs.h
+
+
+ if test "$USE_X_TOOLKIT" = "none"; then
+ OLDXMENU="\${oldXMenudir}/libXMenu11.a"
+ else
+ OLDXMENU="\${lwlibdir}/liblw.a"
+ fi
+ LIBXMENU="\$(OLDXMENU)"
+ LIBX_OTHER="\$(LIBXT) \$(LIBX_EXTRA)"
+ OLDXMENU_DEPS="\${OLDXMENU} ../src/\${OLDXMENU}"
+else
+ ## For a syntactically valid Makefile; not actually used for anything.
+ ## See comments in src/Makefile.in.
+ OLDXMENU=nothing
+ ## FIXME This case (!HAVE_X11 && HAVE_X_WINDOWS) is no longer possible(?).
+ if test "${HAVE_X_WINDOWS}" = "yes"; then
+ LIBXMENU="-lXMenu"
+ else
+ LIBXMENU=
+ fi
+ LIBX_OTHER=
+ OLDXMENU_DEPS=
+fi
+
+if test "$HAVE_GTK" = "yes" || test "$HAVE_MENUS" != "yes"; then
+ OLDXMENU_TARGET=
+ OLDXMENU=nothing
+ LIBXMENU=
+ OLDXMENU_DEPS=
+fi
+
+
+
+
+
+
+
+if test "${HAVE_MENUS}" = "yes" ; then
+
+$as_echo "#define HAVE_MENUS 1" >>confdefs.h
+
+fi
+
+if test "${GNU_MALLOC}" = "yes" ; then
+
+$as_echo "#define GNU_MALLOC 1" >>confdefs.h
+
+fi
+
+RALLOC_OBJ=
+if test "${REL_ALLOC}" = "yes" ; then
+
+$as_echo "#define REL_ALLOC 1" >>confdefs.h
+
+
+ test "$system_malloc" != "yes" && RALLOC_OBJ=ralloc.o
+fi
+
+
+if test "$opsys" = "cygwin"; then
+ CYGWIN_OBJ="sheap.o"
+ ## Cygwin differs because of its unexec().
+ PRE_ALLOC_OBJ=
+ POST_ALLOC_OBJ=lastfile.o
+else
+ CYGWIN_OBJ=
+ PRE_ALLOC_OBJ=lastfile.o
+ POST_ALLOC_OBJ=
+fi
+
+
+
+
+# Configure gnulib here, now that we know LIBS.
@@ -13924,6 +15716,197 @@ fi
LIBC_FATAL_STDERR_=1
export LIBC_FATAL_STDERR_
+# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
+# for constant arguments. Useless!
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5
+$as_echo_n "checking for working alloca.h... " >&6; }
+if test "${ac_cv_working_alloca_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <alloca.h>
+int
+main ()
+{
+char *p = (char *) alloca (2 * sizeof (int));
+ if (p) return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_working_alloca_h=yes
+else
+ ac_cv_working_alloca_h=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: $ac_cv_working_alloca_h" >&5
+$as_echo "$ac_cv_working_alloca_h" >&6; }
+if test $ac_cv_working_alloca_h = yes; then
+
+$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5
+$as_echo_n "checking for alloca... " >&6; }
+if test "${ac_cv_func_alloca_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+#else
+# ifdef _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+# else
+# ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+# else
+# ifdef _AIX
+ #pragma alloca
+# else
+# ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+# endif
+# endif
+# endif
+# endif
+#endif
+
+int
+main ()
+{
+char *p = (char *) alloca (1);
+ if (p) return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_func_alloca_works=yes
+else
+ ac_cv_func_alloca_works=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: $ac_cv_func_alloca_works" >&5
+$as_echo "$ac_cv_func_alloca_works" >&6; }
+
+if test $ac_cv_func_alloca_works = yes; then
+
+$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h
+
+else
+ # The SVR3 libPW and SVR4 libucb both contain incompatible functions
+# that cause trouble. Some versions do not even contain alloca or
+# contain a buggy version. If you still want to use their alloca,
+# use ar to extract alloca.o from them instead of compiling alloca.c.
+
+
+
+
+
+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; }
+if test "${ac_cv_os_cray+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if defined CRAY && ! defined CRAY2
+webecray
+#else
+wenotbecray
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "webecray" >/dev/null 2>&1; then :
+ ac_cv_os_cray=yes
+else
+ ac_cv_os_cray=no
+fi
+rm -f conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5
+$as_echo "$ac_cv_os_cray" >&6; }
+if test $ac_cv_os_cray = yes; then
+ for ac_func in _getb67 GETB67 getb67; 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 CRAY_STACKSEG_END $ac_func
+_ACEOF
+
+ break
+fi
+
+ done
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5
+$as_echo_n "checking stack direction for C alloca... " >&6; }
+if test "${ac_cv_c_stack_direction+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ ac_cv_c_stack_direction=0
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+find_stack_direction (int *addr, int depth)
+{
+ int dir, dummy = 0;
+ if (! addr)
+ addr = &dummy;
+ *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1;
+ dir = depth ? find_stack_direction (addr, depth - 1) : 0;
+ return dir + dummy;
+}
+
+int
+main (int argc, char **argv)
+{
+ return find_stack_direction (0, argc + !argv + 20) < 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_c_stack_direction=1
+else
+ ac_cv_c_stack_direction=-1
+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_c_stack_direction" >&5
+$as_echo "$ac_cv_c_stack_direction" >&6; }
+cat >>confdefs.h <<_ACEOF
+#define STACK_DIRECTION $ac_cv_c_stack_direction
+_ACEOF
+
+
+fi
+
@@ -14254,6 +16237,121 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
fi
+
+ GNULIB_CHOWN=0;
+ GNULIB_CLOSE=0;
+ GNULIB_DUP2=0;
+ GNULIB_DUP3=0;
+ GNULIB_ENVIRON=0;
+ GNULIB_EUIDACCESS=0;
+ GNULIB_FACCESSAT=0;
+ GNULIB_FCHDIR=0;
+ GNULIB_FCHOWNAT=0;
+ GNULIB_FSYNC=0;
+ GNULIB_FTRUNCATE=0;
+ GNULIB_GETCWD=0;
+ GNULIB_GETDOMAINNAME=0;
+ GNULIB_GETDTABLESIZE=0;
+ GNULIB_GETGROUPS=0;
+ GNULIB_GETHOSTNAME=0;
+ GNULIB_GETLOGIN=0;
+ GNULIB_GETLOGIN_R=0;
+ GNULIB_GETPAGESIZE=0;
+ GNULIB_GETUSERSHELL=0;
+ GNULIB_GROUP_MEMBER=0;
+ GNULIB_LCHOWN=0;
+ GNULIB_LINK=0;
+ GNULIB_LINKAT=0;
+ GNULIB_LSEEK=0;
+ GNULIB_PIPE=0;
+ GNULIB_PIPE2=0;
+ GNULIB_PREAD=0;
+ GNULIB_PWRITE=0;
+ GNULIB_READ=0;
+ GNULIB_READLINK=0;
+ GNULIB_READLINKAT=0;
+ GNULIB_RMDIR=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;
+ GNULIB_UNLINKAT=0;
+ GNULIB_USLEEP=0;
+ GNULIB_WRITE=0;
+ HAVE_CHOWN=1;
+ HAVE_DUP2=1;
+ HAVE_DUP3=1;
+ HAVE_EUIDACCESS=1;
+ HAVE_FACCESSAT=1;
+ HAVE_FCHDIR=1;
+ HAVE_FCHOWNAT=1;
+ HAVE_FSYNC=1;
+ HAVE_FTRUNCATE=1;
+ HAVE_GETDTABLESIZE=1;
+ HAVE_GETGROUPS=1;
+ HAVE_GETHOSTNAME=1;
+ HAVE_GETLOGIN=1;
+ HAVE_GETPAGESIZE=1;
+ HAVE_GROUP_MEMBER=1;
+ HAVE_LCHOWN=1;
+ HAVE_LINK=1;
+ HAVE_LINKAT=1;
+ HAVE_PIPE=1;
+ HAVE_PIPE2=1;
+ HAVE_PREAD=1;
+ HAVE_PWRITE=1;
+ HAVE_READLINK=1;
+ HAVE_READLINKAT=1;
+ HAVE_SLEEP=1;
+ HAVE_SYMLINK=1;
+ HAVE_SYMLINKAT=1;
+ HAVE_UNLINKAT=1;
+ HAVE_USLEEP=1;
+ HAVE_DECL_ENVIRON=1;
+ HAVE_DECL_FCHDIR=1;
+ HAVE_DECL_GETDOMAINNAME=1;
+ HAVE_DECL_GETLOGIN_R=1;
+ HAVE_DECL_GETPAGESIZE=1;
+ HAVE_DECL_GETUSERSHELL=1;
+ HAVE_DECL_TTYNAME_R=1;
+ HAVE_OS_H=0;
+ HAVE_SYS_PARAM_H=0;
+ REPLACE_CHOWN=0;
+ REPLACE_CLOSE=0;
+ REPLACE_DUP=0;
+ REPLACE_DUP2=0;
+ REPLACE_FCHOWNAT=0;
+ REPLACE_GETCWD=0;
+ REPLACE_GETDOMAINNAME=0;
+ REPLACE_GETLOGIN_R=0;
+ REPLACE_GETGROUPS=0;
+ REPLACE_GETPAGESIZE=0;
+ REPLACE_LCHOWN=0;
+ REPLACE_LINK=0;
+ REPLACE_LINKAT=0;
+ REPLACE_LSEEK=0;
+ REPLACE_PREAD=0;
+ REPLACE_PWRITE=0;
+ REPLACE_READ=0;
+ REPLACE_READLINK=0;
+ REPLACE_RMDIR=0;
+ REPLACE_SLEEP=0;
+ REPLACE_SYMLINK=0;
+ REPLACE_TTYNAME_R=0;
+ REPLACE_UNLINK=0;
+ REPLACE_UNLINKAT=0;
+ REPLACE_USLEEP=0;
+ REPLACE_WRITE=0;
+ UNISTD_H_HAVE_WINSOCK2_H=0;
+ 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 :
@@ -14368,117 +16466,6 @@ _ACEOF
REPLACE_WCTOMB=0;
- GNULIB_CHOWN=0;
- GNULIB_CLOSE=0;
- GNULIB_DUP2=0;
- GNULIB_DUP3=0;
- GNULIB_ENVIRON=0;
- GNULIB_EUIDACCESS=0;
- GNULIB_FACCESSAT=0;
- GNULIB_FCHDIR=0;
- GNULIB_FCHOWNAT=0;
- GNULIB_FSYNC=0;
- GNULIB_FTRUNCATE=0;
- GNULIB_GETCWD=0;
- GNULIB_GETDOMAINNAME=0;
- GNULIB_GETDTABLESIZE=0;
- GNULIB_GETGROUPS=0;
- GNULIB_GETHOSTNAME=0;
- GNULIB_GETLOGIN=0;
- GNULIB_GETLOGIN_R=0;
- GNULIB_GETPAGESIZE=0;
- GNULIB_GETUSERSHELL=0;
- GNULIB_LCHOWN=0;
- GNULIB_LINK=0;
- GNULIB_LINKAT=0;
- GNULIB_LSEEK=0;
- GNULIB_PIPE=0;
- GNULIB_PIPE2=0;
- GNULIB_PREAD=0;
- GNULIB_PWRITE=0;
- GNULIB_READ=0;
- GNULIB_READLINK=0;
- GNULIB_READLINKAT=0;
- GNULIB_RMDIR=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;
- GNULIB_UNLINKAT=0;
- GNULIB_USLEEP=0;
- GNULIB_WRITE=0;
- HAVE_CHOWN=1;
- HAVE_DUP2=1;
- HAVE_DUP3=1;
- HAVE_EUIDACCESS=1;
- HAVE_FACCESSAT=1;
- HAVE_FCHDIR=1;
- HAVE_FCHOWNAT=1;
- HAVE_FSYNC=1;
- HAVE_FTRUNCATE=1;
- HAVE_GETDTABLESIZE=1;
- HAVE_GETGROUPS=1;
- HAVE_GETHOSTNAME=1;
- HAVE_GETLOGIN=1;
- HAVE_GETPAGESIZE=1;
- HAVE_LCHOWN=1;
- HAVE_LINK=1;
- HAVE_LINKAT=1;
- HAVE_PIPE=1;
- HAVE_PIPE2=1;
- HAVE_PREAD=1;
- HAVE_PWRITE=1;
- HAVE_READLINK=1;
- HAVE_READLINKAT=1;
- HAVE_SLEEP=1;
- HAVE_SYMLINK=1;
- HAVE_SYMLINKAT=1;
- HAVE_UNLINKAT=1;
- HAVE_USLEEP=1;
- HAVE_DECL_ENVIRON=1;
- HAVE_DECL_FCHDIR=1;
- HAVE_DECL_GETDOMAINNAME=1;
- HAVE_DECL_GETLOGIN_R=1;
- HAVE_DECL_GETPAGESIZE=1;
- HAVE_DECL_GETUSERSHELL=1;
- HAVE_DECL_TTYNAME_R=1;
- HAVE_OS_H=0;
- HAVE_SYS_PARAM_H=0;
- REPLACE_CHOWN=0;
- REPLACE_CLOSE=0;
- REPLACE_DUP=0;
- REPLACE_DUP2=0;
- REPLACE_FCHOWNAT=0;
- REPLACE_GETCWD=0;
- REPLACE_GETDOMAINNAME=0;
- REPLACE_GETLOGIN_R=0;
- REPLACE_GETGROUPS=0;
- REPLACE_GETPAGESIZE=0;
- REPLACE_LCHOWN=0;
- REPLACE_LINK=0;
- REPLACE_LINKAT=0;
- REPLACE_LSEEK=0;
- REPLACE_PREAD=0;
- REPLACE_PWRITE=0;
- REPLACE_READ=0;
- REPLACE_READLINK=0;
- REPLACE_RMDIR=0;
- REPLACE_SLEEP=0;
- REPLACE_SYMLINK=0;
- REPLACE_TTYNAME_R=0;
- REPLACE_UNLINK=0;
- REPLACE_UNLINKAT=0;
- REPLACE_USLEEP=0;
- REPLACE_WRITE=0;
- UNISTD_H_HAVE_WINSOCK2_H=0;
- UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS=0;
-
-
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5
$as_echo_n "checking whether the preprocessor supports include_next... " >&6; }
@@ -14718,7 +16705,7 @@ int *p = &optreset; return optreset;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
+if ac_fn_c_try_link "$LINENO"; then :
gl_optind_min=1
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -14739,7 +16726,8 @@ else
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+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"
@@ -14762,22 +16750,20 @@ int
main ()
{
{
- int argc = 0;
- char *argv[10];
+ 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;
- argv[argc++] = "program";
- argv[argc++] = "-a";
- argv[argc++] = "foo";
- argv[argc++] = "bar";
- argv[argc] = NULL;
optind = OPTIND_MIN;
opterr = 0;
- c = getopt (argc, argv, "ab");
+ c = getopt (4, argv, "ab");
if (!(c == 'a'))
return 1;
- c = getopt (argc, argv, "ab");
+ c = getopt (4, argv, "ab");
if (!(c == -1))
return 2;
if (!(optind == 2))
@@ -14785,22 +16771,20 @@ main ()
}
/* Some internal state exists at this point. */
{
- int argc = 0;
- char *argv[10];
+ 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;
- argv[argc++] = "program";
- argv[argc++] = "donald";
- argv[argc++] = "-p";
- argv[argc++] = "billy";
- argv[argc++] = "duck";
- argv[argc++] = "-a";
- argv[argc++] = "bar";
- argv[argc] = NULL;
optind = OPTIND_MIN;
opterr = 0;
- c = getopt (argc, argv, "+abp:q:");
+ c = getopt (7, argv, "+abp:q:");
if (!(c == -1))
return 4;
if (!(strcmp (argv[0], "program") == 0))
@@ -14822,7 +16806,9 @@ main ()
}
/* Detect MacOS 10.5, AIX 7.1 bug. */
{
- char *argv[3] = { "program", "-ab", NULL };
+ 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')
@@ -14901,19 +16887,22 @@ main ()
and fails on MacOS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
OSF/1 5.1, Solaris 10. */
{
- char *myargv[3];
- myargv[0] = "conftest";
- myargv[1] = "-+";
- myargv[2] = 0;
+ static char conftest[] = "conftest";
+ static char plus[] = "-+";
+ char *argv[3] = { conftest, plus, NULL };
opterr = 0;
- if (getopt (2, myargv, "+a") != '?')
+ if (getopt (2, argv, "+a") != '?')
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,
IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */
{
- char *argv[] = { "program", "-p", "foo", "bar", NULL };
+ static char program[] = "program";
+ static char p[] = "-p";
+ static char foo[] = "foo";
+ static char bar[] = "bar";
+ char *argv[] = { program, p, foo, bar, NULL };
optind = 1;
if (getopt (4, argv, "p::") != 'p')
@@ -14927,7 +16916,10 @@ main ()
}
/* This code succeeds on glibc 2.8 and fails on Cygwin 1.7.0. */
{
- char *argv[] = { "program", "foo", "-p", NULL };
+ static char program[] = "program";
+ static char foo[] = "foo";
+ static char p[] = "-p";
+ char *argv[] = { program, foo, p, NULL };
optind = 0;
if (getopt (3, argv, "-p") != 1)
result |= 16;
@@ -14936,13 +16928,26 @@ main ()
}
/* This code fails on glibc 2.11. */
{
- char *argv[] = { "program", "-b", "-a", NULL };
+ static char program[] = "program";
+ static char b[] = "-b";
+ static char a[] = "-a";
+ char *argv[] = { program, b, a, NULL };
optind = opterr = 0;
if (getopt (3, argv, "+:a:b") != 'b')
result |= 64;
else if (getopt (3, argv, "+:a:b") != ':')
result |= 64;
}
+ /* This code dumps core on glibc 2.14. */
+ {
+ static char program[] = "program";
+ static char w[] = "-W";
+ static char dummy[] = "dummy";
+ char *argv[] = { program, w, dummy, NULL };
+ optind = opterr = 1;
+ if (getopt (3, argv, "W;") != 'W')
+ result |= 128;
+ }
return result;
;
@@ -14972,60 +16977,41 @@ $as_echo "$gl_cv_func_getopt_gnu" >&6; }
fi
fi
-ac_fn_c_check_decl "$LINENO" "getenv" "ac_cv_have_decl_getenv" "$ac_includes_default"
-if test "x$ac_cv_have_decl_getenv" = x""yes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_GETENV $ac_have_decl
-_ACEOF
+ REPLACE_GETOPT=0
if test -n "$gl_replace_getopt"; then :
+ REPLACE_GETOPT=1
-
- GETOPT_H=getopt.h
-
-$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
-
-
-
- GNULIB_UNISTD_H_GETOPT=1
-
-
-
-
-
-
-
-
- gl_LIBOBJS="$gl_LIBOBJS getopt.$ac_objext"
-
-
-
-
-
-
-
+fi
- gl_LIBOBJS="$gl_LIBOBJS getopt1.$ac_objext"
+ if test $REPLACE_GETOPT = 1; then
+ GETOPT_H=getopt.h
+$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"
+if test "x$ac_cv_have_decl_getenv" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
fi
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_GETENV $ac_have_decl
+_ACEOF
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5
@@ -15921,6 +17907,81 @@ fi
UINT64_MAX_EQ_ULONG_MAX='defined _LP64';
+
+
+
+
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_inttypes_h='<'inttypes.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <inttypes.h>" >&5
+$as_echo_n "checking absolute name of <inttypes.h>... " >&6; }
+if test "${gl_cv_next_inttypes_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_inttypes_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <inttypes.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+ gl_cv_next_inttypes_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n '\#/inttypes.h#{
+ s#.*"\(.*/inttypes.h\)".*#\1#
+ s#^/[^/]#//&#
+ p
+ q
+ }'`'"'
+ else
+ gl_cv_next_inttypes_h='<'inttypes.h'>'
+ fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_inttypes_h" >&5
+$as_echo "$gl_cv_next_inttypes_h" >&6; }
+ fi
+ NEXT_INTTYPES_H=$gl_cv_next_inttypes_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='<'inttypes.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_inttypes_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H=$gl_next_as_first_directive
+
+
+
+
+
+
+
+
+$as_echo "#define GL_TRIGGER_STDC_LIMIT_MACROS 1" >>confdefs.h
+
+
+
+
+
+
GNULIB_FCHMODAT=0;
GNULIB_FSTATAT=0;
GNULIB_FUTIMENS=0;
@@ -15957,9 +18018,9 @@ fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether lstat correctly handles trailing slash" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether lstat correctly handles trailing slash" >&5
$as_echo_n "checking whether lstat correctly handles trailing slash... " >&6; }
-if test "${ac_cv_func_lstat_dereferences_slashed_symlink+set}" = set; then :
+if test "${gl_cv_func_lstat_dereferences_slashed_symlink+set}" = set; then :
$as_echo_n "(cached) " >&6
else
rm -f conftest.sym conftest.file
@@ -15969,7 +18030,7 @@ else
# 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.
- ac_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink=no
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -15989,9 +18050,9 @@ struct stat sbuf;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_lstat_dereferences_slashed_symlink=yes
+ gl_cv_func_lstat_dereferences_slashed_symlink=yes
else
- ac_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
conftest.$ac_objext conftest.beam conftest.$ac_ext
@@ -16000,31 +18061,19 @@ fi
else
# If the 'ln -s' command failed, then we probably don't even
# have an lstat function.
- ac_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink=no
fi
rm -f conftest.sym conftest.file
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_lstat_dereferences_slashed_symlink" >&5
-$as_echo "$ac_cv_func_lstat_dereferences_slashed_symlink" >&6; }
- test $ac_cv_func_lstat_dereferences_slashed_symlink = yes &&
+{ $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 &&
cat >>confdefs.h <<_ACEOF
#define LSTAT_FOLLOWS_SLASHED_SYMLINK 1
_ACEOF
- if test "x$ac_cv_func_lstat_dereferences_slashed_symlink" = xno; then
-
-
-
-
-
-
-
-
- gl_LIBOBJS="$gl_LIBOBJS lstat.$ac_objext"
-
- fi
GNULIB_MKTIME=0;
@@ -16046,6 +18095,48 @@ _ACEOF
+ GNULIB_PTHREAD_SIGMASK=0;
+ GNULIB_SIGNAL_H_SIGPIPE=0;
+ GNULIB_SIGPROCMASK=0;
+ GNULIB_SIGACTION=0;
+ HAVE_POSIX_SIGNALBLOCKING=1;
+ HAVE_PTHREAD_SIGMASK=1;
+ HAVE_SIGSET_T=1;
+ HAVE_SIGINFO_T=1;
+ HAVE_SIGACTION=1;
+ HAVE_STRUCT_SIGACTION_SA_SIGACTION=1;
+
+ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=1;
+
+ HAVE_SIGHANDLER_T=1;
+ REPLACE_PTHREAD_SIGMASK=0;
+
+
+
+
+ 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>. */
+ #include <sys/types.h>
+
+"
+if test "x$ac_cv_type_sigset_t" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_SIGSET_T 1
+_ACEOF
+
+gl_cv_type_sigset_t=yes
+else
+ gl_cv_type_sigset_t=no
+fi
+
+ if test $gl_cv_type_sigset_t != yes; then
+ HAVE_SIGSET_T=0
+ fi
+
+
+
if test $ac_cv_header_sys_socket_h = no; then
@@ -16298,6 +18389,17 @@ 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
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_STRTOIMAX $ac_have_decl
+_ACEOF
+
ac_fn_c_check_decl "$LINENO" "strtoumax" "ac_cv_have_decl_strtoumax" "$ac_includes_default"
if test "x$ac_cv_have_decl_strtoumax" = x""yes; then :
ac_have_decl=1
@@ -16598,15 +18700,64 @@ fi
gl_source_base='lib'
+ if test $ac_cv_func_alloca_works = no; then
+ :
+ fi
+
+ # Define an additional variable used in the Makefile substitution.
+ if test $ac_cv_working_alloca_h = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca as a compiler built-in" >&5
+$as_echo_n "checking for alloca as a compiler built-in... " >&6; }
+if test "${gl_cv_rpl_alloca+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#if defined __GNUC__ || defined _AIX || defined _MSC_VER
+ Need own alloca
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "Need own alloca" >/dev/null 2>&1; then :
+ gl_cv_rpl_alloca=yes
+else
+ gl_cv_rpl_alloca=no
+fi
+rm -f conftest*
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_rpl_alloca" >&5
+$as_echo "$gl_cv_rpl_alloca" >&6; }
+ if test $gl_cv_rpl_alloca = yes; then
+
+$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h
+ ALLOCA_H=alloca.h
+ else
+ ALLOCA_H=
+ fi
+ else
+ ALLOCA_H=alloca.h
+ fi
+ if test -n "$ALLOCA_H"; then
+ GL_GENERATE_ALLOCA_H_TRUE=
+ GL_GENERATE_ALLOCA_H_FALSE='#'
+else
+ GL_GENERATE_ALLOCA_H_TRUE='#'
+ GL_GENERATE_ALLOCA_H_FALSE=
+fi
- gl_LIBOBJS="$gl_LIBOBJS md5.$ac_objext"
+ :
@@ -16624,35 +18775,138 @@ fi
- gl_LIBOBJS="$gl_LIBOBJS filemode.$ac_objext"
+
+
+
+$as_echo "#define HAVE_DUP2 1" >>confdefs.h
+
+
+ if test $HAVE_DUP2 = 1; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether dup2 works" >&5
+$as_echo_n "checking whether dup2 works... " >&6; }
+if test "${gl_cv_func_dup2_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+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;;
+ cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
+ gl_cv_func_dup2_works=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;;
+ freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
+ gl_cv_func_dup2_works=no;;
+ haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
+ gl_cv_func_dup2_works=no;;
+ *) gl_cv_func_dup2_works=yes;;
+ esac
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ #include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>
+int
+main ()
+{
+int result = 0;
+#ifdef FD_CLOEXEC
+ if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
+ result |= 1;
+#endif
+ if (dup2 (1, 1) == 0)
+ result |= 2;
+#ifdef FD_CLOEXEC
+ if (fcntl (1, F_GETFD) != FD_CLOEXEC)
+ result |= 4;
+#endif
+ close (0);
+ if (dup2 (0, 0) != -1)
+ result |= 8;
+ /* Many gnulib modules require POSIX conformance of EBADF. */
+ if (dup2 (2, 1000000) == -1 && errno != EBADF)
+ result |= 16;
+ return result;
+
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_dup2_works=yes
+else
+ gl_cv_func_dup2_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_dup2_works" >&5
+$as_echo "$gl_cv_func_dup2_works" >&6; }
+ if test "$gl_cv_func_dup2_works" = no; then
+
+
+
+ if test $ac_cv_func_dup2 = yes; then
+ REPLACE_DUP2=1
+ fi
+
-# Persuade glibc <stdlib.h> to declare getloadavg().
-# Make sure getloadavg.c is where it belongs, at configure-time.
-test -f "$srcdir/$gl_source_base/getloadavg.c" ||
- as_fn_error "$srcdir/$gl_source_base/getloadavg.c is missing" "$LINENO" 5
+ gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext"
+
+
+ fi
+ fi
+
+
+
+
+
+
+ GNULIB_DUP2=1
+
+
+
+
+
+
+
+
+
+
+
+# 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,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
+HAVE_GETLOADAVG=1
ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg"
if test "x$ac_cv_func_getloadavg" = x""yes; then :
else
- gl_have_func=no
+ gl_func_getloadavg_done=no
# Some systems with -lutil have (and need) -lkvm as well, some do not.
# On Solaris, -lkvm requires nlist from -lelf, so check that first
# to get the right answer into the cache.
# For kstat on solaris, we need to test for libelf and libkvm to force the
# definition of SVR4 below.
- if test $gl_have_func = no; then
+ if test $gl_func_getloadavg_done = no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5
$as_echo_n "checking for elf_begin in -lelf... " >&6; }
if test "${ac_cv_lib_elf_elf_begin+set}" = set; then :
@@ -16771,12 +19025,12 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5
$as_echo "$ac_cv_lib_util_getloadavg" >&6; }
if test "x$ac_cv_lib_util_getloadavg" = x""yes; then :
- LIBS="-lutil $LIBS" gl_have_func=yes
+ LIBS="-lutil $LIBS" gl_func_getloadavg_done=yes
fi
fi
- if test $gl_have_func = no; then
+ if test $gl_func_getloadavg_done = no; then
# There is a commonly available library for RS/6000 AIX.
# Since it is not a standard part of AIX, it might be installed locally.
gl_getloadavg_LIBS=$LIBS
@@ -16818,7 +19072,7 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5
$as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; }
if test "x$ac_cv_lib_getloadavg_getloadavg" = x""yes; then :
- LIBS="-lgetloadavg $LIBS" gl_have_func=yes
+ LIBS="-lgetloadavg $LIBS" gl_func_getloadavg_done=yes
else
LIBS=$gl_getloadavg_LIBS
fi
@@ -16826,22 +19080,11 @@ fi
fi
# Set up the replacement function if necessary.
- if test $gl_have_func = no; then
-
+ if test $gl_func_getloadavg_done = no; then
+ HAVE_GETLOADAVG=0
-
-
-
-
-
-
- gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext"
-
-
-# Figure out what our getloadavg.c needs.
-
-# Solaris has libkstat which does not require root.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5
+ # Solaris has libkstat which does not require root.
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5
$as_echo_n "checking for kstat_open in -lkstat... " >&6; }
if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then :
$as_echo_n "(cached) " >&6
@@ -16886,26 +19129,11 @@ _ACEOF
fi
-test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes
-
-# On HPUX9, an unprivileged user can get load averages this way.
-if test $gl_have_func = no; then
- for ac_func in pstat_getdynamic
-do :
- ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic"
-if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_PSTAT_GETDYNAMIC 1
-_ACEOF
- gl_have_func=yes
-fi
-done
-
-fi
+ test $ac_cv_lib_kstat_kstat_open = yes && gl_func_getloadavg_done=yes
-# AIX has libperfstat which does not require root
-if test $gl_have_func = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5
+ # AIX has libperfstat which does not require root
+ if test $gl_func_getloadavg_done = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5
$as_echo_n "checking for perfstat_cpu_total in -lperfstat... " >&6; }
if test "${ac_cv_lib_perfstat_perfstat_cpu_total+set}" = set; then :
$as_echo_n "(cached) " >&6
@@ -16950,17 +19178,17 @@ _ACEOF
fi
- test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes
-fi
+ test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_func_getloadavg_done=yes
+ fi
-if test $gl_have_func = no; then
- ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default"
+ if test $gl_func_getloadavg_done = no; then
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_dg_sys_info_h" = x""yes; then :
- gl_have_func=yes
+ gl_func_getloadavg_done=yes
$as_echo "#define DGUX 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5
$as_echo_n "checking for dg_sys_info in -ldgc... " >&6; }
if test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then :
$as_echo_n "(cached) " >&6
@@ -17008,23 +19236,94 @@ fi
fi
+ fi
+ fi
+fi
+
+
+if test "x$gl_save_LIBS" = x; then
+ GETLOADAVG_LIBS=$LIBS
+else
+ GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"`
+fi
+LIBS=$gl_save_LIBS
+
+
+# Test whether the system declares getloadavg. Solaris has the function
+# but declares it in <sys/loadavg.h>, not <stdlib.h>.
+for ac_header in sys/loadavg.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_SYS_LOADAVG_H 1
+_ACEOF
+
+fi
+
+done
+
+if test $ac_cv_header_sys_loadavg_h = yes; then
+ HAVE_SYS_LOADAVG_H=1
+else
+ HAVE_SYS_LOADAVG_H=0
+fi
+ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE_SYS_LOADAVG_H
+ # include <sys/loadavg.h>
+ #endif
+ #include <stdlib.h>
+"
+if test "x$ac_cv_have_decl_getloadavg" = x""yes; then :
+
+else
+ HAVE_DECL_GETLOADAVG=0
+fi
+
+
+if test $HAVE_GETLOADAVG = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext"
+
+
+# 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
+do :
+ ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic"
+if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_PSTAT_GETDYNAMIC 1
+_ACEOF
+ gl_func_getloadavg_done=yes
+fi
+done
+
fi
# We cannot check for <dwarf.h>, because Solaris 2 does not use dwarf (it
# uses stabs), but it is still SVR4. We cannot check for <elf.h> because
# Irix 4.0.5F has the header but not the library.
-if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \
+if test $gl_func_getloadavg_done = no && test "$ac_cv_lib_elf_elf_begin" = yes \
&& test "$ac_cv_lib_kvm_kvm_open" = yes; then
- gl_have_func=yes
+ gl_func_getloadavg_done=yes
$as_echo "#define SVR4 1" >>confdefs.h
fi
-if test $gl_have_func = no; then
+if test $gl_func_getloadavg_done = no; then
ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default"
if test "x$ac_cv_header_inq_stats_cpustats_h" = x""yes; then :
- gl_have_func=yes
+ gl_func_getloadavg_done=yes
$as_echo "#define UMAX 1" >>confdefs.h
@@ -17036,17 +19335,17 @@ fi
fi
-if test $gl_have_func = no; then
+if test $gl_func_getloadavg_done = no; then
ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_cpustats_h" = x""yes; then :
- gl_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h
+ gl_func_getloadavg_done=yes; $as_echo "#define UMAX 1" >>confdefs.h
fi
fi
-if test $gl_have_func = no; then
+if test $gl_func_getloadavg_done = no; then
for ac_header in mach/mach.h
do :
ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default"
@@ -17107,55 +19406,24 @@ fi
done
- fi
fi
-if test "x$gl_save_LIBS" = x; then
- GETLOADAVG_LIBS=$LIBS
-else
- GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"`
-fi
-LIBS=$gl_save_LIBS
-# Test whether the system declares getloadavg. Solaris has the function
-# but declares it in <sys/loadavg.h>, not <stdlib.h>.
-for ac_header in sys/loadavg.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SYS_LOADAVG_H 1
-_ACEOF
-fi
+ GNULIB_GETLOADAVG=1
-done
-if test $ac_cv_header_sys_loadavg_h = yes; then
- HAVE_SYS_LOADAVG_H=1
-else
- HAVE_SYS_LOADAVG_H=0
-fi
-ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE_SYS_LOADAVG_H
- # include <sys/loadavg.h>
- #endif
- #include <stdlib.h>
-"
-if test "x$ac_cv_have_decl_getloadavg" = x""yes; then :
-else
- HAVE_DECL_GETLOADAVG=0
-fi
- GNULIB_GETLOADAVG=1
+if test $REPLACE_GETOPT = 1; then
@@ -17164,51 +19432,58 @@ fi
+ gl_LIBOBJS="$gl_LIBOBJS getopt.$ac_objext"
- if test -n "$gl_replace_getopt"; then :
- GETOPT_H=getopt.h
-$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
+ gl_LIBOBJS="$gl_LIBOBJS getopt1.$ac_objext"
- GNULIB_UNISTD_H_GETOPT=1
+fi
+ REPLACE_GETOPT=0
- gl_LIBOBJS="$gl_LIBOBJS getopt.$ac_objext"
+ if test -n "$gl_replace_getopt"; then :
+ REPLACE_GETOPT=1
+fi
+ if test $REPLACE_GETOPT = 1; then
+ GETOPT_H=getopt.h
+$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
- gl_LIBOBJS="$gl_LIBOBJS getopt1.$ac_objext"
+ GNULIB_UNISTD_H_GETOPT=1
+ fi
+if test $REPLACE_GETOPT = 1; then
-fi
+ gl_LIBOBJS="$gl_LIBOBJS getopt.$ac_objext"
@@ -17218,89 +19493,51 @@ fi
+ gl_LIBOBJS="$gl_LIBOBJS getopt1.$ac_objext"
- if test $gl_cv_have_include_next = yes; then
- gl_cv_next_inttypes_h='<'inttypes.h'>'
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <inttypes.h>" >&5
-$as_echo_n "checking absolute name of <inttypes.h>... " >&6; }
-if test "${gl_cv_next_inttypes_h+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
-
- if test $ac_cv_header_inttypes_h = yes; then
-
+fi
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <inttypes.h>
-_ACEOF
- case "$host_os" in
- aix*) gl_absname_cpp="$ac_cpp -C" ;;
- *) gl_absname_cpp="$ac_cpp" ;;
- esac
- gl_cv_next_inttypes_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
- sed -n '\#/inttypes.h#{
- s#.*"\(.*/inttypes.h\)".*#\1#
- s#^/[^/]#//&#
- p
- q
- }'`'"'
- else
- gl_cv_next_inttypes_h='<'inttypes.h'>'
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_inttypes_h" >&5
-$as_echo "$gl_cv_next_inttypes_h" >&6; }
- fi
- NEXT_INTTYPES_H=$gl_cv_next_inttypes_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='<'inttypes.h'>'
- else
- # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
- gl_next_as_first_directive=$gl_cv_next_inttypes_h
- fi
- NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H=$gl_next_as_first_directive
+ if test $ac_cv_func_lstat = yes; then
+ if test $gl_cv_func_lstat_dereferences_slashed_symlink = no; then
+ REPLACE_LSTAT=1
+ fi
+ else
+ HAVE_LSTAT=0
+ fi
+if test $REPLACE_LSTAT = 1; then
-$as_echo "#define GL_TRIGGER_STDC_LIMIT_MACROS 1" >>confdefs.h
+ gl_LIBOBJS="$gl_LIBOBJS lstat.$ac_objext"
+ :
+fi
- if test $ac_cv_func_lstat = yes; then
- if test $ac_cv_func_lstat_dereferences_slashed_symlink = no; then
- REPLACE_LSTAT=1
- fi
- # Prerequisites of lib/lstat.c.
- else
- HAVE_LSTAT=0
- fi
+ GNULIB_LSTAT=1
- GNULIB_LSTAT=1
@@ -17309,19 +19546,19 @@ $as_echo "#define GL_TRIGGER_STDC_LIMIT_MACROS 1" >>confdefs.h
-if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple MacOS 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.
- ac_cv_func_working_mktime=no
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mktime" >&5
+ if test $APPLE_UNIVERSAL_BUILD = 1; then
+ # A universal build on Apple MacOS 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
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mktime" >&5
$as_echo_n "checking for working mktime... " >&6; }
-if test "${ac_cv_func_working_mktime+set}" = set; then :
+if test "${gl_cv_func_working_mktime+set}" = set; then :
$as_echo_n "(cached) " >&6
else
if test "$cross_compiling" = yes; then :
- ac_cv_func_working_mktime=no
+ gl_cv_func_working_mktime=no
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
@@ -17518,18 +19755,26 @@ main ()
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_working_mktime=yes
+ gl_cv_func_working_mktime=yes
else
- ac_cv_func_working_mktime=no
+ gl_cv_func_working_mktime=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_working_mktime" >&5
-$as_echo "$ac_cv_func_working_mktime" >&6; }
-if test $ac_cv_func_working_mktime = no; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_mktime" >&5
+$as_echo "$gl_cv_func_working_mktime" >&6; }
+
+ if test $gl_cv_func_working_mktime = no; then
+ REPLACE_MKTIME=1
+ else
+ REPLACE_MKTIME=0
+ fi
+
+if test $REPLACE_MKTIME = 1; then
@@ -17540,43 +19785,120 @@ if test $ac_cv_func_working_mktime = no; then
gl_LIBOBJS="$gl_LIBOBJS mktime.$ac_objext"
+
+
+
fi
- if test $ac_cv_func_working_mktime = no; then
- REPLACE_MKTIME=1
+
+ GNULIB_MKTIME=1
+
+
+
+
+
+
+
+
+ LIB_PTHREAD_SIGMASK=
+ if test $ac_cv_func_pthread_sigmask != yes; then
+ gl_save_LIBS=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing pthread_sigmask" >&5
+$as_echo_n "checking for library containing pthread_sigmask... " >&6; }
+if test "${ac_cv_search_pthread_sigmask+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 pthread_sigmask ();
+int
+main ()
+{
+return pthread_sigmask ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' pthread c_r; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
else
- REPLACE_MKTIME=0
+ 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_pthread_sigmask=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_pthread_sigmask+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_pthread_sigmask+set}" = set; then :
+else
+ ac_cv_search_pthread_sigmask=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_pthread_sigmask" >&5
+$as_echo "$ac_cv_search_pthread_sigmask" >&6; }
+ac_res=$ac_cv_search_pthread_sigmask
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+fi
+ LIBS=$gl_save_LIBS
+ if test "$ac_cv_search_pthread_sigmask" = no; then
+ HAVE_PTHREAD_SIGMASK=0
+ elif test "$ac_cv_search_pthread_sigmask" != 'none required'; then
+ LIB_PTHREAD_SIGMASK=$ac_cv_search_pthread_sigmask
+ fi
+ fi
- GNULIB_MKTIME=1
+if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- if test $ac_cv_func_readlink = no; then
- HAVE_READLINK=0
+ gl_LIBOBJS="$gl_LIBOBJS pthread_sigmask.$ac_objext"
+fi
- gl_LIBOBJS="$gl_LIBOBJS readlink.$ac_objext"
+ GNULIB_PTHREAD_SIGMASK=1
+
+
+
- :
+
+
+ if test $ac_cv_func_readlink = no; then
+ HAVE_READLINK=0
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether readlink signature is correct" >&5
$as_echo_n "checking whether readlink signature is correct... " >&6; }
@@ -17647,6 +19969,12 @@ $as_echo "$gl_cv_func_readlink_works" >&6; }
$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
+ fi
+
+if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
@@ -17657,25 +19985,104 @@ $as_echo "#define READLINK_TRAILING_SLASH_BUG 1" >>confdefs.h
gl_LIBOBJS="$gl_LIBOBJS readlink.$ac_objext"
- elif test "$gl_cv_decl_readlink_works" != yes; then
- REPLACE_READLINK=1
+ :
+
+fi
+ GNULIB_READLINK=1
+
- gl_LIBOBJS="$gl_LIBOBJS readlink.$ac_objext"
- fi
- fi
- GNULIB_READLINK=1
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_signal_h='<'signal.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <signal.h>" >&5
+$as_echo_n "checking absolute name of <signal.h>... " >&6; }
+if test "${gl_cv_next_signal_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <signal.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+ gl_cv_next_signal_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n '\#/signal.h#{
+ s#.*"\(.*/signal.h\)".*#\1#
+ s#^/[^/]#//&#
+ p
+ q
+ }'`'"'
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_signal_h" >&5
+$as_echo "$gl_cv_next_signal_h" >&6; }
+ fi
+ NEXT_SIGNAL_H=$gl_cv_next_signal_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='<'signal.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_signal_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H=$gl_next_as_first_directive
+
+
+
+
+
+# AIX declares sig_atomic_t to already include volatile, and C89 compilers
+# then choke on 'volatile sig_atomic_t'. C99 requires that it compile.
+ ac_fn_c_check_type "$LINENO" "volatile sig_atomic_t" "ac_cv_type_volatile_sig_atomic_t" "
+#include <signal.h>
+
+"
+if test "x$ac_cv_type_volatile_sig_atomic_t" = x""yes; then :
+
+else
+ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=0
+fi
+
+
+
+
+
+ ac_fn_c_check_type "$LINENO" "sighandler_t" "ac_cv_type_sighandler_t" "
+#include <signal.h>
+
+"
+if test "x$ac_cv_type_sighandler_t" = x""yes; then :
+
+else
+ HAVE_SIGHANDLER_T=0
+fi
+
@@ -18074,717 +20481,6 @@ $as_echo "$gl_cv_next_stddef_h" >&6; }
- if test $ac_cv_type_long_long_int = yes; then
- HAVE_LONG_LONG_INT=1
- else
- HAVE_LONG_LONG_INT=0
- fi
-
-
- if test $ac_cv_type_unsigned_long_long_int = yes; then
- HAVE_UNSIGNED_LONG_LONG_INT=1
- else
- HAVE_UNSIGNED_LONG_LONG_INT=0
- fi
-
-
-
- if test $ac_cv_header_wchar_h = yes; then
- HAVE_WCHAR_H=1
- else
- HAVE_WCHAR_H=0
- fi
-
-
- if test $ac_cv_header_inttypes_h = yes; then
- HAVE_INTTYPES_H=1
- else
- HAVE_INTTYPES_H=0
- fi
-
-
- if test $ac_cv_header_sys_types_h = yes; then
- HAVE_SYS_TYPES_H=1
- else
- HAVE_SYS_TYPES_H=0
- fi
-
-
-
-
-
-
-
-
-
-
-
- if test $gl_cv_have_include_next = yes; then
- gl_cv_next_stdint_h='<'stdint.h'>'
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <stdint.h>" >&5
-$as_echo_n "checking absolute name of <stdint.h>... " >&6; }
-if test "${gl_cv_next_stdint_h+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
-
- if test $ac_cv_header_stdint_h = yes; then
-
-
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <stdint.h>
-
-_ACEOF
- case "$host_os" in
- aix*) gl_absname_cpp="$ac_cpp -C" ;;
- *) gl_absname_cpp="$ac_cpp" ;;
- esac
- gl_cv_next_stdint_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
- sed -n '\#/stdint.h#{
- s#.*"\(.*/stdint.h\)".*#\1#
- s#^/[^/]#//&#
- p
- q
- }'`'"'
- else
- gl_cv_next_stdint_h='<'stdint.h'>'
- fi
-
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stdint_h" >&5
-$as_echo "$gl_cv_next_stdint_h" >&6; }
- fi
- NEXT_STDINT_H=$gl_cv_next_stdint_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='<'stdint.h'>'
- else
- # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
- gl_next_as_first_directive=$gl_cv_next_stdint_h
- fi
- NEXT_AS_FIRST_DIRECTIVE_STDINT_H=$gl_next_as_first_directive
-
-
-
-
- if test $ac_cv_header_stdint_h = yes; then
- HAVE_STDINT_H=1
- else
- HAVE_STDINT_H=0
- fi
-
-
- if test $ac_cv_header_stdint_h = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stdint.h conforms to C99" >&5
-$as_echo_n "checking whether stdint.h conforms to C99... " >&6; }
-if test "${gl_cv_header_working_stdint_h+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- gl_cv_header_working_stdint_h=no
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* 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>. */
-#if !(defined WCHAR_MIN && defined WCHAR_MAX)
-#error "WCHAR_MIN, WCHAR_MAX not defined in <stdint.h>"
-#endif
-
-
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
-
-#ifdef INT8_MAX
-int8_t a1 = INT8_MAX;
-int8_t a1min = INT8_MIN;
-#endif
-#ifdef INT16_MAX
-int16_t a2 = INT16_MAX;
-int16_t a2min = INT16_MIN;
-#endif
-#ifdef INT32_MAX
-int32_t a3 = INT32_MAX;
-int32_t a3min = INT32_MIN;
-#endif
-#ifdef INT64_MAX
-int64_t a4 = INT64_MAX;
-int64_t a4min = INT64_MIN;
-#endif
-#ifdef UINT8_MAX
-uint8_t b1 = UINT8_MAX;
-#else
-typedef int b1[(unsigned char) -1 != 255 ? 1 : -1];
-#endif
-#ifdef UINT16_MAX
-uint16_t b2 = UINT16_MAX;
-#endif
-#ifdef UINT32_MAX
-uint32_t b3 = UINT32_MAX;
-#endif
-#ifdef UINT64_MAX
-uint64_t b4 = UINT64_MAX;
-#endif
-int_least8_t c1 = INT8_C (0x7f);
-int_least8_t c1max = INT_LEAST8_MAX;
-int_least8_t c1min = INT_LEAST8_MIN;
-int_least16_t c2 = INT16_C (0x7fff);
-int_least16_t c2max = INT_LEAST16_MAX;
-int_least16_t c2min = INT_LEAST16_MIN;
-int_least32_t c3 = INT32_C (0x7fffffff);
-int_least32_t c3max = INT_LEAST32_MAX;
-int_least32_t c3min = INT_LEAST32_MIN;
-int_least64_t c4 = INT64_C (0x7fffffffffffffff);
-int_least64_t c4max = INT_LEAST64_MAX;
-int_least64_t c4min = INT_LEAST64_MIN;
-uint_least8_t d1 = UINT8_C (0xff);
-uint_least8_t d1max = UINT_LEAST8_MAX;
-uint_least16_t d2 = UINT16_C (0xffff);
-uint_least16_t d2max = UINT_LEAST16_MAX;
-uint_least32_t d3 = UINT32_C (0xffffffff);
-uint_least32_t d3max = UINT_LEAST32_MAX;
-uint_least64_t d4 = UINT64_C (0xffffffffffffffff);
-uint_least64_t d4max = UINT_LEAST64_MAX;
-int_fast8_t e1 = INT_FAST8_MAX;
-int_fast8_t e1min = INT_FAST8_MIN;
-int_fast16_t e2 = INT_FAST16_MAX;
-int_fast16_t e2min = INT_FAST16_MIN;
-int_fast32_t e3 = INT_FAST32_MAX;
-int_fast32_t e3min = INT_FAST32_MIN;
-int_fast64_t e4 = INT_FAST64_MAX;
-int_fast64_t e4min = INT_FAST64_MIN;
-uint_fast8_t f1 = UINT_FAST8_MAX;
-uint_fast16_t f2 = UINT_FAST16_MAX;
-uint_fast32_t f3 = UINT_FAST32_MAX;
-uint_fast64_t f4 = UINT_FAST64_MAX;
-#ifdef INTPTR_MAX
-intptr_t g = INTPTR_MAX;
-intptr_t gmin = INTPTR_MIN;
-#endif
-#ifdef UINTPTR_MAX
-uintptr_t h = UINTPTR_MAX;
-#endif
-intmax_t i = INTMAX_MAX;
-uintmax_t j = UINTMAX_MAX;
-
-#include <limits.h> /* for CHAR_BIT */
-#define TYPE_MINIMUM(t) \
- ((t) ((t) 0 < (t) -1 ? (t) 0 : ~ TYPE_MAXIMUM (t)))
-#define TYPE_MAXIMUM(t) \
- ((t) ((t) 0 < (t) -1 \
- ? (t) -1 \
- : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1)))
-struct s {
- int check_PTRDIFF:
- PTRDIFF_MIN == TYPE_MINIMUM (ptrdiff_t)
- && PTRDIFF_MAX == TYPE_MAXIMUM (ptrdiff_t)
- ? 1 : -1;
- /* Detect bug in FreeBSD 6.0 / ia64. */
- int check_SIG_ATOMIC:
- SIG_ATOMIC_MIN == TYPE_MINIMUM (sig_atomic_t)
- && SIG_ATOMIC_MAX == TYPE_MAXIMUM (sig_atomic_t)
- ? 1 : -1;
- int check_SIZE: SIZE_MAX == TYPE_MAXIMUM (size_t) ? 1 : -1;
- int check_WCHAR:
- WCHAR_MIN == TYPE_MINIMUM (wchar_t)
- && WCHAR_MAX == TYPE_MAXIMUM (wchar_t)
- ? 1 : -1;
- /* Detect bug in mingw. */
- int check_WINT:
- WINT_MIN == TYPE_MINIMUM (wint_t)
- && WINT_MAX == TYPE_MAXIMUM (wint_t)
- ? 1 : -1;
-
- /* Detect bugs in glibc 2.4 and Solaris 10 stdint.h, among others. */
- int check_UINT8_C:
- (-1 < UINT8_C (0)) == (-1 < (uint_least8_t) 0) ? 1 : -1;
- int check_UINT16_C:
- (-1 < UINT16_C (0)) == (-1 < (uint_least16_t) 0) ? 1 : -1;
-
- /* Detect bugs in OpenBSD 3.9 stdint.h. */
-#ifdef UINT8_MAX
- int check_uint8: (uint8_t) -1 == UINT8_MAX ? 1 : -1;
-#endif
-#ifdef UINT16_MAX
- int check_uint16: (uint16_t) -1 == UINT16_MAX ? 1 : -1;
-#endif
-#ifdef UINT32_MAX
- int check_uint32: (uint32_t) -1 == UINT32_MAX ? 1 : -1;
-#endif
-#ifdef UINT64_MAX
- int check_uint64: (uint64_t) -1 == UINT64_MAX ? 1 : -1;
-#endif
- int check_uint_least8: (uint_least8_t) -1 == UINT_LEAST8_MAX ? 1 : -1;
- int check_uint_least16: (uint_least16_t) -1 == UINT_LEAST16_MAX ? 1 : -1;
- int check_uint_least32: (uint_least32_t) -1 == UINT_LEAST32_MAX ? 1 : -1;
- int check_uint_least64: (uint_least64_t) -1 == UINT_LEAST64_MAX ? 1 : -1;
- int check_uint_fast8: (uint_fast8_t) -1 == UINT_FAST8_MAX ? 1 : -1;
- int check_uint_fast16: (uint_fast16_t) -1 == UINT_FAST16_MAX ? 1 : -1;
- int check_uint_fast32: (uint_fast32_t) -1 == UINT_FAST32_MAX ? 1 : -1;
- int check_uint_fast64: (uint_fast64_t) -1 == UINT_FAST64_MAX ? 1 : -1;
- int check_uintptr: (uintptr_t) -1 == UINTPTR_MAX ? 1 : -1;
- int check_uintmax: (uintmax_t) -1 == UINTMAX_MAX ? 1 : -1;
- int check_size: (size_t) -1 == SIZE_MAX ? 1 : -1;
-};
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- if test "$cross_compiling" = yes; then :
- gl_cv_header_working_stdint_h=yes
-
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* 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>
-
-
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
-
-#include <stdio.h>
-#include <string.h>
-#define MVAL(macro) MVAL1(macro)
-#define MVAL1(expression) #expression
-static const char *macro_values[] =
- {
-#ifdef INT8_MAX
- MVAL (INT8_MAX),
-#endif
-#ifdef INT16_MAX
- MVAL (INT16_MAX),
-#endif
-#ifdef INT32_MAX
- MVAL (INT32_MAX),
-#endif
-#ifdef INT64_MAX
- MVAL (INT64_MAX),
-#endif
-#ifdef UINT8_MAX
- MVAL (UINT8_MAX),
-#endif
-#ifdef UINT16_MAX
- MVAL (UINT16_MAX),
-#endif
-#ifdef UINT32_MAX
- MVAL (UINT32_MAX),
-#endif
-#ifdef UINT64_MAX
- MVAL (UINT64_MAX),
-#endif
- NULL
- };
-
-int
-main ()
-{
-
- const char **mv;
- for (mv = macro_values; *mv != NULL; mv++)
- {
- const char *value = *mv;
- /* Test whether it looks like a cast expression. */
- if (strncmp (value, "((unsigned int)"/*)*/, 15) == 0
- || strncmp (value, "((unsigned short)"/*)*/, 17) == 0
- || strncmp (value, "((unsigned char)"/*)*/, 16) == 0
- || strncmp (value, "((int)"/*)*/, 6) == 0
- || strncmp (value, "((signed short)"/*)*/, 15) == 0
- || strncmp (value, "((signed char)"/*)*/, 14) == 0)
- return mv - macro_values + 1;
- }
- return 0;
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- gl_cv_header_working_stdint_h=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
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_working_stdint_h" >&5
-$as_echo "$gl_cv_header_working_stdint_h" >&6; }
- fi
- if test "$gl_cv_header_working_stdint_h" = yes; then
- STDINT_H=
- else
- for ac_header in sys/inttypes.h sys/bitypes.h
-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"
-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
-
- if test $ac_cv_header_sys_inttypes_h = yes; then
- HAVE_SYS_INTTYPES_H=1
- else
- HAVE_SYS_INTTYPES_H=0
- fi
-
- if test $ac_cv_header_sys_bitypes_h = yes; then
- HAVE_SYS_BITYPES_H=1
- else
- HAVE_SYS_BITYPES_H=0
- fi
-
-
-
-
- if test $APPLE_UNIVERSAL_BUILD = 0; then
-
-
- for gltype in ptrdiff_t size_t ; do
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bit size of $gltype" >&5
-$as_echo_n "checking for bit size of $gltype... " >&6; }
-if { as_var=gl_cv_bitsizeof_${gltype}; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "sizeof ($gltype) * CHAR_BIT" "result" "
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
-#include <limits.h>"; then :
-
-else
- result=unknown
-fi
-
- eval gl_cv_bitsizeof_${gltype}=\$result
-
-fi
-eval ac_res=\$gl_cv_bitsizeof_${gltype}
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval result=\$gl_cv_bitsizeof_${gltype}
- if test $result = unknown; then
- result=0
- fi
- GLTYPE=`echo "$gltype" | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
- cat >>confdefs.h <<_ACEOF
-#define BITSIZEOF_${GLTYPE} $result
-_ACEOF
-
- eval BITSIZEOF_${GLTYPE}=\$result
- done
-
-
- fi
-
-
- for gltype in sig_atomic_t wchar_t wint_t ; do
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bit size of $gltype" >&5
-$as_echo_n "checking for bit size of $gltype... " >&6; }
-if { as_var=gl_cv_bitsizeof_${gltype}; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "sizeof ($gltype) * CHAR_BIT" "result" "
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
-#include <limits.h>"; then :
-
-else
- result=unknown
-fi
-
- eval gl_cv_bitsizeof_${gltype}=\$result
-
-fi
-eval ac_res=\$gl_cv_bitsizeof_${gltype}
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval result=\$gl_cv_bitsizeof_${gltype}
- if test $result = unknown; then
- result=0
- fi
- GLTYPE=`echo "$gltype" | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
- cat >>confdefs.h <<_ACEOF
-#define BITSIZEOF_${GLTYPE} $result
-_ACEOF
-
- eval BITSIZEOF_${GLTYPE}=\$result
- done
-
-
-
-
- for gltype in sig_atomic_t wchar_t wint_t ; do
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $gltype is signed" >&5
-$as_echo_n "checking whether $gltype is signed... " >&6; }
-if { as_var=gl_cv_type_${gltype}_signed; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
- int verify[2 * (($gltype) -1 < ($gltype) 0) - 1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- result=yes
-else
- result=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- eval gl_cv_type_${gltype}_signed=\$result
-
-fi
-eval ac_res=\$gl_cv_type_${gltype}_signed
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval result=\$gl_cv_type_${gltype}_signed
- GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
- if test "$result" = yes; then
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SIGNED_${GLTYPE} 1
-_ACEOF
-
- eval HAVE_SIGNED_${GLTYPE}=1
- else
- eval HAVE_SIGNED_${GLTYPE}=0
- fi
- done
-
-
- gl_cv_type_ptrdiff_t_signed=yes
- gl_cv_type_size_t_signed=no
- if test $APPLE_UNIVERSAL_BUILD = 0; then
-
-
- for gltype in ptrdiff_t size_t ; do
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $gltype integer literal suffix" >&5
-$as_echo_n "checking for $gltype integer literal suffix... " >&6; }
-if { as_var=gl_cv_type_${gltype}_suffix; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- eval gl_cv_type_${gltype}_suffix=no
- eval result=\$gl_cv_type_${gltype}_signed
- if test "$result" = yes; then
- glsufu=
- else
- glsufu=u
- fi
- for glsuf in "$glsufu" ${glsufu}l ${glsufu}ll ${glsufu}i64; do
- case $glsuf in
- '') gltype1='int';;
- l) gltype1='long int';;
- ll) gltype1='long long int';;
- i64) gltype1='__int64';;
- u) gltype1='unsigned int';;
- ul) gltype1='unsigned long int';;
- ull) gltype1='unsigned long long int';;
- ui64)gltype1='unsigned __int64';;
- esac
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
- extern $gltype foo;
- extern $gltype1 foo;
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- eval gl_cv_type_${gltype}_suffix=\$glsuf
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- eval result=\$gl_cv_type_${gltype}_suffix
- test "$result" != no && break
- done
-fi
-eval ac_res=\$gl_cv_type_${gltype}_suffix
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
- eval result=\$gl_cv_type_${gltype}_suffix
- test "$result" = no && result=
- eval ${GLTYPE}_SUFFIX=\$result
- cat >>confdefs.h <<_ACEOF
-#define ${GLTYPE}_SUFFIX $result
-_ACEOF
-
- done
-
-
- fi
-
-
- for gltype in sig_atomic_t wchar_t wint_t ; do
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $gltype integer literal suffix" >&5
-$as_echo_n "checking for $gltype integer literal suffix... " >&6; }
-if { as_var=gl_cv_type_${gltype}_suffix; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- eval gl_cv_type_${gltype}_suffix=no
- eval result=\$gl_cv_type_${gltype}_signed
- if test "$result" = yes; then
- glsufu=
- else
- glsufu=u
- fi
- for glsuf in "$glsufu" ${glsufu}l ${glsufu}ll ${glsufu}i64; do
- case $glsuf in
- '') gltype1='int';;
- l) gltype1='long int';;
- ll) gltype1='long long int';;
- i64) gltype1='__int64';;
- u) gltype1='unsigned int';;
- ul) gltype1='unsigned long int';;
- ull) gltype1='unsigned long long int';;
- ui64)gltype1='unsigned __int64';;
- esac
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
- #include <stddef.h>
- #include <signal.h>
- #if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
- # include <wchar.h>
- #endif
-
- extern $gltype foo;
- extern $gltype1 foo;
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- eval gl_cv_type_${gltype}_suffix=\$glsuf
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- eval result=\$gl_cv_type_${gltype}_suffix
- test "$result" != no && break
- done
-fi
-eval ac_res=\$gl_cv_type_${gltype}_suffix
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
- eval result=\$gl_cv_type_${gltype}_suffix
- test "$result" = no && result=
- eval ${GLTYPE}_SUFFIX=\$result
- cat >>confdefs.h <<_ACEOF
-#define ${GLTYPE}_SUFFIX $result
-_ACEOF
-
- done
-
-
-
- STDINT_H=stdint.h
- fi
-
- if test -n "$STDINT_H"; then
- GL_GENERATE_STDINT_H_TRUE=
- GL_GENERATE_STDINT_H_FALSE='#'
-else
- GL_GENERATE_STDINT_H_TRUE='#'
- GL_GENERATE_STDINT_H_FALSE=
-fi
-
-
-
-
@@ -18925,26 +20621,40 @@ $as_echo "$gl_cv_next_stdlib_h" >&6; }
+ # This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE.
+
+
+$as_echo "#define my_strftime nstrftime" >>confdefs.h
- gl_LIBOBJS="$gl_LIBOBJS strftime.$ac_objext"
- # This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE.
+ if test "$ac_cv_have_decl_strtoimax" != yes; then
+ HAVE_DECL_STRTOIMAX=0
+ for ac_func in strtoimax
+do :
+ ac_fn_c_check_func "$LINENO" "strtoimax" "ac_cv_func_strtoimax"
+if test "x$ac_cv_func_strtoimax" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_STRTOIMAX 1
+_ACEOF
+fi
+done
+ fi
+if test "$ac_cv_have_decl_strtoimax" != yes && test $ac_cv_func_strtoimax = no; then
-$as_echo "#define my_strftime nstrftime" >>confdefs.h
@@ -18952,8 +20662,29 @@ $as_echo "#define my_strftime nstrftime" >>confdefs.h
- if test "$ac_cv_have_decl_strtoumax" != yes; then
- HAVE_DECL_STRTOUMAX=0
+ gl_LIBOBJS="$gl_LIBOBJS strtoimax.$ac_objext"
+
+
+ ac_fn_c_check_decl "$LINENO" "strtoll" "ac_cv_have_decl_strtoll" "$ac_includes_default"
+if test "x$ac_cv_have_decl_strtoll" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_STRTOLL $ac_have_decl
+_ACEOF
+
+
+
+fi
+
+
+
+
+
+ GNULIB_STRTOIMAX=1
@@ -18962,8 +20693,10 @@ $as_echo "#define my_strftime nstrftime" >>confdefs.h
+ if test "$ac_cv_have_decl_strtoumax" != yes; then
+ HAVE_DECL_STRTOUMAX=0
- for ac_func in strtoumax
+ for ac_func in strtoumax
do :
ac_fn_c_check_func "$LINENO" "strtoumax" "ac_cv_func_strtoumax"
if test "x$ac_cv_func_strtoumax" = x""yes; then :
@@ -18971,15 +20704,22 @@ if test "x$ac_cv_func_strtoumax" = x""yes; then :
#define HAVE_STRTOUMAX 1
_ACEOF
-else
-
- gl_LIBOBJS="$gl_LIBOBJS $ac_func.$ac_objext"
-
fi
done
+ fi
+
+if test "$ac_cv_have_decl_strtoumax" != yes && test $ac_cv_func_strtoumax = no; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS strtoumax.$ac_objext"
- if test $ac_cv_func_strtoumax = no; then
ac_fn_c_check_decl "$LINENO" "strtoull" "ac_cv_have_decl_strtoull" "$ac_includes_default"
if test "x$ac_cv_have_decl_strtoull" = x""yes; then :
@@ -18994,30 +20734,22 @@ _ACEOF
- fi
- fi
-
-
-
-
- GNULIB_STRTOUMAX=1
-
-
+fi
- if test $ac_cv_func_symlink = no; then
- HAVE_SYMLINK=0
+ GNULIB_STRTOUMAX=1
- gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext"
+ if test $ac_cv_func_symlink = no; then
+ HAVE_SYMLINK=0
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether symlink handles trailing slash correctly" >&5
$as_echo_n "checking whether symlink handles trailing slash correctly... " >&6; }
@@ -19062,6 +20794,10 @@ fi
$as_echo "$gl_cv_func_symlink_works" >&6; }
if test "$gl_cv_func_symlink_works" != yes; then
REPLACE_SYMLINK=1
+ fi
+ fi
+
+if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
@@ -19072,13 +20808,15 @@ $as_echo "$gl_cv_func_symlink_works" >&6; }
gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext"
- fi
- fi
+fi
+
- GNULIB_SYMLINK=1
+ GNULIB_SYMLINK=1
+
+
@@ -19224,7 +20962,8 @@ $as_echo "$gl_cv_time_r_posix" >&6; }
else
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
@@ -19238,12 +20977,16 @@ $as_echo "$gl_cv_time_r_posix" >&6; }
:
- fi
+fi
+
- GNULIB_TIME_R=1
+ GNULIB_TIME_R=1
+
+
+
@@ -19322,7 +21065,9 @@ $as_echo "$gl_cv_next_unistd_h" >&6; }
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
+ gl_gnulib_enabled_sigprocmask=false
gl_gnulib_enabled_stat=false
+ gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_verify=false
func_gl_gnulib_m4code_dosname ()
@@ -19339,6 +21084,50 @@ $as_echo "$gl_cv_next_unistd_h" >&6; }
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
fi
}
+ func_gl_gnulib_m4code_sigprocmask ()
+ {
+ if ! $gl_gnulib_enabled_sigprocmask; 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
+fi
+
+ fi
+ if test -z "$gl_cv_func_sigprocmask"; then
+ HAVE_POSIX_SIGNALBLOCKING=0
+ fi
+
+if test $HAVE_POSIX_SIGNALBLOCKING = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS sigprocmask.$ac_objext"
+
+ :
+fi
+
+
+
+
+
+ GNULIB_SIGPROCMASK=1
+
+
+
+
+
+ gl_gnulib_enabled_sigprocmask=true
+ fi
+ }
func_gl_gnulib_m4code_stat ()
{
if ! $gl_gnulib_enabled_stat; then
@@ -19439,7 +21228,8 @@ $as_echo "#define REPLACE_FUNC_STAT_DIR 1" >>confdefs.h
$as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h
;;
esac
- if test $REPLACE_STAT = 1; then
+
+if test $REPLACE_STAT = 1; then
@@ -19451,12 +21241,18 @@ $as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h
gl_LIBOBJS="$gl_LIBOBJS stat.$ac_objext"
- fi
+
+ :
+
+fi
+
- GNULIB_STAT=1
+ GNULIB_STAT=1
+
+
@@ -19464,24 +21260,71 @@ $as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h
if $condition; then
func_gl_gnulib_m4code_dosname
fi
+ if $condition; then
+ func_gl_gnulib_m4code_verify
+ fi
fi
}
- func_gl_gnulib_m4code_strtoull ()
+ func_gl_gnulib_m4code_strtoll ()
{
- if ! $gl_gnulib_enabled_strtoull; then
+ if ! $gl_gnulib_enabled_strtoll; then
- if test "$ac_cv_type_unsigned_long_long_int" = yes; then
+ if test "$ac_cv_type_long_long_int" = yes; then
+ for ac_func in strtoll
+do :
+ ac_fn_c_check_func "$LINENO" "strtoll" "ac_cv_func_strtoll"
+if test "x$ac_cv_func_strtoll" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_STRTOLL 1
+_ACEOF
+
+fi
+done
+
+ if test $ac_cv_func_strtoll = no; then
+ HAVE_STRTOLL=0
+ fi
+ fi
+
+if test $HAVE_STRTOLL = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS strtoll.$ac_objext"
+
+
+ :
+
+fi
+ GNULIB_STRTOLL=1
- for ac_func in strtoull
+
+
+ gl_gnulib_enabled_strtoll=true
+ fi
+ }
+ func_gl_gnulib_m4code_strtoull ()
+ {
+ if ! $gl_gnulib_enabled_strtoull; then
+
+
+
+ if test "$ac_cv_type_unsigned_long_long_int" = yes; then
+ for ac_func in strtoull
do :
ac_fn_c_check_func "$LINENO" "strtoull" "ac_cv_func_strtoull"
if test "x$ac_cv_func_strtoull" = x""yes; then :
@@ -19489,26 +21332,37 @@ if test "x$ac_cv_func_strtoull" = x""yes; then :
#define HAVE_STRTOULL 1
_ACEOF
-else
-
- gl_LIBOBJS="$gl_LIBOBJS $ac_func.$ac_objext"
-
fi
done
-
if test $ac_cv_func_strtoull = no; then
HAVE_STRTOULL=0
+ fi
+ fi
+
+if test $HAVE_STRTOULL = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS strtoull.$ac_objext"
+
:
- fi
- fi
+fi
- GNULIB_STRTOULL=1
+
+ GNULIB_STRTOULL=1
+
+
@@ -19521,7 +21375,7 @@ done
gl_gnulib_enabled_verify=true
fi
}
- if test $GNULIB_UNISTD_H_GETOPT = 1; then
+ if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
if test $REPLACE_LSTAT = 1; then
@@ -19530,9 +21384,18 @@ done
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_have_decl_strtoimax" != yes && test $ac_cv_func_strtoimax = no; then
+ func_gl_gnulib_m4code_verify
+ fi
+ if test "$ac_cv_have_decl_strtoimax" != yes && test $ac_cv_func_strtoimax = no && test $ac_cv_type_long_long_int = yes; then
+ func_gl_gnulib_m4code_strtoll
+ fi
if test "$ac_cv_have_decl_strtoumax" != yes && test $ac_cv_func_strtoumax = no; then
func_gl_gnulib_m4code_verify
fi
@@ -19556,6 +21419,14 @@ else
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE=
fi
+ if $gl_gnulib_enabled_sigprocmask; then
+ gl_GNULIB_ENABLED_sigprocmask_TRUE=
+ gl_GNULIB_ENABLED_sigprocmask_FALSE='#'
+else
+ gl_GNULIB_ENABLED_sigprocmask_TRUE='#'
+ gl_GNULIB_ENABLED_sigprocmask_FALSE=
+fi
+
if $gl_gnulib_enabled_stat; then
gl_GNULIB_ENABLED_stat_TRUE=
gl_GNULIB_ENABLED_stat_FALSE='#'
@@ -19564,6 +21435,14 @@ else
gl_GNULIB_ENABLED_stat_FALSE=
fi
+ if $gl_gnulib_enabled_strtoll; then
+ gl_GNULIB_ENABLED_strtoll_TRUE=
+ gl_GNULIB_ENABLED_strtoll_FALSE='#'
+else
+ gl_GNULIB_ENABLED_strtoll_TRUE='#'
+ gl_GNULIB_ENABLED_strtoll_FALSE=
+fi
+
if $gl_gnulib_enabled_strtoull; then
gl_GNULIB_ENABLED_strtoull_TRUE=
gl_GNULIB_ENABLED_strtoull_FALSE='#'
@@ -19621,1766 +21500,6 @@ fi
-# UNIX98 PTYs.
-for ac_func in grantpt
-do :
- ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt"
-if test "x$ac_cv_func_grantpt" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GRANTPT 1
-_ACEOF
-
-fi
-done
-
-
-# PTY-related GNU extensions.
-for ac_func in getpt
-do :
- ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt"
-if test "x$ac_cv_func_getpt" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GETPT 1
-_ACEOF
-
-fi
-done
-
-
-# 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
-{ $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. */
-
-/* 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; 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_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 :
-
-else
- ac_cv_search_tputs=no
-fi
-rm conftest.$ac_ext
-LIBS=$ac_func_search_save_LIBS
-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"
-
-else
- have_tputs_et_al=false
-fi
-
-if test "$have_tputs_et_al" != true; then
- as_fn_error "I couldn't find termcap functions (tputs and friends).
-Maybe some development libraries/packages are missing? Try installing
-libncurses-dev(el), libterminfo-dev(el) or similar." "$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=
-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
- ;;
-
- freebsd)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5
-$as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; }
- if test "${emacs_cv_freebsd_terminfo+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <osreldate.h>
-int
-main ()
-{
-#if __FreeBSD_version < 400000
-fail;
-#endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_freebsd_terminfo=yes
-else
- emacs_cv_freebsd_terminfo=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_freebsd_terminfo" >&5
-$as_echo "$emacs_cv_freebsd_terminfo" >&6; }
-
- if test $emacs_cv_freebsd_terminfo = yes; then
- TERMINFO=yes
- LIBS_TERMCAP="-lncurses"
- else
- LIBS_TERMCAP="-ltermcap"
- fi
- ;;
-
- netbsd)
- if test $ac_cv_search_tputs = -lterminfo; then
- TERMINFO=yes
- LIBS_TERMCAP="-lterminfo"
- else
- LIBS_TERMCAP="-ltermcap"
- fi
- ;;
-
-esac
-
-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.
- 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
-
-$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
-
-
-
-
-# Do we have res_init, for detecting changes in /etc/resolv.conf?
-resolv=no
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <netinet/in.h>
-#include <arpa/nameser.h>
-#include <resolv.h>
-int
-main ()
-{
-return res_init();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- have_res_init=yes
-else
- have_res_init=no
-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
-$as_echo_n "checking for res_init with -lresolv... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <netinet/in.h>
-#include <arpa/nameser.h>
-#include <resolv.h>
-int
-main ()
-{
-return res_init();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- have_res_init=yes
-else
- have_res_init=no
-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 "$have_res_init" >&6; }
- if test "$have_res_init" = yes ; then
- resolv=yes
- fi
- LIBS="$OLIBS"
-fi
-
-if test "$have_res_init" = yes; then
-
-$as_echo "#define HAVE_RES_INIT 1" >>confdefs.h
-
-fi
-
-# Do we need the Hesiod library to provide the support routines?
-LIBHESIOD=
-if test "$with_hesiod" != no ; then
- # Don't set $LIBS here -- see comments above. FIXME which comments?
- ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send"
-if test "x$ac_cv_func_res_send" = x""yes; then :
-
-else
- ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send"
-if test "x$ac_cv_func___res_send" = x""yes; then :
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5
-$as_echo_n "checking for res_send in -lresolv... " >&6; }
-if test "${ac_cv_lib_resolv_res_send+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lresolv $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 res_send ();
-int
-main ()
-{
-return res_send ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_resolv_res_send=yes
-else
- ac_cv_lib_resolv_res_send=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_resolv_res_send" >&5
-$as_echo "$ac_cv_lib_resolv_res_send" >&6; }
-if test "x$ac_cv_lib_resolv_res_send" = x""yes; then :
- resolv=yes
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5
-$as_echo_n "checking for __res_send in -lresolv... " >&6; }
-if test "${ac_cv_lib_resolv___res_send+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lresolv $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 __res_send ();
-int
-main ()
-{
-return __res_send ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_resolv___res_send=yes
-else
- ac_cv_lib_resolv___res_send=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_resolv___res_send" >&5
-$as_echo "$ac_cv_lib_resolv___res_send" >&6; }
-if test "x$ac_cv_lib_resolv___res_send" = x""yes; then :
- resolv=yes
-fi
-
-fi
-
-fi
-
-fi
-
- if test "$resolv" = yes ; then
- RESOLVLIB=-lresolv
- else
- RESOLVLIB=
- fi
- ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost"
-if test "x$ac_cv_func_hes_getmailhost" = x""yes; then :
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5
-$as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; }
-if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lhesiod $RESOLVLIB $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 hes_getmailhost ();
-int
-main ()
-{
-return hes_getmailhost ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_hesiod_hes_getmailhost=yes
-else
- ac_cv_lib_hesiod_hes_getmailhost=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_hesiod_hes_getmailhost" >&5
-$as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; }
-if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then :
- hesiod=yes
-else
- :
-fi
-
-fi
-
-
- if test x"$hesiod" = xyes; then
-
-$as_echo "#define HAVE_LIBHESIOD 1" >>confdefs.h
-
- LIBHESIOD=-lhesiod
- fi
-fi
-
-
-# Do we need libresolv (due to res_init or Hesiod)?
-if test "$resolv" = yes ; then
-
-$as_echo "#define HAVE_LIBRESOLV 1" >>confdefs.h
-
- LIBRESOLV=-lresolv
-else
- LIBRESOLV=
-fi
-
-
-# These tell us which Kerberos-related libraries to use.
-COM_ERRLIB=
-CRYPTOLIB=
-KRB5LIB=
-DESLIB=
-KRB4LIB=
-
-if test "${with_kerberos}" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5
-$as_echo_n "checking for com_err in -lcom_err... " >&6; }
-if test "${ac_cv_lib_com_err_com_err+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lcom_err $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 com_err ();
-int
-main ()
-{
-return com_err ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_com_err_com_err=yes
-else
- ac_cv_lib_com_err_com_err=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_com_err_com_err" >&5
-$as_echo "$ac_cv_lib_com_err_com_err" >&6; }
-if test "x$ac_cv_lib_com_err_com_err" = x""yes; then :
- have_com_err=yes
-else
- have_com_err=no
-fi
-
- if test $have_com_err = yes; then
- COM_ERRLIB=-lcom_err
- LIBS="$COM_ERRLIB $LIBS"
-
-$as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h
-
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5
-$as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; }
-if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lcrypto $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 mit_des_cbc_encrypt ();
-int
-main ()
-{
-return mit_des_cbc_encrypt ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_crypto_mit_des_cbc_encrypt=yes
-else
- ac_cv_lib_crypto_mit_des_cbc_encrypt=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_crypto_mit_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then :
- have_crypto=yes
-else
- have_crypto=no
-fi
-
- if test $have_crypto = yes; then
- CRYPTOLIB=-lcrypto
- LIBS="$CRYPTOLIB $LIBS"
-
-$as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h
-
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5
-$as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; }
-if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lk5crypto $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 mit_des_cbc_encrypt ();
-int
-main ()
-{
-return mit_des_cbc_encrypt ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_k5crypto_mit_des_cbc_encrypt=yes
-else
- ac_cv_lib_k5crypto_mit_des_cbc_encrypt=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_k5crypto_mit_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then :
- have_k5crypto=yes
-else
- have_k5crypto=no
-fi
-
- if test $have_k5crypto = yes; then
- CRYPTOLIB=-lk5crypto
- LIBS="$CRYPTOLIB $LIBS"
-
-$as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h
-
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5
-$as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; }
-if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkrb5 $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 krb5_init_context ();
-int
-main ()
-{
-return krb5_init_context ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_krb5_krb5_init_context=yes
-else
- ac_cv_lib_krb5_krb5_init_context=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_krb5_krb5_init_context" >&5
-$as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; }
-if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then :
- have_krb5=yes
-else
- have_krb5=no
-fi
-
- if test $have_krb5=yes; then
- KRB5LIB=-lkrb5
- LIBS="$KRB5LIB $LIBS"
-
-$as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h
-
- fi
- if test "${with_kerberos5}" = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5
-$as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; }
-if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldes425 $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 des_cbc_encrypt ();
-int
-main ()
-{
-return des_cbc_encrypt ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_des425_des_cbc_encrypt=yes
-else
- ac_cv_lib_des425_des_cbc_encrypt=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_des425_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then :
- have_des425=yes
-else
- have_des425=no
-fi
-
- if test $have_des425 = yes; then
- DESLIB=-ldes425
- LIBS="$DESLIB $LIBS"
-
-$as_echo "#define HAVE_LIBDES425 1" >>confdefs.h
-
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5
-$as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; }
-if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldes $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 des_cbc_encrypt ();
-int
-main ()
-{
-return des_cbc_encrypt ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_des_des_cbc_encrypt=yes
-else
- ac_cv_lib_des_des_cbc_encrypt=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_des_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then :
- have_des=yes
-else
- have_des=no
-fi
-
- if test $have_des = yes; then
- DESLIB=-ldes
- LIBS="$DESLIB $LIBS"
-
-$as_echo "#define HAVE_LIBDES 1" >>confdefs.h
-
- fi
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5
-$as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; }
-if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkrb4 $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 krb_get_cred ();
-int
-main ()
-{
-return krb_get_cred ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_krb4_krb_get_cred=yes
-else
- ac_cv_lib_krb4_krb_get_cred=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_krb4_krb_get_cred" >&5
-$as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; }
-if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then :
- have_krb4=yes
-else
- have_krb4=no
-fi
-
- if test $have_krb4 = yes; then
- KRB4LIB=-lkrb4
- LIBS="$KRB4LIB $LIBS"
-
-$as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h
-
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5
-$as_echo_n "checking for krb_get_cred in -lkrb... " >&6; }
-if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkrb $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 krb_get_cred ();
-int
-main ()
-{
-return krb_get_cred ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_krb_krb_get_cred=yes
-else
- ac_cv_lib_krb_krb_get_cred=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_krb_krb_get_cred" >&5
-$as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; }
-if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then :
- have_krb=yes
-else
- have_krb=no
-fi
-
- if test $have_krb = yes; then
- KRB4LIB=-lkrb
- LIBS="$KRB4LIB $LIBS"
-
-$as_echo "#define HAVE_LIBKRB 1" >>confdefs.h
-
- fi
- fi
- fi
-
- if test "${with_kerberos5}" != no; then
- for ac_header in krb5.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default"
-if test "x$ac_cv_header_krb5_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB5_H 1
-_ACEOF
- ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include <krb5.h>
-"
-if test "x$ac_cv_member_krb5_error_text" = x""yes; then :
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB5_ERROR_TEXT 1
-_ACEOF
-
-
-fi
-ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include <krb5.h>
-"
-if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then :
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB5_ERROR_E_TEXT 1
-_ACEOF
-
-
-fi
-
-fi
-
-done
-
- else
- for ac_header in des.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default"
-if test "x$ac_cv_header_des_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_DES_H 1
-_ACEOF
-
-else
- for ac_header in kerberosIV/des.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROSIV_DES_H 1
-_ACEOF
-
-else
- for ac_header in kerberos/des.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberos_des_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROS_DES_H 1
-_ACEOF
-
-fi
-
-done
-
-fi
-
-done
-
-fi
-
-done
-
- for ac_header in krb.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default"
-if test "x$ac_cv_header_krb_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB_H 1
-_ACEOF
-
-else
- for ac_header in kerberosIV/krb.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROSIV_KRB_H 1
-_ACEOF
-
-else
- for ac_header in kerberos/krb.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROS_KRB_H 1
-_ACEOF
-
-fi
-
-done
-
-fi
-
-done
-
-fi
-
-done
-
- fi
- for ac_header in com_err.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default"
-if test "x$ac_cv_header_com_err_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_COM_ERR_H 1
-_ACEOF
-
-fi
-
-done
-
-fi
-
-
-
-
-
-
-
-# Solaris requires -lintl if you want strerror (which calls dgettext)
-# to return localized messages.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dgettext in -lintl" >&5
-$as_echo_n "checking for dgettext in -lintl... " >&6; }
-if test "${ac_cv_lib_intl_dgettext+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lintl $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 dgettext ();
-int
-main ()
-{
-return dgettext ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_intl_dgettext=yes
-else
- ac_cv_lib_intl_dgettext=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_intl_dgettext" >&5
-$as_echo "$ac_cv_lib_intl_dgettext" >&6; }
-if test "x$ac_cv_lib_intl_dgettext" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBINTL 1
-_ACEOF
-
- LIBS="-lintl $LIBS"
-
-fi
-
-
-{ $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 :
- $as_echo_n "(cached) " >&6
-else
- if test x$ac_cv_func_tzset = xyes; then
-if test "$cross_compiling" = yes; then :
- # If we have tzset, assume the worst when cross-compiling.
-emacs_cv_localtime_cache=yes
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <time.h>
-char TZ_GMT0[] = "TZ=GMT0";
-char TZ_PST8[] = "TZ=PST8";
-main()
-{
- time_t now = time ((time_t *) 0);
- int hour_GMT0, hour_unset;
- if (putenv (TZ_GMT0) != 0)
- exit (1);
- hour_GMT0 = localtime (&now)->tm_hour;
- unsetenv("TZ");
- hour_unset = localtime (&now)->tm_hour;
- if (putenv (TZ_PST8) != 0)
- exit (1);
- if (localtime (&now)->tm_hour == hour_GMT0)
- exit (1);
- unsetenv("TZ");
- if (localtime (&now)->tm_hour != hour_unset)
- exit (1);
- exit (0);
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- emacs_cv_localtime_cache=no
-else
- emacs_cv_localtime_cache=yes
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
-else
- # If we lack tzset, report that localtime does not cache TZ,
- # since we can't invalidate the cache if we don't have tzset.
- emacs_cv_localtime_cache=no
-fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_localtime_cache" >&5
-$as_echo "$emacs_cv_localtime_cache" >&6; }
-if test $emacs_cv_localtime_cache = yes; then
-
-$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 :
-
-else
- ok_so_far=no
-fi
-
-if test $ok_so_far = yes; then
- ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default"
-if test "x$ac_cv_header_netinet_in_h" = x""yes; then :
-
-else
- ok_so_far=no
-fi
-
-
-fi
-if test $ok_so_far = yes; then
- ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default"
-if test "x$ac_cv_header_arpa_inet_h" = x""yes; then :
-
-else
- ok_so_far=no
-fi
-
-
-fi
-if test $ok_so_far = yes; then
-
-$as_echo "#define HAVE_INET_SOCKETS 1" >>confdefs.h
-
-fi
-
-if test -f /usr/lpp/X11/bin/smt.exp; then
-
-$as_echo "#define HAVE_AIX_SMT_EXP 1" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system supports dynamic ptys" >&5
-$as_echo_n "checking whether system supports dynamic ptys... " >&6; }
-if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-$as_echo "#define HAVE_DEV_PTMX 1" >>confdefs.h
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-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 :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define pid_t int
-_ACEOF
-
-fi
-
-for ac_header in vfork.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default"
-if test "x$ac_cv_header_vfork_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_VFORK_H 1
-_ACEOF
-
-fi
-
-done
-
-for ac_func in fork vfork
-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
-
-if test "x$ac_cv_func_fork" = xyes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5
-$as_echo_n "checking for working fork... " >&6; }
-if test "${ac_cv_func_fork_works+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- ac_cv_func_fork_works=cross
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-
- /* By Ruediger Kuhlmann. */
- return fork () < 0;
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_fork_works=yes
-else
- ac_cv_func_fork_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_fork_works" >&5
-$as_echo "$ac_cv_func_fork_works" >&6; }
-
-else
- ac_cv_func_fork_works=$ac_cv_func_fork
-fi
-if test "x$ac_cv_func_fork_works" = xcross; then
- case $host in
- *-*-amigaos* | *-*-msdosdjgpp*)
- # Override, as these systems have only a dummy fork() stub
- ac_cv_func_fork_works=no
- ;;
- *)
- ac_cv_func_fork_works=yes
- ;;
- esac
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5
-$as_echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;}
-fi
-ac_cv_func_vfork_works=$ac_cv_func_vfork
-if test "x$ac_cv_func_vfork" = xyes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5
-$as_echo_n "checking for working vfork... " >&6; }
-if test "${ac_cv_func_vfork_works+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- ac_cv_func_vfork_works=cross
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Thanks to Paul Eggert for this test. */
-$ac_includes_default
-#include <sys/wait.h>
-#ifdef HAVE_VFORK_H
-# include <vfork.h>
-#endif
-/* On some sparc systems, changes by the child to local and incoming
- argument registers are propagated back to the parent. The compiler
- is told about this with #include <vfork.h>, but some compilers
- (e.g. gcc -O) don't grok <vfork.h>. Test for this by using a
- static variable whose address is put into a register that is
- clobbered by the vfork. */
-static void
-#ifdef __cplusplus
-sparc_address_test (int arg)
-# else
-sparc_address_test (arg) int arg;
-#endif
-{
- static pid_t child;
- if (!child) {
- child = vfork ();
- if (child < 0) {
- perror ("vfork");
- _exit(2);
- }
- if (!child) {
- arg = getpid();
- write(-1, "", 0);
- _exit (arg);
- }
- }
-}
-
-int
-main ()
-{
- pid_t parent = getpid ();
- pid_t child;
-
- sparc_address_test (0);
-
- child = vfork ();
-
- if (child == 0) {
- /* Here is another test for sparc vfork register problems. This
- test uses lots of local variables, at least as many local
- variables as main has allocated so far including compiler
- temporaries. 4 locals are enough for gcc 1.40.3 on a Solaris
- 4.1.3 sparc, but we use 8 to be safe. A buggy compiler should
- reuse the register of parent for one of the local variables,
- since it will think that parent can't possibly be used any more
- in this routine. Assigning to the local variable will thus
- munge parent in the parent process. */
- pid_t
- p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(),
- p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid();
- /* Convince the compiler that p..p7 are live; otherwise, it might
- use the same hardware register for all 8 local variables. */
- if (p != p1 || p != p2 || p != p3 || p != p4
- || p != p5 || p != p6 || p != p7)
- _exit(1);
-
- /* On some systems (e.g. IRIX 3.3), vfork doesn't separate parent
- from child file descriptors. If the child closes a descriptor
- before it execs or exits, this munges the parent's descriptor
- as well. Test for this by closing stdout in the child. */
- _exit(close(fileno(stdout)) != 0);
- } else {
- int status;
- struct stat st;
-
- while (wait(&status) != child)
- ;
- return (
- /* Was there some problem with vforking? */
- child < 0
-
- /* Did the child fail? (This shouldn't happen.) */
- || status
-
- /* Did the vfork/compiler bug occur? */
- || parent != getpid()
-
- /* Did the file descriptor bug occur? */
- || fstat(fileno(stdout), &st) != 0
- );
- }
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_vfork_works=yes
-else
- ac_cv_func_vfork_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_vfork_works" >&5
-$as_echo "$ac_cv_func_vfork_works" >&6; }
-
-fi;
-if test "x$ac_cv_func_fork_works" = xcross; then
- ac_cv_func_vfork_works=$ac_cv_func_vfork
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5
-$as_echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;}
-fi
-
-if test "x$ac_cv_func_vfork_works" = xyes; then
-
-$as_echo "#define HAVE_WORKING_VFORK 1" >>confdefs.h
-
-else
-
-$as_echo "#define vfork fork" >>confdefs.h
-
-fi
-if test "x$ac_cv_func_fork_works" = xyes; then
-
-$as_echo "#define HAVE_WORKING_FORK 1" >>confdefs.h
-
-fi
-
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5
-$as_echo_n "checking for nl_langinfo and CODESET... " >&6; }
-if test "${emacs_cv_langinfo_codeset+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <langinfo.h>
-int
-main ()
-{
-char* cs = nl_langinfo(CODESET);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_langinfo_codeset=yes
-else
- emacs_cv_langinfo_codeset=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_langinfo_codeset" >&5
-$as_echo "$emacs_cv_langinfo_codeset" >&6; }
-if test $emacs_cv_langinfo_codeset = yes; then
-
-$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5
-$as_echo_n "checking for mbstate_t... " >&6; }
-if test "${ac_cv_type_mbstate_t+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-# include <wchar.h>
-int
-main ()
-{
-mbstate_t x; return sizeof x;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_type_mbstate_t=yes
-else
- ac_cv_type_mbstate_t=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_mbstate_t" >&5
-$as_echo "$ac_cv_type_mbstate_t" >&6; }
- if test $ac_cv_type_mbstate_t = yes; then
-
-$as_echo "#define HAVE_MBSTATE_T 1" >>confdefs.h
-
- else
-
-$as_echo "#define mbstate_t int" >>confdefs.h
-
- fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5
-$as_echo_n "checking for C restricted array declarations... " >&6; }
-if test "${emacs_cv_c_restrict_arr+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-void fred (int x[__restrict]);
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_c_restrict_arr=yes
-else
- emacs_cv_c_restrict_arr=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_c_restrict_arr" >&5
-$as_echo "$emacs_cv_c_restrict_arr" >&6; }
-if test "$emacs_cv_c_restrict_arr" = yes; then
-
-$as_echo "#define __restrict_arr __restrict" >>confdefs.h
-
-fi
-
-
-
-# Set up the CFLAGS for real compilation, so we can substitute it.
-CFLAGS="$REAL_CFLAGS"
-CPPFLAGS="$REAL_CPPFLAGS"
-
-## Hack to detect a buggy GCC version.
-if test "x$GCC" = xyes \
- && test x"`$CC --version 2> /dev/null | grep 'gcc.* 4.5.0'`" != x \
- && test x"`echo $CFLAGS | grep '\-O[23]'`" != x \
- && test x"`echo $CFLAGS | grep '\-fno-optimize-sibling-calls'`" = x; then
- as_fn_error "GCC 4.5.0 has problems compiling Emacs; see etc/PROBLEMS'." "$LINENO" 5
-fi
-
-version=$PACKAGE_VERSION
-
-### Specify what sort of things we'll be editing into Makefile and config.h.
-### Use configuration here uncanonicalized to avoid exceeding size limits.
-
-
-## Unused?
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-## 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.
-
-
-
-
-## Used in lwlib/Makefile.in.
-
-if test -n "${machfile}"; then
- M_FILE="\$(srcdir)/${machfile}"
-else
- M_FILE=
-fi
-S_FILE="\$(srcdir)/${opsysfile}"
-
-
-
-
-
-
-
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define EMACS_CONFIGURATION "${canonical}"
-_ACEOF
-
-
-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}"
-_ACEOF
-
-fi
-
-cat >>confdefs.h <<_ACEOF
-#define config_opsysfile "${opsysfile}"
-_ACEOF
-
-
-XMENU_OBJ=
-XOBJ=
-FONT_OBJ=
-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"
- FONT_OBJ=xfont.o
- if test "$HAVE_XFT" = "yes"; then
- FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
- elif test "$HAVE_FREETYPE" = "yes"; then
- FONT_OBJ="$FONT_OBJ ftfont.o ftxfont.o"
- fi
-
-fi
-
-
-
-
-WIDGET_OBJ=
-MOTIF_LIBW=
-if test "${USE_X_TOOLKIT}" != "none" ; then
- WIDGET_OBJ=widget.o
-
-$as_echo "#define USE_X_TOOLKIT 1" >>confdefs.h
-
- if test "${USE_X_TOOLKIT}" = "LUCID"; then
-
-$as_echo "#define USE_LUCID 1" >>confdefs.h
-
- elif test "${USE_X_TOOLKIT}" = "MOTIF"; then
-
-$as_echo "#define USE_MOTIF 1" >>confdefs.h
-
- MOTIF_LIBW=-lXm
- case "$opsys" in
- gnu-linux)
- ## Paul Abrahams <abrahams at equinox.shaysnet.com> says this is needed.
- MOTIF_LIBW="$MOTIF_LIBW -lXpm"
- ;;
-
- unixware)
- ## Richard Anthony Ryan <ryanr at ellingtn.ftc.nrcs.usda.gov>
- ## says -lXimp is needed in UNIX_SV ... 4.2 1.1.2.
- MOTIF_LIBW="MOTIF_LIBW -lXimp"
- ;;
-
- aix4-2)
- ## olson@mcs.anl.gov says -li18n is needed by -lXm.
- MOTIF_LIBW="$MOTIF_LIBW -li18n"
- ;;
- esac
- MOTIF_LIBW="$MOTIF_LIBW $LIBXP"
- fi
-fi
-
-
-TOOLKIT_LIBW=
-case "$USE_X_TOOLKIT" in
- MOTIF) TOOLKIT_LIBW="$MOTIF_LIBW" ;;
- LUCID) TOOLKIT_LIBW="$LUCID_LIBW" ;;
- none) test "x$HAVE_GTK" = "xyes" && TOOLKIT_LIBW="$GTK_LIBS" ;;
-esac
-
-
-if test "$USE_X_TOOLKIT" = "none"; then
- LIBXT_OTHER="\$(LIBXSM)"
- OLDXMENU_TARGET="really-oldXMenu"
-else
- LIBXT_OTHER="\$(LIBXMU) -lXt \$(LIBXTR6) -lXext"
- OLDXMENU_TARGET="really-lwlib"
-fi
-
-
-## The X Menu stuff is present in the X10 distribution, but missing
-## from X11. If we have X10, just use the installed library;
-## otherwise, use our own copy.
-if test "${HAVE_X11}" = "yes" ; then
-
-$as_echo "#define HAVE_X11 1" >>confdefs.h
-
-
- if test "$USE_X_TOOLKIT" = "none"; then
- OLDXMENU="\${oldXMenudir}/libXMenu11.a"
- else
- OLDXMENU="\${lwlibdir}/liblw.a"
- fi
- LIBXMENU="\$(OLDXMENU)"
- LIBX_OTHER="\$(LIBXT) \$(LIBX_EXTRA)"
- OLDXMENU_DEPS="\${OLDXMENU} ../src/\${OLDXMENU}"
-else
- ## For a syntactically valid Makefile; not actually used for anything.
- ## See comments in src/Makefile.in.
- OLDXMENU=nothing
- ## FIXME This case (!HAVE_X11 && HAVE_X_WINDOWS) is no longer possible(?).
- if test "${HAVE_X_WINDOWS}" = "yes"; then
- LIBXMENU="-lXMenu"
- else
- LIBXMENU=
- fi
- LIBX_OTHER=
- OLDXMENU_DEPS=
-fi
-
-if test "$HAVE_GTK" = "yes" || test "$HAVE_MENUS" != "yes"; then
- OLDXMENU_TARGET=
- OLDXMENU=nothing
- LIBXMENU=
- OLDXMENU_DEPS=
-fi
-
-
-
-
-
-
-
-if test "${HAVE_MENUS}" = "yes" ; then
-
-$as_echo "#define HAVE_MENUS 1" >>confdefs.h
-
-fi
-
-if test "${GNU_MALLOC}" = "yes" ; then
-
-$as_echo "#define GNU_MALLOC 1" >>confdefs.h
-
-fi
-
-RALLOC_OBJ=
-if test "${REL_ALLOC}" = "yes" ; then
-
-$as_echo "#define REL_ALLOC 1" >>confdefs.h
-
-
- test "$system_malloc" != "yes" && RALLOC_OBJ=ralloc.o
-fi
-
-
-if test "$opsys" = "cygwin"; then
- CYGWIN_OBJ="sheap.o"
- ## Cygwin differs because of its unexec().
- PRE_ALLOC_OBJ=
- POST_ALLOC_OBJ=lastfile.o
-else
- CYGWIN_OBJ=
- PRE_ALLOC_OBJ=lastfile.o
- POST_ALLOC_OBJ=
-fi
-
-
-
-
-
case "$opsys" in
aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;;
@@ -21396,7 +21515,7 @@ case "$opsys" in
libs_nsgui=
headerpad_extra=690
fi
- LD_SWITCH_SYSTEM_TEMACS="-prebind $libs_nsgui -Xlinker -headerpad -Xlinker $headerpad_extra"
+ LD_SWITCH_SYSTEM_TEMACS="-fno-pie -prebind $libs_nsgui -Xlinker -headerpad -Xlinker $headerpad_extra"
## This is here because src/Makefile.in did some extra fiddling around
## with LD_SWITCH_SYSTEM. The cpp logic was:
@@ -21514,8 +21633,6 @@ if test "x$GCC" = "xyes" && test "x$ORDINARY_LINK" != "xyes"; then
fi
-TOOLTIP_SUPPORT=
-WINDOW_SUPPORT=
## If we're using X11/GNUstep, define some consequences.
if test "$HAVE_X_WINDOWS" = "yes" || test "$HAVE_NS" = "yes"; then
@@ -21524,21 +21641,11 @@ $as_echo "#define HAVE_WINDOW_SYSTEM 1" >>confdefs.h
$as_echo "#define HAVE_MOUSE 1" >>confdefs.h
- MOUSE_SUPPORT="\$(REAL_MOUSE_SUPPORT)"
- TOOLTIP_SUPPORT="\${lispsource}/mouse.elc"
-
- WINDOW_SUPPORT="\$(BASE_WINDOW_SUPPORT)"
- test "$HAVE_X_WINDOWS" = "yes" && \
- WINDOW_SUPPORT="$WINDOW_SUPPORT \$(X_WINDOW_SUPPORT)"
-
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
@@ -21588,8 +21695,9 @@ echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGI
echo " Does Emacs use -lgpm? ${HAVE_GPM}"
echo " Does Emacs use -ldbus? ${HAVE_DBUS}"
echo " Does Emacs use -lgconf? ${HAVE_GCONF}"
+echo " Does Emacs use GSettings? ${HAVE_GSETTINGS}"
echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}"
-echo " Does Emacs use -lgnutls? ${HAVE_GNUTLS}"
+echo " Does Emacs use -lgnutls (2.6.x or higher)? ${HAVE_GNUTLS}"
echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}"
echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}"
@@ -21629,7 +21737,21 @@ test "${prefix}" != NONE &&
test "${exec_prefix}" != NONE &&
exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`
-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 test/automated/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"
+
+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"
+
+
+opt_makefile=test/automated/Makefile
+
+if test -f $srcdir/${opt_makefile}.in; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ ac_config_files="$ac_config_files test/automated/Makefile"
+
+fi
+
+SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'`
+
ac_config_commands="$ac_config_commands mkdirs"
@@ -21759,6 +21881,10 @@ 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
fi
+if test -z "${GL_GENERATE_ALLOCA_H_TRUE}" && test -z "${GL_GENERATE_ALLOCA_H_FALSE}"; then
+ as_fn_error "conditional \"GL_GENERATE_ALLOCA_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.
@@ -21776,10 +21902,6 @@ if test -z "${GL_GENERATE_STDDEF_H_TRUE}" && test -z "${GL_GENERATE_STDDEF_H_FAL
as_fn_error "conditional \"GL_GENERATE_STDDEF_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_GNULIB_ENABLED_dosname_TRUE}" && test -z "${gl_GNULIB_ENABLED_dosname_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_dosname\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
@@ -21788,10 +21910,18 @@ if test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE}" && test
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.
+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
as_fn_error "conditional \"gl_GNULIB_ENABLED_stat\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${gl_GNULIB_ENABLED_strtoll_TRUE}" && test -z "${gl_GNULIB_ENABLED_strtoll_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_strtoll\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${gl_GNULIB_ENABLED_strtoull_TRUE}" && test -z "${gl_GNULIB_ENABLED_strtoull_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_strtoull\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
diff --git a/config.bat b/config.bat
index e480a4b9bc8..dba3600e0d9 100644
--- a/config.bat
+++ b/config.bat
@@ -211,7 +211,7 @@ if exist dir.h ren dir.h vmsdir.h
rem Create "makefile" from "makefile.in".
rm -f Makefile makefile.tmp
-copy Makefile.in+deps.mk makefile.tmp
+copy Makefile.in+lisp.mk+deps.mk makefile.tmp
sed -f ../msdos/sed1v2.inp <makefile.tmp >Makefile
rm -f makefile.tmp
diff --git a/configure.in b/configure.in
index f46645c1bd2..f88506fbb2e 100644
--- a/configure.in
+++ b/configure.in
@@ -144,6 +144,11 @@ this option's value should be `yes', `no', `lucid', `athena', `motif', `gtk' or
with_x_toolkit=$val
])
+OPTION_DEFAULT_OFF([wide-int], [prefer wide Emacs integers (typically 62-bit)])
+if test "$with_wide_int" = yes; then
+ AC_DEFINE([WIDE_EMACS_INT], 1, [Use long long for EMACS_INT if available.])
+fi
+
dnl _ON results in a '--without' option in the --help output, so
dnl the help text should refer to "don't compile", etc.
OPTION_DEFAULT_ON([xpm],[don't compile with XPM image support])
@@ -167,6 +172,7 @@ OPTION_DEFAULT_OFF([ns],[use NeXTstep (Cocoa or GNUstep) windowing system])
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])
OPTION_DEFAULT_ON([gconf],[don't compile with GConf support])
+OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support])
OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
@@ -225,8 +231,8 @@ AC_ARG_ENABLE(asserts,
USE_XASSERTS=no)
AC_ARG_ENABLE(maintainer-mode,
-[AS_HELP_STRING([--enable-maintainer-mode],
- [enable make rules and dependencies not useful (and sometimes
+[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)
@@ -364,17 +370,6 @@ case "${srcdir}" in
* ) srcdir="`(cd ${srcdir}; pwd)`" ;;
esac
-#### Check if the source directory already has a configured system in it.
-if test `pwd` != `(cd ${srcdir} && pwd)` \
- && test -f "${srcdir}/src/config.h" ; then
- AC_MSG_WARN([[The directory tree `${srcdir}' is being used
- as a build directory right now; it has been configured in its own
- right. To configure in another directory as well, you MUST
- use GNU make. If you do not have GNU make, then you must
- now do `make distclean' in ${srcdir},
- and then run $0 again.]])
-fi
-
#### Given the configuration name, set machfile and opsysfile to the
#### names of the m/*.h and s/*.h files we should use.
@@ -541,7 +536,7 @@ case "${canonical}" in
## Silicon Graphics machines
## Iris 4D
mips-sgi-irix6.5 )
- machine=iris4d opsys=irix6-5
+ opsys=irix6-5
# 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).
@@ -989,47 +984,13 @@ fi
# Suppress obsolescent Autoconf test for size_t; Emacs assumes C89 or better.
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
-## If user specified a crt-dir, use that unconditionally.
-if test "X$CRT_DIR" = "X"; then
-
- case "$canonical" in
- x86_64-*-linux-gnu* | s390x-*-linux-gnu*)
- ## On x86-64 and s390x GNU/Linux distributions, the standard library
- ## can be in a variety of places. We only try /usr/lib64 and /usr/lib.
- ## For anything else (eg /usr/lib32), it is up the user to specify
- ## the location (bug#5655).
- ## Test for crtn.o, not just the directory, because sometimes the
- ## directory exists but does not have the relevant files (bug#1287).
- ## FIXME better to test for binary compatibility somehow.
- test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64
- ;;
-
- powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;;
- esac
-
- case "$opsys" in
- hpux10-20) CRT_DIR=/lib ;;
- esac
-
- ## Default is /usr/lib.
- test "X$CRT_DIR" = "X" && CRT_DIR=/usr/lib
-
-else
-
- ## Some platforms don't use any of these files, so it is not
- ## appropriate to put this test outside the if block.
- test -e $CRT_DIR/crtn.o || test -e $CRT_DIR/crt0.o || \
- AC_MSG_ERROR([crt*.o not found in specified location.])
-
-fi
-
-AC_SUBST(CRT_DIR)
-
LIB_MATH=-lm
LIB_STANDARD=
START_FILES=
@@ -1070,6 +1031,80 @@ esac
AC_SUBST(LIB_MATH)
AC_SUBST(START_FILES)
+dnl Not all platforms use crtn.o files. Check if the current one does.
+crt_files=
+
+for file in x $LIB_STANDARD $START_FILES; do
+ case "$file" in
+ *CRT_DIR*) crt_files="$crt_files `echo $file | sed -e 's|.*/||'`" ;;
+ esac
+done
+
+if test "x$crt_files" != x; then
+
+ ## If user specified a crt-dir, use that unconditionally.
+ crt_gcc=no
+
+ if test "X$CRT_DIR" = "X"; then
+
+ CRT_DIR=/usr/lib # default
+
+ case "$canonical" in
+ x86_64-*-linux-gnu* | s390x-*-linux-gnu*)
+ ## On x86-64 and s390x GNU/Linux distributions, the standard library
+ ## can be in a variety of places. We only try /usr/lib64 and /usr/lib.
+ ## For anything else (eg /usr/lib32), it is up the user to specify
+ ## the location (bug#5655).
+ ## Test for crtn.o, not just the directory, because sometimes the
+ ## directory exists but does not have the relevant files (bug#1287).
+ ## FIXME better to test for binary compatibility somehow.
+ test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64
+ ;;
+
+ powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;;
+ esac
+
+ case "$opsys" in
+ hpux10-20) CRT_DIR=/lib ;;
+ esac
+
+ test "x${GCC}" = xyes && crt_gcc=yes
+
+ fi # CRT_DIR = ""
+
+ crt_missing=
+
+ for file in $crt_files; do
+
+ ## If we're using gcc, try to determine it automatically by asking
+ ## gcc. [If this doesn't work, CRT_DIR will remain at the
+ ## system-dependent default from above.]
+ if test $crt_gcc = yes && test ! -e $CRT_DIR/$file; then
+
+ crt_file=`$CC --print-file-name=$file 2>/dev/null`
+ case "$crt_file" in
+ */*)
+ CRT_DIR=`AS_DIRNAME(["$crt_file"])`
+ ;;
+ esac
+ fi
+
+ dnl We expect all the files to be in a single directory, so after the
+ dnl first there is no point asking gcc.
+ crt_gcc=no
+
+ test -e $CRT_DIR/$file || crt_missing="$crt_missing $file"
+ done # $crt_files
+
+ test "x$crt_missing" = x || \
+ AC_MSG_ERROR([Required file(s) not found:$crt_missing
+Try using the --with-crt-dir option.])
+
+fi # crt_files != ""
+
+AC_SUBST(CRT_DIR)
+
+
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
@@ -1297,9 +1332,6 @@ dnl and void *.
AC_C_PROTOTYPES
AC_C_VOLATILE
AC_C_CONST
-dnl This isn't useful because we can't turn on use of `inline' unless
-dnl the compiler groks `extern inline'.
-dnl AC_C_INLINE
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)])
@@ -1370,6 +1402,10 @@ AC_SUBST(DEPFLAGS)
AC_SUBST_FILE(deps_frag)
+lisp_frag=$srcdir/src/lisp.mk
+AC_SUBST_FILE(lisp_frag)
+
+
dnl checks for operating system services
AC_SYS_LONG_FILE_NAMES
@@ -1503,7 +1539,6 @@ AC_SUBST(TEMACS_LDFLAGS2)
ns_frag=/dev/null
NS_OBJ=
NS_OBJC_OBJ=
-NS_SUPPORT=
if test "${HAVE_NS}" = yes; then
window_system=nextstep
with_xft=no
@@ -1516,13 +1551,11 @@ if test "${HAVE_NS}" = yes; then
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"
- NS_SUPPORT="\${lispsource}/emacs-lisp/easymenu.elc \${lispsource}/term/ns-win.elc"
fi
CFLAGS="$tmp_CFLAGS"
CPPFLAGS="$tmp_CPPFLAGS"
AC_SUBST(NS_OBJ)
AC_SUBST(NS_OBJC_OBJ)
-AC_SUBST(NS_SUPPORT)
AC_SUBST(LIB_STANDARD)
AC_SUBST_FILE(ns_frag)
@@ -1827,6 +1860,7 @@ fi
HAVE_GTK=no
+GTK_OBJ=
if test "${with_gtk3}" = "yes"; then
GLIB_REQUIRED=2.28
GTK_REQUIRED=3.0
@@ -1838,6 +1872,7 @@ if 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
fi
if test "$pkg_check_gtk" != "yes"; then
@@ -1855,7 +1890,6 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
fi
fi
-GTK_OBJ=
if test x"$pkg_check_gtk" = xyes; then
AC_SUBST(GTK_CFLAGS)
@@ -1873,7 +1907,7 @@ if test x"$pkg_check_gtk" = xyes; then
else
HAVE_GTK=yes
AC_DEFINE(USE_GTK, 1, [Define to 1 if using GTK.])
- GTK_OBJ=gtkutil.o
+ GTK_OBJ="gtkutil.o $GTK_OBJ"
USE_X_TOOLKIT=none
if $PKG_CONFIG --atleast-version=2.10 gtk+-2.0; then
:
@@ -1950,6 +1984,17 @@ if test "${with_dbus}" = "yes"; then
fi
AC_SUBST(DBUS_OBJ)
+dnl GSettings has been tested under GNU/Linux only.
+HAVE_GSETTINGS=no
+if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then
+ PKG_CHECK_MODULES(GSETTINGS, gio-2.0 >= 2.26, HAVE_GSETTINGS=yes, HAVE_GSETTINGS=no)
+ if test "$HAVE_GSETTINGS" = "yes"; then
+ AC_DEFINE(HAVE_GSETTINGS, 1, [Define to 1 if using GSettings.])
+ SETTINGS_CFLAGS="$GSETTINGS_CFLAGS"
+ SETTINGS_LIBS="$GSETTINGS_LIBS"
+ fi
+fi
+
dnl GConf has been tested under GNU/Linux only.
dnl The version is really arbitrary, it is about the same age as Gtk+ 2.6.
HAVE_GCONF=no
@@ -1958,10 +2003,24 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
if test "$HAVE_GCONF" = yes; then
AC_DEFINE(HAVE_GCONF, 1, [Define to 1 if using GConf.])
dnl Newer GConf doesn't link with g_objects, so this is not defined.
- AC_CHECK_FUNCS([g_type_init])
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS"
fi
fi
+if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
+ SAVE_CFLAGS="$CFLAGS"
+ SAVE_LDFLAGS="$LDFLAGS"
+ CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
+ LDFLAGS="$SETTINGS_LIBS $LDFLAGS"
+ AC_CHECK_FUNCS([g_type_init])
+ CFLAGS="$SAVE_CFLAGS"
+ LDFLAGS="$SAVE_LDFLAGS"
+fi
+AC_SUBST(SETTINGS_CFLAGS)
+AC_SUBST(SETTINGS_LIBS)
+
+
dnl SELinux is available for GNU/Linux only.
HAVE_LIBSELINUX=no
LIBSELINUX_LIBS=
@@ -2036,8 +2095,11 @@ if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
elif test x"${USE_X_TOOLKIT}" = xLUCID; then
AC_MSG_ERROR([Lucid toolkit requires X11/Xaw include files])
else
- AC_MSG_RESULT([no; do not use toolkit by default])
- USE_X_TOOLKIT=none
+ AC_MSG_ERROR([No X toolkit could be found.
+If you are sure you want Emacs compiled without an X toolkit, pass
+ --with-x-toolkit=no
+to configure. Otherwise, install the development libraries for the toolkit
+that you want to use (e.g. Gtk+) and re-run configure.])
fi
fi
fi
@@ -2473,7 +2535,6 @@ fi
### Use -lgpm if available, unless `--with-gpm=no'.
HAVE_GPM=no
LIBGPM=
-MOUSE_SUPPORT=
if test "${with_gpm}" != "no"; then
AC_CHECK_HEADER(gpm.h,
[AC_CHECK_LIB(gpm, Gpm_Open, HAVE_GPM=yes)])
@@ -2481,8 +2542,6 @@ if test "${with_gpm}" != "no"; then
if test "${HAVE_GPM}" = "yes"; then
AC_DEFINE(HAVE_GPM, 1, [Define to 1 if you have the gpm library (-lgpm).])
LIBGPM=-lgpm
- ## May be reset below.
- MOUSE_SUPPORT="\$(GPM_MOUSE_SUPPORT)"
fi
fi
AC_SUBST(LIBGPM)
@@ -2560,15 +2619,6 @@ 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
-AC_FUNC_ALLOCA
-
-dnl src/alloca.c has been removed. Could also check if $ALLOCA is set?
-dnl FIXME is there an autoconf test that does the right thing, without
-dnl needing to call A_M_E afterwards?
-if test x"$ac_cv_func_alloca_works" != xyes; then
- AC_MSG_ERROR( [a system implementation of alloca is required] )
-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.
AC_CHECK_LIB(m, sqrt)
@@ -2649,7 +2699,7 @@ esac
AC_SUBST(BLESSMAIL_TARGET)
-AC_CHECK_FUNCS(gethostname getdomainname dup2 \
+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 \
@@ -2677,11 +2727,6 @@ AC_FUNC_FSEEKO
AC_FUNC_GETPGRP
-# Configure gnulib.
-gl_ASSERT_NO_GNULIB_POSIXCHECK
-gl_ASSERT_NO_GNULIB_TESTS
-gl_INIT
-
# UNIX98 PTYs.
AC_CHECK_FUNCS(grantpt)
@@ -3285,6 +3330,10 @@ AC_SUBST(CYGWIN_OBJ)
AC_SUBST(PRE_ALLOC_OBJ)
AC_SUBST(POST_ALLOC_OBJ)
+# Configure gnulib here, now that we know LIBS.
+gl_ASSERT_NO_GNULIB_POSIXCHECK
+gl_ASSERT_NO_GNULIB_TESTS
+gl_INIT
case "$opsys" in
aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;;
@@ -3301,7 +3350,7 @@ case "$opsys" in
libs_nsgui=
headerpad_extra=690
fi
- LD_SWITCH_SYSTEM_TEMACS="-prebind $libs_nsgui -Xlinker -headerpad -Xlinker $headerpad_extra"
+ LD_SWITCH_SYSTEM_TEMACS="-fno-pie -prebind $libs_nsgui -Xlinker -headerpad -Xlinker $headerpad_extra"
## This is here because src/Makefile.in did some extra fiddling around
## with LD_SWITCH_SYSTEM. The cpp logic was:
@@ -3418,23 +3467,11 @@ fi dnl if $GCC
AC_SUBST(LIB_GCC)
-TOOLTIP_SUPPORT=
-WINDOW_SUPPORT=
## If we're using X11/GNUstep, define some consequences.
if test "$HAVE_X_WINDOWS" = "yes" || test "$HAVE_NS" = "yes"; 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.])
- MOUSE_SUPPORT="\$(REAL_MOUSE_SUPPORT)"
- TOOLTIP_SUPPORT="\${lispsource}/mouse.elc"
-
- WINDOW_SUPPORT="\$(BASE_WINDOW_SUPPORT)"
- test "$HAVE_X_WINDOWS" = "yes" && \
- WINDOW_SUPPORT="$WINDOW_SUPPORT \$(X_WINDOW_SUPPORT)"
-
fi
-AC_SUBST(MOUSE_SUPPORT)
-AC_SUBST(TOOLTIP_SUPPORT)
-AC_SUBST(WINDOW_SUPPORT)
AH_TOP([/* GNU Emacs site configuration template file.
@@ -3466,21 +3503,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
])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
-/* If using GNU, then support inline function declarations. */
-/* Don't try to switch on inline handling as detected by AC_C_INLINE
- generally, because even if non-gcc compilers accept `inline', they
- may reject `extern inline'. */
-#if defined (__GNUC__)
-#define INLINE __inline__
-#else
-#define INLINE
-#endif
-
/* `subprocesses' should be defined if you want to
have code for asynchronous subprocesses
(as used in M-x compile and M-x shell).
@@ -3552,20 +3585,6 @@ AH_BOTTOM([
#include <string.h>
#include <stdlib.h>
-#ifdef HAVE_ALLOCA_H
-# include <alloca.h>
-#elif defined __GNUC__
-# define alloca __builtin_alloca
-#elif defined _AIX
-# define alloca __alloca
-#else
-# include <stddef.h>
-# ifdef __cplusplus
-extern "C"
-# endif
-void *alloca (size_t);
-#endif
-
#ifndef HAVE_STRCHR
#define strchr(a, b) index (a, b)
#endif
@@ -3682,6 +3701,7 @@ echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGI
echo " Does Emacs use -lgpm? ${HAVE_GPM}"
echo " Does Emacs use -ldbus? ${HAVE_DBUS}"
echo " Does Emacs use -lgconf? ${HAVE_GCONF}"
+echo " Does Emacs use GSettings? ${HAVE_GSETTINGS}"
echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}"
echo " Does Emacs use -lgnutls (2.6.x or higher)? ${HAVE_GNUTLS}"
echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}"
@@ -3723,10 +3743,34 @@ fi
test "${exec_prefix}" != NONE &&
exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`]
+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
+dnl (else you get "no `Makefile.am' found for any configure output").
+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"
+
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 test/automated/Makefile])
+ doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \
+ doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile \
+ leim/Makefile])
+
+dnl test/ is not present in release tarfiles.
+opt_makefile=test/automated/Makefile
+
+if test -f $srcdir/${opt_makefile}.in; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ dnl Again, it's best not to use a variable. Though you can add
+ dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
+ AC_CONFIG_FILES([test/automated/Makefile])
+fi
+
+SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'`
+
+AC_SUBST(SUBDIR_MAKEFILES_IN)
dnl Make the necessary directories, if they don't exist.
AC_CONFIG_COMMANDS([mkdirs], [
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index d3521dcd524..e21a02f700f 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,227 @@
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * custom.texi (Hooks): Mention buffer-local hooks (bug#6218).
+
+2011-07-13 Glenn Morris <rgm@gnu.org>
+
+ * dired.texi (Dired Enter): Mention --dired. (Bug#9039)
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mark.texi (Mark Ring): Clarify how many locations are saved
+ (bug#5770).
+ (Global Mark Ring): Ditto.
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * text.texi (Table Recognition): Use "at point" instead of "under
+ point" (bug#4345).
+
+ * display.texi (Cursor Display): Mention `cursor-type'.
+
+ * screen.texi (Point): Clarify that it's only if you use a block
+ cursor that it appears to be on a character (bug#4345).
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * misc.texi (Amusements): Move dissociated press here, from its
+ own section.
+
+ * emacs.texi (Top): Update node listing.
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * emacs.texi (Top): Change "inferiors" to "subnodes" for greater
+ clarity (bug#3523).
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * cmdargs.texi (Initial Options): Document --no-site-lisp.
+ (Misc X): Document --parent-id.
+
+ * frames.texi (Frame Commands): Note that focus-follows-mouse now
+ defaults to nil.
+
+ * misc.texi (emacsclient Options): Document --parent-id.
+
+ * msdog.texi (Windows HOME): Document _emacs as obsolete.
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * emacs.texi: Use "..." instead of ``...'' in the menus
+ (bug#3503).
+
+2011-07-11 Chong Yidong <cyd@stupidchicken.com>
+
+ * killing.texi (Primary Selection): Document `only' setting for
+ select-active-regions.
+
+ * mark.texi (Setting Mark): Reference Shift Selection node.
+
+ * frames.texi (Mouse Commands): Document mouse-yank-primary.
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mark.texi (Setting Mark): Clarify what's meant by "Shifted
+ motion keys" (bug#3503).
+
+ * emacs.texi: Change all the register node names from "RegPos"
+ (etc.) to "Positional Registers" (etc.) (bug#3314).
+
+2011-07-11 Chong Yidong <cyd@stupidchicken.com>
+
+ * killing.texi (Killing, Deletion and Killing, Killing by Lines)
+ (Other Kill Commands, Kill Options): Copyedits.
+ (Deletion and Killing, Kill Ring): Kill/yank now use clipboard.
+ (Yanking): Move yank-excluded properties discussion here.
+ (Cut and Paste): Move from frames.texi. Update subnodes to
+ describe x-select-enable-clipboard case.
+
+ * frames.texi: Move Cut and Paste node and subnodes into
+ killing.texi, except Mouse Commands and Word and Line Mouse.
+
+2011-07-10 Andy Moreton <andrewjmoreton@gmail.com> (tiny change)
+
+ * makefile.w32-in (EMACSSOURCES): Replace major.texi with modes.texi.
+
+2011-07-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * screen.texi (Mode Line): Clarify that coding systems are
+ characters, not letters (bug#1749).
+
+ * cmdargs.texi (Environment): Mention removing variables
+ (bug#1615). Text suggested by Kevin Rodgers.
+
+2011-07-10 Chong Yidong <cyd@stupidchicken.com>
+
+ * misc.texi (Amusements): Don't mention Yow; it's crippled.
+
+ * modes.texi: Rename from major.texi.
+ (Modes): New node. Make Major Modes and Minor Modes subsections
+ of this. All callers changed.
+
+ * custom.texi (Minor Modes): Move to modes.texi.
+
+2011-07-10 Chong Yidong <cyd@stupidchicken.com>
+
+ * custom.texi (Syntax): Node deleted.
+
+ * help.texi (Help Summary):
+ * major.texi (Major Modes):
+ * programs.texi (Parentheses):
+ * search.texi (Regexp Backslash, Regexp Backslash)
+ (Regexp Backslash):
+ * text.texi (Words): Callers changed.
+
+ * text.texi (Refill, Longlines): Delete nodes.
+
+ * ack.texi (Acknowledgments): Longlines removed from manual.
+
+ * emacs.texi (Top): Update node listing.
+
+2011-07-09 Glenn Morris <rgm@gnu.org>
+
+ * fortran-xtra.texi (Fortran): Update handled extensions.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * display.texi (Scrolling): `C-v' (etc) are now bound to
+ `scroll-*-command' (bug#8349).
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dired.texi (Subdirectories in Dired): Clarify that `C-u k'
+ doesn't actually delete any files (bug#7125).
+
+ * picture-xtra.texi (Rectangles in Picture): Clarify the prefix
+ argument for `C-c C-k' (bug#7391).
+
+ * frames.texi (Fonts): Mention "C-u C-x =" to find out what font
+ you're currently using (bug#8489).
+
+2011-07-01 Eli Zaretskii <eliz@gnu.org>
+
+ * mule.texi (Coding Systems): Move index entries from the previous
+ change into their proper places.
+
+2011-07-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * help.texi (Help Files): Document view-external-packages (bug#8902).
+
+ * mule.texi (Coding Systems): Put a few more of the coding systems
+ into the index (bug#8900).
+
+2011-06-26 Glenn Morris <rgm@gnu.org>
+
+ * fortran-xtra.texi (Fortran): F90 mode is also for F2008.
+
+2011-06-25 Andreas Rottmann <a.rottmann@gmx.at>
+
+ * misc.texi (emacsclient Options): Mention --frame-parameters.
+
+2011-06-09 Glenn Morris <rgm@gnu.org>
+
+ * custom.texi (Specifying File Variables):
+ Recommend explicit arguments for minor modes.
+
+2011-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Document wide integers better.
+ * buffers.texi (Buffers):
+ * files.texi (Visiting): Document maxima for 64-bit machines,
+ and mention virtual memory limits.
+
+2011-05-28 Chong Yidong <cyd@stupidchicken.com>
+
+ * custom.texi (Hooks): Reorganize. Mention Prog mode.
+
+ * fixit.texi (Spelling): Mention using prog-mode-hook for flypsell
+ prog mode (Bug#8240).
+
+2011-05-27 Glenn Morris <rgm@gnu.org>
+
+ * custom.texi (Specifying File Variables):
+ Major modes no longer need come first.
+
+2011-05-22 Chong Yidong <cyd@stupidchicken.com>
+
+ * mule.texi (Specify Coding, Text Coding, Communication Coding):
+ (File Name Coding, Terminal Coding): Add command names (Bug#8312).
+
+2011-05-18 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Remove fakemail.c.
+
+2011-05-17 Chong Yidong <cyd@stupidchicken.com>
+
+ Fixes for fitting text into 7x9 printed manual.
+ * building.texi (Flymake, Breakpoints Buffer):
+ * calendar.texi (Appointments):
+ * cmdargs.texi (General Variables, Display X):
+ * custom.texi (Saving Customizations, Face Customization)
+ (Directory Variables, Minibuffer Maps, Init Rebinding):
+ * display.texi (Font Lock, Font Lock, Useless Whitespace):
+ * fixit.texi (Spelling):
+ * frames.texi (Creating Frames, Fonts):
+ * help.texi (Help Files):
+ * mini.texi (Minibuffer File):
+ * misc.texi (emacsclient Options, Emulation):
+ * msdog.texi (Windows Startup, Windows HOME, Windows Fonts):
+ * mule.texi (International Chars, Language Environments)
+ (Select Input Method, Modifying Fontsets, Charsets):
+ * programs.texi (Custom C Indent):
+ * rmail.texi (Rmail Labels):
+ * text.texi (Table Conversion):
+ * trouble.texi (Known Problems, Known Problems):
+ * windows.texi (Change Window):
+ * xresources.texi (GTK resources): Reflow text and re-indent code
+ examples to avoid TeX overflows and underflows on 7x9 paper.
+
+ * emacs.texi: Fix the (commented out) smallbook command.
+
+ * macos.texi (Mac / GNUstep Events):
+ * xresources.texi (Lucid Resources): Remove extraneous examples.
+
2011-05-10 Glenn Morris <rgm@gnu.org>
* custom.texi (Specifying File Variables):
diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in
index aca17ce817d..9465c726eba 100644
--- a/doc/emacs/Makefile.in
+++ b/doc/emacs/Makefile.in
@@ -84,7 +84,7 @@ EMACSSOURCES= \
${srcdir}/windows.texi \
${srcdir}/frames.texi \
${srcdir}/mule.texi \
- ${srcdir}/major.texi \
+ ${srcdir}/modes.texi \
${srcdir}/indent.texi \
${srcdir}/text.texi \
${srcdir}/programs.texi \
diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi
index debe7149cb5..1cfb3d9ffe9 100644
--- a/doc/emacs/ack.texi
+++ b/doc/emacs/ack.texi
@@ -190,9 +190,7 @@ 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; and, together with Kai
-Großjohann and Alex Schroeder, wrote @file{longlines.el}, a minor
-mode for wrapping long lines.
+improvements to the Emacs display engine.
@item
James Clark wrote SGML mode, a mode for editing SGML documents; and
@@ -689,14 +687,12 @@ 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{refill.el}, a mode for
-automatic paragraph refilling, akin to typical word processors;
-@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.
+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.
@item
Eric Ludlam wrote the Speedbar package; @file{checkdoc.el}, for checking
@@ -1016,7 +1012,7 @@ Markus Rost wrote @file{cus-test.el}, a testing framework for customize.
@item
Guillermo J.@: Rozas wrote @file{scheme.el}, a mode for editing Scheme and
-DSSSL code, and @file{fakemail.c}, an interface to the System V mailer.
+DSSSL code.
@item
Ivar Rummelhoff wrote @file{winner.el}, which records recent window
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index ae0d85f249b..d4cc4f7bb6a 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -43,8 +43,11 @@ can be different from the value in other buffers. @xref{Locals}.
A buffer's size cannot be larger than some maximum, which is defined
by the largest buffer position representable by the @dfn{Emacs
integer} data type. This is because Emacs tracks buffer positions
-using that data type. For 32-bit machines, the largest buffer size is
-512 megabytes.
+using that data type. For typical 64-bit machines, the maximum buffer size
+enforced by the data types is @math{2^61 - 2} bytes, or about 2 EiB.
+For typical 32-bit machines, the maximum is @math{2^29 - 2} bytes, or
+about 512 MiB. Buffer sizes are also limited by the size of Emacs's
+virtual memory.
@menu
* Select Buffer:: Creating a new buffer or reselecting an old one.
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index a07e7582011..cca9e441ed4 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -438,8 +438,8 @@ 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 activate Flymake mode, type @kbd{M-x flymake-mode}. You can move
-to the errors spotted by Flymake mode with @kbd{M-x
+ 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}.
@@ -992,7 +992,7 @@ breakpoint}, the breakpoint which point is on.
@item @key{SPC}
@kindex SPC @r{(GDB breakpoints buffer)}
@findex gdb-toggle-breakpoint
-Enable/disable the current breakpoint (@code{gdb-toggle-breakpoint}).
+Enable/disable current breakpoint (@code{gdb-toggle-breakpoint}).
On a graphical display, this changes the color of a bullet in the
margin of a source buffer at the relevant line. This is red when
the breakpoint is enabled and grey when it is disabled. Text-only
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index fabd38ecc18..9de223854c1 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -1473,12 +1473,12 @@ give the names of functions used to create and destroy the window,
respectively.
@findex appt-activate
- To enable appointment notification, use the command @kbd{M-x
-appt-activate}. With a positive argument, it enables notification;
-with a negative argument, it disables notification; with no argument,
-it toggles. Enabling notification also sets up an appointment list
-for today from the diary file, giving all diary entries found with
-recognizable times of day, and reminds you just before each of them.
+ To enable appointment notification, type @kbd{M-x appt-activate}.
+With a positive argument, it enables notification; with a negative
+argument, it disables notification; with no argument, it toggles.
+Enabling notification also sets up an appointment list for today from
+the diary file, giving all diary entries found with recognizable times
+of day, and reminds you just before each of them.
For example, suppose the diary file contains these lines:
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 12c1d9a8bfd..2a19e1b009d 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -289,9 +289,14 @@ like this, the Customize facility does not allow options to be saved
@item --no-site-file
@opindex --no-site-file
@cindex @file{site-start.el} file, not loading
-Do not load @file{site-start.el}. The options @samp{-q}, @samp{-u}
-and @samp{--batch} have no effect on the loading of this file---this
-option and @samp{-Q} are the only options that block it.
+Do not load @file{site-start.el} (@pxref{Init File}). The @samp{-Q}
+option does this too, but other options like @samp{-q} do not.
+
+@item --no-site-lisp
+@opindex --no-site-lisp
+@cindex @file{site-start.el} file, not loading
+Do not include the @file{site-lisp} directories in @code{load-path}
+(@pxref{Init File}). The @samp{-Q} option does this too.
@item --no-splash
@opindex --no-splash
@@ -307,9 +312,9 @@ in your initialization file (@pxref{Entering Emacs}).
@itemx --quick
@opindex --quick
Start emacs with minimum customizations, similar to using @samp{-q},
-@samp{--no-site-file}, and @samp{--no-splash} together. This also
-stops Emacs from processing X resources by setting
-@code{inhibit-x-resources} to @code{t} (@pxref{Resources}).
+@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}).
@item -daemon
@opindex -daemon
@@ -427,10 +432,11 @@ software) inherit the environment from Emacs, too.
@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. (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.
+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
@@ -474,9 +480,8 @@ when you specify a relative directory name.
Directory for the architecture-independent files that come with Emacs.
This is used to initialize the Lisp variable @code{data-directory}.
@item EMACSDOC
-Directory for the documentation string file,
-@file{DOC-@var{emacsversion}}. This is used to initialize the Lisp
-variable @code{doc-directory}.
+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,''
@@ -722,14 +727,14 @@ 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 syntax of the @env{DISPLAY} environment variable is
+ @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.
+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.
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
@@ -1131,6 +1136,11 @@ use---usually just a small rectangle containing the frame's title.
@c Enable horizontal scroll bars. Since horizontal scroll bars
@c are not yet implemented, this actually does nothing.
+@item --parent-id @var{ID}
+Open Emacs as a client X window via the XEmbed protocol, with @var{ID}
+as the parent X window id. Currently, this option is mainly useful
+for developers.
+
@item -vb
@opindex -vb
@itemx --vertical-scroll-bars
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index d7a99d49d60..6a6d465438d 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -23,169 +23,16 @@ Reference Manual}.
@end ifnottex
@menu
-* Minor Modes:: Each minor mode is a feature you can turn on
- independently of any others.
* Easy Customization:: Convenient way to browse and change settings.
* Variables:: Many Emacs commands examine Emacs variables
to decide what to do; by setting variables,
you can control their functioning.
* Key Bindings:: The keymaps say what command each key runs.
By changing them, you can "redefine keys".
-* Syntax:: The syntax table controls how words and
- expressions are parsed.
* Init File:: How to write common customizations in the
@file{.emacs} file.
@end menu
-@node Minor Modes
-@section Minor Modes
-@cindex minor modes
-@cindex mode, minor
-
- Minor modes are optional features which you can turn on or off. For
-example, Auto Fill mode is a minor mode in which @key{SPC} breaks
-lines between words as you type. Minor modes are independent of one
-another and of the selected major mode. Most minor modes say in the
-mode line when they are enabled; for example, @samp{Fill} in the mode
-line means that Auto Fill mode is enabled.
-
- Each minor mode is associated with a command, called the @dfn{mode
-command}, which turns it on or off. The name of this command consists
-of the name of the minor mode, followed by @samp{-mode}; for instance,
-the mode command for Auto Fill mode is @code{auto-fill-mode}. Calling
-the minor mode command with no prefix argument @dfn{toggles} the mode,
-turning it on if it was off, and off if it was on. A positive
-argument always turns the mode on, and a zero or negative argument
-always turns it off. Mode commands are usually invoked with
-@kbd{M-x}, but you can bind keys to them if you wish (@pxref{Key
-Bindings}).
-
- Most minor modes also have a @dfn{mode variable}, with the same name
-as the mode command. Its value is non-@code{nil} if the mode is
-enabled, and @code{nil} if it is disabled. In some minor modes---but
-not all---the value of the variable alone determines whether the mode
-is active: the mode command works simply by setting the variable, and
-changing the value of the variable has the same effect as calling the
-mode command. Because not all minor modes work this way, we recommend
-that you avoid changing the mode variables directly; use the mode
-commands instead.
-
- Some minor modes are @dfn{buffer-local}: they apply only to the
-current buffer, so you can enable the mode in certain buffers and not
-others. Other minor modes are @dfn{global}: while enabled, they
-affect everything you do in the Emacs session, in all buffers. Some
-global minor modes are enabled by default.
-
- The following is a list of some buffer-local minor modes:
-
-@itemize @bullet
-@item
-Abbrev mode automatically expands text based on pre-defined
-abbreviation definitions. @xref{Abbrevs}.
-
-@item
-Auto Fill mode inserts newlines as you type to prevent lines from
-becoming too long. @xref{Filling}.
-
-@item
-Auto Save mode saves the buffer contents periodically to reduce the
-amount of work you can lose in case of a crash. @xref{Auto Save}.
-
-@item
-Enriched mode enables editing and saving of formatted text.
-@xref{Formatted Text}.
-
-@item
-Flyspell mode automatically highlights misspelled words.
-@xref{Spelling}.
-
-@item
-Font-Lock mode automatically highlights certain textual units found in
-programs. It is enabled globally by default, but you can disable it
-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}.
-
-@item
-Outline minor mode provides similar facilities to the major mode
-called Outline mode. @xref{Outline Mode}.
-
-@cindex Overwrite mode
-@cindex mode, Overwrite
-@findex overwrite-mode
-@kindex INSERT
-@item
-Overwrite mode causes ordinary printing characters to replace existing
-text instead of shoving it to the right. For example, if point is in
-front of the @samp{B} in @samp{FOOBAR}, then in Overwrite mode typing
-a @kbd{G} changes it to @samp{FOOGAR}, instead of producing
-@samp{FOOGBAR} as usual. In Overwrite mode, the command @kbd{C-q}
-inserts the next character whatever it may be, even if it is a
-digit---this gives you a way to insert a character instead of
-replacing an existing character. The mode command,
-@code{overwrite-mode}, is bound to the @key{Insert} key.
-
-@findex binary-overwrite-mode
-@item
-Binary Overwrite mode is a variant of Overwrite mode for editing
-binary files; it treats newlines and tabs like other characters, so
-that they overwrite other characters and can be overwritten by them.
-In Binary Overwrite mode, digits after @kbd{C-q} specify an octal
-character code, as usual.
-
-@item
-Visual Line mode performs ``word wrapping'', causing long lines to be
-wrapped at word boundaries. @xref{Visual Line Mode}.
-@end itemize
-
- Here are some useful global minor modes. Since Line Number mode and
-Transient Mark mode can be enabled or disabled just by setting the
-value of the minor mode variable, you @emph{can} set them differently
-for particular buffers, by explicitly making the corresponding
-variable local in those buffers. @xref{Locals}.
-
-@itemize @bullet
-@item
-Column Number mode enables display of the current column number in the
-mode line. @xref{Mode Line}.
-
-@item
-Delete Selection mode causes text insertion to first delete the text
-in the region, if the region is active. @xref{Using Region}.
-
-@item
-Icomplete mode displays an indication of available completions when
-you are in the minibuffer and completion is active. @xref{Completion
-Options}.
-
-@item
-Line Number mode enables display of the current line number in the
-mode line. It is enabled by default. @xref{Mode Line}.
-
-@item
-Menu Bar mode gives each frame a menu bar. It is enabled by default.
-@xref{Menu Bars}.
-
-@item
-Scroll Bar mode gives each window a scroll bar. It is enabled by
-default, but the scroll bar is only displayed on graphical terminals.
-@xref{Scroll Bars}.
-
-@item
-Tool Bar mode gives each frame a tool bar. It is enabled by default,
-but the tool bar is only displayed on graphical terminals. @xref{Tool
-Bars}.
-
-@item
-Transient Mark mode highlights the region, and makes many Emacs
-commands operate on the region when the mark is active. It is enabled
-by default. @xref{Mark}.
-@end itemize
-
@node Easy Customization
@section Easy Customization Interface
@@ -526,7 +373,8 @@ files for different Emacs versions, like this:
(cond ((< emacs-major-version 22)
;; @r{Emacs 21 customization.}
(setq custom-file "~/.custom-21.el"))
- ((and (= emacs-major-version 22) (< emacs-minor-version 3))
+ ((and (= emacs-major-version 22)
+ (< emacs-minor-version 3))
;; @r{Emacs 22 customization, before version 22.3.}
(setq custom-file "~/.custom-22.el"))
(t
@@ -582,15 +430,15 @@ 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.
- For the colors, you can specify a color name (use @kbd{M-x
-list-colors-display} for a list of them) or a hexadecimal color
-specification of the form @samp{#@var{rr}@var{gg}@var{bb}}.
-(@samp{#000000} is black, @samp{#ff0000} is red, @samp{#00ff00} is
-green, @samp{#0000ff} is blue, and @samp{#ffffff} is white.) On a
-black-and-white display, the colors you can use for the background are
-@samp{black}, @samp{white}, @samp{gray}, @samp{gray1}, and
-@samp{gray3}. Emacs supports these shades of gray by using background
-stipple patterns instead of a color.
+ You can specify a color name (use @kbd{M-x list-colors-display} for
+a list of them) or a hexadecimal color specification of the form
+@samp{#@var{rr}@var{gg}@var{bb}}. (@samp{#000000} is black,
+@samp{#ff0000} is red, @samp{#00ff00} is green, @samp{#0000ff} is
+blue, and @samp{#ffffff} is white.) On a black-and-white display, the
+colors you can use for the background are @samp{black}, @samp{white},
+@samp{gray}, @samp{gray1}, and @samp{gray3}. Emacs supports these
+shades of gray by using background stipple patterns instead of a
+color.
Setting, saving and resetting a face work like the same operations for
variables (@pxref{Changing a Variable}).
@@ -887,53 +735,48 @@ your initialization file to set it those sessions (@pxref{Init File}).
hook is a Lisp variable which holds a list of functions, to be called
on some well-defined occasion. (This is called @dfn{running the
hook}.) The individual functions in the list are called the @dfn{hook
-functions} of the hook. With rare exceptions, hooks in Emacs are
-empty when Emacs starts up, so the only hook functions in any given
-hook are the ones you explicitly put there as customization.
-
- Most major modes run one or more @dfn{mode hooks} as the last step
-of initialization. This makes it easy for you to customize the
-behavior of the mode, by setting up a hook function to override the
-local variable assignments already made by the mode. But hooks are
-also used in other contexts. For example, the hook
-@code{kill-emacs-hook} runs just before quitting the Emacs job
-(@pxref{Exiting}).
+functions} of the hook. For example, the hook @code{kill-emacs-hook}
+runs just before exiting Emacs (@pxref{Exiting}).
@cindex normal hook
- Most Emacs hooks are @dfn{normal hooks}. This means that running the
-hook operates by calling all the hook functions, unconditionally, with
-no arguments. We have made an effort to keep most hooks normal so that
-you can use them in a uniform way. Every variable in Emacs whose name
-ends in @samp{-hook} is a normal hook.
+ Most hooks are @dfn{normal hooks}. This means that when Emacs runs
+the hook, it calls each hook function in turn, with no arguments. We
+have made an effort to keep most hooks normal, so that you can use
+them in a uniform way. Every variable whose name ends in @samp{-hook}
+is a normal hook.
@cindex abnormal hook
- There are also a few @dfn{abnormal hooks}. These variables' names end
-in @samp{-hooks} or @samp{-functions}, instead of @samp{-hook}. What
-makes these hooks abnormal is that there is something peculiar about the
-way its functions are called---perhaps they are given arguments, or
-perhaps the values they return are used in some way. For example,
-@code{find-file-not-found-functions} (@pxref{Visiting}) is abnormal because
-as soon as one hook function returns a non-@code{nil} value, the rest
-are not called at all. The documentation of each abnormal hook variable
-explains in detail what is peculiar about it.
+ A few hooks are @dfn{abnormal hooks}. Their names end in
+@samp{-hooks} or @samp{-functions}, instead of @samp{-hook}. 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,
+@code{find-file-not-found-functions} is abnormal because as soon as
+one hook function returns a non-@code{nil} value, the rest are not
+called at all (@pxref{Visiting}). The documentation of each abnormal
+hook variable explains how its functions are used.
@findex add-hook
You can set a hook variable with @code{setq} like any other Lisp
-variable, but the recommended way to add a hook function to a hook
-(either normal or abnormal) is by calling @code{add-hook}.
-@xref{Hooks,,, elisp, The Emacs Lisp Reference Manual}.
+variable, but the recommended way to add a function to a hook (either
+normal or abnormal) is to use @code{add-hook}, as shown by the
+following examples. @xref{Hooks,,, elisp, The Emacs Lisp Reference
+Manual}, for details.
- 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:
+ 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:
@example
(add-hook 'text-mode-hook 'turn-on-auto-fill)
@end example
- The next example shows how to use a hook to customize the indentation
-of C code. (People often have strong personal preferences for one
-format compared to another.) Here the hook function is an anonymous
-lambda expression.
+ 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}).
@example
@group
@@ -943,24 +786,32 @@ lambda expression.
@group
(c-cleanup-list . (scope-operator
empty-defun-braces
- defun-close-semi))
-@end group
-@group
- (c-offsets-alist . ((arglist-close . c-lineup-arglist)
- (substatement-open . 0)))))
+ defun-close-semi))))
@end group
@group
(add-hook 'c-mode-common-hook
- '(lambda ()
- (c-add-style "my-style" my-c-style t)))
+ (lambda () (c-add-style "my-style" my-c-style t)))
@end group
@end example
+@cindex Prog mode
+@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
+@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
+any programming language mode, add it to @code{prog-mode-hook}; Prog
+mode is a major mode that does little else than to let other major
+modes inherit from it, exactly for this purpose.
+
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: the most
-recently added hook functions are executed first.
+asking for trouble. However, the order is predictable: the hook
+functions are executed in the order they appear in the hook.
@findex remove-hook
If you play with adding various different versions of a hook
@@ -969,6 +820,12 @@ the versions you added will remain in the hook variable together. You
can clear out individual functions by calling @code{remove-hook}, or
do @code{(setq @var{hook-variable} nil)} to remove everything.
+@cindex buffer-local hooks
+ If the hook variable is buffer-local, the buffer-local variable will
+be used instead of the global variable. However, if the buffer-local
+variable contains the element @code{t}, the global hook variable will
+be run as well.
+
@node Locals
@subsection Local Variables
@@ -1129,7 +986,10 @@ the file is divided into pages.
If a file has both a local variables list and a @samp{-*-} line,
Emacs processes @emph{everything} in the @samp{-*-} line first, and
-@emph{everything} in the local variables list afterward.
+@emph{everything} in the local variables list afterward. The exception
+to this is a major mode specification. Emacs applies this first,
+wherever it appears, since most major modes kill all local variables as
+part of their initialization.
A local variables list starts with a line containing the string
@samp{Local Variables:}, and ends with a line containing the string
@@ -1204,16 +1064,11 @@ value is @code{t}. @xref{Enabling Multibyte}.
These four ``variables'' are not really variables; setting them in any
other context has no special meaning.
- @emph{If @code{mode} is used to set a major mode, it should be the
-first ``variable'' in the list.} Otherwise, the entries that precede
-it will usually have no effect, since most major modes kill all local
-variables as part of their initialization.
-
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)}.
+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
@@ -1334,7 +1189,8 @@ corresponding alist applies to all the files in that subdirectory.
(java-mode . ((c-file-style . "BSD")
(subdirs . nil)))
("src/imported"
- . ((nil . ((change-log-default-name . "ChangeLog.local"))))))
+ . ((nil . ((change-log-default-name .
+ "ChangeLog.local"))))))
@end example
@noindent
@@ -1563,7 +1419,7 @@ just like @key{RET}.
@code{minibuffer-local-must-match-map} is for strict completion and
for cautious completion.
@item
-Finally, @code{minibuffer-local-filename-completion-map} and
+@code{minibuffer-local-filename-completion-map} and
@code{minibuffer-local-must-match-filename-map} are like the two
previous ones, but they are specifically for file name completion.
They do not bind @key{SPC}.
@@ -1694,7 +1550,6 @@ and mouse events:
(global-set-key (kbd "C-<f5>") 'linum-mode)
(global-set-key (kbd "C-<right>") 'forward-sentence)
(global-set-key (kbd "<mouse-2>") 'mouse-save-then-kill)
-(global-set-key (kbd "C-<down-mouse-3>") 'mouse-yank-at-click)
@end example
Instead of using the @code{kbd} macro, you can use a Lisp string or
@@ -1758,8 +1613,10 @@ 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)))
+ (define-key texinfo-mode-map "\C-cp"
+ 'backward-paragraph)
+ (define-key texinfo-mode-map "\C-cn"
+ 'forward-paragraph)))
@end example
@node Modifier Keys
@@ -2081,36 +1938,6 @@ invoke it; disabling also applies if the command is invoked using
@kbd{M-x}. However, disabling a command has no effect on calling it
as a function from Lisp programs.
-@node Syntax
-@section The Syntax Table
-@cindex syntax table
-
- All the Emacs commands which parse words or balance parentheses are
-controlled by the @dfn{syntax table}. The syntax table says which
-characters are opening delimiters, which are parts of words, which are
-string quotes, and so on. It does this by assigning each character to
-one of fifteen-odd @dfn{syntax classes}. In some cases it specifies
-some additional information also.
-
- Each major mode has its own syntax table (though related major modes
-sometimes share one syntax table), which it installs in each buffer
-that uses the mode. The syntax table installed in the current buffer
-is the one that all commands use, so we call it ``the'' syntax table.
-
-@kindex C-h s
-@findex describe-syntax
- To display a description of the contents of the current syntax
-table, type @kbd{C-h s} (@code{describe-syntax}). The description of
-each character includes the string you would have to give to
-@code{modify-syntax-entry} to set up that character's current syntax,
-starting with the character which designates its syntax class, plus
-some English text to explain its meaning.
-
- A syntax table is actually a Lisp object, a char-table, whose
-elements are cons cells. For full information on the syntax table,
-see @ref{Syntax Tables,, Syntax Tables, elisp, The Emacs Lisp
-Reference Manual}.
-
@node Init File
@section The Init File, @file{~/.emacs}
@cindex init file
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 2f274d7a324..501c4152e6a 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -81,6 +81,13 @@ specified, the @code{ls} switches can include short options (that is,
single characters) requiring no arguments, and long options (starting
with @samp{--}) whose arguments are specified with @samp{=}.
+@vindex dired-use-ls-dired
+ Note that Dired automatically adds the option @samp{--dired}, if
+your @code{ls} program supports it, unless you explicitly set
+the variable @code{dired-use-ls-dired} to @code{nil}. Without this
+option, Dired will have trouble parsing some @samp{unusual} file-names.
+See the documentation of @code{dired-use-ls-dired} for more details.
+
On MS-Windows and MS-DOS systems, Emacs @emph{emulates} @code{ls};
see @ref{ls in Lisp}, for options and peculiarities of that emulation.
@@ -984,8 +991,9 @@ to the parent directory in the same Dired buffer.
Use the @kbd{l} command (@code{dired-do-redisplay}) to update the
subdirectory's contents. Use @kbd{C-u k} on the subdirectory header
-line to delete the subdirectory (@pxref{Dired Updating}). You can also
-hide and show inserted subdirectories (@pxref{Hiding Subdirectories}).
+line to remove the subdirectory listing (@pxref{Dired Updating}). You
+can also hide and show inserted subdirectories (@pxref{Hiding
+Subdirectories}).
@ifnottex
@include dired-xtra.texi
@@ -1145,9 +1153,9 @@ current file as a last resort.
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 deletes that subdirectory from the buffer
-as well. Typing @kbd{C-u k} on the header line for a subdirectory
-also deletes the subdirectory from the Dired buffer.
+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.
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
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 7777aacf0e5..bfbfb355c9c 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -61,11 +61,11 @@ order; also, maybe redisplay the screen (@code{recenter-top-bottom}).
@item C-v
@itemx @key{next}
@itemx @key{PageDown}
-Scroll forward by nearly a full window (@code{scroll-up}).
+Scroll forward by nearly a full window (@code{scroll-up-command}).
@item M-v
@itemx @key{prior}
@itemx @key{PageUp}
-Scroll backward (@code{scroll-down}).
+Scroll backward (@code{scroll-down-command}).
@item C-M-l
Scroll heuristically to bring useful information onto the screen
(@code{reposition-window}).
@@ -662,17 +662,17 @@ that follows an open-parenthesis or open-brace in the leftmost column
that is inside a string or comment.
@cindex slow display during scrolling
- The variable @code{font-lock-beginning-of-syntax-function} (always
-buffer-local) specifies how Font Lock mode can find a position
-guaranteed to be outside any comment or string. In modes which use the
-leftmost column parenthesis convention, the default value of the variable
-is @code{beginning-of-defun}---that tells Font Lock mode to use the
-convention. If you set this variable to @code{nil}, Font Lock no longer
-relies on the convention. This avoids incorrect results, but the price
-is that, in some cases, fontification for a changed text must rescan
-buffer text from the beginning of the buffer. This can considerably
-slow down redisplay while scrolling, particularly if you are close to
-the end of a large buffer.
+ The variable @code{font-lock-beginning-of-syntax-function}, which is
+always buffer-local, specifies how Font Lock mode can find a position
+guaranteed to be outside any comment or string. In modes which use
+the leftmost column parenthesis convention, the default value of the
+variable is @code{beginning-of-defun}---that tells Font Lock mode to
+use the convention. If you set this variable to @code{nil}, Font Lock
+no longer relies on the convention. This avoids incorrect results,
+but the price is that, in some cases, fontification for a changed text
+must rescan buffer text from the beginning of the buffer. This can
+considerably slow down redisplay while scrolling, particularly if you
+are close to the end of a large buffer.
@findex font-lock-add-keywords
Font Lock highlighting patterns already exist for many modes, but you
@@ -685,7 +685,8 @@ comments, use this:
(add-hook 'c-mode-hook
(lambda ()
(font-lock-add-keywords nil
- '(("\\<\\(FIXME\\):" 1 font-lock-warning-face t)))))
+ '(("\\<\\(FIXME\\):" 1
+ font-lock-warning-face t)))))
@end example
@findex font-lock-remove-keywords
@@ -892,9 +893,9 @@ the location of point is enough to show you that the spaces are
present.
@findex delete-trailing-whitespace
- To delete all trailing whitespace within the buffer's accessible
-portion (@pxref{Narrowing}), type @kbd{M-x delete-trailing-whitespace
-@key{RET}}. This command does not remove newline characters.
+ Type @kbd{M-x delete-trailing-whitespace @key{RET}} to delete all
+trailing whitespace within the buffer's accessible portion
+(@pxref{Narrowing}). This command does not remove newline characters.
@vindex indicate-empty-lines
@cindex unused lines
@@ -1210,6 +1211,10 @@ terminal itself blinks the cursor, and Emacs has no control over it.)
You can control how the cursor appears when it blinks off by setting
the variable @code{blink-cursor-alist}.
+@vindex cursor-type
+ You can change the shape of the cursor from the default ``box'' look
+to a bar by altering the @code{cursor-type} variable.
+
@vindex visible-cursor
Some text terminals offer two different cursors: the normal cursor
and the very visible cursor, where the latter may be e.g. bigger or
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 7ca6204a994..e8fb42db0bb 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -39,7 +39,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 set smallbook
+@c @smallbook
@ifset smallbook
@smallbook
@@ -164,19 +164,18 @@ Fundamental Editing Commands
* Help:: Commands for asking Emacs about its commands.
Important Text-Changing Commands
-* Mark:: The mark: how to delimit a ``region'' of text.
+* 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 the text inside a rectangle on the screen.
-* CUA Bindings:: Using @kbd{C-x}, @kbd{C-c}, @kbd{C-v} for copy
- and paste, with enhanced rectangle support.
+* Rectangles:: Operating on text in rectangular areas.
+* CUA Bindings:: Using @kbd{C-x}, @kbd{C-c}, @kbd{C-v} to kill and yank.
* 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.
* Fixit:: Commands especially useful for fixing typos.
-* Keyboard Macros:: A keyboard macro records a sequence of
- keystrokes to be replayed with a single command.
+* Keyboard Macros:: Recording a sequence of keystrokes to be replayed.
Major Structures of Emacs
* Files:: All about handling files.
@@ -186,13 +185,13 @@ Major Structures of Emacs
* International:: Using non-@acronym{ASCII} character sets.
Advanced Features
-* Major Modes:: Text mode vs. Lisp mode vs. C mode...
+* Modes:: Major and minor modes alter Emacs' basic behavior.
* Indentation:: Editing the white space at the beginnings of lines.
* Text:: Commands and modes for editing English.
* Programs:: Commands and modes for editing programs.
* Building:: Compiling, running and debugging programs.
* Maintaining:: Features for maintaining large programs.
-* Abbrevs:: How to define text abbreviations to reduce
+* Abbrevs:: Defining text abbreviations to reduce
the number of characters you must type.
@c AFAICS, the tex stuff generates its own index and does not use this one.
@ifnottex
@@ -201,12 +200,12 @@ Advanced Features
@end ifnottex
* Sending Mail:: Sending mail in Emacs.
* Rmail:: Reading mail in Emacs.
-* Dired:: You can ``edit'' a directory to manage files in it.
+* Dired:: You can "edit" a directory to manage files in it.
* Calendar/Diary:: The calendar and diary facilities.
* Document View:: Viewing PDF, PS and DVI files.
-* Gnus:: How to read netnews with Emacs.
+* Gnus:: A flexible mail and news reader.
* Shell:: Executing shell commands from Emacs.
-* Emacs Server:: Using Emacs as an editing server for @code{mail}, etc.
+* Emacs Server:: Using Emacs as an editing server.
* Printing:: Printing hardcopies of buffers or regions.
* Sorting:: Sorting lines, paragraphs or pages within Emacs.
* Narrowing:: Restricting display and editing to a portion
@@ -220,7 +219,6 @@ Advanced Features
"recursive editing level".
* Emulation:: Emulating some other editors with Emacs.
* Hyperlinking:: Following links in buffers.
-* Dissociated Press:: Dissociating text for fun.
* Amusements:: Various games and hacks.
* Customization:: Modifying the behavior of Emacs.
@@ -252,7 +250,7 @@ Appendices
--- The Detailed Node Listing ---
---------------------------------
-Here are some other nodes which are really inferiors of the ones
+Here are some other nodes which are really subnodes of the ones
already listed, mentioned here so you can get to them in one step:
The Organization of the Screen
@@ -331,15 +329,21 @@ Yanking
* Appending Kills:: Several kills in a row all yank together.
* Earlier Kills:: Yanking something killed some time ago.
+Killing and Yanking on Graphical Displays
+
+* Clipboard:: How Emacs interacts with the system clipboard.
+* Primary Selection:: The temporarily selected text selection.
+* Secondary Selection:: Cutting without altering point and mark.
+
Registers
-* RegPos:: Saving positions in registers.
-* RegText:: Saving text in registers.
-* RegRect:: Saving rectangles in registers.
-* RegConfig:: Saving window configurations in registers.
-* RegNumbers:: Numbers in registers.
-* RegFiles:: File names in registers.
-* Bookmarks:: Bookmarks are like registers, but persistent.
+* Position Registers:: Saving positions in registers.
+* Text Registers:: Saving text in registers.
+* Rectangle Registers:: Saving rectangles in registers.
+* Configuration Registers:: Saving window configurations in registers.
+* Number Registers:: Numbers in registers.
+* File Registers:: File names in registers.
+* Bookmarks:: Bookmarks are like registers, but persistent.
Controlling the Display
@@ -495,7 +499,8 @@ Multiple Windows
Frames and Graphical Displays
-* Cut and Paste:: Mouse commands for cut and paste.
+* Mouse Commands:: Moving, cutting, and pasting, with the mouse.
+* Word and Line Mouse:: Mouse commands for selecting whole words or lines.
* Mouse References:: Using the mouse to select an item from a list.
* Menu Mouse Clicks:: Mouse clicks that bring up menus.
* Mode Line Mouse:: Mouse clicks on the mode line.
@@ -517,14 +522,6 @@ Frames and Graphical Displays
* Non-Window Terminals:: Multiple frames on terminals that show only one.
* Text-Only Mouse:: Using the mouse in text-only terminals.
-Killing and Yanking on Graphical Displays
-
-* Mouse Commands:: Moving, cutting, and pasting, with the mouse.
-* Word and Line Mouse:: Mouse commands for selecting whole words or lines.
-* Cut/Paste Other App:: Transfering text between Emacs and other apps.
-* Secondary Selection:: Cutting without altering point and mark.
-* Clipboard:: Using the clipboard for selections.
-
International Character Set Support
* International Chars:: Basic concepts of multibyte characters.
@@ -551,9 +548,12 @@ International Character Set Support
to use without multibyte characters.
* Charsets:: How Emacs groups its internal character codes.
-Major Modes
+Modes
-* Choosing Modes:: How major modes are specified or chosen.
+* Major Modes:: Text mode vs. Lisp mode vs. C mode...
+* Minor Modes:: Each minor mode is a feature you can turn on
+ independently of any others.
+* Choosing Modes:: How modes are chosen when visiting files.
Indentation
@@ -585,8 +585,6 @@ Filling Text
* Fill Prefix:: Filling paragraphs that are indented
or in a comment, etc.
* Adaptive Fill:: How Emacs can determine the fill prefix automatically.
-* Refill:: Keeping paragraphs filled.
-* Longlines:: Editing text with very long lines.
Outline Mode
@@ -1062,16 +1060,12 @@ Hyperlinking and Navigation Features
Customization
-* Minor Modes:: Each minor mode is a feature you can turn on
- independently of any others.
* Easy Customization:: Convenient way to browse and change settings.
* Variables:: Many Emacs commands examine Emacs variables
to decide what to do; by setting variables,
you can control their functioning.
-* Key Bindings:: The keymaps say what command each key runs.
- By changing them, you can "redefine keys".
-* Syntax:: The syntax table controls how words and
- expressions are parsed.
+* Key Bindings:: 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.
@@ -1491,7 +1485,7 @@ Lisp programming.
@include windows.texi
@include frames.texi
@include mule.texi
-@include major.texi
+@include modes.texi
@include indent.texi
@include text.texi
@c Includes fortran-xtra.
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 40bd065610c..793a11e62ed 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -209,7 +209,8 @@ to reread it.
about 10 megabytes), Emacs asks you for confirmation first. You can
answer @kbd{y} to proceed with visiting the file. Note, however, that
Emacs cannot visit files that are larger than the maximum Emacs buffer
-size, which is around 512 megabytes on 32-bit machines
+size, which is limited by the amount of memory Emacs can allocate
+and by the integers that Emacs can represent
(@pxref{Buffers}). If you try, Emacs will display an error message
saying that the maximum buffer size has been exceeded.
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 72100f8cafb..c14041f2271 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -347,8 +347,7 @@ Quit interactive spell checking and move point back to where it was
when you started spell checking.
@item q
-Quit interactive spell checking and kill the Aspell/Ispell/Hunspell
-subprocess.
+Quit interactive spell checking and kill the spell-checker subprocess.
@item ?
Show the list of options.
@@ -401,17 +400,16 @@ is a spell checking dictionary but no word completion dictionary.
@cindex Flyspell mode
@findex flyspell-mode
+@findex turn-on-flyspell
Flyspell mode is a fully-automatic way to check spelling as you edit
in Emacs. It operates by checking words as you change or insert them.
When it finds a word that it does not recognize, it highlights that
word. This does not interfere with your editing, but when you see the
highlighted word, you can move to it and fix it. Type @kbd{M-x
flyspell-mode} to enable or disable this mode in the current buffer.
-@findex turn-on-flyspell
-To enable @code{flyspell-mode} in all text mode buffers, add
+To enable Flyspell mode in all text mode buffers, add
@code{turn-on-flyspell} to @code{text-mode-hook}.
-
When Flyspell mode highlights a word as misspelled, you can click on
it with @kbd{Mouse-2} to display a menu of possible corrections and
actions. You can also correct the word by editing it manually in any
@@ -422,4 +420,5 @@ way you like.
that it only checks words in comments and string constants. This
feature is useful for editing programs. Type @kbd{M-x
flyspell-prog-mode} to enable or disable this mode in the current
-buffer.
+buffer. To enable this mode in all programming mode buffers, add
+@code{flyspell-prog-mode} to @code{prog-mode-hook} (@pxref{Hooks}).
diff --git a/doc/emacs/fortran-xtra.texi b/doc/emacs/fortran-xtra.texi
index 8f92df3f3ae..ee417624120 100644
--- a/doc/emacs/fortran-xtra.texi
+++ b/doc/emacs/fortran-xtra.texi
@@ -10,18 +10,19 @@
@cindex mode, Fortran
@cindex Fortran fixed form and free form
-@cindex Fortran 77 and Fortran 90, 95, 2003
+@cindex Fortran 77 and Fortran 90, 95, 2003, 2008
@findex f90-mode
@findex fortran-mode
Fortran mode is meant for editing ``fixed form'' (and also ``tab
format'') source code (normally Fortran 77). For editing more modern
-``free form'' source code (Fortran 90, 95, 2003), use F90 mode
+``free form'' source code (Fortran 90, 95, 2003, 2008), use F90 mode
(@code{f90-mode}). Emacs normally uses Fortran mode for files with
extension @samp{.f}, @samp{.F} or @samp{.for}, and F90 mode for the
-extensions @samp{.f90} and @samp{.f95}. 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.
+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.
Fortran mode provides special motion commands for Fortran statements
and subprograms, and indentation commands that understand Fortran
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index b952ef15aff..b9b56670988 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -33,7 +33,8 @@ so that you can use many of the features described in this chapter.
@end ifnottex
@menu
-* Cut and Paste:: Mouse commands for cut and paste.
+* Mouse Commands:: Moving, cutting, and pasting, with the mouse.
+* Word and Line Mouse:: Mouse commands for selecting whole words or lines.
* Mouse References:: Using the mouse to select an item from a list.
* Menu Mouse Clicks:: Mouse clicks that bring up menus.
* Mode Line Mouse:: Mouse clicks on the mode line.
@@ -56,22 +57,8 @@ so that you can use many of the features described in this chapter.
* Text-Only Mouse:: Using the mouse in text-only terminals.
@end menu
-@node Cut and Paste
-@section Cutting and Pasting on Graphical Displays
-
- This section describes commands for selecting a region, cutting, and
-pasting using the mouse.
-
-@menu
-* Mouse Commands:: Moving, cutting, and pasting, with the mouse.
-* Word and Line Mouse:: Mouse commands for selecting whole words or lines.
-* Cut/Paste Other App:: Transfering text between Emacs and other apps.
-* Secondary Selection:: Cutting without altering point and mark.
-* Clipboard:: Using the clipboard for selections.
-@end menu
-
@node Mouse Commands
-@subsection Mouse Commands for Editing
+@section Mouse Commands for Editing
@cindex mouse buttons (what they do)
@kindex Mouse-1
@@ -132,16 +119,21 @@ entirely on the screen. The number of lines scrolled per step depends
on how far away from the window edge the mouse has gone; the variable
@code{mouse-scroll-min-lines} specifies a minimum step size.
+@findex mouse-yank-primary
@findex mouse-yank-at-click
-@vindex mouse-yank-at-point
Clicking with the middle mouse button, @kbd{Mouse-2}, moves point to
-the position where you clicked and performs a yank
-(@code{mouse-yank-at-click}). @xref{Yanking}. If you change the
-variable @code{mouse-yank-at-point} to a non-@code{nil} value,
-@kbd{Mouse-2} does not move point. Then it does not matter where you
-click, or even which of the frame's windows you click on; the yank
-occurs at the existing point. This variable also affects yanking the
-primary and secondary selections (@pxref{Cut/Paste Other App}).
+the position where you clicked and inserts the contents of the primary
+selection (@code{mouse-yank-primary}). @xref{Primary Selection}.
+This behavior is consistent with other X applications; alternatively,
+you can rebind @kbd{Mouse-2} to @code{mouse-yank-at-click}, which
+performs a yank at point.
+
+@vindex mouse-yank-at-point
+ If you change the variable @code{mouse-yank-at-point} to a
+non-@code{nil} value, @kbd{Mouse-2} does not move point; it inserts
+the text at point, regardless of where you clicked or even which of
+the frame's windows you clicked on. This variable affects both
+@code{mouse-yank-primary} and @code{mouse-yank-at-click}.
@findex mouse-save-then-kill
Clicking with the right mouse button, @kbd{Mouse-3}, runs the
@@ -195,7 +187,7 @@ make Emacs behave this way by enabling Delete Selection mode.
@xref{Using Region}.
@node Word and Line Mouse
-@subsection Mouse Commands for Words and Lines
+@section Mouse Commands for Words and Lines
These variants of @kbd{Mouse-1} select entire words or lines at a
time. Emacs activates the region around the selected text, which is
@@ -224,164 +216,6 @@ Select the line you click on.
Select the text you drag across, in the form of whole lines.
@end table
-@node Cut/Paste Other App
-@subsection Cut and Paste with Other Window Applications
-
-@cindex X cutting and pasting
-@cindex X selection
-@cindex primary selection
-@cindex selection, primary
- When running Emacs under the X window system, you can easily
-transfer text between Emacs and other X applications using the
-@dfn{primary selection} (also called the @dfn{X selection}). This is
-@emph{not} the same thing as the @dfn{clipboard}, which is a separate
-facility used on desktop environments such as Gnome, and on operating
-systems such as Microsoft Windows (@pxref{Clipboard}).
-
- Under X, whenever you select some text in Emacs by dragging or
-clicking the mouse (@pxref{Mouse Commands}), it is also saved in the
-primary selection. You can then @dfn{paste} that text into any other
-X application, usually by clicking @kbd{Mouse-2} in that application.
-Unlike the Emacs kill ring (@pxref{Kill Ring}), the primary selection
-has no ``memory'': each time you save something in the primary
-selection, either in Emacs or in another X application, the previous
-contents of the primary selection are lost.
-
-@cindex MS-Windows, and primary selection
- MS-Windows provides no primary selection, but Emacs emulates it
-within a single Emacs session, by storing the selected text
-internally. Therefore, all the features and commands related to the
-primary selection work on Windows as they do on X, for cutting and
-pasting within the same session, but not across Emacs sessions or with
-other applications.
-
- Whenever you kill some text using a command such as @kbd{C-w}
-(@code{kill-region}), or copy it into the kill ring using a command
-such as @kbd{M-w} (@code{kill-ring-save}), that text is also saved in
-the primary selection. @xref{Killing}.
-
-@vindex select-active-regions
- If you set the region using the keyboard---for instance, by typing
-@kbd{C-@key{SPC}} and moving point away from the mark---the text in
-the region is not normally saved to the primary selection. However,
-if you change the variable @code{select-active-regions} to @code{t},
-the region is saved to the primary selection whenever you activate the
-mark. Each change to the region also updates the primary selection.
-
-@vindex yank-pop-change-selection
- If you change @code{yank-pop-change-selection} to @code{t}, rotating
-the kill ring with @kbd{M-y} (@code{yank-pop}) also saves the new yank
-to the primary selection (@pxref{Yanking}).
-
-@vindex save-interprogram-paste-before-kill
- If you change @code{save-interprogram-paste-before-kill} to
-@code{t}, each kill command first saves the existing selection onto
-the kill ring. This prevents you from losing the existing selection,
-at the risk of large memory consumption if other applications generate
-large selections.
-
- You can yank the primary selection into Emacs using the usual yank
-commands, such as @kbd{C-y} (@code{yank}) and @kbd{Mouse-2}
-(@code{mouse-yank-at-click}). These commands actually check the
-primary selection before referring to the kill ring; if no primary
-selection is available, the kill ring contents are used. To prevent
-yank commands from accessing the primary selection, set the variable
-@code{x-select-enable-primary} to @code{nil}.
-
- The standard coding system for the primary selection is
-@code{compound-text-with-extensions}. You may find that the pasted
-text is not what you expected. In such a case, you can specify
-another coding system for the selection by typing @kbd{C-x @key{RET}
-x} or @kbd{C-x @key{RET} X}. Alternatively, you can request a
-different data type by modifying the variable
-@code{x-select-request-type}. @xref{Communication Coding}.
-
-@node Secondary Selection
-@subsection Secondary Selection
-@cindex secondary selection
-
- In addition to the primary selection, the X Window System provides a
-second similar facility known as the @dfn{secondary selection}.
-Nowadays, few X applications make use of the secondary selection, but
-you can access it using the following Emacs commands:
-
-@table @kbd
-@findex mouse-set-secondary
-@kindex M-Drag-Mouse-1
-@item M-Drag-Mouse-1
-Set the secondary selection, with one end at the place where you press
-down the button, and the other end at the place where you release it
-(@code{mouse-set-secondary}). The selected text is highlighted, using
-the @code{secondary-selection} face, as you drag. The window scrolls
-automatically if you drag the mouse off the top or bottom of the
-window, just like @code{mouse-set-region} (@pxref{Mouse Commands}).
-
-This command does not alter the kill ring.
-
-@findex mouse-start-secondary
-@kindex M-Mouse-1
-@item M-Mouse-1
-Set one endpoint for the @dfn{secondary selection}
-(@code{mouse-start-secondary}).
-
-@findex mouse-secondary-save-then-kill
-@kindex M-Mouse-3
-@item M-Mouse-3
-Set the secondary selection, with one end at the position clicked and
-the other at the position specified with @kbd{M-Mouse-1}
-(@code{mouse-secondary-save-then-kill}). This also puts the selected
-text in the kill ring. A second @kbd{M-Mouse-3} at the same place
-kills the secondary selection just made.
-
-@findex mouse-yank-secondary
-@kindex M-Mouse-2
-@item M-Mouse-2
-Insert the secondary selection where you click, placing point at the
-end of the yanked text (@code{mouse-yank-secondary}).
-@end table
-
-Double or triple clicking of @kbd{M-Mouse-1} operates on words and
-lines, much like @kbd{Mouse-1}.
-
-If @code{mouse-yank-at-point} is non-@code{nil}, @kbd{M-Mouse-2} yanks
-at point. Then it does not matter precisely where you click, or even
-which of the frame's windows you click on. @xref{Mouse Commands}.
-
-@node Clipboard
-@subsection Using the Clipboard
-@cindex clipboard
-
- In desktop environments such as Gnome, and operating systems such as
-Microsoft Windows and Mac OS X, you can transfer data (usually text)
-between different applications using the @dfn{clipboard}. The
-clipboard is distinct from the primary selection and secondary
-selection discussed earlier. You can access the clipboard through the
-@samp{Edit} menu of the menu bar (@pxref{Menu Bar}).
-
-@cindex cut
-@findex clipboard-kill-region
- The command @code{clipboard-kill-region}, which is bound to the
-@code{Cut} menu item, kills the region and saves it in the clipboard.
-
-@cindex copy
-@findex clipboard-kill-ring-save
- The command @code{clipboard-kill-ring-save}, which is bound to the
-@code{Copy} menu item, copies the region to the kill ring and saves it
-in the clipboard.
-
-@findex clipboard-yank
-@cindex paste
- The @code{Paste} menu item in the Edit menu yanks the contents of
-the clipboard at point (@code{clipboard-yank}).
-
-@vindex x-select-enable-clipboard
- You can customize the variable @code{x-select-enable-clipboard} to
-make the Emacs yank functions consult the clipboard before the primary
-selection, and to make the kill functions to store in the clipboard as
-well as the primary selection. Otherwise, these commands do not
-access the clipboard at all. Using the clipboard is the default on
-MS-Windows and Mac OS, but not on other systems.
-
@node Mouse References
@section Following References with the Mouse
@kindex Mouse-1 @r{(selection)}
@@ -576,7 +410,8 @@ the default foreground color and font:
@example
(add-to-list 'default-frame-alist '(font . "10x20"))
-(add-to-list 'default-frame-alist '(foreground-color . "blue"))
+(add-to-list 'default-frame-alist
+ '(foreground-color . "blue"))
@end example
@noindent
@@ -625,15 +460,15 @@ this case, @kbd{C-x 5 0} can delete the last interactive frame; you
can use @command{emacsclient} to reconnect to the Emacs session.
@vindex focus-follows-mouse
- On X, you may have to tell Emacs how the system (or the window
-manager) handles focus-switching between windows, in order for the
-command @kbd{C-x 5 o} (@code{other-frame}) to work properly.
-Unfortunately, there is no way for Emacs to detect this automatically,
-so you should set the variable @code{focus-follows-mouse}. If simply
-moving the mouse onto a window selects it and gives it focus, the
-variable should be @code{t}; if you have to click on the window to
-select it, the variable should be @code{nil}. The default is
-@code{t}.
+ On X, you may have to tell Emacs how the window manager handles
+focus-switching between windows, in order for @kbd{C-x 5 o}
+(@code{other-frame}) to work properly. Unfortunately, there is no way
+for Emacs to detect this automatically, so you should set the variable
+@code{focus-follows-mouse}. The default is @code{nil}, meaning you
+have to click on the window to select it (the default for most modern
+window managers). You should change it to @code{t} if your window
+manager selects and window and gives it focus anytime you move the
+mouse onto the window.
The window manager that is part of MS-Windows always gives focus to
a frame that raises, so this variable has no effect in the native
@@ -688,6 +523,11 @@ Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font
X}.
@end itemize
+To check what font you're currently using, the @kbd{C-u C-x =}
+command can be helpful. It'll describe the character under point, and
+also say what font it's rendered in, if the window system you're
+running under supports that.
+
@cindex fontconfig
On X, there are four different ways to express a ``font name''. The
first is to use a @dfn{Fontconfig pattern}. Fontconfig patterns have
@@ -743,12 +583,9 @@ DejaVu Sans Mono:bold:italic
Monospace-12:weight=bold:slant=italic
@end smallexample
-See the Fontconfig manual for a more detailed description of
-Fontconfig patterns. This manual is located in the file
-@file{fontconfig-user.html}, distributed with Fontconfig. It is also
-available online at @url{http://fontconfig.org/fontconfig-user.html}.
-In particular, that manual describes additional font properties that
-influence how the font is hinted, antialiased, or scaled.
+For a more detailed description of Fontconfig patterns, see the
+Fontconfig manual, which is distributed with Fontconfig and available
+online at @url{http://fontconfig.org/fontconfig-user.html}.
The second way to specify a font is to use a @dfn{GTK font
description}. These have the syntax
@@ -821,9 +658,9 @@ The font slant---normally @samp{r} (roman), @samp{i} (italic),
@samp{o} (oblique), @samp{ri} (reverse italic), or @samp{ot} (other).
Some font names support other values.
@item widthtype
-The font width---normally @samp{condensed}, @samp{extended},
-@samp{semicondensed} or @samp{normal} (some font names support other
-values).
+The font width---normally @samp{normal}, @samp{condensed},
+@samp{extended}, or @samp{semicondensed} (some font names support
+other values).
@item style
An optional additional style name. Usually it is empty---most long
font names have two hyphens in a row at this point.
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 3cf1cc522bf..e37e80bfab8 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -962,7 +962,7 @@ special Emacs commands for moving over and operating on paragraphs.
@item Parsing
We say that certain Emacs commands parse words or expressions in the
text being edited. Really, all they know how to do is find the other
-end of a word or expression. @xref{Syntax}.
+end of a word or expression.
@item Point
Point is the place in the buffer at which insertion and deletion
@@ -1212,7 +1212,8 @@ See `font lock.'
@item Syntax Table
The syntax table tells Emacs which characters are part of a word,
which characters balance each other like parentheses, etc.
-@xref{Syntax}.
+@xref{Syntax Tables,, Syntax Tables, elisp, The Emacs Lisp Reference
+Manual}.
@item Super
Super is the name of a modifier bit that a keyboard input character may
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 8c0d768939b..76a9f2413b1 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -139,8 +139,11 @@ command.
@item C-h r
Display the Emacs manual in Info (@code{info-emacs-manual}).
@item C-h s
-Display the current contents of the syntax table, with an explanation of
-what they mean (@code{describe-syntax}). @xref{Syntax}.
+Display the current contents of the @dfn{syntax table}, with an
+explanation of what they mean (@code{describe-syntax}). The syntax
+table says which characters are opening delimiters, which are parts of
+words, which are string quotes, and so on. @xref{Syntax Tables,,
+Syntax Tables, elisp, The Emacs Lisp Reference Manual}, for details.
@item C-h t
Enter the Emacs interactive tutorial (@code{help-with-tutorial}).
@item C-h v @var{var} @key{RET}
@@ -583,7 +586,8 @@ bindings now in effect: first the local bindings of the current minor
modes, then the local bindings defined by the current major mode, and
finally the global bindings (@pxref{Key Bindings}). @kbd{C-h s}
displays the contents of the syntax table, with explanations of each
-character's syntax (@pxref{Syntax}).
+character's syntax (@pxref{Syntax Tables,, Syntax Tables, elisp, The
+Emacs Lisp Reference Manual}).
You can get a list of subcommands for a particular prefix key by
typing @kbd{C-h} after the prefix key. (There are a few prefix keys
@@ -629,7 +633,10 @@ C-@var{char}}; that is, @kbd{C-h} followed by a control character.
Display the Emacs copying conditions (@code{describe-copying}).
These are the rules under which you can copy and redistribute Emacs.
@item C-h C-d
-Display how to debug Emacs problems (@code{view-emacs-debugging}).
+Display help for debugging Emacs (@code{view-emacs-debugging}).
+@item C-h C-e
+Display external packages and information about Emacs
+(@code{view-external-packages}).
@item C-h C-f
Display the Emacs frequently-answered-questions list (@code{view-emacs-FAQ}).
@item C-h g
diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi
index c4ef4781aaf..e13b2808f09 100644
--- a/doc/emacs/indent.texi
+++ b/doc/emacs/indent.texi
@@ -2,7 +2,7 @@
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Indentation, Text, Major Modes, Top
+@node Indentation, Text, Modes, Top
@chapter Indentation
@cindex indentation
@cindex tabs
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 41262e9c2d8..06839ce5187 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -6,20 +6,24 @@
@node Killing, Registers, Mark, Top
@chapter Killing and Moving Text
- @dfn{Killing} means erasing text and copying it into the @dfn{kill
-ring}, from which you can bring it back into the buffer by
-@dfn{yanking} it. (Some applications use the terms ``cutting'' and
-``pasting'' for similar operations.) This is the most common way of
-moving or copying text within Emacs. It is very versatile, because
-there are commands for killing many different types of syntactic
-units.
+ In Emacs, @dfn{killing} means erasing text and copying it into the
+@dfn{kill ring}. @dfn{Yanking} means bringing text from the kill ring
+back into the buffer. (Some applications use the terms ``cutting''
+and ``pasting'' for similar operations.) The kill ring is so-named
+because it can be visualized as a set of blocks of text arranged in a
+ring, which you can access in cyclic order. @xref{Kill Ring}.
+
+ Killing and yanking are the most common way to move or copy text
+within Emacs. It is very versatile, because there are commands for
+killing many different types of syntactic units.
@menu
* 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 C-x/C-c/C-v to kill and yank.
+* CUA Bindings:: Using @kbd{C-x}/@kbd{C-c}/@kbd{C-v} to kill and yank.
@end menu
@node Deletion and Killing
@@ -29,25 +33,28 @@ units.
@cindex cutting text
@cindex deletion
Most commands which erase text from the buffer save it in the kill
-ring. These are known as @dfn{kill} commands. The kill ring stores
-several recent kills, not just the last one, so killing is a very safe
-operation: when you make a new kill, you don't have to worry much
-about losing text that you previously killed.
+ring. These are known as @dfn{kill} commands, and their names
+normally contain the word @samp{kill} (e.g. @code{kill-line}). The
+kill ring stores several recent kills, not just the last one, so
+killing is a very safe operation: you don't have to worry much about
+losing text that you previously killed. The kill ring is shared by
+all buffers, so text that is killed in one buffer can be yanked into
+another buffer.
+
+ When you use @kbd{C-/} (@code{undo}) to undo a kill command
+(@pxref{Undo}), that brings the killed text back into the buffer, but
+does not remove it from the kill ring.
- You can yank text from the kill ring into any position in a buffer,
-including a position in a different buffer; the kill ring is shared by
-all buffers. The @kbd{C-/} (@code{undo}) command can undo both kill
-and delete commands (@pxref{Undo}); the importance of the kill ring is
-that you can yank the text in a different place.
+ On graphical displays, killing text also copies it to the system
+clipboard. @xref{Cut and Paste}.
Commands that erase text but do not save it in the kill ring are
-known as @dfn{delete} commands. These include @kbd{C-d}
-(@code{delete-char}) and @key{DEL} (@code{delete-backward-char}),
-which delete only one character at a time, and those commands that
-delete only spaces or newlines. Commands that can erase significant
-amounts of nontrivial data generally do a kill operation instead. The
-commands' names and individual descriptions use the words @samp{kill}
-and @samp{delete} to say which kind of operation they perform.
+known as @dfn{delete} commands; their names usually contain the word
+@samp{delete}. These include @kbd{C-d} (@code{delete-char}) and
+@key{DEL} (@code{delete-backward-char}), which delete only one
+character at a time, and those commands that delete only spaces or
+newlines. Commands that can erase significant amounts of nontrivial
+data generally do a kill operation instead.
You can also use the mouse to kill and yank. @xref{Cut and Paste}.
@@ -127,21 +134,22 @@ Kill an entire line at once (@code{kill-whole-line})
@kindex C-k
@findex kill-line
- The simplest kill command is @kbd{C-k}. If given at the beginning
-of a line, it kills all the text on the line@footnote{Here, ``line''
-means a logical text line, not a screen line. @xref{Continuation
-Lines}.}, leaving it blank. When used on a blank line, it kills the
-whole line including its newline.
-
- More precisely, @kbd{C-k} kills from point up to the end of the
-line, unless it is at the end of a line. In that case it kills the
-newline following point, thus merging the next line into the current
-one. Spaces and tabs at the end of the line are ignored when deciding
-which case applies, so as long as point is after the last visible
+ The simplest kill command is @kbd{C-k} (@code{kill-line}). If used
+at the end of a line, it kills the line-ending newline character,
+merging the next line into the current one (thus, a blank line is
+entirely removed). Otherwise, @kbd{C-k} kills all the text from point
+up to the end of the line; if point was originally at the beginning of
+the line, this leaves the line blank.
+
+ Spaces and tabs at the end of the line are ignored when deciding
+which case applies. As long as point is after the last visible
character in the line, you can be sure that @kbd{C-k} will kill the
newline. To kill an entire non-blank line, go to the beginning and
type @kbd{C-k} twice.
+ In this context, ``line'' means a logical text line, not a screen
+line (@pxref{Continuation Lines}).
+
When @kbd{C-k} is given a positive argument @var{n}, it kills
@var{n} lines and the newlines that follow them (text on the current
line before point is not killed). With a negative argument
@@ -157,10 +165,10 @@ following newline. This variable is normally @code{nil}.
@kindex C-S-backspace
@findex kill-whole-line
- @kbd{C-S-backspace} (@code{kill-whole-line}) will kill a whole line
-including its newline regardless of the position of point within the
-line. Note that many character terminals will prevent you from typing
-the key sequence @kbd{C-S-backspace}.
+ @kbd{C-S-backspace} (@code{kill-whole-line}) kills a whole line
+including its newline, regardless of the position of point within the
+line. Note that many text terminals will prevent you from typing the
+key sequence @kbd{C-S-backspace}.
@node Other Kill Commands
@subsection Other Kill Commands
@@ -196,10 +204,8 @@ last set. The mark is deactivated at the end of the command.
@kindex M-w
@findex kill-ring-save
- The command @kbd{M-w} (@code{kill-ring-save}) copies the region into
-the kill ring without removing it from the buffer. This is
-approximately equivalent to @kbd{C-w} followed by @kbd{C-/}, except
-that @kbd{M-w} does not alter the undo history.
+ @kbd{M-w} (@code{kill-ring-save}) copies the region into the kill
+ring without removing it from the buffer.
Emacs also provides commands to kill specific syntactic units:
words, with @kbd{M-@key{DEL}} and @kbd{M-d} (@pxref{Words}); balanced
@@ -220,12 +226,10 @@ search backward and kill text before point.
@vindex kill-read-only-ok
@cindex read-only text, killing
Some specialized buffers contain @dfn{read-only text}, which cannot
-be modified and therefore cannot be killed. But some users like to
-use the kill commands to copy read-only text into the kill ring,
-without actually changing it. Therefore, the kill commands work
-specially in a read-only buffer: they move over text, and copy it to
+be modified and therefore cannot be killed. The kill commands work
+specially in a read-only buffer: they move over text and copy it to
the kill ring, without actually deleting it from the buffer.
-Normally, kill commands beep and display an error message when this
+Normally, they also beep and display an error message when this
happens. But if you set the variable @code{kill-read-only-ok} to a
non-@code{nil} value, they just print a message in the echo area to
explain why the text has not been erased.
@@ -257,10 +261,16 @@ Replace text just yanked with an earlier batch of killed text
Append next kill to last batch of killed text (@code{append-next-kill}).
@end table
- On graphical displays with window systems, if there is a current
-selection in some other application, and you selected it more recently
-than you killed any text in Emacs, @kbd{C-y} copies the selection
-instead of text killed within Emacs.
+@cindex yanking and text properties
+@vindex yank-excluded-properties
+ The yank commands discard certain properties from the yanked text.
+These are properties that might lead to annoying results, such as
+causing the text to respond to the mouse or specifying key bindings.
+The list of properties to discard is stored in the variable
+@code{yank-excluded-properties}. These properties are also discarded
+when yanking register contents and rectangles. @xref{Text
+Properties,,, elisp, the Emacs Lisp Reference Manual}, for more
+information about text properties.
@menu
* Kill Ring:: Where killed text is stored. Basic yanking.
@@ -271,38 +281,34 @@ instead of text killed within Emacs.
@node Kill Ring
@subsection The Kill Ring
- All killed text is recorded in the @dfn{kill ring}, a list of blocks
-of text that have been killed. There is only one kill ring, shared by
-all buffers, so you can kill text in one buffer and yank it in another
-buffer. This is the usual way to move text from one file to another.
-(There are several other methods: for instance, you could store the
-text in a register. @xref{Registers}, for information about
-registers. @xref{Accumulating Text}, for some other ways to move text
-around.)
+ The @dfn{kill ring} is a list of blocks of text that were previously
+killed. There is only one kill ring, shared by all buffers, so you
+can kill text in one buffer and yank it in another buffer. This is
+the usual way to move text from one file to another. (There are
+several other methods: for instance, you could store the text in a
+register; see @ref{Registers}. @xref{Accumulating Text}, for some
+other ways to move text around.)
@kindex C-y
@findex yank
- The command @kbd{C-y} (@code{yank}) reinserts the text of the most
-recent kill, leaving the cursor at the end of the text. It also adds
-the position of the beginning of the text to the mark ring, without
-activating the mark; this allows you to jump easily to that position
-with @kbd{C-x C-x} (@pxref{Setting Mark}). With a plain prefix
-argument (@kbd{C-u C-y}), it instead leaves the cursor in front of the
-text, and adds the position of the end of the text to the mark ring.
-Using other sort of prefix argument specifies an earlier kill; for
-example, @kbd{C-u 4 C-y} reinserts the fourth most recent kill.
-@xref{Earlier Kills}.
-
-@cindex yanking and text properties
-@vindex yank-excluded-properties
- The yank commands discard certain properties from the yanked text.
-These are properties that might lead to annoying results, such as
-causing the text to respond to the mouse or specifying key bindings.
-The list of properties to discard is stored in the variable
-@code{yank-excluded-properties}. Yanking of register contents and
-rectangles also discard these properties. @xref{Text Properties,,,
-elisp, the Emacs Lisp Reference Manual}, for more information about
-text properties.
+ @kbd{C-y} (@code{yank}) reinserts the text of the most recent kill,
+leaving the cursor at the end of the text. It also adds the position
+of the beginning of the text to the mark ring, without activating the
+mark; this allows you to jump easily to that position with @kbd{C-x
+C-x} (@pxref{Setting Mark}).
+
+ 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 from the clipboard instead of the
+kill ring. Conceptually, you can think of the clipboard as an
+``extra'' entry in the kill ring, which is present if you recently cut
+or copied some text in another application. @xref{Cut and Paste}.
+
+ With a plain prefix argument (@kbd{C-u C-y}), the @code{yank}
+command instead leaves the cursor in front of the text, and adds the
+position of the end of the text to the mark ring. Using any other
+prefix argument specifies an earlier kill; for example, @kbd{C-u 4
+C-y} reinserts the fourth most recent kill. @xref{Earlier Kills}.
@node Appending Kills
@subsection Appending Kills
@@ -418,6 +424,179 @@ saved.
@code{kill-ring}; you can view the entire contents of the kill ring with
the command @kbd{C-h v kill-ring}.
+@node Cut and Paste
+@section ``Cut and Paste'' Operations on Graphical Displays
+@cindex cut
+@cindex copy
+@cindex paste
+
+ In most graphical desktop environments, you can transfer data
+(usually text) between different applications using a system facility
+called the @dfn{clipboard}. On X, two other similar facilities are
+available: the primary selection and the secondary selection. When
+Emacs is run on a graphical display, its kill and yank commands
+integrate with these facilities, so that you can easily transfer text
+between Emacs and other graphical applications.
+
+ By default, Emacs uses UTF-8 as the coding system for inter-program
+text transfers. If you find that the pasted text is not what you
+expected, you can specify another coding system by typing @kbd{C-x
+@key{RET} x} or @kbd{C-x @key{RET} X}. You can also request a
+different data type by customizing @code{x-select-request-type}.
+@xref{Communication Coding}.
+
+@menu
+* Clipboard:: How Emacs uses the system clipboard.
+* Primary Selection:: The temporarily selected text selection.
+* Secondary Selection:: Cutting without altering point and mark.
+@end menu
+
+@node Clipboard
+@subsection Using the Clipboard
+@cindex clipboard
+
+ The @dfn{clipboard} is the facility that most graphical applications
+use for ``cutting and pasting''. When the clipboard exists, the kill
+and yank commands in Emacs make use of it.
+
+ When you kill some text with a command such as @kbd{C-w}
+(@code{kill-region}), or copy it to the kill ring with a command such
+as @kbd{M-w} (@code{kill-ring-save}), that text is also put in the
+clipboard. @xref{Killing}.
+
+@vindex save-interprogram-paste-before-kill
+ When an Emacs kill command puts text in the clipboard, the existing
+clipboard contents are normally lost. Optionally, you can change
+@code{save-interprogram-paste-before-kill} to @code{t}. Then Emacs
+will first save the clipboard to its kill ring, preventing you from
+losing the old clipboard data---at the risk of high memory consumption
+if that data turns out to be large.
+
+ The usual yank commands, such as @kbd{C-y} (@code{yank}), also use
+the clipboard. If another application ``owns'' the clipboard---i.e.,
+if you cut or copied text there more recently than your last kill
+command in Emacs---then Emacs yanks from the clipboard instead of the
+kill ring. Otherwise, it yanks from the kill ring, as described in
+@ref{Yanking}.
+
+@vindex yank-pop-change-selection
+ Normally, rotating the kill ring with @kbd{M-y} (@code{yank-pop})
+does not alter the clipboard. However, if you change
+@code{yank-pop-change-selection} to @code{t}, then @kbd{M-y} saves the
+new yank to the clipboard.
+
+@vindex x-select-enable-clipboard
+ To prevent kill and yank commands from accessing the clipboard,
+change the variable @code{x-select-enable-clipboard} to @code{nil}.
+
+@vindex x-select-enable-primary
+@findex clipboard-kill-region
+@findex clipboard-kill-ring-save
+@findex clipboard-yank
+ Prior to Emacs 24, the kill and yank commands used the primary
+selection (@pxref{Primary Selection}), not the clipboard. If you
+prefer this behavior, change @code{x-select-enable-clipboard} to
+@code{nil}, @code{x-select-enable-primary} to @code{t}, and
+@code{mouse-drag-copy-region} to @code{t}. In this case, you can use
+the following commands to act explicitly on the clipboard:
+@code{clipboard-kill-region} kills the region and saves it to the
+clipboard; @code{clipboard-kill-ring-save} copies the region to the
+kill ring and saves it to the clipboard; and @code{clipboard-yank}
+yanks the contents of the clipboard at point.
+
+@node Primary Selection
+@subsection Cut and Paste with Other Window Applications
+@cindex X cutting and pasting
+@cindex X selection
+@cindex primary selection
+@cindex selection, primary
+
+ Under the X window system, there exists a @dfn{primary selection}
+containing the last stretch of text selected in an X application
+(usually by dragging the mouse). Typically, this text can be inserted
+into other X applications by @kbd{mouse-2} clicks. The primary
+selection is separate from the clipboard (@pxref{Clipboard}). Its
+contents are more ``fragile''; they are overwritten by any mouse
+selection, whereas the clipboard is only overwritten by explicit
+``cut'' or ``copy'' commands.
+
+ Under X, whenever you set an active region (@pxref{Mark}), Emacs
+saves the text in the active region to the primary selection. This
+applies to active regions made by dragging or clicking the mouse
+(@pxref{Mouse Commands}), and those made by keyboard commands (e.g. by
+typing @kbd{C-@key{SPC}} and moving point; see @ref{Setting Mark}).
+
+@vindex select-active-regions
+ If you change the variable @code{select-active-regions} to
+@code{only}, Emacs saves only temporarily active regions to the
+primary selection, i.e. those made with the mouse or with shift
+selection (@pxref{Shift Selection}). If you change
+@code{select-active-regions} to @code{nil}, Emacs avoids saving active
+regions to the primary selection entirely.
+
+ To insert the primary selection into an Emacs buffer, click
+@kbd{mouse-2} (@code{mouse-yank-primary}) where you want to insert it.
+@xref{Mouse Commands}.
+
+@cindex MS-Windows, and primary selection
+ MS-Windows provides no primary selection, but Emacs emulates it
+within a single Emacs session by storing the selected text internally.
+Therefore, all the features and commands related to the primary
+selection work on Windows as they do on X, for cutting and pasting
+within the same session, but not across Emacs sessions or with other
+applications.
+
+@node Secondary Selection
+@subsection Secondary Selection
+@cindex secondary selection
+
+ In addition to the primary selection, the X Window System provides a
+second similar facility known as the @dfn{secondary selection}.
+Nowadays, few X applications make use of the secondary selection, but
+you can access it using the following Emacs commands:
+
+@table @kbd
+@findex mouse-set-secondary
+@kindex M-Drag-Mouse-1
+@item M-Drag-Mouse-1
+Set the secondary selection, with one end at the place where you press
+down the button, and the other end at the place where you release it
+(@code{mouse-set-secondary}). The selected text is highlighted, using
+the @code{secondary-selection} face, as you drag. The window scrolls
+automatically if you drag the mouse off the top or bottom of the
+window, just like @code{mouse-set-region} (@pxref{Mouse Commands}).
+
+This command does not alter the kill ring.
+
+@findex mouse-start-secondary
+@kindex M-Mouse-1
+@item M-Mouse-1
+Set one endpoint for the @dfn{secondary selection}
+(@code{mouse-start-secondary}).
+
+@findex mouse-secondary-save-then-kill
+@kindex M-Mouse-3
+@item M-Mouse-3
+Set the secondary selection, with one end at the position clicked and
+the other at the position specified with @kbd{M-Mouse-1}
+(@code{mouse-secondary-save-then-kill}). This also puts the selected
+text in the kill ring. A second @kbd{M-Mouse-3} at the same place
+kills the secondary selection just made.
+
+@findex mouse-yank-secondary
+@kindex M-Mouse-2
+@item M-Mouse-2
+Insert the secondary selection where you click, placing point at the
+end of the yanked text (@code{mouse-yank-secondary}).
+@end table
+
+Double or triple clicking of @kbd{M-Mouse-1} operates on words and
+lines, much like @kbd{Mouse-1}.
+
+If @code{mouse-yank-at-point} is non-@code{nil}, @kbd{M-Mouse-2} yanks
+at point. Then it does not matter precisely where you click, or even
+which of the frame's windows you click on. @xref{Mouse Commands}.
+
@node Accumulating Text
@section Accumulating Text
@findex append-to-buffer
@@ -581,8 +760,7 @@ rectangle and then yank it beside the first line of the list.
@xref{Two-Column}, for another way to edit multi-column text.
You can also copy rectangles into and out of registers with @kbd{C-x r
-r @var{r}} and @kbd{C-x r i @var{r}}. @xref{RegRect,,Rectangle
-Registers}.
+r @var{r}} and @kbd{C-x r i @var{r}}. @xref{Rectangle Registers}.
@kindex C-x r o
@findex open-rectangle
diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi
index c52381a663c..ac81377aec9 100644
--- a/doc/emacs/kmacro.texi
+++ b/doc/emacs/kmacro.texi
@@ -332,8 +332,8 @@ numbers stored in registers.
If you use a register as a counter, incrementing it on each
repetition of the macro, that accomplishes the same thing as a
-keyboard macro counter. @xref{RegNumbers}. For most purposes, it is
-simpler to use a keyboard macro counter.
+keyboard macro counter. @xref{Number Registers}. For most purposes,
+it is simpler to use a keyboard macro counter.
@node Keyboard Macro Query
@section Executing Macros with Variations
diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi
index 5d5705456f9..85d92c9fcd7 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -161,10 +161,6 @@ This event occurs when another application requests that Emacs open a
temporary file. By default, this is handled by just generating a
@code{ns-open-file} event, the results of which are described above.
-You can bind @key{ns-pop-up-frames} and @key{ns-open-temp-file} to
-other Lisp functions. When the event is registered, the name of the
-file to open is stored in the variable @code{ns-input-file}.
-
@item ns-open-file-line
Some applications, such as ProjectBuilder and gdb, request not only a
particular file, but also a particular line or sequence of lines in
diff --git a/doc/emacs/major.texi b/doc/emacs/major.texi
deleted file mode 100644
index 9256c712f02..00000000000
--- a/doc/emacs/major.texi
+++ /dev/null
@@ -1,237 +0,0 @@
-@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
-@c Free Software Foundation, Inc.
-@c See file emacs.texi for copying conditions.
-@node Major Modes, Indentation, International, Top
-@chapter Major Modes
-@cindex major modes
-@cindex mode, major
-@kindex TAB @r{(and major modes)}
-@kindex DEL @r{(and major modes)}
-@kindex C-j @r{(and major modes)}
-
- Emacs provides many alternative @dfn{major modes}, each of which
-customizes Emacs for editing text of a particular sort. The major modes
-are mutually exclusive, and each buffer has one major mode at any time.
-The mode line normally shows the name of the current major mode, in
-parentheses (@pxref{Mode Line}).
-
- The least specialized major mode is called @dfn{Fundamental mode}.
-This mode has no mode-specific redefinitions or variable settings, so
-that each Emacs command behaves in its most general manner, and each
-user option variable is in its default state. For editing text of a
-specific type that Emacs knows about, such as Lisp code or English
-text, you should switch to the appropriate major mode, such as Lisp
-mode or Text mode.
-
- Selecting a major mode changes the meanings of a few keys to become
-more specifically adapted to the language being edited. The ones that
-are changed frequently are @key{TAB}, @key{DEL}, and @kbd{C-j}. The
-prefix key @kbd{C-c} normally contains mode-specific commands. In
-addition, the commands which handle comments use the mode to determine
-how comments are to be delimited. Many major modes redefine the
-syntactical properties of characters appearing in the buffer.
-@xref{Syntax}.
-
- The major modes fall into three major groups. The first group
-contains modes for normal text, either plain or with mark-up. It
-includes Text mode, HTML mode, SGML mode, @TeX{} mode and Outline
-mode. The second group contains modes for specific programming
-languages. These include Lisp mode (which has several variants), C
-mode, Fortran mode, and others. The remaining major modes are not
-intended for use on users' files; they are used in buffers created for
-specific purposes by Emacs, such as Dired mode for buffers made by
-Dired (@pxref{Dired}), Message mode for buffers made by @kbd{C-x m}
-(@pxref{Sending Mail}), and Shell mode for buffers used for
-communicating with an inferior shell process (@pxref{Interactive
-Shell}).
-
- Most programming-language major modes specify that only blank lines
-separate paragraphs. This is to make the paragraph commands useful.
-(@xref{Paragraphs}.) They also cause Auto Fill mode to use the
-definition of @key{TAB} to indent the new lines it creates. This is
-because most lines in a program are usually indented
-(@pxref{Indentation}).
-
-@menu
-* Choosing Modes:: How major modes are specified or chosen.
-@end menu
-
-@node Choosing Modes,,Major Modes,Major Modes
-@section How Major Modes are Chosen
-
-@cindex choosing a major mode
- You can select a major mode explicitly for the current buffer, but
-most of the time Emacs determines which mode to use based on the file
-name or on special text in the file.
-
- To explicitly select a new major, you use an @kbd{M-x} command.
-Take the name of a major mode and add @code{-mode} to get the name of
-the command to select that mode. Thus, you can enter Lisp mode by
-executing @kbd{M-x lisp-mode}.
-
-@vindex auto-mode-alist
- When you visit a file, Emacs usually chooses the right major mode
-automatically. Normally, it makes the choice based on the file
-name---for example, files whose names end in @samp{.c} are normally
-edited in C mode---but sometimes it chooses the major mode based on
-the contents of the file. Here is the exact procedure:
-
- First, Emacs checks whether the file contains a file-local variable
-that specifies the major mode. If so, it uses that major mode,
-ignoring all other criteria. @xref{File Variables}. There are
-several methods to specify a major mode using a file-local variable;
-the simplest is to put the mode name in the first nonblank line,
-preceded and followed by @samp{-*-}. Other text may appear on the
-line as well. For example,
-
-@example
-; -*-Lisp-*-
-@end example
-
-@noindent
-tells Emacs to use Lisp mode. Note how the semicolon is used to make
-Lisp treat this line as a comment. Alternatively, you could write
-
-@example
-; -*- mode: Lisp;-*-
-@end example
-
-@noindent
-The latter format allows you to specify local variables as well, like
-this:
-
-@example
-; -*- mode: Lisp; tab-width: 4; -*-
-@end example
-
-@vindex interpreter-mode-alist
- Second, Emacs checks whether the file's contents begin with
-@samp{#!}. If so, that indicates that the file can serve as an
-executable shell command, which works by running an interpreter named
-on the file's first line (the rest of the file is used as input to the
-interpreter). Therefore, Emacs tries to use the interpreter name to
-choose a mode. For instance, a file that begins with
-@samp{#!/usr/bin/perl} is opened in Perl mode. The variable
-@code{interpreter-mode-alist} specifies the correspondence between
-interpreter program names and major modes.
-
- When the first line starts with @samp{#!}, you usually cannot use
-the @samp{-*-} feature on the first line, because the system would get
-confused when running the interpreter. So Emacs looks for @samp{-*-}
-on the second line in such files as well as on the first line. The
-same is true for man pages which start with the magic string
-@samp{'\"} to specify a list of troff preprocessors.
-
-@vindex magic-mode-alist
- Third, Emacs tries to determine the major mode by looking at the
-text at the start of the buffer, based on the variable
-@code{magic-mode-alist}. By default, this variable is @code{nil} (an
-empty list), so Emacs skips this step; however, you can customize it
-in your init file (@pxref{Init File}). The value should be a list of
-elements of the form
-
-@example
-(@var{regexp} . @var{mode-function})
-@end example
-
-@noindent
-where @var{regexp} is a regular expression (@pxref{Regexps}), and
-@var{mode-function} is a Lisp function that toggles a major mode. If
-the text at the beginning of the file matches @var{regexp}, Emacs
-chooses the major mode specified by @var{mode-function}.
-
-Alternatively, an element of @code{magic-mode-alist} may have the form
-
-@example
-(@var{match-function} . @var{mode-function})
-@end example
-
-@noindent
-where @var{match-function} is a Lisp function that is called at the
-beginning of the buffer; if the function returns non-@code{nil}, Emacs
-set the major mode wit @var{mode-function}.
-
- Fourth---if Emacs still hasn't found a suitable major mode---it
-looks at the file's name. The correspondence between file names and
-major modes is controlled by the variable @code{auto-mode-alist}. Its
-value is a list in which each element has this form,
-
-@example
-(@var{regexp} . @var{mode-function})
-@end example
-
-@noindent
-or this form,
-
-@example
-(@var{regexp} @var{mode-function} @var{flag})
-@end example
-
-@noindent
-For example, one element normally found in the list has the form
-@code{(@t{"\\.c\\'"} . c-mode)}, and it is responsible for selecting C
-mode for files whose names end in @file{.c}. (Note that @samp{\\} is
-needed in Lisp syntax to include a @samp{\} in the string, which must
-be used to suppress the special meaning of @samp{.} in regexps.) If
-the element has the form @code{(@var{regexp} @var{mode-function}
-@var{flag})} and @var{flag} is non-@code{nil}, then after calling
-@var{mode-function}, Emacs discards the suffix that matched
-@var{regexp} and searches the list again for another match.
-
-@vindex auto-mode-case-fold
- On systems with case-insensitive file names, such as Microsoft
-Windows, Emacs performs a single case-insensitive search through
-@code{auto-mode-alist}. On other systems, Emacs normally performs a
-single case-sensitive search through the alist. However, if you
-change the variable @code{auto-mode-case-fold} to @code{t}, Emacs
-performs a second case-insensitive search if the first search fails.
-
-@vindex magic-fallback-mode-alist
- Finally, if Emacs @emph{still} hasn't found a major mode to use, it
-compares the text at the start of the buffer to the variable
-@code{magic-fallback-mode-alist}. This variable works like
-@code{magic-mode-alist}, described above, except that is consulted
-only after @code{auto-mode-alist}. By default,
-@code{magic-fallback-mode-alist} contains forms that check for image
-files, HTML/XML/SGML files, and Postscript files.
-
-@vindex major-mode
- Once a major mode is chosen, Emacs sets the value of the variable
-@code{major-mode} to the symbol for that major mode (e.g.,
-@code{text-mode} for Text mode). This is a per-buffer variable
-(@pxref{Locals}); its buffer-local value is set automatically, and you
-should not change it yourself.
-
- The default value of @code{major-mode} determines the major mode to
-use for files that do not specify a major mode, and for new buffers
-created with @kbd{C-x b}. Normally, this default value is the symbol
-@code{fundamental-mode}, which specifies Fundamental mode. You can
-change it via the Customization interface (@pxref{Easy
-Customization}), or by adding a line like this to your init file
-(@pxref{Init File}):
-
-@smallexample
-(setq-default major-mode 'text-mode)
-@end smallexample
-
-@noindent
-If the default value of @code{major-mode} is @code{nil}, the major
-mode is taken from the previously current buffer.
-
-@findex normal-mode
- If you have changed the major mode of a buffer, you can return to
-the major mode Emacs would have chosen automatically, by typing
-@kbd{M-x normal-mode}. This is the same function that
-@code{find-file} calls to choose the major mode. It also processes
-the file's @samp{-*-} line or local variables list (if any).
-@xref{File Variables}.
-
-@vindex change-major-mode-with-file-name
- The commands @kbd{C-x C-w} and @code{set-visited-file-name} change to
-a new major mode if the new file name implies a mode (@pxref{Saving}).
-(@kbd{C-x C-s} does this too, if the buffer wasn't visiting a file.)
-However, this does not happen if the buffer contents specify a major
-mode, and certain ``special'' major modes do not allow the mode to
-change. You can turn off this mode-changing feature by setting
-@code{change-major-mode-with-file-name} to @code{nil}.
diff --git a/doc/emacs/makefile.w32-in b/doc/emacs/makefile.w32-in
index ad976468be9..4064f4ef6a3 100644
--- a/doc/emacs/makefile.w32-in
+++ b/doc/emacs/makefile.w32-in
@@ -76,7 +76,7 @@ EMACSSOURCES= \
$(srcdir)/windows.texi \
$(srcdir)/frames.texi \
$(srcdir)/mule.texi \
- $(srcdir)/major.texi \
+ $(srcdir)/modes.texi \
$(srcdir)/indent.texi \
$(srcdir)/text.texi \
$(srcdir)/programs.texi \
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index b426020b7c6..1a93f5b79c8 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -68,8 +68,9 @@ Set point and the mark around the text you drag across.
@item Mouse-3
Set the mark at point, then move point to where you click
(@code{mouse-save-then-kill}).
-@item @samp{Shifted motion keys}
+@item @samp{Shifted cursor motion keys}
Set the mark at point if the mark is inactive, then move point.
+@xref{Shift Selection}.
@end table
@kindex C-SPC
@@ -252,7 +253,9 @@ Another effect of this mode is that some keys, such as @key{DEL} and
@cindex mark ring
Aside from delimiting the region, the mark is also useful for
remembering spots that you may want to go back to. Each buffer
-remembers 16 previous locations of the mark, in the @dfn{mark ring}.
+remembers @code{mark-ring-max} previous locations of the mark, in the
+@dfn{mark ring}. This defaults to 16 locations.
+
Commands that set the mark also push the old mark onto this ring.
@table @kbd
@@ -307,17 +310,19 @@ is non-@code{nil} by default.
If you want to move back to the same place over and over, the mark
ring may not be convenient enough. If so, you can record the position
-in a register for later retrieval (@pxref{RegPos,, Saving Positions in
-Registers}).
+in a register for later retrieval (@pxref{Position Registers,, Saving
+Positions in Registers}).
@node Global Mark Ring
@section The Global Mark Ring
@cindex global mark ring
+@vindex global-mark-ring-max
In addition to the ordinary mark ring that belongs to each buffer,
Emacs has a single @dfn{global mark ring}. Each time you set a mark,
in any buffer, this is recorded in the global mark ring in addition to
-the current buffer's own mark ring.
+the current buffer's own mark ring. The length of this ring can be
+controlled by @code{global-mark-ring-max}, and is 16 by default.
@kindex C-x C-@key{SPC}
@findex pop-global-mark
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index dcc1c445e68..ce0d396fd0d 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -68,10 +68,10 @@ 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.
- You can specify the parent directory by adding @file{..}: for
-example, @file{/u2/emacs/src/../lisp/simple.el} is equivalent to
-@file{/u2/emacs/lisp/simple.el}. Alternatively, you can use
-@kbd{M-@key{DEL}} to kill directory names backwards (@pxref{Words}).
+ You can specify the parent directory with @file{..}:
+@file{/a/b/../foo.el} is equivalent to @file{/a/foo.el}.
+Alternatively, you can use @kbd{M-@key{DEL}} to kill directory names
+backwards (@pxref{Words}).
To specify a file in a completely different directory, you can kill
the entire default with @kbd{C-a C-k} (@pxref{Minibuffer Edit}).
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 06267851d4c..426610e65b9 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -1603,16 +1603,8 @@ listed below:
@item -a @var{command}
@itemx --alternate-editor=@var{command}
Specify a command to run if @code{emacsclient} fails to contact Emacs.
-This is useful when running @code{emacsclient} in a script. For
-example, the following setting for the @env{EDITOR} environment
-variable will always give you an editor, even if no Emacs server is
-running:
+This is useful when running @code{emacsclient} in a script.
-@example
-EDITOR="emacsclient --alternate-editor emacs +%d %s"
-@end example
-
-@noindent
As a special exception, if @var{command} is the empty string, then
@code{emacsclient} starts Emacs in daemon mode and then tries
connecting again.
@@ -1631,6 +1623,11 @@ 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
+@itemx --frame-parameters=@var{alist}
+Set the parameters for a newly-created graphical frame
+(@pxref{Frame Parameters}).
+
@item -d @var{display}
@itemx --display=@var{display}
Tell Emacs to open the given files on the X display @var{display}
@@ -1681,6 +1678,11 @@ all server buffers are finished. You can take as long as you like to
edit the server buffers within Emacs, and they are @emph{not} killed
when you type @kbd{C-x #} in them.
+@item --parent-id @var{ID}
+Open an @command{emacsclient} frame as a client frame in the parent X
+window with id @var{ID}, via the XEmbed protocol. Currently, this
+option is mainly useful for developers.
+
@item -q
@itemx --quiet
Do not let @command{emacsclient} display messages about waiting for
@@ -2513,9 +2515,8 @@ also use the command @kbd{M-x scroll-all-mode} or set the variable
@item EDT (DEC VMS editor)
@findex edt-emulation-on
@findex edt-emulation-off
-Turn on EDT emulation with the command @kbd{M-x edt-emulation-on},
-while @kbd{M-x edt-emulation-off} restores normal Emacs command
-bindings.
+Turn on EDT emulation @kbd{M-x edt-emulation-on}; use @kbd{M-x
+edt-emulation-off} to restore normal Emacs command bindings.
Most of the EDT emulation commands are keypad keys, and most standard
Emacs key bindings are still available. The EDT emulation rebindings
@@ -2571,7 +2572,7 @@ not use it.
key bindings.
@end table
-@node Hyperlinking, Dissociated Press, Emulation, Top
+@node Hyperlinking, Amusements, Emulation, Top
@section Hyperlinking and Navigation Features
@cindex hyperlinking
@@ -2737,82 +2738,14 @@ Display a menu of files and URLs mentioned in current buffer, then
find the one you select (@code{ffap-menu}).
@end table
-@node Dissociated Press, Amusements, Hyperlinking, Top
-@section Dissociated Press
-
-@findex dissociated-press
- @kbd{M-x dissociated-press} is a command for scrambling a file of text
-either word by word or character by character. Starting from a buffer of
-straight English, it produces extremely amusing output. The input comes
-from the current Emacs buffer. Dissociated Press writes its output in a
-buffer named @samp{*Dissociation*}, and redisplays that buffer after every
-couple of lines (approximately) so you can read the output as it comes out.
-
- Dissociated Press asks every so often whether to continue generating
-output. Answer @kbd{n} to stop it. You can also stop at any time by
-typing @kbd{C-g}. The dissociation output remains in the
-@samp{*Dissociation*} buffer for you to copy elsewhere if you wish.
-
-@cindex presidentagon
- Dissociated Press operates by jumping at random from one point in
-the buffer to another. In order to produce plausible output rather
-than gibberish, it insists on a certain amount of overlap between the
-end of one run of consecutive words or characters and the start of the
-next. That is, if it has just output `president' and then decides to
-jump to a different point in the buffer, it might spot the `ent' in
-`pentagon' and continue from there, producing `presidentagon'. Long
-sample texts produce the best results.
-
-@cindex againformation
- A positive argument to @kbd{M-x dissociated-press} 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. In this mode, whole words are treated as the elements to
-be permuted, rather than characters. No argument is equivalent to an
-argument of two. For your againformation, the output goes only into the
-buffer @samp{*Dissociation*}. The buffer you start with is not changed.
-
-@cindex Markov chain
-@cindex ignoriginal
-@cindex techniquitous
- Dissociated Press produces results fairly like those of a Markov
-chain based on a frequency table constructed from the sample text. It
-is, however, an independent, ignoriginal invention. Dissociated Press
-techniquitously copies several consecutive characters from the sample
-text between random jumps, unlike a Markov chain which would jump
-randomly after each word or character. This makes for more plausible
-sounding results, and runs faster.
-
-@cindex outragedy
-@cindex buggestion
-@cindex properbose
-@cindex mustatement
-@cindex developediment
-@cindex userenced
- It is a mustatement that too much use of Dissociated Press can be a
-developediment to your real work, sometimes to the point of outragedy.
-And keep dissociwords out of your documentation, if you want it to be well
-userenced and properbose. Have fun. Your buggestions are welcome.
-
-@node Amusements, Customization, Dissociated Press, Top
+@node Amusements, Customization, Hyperlinking, Top
@section Other Amusements
@cindex boredom
-@findex hanoi
-@findex yow
-@findex gomoku
-@cindex tower of Hanoi
-
- If you are a little bit bored, you can try @kbd{M-x hanoi}. If you are
-considerably bored, give it a numeric argument. If you are very, very
-bored, try an argument of 9. Sit back and watch.
-
-@cindex Go Moku
- If you want a little more personal involvement, try @kbd{M-x gomoku},
-which plays the game Go Moku with you.
-@findex bubbles
- @kbd{M-x bubbles} is a game in which the object is to remove as many
-bubbles as you can in the smallest number of moves.
+@findex animate-birthday-present
+@cindex animate
+ The @code{animate} package makes text dance. For an example, try
+@kbd{M-x animate-birthday-present}.
@findex blackbox
@findex mpuz
@@ -2825,73 +2758,82 @@ puzzle with letters standing for digits in a code that you must
guess---to guess a value, type a letter and then the digit you think it
stands for. The aim of @code{5x5} is to fill in all the squares.
+@findex bubbles
+ @kbd{M-x bubbles} is a game in which the object is to remove as many
+bubbles as you can in the smallest number of moves.
+
@findex decipher
@cindex ciphers
@cindex cryptanalysis
-@kbd{M-x decipher} helps you to cryptanalyze a buffer which is encrypted
-in a simple monoalphabetic substitution cipher.
+ @kbd{M-x decipher} helps you to cryptanalyze a buffer which is
+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
+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
+results fairly like those of a Markov chain, but is however, an
+independent, ignoriginal invention; it techniquitously copies several
+consecutive characters from the sample text between random jumps,
+unlike a Markov chain which would jump randomly after each word or
+character. Keep dissociwords out of your documentation, if you want
+it to be well userenced and properbose.
@findex dunnet
- @kbd{M-x dunnet} runs an adventure-style exploration game, which is
-a bigger sort of puzzle.
+ @kbd{M-x dunnet} runs an text-based adventure game.
-@findex lm
-@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.
+@findex gomoku
+@cindex Go Moku
+ If you want a little more personal involvement, try @kbd{M-x gomoku},
+which plays the game Go Moku with you.
+
+@cindex tower of Hanoi
+@findex hanoi
+ If you are a little bit bored, you can try @kbd{M-x hanoi}. If you are
+considerably bored, give it a numeric argument. If you are very, very
+bored, try an argument of 9. Sit back and watch.
@findex life
@cindex Life
-@kbd{M-x life} runs Conway's ``Life'' cellular automaton.
+ @kbd{M-x life} runs Conway's ``Life'' cellular automaton.
+
+@findex lm
+@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.
@findex morse-region
@findex unmorse-region
@cindex Morse code
@cindex --/---/.-./.../.
-@kbd{M-x morse-region} converts text in a region to Morse code and
+ @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.
@findex pong
@cindex Pong game
-@kbd{M-x pong} plays a Pong-like game, bouncing the ball off opposing
-bats.
-
-@findex solitaire
-@cindex solitaire
-@kbd{M-x solitaire} plays a game of solitaire in which you jump pegs
-across other pegs.
-
-@findex animate-birthday-present
-@cindex animate
-The @code{animate} package makes text dance. For an example, try
-@kbd{M-x animate-birthday-present}.
-
-@findex studlify-region
-@cindex StudlyCaps
-@kbd{M-x studlify-region} studlify-cases the region, producing
-text like this:
-
-@example
-M-x stUdlIfY-RegioN stUdlIfY-CaSeS thE region.
-@end example
-
@findex tetris
@cindex Tetris
@findex snake
@cindex Snake
-@kbd{M-x tetris} runs an implementation of the well-known Tetris game.
-Likewise, @kbd{M-x snake} provides an implementation of Snake.
-
- When you are frustrated, try the famous Eliza program. Just do
-@kbd{M-x doctor}. End each input by typing @key{RET} twice.
+ @kbd{M-x pong}, @kbd{M-x snake} and @kbd{M-x tetris} are
+implementations of the well-known Pong, Snake and Tetris games.
-@cindex Zippy
- When you are feeling strange, type @kbd{M-x yow}.
+@findex solitaire
+@cindex solitaire
+ @kbd{M-x solitaire} plays a game of solitaire in which you jump pegs
+across other pegs.
@findex zone
-The command @kbd{M-x zone} plays games with the display when Emacs is
-idle.
+ 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.
@ifnottex
@lowersections
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
new file mode 100644
index 00000000000..314d5d4347e
--- /dev/null
+++ b/doc/emacs/modes.texi
@@ -0,0 +1,410 @@
+@c This is part of the Emacs manual.
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Free Software Foundation, Inc.
+@c See file emacs.texi for copying conditions.
+@node Modes, Indentation, International, Top
+@chapter Editing Modes
+
+ Emacs contains many @dfn{editing modes}, each of which alters its
+basic behavior in useful ways. These are divided into @dfn{major
+modes} and @dfn{minor modes}.
+
+ Major modes provide specialized facilities for working on a
+particular file type, such as a C source file (@pxref{Programs}), or a
+particular type of non-file buffer, such as a shell buffer
+(@pxref{Shell}). Major modes are mutually exclusive; each buffer has
+one and only one major mode at any time.
+
+ Minor modes are optional features which you can turn on or off, not
+necessarily specific to a type of file or buffer. For example, Auto
+Fill mode is a minor mode in which @key{SPC} breaks lines between
+words as you type (@pxref{Auto Fill}). Minor modes are independent of
+one another, and of the selected major mode.
+
+@menu
+* Major Modes:: Text mode vs. Lisp mode vs. C mode...
+* Minor Modes:: Each minor mode is a feature you can turn on
+ independently of any others.
+* Choosing Modes:: How modes are chosen when visiting files.
+@end menu
+
+@node Major Modes
+@section Major Modes
+@cindex major modes
+@cindex mode, major
+@kindex TAB @r{(and major modes)}
+@kindex DEL @r{(and major modes)}
+@kindex C-j @r{(and major modes)}
+
+ Every buffer possesses a major mode, which determines the editing
+behavior of Emacs while that buffer is current. The mode line
+normally shows the name of the current major mode, in parentheses.
+@xref{Mode Line}.
+
+ Usually, the major mode is automatically set by Emacs, when you
+first visit a file or create a buffer. @xref{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}.
+
+ The least specialized major mode is called @dfn{Fundamental mode}.
+This mode has no mode-specific redefinitions or variable settings, so
+that each Emacs command behaves in its most general manner, and each
+user option variable is in its default state.
+
+ For editing text of a specific type that Emacs knows about, such as
+Lisp code or English text, you typically use a more specialized major
+mode, such as Lisp mode or Text mode. Such major modes change the
+meanings of some keys to become more specifically adapted to the
+language being edited. The ones that are commonly changed are
+@key{TAB}, @key{DEL}, and @kbd{C-j}. The prefix key @kbd{C-c}
+normally contains mode-specific commands. In addition, the commands
+which handle comments use the mode to determine how comments are to be
+delimited. Many major modes redefine the syntactical properties of
+characters appearing in the buffer.
+
+ The major modes fall into three major groups. The first group
+contains modes for normal text, either plain or with mark-up. It
+includes Text mode, HTML mode, SGML mode, @TeX{} mode and Outline
+mode. The second group contains modes for specific programming
+languages. These include Lisp mode (which has several variants), C
+mode, Fortran mode, and others. The remaining major modes are not
+intended for use on users' files; they are used in buffers created for
+specific purposes by Emacs, such as Dired mode for buffers made by
+Dired (@pxref{Dired}), Message mode for buffers made by @kbd{C-x m}
+(@pxref{Sending Mail}), and Shell mode for buffers used for
+communicating with an inferior shell process (@pxref{Interactive
+Shell}).
+
+ Most programming-language major modes specify that only blank lines
+separate paragraphs. This is to make the paragraph commands useful.
+(@xref{Paragraphs}.) They also cause Auto Fill mode to use the
+definition of @key{TAB} to indent the new lines it creates. This is
+because most lines in a program are usually indented
+(@pxref{Indentation}).
+
+@node Minor Modes
+@section Minor Modes
+@cindex minor modes
+@cindex mode, minor
+
+ A minor mode is an optional editing modes that alters the behavior
+of Emacs in some well-defined way. Unlike major modes, any number of
+minor modes can be in effect at any time. Some minor modes are
+@dfn{buffer-local}: they apply only to the current buffer, so you can
+enable the mode in certain buffers and not others. Other minor modes
+are @dfn{global}: while enabled, they affect everything you do in the
+Emacs session, in all buffers. Some global minor modes are enabled by
+default.
+
+ Most minor modes say in the mode line when they are enabled, just
+after the major mode indicator. For example, @samp{Fill} in the mode
+line means that Auto Fill mode is enabled. @xref{Mode Line}.
+
+ Each minor mode is associated with a command, called the @dfn{mode
+command}, which turns it on or off. The name of this command consists
+of the name of the minor mode, followed by @samp{-mode}; for instance,
+the mode command for Auto Fill mode is @code{auto-fill-mode}. Calling
+the minor mode command with no prefix argument @dfn{toggles} the mode,
+turning it on if it was off, and off if it was on. A positive
+argument always turns the mode on, and a zero or negative argument
+always turns it off. Mode commands are usually invoked with
+@kbd{M-x}, but you can bind keys to them if you wish (@pxref{Key
+Bindings}).
+
+ Most minor modes also have a @dfn{mode variable}, with the same name
+as the mode command. Its value is non-@code{nil} if the mode is
+enabled, and @code{nil} if it is disabled. In some minor modes---but
+not all---the value of the variable alone determines whether the mode
+is active: the mode command works simply by setting the variable, and
+changing the value of the variable has the same effect as calling the
+mode command. Because not all minor modes work this way, we recommend
+that you avoid changing the mode variables directly; use the mode
+commands instead.
+
+ The following is a list of some buffer-local minor modes:
+
+@itemize @bullet
+@item
+Abbrev mode automatically expands text based on pre-defined
+abbreviation definitions. @xref{Abbrevs}.
+
+@item
+Auto Fill mode inserts newlines as you type to prevent lines from
+becoming too long. @xref{Filling}.
+
+@item
+Auto Save mode saves the buffer contents periodically to reduce the
+amount of work you can lose in case of a crash. @xref{Auto Save}.
+
+@item
+Enriched mode enables editing and saving of formatted text.
+@xref{Formatted Text}.
+
+@item
+Flyspell mode automatically highlights misspelled words.
+@xref{Spelling}.
+
+@item
+Font-Lock mode automatically highlights certain textual units found in
+programs. It is enabled globally by default, but you can disable it
+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}.
+
+@item
+Outline minor mode provides similar facilities to the major mode
+called Outline mode. @xref{Outline Mode}.
+
+@cindex Overwrite mode
+@cindex mode, Overwrite
+@findex overwrite-mode
+@kindex INSERT
+@item
+Overwrite mode causes ordinary printing characters to replace existing
+text instead of shoving it to the right. For example, if point is in
+front of the @samp{B} in @samp{FOOBAR}, then in Overwrite mode typing
+a @kbd{G} changes it to @samp{FOOGAR}, instead of producing
+@samp{FOOGBAR} as usual. In Overwrite mode, the command @kbd{C-q}
+inserts the next character whatever it may be, even if it is a
+digit---this gives you a way to insert a character instead of
+replacing an existing character. The mode command,
+@code{overwrite-mode}, is bound to the @key{Insert} key.
+
+@findex binary-overwrite-mode
+@item
+Binary Overwrite mode is a variant of Overwrite mode for editing
+binary files; it treats newlines and tabs like other characters, so
+that they overwrite other characters and can be overwritten by them.
+In Binary Overwrite mode, digits after @kbd{C-q} specify an octal
+character code, as usual.
+
+@item
+Visual Line mode performs ``word wrapping'', causing long lines to be
+wrapped at word boundaries. @xref{Visual Line Mode}.
+@end itemize
+
+ Here are some useful global minor modes. Since Line Number mode and
+Transient Mark mode can be enabled or disabled just by setting the
+value of the minor mode variable, you @emph{can} set them differently
+for particular buffers, by explicitly making the corresponding
+variable local in those buffers. @xref{Locals}.
+
+@itemize @bullet
+@item
+Column Number mode enables display of the current column number in the
+mode line. @xref{Mode Line}.
+
+@item
+Delete Selection mode causes text insertion to first delete the text
+in the region, if the region is active. @xref{Using Region}.
+
+@item
+Icomplete mode displays an indication of available completions when
+you are in the minibuffer and completion is active. @xref{Completion
+Options}.
+
+@item
+Line Number mode enables display of the current line number in the
+mode line. It is enabled by default. @xref{Mode Line}.
+
+@item
+Menu Bar mode gives each frame a menu bar. It is enabled by default.
+@xref{Menu Bars}.
+
+@item
+Scroll Bar mode gives each window a scroll bar. It is enabled by
+default, but the scroll bar is only displayed on graphical terminals.
+@xref{Scroll Bars}.
+
+@item
+Tool Bar mode gives each frame a tool bar. It is enabled by default,
+but the tool bar is only displayed on graphical terminals. @xref{Tool
+Bars}.
+
+@item
+Transient Mark mode highlights the region, and makes many Emacs
+commands operate on the region when the mark is active. It is enabled
+by default. @xref{Mark}.
+@end itemize
+
+@node Choosing Modes
+@section Choosing File Modes
+
+@cindex choosing a major mode
+@cindex choosing a minor mode
+@vindex auto-mode-alist
+ When you visit a file, Emacs chooses a major mode automatically.
+Normally, it makes the choice based on the file name---for example,
+files whose names end in @samp{.c} are normally edited in C mode---but
+sometimes it chooses the major mode based on special text in the file.
+This special text can also be used to enable buffer-local minor modes.
+
+ Here is the exact procedure:
+
+ First, Emacs checks whether the file contains file-local mode
+variables. @xref{File Variables}. If there is a file-local variable
+that specifies a major mode, then Emacs uses that major mode, ignoring
+all other criteria. There are several methods to specify a major mode
+using a file-local variable; the simplest is to put the mode name in
+the first nonblank line, preceded and followed by @samp{-*-}. Other
+text may appear on the line as well. For example,
+
+@example
+; -*-Lisp-*-
+@end example
+
+@noindent
+tells Emacs to use Lisp mode. Note how the semicolon is used to make
+Lisp treat this line as a comment. Alternatively, you could write
+
+@example
+; -*- mode: Lisp;-*-
+@end example
+
+@noindent
+The latter format allows you to specify local variables as well, like
+this:
+
+@example
+; -*- mode: Lisp; tab-width: 4; -*-
+@end example
+
+ If a file variable specifies a buffer-local minor mode, Emacs
+enables that minor mode in the buffer.
+
+@vindex interpreter-mode-alist
+ Second, if there is no file variable specifying a major mode, Emacs
+checks whether the file's contents begin with @samp{#!}. If so, that
+indicates that the file can serve as an executable shell command,
+which works by running an interpreter named on the file's first line
+(the rest of the file is used as input to the interpreter).
+Therefore, Emacs tries to use the interpreter name to choose a mode.
+For instance, a file that begins with @samp{#!/usr/bin/perl} is opened
+in Perl mode. The variable @code{interpreter-mode-alist} specifies
+the correspondence between interpreter program names and major modes.
+
+ When the first line starts with @samp{#!}, you usually cannot use
+the @samp{-*-} feature on the first line, because the system would get
+confused when running the interpreter. So Emacs looks for @samp{-*-}
+on the second line in such files as well as on the first line. The
+same is true for man pages which start with the magic string
+@samp{'\"} to specify a list of troff preprocessors.
+
+@vindex magic-mode-alist
+ Third, Emacs tries to determine the major mode by looking at the
+text at the start of the buffer, based on the variable
+@code{magic-mode-alist}. By default, this variable is @code{nil} (an
+empty list), so Emacs skips this step; however, you can customize it
+in your init file (@pxref{Init File}). The value should be a list of
+elements of the form
+
+@example
+(@var{regexp} . @var{mode-function})
+@end example
+
+@noindent
+where @var{regexp} is a regular expression (@pxref{Regexps}), and
+@var{mode-function} is a Lisp function that toggles a major mode. If
+the text at the beginning of the file matches @var{regexp}, Emacs
+chooses the major mode specified by @var{mode-function}.
+
+Alternatively, an element of @code{magic-mode-alist} may have the form
+
+@example
+(@var{match-function} . @var{mode-function})
+@end example
+
+@noindent
+where @var{match-function} is a Lisp function that is called at the
+beginning of the buffer; if the function returns non-@code{nil}, Emacs
+set the major mode wit @var{mode-function}.
+
+ Fourth---if Emacs still hasn't found a suitable major mode---it
+looks at the file's name. The correspondence between file names and
+major modes is controlled by the variable @code{auto-mode-alist}. Its
+value is a list in which each element has this form,
+
+@example
+(@var{regexp} . @var{mode-function})
+@end example
+
+@noindent
+or this form,
+
+@example
+(@var{regexp} @var{mode-function} @var{flag})
+@end example
+
+@noindent
+For example, one element normally found in the list has the form
+@code{(@t{"\\.c\\'"} . c-mode)}, and it is responsible for selecting C
+mode for files whose names end in @file{.c}. (Note that @samp{\\} is
+needed in Lisp syntax to include a @samp{\} in the string, which must
+be used to suppress the special meaning of @samp{.} in regexps.) If
+the element has the form @code{(@var{regexp} @var{mode-function}
+@var{flag})} and @var{flag} is non-@code{nil}, then after calling
+@var{mode-function}, Emacs discards the suffix that matched
+@var{regexp} and searches the list again for another match.
+
+@vindex auto-mode-case-fold
+ On systems with case-insensitive file names, such as Microsoft
+Windows, Emacs performs a single case-insensitive search through
+@code{auto-mode-alist}. On other systems, Emacs normally performs a
+single case-sensitive search through the alist. However, if you
+change the variable @code{auto-mode-case-fold} to @code{t}, Emacs
+performs a second case-insensitive search if the first search fails.
+
+@vindex magic-fallback-mode-alist
+ Finally, if Emacs @emph{still} hasn't found a major mode to use, it
+compares the text at the start of the buffer to the variable
+@code{magic-fallback-mode-alist}. This variable works like
+@code{magic-mode-alist}, described above, except that is consulted
+only after @code{auto-mode-alist}. By default,
+@code{magic-fallback-mode-alist} contains forms that check for image
+files, HTML/XML/SGML files, and Postscript files.
+
+@vindex major-mode
+ Once a major mode is chosen, Emacs sets the value of the variable
+@code{major-mode} to the symbol for that major mode (e.g.,
+@code{text-mode} for Text mode). This is a per-buffer variable
+(@pxref{Locals}); its buffer-local value is set automatically, and you
+should not change it yourself.
+
+ The default value of @code{major-mode} determines the major mode to
+use for files that do not specify a major mode, and for new buffers
+created with @kbd{C-x b}. Normally, this default value is the symbol
+@code{fundamental-mode}, which specifies Fundamental mode. You can
+change it via the Customization interface (@pxref{Easy
+Customization}), or by adding a line like this to your init file
+(@pxref{Init File}):
+
+@smallexample
+(setq-default major-mode 'text-mode)
+@end smallexample
+
+@noindent
+If the default value of @code{major-mode} is @code{nil}, the major
+mode is taken from the previously current buffer.
+
+@findex normal-mode
+ If you have changed the major mode of a buffer, you can return to
+the major mode Emacs would have chosen automatically, by typing
+@kbd{M-x normal-mode}. This is the same function that
+@code{find-file} calls to choose the major mode. It also processes
+the file's @samp{-*-} line or local variables list (if any).
+@xref{File Variables}.
+
+@vindex change-major-mode-with-file-name
+ The commands @kbd{C-x C-w} and @code{set-visited-file-name} change to
+a new major mode if the new file name implies a mode (@pxref{Saving}).
+(@kbd{C-x C-s} does this too, if the buffer wasn't visiting a file.)
+However, this does not happen if the buffer contents specify a major
+mode, and certain ``special'' major modes do not allow the mode to
+change. You can turn off this mode-changing feature by setting
+@code{change-major-mode-with-file-name} to @code{nil}.
diff --git a/doc/emacs/msdog.texi b/doc/emacs/msdog.texi
index 0a454db86bb..533872ddf61 100644
--- a/doc/emacs/msdog.texi
+++ b/doc/emacs/msdog.texi
@@ -84,30 +84,29 @@ Emacs will start in the current directory of the Windows shell.
@cindex invoking Emacs from Windows Explorer
@pindex emacsclient.exe
@pindex emacsclientw.exe
-Via the Emacs client program, @file{emacsclient.exe} or
-@file{emacsclientw.exe}. This allows to invoke Emacs from other
-programs, and to reuse a running Emacs process for serving editing
-jobs required by other programs. @xref{Emacs Server}. The difference
-between @file{emacsclient.exe} and @file{emacsclientw.exe} is that the
-former is a console program, while the latter is a Windows GUI
-program. Both programs wait for Emacs to signal that the editing job
-is finished, before they exit and return control to the program that
-invoked them. Which one of them to use in each case depends on the
-expectations of the program that needs editing services. If that
-program is itself a console (text-mode) program, you should use
-@file{emacsclient.exe}, so that any of its messages and prompts appear
-in the same command window as those of the invoking program. By
-contrast, if the invoking program is a GUI program, you will be better
-off using @file{emacsclientw.exe}, because @file{emacsclient.exe} will
-pop up a command window if it is invoked from a GUI program. A
-notable situation where you would want @file{emacsclientw.exe} is when
-you right-click on a file in the Windows Explorer and select ``Open
-With'' from the pop-up menu. Use the @samp{--alternate-editor=} or
-@samp{-a} options if Emacs might not be running (or not running as a
-server) when @command{emacsclient} is invoked---that will always give
-you an editor. When invoked via @command{emacsclient}, Emacs will
-start in the current directory of the program that invoked
-@command{emacsclient}.
+Via @file{emacsclient.exe} or @file{emacsclientw.exe}, which allow you
+to invoke Emacs from other programs, and to reuse a running Emacs
+process for serving editing jobs required by other programs.
+@xref{Emacs Server}. The difference between @file{emacsclient.exe}
+and @file{emacsclientw.exe} is that the former is a console program,
+while the latter is a Windows GUI program. Both programs wait for
+Emacs to signal that the editing job is finished, before they exit and
+return control to the program that invoked them. Which one of them to
+use in each case depends on the expectations of the program that needs
+editing services. If that program is itself a console (text-mode)
+program, you should use @file{emacsclient.exe}, so that any of its
+messages and prompts appear in the same command window as those of the
+invoking program. By contrast, if the invoking program is a GUI
+program, you will be better off using @file{emacsclientw.exe}, because
+@file{emacsclient.exe} will pop up a command window if it is invoked
+from a GUI program. A notable situation where you would want
+@file{emacsclientw.exe} is when you right-click on a file in the
+Windows Explorer and select ``Open With'' from the pop-up menu. Use
+the @samp{--alternate-editor=} or @samp{-a} options if Emacs might not
+be running (or not running as a server) when @command{emacsclient} is
+invoked---that will always give you an editor. When invoked via
+@command{emacsclient}, Emacs will start in the current directory of
+the program that invoked @command{emacsclient}.
@end enumerate
@node Text and Binary
@@ -402,11 +401,11 @@ names, which might cause misalignment of columns in Dired display.
The Windows equivalent of the @code{HOME} directory is the
@dfn{user-specific application data directory}. The actual location
-depends on your Windows version and system configuration; 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
+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}.
@@ -446,10 +445,10 @@ any name mentioned in @ref{Init File}.
@cindex @file{_emacs} init file, MS-Windows
Because MS-DOS does not allow file names with leading dots, and
-because older Windows systems made it hard to create files with such
-names, the Windows port of Emacs supports an alternative name
-@file{_emacs} as a fallback, if such a file exists in the home
-directory, whereas @file{.emacs} does not.
+older Windows systems made it hard to create files with such names,
+the Windows port of Emacs supports an init file name @file{_emacs}, if
+such a file exists in the home directory and @file{.emacs} does not.
+This name is considered obsolete.
@node Windows Keyboard
@section Keyboard Usage on MS-Windows
@@ -955,11 +954,12 @@ The following scripts are recognized on Windows: @code{latin}, @code{greek},
@cindex font antialiasing (MS Windows)
@item antialias
-Specifies the antialiasing to use for the font. The value @code{none}
-means no antialiasing, @code{standard} means use standard antialiasing,
-@code{subpixel} means use subpixel antialiasing (known as Cleartype on Windows),
-and @code{natural} means use subpixel antialiasing with adjusted spacing between
-letters. If unspecified, the font will use the system default antialiasing.
+Specifies the antialiasing method. The value @code{none} means no
+antialiasing, @code{standard} means use standard antialiasing,
+@code{subpixel} means use subpixel antialiasing (known as Cleartype on
+Windows), and @code{natural} means use subpixel antialiasing with
+adjusted spacing between letters. If unspecified, the font will use
+the system default antialiasing.
@end table
@node Windows Misc
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index e12ec707063..3c970ecb12c 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 See file emacs.texi for copying conditions.
-@node International, Major Modes, Frames, Top
+@node International, Modes, Frames, Top
@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)
@@ -232,7 +232,8 @@ preferred charset: unicode (Unicode (ISO10646))
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)
+ 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
@@ -322,7 +323,7 @@ language environment also specifies a default input method.
@findex set-language-environment
@vindex current-language-environment
- To select a language environment, customize the variable
+ To select a language environment, customize
@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
@@ -648,9 +649,9 @@ shows that information in addition to the other information about the
character.
@findex list-input-methods
- To see a list of all the supported input methods, type @kbd{M-x
-list-input-methods}. The list gives information about each input
-method, including the string that stands for it in the mode line.
+ @kbd{M-x list-input-methods} displays a list of all the supported
+input methods. The list gives information about each input method,
+including the string that stands for it in the mode line.
@node Coding Systems
@section Coding Systems
@@ -760,6 +761,7 @@ aliases for @code{undecided-unix}, @code{undecided-dos}, and
the end-of-line conversion, and leave the character code conversion to
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
not meant to encode non-@acronym{ASCII} characters. With
@@ -770,6 +772,7 @@ end-of-line conversion in the usual way, based on the data
encountered, and has the usual three variants to specify the kind of
end-of-line conversion to use.
+@cindex @code{no-conversion}, coding system
In contrast, the coding system @code{no-conversion} specifies no
character code conversion at all---none for non-@acronym{ASCII} byte values and
none for end of line. This is useful for reading or writing binary
@@ -781,6 +784,7 @@ the @kbd{M-x find-file-literally} command. This uses
@code{no-conversion}, and also suppresses other Emacs features that
might convert the file contents before you see them. @xref{Visiting}.
+@cindex @code{emacs-internal}, coding system
The coding system @code{emacs-internal} (or @code{utf-8-emacs},
which is equivalent) means that the file contains non-@acronym{ASCII}
characters stored with the internal Emacs encoding. This coding
@@ -915,11 +919,12 @@ written in the Emacs internal character code).
@section Specifying a File's Coding System
If Emacs recognizes the encoding of a file incorrectly, you can
-reread the file using the correct coding system by typing @kbd{C-x
-@key{RET} r @var{coding-system} @key{RET}}. To see what coding system
-Emacs actually used to decode the file, look at the coding system
-mnemonic letter near the left edge of the mode line (@pxref{Mode
-Line}), or type @kbd{C-h C @key{RET}}.
+reread the file using the correct coding system with @kbd{C-x
+@key{RET} r} (@code{revert-buffer-with-coding-system}). This command
+prompts for the coding system to use. To see what coding system Emacs
+actually used to decode the file, look at the coding system mnemonic
+letter near the left edge of the mode line (@pxref{Mode Line}), or
+type @kbd{C-h C} (@code{describe-coding-system}).
@vindex coding
You can specify the coding system for a particular file in the file
@@ -993,15 +998,16 @@ one:
@table @kbd
@item C-x @key{RET} f @var{coding} @key{RET}
-Use coding system @var{coding} for saving or revisiting the visited
-file in the current buffer.
+Use coding system @var{coding} to save or revisit the visited 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
-command.
+command (@code{universal-coding-system-argument}).
@item C-x @key{RET} r @var{coding} @key{RET}
-Revisit the current file using the coding system @var{coding}.
+Revisit the current file using the coding system @var{coding}
+(@code{revert-buffer-with-coding-system}).
@item M-x recode-region @key{RET} @var{right} @key{RET} @var{wrong} @key{RET}
Convert a region that was decoded using coding system @var{wrong},
@@ -1083,19 +1089,17 @@ 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.
+other window-based 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 window-based application
+(@code{set-next-selection-coding-system}).
@item C-x @key{RET} p @var{input-coding} @key{RET} @var{output-coding} @key{RET}
Use coding systems @var{input-coding} and @var{output-coding} for
-subprocess input and output in the current buffer.
-
-@item C-x @key{RET} c @var{coding} @key{RET}
-Specify coding system @var{coding} for the immediately following
-command.
+subprocess input and output in the current buffer
+(@code{set-buffer-process-coding-system}).
@end table
@kindex C-x RET x
@@ -1133,9 +1137,10 @@ own buffer, and thus you can use this command to specify translation to
and from a particular subprocess by giving the command in the
corresponding buffer.
- You can also use @kbd{C-x @key{RET} c} just before the command that
-runs or starts a subprocess, to specify the coding system to use for
-communication with that subprocess.
+ You can also use @kbd{C-x @key{RET} c}
+(@code{universal-coding-system-argument}) just before the command that
+runs or starts a subprocess, to specify the coding system for
+communicating with that subprocess. @xref{Text Coding}.
The default for translation of process input and output depends on the
current language environment.
@@ -1159,7 +1164,7 @@ 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}.
+@emph{names} (@code{set-file-name-coding-system}).
@end table
@vindex file-name-coding-system
@@ -1204,10 +1209,12 @@ system, and the coding system to which you wish to convert.
@table @kbd
@item C-x @key{RET} k @var{coding} @key{RET}
-Use coding system @var{coding} for keyboard input.
+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.
+Use coding system @var{coding} for terminal output
+(@code{set-terminal-coding-system}).
@end table
@kindex C-x RET t
@@ -1468,18 +1475,22 @@ examples are:
@example
;; Use Liberation Mono for latin-3 charset.
-(set-fontset-font "fontset-default" 'iso-8859-3 "Liberation Mono")
+(set-fontset-font "fontset-default" 'iso-8859-3
+ "Liberation Mono")
;; Prefer a big5 font for han characters
-(set-fontset-font "fontset-default" 'han (font-spec :registry "big5")
+(set-fontset-font "fontset-default"
+ 'han (font-spec :registry "big5")
nil 'prepend)
-;; Use DejaVu Sans Mono as a fallback in fontset-startup before
-;; resorting to fontset-default.
-(set-fontset-font "fontset-startup" nil "DejaVu Sans Mono" nil 'append)
+;; Use DejaVu Sans Mono as a fallback in fontset-startup
+;; before resorting to fontset-default.
+(set-fontset-font "fontset-startup" nil "DejaVu Sans Mono"
+ nil 'append)
;; Use MyPrivateFont for the Unicode private use area.
-(set-fontset-font "fontset-default" '(#xe000 . #xf8ff) "MyPrivateFont")
+(set-fontset-font "fontset-default" '(#xe000 . #xf8ff)
+ "MyPrivateFont")
@end example
@@ -1644,9 +1655,9 @@ name, and displays information about that charset, including its
internal representation within Emacs.
@findex list-character-sets
- To display a list of all supported charsets, type @kbd{M-x
-list-character-sets}. The list gives the names of charsets and
-additional information to identity each charset (see
+ @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,
charsets are divided into two categories: @dfn{normal charsets} are
listed first, followed by @dfn{supplementary charsets}. A
diff --git a/doc/emacs/picture-xtra.texi b/doc/emacs/picture-xtra.texi
index 7e72fb0acb6..0dcfc7a9627 100644
--- a/doc/emacs/picture-xtra.texi
+++ b/doc/emacs/picture-xtra.texi
@@ -245,7 +245,8 @@ rectangle commands may also be useful.
@table @kbd
@item C-c C-k
Clear out the region-rectangle with spaces
-(@code{picture-clear-rectangle}). With argument, delete the text.
+(@code{picture-clear-rectangle}). With a prefix argument, delete the
+text.
@item C-c C-w @var{r}
Similar, but save rectangle contents in register @var{r} first
(@code{picture-clear-rectangle-to-register}).
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 5b7322f214b..870986d421a 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -608,7 +608,9 @@ example,
@example
(setq c-default-style
- '((java-mode . "java") (awk-mode . "awk") (other . "gnu")))
+ '((java-mode . "java")
+ (awk-mode . "awk")
+ (other . "gnu")))
@end example
@noindent
@@ -641,8 +643,9 @@ balanced.
When talking about these facilities, the term ``parenthesis'' also
includes braces, brackets, or whatever delimiters are defined to match
in pairs. The major mode controls which delimiters are significant,
-through the syntax table (@pxref{Syntax}). In Lisp, only parentheses
-count; in C, these commands apply to braces and brackets too.
+through the syntax table (@pxref{Syntax Tables,, Syntax Tables, elisp,
+The Emacs Lisp Reference Manual}). In Lisp, only parentheses count;
+in C, these commands apply to braces and brackets too.
You can use @kbd{M-x check-parens} to find any unbalanced
parentheses and unbalanced string quotes in the buffer.
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index 42ce85c7ee1..b4b9fd252e1 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -35,16 +35,16 @@ Bookmarks are similar enough in spirit to registers that they
seem to belong in this chapter.
@menu
-* Position: RegPos. Saving positions in registers.
-* Text: RegText. Saving text in registers.
-* Rectangle: RegRect. Saving rectangles in registers.
-* Configurations: RegConfig. Saving window configurations in registers.
-* Numbers: RegNumbers. Numbers in registers.
-* Files: RegFiles. File names in registers.
-* Bookmarks:: Bookmarks are like registers, but persistent.
+* Position Registers:: Saving positions in registers.
+* Text Registers:: Saving text in registers.
+* Rectangle Registers:: Saving rectangles in registers.
+* Configuration Registers:: Saving window configurations in registers.
+* Number Registers:: Numbers in registers.
+* File Registers:: File names in registers.
+* Bookmarks:: Bookmarks are like registers, but persistent.
@end menu
-@node RegPos
+@node Position Registers
@section Saving Positions in Registers
@cindex saving position in a register
@@ -76,7 +76,7 @@ was saved from has been killed, @kbd{C-x r j} tries to create the buffer
again by visiting the same file. Of course, this works only for buffers
that were visiting files.
-@node RegText
+@node Text Registers
@section Saving Text in Registers
@cindex saving text in a register
@@ -123,7 +123,7 @@ the region text to the text in the register instead of
after, but with a numeric argument (@kbd{C-u}) it puts point after the
text and the mark before.
-@node RegRect
+@node Rectangle Registers
@section Saving Rectangles in Registers
@cindex saving rectangle in a register
@@ -150,7 +150,7 @@ one.
See also the command @code{sort-columns}, which you can think of
as sorting a rectangle. @xref{Sorting}.
-@node RegConfig
+@node Configuration Registers
@section Saving Window Configurations in Registers
@cindex saving window configuration in a register
@@ -178,7 +178,7 @@ restore a frame configuration, any existing frames not included in the
configuration become invisible. If you wish to delete these frames
instead, use @kbd{C-u C-x r j @var{r}}.
-@node RegNumbers
+@node Number Registers
@section Keeping Numbers in Registers
@cindex saving number in a register
@@ -205,7 +205,7 @@ register contents into the buffer. @kbd{C-x r +} with no numeric
argument increments the register value by 1; @kbd{C-x r n} with no
numeric argument stores zero in the register.
-@node RegFiles
+@node File Registers
@section Keeping File Names in Registers
@cindex saving file name in a register
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 7a5a734443c..ad22ae921e0 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -620,13 +620,13 @@ are three ways to use the labels: in moving, in summaries, and in sorting.
@kindex C-M-p @r{(Rmail)}
@findex rmail-next-labeled-message
@findex rmail-previous-labeled-message
- The command @kbd{C-M-n @var{labels} @key{RET}}
+ @kbd{C-M-n @var{labels} @key{RET}}
(@code{rmail-next-labeled-message}) moves to the next message that has
-one of the labels @var{labels}. The argument @var{labels} specifies one
-or more label names, separated by commas. @kbd{C-M-p}
-(@code{rmail-previous-labeled-message}) is similar, but moves backwards
-to previous messages. A numeric argument to either command serves as a
-repeat count.
+one of the labels @var{labels}. The argument @var{labels} specifies
+one or more label names, separated by commas. @kbd{C-M-p}
+(@code{rmail-previous-labeled-message}) is similar, but moves
+backwards to previous messages. A numeric argument to either command
+serves as a repeat count.
The command @kbd{C-M-l @var{labels} @key{RET}}
(@code{rmail-summary-by-labels}) displays a summary containing only the
diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi
index 0bc3ce3db8c..59f65fac8af 100644
--- a/doc/emacs/screen.texi
+++ b/doc/emacs/screen.texi
@@ -73,14 +73,14 @@ different places in the buffer; for example, you can place point by
clicking mouse button 1 (normally the left button) at the desired
location.
- While the cursor appears to be @emph{on} a character, you should
-think of point as @emph{between} two characters; it points @emph{before}
-the character that appears under the cursor. For example, if your text
-looks like @samp{frob} with the cursor over the @samp{b}, then point is
-between the @samp{o} and the @samp{b}. If you insert the character
-@samp{!} at that position, the result is @samp{fro!b}, with point
-between the @samp{!} and the @samp{b}. Thus, the cursor remains over
-the @samp{b}, as before.
+ If you use a block cursor, the cursor appears to be @emph{on} a
+character, but you should think of point as @emph{between} two
+characters; it points @emph{before} the character that appears under
+the cursor. For example, if your text looks like @samp{frob} with the
+cursor over the @samp{b}, then point is between the @samp{o} and the
+@samp{b}. If you insert the character @samp{!} at that position, the
+result is @samp{fro!b}, with point between the @samp{!} and the
+@samp{b}. Thus, the cursor remains over the @samp{b}, as before.
Sometimes people speak of ``the cursor'' when they mean ``point,'' or
speak of commands that move point as ``cursor motion'' commands.
@@ -92,12 +92,14 @@ it again later. When Emacs displays multiple windows, each window has
its own point location. If the same buffer appears in more than one
window, each window has its own point position in that buffer.
- On a graphical display, Emacs shows a cursor in each window; the
-selected window's cursor is solid and blinking, and the other cursors
-are hollow. On a text-only terminal, there is just one cursor, in the
-selected window; even though the unselected windows have their own
-point positions, they do not display a cursor. @xref{Cursor Display},
-for customizable variables that control cursor display.
+ On a graphical display, Emacs shows a cursor in each window. The
+selected window's cursor will be blinking. If you use the default,
+@code{box} cursor type, the selected window's cursor will be solid,
+and the other cursors are hollow. On a text-only terminal, there is
+just one cursor, in the selected window; even though the unselected
+windows have their own point positions, they do not display a cursor.
+@xref{Cursor Display}, for customizable variables that control cursor
+display.
@node Echo Area
@section The Echo Area
@@ -190,7 +192,7 @@ sometimes useful to have this information.
Systems}). If it is a dash (@samp{-}), that indicates the default
state of affairs: no special character set handling, except for the
end-of-line translations described in the next paragraph. @samp{=}
-means no conversion whatsoever. Letters represent various nontrivial
+means no conversion whatsoever. Characters represent various nontrivial
@dfn{coding systems}---for example, @samp{1} represents ISO Latin-1.
On a text-only terminal, @var{cs} is preceded by two additional
characters that describe the coding system for keyboard input and the
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index b5d426210aa..015f9529b73 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -870,8 +870,9 @@ matches at the end of the buffer only if the contents end with a
word-constituent character.
@item \w
-matches any word-constituent character. The syntax table
-determines which characters these are. @xref{Syntax}.
+matches any word-constituent character. The syntax table determines
+which characters these are. @xref{Syntax Tables,, Syntax Tables,
+elisp, The Emacs Lisp Reference Manual}.
@item \W
matches any character that is not a word-constituent.
@@ -892,7 +893,8 @@ symbol-constituent character.
matches any character whose syntax is @var{c}. Here @var{c} is a
character that designates a particular syntax class: thus, @samp{w}
for word constituent, @samp{-} or @samp{ } for whitespace, @samp{.}
-for ordinary punctuation, etc. @xref{Syntax}.
+for ordinary punctuation, etc. @xref{Syntax Tables,, Syntax Tables,
+elisp, The Emacs Lisp Reference Manual}.
@item \S@var{c}
matches any character whose syntax is not @var{c}.
@@ -911,8 +913,9 @@ matches any character that does @emph{not} belong to category
@var{c}.
@end table
- The constructs that pertain to words and syntax are controlled by the
-setting of the syntax table (@pxref{Syntax}).
+ The constructs that pertain to words and syntax are controlled by
+the setting of the syntax table. @xref{Syntax Tables,, Syntax Tables,
+elisp, The Emacs Lisp Reference Manual}.
@node Regexp Example
@section Regular Expression Example
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 48f3bd15587..e3f5c05d8da 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -154,9 +154,10 @@ the mark by one additional word. @kbd{M-@@} also accepts a numeric
argument that says how many words to scan for the place to put the
mark.
- The word commands' understanding of word boundaries is controlled
-by the syntax table. Any character can, for example, be declared to
-be a word delimiter. @xref{Syntax}.
+ The word commands' understanding of word boundaries is controlled by
+the syntax table. Any character can, for example, be declared to be a
+word delimiter. @xref{Syntax Tables,, Syntax Tables, elisp, The Emacs
+Lisp Reference Manual}.
@node Sentences
@section Sentences
@@ -406,8 +407,6 @@ Text}).
* Fill Commands:: Commands to refill paragraphs and center lines.
* Fill Prefix:: Filling paragraphs that are indented or in a comment, etc.
* Adaptive Fill:: How Emacs can determine the fill prefix automatically.
-* Refill:: Keeping paragraphs filled.
-* Longlines:: Editing text with very long lines.
@end menu
@node Auto Fill
@@ -722,92 +721,6 @@ line, and it should return the appropriate fill prefix based on that
line. If it returns @code{nil}, @code{adaptive-fill-regexp} gets
a chance to find a prefix.
-@node Refill
-@subsection Refill Mode
-@cindex refilling text, word processor style
-@cindex modes, Refill
-@cindex Refill minor mode
-
- Refill minor mode provides support for keeping paragraphs filled as
-you type or modify them in other ways. It provides an effect similar
-to typical word processor behavior. This works by running a
-paragraph-filling command at suitable times.
-
- To toggle the use of Refill mode in the current buffer, type
-@kbd{M-x refill-mode}. When you are typing text, only characters
-which normally trigger auto filling, like the space character, will
-trigger refilling. This is to avoid making it too slow. Apart from
-self-inserting characters, other commands which modify the text cause
-refilling.
-
- The current implementation is preliminary and not robust. You can
-get better ``line wrapping'' behavior using Longlines mode.
-@xref{Longlines}. However, Longlines mode has an important
-side-effect: the newlines that it inserts for you are not saved to
-disk, so the files that you make with Longlines mode will appear to be
-completely unfilled if you edit them without Longlines mode.
-
-@node Longlines
-@subsection Long Lines Mode
-@cindex refilling text, word processor style
-@cindex modes, Long Lines
-@cindex word wrap
-@cindex Long Lines minor mode
-
- Sometimes, you may come across ``unfilled'' text files, which Emacs
-normally displays as a bunch of extremely long lines. Comfortably
-reading and editing such files normally requires ``word wrap'', a
-feature that breaks up each long text line into multiple screen lines
-in a readable manner---by putting the breaks at word boundaries. Many
-text editors, such as those built into many web browsers, perform word
-wrapping by default.
-
- There are two different minor modes in Emacs that perform word
-wrapping. The first is Visual Line mode, which does it by altering
-the behavior of screen line continuation. @xref{Visual Line Mode},
-for information about Visual Line mode.
-
-@findex longlines-mode
- Instead of using Visual Line mode, you can use a minor mode called
-Long Lines mode. Long Lines mode wraps lines by inserting or deleting
-@dfn{soft newlines} as you type (@pxref{Hard and Soft Newlines}).
-These soft newlines won't show up when you save the buffer into a
-file, or when you copy the text into the kill ring, clipboard, or a
-register. Unlike Visual Line mode, Lone Lines mode breaks long lines
-at the fill column (@pxref{Fill Commands}), rather than the right
-window edge. To enable Long Lines mode, type @kbd{M-x
-longlines-mode}. If the text is full of long lines, this also
-immediately ``wraps'' them all.
-
-@findex longlines-auto-wrap
- The word wrap performed by Long Lines mode is @emph{not} the same as
-ordinary filling (@pxref{Fill Commands}). It does not contract
-multiple spaces into a single space, recognize fill prefixes
-(@pxref{Fill Prefix}), or perform adaptive filling (@pxref{Adaptive
-Fill}). The reason for this is that a wrapped line is still,
-conceptually, a single line. Each soft newline is equivalent to
-exactly one space in that long line, and vice versa. However, you can
-still call filling functions such as @kbd{M-q}, and these will work as
-expected, inserting soft newlines that won't show up on disk or when
-the text is copied. You can even rely entirely on the normal fill
-commands by turning off automatic line wrapping, with @kbd{C-u M-x
-longlines-auto-wrap}. To turn automatic line wrapping back on, type
-@kbd{M-x longlines-auto-wrap}.
-
-@findex longlines-show-hard-newlines
- Type @kbd{RET} to insert a hard newline, one which automatic
-refilling will not remove. If you want to see where all the hard
-newlines are, type @kbd{M-x longlines-show-hard-newlines}. This will
-mark each hard newline with a special symbol. The same command with a
-prefix argument turns this display off.
-
- Long Lines mode does not change normal text files that are already
-filled, since the existing newlines are considered hard newlines.
-Before Long Lines can do anything, you need to transform each
-paragraph into a long line. One way is to set @code{fill-column} to a
-large number (e.g., @kbd{C-u 9999 C-x f}), re-fill all the paragraphs,
-and then set @code{fill-column} back to its original value.
-
@node Case
@section Case Conversion Commands
@cindex case conversion
@@ -2593,16 +2506,16 @@ Recognize tables within the current region and activate them.
Deactivate tables within the current region.
@findex table-recognize-table
@item M-x table-recognize-table
-Recognize the table under point and activate it.
+Recognize the table at point and activate it.
@findex table-unrecognize-table
@item M-x table-unrecognize-table
-Deactivate the table under point.
+Deactivate the table at point.
@findex table-recognize-cell
@item M-x table-recognize-cell
-Recognize the cell under point and activate it.
+Recognize the cell at point and activate it.
@findex table-unrecognize-cell
@item M-x table-unrecognize-cell
-Deactivate the cell under point.
+Deactivate the cell at point.
@end table
For another way of converting text into tables, see @ref{Table
@@ -2809,20 +2722,20 @@ following three paragraphs (the latter two are indented with header
lines):
@example
-@samp{table-capture} is a powerful command, but mastering its
-power requires some practice. Here are some things it can do:
-
-Parse Cell Items By using column delimiter regular
- expression and raw delimiter regular
- expression, it parses the specified text
- area and extracts cell items from
- non-table text and then forms a table out
- of them.
-
-Capture Text Area When no delimiters are specified it
- creates a single cell table. The text in
- the specified region is placed in that
- cell.
+table-capture is a powerful command.
+Here are some things it can do:
+
+Parse Cell Items By using column delimiter regular
+ expression and raw delimiter regular
+ expression, it parses the specified text
+ area and extracts cell items from
+ non-table text and then forms a table out
+ of them.
+
+Capture Text Area When no delimiters are specified it
+ creates a single cell table. The text in
+ the specified region is placed in that
+ cell.
@end example
@noindent
@@ -2836,22 +2749,22 @@ following one.
@c produced output!!
@smallexample
@group
-+-----------------------------------------------------------------+
-|@samp{table-capture} is a powerful command, but mastering its |
-|power requires some practice. Here are some things it can do: |
-| |
-|Parse Cell Items By using column delimiter regular |
-| expression and raw delimiter regular |
-| expression, it parses the specified text |
-| area and extracts cell items from |
-| non-table text and then forms a table out |
-| of them. |
-| |
-|Capture Text Area When no delimiters are specified it |
-| creates a single cell table. The text in |
-| the specified region is placed in that |
-| cell. |
-+-----------------------------------------------------------------+
++-------------------------------------------------------------+
+|table-capture is a powerful command. |
+|Here are some things it can do: |
+| |
+|Parse Cell Items By using column delimiter regular |
+| expression and raw delimiter regular |
+| expression, it parses the specified text |
+| area and extracts cell items from |
+| non-table text and then forms a table out |
+| of them. |
+| |
+|Capture Text Area When no delimiters are specified it |
+| creates a single cell table. The text in |
+| the specified region is placed in that |
+| cell. |
++-------------------------------------------------------------+
@end group
@end smallexample
@@ -2861,22 +2774,22 @@ paragraphs occupying its own cell. Each cell can now be edited
independently without affecting the layout of other cells.
@smallexample
-+-----------------------------------------------------------------+
-|@samp{table-capture} is a powerful command, but mastering its |
-|power requires some practice. Here are some things it can do: |
-+---------------------+-------------------------------------------+
-|Parse Cell Items |By using column delimiter regular |
-| |expression and raw delimiter regular |
-| |expression, it parses the specified text |
-| |area and extracts cell items from |
-| |non-table text and then forms a table out |
-| |of them. |
-+---------------------+-------------------------------------------+
-|Capture Text Area |When no delimiters are specified it |
-| |creates a single cell table. The text in |
-| |the specified region is placed in that |
-| |cell. |
-+---------------------+-------------------------------------------+
++--------------------------------------------------------------+
+|table-capture is a powerful command. |
+|Here are some things it can do: |
++------------------+-------------------------------------------+
+|Parse Cell Items |By using column delimiter regular |
+| |expression and raw delimiter regular |
+| |expression, it parses the specified text |
+| |area and extracts cell items from |
+| |non-table text and then forms a table out |
+| |of them. |
++------------------+-------------------------------------------+
+|Capture Text Area |When no delimiters are specified it |
+| |creates a single cell table. The text in |
+| |the specified region is placed in that |
+| |cell. |
++------------------+-------------------------------------------+
@end smallexample
@noindent
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index a2b9b16bae6..28c0285cf03 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -443,8 +443,7 @@ problems, , Bugs and problems, efaq, GNU Emacs FAQ}.
@item
The @samp{bug-gnu-emacs} mailing list (also available as the newsgroup
-@samp{gnu.emacs.bug}). This is where you will find most Emacs bug
-reports. You can read the list archives at
+@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
@@ -454,10 +453,10 @@ this.
@item
The bug tracker at @url{http://debbugs.gnu.org}. From early 2008,
-reports from the @samp{bug-gnu-emacs} list have 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.
+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.
@item
The @samp{emacs-pretest-bug} mailing list. This list is no longer
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index ae9b69ef3f4..6aa8a06778b 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -343,10 +343,10 @@ to an adjacent window. The minimum size is specified by the variables
@kindex C-x -
@findex shrink-window-if-larger-than-buffer
- The command @kbd{C-x -} (@code{shrink-window-if-larger-than-buffer})
-reduces the height of the selected window, if it is taller than
-necessary to show the whole text of the buffer it is displaying. It
-gives the extra lines to other windows in the frame.
+ @kbd{C-x -} (@code{shrink-window-if-larger-than-buffer}) reduces the
+height of the selected window, if it is taller than necessary to show
+the whole text of the buffer it is displaying. It gives the extra
+lines to other windows in the frame.
@kindex C-x +
@findex balance-windows
diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi
index 33ea83d7d6e..d30f7e42254 100644
--- a/doc/emacs/xresources.texi
+++ b/doc/emacs/xresources.texi
@@ -451,13 +451,6 @@ fonts. For more information about fontsets see the man page for
@code{font} and @code{fontSet} resources are specified, the
@code{fontSet} resource is used.
- Thus, to specify @samp{-*-helvetica-medium-r-*--*-120-*-*-*-*-*-*,*}
-for both the popup and menu bar menus, write this:
-
-@example
-Emacs*menu*fontSet: -*-helvetica-medium-r-*--*-120-*-*-*-*-*-*,*
-@end example
-
@noindent
Resources for @emph{non-menubar} toolkit pop-up menus have
@samp{menu*} instead of @samp{pane.menubar}. For example, to specify
@@ -474,15 +467,6 @@ For dialog boxes, use @samp{dialog*}:
Emacs.dialog*.font: Sans-12
@end example
-@noindent
-The @samp{*menu*} as a wildcard matches @samp{pane.menubar} and
-@samp{menu@dots{}}.
-
-Experience shows that on some systems you may need to add
-@samp{shell.}@: before the @samp{pane.menubar} or @samp{menu*}. On
-some other systems, you must not add @samp{shell.}. The generic wildcard
-approach should work on both kinds of systems.
-
Here is a list of the specific resources for menu bars and pop-up menus:
@table @code
@@ -677,10 +661,10 @@ to courier with size 12:
gtk-font-name = "courier 12"
@end smallexample
- The thing to note is that the font name is not an X font name, like
--*-helvetica-medium-r-*--*-120-*-*-*-*-*-*, 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:
+ 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:
@smallexample
gtk-font-name = "helvetica bold 10"
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 636054972af..153d7e839c3 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,9 +1,262 @@
-2011-07-02 Eli Zaretskii <eliz@gnu.org>
+2011-07-14 Eli Zaretskii <eliz@gnu.org>
* display.texi (Other Display Specs): Document that `left-fringe'
and `right-fringe' display specifications are of the "replacing"
kind.
+2011-07-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * help.texi (Documentation Basics): Add a link to the Function
+ Documentation node (bug#6580).
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * keymaps.texi (Menu Bar): Mention :visible and :enable
+ (bug#6344). Text by Drew Adams.
+
+ * modes.texi (Running Hooks): Mention buffer-local hook variables
+ (bug#6218).
+
+ * objects.texi (General Escape Syntax): "a with grave accent" is
+ ?xe0, not ?x8e0 (bug#5259).
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * display.texi (Face Attributes, Font Selection): Add references
+ to the Fonts node in the Emacs manual (Bug#4178).
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * display.texi (Window Systems): `window-system' is
+ terminal-local.
+
+ * frames.texi (Frame Parameters, Parameter Access): Don't mention
+ frame-local variables.
+
+ * variables.texi (Buffer-Local Variables): Don't mention obsolete
+ frame-local variables.
+ (Frame-Local Variables): Node deleted.
+
+ * elisp.texi (Top): Update node listing.
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * elisp.texi: Change "inferiors" to "subnodes" in three places
+ (bug#3523).
+
+2011-07-11 Chong Yidong <cyd@stupidchicken.com>
+
+ * frames.texi (Window System Selections): Discussion of
+ x-select-enable-clipboard moved to Emacs manual.
+
+2011-07-11 Deniz Dogan <deniz@dogan.se>
+
+ * commands.texi (Prefix Command Arguments): Remove excessive
+ apostrophe.
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * syntax.texi (Syntax Descriptors): Clarify that the ". 23" syntax
+ description is a string (bug#3313).
+
+ * frames.texi (Display Feature Testing): Try to explain what all
+ the visual classes mean (bug#3042).
+
+2011-07-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * modes.texi (Mode Line Variables): Document `mode-line-remote'
+ and `mode-line-client' (bug#2974).
+
+ * text.texi (Insertion): Clarify marker movements (bug#1651).
+ Text from Drew Adams.
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * text.texi (Special Properties): Clarify the format of `face'
+ (bug#1375).
+
+ * commands.texi (Interactive Call): Add a `call-interactively'
+ example (bug#1010).
+
+2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * functions.texi (Calling Functions): Link to the "Interactive
+ Call" node (bug#1001).
+
+2011-07-06 Chong Yidong <cyd@stupidchicken.com>
+
+ * customize.texi (Composite Types): Move alist and plist to here
+ from Simple Types (Bug#7545).
+
+ * elisp.texi (Top): Update menu description.
+
+ * display.texi (Face Attributes): Document negative line widths
+ (Bug#6113).
+
+2011-07-03 Tobias C. Rittweiler <tcr@freebits.de> (tiny change)
+
+ * searching.texi (Match Data): Note that match data can be
+ overwritten by most functions (bug#2499).
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * strings.texi (Formatting Strings): Clarify what the "-" and "0"
+ flags mean (bug#6659).
+
+ * functions.texi (What Is a Function): Document the autoload
+ object (bug#6496).
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * customize.texi (Variable Definitions): Clarify that SETFUNCTION
+ is only used in the Customize user interface (bug#6089).
+
+ * display.texi (Showing Images): Mention the point of sliced
+ images (bug#7836).
+
+2011-07-02 Eli Zaretskii <eliz@gnu.org>
+
+ * variables.texi (Defining Variables, Void Variables)
+ (Constant Variables): Fix incorrect usage of @kindex.
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * variables.texi (Defining Variables): Add an index entry for
+ `set-variable' (bug#7262).
+ (Defining Variables): Use @findex for functions.
+
+ * frames.texi (Basic Parameters): Document the `explicit-name'
+ parameter (bug#6951).
+
+ * customize.texi (Type Keywords): Clarify that :value provides a
+ default value for all types (bug#7386).
+
+ * streams.texi (Output Functions): Document `pp'.
+
+2011-06-25 Chong Yidong <cyd@stupidchicken.com>
+
+ * keymaps.texi (Searching Keymaps):
+ * display.texi (Overlay Properties): Fix errors in 2011-05-29
+ change. Suggested by Johan Bockgård.
+
+2011-06-15 Chong Yidong <cyd@stupidchicken.com>
+
+ * text.texi (Special Properties): Clarify role of font-lock-face.
+
+2011-06-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * processes.texi (Process Information): Renamed `process-alive-p'
+ to `process-live-p' for consistency with other `-live-p' functions.
+
+2011-06-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Document wide integers better.
+ * files.texi (File Attributes): Document ino_t values better.
+ ino_t values no longer map to anything larger than a single cons.
+ * numbers.texi (Integer Basics, Integer Basics, Arithmetic Operations):
+ (Bitwise Operations):
+ * objects.texi (Integer Type): Use a binary notation that is a bit easier
+ to read, and that will port better if 62-bits becomes the default.
+ Fix or remove incorrect examples.
+ * os.texi (Time Conversion): Document time_t values better.
+
+2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * processes.texi (Process Information): Document
+ `process-alive-p'.
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * help.texi (Accessing Documentation):
+ * display.texi (Pixel Specification):
+ * processes.texi (Serial Ports, Serial Ports):
+ * nonascii.texi (Character Properties, Default Coding Systems):
+ * text.texi (Changing Properties, Special Properties):
+ * windows.texi (Window Start and End):
+ * modes.texi (SMIE Indentation Example, SMIE Tricks):
+ * keymaps.texi (Searching Keymaps, Tool Bar):
+ * minibuf.texi (Basic Completion):
+ * compile.texi (Eval During Compile):
+ * strings.texi (Formatting Strings): Tweaks to avoid overflowing
+ 7x9 paper in printed manual.
+
+ * lists.texi (Sets And Lists): Fix misplaced text.
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * keymaps.texi (Remapping Commands): Emphasize that the keymap
+ needs to be active (Bug#8350).
+
+2011-05-28 Chong Yidong <cyd@stupidchicken.com>
+
+ * minibuf.texi (Reading File Names): Clarify (Bug#8480).
+
+ * tips.texi (Coding Conventions): Remove antediluvian filename
+ limit recommendation (Bug#8538).
+
+2011-05-27 Glenn Morris <rgm@gnu.org>
+
+ * modes.texi (Auto Major Mode): Update for set-auto-mode changes.
+
+2011-05-26 Glenn Morris <rgm@gnu.org>
+
+ * variables.texi (File Local Variables):
+ Update hack-local-variables `mode-only' return value.
+ Add some more details on what this function does in the other case.
+
+2011-05-19 Glenn Morris <rgm@gnu.org>
+
+ * lists.texi (Sets And Lists): Mention cl provides union etc.
+
+2011-05-19 Nix <nix@esperi.org.uk>
+
+ * windows.texi (Displaying Buffers): pop-to-buffer is not a command.
+
+ * text.texi (Parsing HTML): Update for function name changes.
+
+ * syntax.texi (Syntax Flags): Small fix.
+
+ * keymaps.texi (Active Keymaps): Typo fix.
+ (Changing Key Bindings): Grammar fix.
+
+ * frames.texi (Minibuffers and Frames): Grammar fix.
+ (Window System Selections): x-select-enable-clipboard now defaults to t.
+
+ * customize.texi (Common Keywords):
+ * display.texi (Abstract Display):
+ * modes.texi (Auto-Indentation):
+ * nonascii.texi (Converting Representations): Typo fixes.
+
+ * control.texi (Examples of Catch): Call it "goto" not "go to".
+
+2011-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ * nonascii.texi (Character Properties): Fix inconsistencies with
+ implementation.
+
+ * text.texi (Special Properties): Move @defvar's out of the
+ @table. (Bug#8652)
+
+2011-05-12 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (Image Descriptors): Fix typo. (Bug#8495)
+
+2011-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * modes.texi (Region to Refontify): Rename from "Region to Fontify".
+ (Multiline Font Lock):
+ * vol2.texi (Top):
+ * vol1.texi (Top):
+ * elisp.texi (Top): Update menu accordingly.
+
+2011-05-12 Drew Adams <drew.adams@oracle.com>
+
+ * modes.texi (Region to Fontify): Fix typo.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ * minibuf.texi: Fix typo "in in -> in".
+
2011-05-06 Paul Eggert <eggert@cs.ucla.edu>
* numbers.texi (Integer Basics): Large integers are treated as floats.
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index eb42ddb11a4..e76b2bafd79 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -597,13 +597,32 @@ realistic example of using @code{commandp}.
@defun call-interactively command &optional record-flag keys
This function calls the interactively callable function @var{command},
-reading arguments according to its interactive calling specifications.
-It returns whatever @var{command} returns. An error is signaled if
-@var{command} is not a function or if it cannot be called
-interactively (i.e., is not a command). Note that keyboard macros
-(strings and vectors) are not accepted, even though they are
-considered commands, because they are not functions. If @var{command}
-is a symbol, then @code{call-interactively} uses its function definition.
+providing arguments according to its interactive calling specifications.
+It returns whatever @var{command} returns.
+
+If, for instance, you have a function with the following signature:
+
+@example
+(defun foo (begin end)
+ (interactive "r")
+ ...)
+@end example
+
+then saying
+
+@example
+(call-interactively 'foo)
+@end example
+
+will call @code{foo} with the region (@code{point} and @code{mark}) as
+the arguments.
+
+An error is signaled if @var{command} is not a function or if it
+cannot be called interactively (i.e., is not a command). Note that
+keyboard macros (strings and vectors) are not accepted, even though
+they are considered commands, because they are not functions. If
+@var{command} is a symbol, then @code{call-interactively} uses its
+function definition.
@cindex record command history
If @var{record-flag} is non-@code{nil}, then this command and its
@@ -2993,7 +3012,7 @@ An integer, which stands for itself.
@item
A list of one element, which is an integer. This form of prefix
-argument results from one or a succession of @kbd{C-u}'s with no
+argument results from one or a succession of @kbd{C-u}s with no
digits. The numeric value is the integer in the list, but some
commands make a distinction between such a list and an integer alone.
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index f9f0e6662cf..fe5563370c4 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -445,7 +445,7 @@ used to load it for compiling, but not executing. For example,
@lisp
(eval-when-compile
- (require 'my-macro-package)) ;; only macros needed from this
+ (require 'my-macro-package))
@end lisp
The same sort of thing goes for macros and @code{defsubst} functions
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index b6fdb9dbcbd..875c23658b9 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -623,7 +623,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 ``go to.'')
+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:
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 2f1ea055f82..868edaa5bd4 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -174,7 +174,7 @@ For example, the MH-E package updates this alist with the following:
The value of @var{package} needs to be unique and it needs to match
the @var{package} value appearing in the @code{:package-version}
-keyword. Since the user might see the value in a error message, a good
+keyword. Since the user might see the value in an error message, a good
choice is the official name of the package, such as MH-E or Gnus.
@end defvar
@@ -326,11 +326,12 @@ 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. 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}.
+option when using the Customize user 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}.
@item :get @var{getfunction}
@kindex get@r{, @code{defcustom} keyword}
@@ -512,8 +513,7 @@ equivalent to @code{(string)}.
Introduction, widget, The Emacs Widget Library}, for details.
@menu
-* Simple Types:: Simple customization types: sexp, integer, number,
- string, file, directory, alist.
+* Simple Types:: Simple customization types: sexp, integer, etc.
* 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.
@@ -576,22 +576,103 @@ 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}.
-@item alist
-The value must be a list of cons-cells, the @sc{car} of each cell
-representing a key, and the @sc{cdr} of the same cell representing an
-associated value. The user can add and delete key/value pairs, and
-edit both the key and the value of each pair.
+@item symbol
+The value must be a symbol. It appears in the customization buffer as
+the name of the symbol.
-You can specify the key and value types like this:
+@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}}.
-@smallexample
-(alist :key-type @var{key-type} :value-type @var{value-type})
-@end smallexample
+@item variable
+The value must be a variable name, and you can do completion with
+@kbd{M-@key{TAB}}.
+
+@item face
+The value must be a symbol which is a face name, and you can do
+completion with @kbd{M-@key{TAB}}.
+
+@item boolean
+The value is boolean---either @code{nil} or @code{t}. Note that by
+using @code{choice} and @code{const} together (see the next section),
+you can specify that the value must be @code{nil} or @code{t}, but also
+specify the text to describe each value in a way that fits the specific
+meaning of the alternative.
+
+@item coding-system
+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.
+@end table
+
+@node Composite Types
+@subsection Composite Types
+@cindex composite types (customization)
+
+ When none of the simple types is appropriate, you can use composite
+types, which build new types from other types or from specified data.
+The specified types or data are called the @dfn{arguments} of the
+composite type. The composite type normally looks like this:
+
+@example
+(@var{constructor} @var{arguments}@dots{})
+@end example
@noindent
-where @var{key-type} and @var{value-type} are customization type
-specifications. The default key type is @code{sexp}, and the default
-value type is @code{sexp}.
+but you can also add keyword-value pairs before the arguments, like
+this:
+
+@example
+(@var{constructor} @r{@{}@var{keyword} @var{value}@r{@}}@dots{} @var{arguments}@dots{})
+@end example
+
+ Here is a table of constructors and how to use them to write
+composite types:
+
+@table @code
+@item (cons @var{car-type} @var{cdr-type})
+The value must be a cons cell, its @sc{car} must fit @var{car-type}, and
+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.
+
+@item (list @var{element-types}@dots{})
+The value must be a list with exactly as many elements as the
+@var{element-types} given; and each element must fit the
+corresponding @var{element-type}.
+
+For example, @code{(list integer string function)} describes a list of
+three elements; the first element must be an integer, the second a
+string, and the third a function.
+
+In the customization buffer, each element is displayed and edited
+separately, according to the type specified for it.
+
+@item (group @var{element-types}@dots{})
+This works like @code{list} except for the formatting
+of text in the Custom buffer. @code{list} labels each
+element value with its tag; @code{group} does not.
+
+@item (vector @var{element-types}@dots{})
+Like @code{list} except that the value must be a vector instead of a
+list. The elements work the same as in @code{list}.
+
+@item (alist :key-type @var{key-type} :value-type @var{value-type})
+The value must be a list of cons-cells, the @sc{car} of each cell
+representing a key of customization type @var{key-type}, and the
+@sc{cdr} of the same cell representing a value of customization type
+@var{value-type}. The user can add and delete key/value pairs, and
+edit both the key and the value of each pair.
+
+If omitted, @var{key-type} and @var{value-type} default to
+@code{sexp}.
The user can add any key matching the specified key type, but you can
give some keys a preferential treatment by specifying them with the
@@ -686,105 +767,11 @@ and the VALUE is a list of that person's pets."
:type '(alist :value-type (repeat string)))
@end smallexample
-@item plist
-The @code{plist} custom type is similar to the @code{alist} (see above),
-except that the information is stored as a property list, i.e. a list of
-this form:
-
-@smallexample
-(@var{key} @var{value} @var{key} @var{value} @var{key} @var{value} @dots{})
-@end smallexample
-
-The default @code{:key-type} for @code{plist} is @code{symbol},
-rather than @code{sexp}.
-
-@item symbol
-The value must be a symbol. It appears in the customization buffer as
-the name of the symbol.
-
-@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}}.
-
-@item variable
-The value must be a variable name, and you can do completion with
-@kbd{M-@key{TAB}}.
-
-@item face
-The value must be a symbol which is a face name, and you can do
-completion with @kbd{M-@key{TAB}}.
-
-@item boolean
-The value is boolean---either @code{nil} or @code{t}. Note that by
-using @code{choice} and @code{const} together (see the next section),
-you can specify that the value must be @code{nil} or @code{t}, but also
-specify the text to describe each value in a way that fits the specific
-meaning of the alternative.
-
-@item coding-system
-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.
-@end table
-
-@node Composite Types
-@subsection Composite Types
-@cindex composite types (customization)
-
- When none of the simple types is appropriate, you can use composite
-types, which build new types from other types or from specified data.
-The specified types or data are called the @dfn{arguments} of the
-composite type. The composite type normally looks like this:
-
-@example
-(@var{constructor} @var{arguments}@dots{})
-@end example
-
-@noindent
-but you can also add keyword-value pairs before the arguments, like
-this:
-
-@example
-(@var{constructor} @r{@{}@var{keyword} @var{value}@r{@}}@dots{} @var{arguments}@dots{})
-@end example
-
- Here is a table of constructors and how to use them to write
-composite types:
-
-@table @code
-@item (cons @var{car-type} @var{cdr-type})
-The value must be a cons cell, its @sc{car} must fit @var{car-type}, and
-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.
-
-@item (list @var{element-types}@dots{})
-The value must be a list with exactly as many elements as the
-@var{element-types} given; and each element must fit the
-corresponding @var{element-type}.
-
-For example, @code{(list integer string function)} describes a list of
-three elements; the first element must be an integer, the second a
-string, and the third a function.
-
-In the customization buffer, each element is displayed and edited
-separately, according to the type specified for it.
-
-@item (group @var{element-types}@dots{})
-This works like @code{list} except for the formatting
-of text in the Custom buffer. @code{list} labels each
-element value with its tag; @code{group} does not.
-
-@item (vector @var{element-types}@dots{})
-Like @code{list} except that the value must be a vector instead of a
-list. The elements work the same as in @code{list}.
+@item (plist :key-type @var{key-type} :value-type @var{value-type})
+This customization type is similar to @code{alist} (see above), except
+that (i) the information is stored as a property list,
+(@pxref{Property Lists}), and (ii) @var{key-type}, if omitted,
+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}.
@@ -1035,7 +1022,12 @@ meanings:
@table @code
@item :value @var{default}
-This is used for a type that appears as an alternative inside of
+Provide a default value.
+
+If @code{nil} is not a valid value for the alternative, then it is
+essential to specify a valid default with @code{:value}.
+
+If you use this for a type that appears as an alternative inside of
@code{choice}; it specifies the default value to use, at first, if and
when the user selects this alternative with the menu in the
customization buffer.
@@ -1043,9 +1035,6 @@ customization buffer.
Of course, if the actual value of the option fits this alternative, it
will appear showing the actual value, not @var{default}.
-If @code{nil} is not a valid value for the alternative, then it is
-essential to specify a valid default with @code{:value}.
-
@item :format @var{format-string}
@kindex format@r{, customization keyword}
This string will be inserted in the buffer to represent the value
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 6c5c8caa233..d8be424a69f 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1441,9 +1441,9 @@ specify a particular attribute for certain text. @xref{Face
Attributes}.
@item
-A cons cell, either of the form @code{(foreground-color . @var{color-name})} or
-@code{(background-color . @var{color-name})}. These elements specify
-just the foreground color or just the background color.
+A cons cell, of the form @code{(foreground-color . @var{color-name})}
+or @code{(background-color . @var{color-name})}. These elements
+specify just the foreground color or just the background color.
@code{(foreground-color . @var{color-name})} has the same effect as
@code{(:foreground @var{color-name})}; likewise for the background.
@@ -1800,9 +1800,9 @@ height.
@cindex faces
A @dfn{face} is a collection of graphical attributes for displaying
-text: font family, 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.
+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.
@@ -2001,16 +2001,17 @@ attribute is ignored.
@table @code
@item :family
-Font family name or fontset name (a string). 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.
+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.
@item :foundry
-The name of the @dfn{font foundry} in which the font family specified
-by the @code{:family} attribute is located (a string). The wild-card
-characters @samp{*} and @samp{?} are allowed.
+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}.
@item :width
Relative proportionate character width, also known as the character
@@ -2092,7 +2093,10 @@ Draw a box with lines of width 1, in color @var{color}.
@item @code{(:line-width @var{width} :color @var{color} :style @var{style})}
This way you can explicitly specify all aspects of the box. The value
-@var{width} specifies the width of the lines to draw; it defaults to 1.
+@var{width} specifies the width of the lines to draw; it defaults to
+1. A negative width @var{-n} means to draw a line of width @var{n}
+that occupies the space of the underlying text, thus avoiding any
+increase in the character height or width.
The value @var{color} specifies the color to draw with. The default is
the foreground color of the face for simple boxes, and the background
@@ -2681,14 +2685,15 @@ usually assign faces to around 400 to 600 characters at each call.
Before Emacs can draw a character on a particular 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}).}. Normally, Emacs automatically chooses a font based on the
-faces assigned to that character---specifically, the face attributes
-@code{:family}, @code{:weight}, @code{:slant}, and @code{:width}
-(@pxref{Face Attributes}). The choice of font also depends on the
-character to be displayed; some fonts can only display a limited set
-of characters. If no available font exactly fits the requirements,
-Emacs looks for the @dfn{closest matching font}. The variables in
-this section control how Emacs makes this selection.
+Mode}).}. @xref{Fonts,,, emacs, The GNU Emacs Manual}. Normally,
+Emacs automatically chooses a font based on the faces assigned to that
+character---specifically, the face attributes @code{:family},
+@code{:weight}, @code{:slant}, and @code{:width} (@pxref{Face
+Attributes}). The choice of font also depends on the character to be
+displayed; some fonts can only display a limited set of characters.
+If no available font exactly fits the requirements, Emacs looks for
+the @dfn{closest matching font}. The variables in this section
+control how Emacs makes this selection.
@defopt face-font-family-alternatives
If a given family is specified but does not exist, this variable
@@ -3821,9 +3826,10 @@ pixels per inch, millimeter, and centimeter, respectively. The
and height of the current face. An image specification @code{image}
corresponds to the width or height of the image.
- The @code{left-fringe}, @code{right-fringe}, @code{left-margin},
-@code{right-margin}, @code{scroll-bar}, and @code{text} elements
-specify to the width of the corresponding area of the window.
+ The elements @code{left-fringe}, @code{right-fringe},
+@code{left-margin}, @code{right-margin}, @code{scroll-bar}, and
+@code{text} specify to the width of the corresponding area of the
+window.
The @code{left}, @code{center}, and @code{right} positions can be
used with @code{:align-to} to specify a position relative to the left
@@ -4214,14 +4220,14 @@ Laplace edge-detection currently uses a matrix of
@tex
$$\pmatrix{1 & 0 & 0 \cr
0& 0 & 0 \cr
- 9 & 9 & -1 \cr}$$
+ 0 & 0 & -1 \cr}$$
@end tex
@end iftex
@ifnottex
@display
(1 0 0
0 0 0
- 9 9 -1)
+ 0 0 -1)
@end display
@end ifnottex
@@ -4653,16 +4659,14 @@ If @var{no-error} is non-@code{nil} and a suitable path can't be
found, don't signal an error. Instead, return a list of directories as
before, except that @code{nil} appears in place of the image directory.
-Here is an example that uses a common idiom to provide compatibility
-with versions of Emacs that lack the variable @code{image-load-path}:
+Here is an example of using @code{image-load-path-for-library}:
@example
(defvar image-load-path) ; shush compiler
(let* ((load-path (image-load-path-for-library
- "mh-e" "mh-logo.xpm"))
+ "mh-e" "mh-logo.xpm"))
(image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
+ image-load-path)))
(mh-tool-bar-folder-buttons-init))
@end example
@end defun
@@ -4702,10 +4706,17 @@ it a @code{display} property which specifies @var{image}. @xref{Display
Property}.
@end defun
+@cindex slice, image
+@cindex image slice
@defun insert-sliced-image image &optional string area rows cols
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.
@end defun
@defun put-image image pos &optional string area
@@ -5202,7 +5213,7 @@ element value into the current buffer.
Typically, you define an ewoc with @code{ewoc-create}, and then pass
the resulting ewoc structure to other functions in the Ewoc package to
build nodes within it, and display it in the buffer. Once it is
-displayed in the buffer, other functions determine the correspondance
+displayed in the buffer, other functions determine the correspondence
between buffer positions and nodes, move point from one node's textual
representation to another, and so forth. @xref{Abstract Display
Functions}.
@@ -5400,8 +5411,10 @@ value) in various ways.
(aref colorcomp-data 2)))
(samp " (sample text) "))
(insert "Color\t: "
- (propertize samp 'face `(foreground-color . ,cstr))
- (propertize samp 'face `(background-color . ,cstr))
+ (propertize samp 'face
+ `(foreground-color . ,cstr))
+ (propertize samp 'face
+ `(background-color . ,cstr))
"\n"))))
(defun colorcomp (color)
@@ -5900,8 +5913,8 @@ 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.
@defvar window-system
-This frame-local variable tells Lisp programs what window system Emacs is using
-for displaying the frame. The possible values are
+This terminal-local variable tells Lisp programs what window system
+Emacs is using for displaying the frame. The possible values are
@table @code
@item x
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 69c50ba42be..bb05f1b4a0b 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -14,7 +14,7 @@
@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 set smallbook
+@c @smallbook
@ifset smallbook
@smallbook
@@ -193,7 +193,7 @@ Appendices
--- The Detailed Node Listing ---
---------------------------------
-Here are other nodes that are inferiors of those already listed,
+Here are other nodes that are subnodes of those already listed,
mentioned here so you can get to them in one step:
Introduction
@@ -430,7 +430,6 @@ Variables
* 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.
@@ -508,8 +507,7 @@ Writing Customization Definitions
Customization Types
-* Simple Types:: Simple customization types: sexp, integer, number,
- string, file, directory, alist.
+* Simple Types:: Simple customization types: sexp, integer, etc.
* 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.
@@ -828,7 +826,7 @@ Font Lock Mode
Multiline Font Lock Constructs
* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Fontify:: Controlling which region gets refontified
+* Region to Refontify:: Controlling which region gets refontified
after a buffer change.
Documentation
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index e3bdebd28a1..4d992bd2c51 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -251,7 +251,7 @@ literally, i.e. without conversions of any kind. The command
@code{find-file-literally} sets this variable's local value, but other
equivalent functions and commands can do that as well, e.g.@: to avoid
automatic addition of a newline at the end of the file. This variable
-us permanent local, so it is unaffected by changes of major modes.
+is permanent local, so it is unaffected by changes of major modes.
@end defvar
@node Subroutines of Visiting
@@ -1237,11 +1237,12 @@ deleted and recreated; @code{nil} otherwise.
@item
The file's inode number. If possible, this is an integer. If the
inode number is too large to be represented as an integer in Emacs
-Lisp, but still fits into a 32-bit integer, then the value has the
+Lisp but dividing it by @math{2^16} yields a representable integer,
+then the value has the
form @code{(@var{high} . @var{low})}, where @var{low} holds the low 16
-bits. If the inode is wider than 32 bits, the value is of the form
+bits. If the inode number is too wide for even that, the value is of the form
@code{(@var{high} @var{middle} . @var{low})}, where @code{high} holds
-the high 24 bits, @var{middle} the next 24 bits, and @var{low} the low
+the high bits, @var{middle} the middle 24 bits, and @var{low} the low
16 bits.
@item
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 06c120cc09d..b6012a4dd53 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -337,9 +337,6 @@ parameters @code{foreground-color}, @code{background-color},
If the terminal supports frame transparency, the parameter
@code{alpha} is also meaningful.
- You can use frame parameters to define frame-local bindings for
-variables. @xref{Frame-Local Variables}.
-
@menu
* Parameter Access:: How to change a frame's parameters.
* Initial Parameters:: Specifying frame parameters when you make a frame.
@@ -374,9 +371,6 @@ elements of @var{alist}. Each element of @var{alist} has the form
parameter. If you don't mention a parameter in @var{alist}, its value
doesn't change. If @var{frame} is @code{nil}, it defaults to the selected
frame.
-
-You can use this function to define frame-local bindings for
-variables, see @ref{Frame-Local Variables}.
@end defun
@defun set-frame-parameter frame parm value
@@ -520,6 +514,11 @@ you don't specify a name, Emacs sets the frame name automatically
If you specify the frame name explicitly when you create the frame, the
name is also used (instead of the name of the Emacs executable) when
looking up X resources for the frame.
+
+@item explicit-name
+If the frame name was specified explicitly when the frame was created,
+this parameter will be that name. If the frame wasn't explicitly
+named, this parameter will be @code{nil}.
@end table
@node Position Parameters
@@ -1368,7 +1367,7 @@ minibuffer-window}).
However, you can also create a frame with no minibuffer. Such a frame
must use the minibuffer window of some other frame. When you create the
-frame, you can specify explicitly the minibuffer window to use (in some
+frame, you can explicitly specify the minibuffer window to use (in some
other frame). If you don't, then the minibuffer is found in the frame
which is the value of the variable @code{default-minibuffer-frame}. Its
value should be a frame that does have a minibuffer.
@@ -1954,30 +1953,34 @@ defined in the file @file{lisp/term/x-win.el}. Use @kbd{M-x apropos
@node Window System Selections
@section Window System Selections
@cindex selection (for window systems)
-
-The X server records a set of @dfn{selections} which permit transfer of
-data between application programs. The various selections are
-distinguished by @dfn{selection types}, represented in Emacs by
-symbols. X clients including Emacs can read or set the selection for
-any given type.
+@cindex clipboard
+@cindex primary selection
+@cindex secondary selection
+
+ In the X window system, data can be transferred between different
+applications by means of @dfn{selections}. X defines an arbitrary
+number of @dfn{selection types}, each of which can store its own data;
+however, only three are commonly used: the @dfn{clipboard},
+@dfn{primary selection}, and @dfn{secondary selection}. @xref{Cut and
+Paste,, Cut and Paste, emacs, The GNU Emacs Manual}, for Emacs
+commands that make use of these selections. This section documents
+the low-level functions for reading and setting X selections.
@deffn Command x-set-selection type data
-This function sets a ``selection'' in the X server. It takes two
-arguments: a selection type @var{type}, and the value to assign to it,
-@var{data}. If @var{data} is @code{nil}, it means to clear out the
-selection. Otherwise, @var{data} may be a string, a symbol, an integer
-(or a cons of two integers or list of two integers), an overlay, or a
-cons of two markers pointing to the same buffer. An overlay or a pair
-of markers stands for text in the overlay or between the markers.
-
-The argument @var{data} may also be a vector of valid non-vector
-selection values.
-
-Each possible @var{type} has its own selection value, which changes
-independently. The usual values of @var{type} are @code{PRIMARY},
-@code{SECONDARY} and @code{CLIPBOARD}; these are symbols with upper-case
-names, in accord with X Window System conventions. If @var{type} is
-@code{nil}, that stands for @code{PRIMARY}.
+This function sets an X selection. It takes two arguments: a
+selection type @var{type}, and the value to assign to it, @var{data}.
+
+@var{type} should be a symbol; it is usually one of @code{PRIMARY},
+@code{SECONDARY} or @code{CLIPBOARD}. These are symbols with
+upper-case names, in accord with X Window System conventions. If
+@var{type} is @code{nil}, that stands for @code{PRIMARY}.
+
+If @var{data} is @code{nil}, it means to clear out the selection.
+Otherwise, @var{data} may be a string, a symbol, an integer (or a cons
+of two integers or list of two integers), an overlay, or a cons of two
+markers pointing to the same buffer. An overlay or a pair of markers
+stands for text in the overlay or between the markers. The argument
+@var{data} may also be a vector of valid non-vector selection values.
This function returns @var{data}.
@end deffn
@@ -2014,14 +2017,6 @@ and @code{x-set-selection} on MS-Windows support the text data type
only; if the clipboard holds other types of data, Emacs treats the
clipboard as empty.
-@defopt x-select-enable-clipboard
-If this is non-@code{nil}, the Emacs yank functions consult the
-clipboard before the primary selection, and the kill functions store in
-the clipboard as well as the primary selection. Otherwise they do not
-access the clipboard at all. The default is @code{nil} on most systems,
-but @code{t} on MS-Windows.
-@end defopt
-
@node Drag and Drop
@section Drag and Drop
@@ -2441,10 +2436,13 @@ For a tty display, it is log to base two of the number of colors supported.
@end defun
@defun display-visual-class &optional display
-This function returns the visual class for the screen. The value is one
-of the symbols @code{static-gray}, @code{gray-scale},
-@code{static-color}, @code{pseudo-color}, @code{true-color}, and
-@code{direct-color}.
+This function returns the visual class for the screen. The value is
+one of the symbols @code{static-gray} (a limited, unchangeable number
+of grays), @code{gray-scale} (a full range of grays),
+@code{static-color} (a limited, unchangeable number of colors),
+@code{pseudo-color} (a limited number of colors), @code{true-color} (a
+full range of colors), and @code{direct-color} (a full range of
+colors).
@end defun
@defun display-color-cells &optional display
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 974487382c8..f3b2375b61d 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -112,6 +112,13 @@ editors; for Lisp programs, the distinction is normally unimportant.
@item byte-code function
A @dfn{byte-code function} is 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.
@end table
@defun functionp object
@@ -783,6 +790,12 @@ 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.
+
@node Mapping Functions
@section Mapping Functions
@cindex mapping functions
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index e287e6fbad4..0ce05d55a07 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -78,11 +78,12 @@ function or variable that it describes:
@item
@kindex function-documentation
The documentation for a function is usually stored in the function
-definition itself (@pxref{Lambda Expressions}). 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.
+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.
@item
@kindex variable-documentation
@@ -138,9 +139,9 @@ unless @var{verbatim} is non-@code{nil}.
@end defun
@defun documentation function &optional verbatim
-This function returns the documentation string of @var{function}.
-@code{documentation} handles macros, named keyboard macros, and
-special forms, as well as ordinary functions.
+This function returns the documentation string of @var{function}. It
+handles macros, named keyboard macros, and special forms, as well as
+ordinary functions.
If @var{function} is a symbol, this function first looks for the
@code{function-documentation} property of that symbol; if that has a
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 2648c22ca01..15b2f2079ba 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -686,7 +686,7 @@ bindings, as in @code{lookup-key} (@pxref{Functions for Key Lookup}).
When commands are remapped (@pxref{Remapping Commands}),
@code{key-binding} normally processes command remappings so as to
-returns the remapped command that will actually be executed. However,
+return the remapped command that will actually be executed. However,
if @var{no-remap} is non-@code{nil}, @code{key-binding} ignores
remappings and returns the binding directly specified for @var{key}.
@@ -718,17 +718,18 @@ pseudo-Lisp description of the order and conditions for searching
them:
@lisp
-(or (if overriding-terminal-local-map
- (@var{find-in} overriding-terminal-local-map)
- (if 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))))))
+(or (cond
+ (overriding-terminal-local-map
+ (@var{find-in} overriding-terminal-local-map))
+ (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} (current-global-map)))
@end lisp
@@ -1239,7 +1240,7 @@ local map, that usually affects all buffers using the same major mode.
The @code{global-set-key} and @code{local-set-key} functions are
convenient interfaces for these operations (@pxref{Key Binding
Commands}). You can also use @code{define-key}, a more general
-function; then you must specify explicitly the map to change.
+function; then you must explicitly specify the map to change.
When choosing the key sequences for Lisp programs to rebind, please
follow the Emacs conventions for use of various keys (@pxref{Key
@@ -1468,33 +1469,33 @@ Dired mode is set up:
@section Remapping Commands
@cindex remapping commands
- A special kind of key binding, using a special ``key sequence''
-which includes a command name, has the effect of @dfn{remapping} that
-command into another. Here's how it works. You make a key binding
-for a key sequence that starts with the dummy event @code{remap},
-followed by the command name you want to remap. Specify the remapped
-definition as the definition in this binding. The remapped definition
-is usually a command name, but it can be any valid definition for
-a key binding.
+ A special kind of key binding can be used to @dfn{remap} one command
+to another, without having to refer to the key sequence(s) bound to
+the original command. To use this feature, make a key binding for a
+key sequence that starts with the dummy event @code{remap}, followed
+by the command name you want to remap; for the binding, specify the
+new definition (usually a command name, but possibly any other valid
+definition for a key binding).
- Here's an example. Suppose that My mode uses special commands
-@code{my-kill-line} and @code{my-kill-word}, which should be invoked
-instead of @code{kill-line} and @code{kill-word}. It can establish
-this by making these two command-remapping bindings in its keymap:
+ For example, suppose My mode provides a special command
+@code{my-kill-line}, which should be invoked instead of
+@code{kill-line}. To establish this, its mode keymap should contain
+the following remapping:
@smallexample
(define-key my-mode-map [remap kill-line] 'my-kill-line)
-(define-key my-mode-map [remap kill-word] 'my-kill-word)
@end smallexample
-Whenever @code{my-mode-map} is an active keymap, if the user types
-@kbd{C-k}, Emacs will find the standard global binding of
-@code{kill-line} (assuming nobody has changed it). But
-@code{my-mode-map} remaps @code{kill-line} to @code{my-kill-line},
-so instead of running @code{kill-line}, Emacs runs
-@code{my-kill-line}.
+@noindent
+Then, whenever @code{my-mode-map} is active, if the user types
+@kbd{C-k} (the default global key sequence for @code{kill-line}) Emacs
+will instead run @code{my-kill-line}.
-Remapping only works through a single level. In other words,
+ Note that remapping only takes place through active keymaps; for
+example, putting a remapping in a prefix keymap like @code{ctl-x-map}
+typically has no effect, as such keymaps are not themselves active.
+In addition, remapping only works through a single level; in the
+following example,
@smallexample
(define-key my-mode-map [remap kill-line] 'my-kill-line)
@@ -1502,11 +1503,10 @@ Remapping only works through a single level. In other words,
@end smallexample
@noindent
-does not have the effect of remapping @code{kill-line} into
-@code{my-other-kill-line}. If an ordinary key binding specifies
-@code{kill-line}, this keymap will remap it to @code{my-kill-line};
-if an ordinary binding specifies @code{my-kill-line}, this keymap will
-remap it to @code{my-other-kill-line}.
+@code{kill-line} is @emph{not} remapped to @code{my-other-kill-line}.
+Instead, if an ordinary key binding specifies @code{kill-line}, it is
+remapped to @code{my-kill-line}; if an ordinary binding specifies
+@code{my-kill-line}, it is remapped to @code{my-other-kill-line}.
To undo the remapping of a command, remap it to @code{nil}; e.g.
@@ -2262,6 +2262,17 @@ the double-dash and replacing each single dash with capitalization of
the following word. Thus, @code{"--:singleLine"}, is equivalent to
@code{"--single-line"}.
+ You can use a longer form to specify keywords such as @code{:enable}
+and @code{:visible} for a menu separator:
+
+@code{(menu-item @var{separator-type} nil . @var{item-property-list})}
+
+For example:
+
+@example
+(menu-item "--" nil :visible (boundp 'foo))
+@end example
+
Some systems and display toolkits don't really handle all of these
separator types. If you use a type that isn't supported, the menu
displays a similar kind of separator that is supported.
@@ -2636,8 +2647,8 @@ using an indirection through @code{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 "tool bar" ignore
+ :filter (lambda (ignore) tool-bar-map)))
@end example
@noindent
Thus the tool bar map is derived dynamically from the value of variable
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index fa3fac814c1..064be89632f 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1266,9 +1266,9 @@ functions for sets include @code{memq} and @code{delq}, and their
@cindex CL note---lack @code{union}, @code{intersection}
@quotation
@b{Common Lisp note:} Common Lisp has functions @code{union} (which
-avoids duplicate elements) and @code{intersection} for set operations,
-but GNU Emacs Lisp does not have them. You can write them in Lisp if
-you wish.
+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}.
@end quotation
@defun memq object list
@@ -1355,10 +1355,10 @@ and the @code{(4)} in the @code{sample-list} are not @code{eq}:
(delq '(4) sample-list)
@result{} (a c (4))
@end group
+@end example
If you want to delete elements that are @code{equal} to a given value,
use @code{delete} (see below).
-@end example
@defun remq object list
This function returns a copy of @var{list}, with all elements removed
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index acc68b0aafa..aa22e6c92ff 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -837,12 +837,13 @@ variable as ``risky'' with a non-@code{nil}
@code{risky-local-variable} property. @xref{File Local Variables}.
@defvar completion-ignore-case
-If the value of this variable is non-@code{nil}, Emacs does not
-consider case significant in completion. Note, however, that this
-variable is overridden by @code{read-file-name-completion-ignore-case}
-within @code{read-file-name} (@pxref{Reading File Names}), and by
-@code{read-buffer-completion-ignore-case} within @code{read-buffer}
-(@pxref{High-Level Completion}).
+If the value of this variable is non-@code{nil}, case is not
+considered significant in completion. Within @code{read-file-name},
+this variable is overridden by
+@code{read-file-name-completion-ignore-case} (@pxref{Reading File
+Names}); within @code{read-buffer}, it is overridden by
+@code{read-buffer-completion-ignore-case} (@pxref{High-Level
+Completion}).
@end defvar
@defvar completion-regexp-list
@@ -1383,17 +1384,19 @@ 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.
-The optional argument @var{require-match} has the same meaning as in
-@code{completing-read}. @xref{Minibuffer Completion}.
+@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.
-@code{read-file-name} uses
-@code{minibuffer-local-filename-completion-map} as the keymap if
-@var{require-match} is @code{nil}, and uses
-@code{minibuffer-local-filename-must-match-map} if @var{require-match}
-is non-@code{nil}. @xref{Completion Commands}.
+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}.
The argument @var{directory} specifies the directory to use for
-completion of relative file names. It should be an absolute directory
+completing relative file names. It should be an absolute directory
name. If @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}.
@@ -1441,11 +1444,7 @@ argument that decides which file names are acceptable completion
possibilities. A file name is an acceptable value if @var{predicate}
returns non-@code{nil} for it.
-@code{read-file-name} does not automatically expand file names. You
-must call @code{expand-file-name} yourself if an absolute file name is
-required.
-
-Here is an example:
+Here is an example of using @code{read-file-name}:
@example
@group
@@ -1691,7 +1690,7 @@ match for some possibility; @code{nil} otherwise.
@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
+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.
@end itemize
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index f0a8985fa75..dd3b2e3038f 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -101,6 +101,11 @@ one, with no arguments.
The hook variable's value can also be a single function---either a
lambda expression or a symbol with a function definition---which
@code{run-hooks} calls. But this usage is obsolete.
+
+If the hook variable is buffer-local, the buffer-local variable will
+be used instead of the global variable. However, if the buffer-local
+variable contains the element @code{t}, the global hook variable will
+be run as well.
@end defun
@defun run-hook-with-args hook &rest args
@@ -169,11 +174,11 @@ function goes at the end of the hook list and will be executed last.
value is a single function; it sets or changes the value to a list of
functions.
-If @var{local} is non-@code{nil}, that says to add @var{function} to
-the buffer-local hook list instead of to the global hook list. If
-needed, this makes the hook buffer-local and adds @code{t} to the
-buffer-local value. The latter acts as a flag to run the hook
-functions in the default value as well as in the local value.
+If @var{local} is non-@code{nil}, that says to add @var{function} to the
+buffer-local hook list instead of to the global hook list. This makes
+the hook buffer-local and adds @code{t} to the buffer-local value. The
+latter acts as a flag to run the hook functions in the default value as
+well as in the local value.
@end defun
@defun remove-hook hook function &optional local
@@ -583,12 +588,9 @@ If you run @code{normal-mode} interactively, the argument
@var{find-file} is normally @code{nil}. In this case,
@code{normal-mode} unconditionally processes any file local variables.
-If @code{normal-mode} processes the local variables list and this list
-specifies a major mode, that mode overrides any mode chosen by
-@code{set-auto-mode}. If neither @code{set-auto-mode} nor
-@code{hack-local-variables} specify a major mode, the buffer stays in
-the major mode determined by the default value of @code{major-mode}
-(see below).
+The function calls @code{set-auto-mode} to choose a major mode. If this
+does not specify a mode, the buffer stays in the major mode determined
+by the default value of @code{major-mode} (see below).
@cindex file mode specification error
@code{normal-mode} uses @code{condition-case} around the call to the
@@ -600,15 +602,15 @@ mode specification error}, followed by the original error message.
@cindex visited file mode
This function selects the major mode that is appropriate for the
current buffer. It bases its decision (in order of precedence) on
-the @w{@samp{-*-}} line, on the @w{@samp{#!}} line (using
+the @w{@samp{-*-}} line, on any @samp{mode:} local variable near the
+end of a file, on the @w{@samp{#!}} line (using
@code{interpreter-mode-alist}), on the text at the beginning of the
buffer (using @code{magic-mode-alist}), and finally on the visited
file name (using @code{auto-mode-alist}). @xref{Choosing Modes, , How
-Major Modes are Chosen, emacs, The GNU Emacs Manual}. However, this
-function does not look for the @samp{mode:} local variable near the
-end of a file; the @code{hack-local-variables} function does that.
+Major Modes are 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 for a mode tag either.
+does not check the @w{@samp{-*-}} line, or near the end of the file,
+for any mode tag.
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
@@ -1049,8 +1051,8 @@ Turning on text-mode runs the hook `text-mode-hook'."
@end group
@group
;; @r{These four lines are absent from the current version}
- ;; @r{not because this is done some other way, but rather}
- ;; @r{because nowadays Text mode uses the normal definition of paragraphs.}
+ ;; @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)
@@ -1142,12 +1144,15 @@ modes should understand the Lisp conventions for comments. The rest of
@smallexample
@group
- (set (make-local-variable 'paragraph-start) (concat page-delimiter "\\|$" ))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
+ (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))
+ (set (make-local-variable 'comment-indent-function)
+ 'lisp-comment-indent))
@dots{}
@end group
@end smallexample
@@ -1866,6 +1871,15 @@ 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
+This variable is used to show whether @code{default-directory} for the
+current buffer is remote.
+@end defopt
+
+@defopt mode-line-client
+This variable is used to identify @code{emacsclient} frames.
+@end defopt
+
The following three variables are used in @code{mode-line-modes}:
@defvar mode-name
@@ -3174,7 +3188,7 @@ subsequent lines.
@menu
* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Fontify:: Controlling which region gets refontified
+* Region to Refontify:: Controlling which region gets refontified
after a buffer change.
@end menu
@@ -3226,7 +3240,7 @@ place the @code{font-lock-multiline} property on the text before
Font-Lock looks at it, or use
@code{font-lock-fontify-region-function}.
-@node Region to Fontify
+@node Region to Refontify
@subsubsection Region to Fontify after a Buffer Change
When a buffer is changed, the region that Font Lock refontifies is
@@ -3235,15 +3249,15 @@ While this works well most of the time, sometimes it doesn't---for
example, when a change alters the syntactic meaning of text on an
earlier line.
- You can enlarge (or even reduce) the region to fontify by setting
-one the following variables:
+ You can enlarge (or even reduce) the region to refontify by setting
+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.
The function is given three parameters, the standard @var{beg},
-@var{end}, and @var{old-len} from after-change-functions
+@var{end}, and @var{old-len} from @code{after-change-functions}
(@pxref{Change Hooks}). It should return either a cons of the
beginning and end buffer positions (in that order) of the region to
fontify, or @code{nil} (which means choose the region in the standard
@@ -3256,7 +3270,7 @@ reasonably fast.
@end defvar
@node Auto-Indentation
-@section Auto-indention of code
+@section Auto-indentation of code
For programming languages, an important feature of a major mode is to
provide automatic indentation. This is controlled in Emacs by
@@ -3622,7 +3636,9 @@ natural to have a BNF grammar that looks like this:
(inst ("IF" exp "THEN" insts "ELSE" insts "END")
("CASE" exp "OF" cases "END")
...)
- (cases (cases "|" cases) (caselabel ":" insts) ("ELSE" insts))
+ (cases (cases "|" cases)
+ (caselabel ":" insts)
+ ("ELSE" insts))
...
@end example
@@ -3897,9 +3913,10 @@ and is always at the beginning of a line, we can use a more efficient
rule:
@example
((equal token "if")
- (and (not (smie-rule-bolp)) (smie-rule-prev-p "else")
+ (and (not (smie-rule-bolp))
+ (smie-rule-prev-p "else")
(save-excursion
- (sample-smie-backward-token) ;Jump before the "else".
+ (sample-smie-backward-token)
(cons 'column (current-column)))))
@end example
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index 6fcde611998..77337899923 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -201,7 +201,7 @@ characters.
@defun byte-to-string byte
@cindex byte to string
This function returns a unibyte string containing a single byte of
-character data, @var{character}. It signals a error if
+character data, @var{character}. It signals an error if
@var{character} is not an integer between 0 and 255.
@end defun
@@ -374,18 +374,18 @@ properties that Emacs knows about:
@table @code
@item name
-This property corresponds to the Unicode @code{Name} property. The
-value is a string consisting of upper-case Latin letters A to Z,
-digits, spaces, and hyphen @samp{-} characters.
+Corresponds to the @code{Name} Unicode property. The value is a
+string consisting of upper-case Latin letters A to Z, digits, spaces,
+and hyphen @samp{-} characters.
@cindex unicode general category
@item general-category
-This property corresponds to the Unicode @code{General_Category}
-property. The value is a symbol whose name is a 2-letter abbreviation
-of the character's classification.
+Corresponds to the @code{General_Category} Unicode property. The
+value is a symbol whose name is a 2-letter abbreviation of the
+character's classification.
@item canonical-combining-class
-Corresponds to the Unicode @code{Canonical_Combining_Class} property.
+Corresponds to the @code{Canonical_Combining_Class} Unicode property.
The value is an integer number.
@item bidi-class
@@ -410,7 +410,7 @@ Corresponds to the Unicode @code{Numeric_Value} property for
characters whose @code{Numeric_Type} is @samp{Digit}. The value is an
integer number.
-@item digit
+@item digit-value
Corresponds to the Unicode @code{Numeric_Value} property for
characters whose @code{Numeric_Type} is @samp{Decimal}. The value is
an integer number. Examples of such characters include compatibility
@@ -466,16 +466,19 @@ This function returns the value of @var{char}'s @var{propname} property.
@result{} Nd
@end group
@group
-(get-char-code-property ?\u2084 'digit-value) ; subscript 4
+;; subscript 4
+(get-char-code-property ?\u2084 'digit-value)
@result{} 4
@end group
@group
-(get-char-code-property ?\u2155 'numeric-value) ; one fifth
- @result{} 1/5
+;; one fifth
+(get-char-code-property ?\u2155 'numeric-value)
+ @result{} 0.2
@end group
@group
-(get-char-code-property ?\u2163 'numeric-value) ; Roman IV
- @result{} \4
+;; Roman IV
+(get-char-code-property ?\u2163 'numeric-value)
+ @result{} 4
@end group
@end example
@end defun
@@ -1449,11 +1452,11 @@ for decoding (in case @var{operation} does decoding), and
@var{encoding-system} is the coding system for encoding (in case
@var{operation} does encoding).
-The argument @var{operation} is a symbol, one of @code{write-region},
-@code{start-process}, @code{call-process}, @code{call-process-region},
-@code{insert-file-contents}, or @code{open-network-stream}. These are
-the names of the Emacs I/O primitives that can do character code and
-eol conversion.
+The argument @var{operation} is a symbol; it should be one of
+@code{write-region}, @code{start-process}, @code{call-process},
+@code{call-process-region}, @code{insert-file-contents}, or
+@code{open-network-stream}. These are the names of the Emacs I/O
+primitives that can do character code and eol conversion.
The remaining arguments should be the same arguments that might be given
to the corresponding I/O primitive. Depending on the primitive, one
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 2c73a03a26c..65921f444e0 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -50,8 +50,9 @@ to
@tex
@math{2^{29}-1}),
@end tex
-but some machines may provide a wider range. Many examples in this
-chapter assume an integer has 30 bits.
+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.
@cindex overflow
The Lisp reader reads an integer as a sequence of digits with optional
@@ -97,17 +98,18 @@ view the numbers in their binary form.
In 30-bit binary, the decimal integer 5 looks like this:
@example
-00 0000 0000 0000 0000 0000 0000 0101
+0000...000101 (30 bits total)
@end example
@noindent
-(We have inserted spaces between groups of 4 bits, and two spaces
-between groups of 8 bits, to make the binary integer easier to read.)
+(The @samp{...} stands for enough bits to fill out a 30-bit word; in
+this case, @samp{...} stands for twenty 0 bits. Later examples also
+use the @samp{...} notation to make binary integers easier to read.)
The integer @minus{}1 looks like this:
@example
-11 1111 1111 1111 1111 1111 1111 1111
+1111...111111 (30 bits total)
@end example
@noindent
@@ -120,14 +122,14 @@ complement} notation.)
@minus{}5 looks like this:
@example
-11 1111 1111 1111 1111 1111 1111 1011
+1111...111011 (30 bits total)
@end example
In this implementation, the largest 30-bit binary integer value is
536,870,911 in decimal. In binary, it looks like this:
@example
-01 1111 1111 1111 1111 1111 1111 1111
+0111...111111 (30 bits total)
@end example
Since the arithmetic functions do not check whether integers go
@@ -137,7 +139,7 @@ negative integer @minus{}536,870,912:
@example
(+ 1 536870911)
@result{} -536870912
- @result{} 10 0000 0000 0000 0000 0000 0000 0000
+ @result{} 1000...000000 (30 bits total)
@end example
Many of the functions described in this chapter accept markers for
@@ -508,8 +510,8 @@ commonly used.
if any argument is floating.
It is important to note that in Emacs Lisp, arithmetic functions
-do not check for overflow. Thus @code{(1+ 268435455)} may evaluate to
-@minus{}268435456, depending on your hardware.
+do not check for overflow. Thus @code{(1+ 536870911)} may evaluate to
+@minus{}536870912, depending on your hardware.
@defun 1+ number-or-marker
This function returns @var{number-or-marker} plus 1.
@@ -829,19 +831,19 @@ value of a positive integer by two, rounding downward.
The function @code{lsh}, like all Emacs Lisp arithmetic functions, does
not check for overflow, so shifting left can discard significant bits
and change the sign of the number. For example, left shifting
-536,870,911 produces @minus{}2 on a 30-bit machine:
+536,870,911 produces @minus{}2 in the 30-bit implementation:
@example
(lsh 536870911 1) ; @r{left shift}
@result{} -2
@end example
-In binary, in the 30-bit implementation, the argument looks like this:
+In binary, the argument looks like this:
@example
@group
;; @r{Decimal 536,870,911}
-01 1111 1111 1111 1111 1111 1111 1111
+0111...111111 (30 bits total)
@end group
@end example
@@ -851,7 +853,7 @@ which becomes the following when left shifted:
@example
@group
;; @r{Decimal @minus{}2}
-11 1111 1111 1111 1111 1111 1111 1110
+1111...111110 (30 bits total)
@end group
@end example
@end defun
@@ -874,9 +876,9 @@ looks like this:
@group
(ash -6 -1) @result{} -3
;; @r{Decimal @minus{}6 becomes decimal @minus{}3.}
-11 1111 1111 1111 1111 1111 1111 1010
+1111...111010 (30 bits total)
@result{}
-11 1111 1111 1111 1111 1111 1111 1101
+1111...111101 (30 bits total)
@end group
@end example
@@ -887,9 +889,9 @@ In contrast, shifting the pattern of bits one place to the right with
@group
(lsh -6 -1) @result{} 536870909
;; @r{Decimal @minus{}6 becomes decimal 536,870,909.}
-11 1111 1111 1111 1111 1111 1111 1010
+1111...111010 (30 bits total)
@result{}
-01 1111 1111 1111 1111 1111 1111 1101
+0111...111101 (30 bits total)
@end group
@end example
@@ -899,34 +901,35 @@ Here are other examples:
@c with smallbook but not with regular book! --rjc 16mar92
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ 30-bit binary values}
-(lsh 5 2) ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
- @result{} 20 ; = @r{00 0000 0000 0000 0000 0000 0001 0100}
+(lsh 5 2) ; 5 = @r{0000...000101}
+ @result{} 20 ; = @r{0000...010100}
@end group
@group
(ash 5 2)
@result{} 20
-(lsh -5 2) ; -5 = @r{11 1111 1111 1111 1111 1111 1111 1011}
- @result{} -20 ; = @r{11 1111 1111 1111 1111 1111 1110 1100}
+(lsh -5 2) ; -5 = @r{1111...111011}
+ @result{} -20 ; = @r{1111...101100}
(ash -5 2)
@result{} -20
@end group
@group
-(lsh 5 -2) ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
- @result{} 1 ; = @r{00 0000 0000 0000 0000 0000 0000 0001}
+(lsh 5 -2) ; 5 = @r{0000...000101}
+ @result{} 1 ; = @r{0000...000001}
@end group
@group
(ash 5 -2)
@result{} 1
@end group
@group
-(lsh -5 -2) ; -5 = @r{11 1111 1111 1111 1111 1111 1111 1011}
- @result{} 268435454 ; = @r{00 0111 1111 1111 1111 1111 1111 1110}
+(lsh -5 -2) ; -5 = @r{1111...111011}
+ @result{} 268435454
+ ; = @r{0011...111110}
@end group
@group
-(ash -5 -2) ; -5 = @r{11 1111 1111 1111 1111 1111 1111 1011}
- @result{} -2 ; = @r{11 1111 1111 1111 1111 1111 1111 1110}
+(ash -5 -2) ; -5 = @r{1111...111011}
+ @result{} -2 ; = @r{1111...111110}
@end group
@end smallexample
@end defun
@@ -961,23 +964,23 @@ because its binary representation consists entirely of ones. If
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ 30-bit binary values}
-(logand 14 13) ; 14 = @r{00 0000 0000 0000 0000 0000 0000 1110}
- ; 13 = @r{00 0000 0000 0000 0000 0000 0000 1101}
- @result{} 12 ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100}
+(logand 14 13) ; 14 = @r{0000...001110}
+ ; 13 = @r{0000...001101}
+ @result{} 12 ; 12 = @r{0000...001100}
@end group
@group
-(logand 14 13 4) ; 14 = @r{00 0000 0000 0000 0000 0000 0000 1110}
- ; 13 = @r{00 0000 0000 0000 0000 0000 0000 1101}
- ; 4 = @r{00 0000 0000 0000 0000 0000 0000 0100}
- @result{} 4 ; 4 = @r{00 0000 0000 0000 0000 0000 0000 0100}
+(logand 14 13 4) ; 14 = @r{0000...001110}
+ ; 13 = @r{0000...001101}
+ ; 4 = @r{0000...000100}
+ @result{} 4 ; 4 = @r{0000...000100}
@end group
@group
(logand)
- @result{} -1 ; -1 = @r{11 1111 1111 1111 1111 1111 1111 1111}
+ @result{} -1 ; -1 = @r{1111...111111}
@end group
@end smallexample
@end defun
@@ -991,18 +994,18 @@ passed just one argument, it returns that argument.
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ 30-bit binary values}
-(logior 12 5) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100}
- ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
- @result{} 13 ; 13 = @r{00 0000 0000 0000 0000 0000 0000 1101}
+(logior 12 5) ; 12 = @r{0000...001100}
+ ; 5 = @r{0000...000101}
+ @result{} 13 ; 13 = @r{0000...001101}
@end group
@group
-(logior 12 5 7) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100}
- ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
- ; 7 = @r{00 0000 0000 0000 0000 0000 0000 0111}
- @result{} 15 ; 15 = @r{00 0000 0000 0000 0000 0000 0000 1111}
+(logior 12 5 7) ; 12 = @r{0000...001100}
+ ; 5 = @r{0000...000101}
+ ; 7 = @r{0000...000111}
+ @result{} 15 ; 15 = @r{0000...001111}
@end group
@end smallexample
@end defun
@@ -1016,18 +1019,18 @@ result is 0, which is an identity element for this operation. If
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ 30-bit binary values}
-(logxor 12 5) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100}
- ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
- @result{} 9 ; 9 = @r{00 0000 0000 0000 0000 0000 0000 1001}
+(logxor 12 5) ; 12 = @r{0000...001100}
+ ; 5 = @r{0000...000101}
+ @result{} 9 ; 9 = @r{0000...001001}
@end group
@group
-(logxor 12 5 7) ; 12 = @r{00 0000 0000 0000 0000 0000 0000 1100}
- ; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
- ; 7 = @r{00 0000 0000 0000 0000 0000 0000 0111}
- @result{} 14 ; 14 = @r{00 0000 0000 0000 0000 0000 0000 1110}
+(logxor 12 5 7) ; 12 = @r{0000...001100}
+ ; 5 = @r{0000...000101}
+ ; 7 = @r{0000...000111}
+ @result{} 14 ; 14 = @r{0000...001110}
@end group
@end smallexample
@end defun
@@ -1040,9 +1043,9 @@ bit is one in the result if, and only if, the @var{n}th bit is zero in
@example
(lognot 5)
@result{} -6
-;; 5 = @r{00 0000 0000 0000 0000 0000 0000 0101}
+;; 5 = @r{0000...000101} (30 bits total)
;; @r{becomes}
-;; -6 = @r{11 1111 1111 1111 1111 1111 1111 1010}
+;; -6 = @r{1111...111010} (30 bits total)
@end example
@end defun
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index c58d54f13fc..6d63bb7b750 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -179,10 +179,9 @@ to
@tex
@math{2^{29}-1})
@end tex
-on most machines. (Some machines may provide a wider range.) It is
-important to note that the Emacs Lisp arithmetic functions do not check
-for overflow. Thus @code{(1+ 536870911)} is @minus{}536870912 on most
-machines.
+on typical 32-bit machines. (Some machines provide a wider range.)
+Emacs Lisp arithmetic functions do not check for overflow. Thus
+@code{(1+ 536870911)} is @minus{}536870912 if Emacs integers are 30 bits.
The read syntax for integers is a sequence of (base ten) digits with an
optional sign at the beginning and an optional period at the end. The
@@ -195,7 +194,6 @@ leading @samp{+} or a final @samp{.}.
1 ; @r{The integer 1.}
1. ; @r{Also the integer 1.}
+1 ; @r{Also the integer 1.}
-1073741825 ; @r{Also the integer 1 on a 30-bit implementation.}
@end group
@end example
@@ -203,8 +201,8 @@ leading @samp{+} or a final @samp{.}.
As a special exception, if a sequence of digits specifies an integer
too large or too small to be a valid integer object, the Lisp reader
reads it as a floating-point number (@pxref{Floating Point Type}).
-For instance, on most machines @code{536870912} is read as the
-floating-point number @code{536870912.0}.
+For instance, if Emacs integers are 30 bits, @code{536870912} is read
+as the floating-point number @code{536870912.0}.
@xref{Numbers}, for more information.
@@ -394,7 +392,7 @@ value is more important than the @acronym{ASCII} representation.
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{?\x8e0} for the Latin-1 character
+character @kbd{C-a}, and @code{?\xe0} for the Latin-1 character
@iftex
@samp{@`a}.
@end iftex
@@ -1039,7 +1037,7 @@ 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{\x8e0\ }} represents
+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.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index b226d676462..5f422065c5b 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1193,11 +1193,11 @@ 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}).
- Many operating systems are limited to time values that contain 32 bits
+ 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, some
-operating systems have larger time values, and can represent times far
-in the past or future.
+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
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index ba9d8accd4a..5d5b11497f7 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -859,6 +859,12 @@ For a network connection, @code{process-status} returns one of the symbols
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
+process is considered alive if its status is @code{run}, @code{open},
+@code{listen}, @code{connect} or @code{stop}.
+@end defun
+
@defun process-type process
This function returns the symbol @code{network} for a network
connection or server, @code{serial} for a serial port connection, or
@@ -1794,9 +1800,9 @@ nice values get scheduled more favorably.)
The number of threads in the process.
@item start
-The time the process was started, in the @w{@code{(@var{high}
-@var{low} @var{microsec})}} format used by @code{current-time} and
-@code{file-attributes}.
+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}.
@item etime
The time elapsed since the process started, in the @w{@code{(@var{high}
@@ -2482,25 +2488,17 @@ Install @var{plist} as the initial plist of the process.
@itemx :parity
@itemx :stopbits
@itemx :flowcontrol
-These arguments are handled by @code{serial-process-configure}, which
-is called by @code{make-serial-process}.
+These are handled by @code{serial-process-configure}, which is called
+by @code{make-serial-process}.
@end table
The original argument list, possibly modified by later configuration,
is available via the function @code{process-contact}.
-Examples:
+Here is an example:
@example
(make-serial-process :port "/dev/ttyS0" :speed 9600)
-
-(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
-
-(make-serial-process :port "\\\\.\\COM13" :speed 1200
- :bytesize 7 :parity 'odd)
-
-(make-serial-process :port "/dev/tty.BlueConsole-SPP-1"
- :speed nil)
@end example
@end defun
@@ -2560,19 +2558,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.
-
-Examples:
-
-@example
-(serial-process-configure :process "/dev/ttyS0" :speed 1200)
-
-(serial-process-configure :buffer "COM1" :stopbits 1
- :parity 'odd :flowcontrol 'hw)
-
-(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
-@end example
+@code{serial-process-configure} is called by
+@code{make-serial-process} for the initial configuration of the serial
+port.
@end defun
@node Byte Packing
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 27b089f75b6..6272301dbb4 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1207,6 +1207,12 @@ search you wish to refer back to and the use of the match data. If you
can't avoid another intervening search, you must save and restore the
match data around it, to prevent it from being overwritten.
+ Notice that all functions are allowed to overwrite the match data
+unless they're explicitly documented not to do so. A consequence is
+that functions that are run implictly in the background
+(@pxref{Timers}, and @ref{Idle Timers}) should likely save and restore
+the match data explicitly.
+
@menu
* Replacing Match:: Replacing a substring that was matched.
* Simple Match Data:: Accessing single items of match data,
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index 9802c7485dd..4d3a66d8852 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -684,6 +684,12 @@ For example, if the current buffer name is @samp{foo},
returns @code{"The buffer is foo"}.
@end defmac
+@defun pp object &optional stream
+This function outputs @var{object} to @var{stream}, just like
+@code{prin1}, but does it in a more ``pretty'' way. That is, it'll
+indent and fill the object to make it more readable for humans.
+@end defun
+
@node Output Variables
@section Variables Affecting Output
@cindex output-controlling variables
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index d062c215952..2b8911277cd 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -828,12 +828,12 @@ is not truncated.
@example
@group
-(format "The word `%7s' actually has %d letters in it."
+(format "The word `%7s' has %d letters in it."
"foo" (length "foo"))
- @result{} "The word ` foo' actually has 3 letters in it."
-(format "The word `%7s' actually has %d letters in it."
+ @result{} "The word ` foo' has 3 letters in it."
+(format "The word `%7s' has %d letters in it."
"specification" (length "specification"))
- @result{} "The word `specification' actually has 13 letters in it."
+ @result{} "The word `specification' has 13 letters in it."
@end group
@end example
@@ -856,14 +856,16 @@ with @samp{0x} or @samp{0X}. For @samp{%e}, @samp{%f}, and @samp{%g},
the @samp{#} flag means include a decimal point even if the precision
is zero.
+ The flag @samp{0} ensures that the padding consists of @samp{0}
+characters instead of spaces. This flag is ignored for non-numerical
+specification characters like @samp{%s}, @samp{%S} and @samp{%c}.
+These specification characters accept the @samp{0} flag, but still pad
+with @emph{spaces}.
+
The flag @samp{-} causes the padding inserted by the width
specifier, if any, to be inserted on the right rather than the left.
-The flag @samp{0} ensures that the padding consists of @samp{0}
-characters instead of spaces, inserted on the left. These flags are
-ignored for specification characters for which they do not make sense:
-@samp{%s}, @samp{%S} and @samp{%c} accept the @samp{0} flag, but still
-pad with @emph{spaces} on the left. If both @samp{-} and @samp{0} are
-present and valid, @samp{-} takes precedence.
+If both @samp{-} and @samp{0} are present, the @samp{0} flag is
+ignored.
@example
@group
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 55ee2dec4a4..31ee7eb4e7d 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -108,7 +108,7 @@ Then come the characters for any desired flags. If no matching
character or flags are needed, one character is sufficient.
For example, the syntax descriptor for the character @samp{*} in C
-mode is @samp{@w{. 23}} (i.e., punctuation, matching character slot
+mode is @code{". 23"} (i.e., punctuation, matching character slot
unused, second character of a comment-starter, first character of a
comment-ender), and the entry for @samp{/} is @samp{@w{. 14}} (i.e.,
punctuation, matching character slot unused, first character of a
@@ -374,7 +374,7 @@ character, @samp{/}, does not have the @samp{b} flag.
@item @samp{*/}
This is a comment-end sequence for ``b'' style because the first
-character, @samp{*}, does have the @samp{b} flag.
+character, @samp{*}, has the @samp{b} flag.
@item newline
This is a comment-end sequence for ``a'' style, because the newline
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 3ff2697dd37..b91afb044f0 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -364,14 +364,13 @@ after point. Some insertion functions leave point before the inserted
text, while other functions leave it after. We call the former
insertion @dfn{after point} and the latter insertion @dfn{before point}.
- Insertion relocates markers that point at positions after the
-insertion point, so that they stay with the surrounding text
-(@pxref{Markers}). When a marker points at the place of insertion,
-insertion may or may not relocate the marker, depending on the marker's
-insertion type (@pxref{Marker Insertion Types}). Certain special
-functions such as @code{insert-before-markers} relocate all such markers
-to point after the inserted text, regardless of the markers' insertion
-type.
+ Insertion moves markers located at positions after the insertion
+point, so that they stay with the surrounding text (@pxref{Markers}).
+When a marker points at the place of insertion, insertion may or may
+not relocate the marker, depending on the marker's insertion type
+(@pxref{Marker Insertion Types}). Certain special functions such as
+@code{insert-before-markers} relocate all such markers to point after
+the inserted text, regardless of the markers' insertion type.
Insertion functions signal an error if the current buffer is
read-only or if they insert within read-only text.
@@ -2806,9 +2805,9 @@ construct each part with @code{propertize} and then combine them with
@end smallexample
@end defun
- See also the function @code{buffer-substring-no-properties}
-(@pxref{Buffer Contents}) which copies text from the buffer
-but does not copy its properties.
+ @xref{Buffer Contents}, for the function
+@code{buffer-substring-no-properties}, which copies text from the
+buffer but does not copy its properties.
@node Property Search
@subsection Text Property Search Functions
@@ -2978,8 +2977,7 @@ character.
You can use the property @code{face} to control the font and color of
text. @xref{Faces}, for more information.
-In the simplest case, the value is a face name. It can also be a list;
-then each element can be any of these possibilities;
+@code{face} can be the following:
@itemize @bullet
@item
@@ -2992,17 +2990,10 @@ 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}.
-
-@item
-A cons cell with the form @code{(foreground-color . @var{color-name})}
-or @code{(background-color . @var{color-name})}. These are old,
-deprecated equivalents for @code{(:foreground @var{color-name})} and
-@code{(:background @var{color-name})}. Please convert code that uses
-them.
@end itemize
-It works to use the latter two forms directly as the value
-of the @code{face} property.
+@code{face} can also be a list, where each element uses one of the
+forms listed above.
Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by
dynamically updating the @code{face} property of characters based on
@@ -3010,18 +3001,18 @@ the context.
@item font-lock-face
@kindex font-lock-face @r{(text property)}
-The @code{font-lock-face} property is equivalent to the @code{face}
-property when Font Lock mode is enabled. When Font Lock mode is disabled,
+This property specifies a value for the @code{face} property that Font
+Lock mode should apply to the underlying text. It is one of the
+fontification methods used by Font Lock mode, and is useful for
+special modes that implement their own highlighting.
+@xref{Precalculated Fontification}. When Font Lock mode is disabled,
@code{font-lock-face} has no effect.
-The @code{font-lock-face} property is useful for special modes that
-implement their own highlighting. @xref{Precalculated Fontification}.
-
@item mouse-face
@kindex mouse-face @r{(text property)}
-The property @code{mouse-face} is used instead of @code{face} when the
-mouse is on or near the character. For this purpose, ``near'' means
-that all text between the character and where the mouse is have the same
+This property is used instead of @code{face} when the mouse is on or
+near the character. For this purpose, ``near'' means that all text
+between the character and where the mouse is have the same
@code{mouse-face} property value.
@item fontified
@@ -3272,15 +3263,28 @@ functions (which may be the same function). In any case, all the
@code{point-left} functions are called first, followed by all the
@code{point-entered} functions.
-It is possible with @code{char-after} to examine characters at various
+It is possible to use @code{char-after} to examine characters at various
buffer positions without moving point to those positions. Only an
actual change in the value of point runs these hook functions.
+The variable @code{inhibit-point-motion-hooks} can inhibit running the
+@code{point-left} and @code{point-entered} hooks, see @ref{Inhibit
+point motion hooks}.
+
+@item composition
+@kindex composition @r{(text property)}
+This text property is used to display a sequence of characters as a
+single glyph composed from components. But the value of the property
+itself is completely internal to Emacs and should not be manipulated
+directly by, for instance, @code{put-text-property}.
+
+@end table
+
@defvar inhibit-point-motion-hooks
-When this variable is non-@code{nil}, @code{point-left} and
-@code{point-entered} hooks are not run, and the @code{intangible}
-property has no effect. Do not set this variable globally; bind it with
-@code{let}.
+@anchor{Inhibit point motion hooks} When this variable is
+non-@code{nil}, @code{point-left} and @code{point-entered} hooks are
+not run, and the @code{intangible} property has no effect. Do not set
+this variable globally; bind it with @code{let}.
@end defvar
@defvar show-help-function
@@ -3293,15 +3297,6 @@ string to display. Tooltip mode (@pxref{Tooltips,,, emacs, The GNU Emacs
Manual}) provides an example.
@end defvar
-@item composition
-@kindex composition @r{(text property)}
-This text property is used to display a sequence of characters as a
-single glyph composed from components. But the value of the property
-itself is completely internal to Emacs and should not be manipulated
-directly by, for instance, @code{put-text-property}.
-
-@end table
-
@node Format Properties
@subsection Formatted Text Properties
@@ -4095,17 +4090,16 @@ coding instead.
@node Parsing HTML
@section Parsing HTML
@cindex parsing html
-@cindex parsing xml
-Emacs provides an interface to the @code{libxml2} library via two
-functions: @code{html-parse-buffer} and @code{xml-parse-buffer}. The
-HTML function will parse ``real world'' HTML and try to return a
-sensible parse tree, while the XML function is somewhat stricter about
-syntax.
+@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.
-They both take a two optional parameter. The first is a buffer, and
-the second is a base URL to be used to expand relative URLs in the
-document, if any.
+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.
Here's an example demonstrating the structure of the parsed data you
get out. Given this HTML document:
@@ -4134,12 +4128,21 @@ 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.
+@end defun
@node Atomic Changes
@section Atomic Change Groups
@cindex atomic changes
- In data base terminology, an @dfn{atomic} change is an indivisible
+ In database terminology, an @dfn{atomic} change is an indivisible
change---it can succeed entirely or it can fail entirely, but it
cannot partly succeed. A Lisp program can make a series of changes to
one or several buffers as an @dfn{atomic change group}, meaning that
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 37fbe7eb2b4..be37eb2034b 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -204,12 +204,6 @@ definition automatically. Avoid constructing the names in the macro
itself, since that would confuse these tools.
@item
-Please keep the names of your Emacs Lisp source files to 13 characters
-or less. This way, if the files are compiled, the compiled files' names
-will be 14 characters or less, which is short enough to fit on all kinds
-of Unix systems.
-
-@item
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
@@ -255,7 +249,8 @@ file if you distribute copies. Use a notice like this one:
;; 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 this program. If not, see
+;; <http://www.gnu.org/licenses/>.
@end smallexample
If you have signed papers to assign the copyright to the Foundation,
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 7e2c32334a4..3da09369882 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -39,7 +39,6 @@ representing the variable.
* 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.
@@ -99,7 +98,7 @@ x
@node Constant Variables
@section Variables that Never Change
-@kindex setting-constant
+@cindex @code{setting-constant} error
@cindex keyword symbol
@cindex variable with constant value
@cindex constant variables
@@ -288,7 +287,7 @@ has room to execute.
@node Void Variables
@section When a Variable is ``Void''
-@kindex void-variable
+@cindex @code{void-variable} error
@cindex void variable
If you have never given a symbol any value as a global variable, we
@@ -583,7 +582,8 @@ 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
-@kindex variable-interactive
+@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
@@ -1186,8 +1186,7 @@ additional, unusual kinds of variable binding, such as
@dfn{buffer-local} bindings, which apply only in one buffer. Having
different values for a variable in different buffers is an important
customization method. (Variables can also have bindings that are
-local to each terminal, or to each frame. @xref{Multiple Terminals},
-and @xref{Frame-Local Variables}.)
+local to each terminal. @xref{Multiple Terminals}.)
@menu
* Intro to Buffer-Local:: Introduction and concepts.
@@ -1286,9 +1285,8 @@ buffer-local binding of buffer @samp{b}.
values when you visit the file. @xref{File Variables,,, emacs, The
GNU Emacs Manual}.
- A buffer-local variable cannot be made frame-local
-(@pxref{Frame-Local Variables}) or terminal-local (@pxref{Multiple
-Terminals}).
+ A buffer-local variable cannot be made terminal-local
+(@pxref{Multiple Terminals}).
@node Creating Buffer-Local
@subsection Creating and Deleting Buffer-Local Bindings
@@ -1339,9 +1337,9 @@ is not current either on entry to or exit from the @code{let}. This is
because @code{let} does not distinguish between different kinds of
bindings; it knows only which variable the binding was made for.
-If the variable is terminal-local (@pxref{Multiple Terminals}), or
-frame-local (@pxref{Frame-Local Variables}), this function signals an
-error. Such variables cannot have buffer-local bindings as well.
+If the variable is terminal-local (@pxref{Multiple Terminals}), this
+function signals an error. Such variables cannot have buffer-local
+bindings as well.
@strong{Warning:} do not use @code{make-local-variable} for a hook
variable. The hook variables are automatically made buffer-local as
@@ -1670,12 +1668,16 @@ This function works by walking the alist stored in
@code{file-local-variables-alist} and applying each local variable in
turn. It calls @code{before-hack-local-variables-hook} and
@code{hack-local-variables-hook} before and after applying the
-variables, respectively.
+variables, respectively. It only calls the before-hook if the alist
+is non-@code{nil}; it always calls the other hook. This
+function ignores a @samp{mode} element if it specifies the same major
+mode as the buffer already has.
If the optional argument @var{mode-only} is non-@code{nil}, then all
-this function does is return @code{t} if the @w{@samp{-*-}} line or
-the local variables list specifies a mode and @code{nil} otherwise.
-It does not set the mode nor any other file-local variable.
+this function does is return a symbol specifying the major mode,
+if the @w{@samp{-*-}} line or the local variables list specifies one,
+and @code{nil} otherwise. It does not set the mode nor any other
+file-local variable.
@end defun
@defvar file-local-variables-alist
@@ -1875,36 +1877,6 @@ modification times of the associated directory local variables file
updates this list.
@end defvar
-@node Frame-Local Variables
-@section Frame-Local Values for Variables
-@cindex frame-local variables
-
- In addition to buffer-local variable bindings (@pxref{Buffer-Local
-Variables}), Emacs supports @dfn{frame-local} bindings. A frame-local
-binding for a variable is in effect in a frame for which it was
-defined.
-
- In practice, frame-local variables have not proven very useful.
-Ordinary frame parameters are generally used instead (@pxref{Frame
-Parameters}). The function @code{make-variable-frame-local}, which
-was used to define frame-local variables, has been deprecated since
-Emacs 22.2. However, you can still define a frame-specific binding
-for a variable @var{var} in frame @var{frame}, by setting the
-@var{var} frame parameter for that frame:
-
-@lisp
- (modify-frame-parameters @var{frame} '((@var{var} . @var{value})))
-@end lisp
-
-@noindent
-This causes the variable @var{var} to be bound to the specified
-@var{value} in the named @var{frame}. To check the frame-specific
-values of such variables, use @code{frame-parameter}. @xref{Parameter
-Access}.
-
- Note that you cannot have a frame-local binding for a variable that
-has a buffer-local binding.
-
@node Variable Aliases
@section Variable Aliases
@cindex variable aliases
diff --git a/doc/lispref/vol1.texi b/doc/lispref/vol1.texi
index ad8ff0819ca..3b7718814b5 100644
--- a/doc/lispref/vol1.texi
+++ b/doc/lispref/vol1.texi
@@ -211,7 +211,7 @@ Appendices
--- The Detailed Node Listing ---
---------------------------------
-Here are other nodes that are inferiors of those already listed,
+Here are other nodes that are subnodes of those already listed,
mentioned here so you can get to them in one step:
Introduction
@@ -847,7 +847,7 @@ Font Lock Mode
Multiline Font Lock Constructs
* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Fontify:: Controlling which region gets refontified
+* Region to Refontify:: Controlling which region gets refontified
after a buffer change.
Documentation
diff --git a/doc/lispref/vol2.texi b/doc/lispref/vol2.texi
index 7832b3a8614..22a51d3235c 100644
--- a/doc/lispref/vol2.texi
+++ b/doc/lispref/vol2.texi
@@ -210,7 +210,7 @@ Appendices
--- The Detailed Node Listing ---
---------------------------------
-Here are other nodes that are inferiors of those already listed,
+Here are other nodes that are subnodes of those already listed,
mentioned here so you can get to them in one step:
Introduction
@@ -846,7 +846,7 @@ Font Lock Mode
Multiline Font Lock Constructs
* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Fontify:: Controlling which region gets refontified
+* Region to Refontify:: Controlling which region gets refontified
after a buffer change.
Documentation
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 9ce00de4abc..2cf4a8152c7 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -826,8 +826,8 @@ This function updates the buffer list just like @code{switch-to-buffer}
unless @var{norecord} is non-@code{nil}.
@end deffn
-@deffn Command pop-to-buffer buffer-or-name &optional other-window norecord
-This command makes @var{buffer-or-name} the current buffer and switches
+@defun pop-to-buffer buffer-or-name &optional other-window norecord
+This function makes @var{buffer-or-name} the current buffer and switches
to it in some window, preferably not the window previously selected.
The ``popped-to'' window becomes the selected window. Its frame is
given the X server's focus, if possible; see @ref{Input Focus}. The
@@ -866,7 +866,7 @@ All the variables that affect @code{display-buffer} affect
This function updates the buffer list just like @code{switch-to-buffer}
unless @var{norecord} is non-@code{nil}.
-@end deffn
+@end defun
@deffn Command replace-buffer-in-windows &optional buffer-or-name
This function replaces @var{buffer-or-name} in all windows displaying
@@ -1462,10 +1462,10 @@ to the current position of point in @var{window}; @var{window}, to the
selected window. If @var{position} is @code{t}, that means to check the
last visible position in @var{window}.
-The @code{pos-visible-in-window-p} function considers only vertical
-scrolling. If @var{position} is out of view only because @var{window}
-has been scrolled horizontally, @code{pos-visible-in-window-p} returns
-non-@code{nil} anyway. @xref{Horizontal Scrolling}.
+This function considers only vertical scrolling. If @var{position} is
+out of view only because @var{window} has been scrolled horizontally,
+@code{pos-visible-in-window-p} returns non-@code{nil} anyway.
+@xref{Horizontal Scrolling}.
If @var{position} is visible, @code{pos-visible-in-window-p} returns
@code{t} if @var{partially} is @code{nil}; if @var{partially} is
diff --git a/doc/man/ChangeLog b/doc/man/ChangeLog
index 06ff5782003..0735e0593f9 100644
--- a/doc/man/ChangeLog
+++ b/doc/man/ChangeLog
@@ -1,3 +1,11 @@
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * emacsclient.1: Document exit status.
+
+2011-06-25 Andreas Rottmann <a.rottmann@gmx.at>
+
+ * emacsclient.1: Mention --frame-parameters.
+
2011-03-07 Chong Yidong <cyd@stupidchicken.com>
* Version 23.3 released.
diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1
index cae4d76634b..4020b6c0b6a 100644
--- a/doc/man/emacsclient.1
+++ b/doc/man/emacsclient.1
@@ -58,6 +58,9 @@ daemon mode and emacsclient will try to connect to it.
.B -c, \-\-create-frame
create a new frame instead of trying to use the current Emacs frame
.TP
+.B \-F, \-\-frame-parameters=ALIST
+set the parameters of a newly-created frame.
+.TP
.B \-d, \-\-display=DISPLAY
tell the server to display the files on the given display.
.TP
@@ -84,6 +87,9 @@ print version information and exit
.TP
.B \-H, \-\-help
print this usage information message and exit
+.SH "EXIT STATUS"
+Normally, the exit status is 0. If emacsclient shuts down due to
+Emacs signaling an error, the exit status is 1.
.SH "SEE ALSO"
The program is documented fully in
.IR "Using Emacs as a Server"
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index ca9dbba9692..38cbaafa45d 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,112 @@
+2011-07-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * widget.texi (Setting Up the Buffer): Remove mention of the
+ global keymap parent, which doesn't seem to be accurate
+ (bug#7045).
+
+2010-07-10 Kevin Ryde <user42@zip.com.au>
+
+ * cl.texi (For Clauses): Add destructuring example processing an
+ alist (bug#6596).
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * org.texi (Special agenda views): Fix double quoting (bug#3509).
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * ediff.texi (Major Entry Points): Remove mention of `require',
+ since that's not pertinent in the installed Emacs (bug#9016).
+
+2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Expiring Mail): Document gnus-auto-expirable-marks.
+ (Filtering New Groups): Clarify how simple the "options -n" format is.
+ (Agent Expiry): Remove mention of `gnus-request-expire-articles', which
+ is internal.
+
+2011-07-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Cleanup remote connections): Add
+ `tramp-cleanup-this-connection'.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Subscription Methods): Link to "Group Levels" to explain
+ zombies.
+ (Checking New Groups): Ditto (bug#8974).
+ (Checking New Groups): Moved the reference to the right place.
+
+2011-07-03 Dave Abrahams <dave@boostpro.com> (tiny change)
+
+ * gnus.texi (Startup Files): Clarify that we're talking about numbered
+ backups, and not actual vc (bug#8975).
+
+2011-07-03 Kevin Ryde <user42@zip.com.au>
+
+ * cl.texi (For Clauses): @items for hash-values and key-bindings
+ to make them more visible when skimming. Add examples of `using'
+ clause to them, examples being clearer than a description in
+ words (bug#6599).
+
+2011-07-01 Alan Mackenzie <acm@muc.de>
+
+ * cc-mode.texi (Guessing the Style): New page.
+ (Styles): Add a short introduction to above.
+
+2011-06-28 Deniz Dogan <deniz@dogan.se>
+
+ * rcirc.texi (Configuration): Bug-fix:
+ `rcirc-default-user-full-name' is now `rcirc-default-full-name'.
+ Reported by Elias Pipping <pipping@exherbo.org>.
+
+2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Summary Mail Commands): Document
+ `gnus-summary-reply-to-list-with-original'.
+
+2011-06-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell.texi (Known problems): Fix typo.
+
+2011-06-12 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Customizing Completion): Mention authinfo-style files.
+ (Password handling): `auth-source-debug' is good for debug messages.
+
+2011-05-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi (Store custom flags and keywords): Refer to
+ `gnus-registry-article-marks-to-{chars,names}' instead of
+ `gnus-registry-user-format-function-{M,M2}'.
+
+2011-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2011-05-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi (Gnus Registry Setup): Rename from "Setup".
+ (Store custom flags and keywords):
+ Mention `gnus-registry-user-format-function-M' and
+ `gnus-registry-user-format-function-M2'.
+
+2011-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Sync from gnulib, version 2011-05-11.16.
+
+2011-05-17 Glenn Morris <rgm@gnu.org>
+
+ * gnus.texi (Face): Fix typo.
+
+2011-05-14 Glenn Morris <rgm@gnu.org>
+
+ * dired-x.texi (Omitting Examples): Minor addition.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ * ede.texi: Fix typo "or or -> or".
+
2011-05-03 Peter Münster <pmlists@free.fr> (tiny change)
* gnus.texi (Summary Buffer Lines):
@@ -16,8 +125,8 @@
2011-04-14 Teodor Zlatanov <tzz@lifelogs.com>
* gnus.texi (nnmairix caveats, Setup, Registry Article Refer Method)
- (Fancy splitting to parent, Store arbitrary data): Updated
- gnus-registry docs.
+ (Fancy splitting to parent, Store arbitrary data):
+ Updated gnus-registry docs.
2011-04-13 Juanma Barranquero <lekktu@gmail.com>
@@ -213,8 +322,8 @@
2011-02-19 Glenn Morris <rgm@gnu.org>
- * dired-x.texi (Technical Details): No longer redefines dired-add-entry,
- dired-initial-position, dired-clean-up-after-deletion,
+ * dired-x.texi (Technical Details): No longer redefines
+ dired-add-entry, dired-initial-position, dired-clean-up-after-deletion,
dired-read-shell-command, or dired-find-buffer-nocreate.
2011-02-18 Glenn Morris <rgm@gnu.org>
@@ -300,7 +409,7 @@
* gnus-overrides.texi: Renamed from overrides.texi and all the relevant
manuals use it now.
- * Makefile.in (nowebhack): Fixed to use -D flag instead of overrides.
+ * Makefile.in (nowebhack): Fix to use -D flag instead of overrides.
2011-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -419,7 +528,7 @@
* Makefile.in (MAKEINFO): Now controlled by `configure'.
(MAKEINFO_OPTS): New variable. Use it where appropriate.
- (ENVADD): Updated.
+ (ENVADD): Update.
2011-01-18 Glenn Morris <rgm@gnu.org>
@@ -453,8 +562,8 @@
2010-12-17 Daiki Ueno <ueno@unixuser.org>
- * epa.texi (Encrypting/decrypting *.gpg files): Mention
- epa-file-select-keys.
+ * epa.texi (Encrypting/decrypting *.gpg files):
+ Mention epa-file-select-keys.
2010-12-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -462,7 +571,7 @@
2010-12-16 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus.texi (Foreign Groups): Added clarification of foreign groups.
+ * gnus.texi (Foreign Groups): Add clarification of foreign groups.
2010-12-15 Andrew Cohen <cohen@andy.bu.edu>
@@ -753,8 +862,8 @@
2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.texi (Client-Side IMAP Splitting): Mention
- nnimap-unsplittable-articles.
+ * gnus.texi (Client-Side IMAP Splitting):
+ Mention nnimap-unsplittable-articles.
2010-10-29 Julien Danjou <julien@danjou.info>
@@ -847,8 +956,8 @@
2010-10-12 Daiki Ueno <ueno@unixuser.org>
* epa.texi (Caching Passphrases):
- * auth.texi (GnuPG and EasyPG Assistant Configuration): Clarify
- some configurations require to set up gpg-agent.
+ * auth.texi (GnuPG and EasyPG Assistant Configuration):
+ Clarify some configurations require to set up gpg-agent.
2010-10-11 Glenn Morris <rgm@gnu.org>
@@ -948,14 +1057,14 @@
2010-10-03 Julien Danjou <julien@danjou.info>
- * emacs-mime.texi (Display Customization): Update
- mm-inline-large-images documentation and add documentation for
+ * emacs-mime.texi (Display Customization):
+ Update mm-inline-large-images documentation and add documentation for
mm-inline-large-images-proportion.
2010-10-03 Michael Albinus <michael.albinus@gmx.de>
- * tramp.texi (Frequently Asked Questions): Mention
- remote-file-name-inhibit-cache.
+ * tramp.texi (Frequently Asked Questions):
+ Mention remote-file-name-inhibit-cache.
2010-10-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -964,15 +1073,14 @@
2010-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.texi (Splitting Mail): Mention the new fancy splitting
- function.
- (Article Hiding): Add google banner example. Suggested by Benjamin
- Xu.
+ * gnus.texi (Splitting Mail): Mention the new fancy splitting function.
+ (Article Hiding): Add google banner example.
+ Suggested by Benjamin Xu.
2010-09-30 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove
- nnimap-split-rule from examples.
+ * gnus.texi (Spam Package Configuration Examples, SpamOracle):
+ Remove nnimap-split-rule from examples.
2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1001,8 +1109,8 @@
2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.texi (Customizing the IMAP Connection): Document
- nnimap-fetch-partial-articles.
+ * gnus.texi (Customizing the IMAP Connection):
+ Document nnimap-fetch-partial-articles.
2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1027,7 +1135,7 @@
2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.texi (NoCeM): Removed.
+ * gnus.texi (NoCeM): Remove.
(Startup Variables): No jingle.
2010-09-25 Ulrich Mueller <ulm@gentoo.org>
@@ -1127,8 +1235,8 @@
2010-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.texi (Asynchronous Fetching): Document
- gnus-async-post-fetch-function.
+ * gnus.texi (Asynchronous Fetching):
+ Document gnus-async-post-fetch-function.
(HTML): Made into its own section.
2010-08-26 Michael Albinus <michael.albinus@gmx.de>
@@ -1136,8 +1244,8 @@
Sync with Tramp 2.1.19.
* tramp.texi (Inline methods, Default Method): Mention
- `tramp-inline-compress-start-size'. Remove "kludgy" phrase. Remove
- remark about doubled "-t" argument.
+ `tramp-inline-compress-start-size'. Remove "kludgy" phrase.
+ Remove remark about doubled "-t" argument.
(Auto-save and Backup): Remove reference to Emacs 21.
(Filename Syntax): Describe port numbers.
(Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt
@@ -1387,8 +1495,8 @@
Synchronize with Tramp repository.
* tramp.texi (Auto-save and Backup): Remove reference to Emacs 21.
- (Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt
- supported MS Windows versions. Remove obsolete URL. Use the $()
+ (Frequently Asked Questions): Adapt supported (X)Emacs versions.
+ Adapt supported MS Windows versions. Remove obsolete URL. Use the $()
syntax, texi2dvi reports errors with the backquotes.
* trampver.texi: Update release number.
@@ -1622,8 +1730,8 @@
* dbus.texi (Type Conversion): Fix typo.
(Asynchronous Methods): Rename `dbus-registered-functions-table' to
`dbus-registered-objects-table'.
- (Receiving Method Calls): New defun `dbus-register-property'. Move
- `dbus-unregister-object' here.
+ (Receiving Method Calls): New defun `dbus-register-property'.
+ Move `dbus-unregister-object' here.
2009-11-13 Carsten Dominik <carsten.dominik@gmail.com>
@@ -1637,9 +1745,9 @@
2009-11-13 John Wiegley <johnw@newartisans.com>
- * org.texi (Tracking your habits): Added a new section in the
+ * org.texi (Tracking your habits): Add a new section in the
manual about how to track habits.
- (Resolving idle time): Added a section on how idle and
+ (Resolving idle time): Add a section on how idle and
dangling clocks are resolved.
2009-11-13 Carsten Dominik <carsten.dominik@gmail.com>
@@ -1666,11 +1774,11 @@
should be set.
(Agenda commands): Document that SPC is a filter for
any tag.
- (Search view): Renamed from "Keyword search".
+ (Search view): Rename from "Keyword search".
(Capure): New chapter.
(Markup): New chapter.
- (Links in HTML export, Images in HTML export): Extend
- the section titles.
+ (Links in HTML export, Images in HTML export):
+ Extend the section titles.
(Images in HTML export): Document the align option.
(Text areas in HTML export): Extend the section title.
(Images in LaTeX export): Explain image placement in LaTeX.
@@ -1757,8 +1865,8 @@
2009-09-13 Chong Yidong <cyd@stupidchicken.com>
- * dired-x.texi (Technical Details): Delete
- dired-up-directory (Bug#4292).
+ * dired-x.texi (Technical Details):
+ Delete dired-up-directory (Bug#4292).
2009-09-03 Michael Albinus <michael.albinus@gmx.de>
@@ -1771,7 +1879,7 @@
Document entry text mode. Improve documentation of the keys to include
inactive time stamps into the agenda view.
(Feedback): Document the new bug report command.
- (Structure editing): Added an index entry for the sorting of subtrees.
+ (Structure editing): Add an index entry for the sorting of subtrees.
2009-09-02 Teodor Zlatanov <tzz@lifelogs.com>
@@ -1791,8 +1899,8 @@
2009-08-29 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus.texi (Expiring Mail): Mention
- gnus-mark-copied-or-moved-articles-as-expirable.
+ * gnus.texi (Expiring Mail):
+ Mention gnus-mark-copied-or-moved-articles-as-expirable.
(Various Various): Mention gnus-safe-html-newsgroups.
* gnus-news.texi: Mention
@@ -1935,7 +2043,7 @@
#+LEATEX_HEADER in-buffer setting.
(Bugs): Section removed.
(Hooks): New section.
- (Add-on packages): Moved here from old location.
+ (Add-on packages): Move here from old location.
(Context-sensitive commands): New section.
(Setting tags): Document newline option.
(Global TODO list, Matching tags and properties):
@@ -1996,8 +2104,8 @@
2009-06-30 Michael Albinus <michael.albinus@gmx.de>
- * tramp.texi (Inline methods, External methods, Gateway methods): Avoid
- the words "kludge" and hack".
+ * tramp.texi (Inline methods, External methods, Gateway methods):
+ Avoid the words "kludge" and hack".
(External methods): Add `synce' method.
* trampver.texi: Update release number.
@@ -2452,8 +2560,8 @@
2009-01-09 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.texi (Converting Kill Files): Fix URL. Include
- gnus-kill-to-score.el in contrib directory.
+ * gnus.texi (Converting Kill Files): Fix URL.
+ Include gnus-kill-to-score.el in contrib directory.
2009-01-09 Reiner Steib <Reiner.Steib@gmx.de>
@@ -2480,8 +2588,8 @@
2008-12-20 Carsten Dominik <dominik@science.uva.nl>
* org.texi (Activation, Exporting, ASCII export, HTML export)
- (HTML Export commands, LaTeX/PDF export commands): Improve
- documentation about transient-mark-mode.
+ (HTML Export commands, LaTeX/PDF export commands):
+ Improve documentation about transient-mark-mode.
(References): DOcuemtn the use of special names like $LR1 to reference
to fields in the last table row.
@@ -2576,7 +2684,7 @@
2008-11-16 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper.texi (viper-ESC-keyseq-timeout, viper-ESC-key): Removed.
+ * viper.texi (viper-ESC-keyseq-timeout, viper-ESC-key): Remove.
* ediff.texi: Version/date change.
@@ -2627,12 +2735,12 @@
2008-09-25 Teodor Zlatanov <tzz@lifelogs.com>
- * message.texi (Sending Variables): Fixed variable documentation to
+ * message.texi (Sending Variables): Fix variable documentation to
avoid the "y/n" wording.
2008-09-24 Teodor Zlatanov <tzz@lifelogs.com>
- * message.texi (Sending Variables): Added `message-confirm-send' doc.
+ * message.texi (Sending Variables): Add `message-confirm-send' doc.
2008-09-24 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -2846,7 +2954,7 @@
2008-06-21 Michael Albinus <michael.albinus@gmx.de>
- * tramp.texi (Password handling): Renamed from "Password caching".
+ * tramp.texi (Password handling): Rename from "Password caching".
Add `auth-source' mechanism.
(Connection caching): Tramp reopens the connection automatically,
when the operating system on the remote host has been changed.
@@ -3058,8 +3166,8 @@
2008-04-01 Daiki Ueno <ueno@unixuser.org>
- * epa.texi (Encrypting/decrypting *.gpg files): Document
- epa-file-name-regexp.
+ * epa.texi (Encrypting/decrypting *.gpg files):
+ Document epa-file-name-regexp.
2008-03-31 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -3311,8 +3419,8 @@
2008-01-09 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus.texi (Article Keymap): Add
- gnus-article-wide-reply-with-original; fix descriptions of
+ * gnus.texi (Article Keymap):
+ Add gnus-article-wide-reply-with-original; fix descriptions of
gnus-article-reply-with-original and
gnus-article-followup-with-original.
@@ -3385,14 +3493,14 @@
(Getting started with rcirc): Change items to reflect prompts.
Add more explanation to rcirc-track-minor-mode and added a comment to
warn future maintainers that this section is a copy.
- (People): Changed /ignore example.
+ (People): Change /ignore example.
(Keywords): Not keywords.
2007-12-20 Alex Schroeder <alex@gnu.org>
* rcirc.texi (Top): Fighting Information Overload chapter added.
(Getting started with rcirc): Add notice of rcirc-track-minor-mode.
- (rcirc commands): Moved /ignore command to the new chapter.
+ (rcirc commands): Move /ignore command to the new chapter.
(Fighting Information Overload): New chapter documenting /keyword,
/bright, /dim, channel ignore, and low priority channels.
(Configuration): Document rcirc-server-alist, remove
@@ -3592,8 +3700,8 @@
2007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.texi (Sorting the Summary Buffer): Remove
- gnus-article-sort-by-date-reverse.
+ * gnus.texi (Sorting the Summary Buffer):
+ Remove gnus-article-sort-by-date-reverse.
2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -3625,8 +3733,8 @@
2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus.texi (Archived Messages): Document
- gnus-update-message-archive-method.
+ * gnus.texi (Archived Messages):
+ Document gnus-update-message-archive-method.
2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -3634,13 +3742,13 @@
2007-10-28 Michaël Cadilhac <michael@cadilhac.name>
- * gnus.texi (Group Maneuvering): Document
- `gnus-summary-next-group-on-exit'.
+ * gnus.texi (Group Maneuvering):
+ Document `gnus-summary-next-group-on-exit'.
2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus.texi (Really Various Summary Commands): Mention
- gnus-auto-select-on-ephemeral-exit.
+ * gnus.texi (Really Various Summary Commands):
+ Mention gnus-auto-select-on-ephemeral-exit.
2007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
@@ -3789,14 +3897,14 @@
2007-10-28 Kevin Greiner <kevin.greiner@compsol.cc>
- * gnus.texi (nntp-open-via-telnet-and-telnet): Fixed grammar.
+ * gnus.texi (nntp-open-via-telnet-and-telnet): Fix grammar.
(Agent Parameters): Updated parameter names to match code.
(Group Agent Commands): Corrected 'gnus-agent-fetch-series' as
'gnus-agent-summary-fetch-series'.
(Agent and flags): New section providing a generalized discussion
of flag handling.
- (Agent and IMAP): Removed flag discussion.
- (Agent Variables): Added 'gnus-agent-synchronize-flags'.
+ (Agent and IMAP): Remove flag discussion.
+ (Agent Variables): Add 'gnus-agent-synchronize-flags'.
2007-10-28 Romain Francoise <romain@orebokech.com>
@@ -3829,7 +3937,7 @@
* gnus.texi (Blacklists and Whitelists, BBDB Whitelists)
(Gmane Spam Reporting, Bogofilter, spam-stat spam filtering)
(spam-stat spam filtering, SpamOracle)
- (Extending the Spam ELisp package): Removed extra quote symbol for
+ (Extending the Spam ELisp package): Remove extra quote symbol for
clarity.
2007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
@@ -3846,8 +3954,8 @@
2007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.texi (Sorting the Summary Buffer): Added
- gnus-thread-sort-by-recipient.
+ * gnus.texi (Sorting the Summary Buffer):
+ Add gnus-thread-sort-by-recipient.
2007-10-28 Romain Francoise <romain@orebokech.com>
@@ -3882,8 +3990,8 @@
2007-10-28 Simon Josefsson <jas@extundo.com>
- * gnus.texi (Article Washing): Add libidn URL. Suggested by
- Michael Cook <michael@waxrat.com>.
+ * gnus.texi (Article Washing): Add libidn URL.
+ Suggested by Michael Cook <michael@waxrat.com>.
2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -3932,10 +4040,10 @@
everywhere for consistency.
(Filtering Spam Using The Spam ELisp Package): Admonish again.
(Spam ELisp Package Sequence of Events): This is Gnus, say so.
- Say "regular expression" instead of "regex." Admonish. Pick
- other words to sound better (s/so/thus/).
- (Spam ELisp Package Filtering of Incoming Mail): Mention
- statistical filters. Remove old TODO.
+ Say "regular expression" instead of "regex." Admonish.
+ Pick other words to sound better (s/so/thus/).
+ (Spam ELisp Package Filtering of Incoming Mail):
+ Mention statistical filters. Remove old TODO.
(Spam ELisp Package Sorting and Score Display in Summary Buffer):
New section on sorting and displaying the spam score.
(BBDB Whitelists): Mention spam-use-BBDB-exclusive is not a
@@ -3961,7 +4069,7 @@
2007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.texi (Adaptive Scoring): Added gnus-adaptive-pretty-print.
+ * gnus.texi (Adaptive Scoring): Add gnus-adaptive-pretty-print.
2007-10-28 Simon Josefsson <jas@extundo.com>
@@ -3975,7 +4083,7 @@
2007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus.texi (Hashcash): Changed location of library, also mention
+ * gnus.texi (Hashcash): Change location of library, also mention
that payments can be verified and fix the name of the
hashcash-path variable.
@@ -3995,7 +4103,7 @@
2007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus.texi (SpamAssassin backend): Added new node about SpamAssassin.
+ * gnus.texi (SpamAssassin backend): Add new node about SpamAssassin.
From Hubert Chan <hubert@uhoreg.ca>.
2007-10-28 Jesper Harder <harder@ifa.au.dk>
@@ -4013,8 +4121,8 @@
2007-10-28 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus.texi (Outgoing Messages, Agent Variables): Add
- gnus-agent-queue-mail and gnus-agent-prompt-send-queue.
+ * gnus.texi (Outgoing Messages, Agent Variables):
+ Add gnus-agent-queue-mail and gnus-agent-prompt-send-queue.
Suggested by Gaute Strokkenes <gs234@srcf.ucam.org>
2007-10-28 Jesper Harder <harder@ifa.au.dk>
@@ -4352,8 +4460,8 @@
2007-06-19 Jay Belanger <jay.p.belanger@gmail.com>
- * calc.texi (Basic Arithmetic, Customizing Calc): Mention
- the variable `calc-multiplication-has-precedence'.
+ * calc.texi (Basic Arithmetic, Customizing Calc):
+ Mention the variable `calc-multiplication-has-precedence'.
2007-06-19 Carsten Dominik <dominik@science.uva.nl>
@@ -4576,7 +4684,7 @@
2007-02-25 Carsten Dominik <dominik@science.uva.nl>
- * org.texi (The spreadsheet): Renamed from "Table calculations".
+ * org.texi (The spreadsheet): Rename from "Table calculations".
Completely reorganized and rewritten.
(CamelCase links): Section removed.
(Repeating items): New section.
@@ -4854,7 +4962,7 @@
2006-10-20 Masatake YAMATO <jet@gyve.org>
- * cc-mode.texi (Sample .emacs File): Added missing `)' in
+ * cc-mode.texi (Sample .emacs File): Add missing `)' in
sample code `my-c-initialization-hook'.
2006-10-19 Stuart D. Herring <herring@lanl.gov>
@@ -5018,13 +5126,13 @@
* rcirc.texi: Fix typos.
(Getting started with rcirc): New calling convention for M-x irc.
Mention #rcirc. Removed channel tracking.
- (Configuration): Changed the names of all variables that got changed
+ (Configuration): Change the names of all variables that got changed
recently, eg. rcirc-server to rcirc-default-server. Added
documentation for rcirc-authinfo, some background for Bitlbee, and
rcirc-track-minor-mode.
- (Scrolling conservatively): Fixed the xref from Auto Scrolling to just
+ (Scrolling conservatively): Fix the xref from Auto Scrolling to just
Scrolling.
- (Reconnecting after you have lost the connection): Fixed example code
+ (Reconnecting after you have lost the connection): Fix example code
to match code changes.
2006-07-10 Nick Roberts <nickrob@snap.net.nz>
@@ -5846,8 +5954,8 @@
* faq.texi: Set VER to `22.1'.
(Basic editing): Explain how to use localized versions of the
- Tutorial. Mention that `C-h r' displays the manual. Delete
- obsolete WWW link to an Emacs 18 tutorial.
+ Tutorial. Mention that `C-h r' displays the manual.
+ Delete obsolete WWW link to an Emacs 18 tutorial.
(Getting a printed manual): Point to the new locations of the
manuals on the GNU Web site.
(Emacs Lisp documentation): Explain that the Emacs Lisp manual is
@@ -6030,8 +6138,8 @@
2005-10-23 Lars Hansen <larsh@soem.dk>
- * dired-x.texi (Miscellaneous Commands): Replace
- dired-do-relative-symlink by dired-do-relsymlink and
+ * dired-x.texi (Miscellaneous Commands):
+ Replace dired-do-relative-symlink by dired-do-relsymlink and
dired-do-relative-symlink-regexp by dired-do-relsymlink-regexp.
2005-10-23 Jay Belanger <belanger@truman.edu>
@@ -6041,8 +6149,8 @@
2005-10-23 Michael Albinus <michael.albinus@gmx.de>
- * faq.texi (Bugs and problems): Replace
- `dired-move-to-filename-regexp' by
+ * faq.texi (Bugs and problems):
+ Replace `dired-move-to-filename-regexp' by
`directory-listing-before-filename-regexp'.
2005-10-22 Eli Zaretskii <eliz@gnu.org>
@@ -6189,8 +6297,8 @@
* newsticker.texi: Replace @command with @code. Replace @example
with @lisp.
- (Top): Added explanations to menu items.
- (GNU Free Documentation License): Removed.
+ (Top): Add explanations to menu items.
+ (GNU Free Documentation License): Remove.
2005-09-16 Romain Francoise <romain@orebokech.com>
@@ -6678,7 +6786,7 @@
2005-01-01 Jay Belanger <belanger@truman.edu>
- * calc.texi (Programming Tutorial): Changed description of how to
+ * calc.texi (Programming Tutorial): Change description of how to
edit keyboard macros to match current behavior.
2004-12-31 Jay Belanger <belanger@truman.edu>
@@ -6778,10 +6886,10 @@
2004-12-08 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-faq.texi ([5.1]): Added missing bracket.
+ * gnus-faq.texi ([5.1]): Add missing bracket.
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): Index
- `spam-initialize'.
+ * gnus.texi (Filtering Spam Using The Spam ELisp Package):
+ Index `spam-initialize'.
2004-11-22 Reiner Steib <Reiner.Steib@gmx.de>
@@ -6792,20 +6900,20 @@
2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
- * emacs-mime.texi (Encoding Customization): Fix
- mm-coding-system-priorities entry.
+ * emacs-mime.texi (Encoding Customization):
+ Fix mm-coding-system-priorities entry.
2004-11-03 Jan Djärv <jan.h.d@swipnet.se>
* idlwave.texi (Continued Statement Indentation):
* reftex.texi (Options (Index Support)):
(Displaying and Editing the Index, Table of Contents):
- * speedbar.texi (Creating a display, Major Display Modes): Replace
- non-nil with non-@code{nil}.
+ * speedbar.texi (Creating a display, Major Display Modes):
+ Replace non-nil with non-@code{nil}.
2004-10-21 Jay Belanger <belanger@truman.edu>
- * calc.texi (Algebraic-Style Calculations): Removed a comment.
+ * calc.texi (Algebraic-Style Calculations): Remove a comment.
2004-10-18 Luc Teirlinck <teirllm@auburn.edu>
@@ -6813,7 +6921,7 @@
2004-10-18 Jay Belanger <belanger@truman.edu>
- * calc.texi (Reporting Bugs): Changed the address that bugs
+ * calc.texi (Reporting Bugs): Change the address that bugs
should be sent to.
2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
@@ -6832,7 +6940,7 @@
2004-10-12 Jay Belanger <belanger@truman.edu>
- * calc.texi (Help Commands): Changed the descriptions of
+ * calc.texi (Help Commands): Change the descriptions of
calc-describe-function and calc-describe-variable to match their
current behavior.
@@ -6898,25 +7006,25 @@
2004-09-20 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.texi (MIME Commands): Added
- gnus-mime-display-multipart-as-mixed,
+ * gnus.texi (MIME Commands):
+ Add gnus-mime-display-multipart-as-mixed,
gnus-mime-display-multipart-alternative-as-mixed,
gnus-mime-display-multipart-related-as-mixed.
(Mail Source Customization): Clarify `mail-source-directory'.
(Splitting Mail): Mention gnus-group-find-new-groups.
- (SpamOracle): Fixed typo.
+ (SpamOracle): Fix typo.
* gnus-faq.texi: Untabify.
([6.3]): nnir.el is in contrib directory.
* message.texi (News Headers): Clarify how a unique ID is created.
- * gnus.texi (Batching Agents): Fixed typo in example. Reported
- by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
+ * gnus.texi (Batching Agents): Fix typo in example.
+ Reported by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
2004-09-20 Andre Srinivasan <andre@e2open.com> (tiny change)
- * gnus.texi (Group Parameters): Added more on hooks.
+ * gnus.texi (Group Parameters): Add more on hooks.
2004-09-20 Florian Weimer <fw@deneb.enyo.de>
@@ -6924,7 +7032,7 @@
2004-09-22 Jay Belanger <belanger@truman.edu>
- * calc.texi (Vectors as Lists): Added a warning that the tutorial
+ * calc.texi (Vectors as Lists): Add a warning that the tutorial
might be hidden during part of the session.
2004-09-20 Jay Belanger <belanger@truman.edu>
@@ -7017,8 +7125,8 @@
mm-content-transfer-encoding-defaults entry.
(rfc2047): Update.
- * gnus.texi (Article Highlighting): Add
- gnus-cite-ignore-quoted-from.
+ * gnus.texi (Article Highlighting):
+ Add gnus-cite-ignore-quoted-from.
(POP before SMTP): New node.
(Posting Styles): Addition.
(Splitting Mail): Add nnmail-split-lowercase-expanded.
@@ -7032,8 +7140,8 @@
2004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.texi (Mail Source Specifiers): Describe
- `pop3-leave-mail-on-server'.
+ * gnus.texi (Mail Source Specifiers):
+ Describe `pop3-leave-mail-on-server'.
2004-08-02 Reiner Steib <Reiner.Steib@gmx.de>
@@ -7060,8 +7168,8 @@
2004-06-13 Luc Teirlinck <teirllm@auburn.edu>
- * autotype.texi (Copyrights, Timestamps): Recommend
- `before-save-hook' instead of `write-file-functions'.
+ * autotype.texi (Copyrights, Timestamps):
+ Recommend `before-save-hook' instead of `write-file-functions'.
2004-06-13 Lars Hansen <larsh@math.ku.dk>
@@ -7172,7 +7280,7 @@
2004-02-29 Simon Josefsson <jas@extundo.com>
- * smtpmail.texi (Authentication): Changed the list of supported
+ * smtpmail.texi (Authentication): Change the list of supported
authentication mechanisms from CRAM-MD5, PLAIN and LOGIN-MD5 to
CRAM-MD5 and LOGIN, tiny patch from Andreas Voegele
<voegelas@gmx.net>.
@@ -7191,8 +7299,8 @@
* tramp.texi (Customizing Completion): Explain new functions
`tramp-parse-shostkeys' and `tramp-parse-sknownhosts'.
(all): Savannah URLs unified to "http://savannah.nongnu.org".
- (Top): Refer to Savannah mailing list as the major one. Mention
- older mailing lists in HTML mode only.
+ (Top): Refer to Savannah mailing list as the major one.
+ Mention older mailing lists in HTML mode only.
(Auto-save and Backup): Add auto-save. Based on wording of Kai.
(Frequently Asked Questions): Remote hosts must not be Unix-like
for "smb" method.
@@ -7381,7 +7489,7 @@
(Multi-hop Methods): Add method `remsh'.
Small patch from Adrian Aichner <adrian@xemacs.org>:
Fix minor typos.
- (Concept Index): Added to make manual searchable via
+ (Concept Index): Add to make manual searchable via
`Info-index'.
(Version Control): Add cindex entry.
@@ -7431,7 +7539,7 @@
appropriate. In info case, point to node `Installation' in order
to explain how to generate the other way. In html case, make a
link to the other html file.
- (Obtaining TRAMP): Added a paragraph saying to perform `autoconf'
+ (Obtaining TRAMP): Add a paragraph saying to perform `autoconf'
after CVS checkout/update.
(Installation): Completely rewritten.
(Installation parameters, Load paths): New sections under
@@ -7484,8 +7592,8 @@
2002-12-26 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * tramp.texi (External transfer methods): New method `smb'. From
- Michael Albinus.
+ * tramp.texi (External transfer methods): New method `smb'.
+ From Michael Albinus.
2002-11-05 Karl Berry <karl@gnu.org>
@@ -7494,8 +7602,8 @@
2002-10-06 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- * tramp.texi: Move @copying to standard place. Use
- @insertcopying.
+ * tramp.texi: Move @copying to standard place.
+ Use @insertcopying.
2002-10-02 Karl Berry <karl@gnu.org>
@@ -7953,8 +8061,8 @@
1989-01-17 Robert J. Chassell (bob@rice-chex.ai.mit.edu)
* texinfo.tex: Change spelling of `\sc' font to `\smallcaps' and
- then define `\sc' as the command for smallcaps in Texinfo. This
- means that the @sc command will produce small caps. bfox has
+ then define `\sc' as the command for smallcaps in Texinfo.
+ This means that the @sc command will produce small caps. bfox has
made the corresponding change to makeinfo and texinfm.el.
1988-08-16 Robert J. Chassell (bob@frosted-flakes.ai.mit.edu)
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 450199a33c5..28a949f81e2 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -28,7 +28,7 @@ srcdir=@srcdir@
# 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 shortlisp)
+# (cf src/Makefile.in's passing of $lisp to make-docfile)
VPATH=@srcdir@
## Where the output files go.
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 9ae9abd5e1a..a9339162666 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -287,10 +287,11 @@ Configuration Basics
Styles
-* Built-in Styles::
-* Choosing a Style::
-* Adding Styles::
-* File Styles::
+* Built-in Styles::
+* Choosing a Style::
+* Adding Styles::
+* Guessing the Style::
+* File Styles::
Customizing Auto-newlines
@@ -2511,14 +2512,18 @@ groupings of customizations called @dfn{styles}, associate a single name
for any particular style, and pretty easily start editing new or
existing code using these styles.
+As an alternative to writing a style definition yourself, you can have
+@ccmode{} @dfn{guess} (at least part of) your style by looking at an
+already formatted piece of your code, @ref{Guessing the Style}.
+
@menu
-* Built-in Styles::
-* Choosing a Style::
-* Adding Styles::
-* File Styles::
+* Built-in Styles::
+* Choosing a Style::
+* Adding Styles::
+* Guessing the Style::
+* File Styles::
@end menu
-
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@node Built-in Styles, Choosing a Style, Styles, Styles
@comment node-name, next, previous, up
@@ -2653,9 +2658,8 @@ This variable always contains the buffer's current style name, as a
string.
@end defvar
-
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Adding Styles, File Styles, Choosing a Style, Styles
+@node Adding Styles, Guessing the Style, Choosing a Style, Styles
@comment node-name, next, previous, up
@subsection Adding and Amending Styles
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2742,9 +2746,131 @@ This is the variable that holds the definitions for the styles. It
should not be changed directly; use @code{c-add-style} instead.
@end defvar
+@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+@node Guessing the Style, File Styles, Adding Styles, Styles
+@comment node-name, next, previous, up
+@subsection Guessing the Style
+@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+Instead of specifying a style, you can get @ccmode{} to @dfn{guess}
+your style by examining an already formatted code buffer. @ccmode{}
+then determines the ''most frequent'' offset (@pxref{c-offsets-alist})
+for each of the syntactic symbols (@pxref{Indentation Engine Basics})
+encountered in the buffer, and the ''most frequent'' value of
+c-basic-offset (@pxref{Customizing Indentation}), then merges the
+current style with these ''guesses'' to form a new style. This
+combined style is known as the @dfn{guessed style}.
+
+To do this, call @code{c-guess} (or one of the other 5 guessing
+commands) on your sample buffer. The analysis of your code may take
+some time.
+
+You can then set the guessed style in any @ccmode{} buffer with
+@code{c-guess-install}. You can display the style with
+@code{c-guess-view}, and preserve it by copying it into your
+@file{.emacs} for future use, preferably after editing it.
+
+@table @asis
+@item @kbd{M-x c-guess-no-install}
+@itemx @kbd{M-x c-guess-buffer-no-install}
+@itemx @kbd{M-x c-guess-region-no-install}
+@findex c-guess-no-install
+@findex c-guess-buffer-no-install
+@findex c-guess-region-no-install
+@findex guess-no-install (c-)
+@findex guess-buffer-no-install (c-)
+@findex guess-region-no-install (c-)
+These commands analyze a part of the current buffer and guess the
+style from it.
+
+The part of the buffer examined is either the region
+(@code{c-guess-region-no-install}), the entire buffer
+(@code{c-guess-buffer-no-install}), or the first
+@code{c-guess-region-max} bytes (@code{c-guess-no-install}).
+
+Each of these commands can be given an optional prefix argument. This
+instructs @ccmode{} to combine the new guesses with the current
+guesses before forming the guessed style.
+@end table
+
+@table @asis
+@item @kbd{M-x c-guess}
+@itemx @kbd{M-x c-guess-buffer}
+@itemx @kbd{M-x c-guess-region}
+@findex c-guess
+@findex c-guess-buffer
+@findex c-guess-region
+@findex guess (c-)
+@findex guess-buffer (c-)
+@findex guess-region (c-)
+These commands analyze a part of the current buffer, guess the style
+from it, then install the guessed style on the buffer. The guessed
+style is given a name based on the buffer's absolute file name, and
+you can then set this style on any @ccmode{} buffer with @kbd{C-c .}.
+
+The part of the buffer examined is either the region
+(@code{c-guess-region}), the entire buffer (@code{c-guess-buffer}), or
+the first @code{c-guess-region-max} bytes (@code{c-guess}).
+
+Each of these commands can be given an optional prefix argument. This
+instructs @ccmode{} to combine the new guesses with the current
+guesses before forming the guessed style.
+@end table
+
+@defopt c-guess-region-max
+@vindex guess-region-max (c-)
+This variable, default 50000, is the size in bytes of the buffer
+portion examined by c-guess and c-guess-no-install. If set to
+@code{nil}, the entire buffer is examined.
+@end defopt
+
+@defopt c-guess-offset-threshold
+@vindex guess-offset-threshold (c-)
+This variable, default 10, is the maximum offset, either outwards or
+inwards, which will be taken into account by the analysis process.
+Any offset bigger than this will be ignored. For no limit, set this
+variable to a large number.
+@end defopt
+
+@table @asis
+@item @kbd{M-x c-guess-install}
+@findex c-guess-install
+@findex guess-install (c-)
+
+Set the current buffer's style to the guessed style. This prompts you
+to enter an optional new style name to give to the guessed style. By
+default, this name is based on the buffer's absolute file name. You
+can then use this style like any other.
+
+@item @kbd{M-x c-guess-view}
+@findex c-guess-view
+@findex guess-view (c-)
+Display the most recently guessed style in a temporary buffer. This
+display is in the form of a @code{c-add-style} form (@pxref{Adding
+Styles}) which can be easily copied to your @file{.emacs}. You will
+probably want to edit it first.
+
+The display of the guessed style contains these elements:
+
+@table @asis
+@item Placeholder Name
+You should replace this with a style name of your own.
+@item Parent Style
+The style current when the guessing began, from which the guessed
+style inherits (@pxref{Config Basics}) the settings which weren't
+guessed.
+@item Guessed Offsets
+These are the core result of the guessing process. Each of them is
+marked by a comment.
+@item Inherited Offsets
+These are syntactic offsets which have been taken over from the parent
+style. To avoid possible future conflicts, you should remove either
+these offsets or the parent style name.
+@end table
+@end table
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node File Styles, , Adding Styles, Styles
+@node File Styles, , Guessing the Style, Styles
@comment node-name, next, previous, up
@subsection File Styles
@cindex styles, file local
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index afe7c94f447..3f3d616e343 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -2449,22 +2449,33 @@ one of these types of clauses with other clauses like @code{for ... to}
or @code{while}.
@item for @var{var} being the hash-keys of @var{hash-table}
-This clause iterates over the entries in @var{hash-table}. For each
-hash table entry, @var{var} is bound to the entry's key. If you write
-@samp{the hash-values} instead, @var{var} is bound to the values
-of the entries. The clause may be followed by the additional
-term @samp{using (hash-values @var{var2})} (where @code{hash-values}
-is the opposite word of the word following @code{the}) to cause
-@var{var} and @var{var2} to be bound to the two parts of each
-hash table entry.
+@itemx for @var{var} being the hash-values of @var{hash-table}
+This clause iterates over the entries in @var{hash-table} with
+@var{var} bound to each key, or value. A @samp{using} clause can bind
+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))
+@end example
@item for @var{var} being the key-codes of @var{keymap}
+@itemx for @var{var} being the key-bindings of @var{keymap}
This clause iterates over the entries in @var{keymap}.
The iteration does not enter nested keymaps but does enter inherited
(parent) keymaps.
-You can use @samp{the key-bindings} to access the commands bound to
-the keys rather than the key codes, and you can add a @code{using}
-clause to access both the codes and the bindings together.
+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))
+@end example
+
@item for @var{var} being the key-seqs of @var{keymap}
This clause iterates over all key sequences defined by @var{keymap}
@@ -2575,7 +2586,14 @@ the trailing values are ignored, and if there are more variables
than values the trailing variables get the value @code{nil}.
If @code{nil} is used as a variable name, the corresponding
values are ignored. Destructuring may be nested, and dotted
-lists of variables like @code{(x . y)} are allowed.
+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)
+@end example
@node Iteration Clauses, Accumulation Clauses, For Clauses, Loop Facility
@subsection Iteration Clauses
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index eb797789922..99530e6356d 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -452,7 +452,9 @@ then put
@end example
@noindent
-in the @code{dired-load-hook} (@pxref{Installation}).
+in the @code{dired-load-hook} (@pxref{Installation}). (Of course, a
+better way to achieve this particular goal is simply to omit @samp{-a} from
+@code{dired-listing-switches}.)
@end itemize
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index 67df955ca8f..13b640a09fe 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -241,7 +241,7 @@ To add the current file to an existing target, type @kbd{C-c . a}
You can add a file to more than one target; this is OK.
To remove the current file from a target, type @kbd{C-c . d}
-(@code{ede-remove-file}), or or use the @samp{Remove File} menu item
+(@code{ede-remove-file}), or use the @samp{Remove File} menu item
in the @samp{Target Options} submenu. If the file belongs to multiple
targets, this command prompts for each target it could be removed
from.
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index 3ba0796e636..20c2ed90873 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -334,18 +334,6 @@ Brings up Ediff session registry. This feature enables you to quickly find
and restart active Ediff sessions.
@end table
-@noindent
-If you want Ediff to be loaded from the very beginning of your Emacs
-session, you should put this line in your @file{~/.emacs} file:
-
-@example
-(require 'ediff)
-@end example
-
-@noindent
-Otherwise, Ediff will be loaded automatically when you use one of the
-above functions, either directly or through the menus.
-
When the above functions are invoked, the user is prompted for all the
necessary information---typically the files or buffers to compare, merge, or
patch. Ediff tries to be smart about these prompts. For instance, in
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 0ae6a0e7fae..74082bfd3b1 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -814,7 +814,7 @@ way@dots{}). If input redirection is added, also update the
With the handling of @emph{word} specified by an
@code{eshell-special-alist}.
-@item In @code{eshell-veal-using-options}, allow a @code{:complete} tag
+@item In @code{eshell-eval-using-options}, allow a @code{:complete} tag
It would be used to provide completion rules for that command. Then the
macro will automagically define the completion function.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index a35a7e85794..439ff7fbc55 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -1167,16 +1167,17 @@ when you do the @kbd{g} command (@pxref{Scanning New Messages}).
@node Checking New Groups
@subsection Checking New Groups
-Gnus normally determines whether a group is new or not by comparing the
-list of groups from the active file(s) with the lists of subscribed and
-dead groups. This isn't a particularly fast method. If
-@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the
-server for new groups since the last time. This is both faster and
-cheaper. This also means that you can get rid of the list of killed
-groups altogether, so you may set @code{gnus-save-killed-list} to
-@code{nil}, which will save time both at startup, at exit, and all over.
-Saves disk space, too. Why isn't this the default, then?
-Unfortunately, not all servers support this command.
+Gnus normally determines whether a group is new or not by comparing
+the list of groups from the active file(s) with the lists of
+subscribed and dead groups. This isn't a particularly fast method.
+If @code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will
+ask the server for new groups since the last time. This is both
+faster and cheaper. This also means that you can get rid of the list
+of killed groups (@pxref{Group Levels}) altogether, so you may set
+@code{gnus-save-killed-list} to @code{nil}, which will save time both
+at startup, at exit, and all over. Saves disk space, too. Why isn't
+this the default, then? Unfortunately, not all servers support this
+command.
I bet I know what you're thinking now: How do I find out whether my
server supports @code{ask-server}? No? Good, because I don't have a
@@ -1214,9 +1215,10 @@ Some handy pre-fab functions are:
@item gnus-subscribe-zombies
@vindex gnus-subscribe-zombies
-Make all new groups zombies. This is the default. You can browse the
-zombies later (with @kbd{A z}) and either kill them all off properly
-(with @kbd{S z}), or subscribe to them (with @kbd{u}).
+Make all new groups zombies (@pxref{Group Levels}). This is the
+default. You can browse the zombies later (with @kbd{A z}) and either
+kill them all off properly (with @kbd{S z}), or subscribe to them
+(with @kbd{u}).
@item gnus-subscribe-randomly
@vindex gnus-subscribe-randomly
@@ -1300,6 +1302,10 @@ subscribing these groups.
@code{gnus-subscribe-options-newsgroup-method} is used instead. This
variable defaults to @code{gnus-subscribe-alphabetically}.
+The ``options -n'' format is very simplistic. The syntax above is all
+that is supports -- you can force-subscribe hierarchies, or you can
+deny hierarchies, and that's it.
+
@vindex gnus-options-not-subscribe
@vindex gnus-options-subscribe
If you don't want to mess with your @file{.newsrc} file, you can just
@@ -1430,7 +1436,7 @@ several servers where not all servers support @code{ask-server}.
The @code{gnus-startup-file} variable says where the startup files are.
The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup
file being whatever that one is, with a @samp{.eld} appended.
-If you want version control for this file, set
+If you want to keep multiple numbered backups of this file, set
@code{gnus-backup-startup-file}. It respects the same values as the
@code{version-control} variable.
@@ -2360,6 +2366,7 @@ empty subscribed groups and unsubscribed groups, too. Type @kbd{l} to
go back to showing nonempty subscribed groups again. Thus, unsubscribed
groups are hidden, in a way.
+@cindex zombie groups
Zombie and killed groups are similar to unsubscribed groups in that they
are hidden by default. But they are different from subscribed and
unsubscribed groups in that Gnus doesn't ask the news server for
@@ -5568,6 +5575,13 @@ message (@code{gnus-summary-wide-reply-with-original}). This command uses
the process/prefix convention, but only uses the headers from the
first article to determine the recipients.
+@item S L
+@kindex S L (Summary)
+@findex gnus-summary-reply-to-list-with-original
+When replying to a message from a mailing list, send a reply to that
+message to the mailing list, and include the original message
+(@code{gnus-summary-reply-to-list-with-original}).
+
@item S v
@kindex S v (Summary)
@findex gnus-summary-very-wide-reply
@@ -15638,14 +15652,16 @@ will remain on your system until hell freezes over. This bears
repeating one more time, with some spurious capitalizations: IF you do
NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES.
+@vindex gnus-auto-expirable-marks
You do not have to mark articles as expirable by hand. Gnus provides
two features, called ``auto-expire'' and ``total-expire'', that can help you
with this. In a nutshell, ``auto-expire'' means that Gnus hits @kbd{E}
for you when you select an article. And ``total-expire'' means that Gnus
considers all articles as expirable that are read. So, in addition to
the articles marked @samp{E}, also the articles marked @samp{r},
-@samp{R}, @samp{O}, @samp{K}, @samp{Y} and so on are considered
-expirable.
+@samp{R}, @samp{O}, @samp{K}, @samp{Y} (and so on) are considered
+expirable. @code{gnus-auto-expirable-marks} has the full list of
+these marks.
When should either auto-expire or total-expire be used? Most people
who are subscribed to mailing lists split each list into its own group
@@ -18994,9 +19010,8 @@ that you're running out of space. Neither are particularly fast or
efficient, and it's not a particularly good idea to interrupt them (with
@kbd{C-g} or anything else) once you've started one of them.
-Note that other functions, e.g. @code{gnus-request-expire-articles},
-might run @code{gnus-agent-expire} for you to keep the agent
-synchronized with the group.
+Note that other functions might run @code{gnus-agent-expire} for you
+to keep the agent synchronized with the group.
The agent parameter @code{agent-enable-expiration} may be used to
prevent expiration in selected groups.
@@ -23501,7 +23516,7 @@ specifications.
The @code{gnus-face-properties-alist} variable affects the appearance of
displayed Face images. @xref{X-Face}.
-Viewing an @code{Face} header requires an Emacs that is able to display
+Viewing a @code{Face} header requires an Emacs that is able to display
PNG images.
@c Maybe add this:
@c (if (featurep 'xemacs)
@@ -25906,15 +25921,15 @@ of all messages matching a particular set of criteria.
@end enumerate
@menu
-* Setup::
+* Gnus Registry Setup::
* Fancy splitting to parent::
* Registry Article Refer Method::
* Store custom flags and keywords::
* Store arbitrary data::
@end menu
-@node Setup
-@subsection Setup
+@node Gnus Registry Setup
+@subsection Gnus Registry Setup
Fortunately, setting up the Gnus registry is pretty easy:
@@ -26086,6 +26101,21 @@ Call this function to mark an article with a custom registry mark. It
will offer the available marks for completion.
@end defun
+You can use @code{defalias} to install a summary line formatting
+function that will show the registry marks. There are two flavors of
+this function, either showing the marks as single characters, using
+their @code{:char} property, or showing the marks as full strings.
+
+@lisp
+;; show the marks as single characters (see the :char property in
+;; `gnus-registry-marks'):
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+
+;; show the marks by name (see `gnus-registry-marks'):
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+@end lisp
+
+
@node Store arbitrary data
@subsection Store arbitrary data
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index a0ec20c4034..8e01a10bde3 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -13981,25 +13981,25 @@ particular, you may use the functions @code{org-agenda-skip-entry-if}
and @code{org-agenda-skip-subtree-if} in this form, for example:
@table @code
-@item '(org-agenda-skip-entry-if 'scheduled)
+@item (org-agenda-skip-entry-if 'scheduled)
Skip current entry if it has been scheduled.
-@item '(org-agenda-skip-entry-if 'notscheduled)
+@item (org-agenda-skip-entry-if 'notscheduled)
Skip current entry if it has not been scheduled.
-@item '(org-agenda-skip-entry-if 'deadline)
+@item (org-agenda-skip-entry-if 'deadline)
Skip current entry if it has a deadline.
-@item '(org-agenda-skip-entry-if 'scheduled 'deadline)
+@item (org-agenda-skip-entry-if 'scheduled 'deadline)
Skip current entry if it has a deadline, or if it is scheduled.
-@item '(org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))
+@item (org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))
Skip current entry if the TODO keyword is TODO or WAITING.
-@item '(org-agenda-skip-entry-if 'todo 'done)
+@item (org-agenda-skip-entry-if 'todo 'done)
Skip current entry if the TODO keyword marks a DONE state.
-@item '(org-agenda-skip-entry-if 'timestamp)
+@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")
+@item (org-agenda-skip-entry '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 'notregexp "regular expression")
Skip current entry unless the regular expression matches.
-@item '(org-agenda-skip-subtree-if 'regexp "regular expression")
+@item (org-agenda-skip-subtree-if 'regexp "regular expression")
Same as above, but check and skip the entire subtree.
@end table
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index c2b6867c419..3e9ee928822 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -509,8 +509,8 @@ This variable contains the default user name to report to the server.
It defaults to the login name returned by @code{user-login-name}, just
like @code{rcirc-default-nick}.
-@item rcirc-default-user-full-name
-@vindex rcirc-default-user-full-name
+@item rcirc-default-full-name
+@vindex rcirc-default-full-name
@cindex full name
@cindex real name
@cindex surname
@@ -519,7 +519,7 @@ to the name returned by @code{user-full-name}. If you want to hide
your full name, you might want to set it to some pseudonym.
@example
-(setq rcirc-default-user-full-name "Curious Minds Want To Know")
+(setq rcirc-default-full-name "Curious Minds Want To Know")
@end example
@item rcirc-authinfo
@@ -926,7 +926,7 @@ The real answer, therefore, is a @code{/reconnect} command:
(delete-process process)
(rcirc-connect server port nick
rcirc-default-user-name
- rcirc-default-user-full-name
+ rcirc-default-full-name
channels))))
@end smallexample
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 9f64511ea28..fd22fd68567 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2011-03-25.11}
+\def\texinfoversion{2011-05-23.16}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -693,15 +693,6 @@ where each line of input produces a line of output.}
\newdimen\mil \mil=0.001in
-% Old definition--didn't work.
-%\parseargdef\need{\par %
-%% This method tries to make TeX break the page naturally
-%% if the depth of the box does not fit.
-%{\baselineskip=0pt%
-%\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak
-%\prevdepth=-1000pt
-%}}
-
\parseargdef\need{%
% Ensure vertical mode, so we don't make a big box in the middle of a
% paragraph.
@@ -3227,7 +3218,7 @@ end
\finishedtitlepagetrue
}
-%%% Macros to be used within @titlepage:
+% Macros to be used within @titlepage:
\let\subtitlerm=\tenrm
\def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}
@@ -3260,7 +3251,7 @@ end
}
-%%% Set up page headings and footings.
+% Set up page headings and footings.
\let\thispage=\folio
@@ -3959,9 +3950,9 @@ end
\setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip
\global\advance\multitablelinespace by-\ht0
\fi
-%% Test to see if parskip is larger than space between lines of
-%% table. If not, do nothing.
-%% If so, set to same dimension as multitablelinespace.
+% Test to see if parskip is larger than space between lines of
+% table. If not, do nothing.
+% If so, set to same dimension as multitablelinespace.
\ifdim\multitableparskip>\multitablelinespace
\global\multitableparskip=\multitablelinespace
\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
@@ -5536,14 +5527,13 @@ end
% (including whitespace, linebreaking, etc. around it),
% given all the information in convenient, parsed form.
-%%% Args are the skip and penalty (usually negative)
+% Args are the skip and penalty (usually negative)
\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi}
-%%% Define plain chapter starts, and page on/off switching for it
% Parameter controlling skip before chapter headings (if needed)
-
\newskip\chapheadingskip
+% Define plain chapter starts, and page on/off switching for it.
\def\chapbreak{\dobreak \chapheadingskip {-4000}}
\def\chappager{\par\vfill\supereject}
% Because \domark is called before \chapoddpage, the filler page will
@@ -6702,7 +6692,7 @@ end
% commands also insert a nobreak penalty, and we don't want to allow
% a break between a section heading and a defun.
%
- % As a minor refinement, we avoid "club" headers by signalling
+ % As a further refinement, we avoid "club" headers by signalling
% with penalty of 10003 after the very first @deffn in the
% sequence (see above), and penalty of 10002 after any following
% @def command.
@@ -6769,13 +6759,36 @@ end
\def\domakedefun#1#2#3{%
\envdef#1{%
\startdefun
+ \doingtypefnfalse % distinguish typed functions from all else
\parseargusing\activeparens{\printdefunline#3}%
}%
\def#2{\dodefunx#1}%
\def#3%
}
-%%% Untyped functions:
+\newif\ifdoingtypefn % doing typed function?
+\newif\ifrettypeownline % typeset return type on its own line?
+
+% @deftypefnnewline on|off says whether the return type of typed functions
+% are printed on their own line. This affects @deftypefn, @deftypefun,
+% @deftypeop, and @deftypemethod.
+%
+\parseargdef\deftypefnnewline{%
+ \def\temp{#1}%
+ \ifx\temp\onword
+ \expandafter\let\csname SETtxideftypefnnl\endcsname
+ = \empty
+ \else\ifx\temp\offword
+ \expandafter\let\csname SETtxideftypefnnl\endcsname
+ = \relax
+ \else
+ \errhelp = \EMsimple
+ \errmessage{Unknown @txideftypefnnl value `\temp',
+ must be on|off}%
+ \fi\fi
+}
+
+% Untyped functions:
% @deffn category name args
\makedefun{deffn}{\deffngeneral{}}
@@ -6794,7 +6807,7 @@ end
\defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}%
}
-%%% Typed functions:
+% Typed functions:
% @deftypefn category type name args
\makedefun{deftypefn}{\deftypefngeneral{}}
@@ -6809,10 +6822,11 @@ end
%
\def\deftypefngeneral#1#2 #3 #4 #5\endheader{%
\dosubind{fn}{\code{#4}}{#1}%
+ \doingtypefntrue
\defname{#2}{#3}{#4}\defunargs{#5\unskip}%
}
-%%% Typed variables:
+% Typed variables:
% @deftypevr category type var args
\makedefun{deftypevr}{\deftypecvgeneral{}}
@@ -6830,7 +6844,7 @@ end
\defname{#2}{#3}{#4}\defunargs{#5\unskip}%
}
-%%% Untyped variables:
+% Untyped variables:
% @defvr category var args
\makedefun{defvr}#1 {\deftypevrheader{#1} {} }
@@ -6841,7 +6855,8 @@ end
% \defcvof {category of}class var args
\def\defcvof#1#2 {\deftypecvof{#1}#2 {} }
-%%% Type:
+% Types:
+
% @deftp category name args
\makedefun{deftp}#1 #2 #3\endheader{%
\doind{tp}{\code{#2}}%
@@ -6869,25 +6884,49 @@ end
% We are followed by (but not passed) the arguments, if any.
%
\def\defname#1#2#3{%
+ \par
% Get the values of \leftskip and \rightskip as they were outside the @def...
\advance\leftskip by -\defbodyindent
%
- % How we'll format the type name. Putting it in brackets helps
+ % Determine if we are typesetting the return type of a typed function
+ % on a line by itself.
+ \rettypeownlinefalse
+ \ifdoingtypefn % doing a typed function specifically?
+ % then check user option for putting return type on its own line:
+ \expandafter\ifx\csname SETtxideftypefnnl\endcsname\relax \else
+ \rettypeownlinetrue
+ \fi
+ \fi
+ %
+ % How we'll format the category name. Putting it in brackets helps
% distinguish it from the body text that may end up on the next line
% just below it.
\def\temp{#1}%
\setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi}
%
- % Figure out line sizes for the paragraph shape.
+ % Figure out line sizes for the paragraph shape. We'll always have at
+ % least two.
+ \tempnum = 2
+ %
% The first line needs space for \box0; but if \rightskip is nonzero,
% we need only space for the part of \box0 which exceeds it:
\dimen0=\hsize \advance\dimen0 by -\wd0 \advance\dimen0 by \rightskip
+ %
+ % If doing a return type on its own line, we'll have another line.
+ \ifrettypeownline
+ \advance\tempnum by 1
+ \def\maybeshapeline{0in \hsize}%
+ \else
+ \def\maybeshapeline{}%
+ \fi
+ %
% The continuations:
\dimen2=\hsize \advance\dimen2 by -\defargsindent
- % (plain.tex says that \dimen1 should be used only as global.)
- \parshape 2 0in \dimen0 \defargsindent \dimen2
%
- % Put the type name to the right margin.
+ % The final paragraph shape:
+ \parshape \tempnum 0in \dimen0 \maybeshapeline \defargsindent \dimen2
+ %
+ % Put the category name at the right margin.
\noindent
\hbox to 0pt{%
\hfil\box0 \kern-\hsize
@@ -6909,8 +6948,16 @@ end
% . this still does not fix the ?` and !` ligatures, but so far no
% one has made identifiers using them :).
\df \tt
- \def\temp{#2}% return value type
- \ifx\temp\empty\else \tclose{\temp} \fi
+ \def\temp{#2}% text of the return type
+ \ifx\temp\empty\else
+ \tclose{\temp}% typeset the return type
+ \ifrettypeownline
+ % put return type on its own line; prohibit line break following:
+ \hfil\vadjust{\nobreak}\break
+ \else
+ \space % type on same line, so just followed by a space
+ \fi
+ \fi % no return type
#3% output function name
}%
{\rm\enskip}% hskip 0.5 em of \tenrm
@@ -8424,7 +8471,7 @@ directory should work if nowhere else does.}
%
% Latin1 (ISO-8859-1) character definitions.
\def\latonechardefs{%
- \gdef^^a0{~}
+ \gdef^^a0{\tie}
\gdef^^a1{\exclamdown}
\gdef^^a2{\missingcharmsg{CENT SIGN}}
\gdef^^a3{{\pounds}}
@@ -8546,7 +8593,7 @@ directory should work if nowhere else does.}
% Latin2 (ISO-8859-2) character definitions.
\def\lattwochardefs{%
- \gdef^^a0{~}
+ \gdef^^a0{\tie}
\gdef^^a1{\ogonek{A}}
\gdef^^a2{\u{}}
\gdef^^a3{\L}
@@ -9395,6 +9442,8 @@ directory should work if nowhere else does.}
\message{and turning on texinfo input format.}
+\def^^L{\par} % remove \outer, so ^L can appear in an @comment
+
% DEL is a comment character, in case @c does not suffice.
\catcode`\^^? = 14
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 2663d2df0f5..a4e06ab22f1 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1539,7 +1539,8 @@ can return user names only.
@item @code{tramp-parse-netrc}
@findex tramp-parse-netrc
-Finally, a function which parses @file{~/.netrc} like files.
+Finally, a function which parses @file{~/.netrc} like files. This
+includes also @file{~/.authinfo}-style files.
@end table
If you want to keep your own data in a file, with your own structure,
@@ -1598,6 +1599,10 @@ The port can be any @value{tramp} method (@pxref{Inline methods},
@pxref{External methods}), to match only this method. When you omit
the port, you match all @value{tramp} methods.
+In case of problems, setting @code{auth-source-debug} to @code{t}
+gives useful debug messages.
+
+
@anchor{Caching passwords}
@subsection Caching passwords
@@ -2675,6 +2680,12 @@ handling}), file cache, connection cache (@pxref{Connection caching}),
connection buffers.
@end deffn
+@deffn Command tramp-cleanup-this-connection
+This command flushes all objects of the current buffer's remote
+connection. The same objects are removed as in
+@code{tramp-cleanup-connection}.
+@end deffn
+
@deffn Command tramp-cleanup-all-connections
This command flushes objects for all active remote connections. The
same objects are removed as in @code{tramp-cleanup-connection}.
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index c4f5317e5a7..a778f491e76 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -450,7 +450,6 @@ There is a standard widget keymap which you might find useful.
@findex widget-button-press
@findex widget-button-click
@defvr Const widget-keymap
-A keymap with the global keymap as its parent.@*
@key{TAB} and @kbd{C-@key{TAB}} are bound to @code{widget-forward} and
@code{widget-backward}, respectively. @key{RET} and @kbd{Mouse-2}
are bound to @code{widget-button-press} and
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 0eb21406105..bfe584c69a1 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,101 @@
+2011-07-12 Bill Wohler <wohler@newt.com>
+
+ Release MH-E version 8.2.91.
+
+ * NEWS, MH-E-NEWS: Update for MH-E release 8.2.91.
+
+ * MH-E-NEWS: Mention that SourceForge MH-E users will have to
+ update their load-paths.
+
+2011-07-10 Bill Wohler <wohler@newt.com>
+
+ Release MH-E version 8.2.90.
+
+ * NEWS, MH-E-NEWS: Update for MH-E release 8.2.90.
+
+2011-07-07 Tassilo Horn <tassilo@member.fsf.org>
+
+ * themes/tsdh-light-theme.el:
+ * themes/tsdh-dark-theme.el: Make `gnus-button' face inherit from
+ `button', `gnus-header-name' boxed, and define `rcirc-my-nick'
+ face.
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * NEWS: Clarify `smtpmail-auth-credentials' non-existence.
+ Mention the `send-mail-function' default change.
+
+2011-07-07 Chong Yidong <cyd@stupidchicken.com>
+
+ * themes/dichromacy-theme.el:
+ * themes/tango-theme.el:
+ * themes/tango-dark-theme.el:
+ * themes/wheatgrass-theme.el: Don't define button face separately;
+ it inherits from link now.
+
+2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * NEWS: Clarify that `smtpmail-starttls-credentials' doesn't exist.
+
+2011-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * NEWS: Document new emacs-lock.el and renaming of old one.
+
+2011-07-05 Manoj Srivastava <srivasta@ieee.org>
+
+ * themes/manoj-dark-theme.el (manoj-dark): New file.
+
+2011-03-29 Kevin Ryde <user42@zip.com.au>
+
+ * compilation.txt (perl-Test2): New samples.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * tutorials/TUTORIAL.zh: Remove spurious ")" character on the
+ first line.
+
+2011-07-01 Alan Mackenzie <acm@muc.de>
+
+ * NEWS: CC Mode: New "guessing" of style.
+
+2011-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * NEWS: Mention the new primtive secure-hash.
+
+2011-06-14 Chong Yidong <cyd@stupidchicken.com>
+
+ * themes/dichromacy-theme.el: New theme.
+
+2011-06-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * NEWS: Mention new configure option --with-wide-int.
+
+2011-05-24 Leo Liu <sdl.web@gmail.com>
+
+ * NEWS: Mention the new primitive sha1 and the removal of sha1.el.
+
+2011-05-14 Ulf Jasper <ulf.jasper@web.de>
+
+ * images/newsticker/README: Added.
+
+2011-05-13 Ulf Jasper <ulf.jasper@web.de>
+
+ * images/newsticker: Added.
+ * images/newsticker/browse-url.xpm: Added.
+ * images/newsticker/get-all.xpm: Added.
+ * images/newsticker/mark-immortal.xpm: Added.
+ * images/newsticker/mark-read.xpm: Added.
+ * images/newsticker/narrow.xpm: Added.
+ * images/newsticker/next-feed.xpm: Added.
+ * images/newsticker/next-item.xpm: Added.
+ * images/newsticker/prev-feed.xpm: Added.
+ * images/newsticker/prev-item.xpm: Added.
+ * images/newsticker/update.xpm: Added.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ * MH-E-NEWS, PROBLEMS: Fix typo "the the -> the".
+
2011-05-03 Leo Liu <sdl.web@gmail.com>
* NEWS: Mention the new command isearch-yank-pop.
@@ -70,19 +168,24 @@
2011-02-17 Ken Manheimer <ken.manheimer@gmail.com>
- * etc/images/icons/allout-widgets/dark-bg,
- * etc/images/icons/allout-widgets/light-bg,
- * encrypted-locked.{xpm,png}, unlocked-encrypted.{xpm,png}:
+ * images/icons/allout-widgets/dark-bg/encrypted-locked.png:
+ * images/icons/allout-widgets/dark-bg/encrypted-locked.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/unlocked-encrypted.png:
+ * images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm:
Reorganize icon directories and files to reconcile against windows
short-filename clashes.
2011-02-16 Ken Manheimer <ken.manheimer@gmail.com>
- * etc/images/icons/allout-widgets-dark-bg,
- * etc/images/icons/allout-widgets-light-bg: Icons for new
+ * images/icons/allout-widgets-dark-bg,
+ * images/icons/allout-widgets-light-bg: Icons for new
allout-widgets.el.
- * etc/images/icons/README: Include coypright and GPL 3 license for
+ * images/icons/README: Include coypright and GPL 3 license for
new icons.
2011-02-16 Michael Albinus <michael.albinus@gmx.de>
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 27b6d40bd89..a46354d7b7b 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -3,6 +3,36 @@
Copyright (C) 2001-2011 Free Software Foundation, Inc.
See the end of the file for license conditions.
+* Changes in MH-E 8.2.91
+
+Version 8.2.91 fixes the folder window problem that was introduced
+in 8.2.90. It also fixes compilation warnings in XEmacs 21.5.31, as
+well as an error when running XEmacs 21.5.31 in a terminal.
+
+Another implication of the VCS change is that users who download MH-E
+from SourceForge and explicitly load MH-E will have to be change their
+`load-path' to "/path/to/mh-e/emacs/trunk/lisp/mh-e" instead. Note the
+addition of "trunk."
+
+This version of MH-E is packaged with GNU Emacs 24.1
+
+* Changes in MH-E 8.2.90
+
+In 2010, the version control system (VCS) of Emacs was upgraded from
+CVS to Bazaar. In 2011, the MH-E team followed suit and upgraded the
+MH-E repository at SourceForge from CVS to Bazaar as well. The result
+is version 8.2.90 of MH-E, which includes needed changes to the build
+scripts.
+
+Otherwise, this is a small release that includes mostly internal
+changes from the Emacs team. One of these changes manifests itself in
+the user interface--you can now complete folders with abbreviations,
+meaning that `+f/b/b TAB' can complete to `+foo/bar/baz'.
+
+Also, RFC 2047-encoded Subject header fields in replies are now
+decoded.
+
+
* Changes in MH-E 8.2
@@ -320,7 +350,7 @@ changes for MH-E functions are listed here.
Most of the changes have to do with the renaming of the functions with
"mhn" in them to "mh" because nmh doesn't use `mhn'. The names were
-also made consistent with the the family of "mml" functions.
+also made consistent with the family of "mml" functions.
The type of signing or encryption has been generalized so the method
is now an option rather than a part of the function's name. The option
diff --git a/etc/NEWS b/etc/NEWS
index 1001875a2e5..11acbd8c42d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -47,6 +47,9 @@ also depend on Gtk+. You can disable them with --without-rsvg and
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.
+** There is a new configure option --with-wide-int.
+With it, Emacs integers typically have 62 bits, even on 32-bit machines.
+
---
** 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
@@ -55,24 +58,29 @@ automatically select it.
* 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.
+---
** On Windows, Emacs now warns when the obsolete _emacs init file is used,
and also when HOME is set to C:\ by default.
* Changes in Emacs 24.1
-** Completion in a non-minibuffer now tries to detect the end of completion
-and pops down the *Completions* buffer accordingly.
+** 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.
** emacsclient changes
++++
*** New emacsclient argument --parent-id ID can be used to open a
client frame in parent X window ID, via XEmbed. This works like the
--parent-id argument to Emacs.
@@ -80,18 +88,87 @@ client frame in parent X window ID, via XEmbed. This works like the
+++
*** New emacsclient argument -q/--quiet suppresses some status messages.
++++
+*** New emacsclient argument --frame-parameters can be used to set the
+frame parameters of a newly-created graphical frame.
+
++++
*** If emacsclient shuts down as a result of Emacs signalling an
error, its exit status is 1.
-** Completion can cycle, depending on completion-cycle-threshold.
+** Completion
+
+*** 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.
+
+*** Completion in a non-minibuffer now tries to detect the end of completion
+and pops down the *Completions* buffer accordingly.
+
+*** Completion can cycle, depending on completion-cycle-threshold.
-** `completing-read' can be customized using the new variable
+*** New completion style `substring'.
+
+*** Completion style can be set per-category `completion-category-overrides'.
+
+*** Completion of buffers now uses substring completion by default.
+
+*** `completing-read' can be customized using the new variable
`completing-read-function'.
+*** 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.
+
** auto-mode-case-fold is now enabled by default.
+** Mail changes
+
+The default of `send-mail-function' has changed from
+`sendmail-send-it' (on GNU/Linux and other Unix-like systems) or
+`mailclient-send-it' (on Windows) to `sendmail-query-once'. This new
+default will ask the user (once) whether to use the internal smtpmail
+package to send email, or to use the old, external defaults.
+
+** smtpmail changes
+
+*** smtpmail has been largely rewritten to upgrade to STARTTLS if
+possible, and uses the auth-source framework for getting credentials.
+The rewrite should be largely compatible with previous versions of
+smtpmail, but there are two major incompatibilities:
+
+*** `smtpmail-auth-credentials' no longer exists. That variable used
+to be be either ~/.authinfo (in which case you won't see any
+difference), but if it were a direct list of user names and passwords,
+it will be ignored, and you will be prompted for the user name and the
+password instead. They will then be saved to ~/.authinfo.
+
+If you wish to copy over all the credentials from
+`smtpmail-auth-credentials' to your ~/.authinfo file manually, instead
+of letting smtpmail prompt you for these values, that's also possible.
+
+If you had, for instance,
+
+(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
+
+*** Similarly, `smtpmail-starttls-credentials' no longer exists. If
+you had that set, then then 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.
+
+** Internationalization changes
+
+++
-** Emacs now supports display and editing of bidirectional text.
+*** Emacs now supports display and editing of bidirectional text.
See the node "Bidirectional Editing" in the Emacs Manual for some
additional documentation.
@@ -113,6 +190,20 @@ Reordering of bidirectional text for display in Emacs is a "Full
bidirectionality" class implementation of the Unicode Bidirectional
Algorithm.
++++
+*** Enhanced support for characters that have no glyphs in available fonts.
+If a character has no glyphs in any of the available fonts, Emacs by
+default will display 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'.
+
+On character terminals these methods are used for characters that
+cannot be encoded by the `terminal-coding-system'.
+
+*** There are two new input methods for Persian/Farsi: farsi and farsi-translit.
+
** GTK scroll-bars are now placed on the right by default.
Use `set-scroll-bar-mode' to change this.
@@ -150,19 +241,9 @@ off by customizing x-gtk-use-system-tooltips.
with Xft. To change font, use the X resource font, for example:
Emacs.pane.menubar.font: Courier-12
-+++
-** Enhanced support for characters that have no glyphs in available fonts.
-If a character has no glyphs in any of the available fonts, Emacs by
-default will display 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'.
-
-On character terminals these methods are used for characters that
-cannot be encoded by the `terminal-coding-system'.
-
** 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.
** On Nextstep/OSX, the menu bar can be hidden by customizing
ns-auto-hide-menu-bar.
@@ -265,13 +346,28 @@ the remote file-name cache is used for read access.
+++
** The use of a "mode: minor" specification in a file local variables section
-to enable a minor-mode is deprecated. Instead, use "eval: (minor-mode)".
+to enable a minor-mode is deprecated. Instead, use "eval: (minor-mode 1)".
** The standalone programs lib-src/digest-doc and sorted-doc have been
replaced with Lisp commands `doc-file-to-man' and `doc-file-to-info'.
+---
+** The standalone program `fakemail' has been removed.
+If you need it, feedmail.el ought to provide a superset of the functionality.
+
++++
** 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.
+
* Editing Changes in Emacs 24.1
@@ -326,44 +422,59 @@ 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.
-*** `mouse-drag-copy-region' now defaults to nil.
++++
*** `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 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.
+---
**** 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.
+*** Support for X clipboard managers has been added.
+
+**** To inhibit use of the clipboard manager, set
+`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 an prefix argument, this
prompts for a number to count from and for a format string.
@@ -375,6 +486,10 @@ $ESHELL nor variable `explicit-shell-file-name' is set.
* Changes in Specialized Modes and Packages in Emacs 24.1
+** MH-E
+
+*** Upgraded to MH-E version 8.2.91. See MH-E-NEWS for details.
+
** comint and modes derived from it use the generic completion code.
** Compilation mode
@@ -397,11 +512,24 @@ Just set shell-dir-cookie-re to an appropriate regexp.
** Modula-2 mode provides auto-indentation.
+** 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.
+
+*** 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'.
+
** latex-electric-env-pair-mode keeps \begin..\end matched on the fly.
** FIXME: xdg-open for browse-url and reportbug, 2010/08.
-** Archive Mode has basic support to browse 7z archives.
+** Archive Mode has basic support to browse and update 7z archives.
** browse-url has gotten a new variable that is used for mailto: URLs,
`browse-url-mailto-function', which defaults to `browse-url-mail'.
@@ -461,10 +589,19 @@ 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.
@@ -639,6 +776,14 @@ listing object name completions when being sent text via
*** An API for manipulating SQL product definitions has been added.
+** 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.
+
** sregex.el is now obsolete, since rx.el is a strict superset.
** s-region.el and pc-select are now declared obsolete,
@@ -690,6 +835,9 @@ the user 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
@@ -703,8 +851,15 @@ 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.
+** CC Mode (C, C++, etc.)
+
+*** New feature to "guess" the style in an existing buffer.
+
** Miscellaneous
++++
+*** f90.el has some support for Fortran 2008 syntax.
+
---
*** `copyright-fix-years' can optionally convert consecutive years to ranges.
@@ -721,6 +876,9 @@ consult.
* 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 C-x C-q in Occur mode.
+
** New global minor modes electric-pair-mode, electric-indent-mode,
and electric-layout-mode.
@@ -743,6 +901,13 @@ soap-inspect.el is an interactive inspector for SOAP WSDL structures.
** 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.
+
* Incompatible Lisp Changes in Emacs 24.1
@@ -817,6 +982,34 @@ sc.el, x-menu.el, rnews.el, rnewspost.el
* Lisp changes in Emacs 24.1
+** Window changes
+
+*** `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.
+
+*** FIXME: buffer-display-alist changes
+
+** 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.
+
+*** 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':
+- `category' is the kind of objects returned (e.g., `buffer', `file', ...),
+ used to select a style in completion-category-overrides.
+- `annotation-function' to add annotations in *Completions*.
+- `display-sort-function' to specify how to sort entries in *Completions*.
+- `cycle-sort-function' to specify how to sort entries when cycling.
+
** `glyphless-char-display' can now distinguish between graphical and
text terminal display, via a char-table entry that is a cons cell.
@@ -893,8 +1086,6 @@ argument is supplied (see Trash changes, above).
** buffer-substring-filters is obsoleted by filter-buffer-substring-functions.
-** New completion style `substring'.
-
** `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 signalling an error if the user provides a invalid
@@ -906,12 +1097,14 @@ i.e. via menu entries of the form `(menu-item "--")'.
** Image API
-*** When the image type is one of listed in `image-animated-types'
-and the number of sub-images in the image is more than one, then the
-new function `create-animated-image' creates an animated image where
-sub-images are displayed successively with the duration defined by
-`image-animate-max-time' and the delay between sub-images defined
-by the Graphic Control Extension of the image.
+*** Animated images support (currently animated gifs only).
+
+**** `image-animated-p' returns non-nil if an image can be animated.
+
+**** `image-animate' animates a supplied image spec.
+
+**** `image-animate-timer' returns the timer object for an image that
+is being animated.
*** `image-extension-data' is renamed to `image-metadata'.
@@ -958,6 +1151,14 @@ 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.
+
+---
+** rx.el has a new `group-n' construct for explicitly numbered groups.
+
+** keymaps can inherit from multiple parents.
* Changes in Emacs 24.1 on non-free operating systems
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 15d4ea227d0..2f344955cb2 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1217,7 +1217,7 @@ be carried out at the same time:
2) If the connection is very slow, you might also want to consider
switching off scroll bars, menu bar, and tool bar. Adding the
following forms to your .emacs file will accomplish that, but only
- after the the initial frame is displayed:
+ after the initial frame is displayed:
(scroll-bar-mode -1)
(menu-bar-mode -1)
diff --git a/etc/TODO b/etc/TODO
index 303d21b053b..c38b04a681d 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -13,15 +13,10 @@ to the FSF.
* Tentative plan for Emacs-24
-** Bidi
-** lexbind: I haven't checked the status of the code recently, so
- I don't know how realistic it is to include it. But it's been around
- for a long time, and I trust Miles, so I have hope.
** concurrency: including it as an "experimental" compile-time option
sounds good. Of course there might still be big questions around
"which form of concurrency" we'll want.
** Overhaul of customize: sounds wonderful.
-** some kind of color-theme: agreed.
** 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
resulting efficiency will be sufficient.
@@ -30,7 +25,6 @@ to the FSF.
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.
-** package manager.
** 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
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 8e19222143a..888c1f94c33 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -254,6 +254,7 @@ foo.c:8.23-45: Informational: message
foo.c:8-23: message
foo.c:8-45.3: message
foo.c:8.23-9.1: message
+foo.el:3:1:Error: End of file during parsing
jade:dbcommon.dsl:133:17:E: missing argument for function call
G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found.
file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found.
@@ -496,6 +497,16 @@ symbol: perl--Test
# Failed test 1 in foo.t at line 6
+* Perl Test.pm module error messages comparing two values
+
+symbol: perl--Test2
+
+# Test 3 got: "99" (d-compilation-perl.t at line 29)
+# Expected: "88" (my test name)
+# d-compilation-perl.t line 29 is: ok(99,88,'my test name');
+
+# Test 6 got: "xx" (foo.t at line 33 fail #2)
+# Expected: "yy"
* Perl Test::Harness output
diff --git a/etc/images/newsticker/README b/etc/images/newsticker/README
new file mode 100644
index 00000000000..dc91d9eafd4
--- /dev/null
+++ b/etc/images/newsticker/README
@@ -0,0 +1,8 @@
+COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
+
+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.
+License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/newsticker/browse-url.xpm b/etc/images/newsticker/browse-url.xpm
new file mode 100644
index 00000000000..e9f7900b893
--- /dev/null
+++ b/etc/images/newsticker/browse-url.xpm
@@ -0,0 +1,66 @@
+/* XPM */
+static char * visit_xpm[] = {
+"24 24 39 1",
+" c None",
+". c #000000",
+"+ c #FFFFFF",
+"@ c #00E63D",
+"# c #00E83E",
+"$ c #00E73D",
+"% c #00E93E",
+"& c #00E63C",
+"* c #00E53C",
+"= c #00E23B",
+"- c #00E33B",
+"; c #00E83D",
+"> c #00E13A",
+", c #00DD38",
+"' c #00DE38",
+") c #00E23A",
+"! c #00E43C",
+"~ c #00DF39",
+"{ c #00DB37",
+"] c #00D634",
+"^ c #00D734",
+"/ c #00E039",
+"( c #00DC37",
+"_ c #00D835",
+": c #00D332",
+"< c #00CD2F",
+"[ c #00DB36",
+"} c #00D433",
+"| c #00CF30",
+"1 c #00DA36",
+"2 c #00D936",
+"3 c #00D533",
+"4 c #00D131",
+"5 c #00CE2F",
+"6 c #00CC2F",
+"7 c #00CA2D",
+"8 c #00C62B",
+"9 c #00C52A",
+"0 c #00BE27",
+" ",
+" ",
+" . ",
+" .+. ",
+" .+++. ",
+" .++.++. ",
+" .++.@.++. ",
+" .++.##$.++. ",
+" .++.%%%#&.++. ",
+" .++.$%%%#*=.++. ",
+" .++.-@;##$*>,.++. ",
+" .++.')!&@@*=~{].++. ",
+" .++.^{~>---)/(_:<.++. ",
+" .++.^[,~/~'(_}|.++. ",
+" .++.]_1[12^:|.++. ",
+" .++.:}33:45.++. ",
+" .++.<5567.++. ",
+" .++.889.++. ",
+" .++.0.++. ",
+" .++.++. ",
+" .+++. ",
+" .+. ",
+" . ",
+" "};
diff --git a/etc/images/newsticker/get-all.xpm b/etc/images/newsticker/get-all.xpm
new file mode 100644
index 00000000000..2df66d7fe23
--- /dev/null
+++ b/etc/images/newsticker/get-all.xpm
@@ -0,0 +1,97 @@
+/* XPM */
+static char * get_all_xpm[] = {
+"24 24 70 1",
+" c None",
+". c #000000",
+"+ c #F3DA00",
+"@ c #F5DF00",
+"# c #F7E300",
+"$ c #F9E700",
+"% c #FAEA00",
+"& c #FBEC00",
+"* c #FBED00",
+"= c #FCEE00",
+"- c #FAEB00",
+"; c #F9E800",
+"> c #F8E500",
+", c #F6E000",
+"' c #F4DB00",
+") c #F1D500",
+"! c #EFD000",
+"~ c #B7CA00",
+"{ c #BFD100",
+"] c #C5D700",
+"^ c #CBDB00",
+"/ c #CFDF00",
+"( c #D2E200",
+"_ c #D4E400",
+": c #D3E300",
+"< c #D0E000",
+"[ c #CCDD00",
+"} c #C7D800",
+"| c #C1D300",
+"1 c #BACC00",
+"2 c #B1C500",
+"3 c #A8BC00",
+"4 c #20A900",
+"5 c #22AF00",
+"6 c #24B500",
+"7 c #26B900",
+"8 c #27BC00",
+"9 c #27BE00",
+"0 c #28BF00",
+"a c #27BD00",
+"b c #26BA00",
+"c c #25B600",
+"d c #23B100",
+"e c #21AB00",
+"f c #1FA400",
+"g c #1C9B00",
+"h c #21AA00",
+"i c #24B300",
+"j c #25B800",
+"k c #25B700",
+"l c #24B400",
+"m c #23B000",
+"n c #1FA500",
+"o c #1D9E00",
+"p c #20A800",
+"q c #21AC00",
+"r c #23B200",
+"s c #22AD00",
+"t c #1D9F00",
+"u c #20A700",
+"v c #1EA100",
+"w c #1C9C00",
+"x c #1DA000",
+"y c #1B9800",
+"z c #1A9600",
+"A c #1A9700",
+"B c #1A9500",
+"C c #199200",
+"D c #189100",
+"E c #178C00",
+" ",
+" ",
+" ",
+" ",
+" ................... ",
+" .+@#$%&*=*&-;>,')!. ",
+" ................... ",
+" ",
+" ................... ",
+" .~{]^/(___:<[}|123. ",
+" ................... ",
+" ",
+" ................... ",
+" .45678909abcdefg. ",
+" .h5icj7jklmeno. ",
+" .pq5drrmshft. ",
+" .fu4h4pnvw. ",
+" .oxvxtwy. ",
+" .zAAzB. ",
+" .CCD. ",
+" .E. ",
+" . ",
+" ",
+" "};
diff --git a/etc/images/newsticker/mark-immortal.xpm b/etc/images/newsticker/mark-immortal.xpm
new file mode 100644
index 00000000000..4e5a3649eb7
--- /dev/null
+++ b/etc/images/newsticker/mark-immortal.xpm
@@ -0,0 +1,120 @@
+/* XPM */
+static char * mark_immortal_xpm[] = {
+"24 24 93 2",
+" c None",
+". c #171717",
+"+ c #030303",
+"@ c #000000",
+"# c #181818",
+"$ c #090909",
+"% c #FFC960",
+"& c #FFCB61",
+"* c #FFCB62",
+"= c #FFC961",
+"- c #FFC75F",
+"; c #FFC65E",
+"> c #FFCA61",
+", c #FFCD63",
+"' c #FFCF65",
+") c #FFD065",
+"! c #FFCE64",
+"~ c #FFC35C",
+"{ c #FFC45D",
+"] c #FFD166",
+"^ c #FFD267",
+"/ c #FFD368",
+"( c #FFD167",
+"_ c #FFC05A",
+": c #010101",
+"< c #040404",
+"[ c #FFCC62",
+"} c #FFD569",
+"| c #FFD56A",
+"1 c #FFC860",
+"2 c #FFC25B",
+"3 c #FFBB56",
+"4 c #020202",
+"5 c #060606",
+"6 c #FFC15B",
+"7 c #FFC85F",
+"8 c #FFD469",
+"9 c #FFD66A",
+"0 c #FFBC57",
+"a c #1B1B1B",
+"b c #070707",
+"c c #FFBA55",
+"d c #FFB451",
+"e c #FFB954",
+"f c #FFB350",
+"g c #FFB652",
+"h c #FFBE58",
+"i c #FFCD64",
+"j c #FFD066",
+"k c #FFC059",
+"l c #FFB14E",
+"m c #0B0B0B",
+"n c #FFBB55",
+"o c #FFC15A",
+"p c #FFB552",
+"q c #FFAD4B",
+"r c #080808",
+"s c #FFAF4C",
+"t c #FFB853",
+"u c #FFA948",
+"v c #050505",
+"w c #FFB04E",
+"x c #FFB753",
+"y c #FFBC56",
+"z c #FFC55D",
+"A c #FFC55E",
+"B c #FFC45C",
+"C c #FFBD57",
+"D c #FFB854",
+"E c #FFB34F",
+"F c #FFAB4A",
+"G c #FFA545",
+"H c #FFAA49",
+"I c #FFB04D",
+"J c #FFB551",
+"K c #FFBF58",
+"L c #FFB24F",
+"M c #FFAC4A",
+"N c #FFA646",
+"O c #FFA344",
+"P c #FFA848",
+"Q c #FFB14F",
+"R c #FFAF4D",
+"S c #FFA546",
+"T c #FFA243",
+"U c #FFA445",
+"V c #FFAE4C",
+"W c #FFA444",
+"X c #FFA142",
+"Y c #FF9F41",
+"Z c #0A0A0A",
+"` c #FF9E40",
+" . c #FF9F40",
+" ",
+" ",
+" ",
+" . + @ @ + # ",
+" $ @ % & * * = - + + ",
+" @ ; > , ' ) ' ! * - ~ @ ",
+" @ { > ! ] ^ / / ( ' * ; _ : ",
+" < _ ; [ ) / } | } / ] , 1 2 3 4 ",
+" 5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a ",
+" b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5 ",
+" : e _ ; * ) / 8 } } / ] , 1 2 3 f 5 ",
+" : g h { = i j ^ / ^ ] ! * ; k e l m ",
+" : f n o ; > , ' ) ' ! * - 2 0 p q r ",
+" : s g 0 6 ; % > * * = - ~ h t l u r ",
+" v u w x y k ~ z A z B o C D E F G b ",
+" 5 H I J e 0 h K h C c x L M N . ",
+" 4 O P q Q d g x g J L R H S T < ",
+" @ T U P F q V q M H N W X + ",
+" @ Y T O W G G W O X Y @ ",
+" 4 Z ` Y Y Y .` 4 4 ",
+" 5 : : @ @ Z ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/mark-read.xpm b/etc/images/newsticker/mark-read.xpm
new file mode 100644
index 00000000000..3a643bb786a
--- /dev/null
+++ b/etc/images/newsticker/mark-read.xpm
@@ -0,0 +1,71 @@
+/* XPM */
+static char * mark_read_xpm[] = {
+"24 24 44 1",
+" c None",
+". c #C20000",
+"+ c #BE0000",
+"@ c #C70000",
+"# c #CE0000",
+"$ c #C90000",
+"% c #BD0000",
+"& c #CB0000",
+"* c #D10000",
+"= c #D70000",
+"- c #D30000",
+"; c #CD0000",
+"> c #C60000",
+", c #D40000",
+"' c #DA0000",
+") c #DE0000",
+"! c #DB0000",
+"~ c #D60000",
+"{ c #D00000",
+"] c #DC0000",
+"^ c #E00000",
+"/ c #E40000",
+"( c #E10000",
+"_ c #DD0000",
+": c #D80000",
+"< c #E50000",
+"[ c #E70000",
+"} c #E60000",
+"| c #E20000",
+"1 c #E90000",
+"2 c #E80000",
+"3 c #E30000",
+"4 c #DF0000",
+"5 c #D90000",
+"6 c #CC0000",
+"7 c #C10000",
+"8 c #C30000",
+"9 c #BF0000",
+"0 c #B90000",
+"a c #BC0000",
+"b c #BB0000",
+"c c #B80000",
+"d c #B50000",
+"e c #B70000",
+" ",
+" ",
+" ",
+" . + ",
+" +@# $.% ",
+" &*= -;> ",
+" ,') !~{ ",
+" ]^/ (_: ",
+" (<[ }|) ",
+" <[1 2<| ",
+" }222[< ",
+" }}}< ",
+" 333| ",
+" _4^4)] ",
+" ~:' 5=- ",
+" 6{- *#$ ",
+" 7>$ @89 ",
+" 0a+ %bc ",
+" ddc edd ",
+" ddd ddd ",
+" d d ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/narrow.xpm b/etc/images/newsticker/narrow.xpm
new file mode 100644
index 00000000000..d802764aa22
--- /dev/null
+++ b/etc/images/newsticker/narrow.xpm
@@ -0,0 +1,75 @@
+/* XPM */
+static char * narrow_xpm[] = {
+"24 24 48 1",
+" c None",
+". c #000000",
+"+ c #969696",
+"@ c #9E9E9E",
+"# c #A4A4A4",
+"$ c #AAAAAA",
+"% c #AEAEAE",
+"& c #B1B1B1",
+"* c #B3B3B3",
+"= c #B4B4B4",
+"- c #B2B2B2",
+"; c #AFAFAF",
+"> c #ABABAB",
+", c #A6A6A6",
+"' c #A0A0A0",
+") c #989898",
+"! c #909090",
+"~ c #73AAD4",
+"{ c #7AB2DA",
+"] c #7FB8DF",
+"^ c #84BDE3",
+"/ c #88C2E7",
+"( c #8BC5E9",
+"_ c #8DC7EB",
+": c #8CC6EA",
+"< c #89C3E8",
+"[ c #86BFE5",
+"} c #81BAE1",
+"| c #7BB3DC",
+"1 c #75ACD6",
+"2 c #6DA4CF",
+"3 c #979797",
+"4 c #A3A3A3",
+"5 c #A8A8A8",
+"6 c #ADADAD",
+"7 c #ACACAC",
+"8 c #A9A9A9",
+"9 c #A5A5A5",
+"0 c #9A9A9A",
+"a c #929292",
+"b c #8C8C8C",
+"c c #808080",
+"d c #818181",
+"e c #838383",
+"f c #848484",
+"g c #858585",
+"h c #868686",
+"i c #828282",
+" ",
+" ",
+" ",
+" .................. ",
+" .+@#$%&*=*-;>,')!. ",
+" .................. ",
+" ",
+" ",
+" .................. ",
+" .~{]^/(___:<[}|12. ",
+" .................. ",
+" ",
+" ",
+" .................. ",
+" .!3@45>666789'0ab. ",
+" .................. ",
+" ",
+" ",
+" .................. ",
+" .cccdefghhgficccc. ",
+" .................. ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/next-feed.xpm b/etc/images/newsticker/next-feed.xpm
new file mode 100644
index 00000000000..9424e16d289
--- /dev/null
+++ b/etc/images/newsticker/next-feed.xpm
@@ -0,0 +1,84 @@
+/* XPM */
+static char * next_feed_xpm[] = {
+"24 24 57 1",
+" c None",
+". c #000000",
+"+ c #6CA2CE",
+"@ c #75ADD6",
+"# c #71A8D3",
+"$ c #79B1DA",
+"% c #7EB7DE",
+"& c #7DB5DD",
+"* c #81BAE1",
+"= c #85BEE4",
+"- c #78B0D9",
+"; c #7FB7DE",
+"> c #83BCE3",
+", c #87C1E6",
+"' c #8AC4E9",
+") c #7BB3DB",
+"! c #80B8DF",
+"~ c #88C2E7",
+"{ c #8BC5E9",
+"] c #8DC7EB",
+"^ c #7CB4DC",
+"/ c #7FB8DF",
+"( c #84BDE3",
+"_ c #7BB3DC",
+": c #83BCE2",
+"< c #87C0E6",
+"[ c #8AC4E8",
+"} c #8BC5EA",
+"| c #8CC6EA",
+"1 c #88C1E6",
+"2 c #89C3E8",
+"3 c #8AC3E8",
+"4 c #7EB6DE",
+"5 c #82BBE1",
+"6 c #86C0E5",
+"7 c #87C0E5",
+"8 c #75ACD6",
+"9 c #7AB2DA",
+"0 c #81B9E0",
+"a c #82BBE2",
+"b c #71A8D2",
+"c c #70A7D1",
+"d c #74ACD6",
+"e c #699FCC",
+"f c #6EA5D0",
+"g c #72A9D4",
+"h c #669CC9",
+"i c #6298C5",
+"j c #679DCA",
+"k c #6BA1CD",
+"l c #6095C3",
+"m c #5C91C0",
+"n c #5F94C2",
+"o c #5B90C0",
+"p c #588CBC",
+"q c #578CBC",
+"r c #5589BA",
+" ",
+" ",
+" . ... ",
+" .. .+. ",
+" .@. .#. ",
+" .$%. .@. ",
+" .&*=. .-. ",
+" .;>,'. .). ",
+" .!=~{]. .^. ",
+" ./(~{]]. ._. ",
+" .%:<[}||. .). ",
+" .&*=12'3~. .-. ",
+" .$45=6<7. .@. ",
+" .8940a:. .b. ",
+" .cd-)&. .+. ",
+" .efg8. .h. ",
+" .ijk. .l. ",
+" .mn. .o. ",
+" .p. .q. ",
+" .. .r. ",
+" . ... ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/next-item.xpm b/etc/images/newsticker/next-item.xpm
new file mode 100644
index 00000000000..b3759cc1b61
--- /dev/null
+++ b/etc/images/newsticker/next-item.xpm
@@ -0,0 +1,69 @@
+/* XPM */
+static char * next_xpm[] = {
+"24 24 42 1",
+" c None",
+". c #000000",
+"+ c #7EB6DE",
+"@ c #82BBE2",
+"# c #85BEE4",
+"$ c #88C1E7",
+"% c #8AC3E8",
+"& c #87C1E6",
+"* c #8AC4E9",
+"= c #8CC6EA",
+"- c #8CC6EB",
+"; c #88C2E7",
+"> c #8BC5E9",
+", c #8DC7EB",
+"' c #87C0E6",
+") c #8AC4E8",
+"! c #8BC5EA",
+"~ c #8BC4E9",
+"{ c #88C1E6",
+"] c #89C3E8",
+"^ c #86BFE5",
+"/ c #83BBE2",
+"( c #82BBE1",
+"_ c #86C0E5",
+": c #87C0E5",
+"< c #83BCE2",
+"[ c #81B9E0",
+"} c #81BAE1",
+"| c #78B0D9",
+"1 c #7BB3DB",
+"2 c #7DB5DD",
+"3 c #7DB6DD",
+"4 c #72A9D4",
+"5 c #75ACD6",
+"6 c #76AED7",
+"7 c #77AFD8",
+"8 c #6BA1CD",
+"9 c #6EA4CF",
+"0 c #6FA6D1",
+"a c #6298C6",
+"b c #659BC8",
+"c c #5C91C0",
+" ",
+" ",
+" . ",
+" .. ",
+" .+. ",
+" .@#. ",
+" .#$%. ",
+" .&*=-. ",
+" .;>,,,. ",
+" .;>,,,=. ",
+" .')!==~;. ",
+" .#{]*%;^/. ",
+" .(#_':#<. ",
+" .+[@</}. ",
+" .|1232. ",
+" .4567. ",
+" .890. ",
+" .ab. ",
+" .c. ",
+" .. ",
+" . ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/prev-feed.xpm b/etc/images/newsticker/prev-feed.xpm
new file mode 100644
index 00000000000..9871eaa637e
--- /dev/null
+++ b/etc/images/newsticker/prev-feed.xpm
@@ -0,0 +1,79 @@
+/* XPM */
+static char * prev_feed_xpm[] = {
+"24 24 52 1",
+" c None",
+". c #000000",
+"+ c #70A7D2",
+"@ c #75ADD6",
+"# c #71A8D3",
+"$ c #79B1DA",
+"% c #7BB3DB",
+"& c #7DB5DD",
+"* c #83BBE2",
+"= c #7EB6DE",
+"- c #78B0D9",
+"; c #7FB7DE",
+"> c #88C2E7",
+", c #85BEE4",
+"' c #80B9E0",
+") c #80B8DF",
+"! c #8CC6EA",
+"~ c #89C3E8",
+"{ c #86BFE5",
+"] c #81BAE1",
+"^ c #7CB4DC",
+"/ c #7FB8DF",
+"( c #8DC7EB",
+"_ c #7BB3DC",
+": c #7EB7DE",
+"< c #8BC4E9",
+"[ c #8AC4E9",
+"} c #8AC3E8",
+"| c #87C0E6",
+"1 c #87C0E5",
+"2 c #83BCE2",
+"3 c #75ACD6",
+"4 c #7FB7DF",
+"5 c #77AED8",
+"6 c #71A8D2",
+"7 c #70A7D1",
+"8 c #76ADD7",
+"9 c #6CA2CE",
+"0 c #699FCC",
+"a c #73AAD4",
+"b c #6BA1CD",
+"c c #669CC9",
+"d c #6298C5",
+"e c #689ECB",
+"f c #6499C7",
+"g c #6095C3",
+"h c #5C91C0",
+"i c #5E93C2",
+"j c #5B90C0",
+"k c #588CBC",
+"l c #578CBC",
+"m c #5589BA",
+" ",
+" ",
+" ... . ",
+" .+. .. ",
+" .@. .#. ",
+" .$. .%@. ",
+" .&. .*=-. ",
+" .;. .>,'%. ",
+" .). .!~{]^. ",
+" ./. .(!~{]_. ",
+" .:. .!!<>,'%. ",
+" .&. .~[}>{*=-. ",
+" .$. .|1,2/%@. ",
+" .3. .*]4%56. ",
+" .7. .^$8#9. ",
+" .0. .a7bc. ",
+" .d. .efg. ",
+" .h. .ij. ",
+" .k. .l. ",
+" .m. .. ",
+" ... . ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/prev-item.xpm b/etc/images/newsticker/prev-item.xpm
new file mode 100644
index 00000000000..f9d71f912f6
--- /dev/null
+++ b/etc/images/newsticker/prev-item.xpm
@@ -0,0 +1,66 @@
+/* XPM */
+static char * previous_xpm[] = {
+"24 24 39 1",
+" c None",
+". c #000000",
+"+ c #7BB3DB",
+"@ c #83BCE2",
+"# c #7FB8DF",
+"$ c #89C2E7",
+"% c #86BFE5",
+"& c #83BBE2",
+"* c #8CC6EA",
+"= c #8BC4E9",
+"- c #88C2E7",
+"; c #85BEE4",
+"> c #8DC7EB",
+", c #89C3E8",
+"' c #8AC4E8",
+") c #8BC5EA",
+"! c #88C1E6",
+"~ c #8AC4E9",
+"{ c #8AC3E8",
+"] c #86C0E5",
+"^ c #87C0E6",
+"/ c #87C0E5",
+"( c #82BBE2",
+"_ c #81BAE1",
+": c #7FB7DF",
+"< c #7DB6DD",
+"[ c #7DB5DD",
+"} c #7CB4DC",
+"| c #79B1DA",
+"1 c #76ADD7",
+"2 c #77AFD8",
+"3 c #73AAD4",
+"4 c #70A7D1",
+"5 c #6EA5D0",
+"6 c #6CA2CE",
+"7 c #689ECB",
+"8 c #6399C7",
+"9 c #6095C4",
+"0 c #5C90C0",
+" ",
+" ",
+" . ",
+" .. ",
+" .+. ",
+" .@#. ",
+" .$%&. ",
+" .*=-;. ",
+" .>>*,%. ",
+" .>>>*,%. ",
+" .')**=-;. ",
+" .;!,~{-%&. ",
+" .;]^/;@#. ",
+" .(@&_:+. ",
+" .<[}|1. ",
+" .2134. ",
+" .567. ",
+" .89. ",
+" .0. ",
+" .. ",
+" . ",
+" ",
+" ",
+" "};
diff --git a/etc/images/newsticker/update.xpm b/etc/images/newsticker/update.xpm
new file mode 100644
index 00000000000..35d6c18ba11
--- /dev/null
+++ b/etc/images/newsticker/update.xpm
@@ -0,0 +1,64 @@
+/* XPM */
+static char * update_xpm[] = {
+"24 24 37 1",
+" c None",
+". c #076D00",
+"+ c #0A8600",
+"@ c #0A8800",
+"# c #098400",
+"$ c #087200",
+"% c #087900",
+"& c #098500",
+"* c #098100",
+"= c #087600",
+"- c #097E00",
+"; c #097F00",
+"> c #0A8700",
+", c #0A8C00",
+"' c #097C00",
+") c #098300",
+"! c #0A8900",
+"~ c #0A8E00",
+"{ c #0B9200",
+"] c #087700",
+"^ c #076E00",
+"/ c #076C00",
+"( c #076B00",
+"_ c #076A00",
+": c #076900",
+"< c #076800",
+"[ c #066700",
+"} c #066500",
+"| c #066400",
+"1 c #066300",
+"2 c #066600",
+"3 c #066200",
+"4 c #076700",
+"5 c #065E00",
+"6 c #066100",
+"7 c #065F00",
+"8 c #066000",
+" ",
+" ",
+" ",
+" . +@@@+# ",
+" $% &@ +* ",
+" =-# ; ",
+" %*>, ' ",
+" ')!~{ = ",
+" ]$ ",
+" ^ ^ ",
+" . . ",
+" / ( ",
+" _ : ",
+" < [ ",
+" } | ",
+" [[ ",
+" 1 $.:23 ",
+" 3 4}35 ",
+" 6 655 ",
+" 76 85 55 ",
+" 5555555 5 ",
+" ",
+" ",
+" "};
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
new file mode 100644
index 00000000000..31f27d9fb8a
--- /dev/null
+++ b/etc/themes/dichromacy-theme.el
@@ -0,0 +1,126 @@
+;;; dichromacy-theme.el --- color theme suitable for color-blind users
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Chong Yidong <cyd@stupidchicken>
+
+;; 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:
+
+(deftheme dichromacy
+ "Face colors suitable for red/green color-blind users.
+The color palette is from B. Wong, Nature Methods 8, 441 (2011).
+It is intended to provide good variability while being easily
+differentiated by individuals with protanopia or deuteranopia.
+
+Basic, Font Lock, Isearch, Gnus, Message, Flyspell, and
+Ansi-Color faces are included.")
+
+(let ((class '((class color) (min-colors 89)))
+ (orange "#e69f00")
+ (skyblue "#56b4e9")
+ (bluegreen "#009e73")
+ (yellow "#f8ec59")
+ (blue "#0072b2")
+ (vermillion "#d55e00")
+ (redpurple "#cc79a7")
+ (bluegray "#848ea9"))
+ (custom-theme-set-faces
+ 'dichromacy
+ `(default ((,class (:foreground "black" :background "white"))))
+ `(cursor ((,class (:foreground "white" :background "black"))))
+ ;; Highlighting faces
+ `(fringe ((,class (:background "#f7f7f7"))))
+ `(highlight ((,class (:foreground ,blue :background "#e5e5e5"))))
+ `(region ((,class (:foreground unspecified :background ,yellow))))
+ `(secondary-selection ((,class (:background "#e5e5e5"))))
+ `(isearch ((,class (:foreground "white" :background ,vermillion))))
+ `(lazy-highlight ((,class (:foreground "white" :background ,redpurple))))
+ `(trailing-whitespace ((,class (:background ,vermillion))))
+ ;; Mode line faces
+ `(mode-line ((,class (:box (:line-width -1 :style released-button)
+ :background "#e5e5e5" :foreground "black"))))
+ `(mode-line-inactive ((,class (:box (:line-width -1 :style released-button)
+ :background "#b0b0b0"
+ :foreground "black"))))
+ ;; Escape and prompt faces
+ `(minibuffer-prompt ((,class (:weight bold :foreground ,blue))))
+ `(escape-glyph ((,class (:foreground ,vermillion))))
+ ;; Font lock faces
+ `(font-lock-builtin-face ((,class (:foreground ,blue))))
+ `(font-lock-comment-face ((,class (:slant italic :foreground ,bluegreen))))
+ `(font-lock-constant-face ((,class (:weight bold :foreground ,vermillion))))
+ `(font-lock-function-name-face ((,class (:foreground ,vermillion))))
+ `(font-lock-keyword-face ((,class (:weight bold :foreground ,skyblue))))
+ `(font-lock-string-face ((,class (:foreground ,bluegray))))
+ `(font-lock-type-face ((,class (:weight bold :foreground ,blue))))
+ `(font-lock-variable-name-face ((,class (:weight bold :foreground ,orange))))
+ `(font-lock-warning-face ((,class (:weight bold :slant italic
+ :foreground ,vermillion))))
+ ;; Button and link faces
+ `(link ((,class (:underline t :foreground ,blue))))
+ `(link-visited ((,class (:underline t :foreground ,redpurple))))
+ ;; Gnus faces
+ `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermillion))))
+ `(gnus-group-news-1-low ((,class (:foreground ,vermillion))))
+ `(gnus-group-news-2 ((,class (:weight bold :foreground ,orange))))
+ `(gnus-group-news-2-low ((,class (:foreground ,orange))))
+ `(gnus-group-news-3 ((,class (:weight bold :foreground ,skyblue))))
+ `(gnus-group-news-3-low ((,class (:foreground ,skyblue))))
+ `(gnus-group-news-4 ((,class (:weight bold :foreground ,redpurple))))
+ `(gnus-group-news-4-low ((,class (:foreground ,redpurple))))
+ `(gnus-group-news-5 ((,class (:weight bold :foreground ,blue))))
+ `(gnus-group-news-5-low ((,class (:foreground ,blue))))
+ `(gnus-group-news-low ((,class (:foreground ,bluegreen))))
+ `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermillion))))
+ `(gnus-group-mail-1-low ((,class (:foreground ,vermillion))))
+ `(gnus-group-mail-2 ((,class (:weight bold :foreground ,orange))))
+ `(gnus-group-mail-2-low ((,class (:foreground ,orange))))
+ `(gnus-group-mail-3 ((,class (:weight bold :foreground ,skyblue))))
+ `(gnus-group-mail-3-low ((,class (:foreground ,skyblue))))
+ `(gnus-group-mail-low ((,class (:foreground ,bluegreen))))
+ `(gnus-header-content ((,class (:foreground ,redpurple))))
+ `(gnus-header-from ((,class (:weight bold :foreground ,blue))))
+ `(gnus-header-subject ((,class (:foreground ,orange))))
+ `(gnus-header-name ((,class (:foreground ,skyblue))))
+ `(gnus-header-newsgroups ((,class (:foreground ,vermillion))))
+ ;; Message faces
+ `(message-header-name ((,class (:foreground ,skyblue))))
+ `(message-header-cc ((,class (:foreground ,vermillion))))
+ `(message-header-other ((,class (:foreground ,bluegreen))))
+ `(message-header-subject ((,class (:foreground ,orange))))
+ `(message-header-to ((,class (:weight bold :foreground ,blue))))
+ `(message-cited-text ((,class (:slant italic :foreground ,bluegreen))))
+ `(message-separator ((,class (:weight bold :foreground ,redpurple))))
+ ;; Flyspell
+ `(flyspell-duplicate ((,class (:weight unspecified :foreground unspecified
+ :slant unspecified :underline ,orange))))
+ `(flyspell-incorrect ((,class (:weight unspecified :foreground unspecified
+ :slant unspecified :underline ,redpurple)))))
+
+ (custom-theme-set-variables
+ 'dichromacy
+ `(ansi-color-names-vector ["black" ,vermillion ,bluegreen ,yellow
+ ,blue ,redpurple ,skyblue "white"])))
+
+(provide-theme 'dichromacy)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; dichromacy-theme.el ends here
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index 60f9fa8dc9d..98c74b268af 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -26,7 +26,7 @@
;;; Code:
(deftheme light-blue
- "Theme with a light blue backgound.")
+ "Face colors utilizing a light blue backgound.")
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
new file mode 100644
index 00000000000..bd6bbaa88a2
--- /dev/null
+++ b/etc/themes/manoj-dark-theme.el
@@ -0,0 +1,700 @@
+;;; manoj-dark.el --- A dark theme from Manoj
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Manoj Srivastava <srivasta@ieee.org>
+;; Keywords: lisp, faces
+
+;; 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:
+
+;; I spend a lot of time workin 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.
+
+;; It does not help that I am blue-green color blind, so subtle
+;; variations are often lost on me. I do want to use color contrast to
+;; increase productivity, but I also want to avoid the jarring angry
+;; fruit salad look, and so I am in the process of crafting a logical
+;; color scheme that is high contrast enough for me, without being too
+;; unpleasing.
+
+;; In circumstances where there a lot of related faces that can be
+;; viewed, for example, the Gnus group buffer, consistent and logical
+;; color choices are the only sane option. Gnus groups can be newa
+;; (blueish) or mail (greenish), have states (large number of under
+;; messages, normal, and empty). The large number unread groups have
+;; highest luminance (appear brighter), and the empty one have lower
+;; luminance (appear greyer), but have the same chroma and saturation.
+;; Sub states and group priorities are rendered using a color series
+;; which has constant luminance and saturation, and vary in hue by a
+;; constant separation -- so all the related groups have the same
+;; brightness ({mail,news}/{unread,normal,empty}), and a graded
+;; selection of foreground colors. It sounds more complicated that it
+;; looks. The eye is drawn naturally to the unread groups, and first
+;; to the mail, then USENET groups (which is my preference).
+
+;; Similar color variations occur for individual messages in a group;
+;; high scoring messages bubble to the top, and have a higher
+;; luminance. This color schema has made me slightly faster at
+;; reading mail/USENET.
+
+;; In the message itself, quoted mail messages from different people
+;; are color coordinated, with high contrast beteen citations that are
+;; close to each other in the heirarchy, so it is less likely that one
+;; misunderstands who said what in a long conversation.
+
+;; The following scheme covers programming languages, Gnus, Erc, mail,
+;; org-mode, CUA-mode, apt-utils, bbdb, compilation buffers, changelog
+;; mode, diff and ediff, eshell, and more. You need emacs-goodies
+;; package on Debian to use this. See the wiki page at
+;; http://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The
+;; project home page is at https://gna.org/projects/color-theme.
+
+;;; Code:
+
+(deftheme manoj-dark
+ "Very high contrast faces with a black background.
+This theme avoids subtle color variations, while avoiding the
+jarring angry fruit salad look to reduce eye fatigue.")
+
+(custom-theme-set-faces
+ 'manoj-dark
+ '(default ((t (:background "black" :foreground "WhiteSmoke"))))
+ ;; Font lock faces
+ '(font-lock-builtin-face ((t (:foreground "LightSteelBlue"))))
+ '(font-lock-constant-face ((t (:foreground "LightSlateBlue" :bold t))))
+ '(font-lock-preprocessor-face ((t (:foreground "CornFlowerBlue" :italic t))))
+ '(font-lock-keyword-face ((t (:foreground "cyan1"))))
+ '(font-lock-type-face ((t (:foreground "SteelBlue1"))))
+ '(font-lock-regexp-grouping-backslash ((t (:bold t :weight bold))))
+ '(font-lock-regexp-grouping-construct ((t (:bold t :weight bold))))
+ '(font-lock-variable-name-face ((t (:foreground "Aquamarine"))))
+ '(font-lock-function-name-face ((t (:foreground "mediumspringgreen"
+ :weight bold :height 1.1))))
+ '(font-lock-string-face ((t (:foreground "RosyBrown1"))))
+ '(font-lock-comment-face ((t (:italic t :slant oblique :foreground "chocolate1"))))
+ '(font-lock-comment-delimiter-face ((t (:foreground "Salmon"))))
+ '(font-lock-doc-face ((t (:italic t :slant oblique :foreground "LightCoral"))))
+ '(font-lock-doc-string-face ((t (:foreground "Plum"))))
+ '(font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold))))
+
+ '(cperl-array-face ((t (:foreground "LawnGreen" :background "B;ack" :bold t))))
+ '(cperl-hash-face ((t (:foreground "SpringGreen" :background "B;ack" :bold t :italic t))))
+ '(cperl-nonoverridable-face ((t (:foreground "chartreuse3"))))
+
+ '(gnus-button ((t (:bold t :weight bold :background "#191932" :box (:line-width 2 :style released-button)))))
+ '(gnus-cite-attribution-face ((t (:italic t))))
+ '(gnus-cite-face-1 ((t (:foreground "CornflowerBlue"))))
+ '(gnus-cite-face-2 ((t (:foreground "PaleGreen"))))
+ '(gnus-cite-face-3 ((t (:foreground "LightGoldenrod"))))
+ '(gnus-cite-face-4 ((t (:foreground "LightPink"))))
+ '(gnus-cite-face-5 ((t (:foreground "turquoise"))))
+ '(gnus-cite-face-6 ((t (:foreground "khaki"))))
+ '(gnus-cite-face-7 ((t (:foreground "plum"))))
+ '(gnus-cite-face-8 ((t (:foreground "DeepSkyBlue1"))))
+ '(gnus-cite-face-9 ((t (:foreground "chartreuse1"))))
+ '(gnus-cite-face-10 ((t (:foreground "thistle1"))))
+ '(gnus-cite-face-11 ((t (:foreground "LightYellow1"))))
+ '(gnus-emphasis-bold ((t (:bold t :weight bold))))
+ '(gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold))))
+ '(gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow"))))
+ '(gnus-emphasis-italic ((t (:italic t :slant italic))))
+ '(gnus-emphasis-strikethru ((t (:strike-through t))))
+ '(gnus-emphasis-underline ((t (:underline t))))
+ '(gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold))))
+ '(gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold))))
+ '(gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic))))
+
+ '(gnus-header-content ((t (:italic t :foreground "DarkKhaki" :slant italic))))
+ '(gnus-header-content-face ((t (:italic t :foreground "DarkKhaki" :slant italic))))
+ '(gnus-header-from ((t (:foreground "PaleGreen1"))))
+ '(gnus-header-from-face ((t (:foreground "PaleGreen1"))))
+ '(gnus-header-name ((t (:bold t :foreground "BlanchedAlmond" :weight bold))))
+ '(gnus-header-name-face ((t (:bold t :foreground "BlanchedAlmond" :weight bold))))
+ '(gnus-header-newsgroups ((t (:italic t :foreground "yellow" :slant italic))))
+ '(gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic))))
+ '(gnus-header-subject ((t (:foreground "coral1"))))
+ '(gnus-header-subject-face ((t (:foreground "coral1"))))
+ '(gnus-signature ((t (:italic t :slant italic))))
+ '(gnus-signature-face ((t (:italic t :slant italic))))
+ '(gnus-splash ((t (:foreground "#cccccc"))))
+ '(gnus-summary-cancelled ((t (:background "black" :foreground "yellow"))))
+ '(gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow"))))
+ '(gnus-summary-high-ancient ((t (:bold t :foreground "CornflowerBlue" :weight bold))))
+ '(gnus-summary-high-ancient-face ((t (:bold t :foreground "CornflowerBlue" :weight bold))))
+ '(gnus-summary-normal-ancient ((t (:foreground "SkyBlue"))))
+ '(gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue"))))
+ '(gnus-summary-low-ancient ((t (:italic t :foreground "LightSteelBlue" :slant italic))))
+ '(gnus-summary-low-ancien-facet ((t (:italic t :foreground "LightSteelBlue" :slant italic))))
+
+ '(gnus-summary-high-read ((t (:bold t :foreground "grey60" :weight bold))))
+ '(gnus-summary-high-read-face ((t (:bold t :foreground "grey60" :weight bold))))
+ '(gnus-summary-normal-read ((t (:foreground "grey50"))))
+ '(gnus-summary-normal-read-face ((t (:foreground "grey50"))))
+ '(gnus-summary-low-read ((t (:italic t :foreground "LightSlateGray" :slant italic))))
+ '(gnus-summary-low-read-face ((t (:italic t :foreground "LightSlateGray" :slant italic))))
+
+ '(gnus-summary-high-ticked ((t (:bold t :foreground "RosyBrown" :weight bold))))
+ '(gnus-summary-high-ticked-face ((t (:bold t :foreground "RosyBrown" :weight bold))))
+ '(gnus-summary-normal-ticked ((t (:foreground "LightSalmon"))))
+ '(gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon"))))
+ '(gnus-summary-low-ticked ((t (:italic t :foreground "pink" :slant italic))))
+ '(gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic))))
+
+ '(gnus-summary-high-undownloaded ((t (:bold t :foreground "ivory3" :weight bold))))
+ '(gnus-summary-normal-undownloaded ((t (:foreground "LightGray" :weight normal))))
+ '(gnus-summary-low-undownloaded ((t (:italic t :foreground "grey75" :slant italic :weight normal))))
+
+ '(gnus-summary-high-unread ((t (:bold t :foreground "PaleGreen" :weight bold))))
+ '(gnus-summary-high-unread-face ((t (:bold t :foreground "PaleGreen" :weight bold))))
+ '(gnus-summary-normal-unread ((t (:foreground "YellowGreen"))))
+ '(gnus-summary-normal-unread-face ((t (:foreground "YellowGreen"))))
+ '(gnus-summary-low-unread ((t (:italic t :foreground "MediumSeaGreen" :slant italic))))
+ '(gnus-summary-low-unread-face ((t (:italic t :foreground "MediumSeaGreen" :slant italic))))
+ '(gnus-summary-root-face ((t (:bold t :foreground "Red" :weight bold))))
+ '(gnus-summary-selected ((t (:underline t :foreground "LemonChiffon"))))
+ '(gnus-summary-selected-face ((t (:underline t :foreground "LemonChiffon"))))
+ '(gnus-user-agent-bad-face ((t (:bold t :background "black" :foreground "red" :weight bold))))
+ '(gnus-user-agent-good-face ((t (:background "black" :foreground "green"))))
+ '(gnus-user-agent-unknown-face ((t (:bold t :background "black" :foreground "orange" :weight bold))))
+ '(gnus-x-face ((t (:background "white" :foreground "black"))))
+
+ '(gnus-group-mail-1 ((t (:bold t :foreground "#3BFF00" :weight normal))))
+ '(gnus-group-mail-1-face ((t (:bold t :foreground "#3BFF00" :weight normal))))
+ '(gnus-group-mail-2 ((t (:bold t :foreground "#5EFF00" :weight normal))))
+ '(gnus-group-mail-2-face ((t (:bold t :foreground "#5EFF00" :weight normal))))
+ '(gnus-group-mail-3 ((t (:bold t :foreground "#80FF00" :weight normal))))
+ '(gnus-group-mail-3-face ((t (:bold t :foreground "#A1FF00" :weight normal))))
+
+
+ '(gnus-group-mail-1-empty ((t (:foreground "#249900"))))
+ '(gnus-group-mail-1-empty-face ((t (:foreground "#249900"))))
+ '(gnus-group-mail-2-empty ((t (:foreground "#389900"))))
+ '(gnus-group-mail-2-empty-face ((t (:foreground "#389900"))))
+ '(gnus-group-mail-3-empty ((t (:foreground "#4D9900"))))
+ '(gnus-group-mail-3-empty-face ((t (:foreground "#4D9900"))))
+
+ '(gnus-group-mail-low ((t (:bold t :foreground "aquamarine2" :weight bold))))
+ '(gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine2" :weight bold))))
+ '(gnus-group-mail-low-empty ((t (:foreground "aquamarine2"))))
+ '(gnus-group-mail-low-empty-face ((t (:foreground "aquamarine2"))))
+
+ '(gnus-group-news-1 ((t (:bold t :foreground "#8480FF" :weight bold))))
+ '(gnus-group-news-1-face ((t (:bold t :foreground "#8480FF" :weight bold))))
+ '(gnus-group-news-2 ((t (:bold t :foreground "#8088FF" :weight bold))))
+ '(gnus-group-news-2-face ((t (:bold t :foreground "#8088FF" :weight bold))))
+ '(gnus-group-news-3 ((t (:bold t :foreground "#8095FF" :weight bold))))
+ '(gnus-group-news-3-face ((t (:bold t :foreground "#8095FF" :weight bold))))
+ '(gnus-group-news-4 ((t (:bold t :foreground "#80A1FF" :weight bold))))
+ '(gnus-group-news-4-face ((t (:bold t :foreground "#80A1FF" :weight bold))))
+ '(gnus-group-news-5 ((t (:bold t :foreground "#80AEFF" :weight bold))))
+ '(gnus-group-news-5-face ((t (:bold t :foreground "#80AEFF" :weight bold))))
+ '(gnus-group-news-6 ((t (:bold t :foreground "#80BBFF" :weight bold))))
+ '(gnus-group-news-6-face ((t (:bold t :foreground "#80BBFF" :weight bold))))
+
+ '(gnus-group-news-1-empty ((t (:foreground "#524DFF"))))
+ '(gnus-group-news-1-empty-face ((t (:foreground "#524DFF"))))
+ '(gnus-group-news-2-empty ((t (:foreground "#4D58FF"))))
+ '(gnus-group-news-2-empty-face ((t (:foreground "#4D58FF"))))
+ '(gnus-group-news-3-empty ((t (:foreground "#4D6AFF"))))
+ '(gnus-group-news-3-empty-face ((t (:foreground "#4D6AFF"))))
+ '(gnus-group-news-4-empty ((t (:foreground "#4D7CFF"))))
+ '(gnus-group-news-4-empty-face ((t (:foreground "#4D7CFF"))))
+ '(gnus-group-news-5-empty ((t (:foreground "#4D8EFF"))))
+ '(gnus-group-news-5-empty-face ((t (:foreground "#4D8EFF"))))
+ '(gnus-group-news-6-empty ((t (:foreground "#4DA0FF"))))
+ '(gnus-group-news-6-empty-face ((t (:foreground "#4DA0FF"))))
+
+ '(gnus-group-news-low ((t (:bold t :foreground "DarkTurquoise" :weight bold))))
+ '(gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold))))
+ '(gnus-group-news-low-empty ((t (:foreground "DarkTurquoise"))))
+ '(gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise"))))
+
+ ;;message faces
+ '(message-cited-text ((t (:foreground "red3"))))
+ '(message-header-cc ((t (:bold t :foreground "chartreuse1" :weight bold))))
+ '(message-header-cc-face ((t (:bold t :foreground "chartreuse1" :weight bold))))
+ '(message-header-name ((t (:foreground "green"))))
+ '(message-header-name-face ((t (:foreground "green"))))
+ '(message-header-newsgroups ((t (:italic t :bold t :foreground "papaya whip" :slant italic :weight bold))))
+ '(message-header-newsgroups-face ((t (:italic t :bold t :foreground "papaya whip" :slant italic :weight bold))))
+ '(message-header-other ((t (:foreground "ivory"))))
+ '(message-header-other-face ((t (:foreground "ivory"))))
+ '(message-header-subject ((t (:foreground "OliveDrab1"))))
+ '(message-header-subject-face ((t (:foreground "OliveDrab1"))))
+ '(message-header-to ((t (:bold t :foreground "floral white" :weight bold))))
+ '(message-header-to-face ((t (:bold t :foreground "floral white" :weight bold))))
+ '(message-header-xheader ((t (:foreground "DeepSkyBlue1"))))
+ '(message-header-xheader-face ((t (:foreground "DeepSkyBlue1"))))
+ '(message-mml ((t (:foreground "MediumSpringGreen"))))
+ '(message-mml-face ((t (:foreground "MediumSpringGreen"))))
+ '(message-separator ((t (:foreground "LightSkyBlue1"))))
+ '(message-separator-face ((t (:foreground "LightSkyBlue1"))))
+ '(message-url ((t (:bold t :foreground "blue" :weight bold))))
+
+ '(bg:erc-color-face0 ((t (:background "saddle brown"))))
+ '(bg:erc-color-face1 ((t (:background "black"))))
+ '(bg:erc-color-face10 ((t (:background "DodgerBlue4"))))
+ '(bg:erc-color-face11 ((t (:background "cyan4"))))
+ '(bg:erc-color-face12 ((t (:background "blue"))))
+ '(bg:erc-color-face13 ((t (:background "deeppink"))))
+ '(bg:erc-color-face14 ((t (:background "gray50"))))
+ '(bg:erc-color-face15 ((t (:background "grey15"))))
+ '(bg:erc-color-face2 ((t (:background "blue4"))))
+ '(bg:erc-color-face3 ((t (:background "green4"))))
+ '(bg:erc-color-face4 ((t (:background "red"))))
+ '(bg:erc-color-face5 ((t (:background "brown"))))
+ '(bg:erc-color-face6 ((t (:background "purple"))))
+ '(bg:erc-color-face7 ((t (:background "orange"))))
+ '(bg:erc-color-face8 ((t (:background "yellow4"))))
+ '(bg:erc-color-face9 ((t (:background "green"))))
+ '(erc-action-face ((t (:bold t :weight bold :foreground "turquoise1"))))
+ '(erc-bold-face ((t (:bold t :weight bold))))
+ '(erc-button ((t (:bold t :weight bold :foreground "RoyalBlue1" :box (:line-width 2 :style released-button)))))
+ '(erc-button-face ((t (:bold t :weight bold :foreground "RoyalBlue1" :box (:line-width 2 :style released-button)))))
+ '(erc-command-indicator-face ((t (:bold t :weight bold))))
+ '(erc-current-nick-face ((t (:bold t :foreground "DarkTurquoise" :weight bold))))
+ '(erc-dangerous-host-face ((t (:foreground "red"))))
+ '(erc-direct-msg-face ((t (:foreground "sandybrown"))))
+ '(erc-error-face ((t (:foreground "red"))))
+ '(erc-fool-face ((t (:foreground "dim gray"))))
+ '(erc-header-line ((t (:background "grey95" :foreground "ConFlowerBlue"))))
+ '(erc-input-face ((t (:foreground "brown"))))
+ '(erc-inverse-face ((t (:background "Black" :foreground "White"))))
+ '(erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold))))
+ '(erc-my-nick-face ((t (:bold t :foreground "brown" :weight bold))))
+ '(erc-nick-default-face ((t (:bold t :weight bold :foreground "DodgerBlue1"))))
+ '(erc-button-nickname-face ((t (:bold t :weight bold :background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button) ))))
+ '(erc-nick-msg-face ((t (:bold t :foreground "IndianRed" :weight bold))))
+ '(erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold))))
+ '(erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold))))
+ '(erc-prompt-face ((t (:bold t :background "Navy" :foreground "lightBlue2" :weight bold))))
+ '(erc-timestamp-face ((t (:bold t :foreground "SeaGreen1" :weight bold))))
+ '(erc-underline-face ((t (:underline t))))
+ '(fg:erc-color-face0 ((t (:foreground "BlanchedAlmond"))))
+ '(fg:erc-color-face1 ((t (:foreground "beige"))))
+ '(fg:erc-color-face10 ((t (:foreground "pale goldenrod"))))
+ '(fg:erc-color-face11 ((t (:foreground "cyan"))))
+ '(fg:erc-color-face12 ((t (:foreground "lightblue1"))))
+ '(fg:erc-color-face13 ((t (:foreground "deeppink"))))
+ '(fg:erc-color-face14 ((t (:foreground "gray50"))))
+ '(fg:erc-color-face15 ((t (:foreground "gray90"))))
+ '(fg:erc-color-face2 ((t (:foreground "blue4"))))
+ '(fg:erc-color-face3 ((t (:foreground "green4"))))
+ '(fg:erc-color-face4 ((t (:foreground "red"))))
+ '(fg:erc-color-face5 ((t (:foreground "brown"))))
+ '(fg:erc-color-face6 ((t (:foreground "purple"))))
+ '(fg:erc-color-face7 ((t (:foreground "orange"))))
+ '(fg:erc-color-face8 ((t (:foreground "yellow"))))
+ '(fg:erc-color-face9 ((t (:foreground "green"))))
+
+ '(org-agenda-date ((t (:foreground "LightSkyBlue"))))
+ '(org-agenda-date-weekend ((t (:bold t :foreground "LightSkyBlue" :weight bold))))
+ '(org-agenda-restriction-lock ((t (:background "skyblue4"))))
+ '(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-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))))
+ '(org-drawer ((t (:foreground "LightSkyBlue"))))
+ '(org-ellipsis ((t (:foreground "LightGoldenrod" :underline t))))
+ '(org-formula ((t (:foreground "chocolate1"))))
+ '(org-headline-done ((t (:foreground "LightSalmon"))))
+ '(org-hide ((t (:foreground "black"))))
+ '(org-latex-and-export-specials ((t (:foreground "burlywood"))))
+ '(org-level-1 ((t (:foreground "LightSkyBlue"))))
+ '(org-level-2 ((t (:foreground "LightGoldenrod"))))
+ '(org-level-3 ((t (:foreground "Cyan1"))))
+ '(org-level-4 ((t (:foreground "chocolate1"))))
+ '(org-level-5 ((t (:foreground "PaleGreen"))))
+ '(org-level-6 ((t (:foreground "Aquamarine"))))
+ '(org-level-7 ((t (:foreground "LightSteelBlue"))))
+ '(org-level-8 ((t (:foreground "LightSalmon"))))
+ '(org-link ((t (:foreground "Cyan" :underline t))))
+ '(org-mode-line-clock ((t (:foreground "DarkGreen" :underline t))))
+ '(org-scheduled-previously ((t (:foreground "chocolate1"))))
+ '(org-scheduled-today ((t (:foreground "PaleGreen"))))
+ '(org-sexp-date ((t (:foreground "Cyan"))))
+ '(org-special-keyword ((t (:foreground "LightSalmon"))))
+ '(org-table ((t (:foreground "LightSkyBlue"))))
+ '(org-tag ((t (:bold t :weight bold))))
+ '(org-target ((t (:underline t))))
+ '(org-time-grid ((t (:foreground "LightGoldenrod"))))
+ '(org-todo ((t (:bold t :foreground "Pink" :weight bold))))
+ '(org-upcoming-deadline ((t (:foreground "chocolate1"))))
+ '(org-verbatim ((t (:foreground "grey70" :underline t))))
+ '(org-warning ((t (:bold t :weight bold :foreground "Pink"))))
+ '(outline-1 ((t (:foreground "LightSkyBlue"))))
+ '(outline-2 ((t (:foreground "LightGoldenrod"))))
+ '(outline-3 ((t (:foreground "Cyan1"))))
+ '(outline-4 ((t (:foreground "chocolate1"))))
+ '(outline-5 ((t (:foreground "PaleGreen"))))
+ '(outline-6 ((t (:foreground "Aquamarine"))))
+ '(outline-7 ((t (:foreground "LightSteelBlue"))))
+ '(outline-8 ((t (:foreground "LightSalmon"))))
+
+
+ '(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))))
+ '(align-highlight-nochange-face ((t (:background "SkyBlue4"))))
+
+ '(antlr-font-lock-keyword-face ((t (:foreground "SteelBlue")))) ;%
+ '(antlr-font-lock-literal-face ((t (:foreground "PaleVioletRed"))))
+ '(antlr-font-lock-ruledef-face ((t (:foreground "DarkGreen"))))
+ '(antlr-font-lock-ruleref-face ((t (:foreground "SteelBlue"))))
+ '(antlr-font-lock-tokendef-face ((t (:foreground "khaki"))))
+ '(antlr-font-lock-tokenref-face ((t (:foreground "LightSteelBlue4"))))
+
+ '(bbdb-company ((t (:italic t :slant italic :foreground "indian red"))))
+ '(bbdb-field-name ((t (:bold t :weight bold :foreground "steel blue"))))
+ '(bbdb-field-value ((t (:foreground "AntiqueWhite2"))))
+ '(bbdb-name ((t (:underline t :foreground "cadet blue"))))
+
+ '(bold ((t (:bold t :weight bold))))
+ '(bold-italic ((t (:bold t :italic t :slant italic :weight bold))))
+ '(border ((t (:background "gold" :foreground "black" ))))
+ '(buffer-menu-buffer ((t (:bold t :weight bold))))
+ '(button ((t (:underline t :box (:line-width 2 :color "grey"
+ :style released-button)
+ :foreground "black" :background "grey"
+ :weight bold ))))
+ '(calendar-today-face ((t (:underline t :bold t :foreground "cornsilk"))))
+ '(change-log-acknowledgement-face ((t (:italic t :slant oblique :foreground "AntiqueWhite3"))))
+ '(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-function-face ((t (:foreground "Aquamarine"))))
+ '(change-log-list-face ((t (:foreground "LightSkyBlue"))))
+ '(change-log-name-face ((t (:bold t :weight bold :foreground "Gold"))))
+
+ '(comint-highlight-input ((t (:bold t :weight bold))))
+ '(comint-highlight-prompt ((t (:foreground "cyan1"))))
+ '(compilation-column-number ((t (:foreground "PaleGreen"))))
+ '(compilation-error ((t (:bold t :weight bold :foreground "Brown1"))))
+ '(compilation-info ((t (:bold t :foreground "LightPink1" :weight bold))))
+ '(compilation-line-number ((t (:foreground "LightGoldenrod"))))
+ '(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-first-difference ((t (:bold t :weight bold))))
+
+ '(css-selector ((t (:foreground "LightSteelBlue"))))
+ '(css-property ((t (:foreground "light sea green"))))
+
+ '(cursor ((t (:background "orchid"))))
+ '(custom-button-face ((t (:background "lightgrey" :foreground "black"
+ :box '(:line-width 2 :style released-button)))))
+ '(custom-button-pressed-face ((t (:background "lightgrey"
+ :foreground "black"
+ :box '(:line-width 2 :style pressed-button)))))
+ '(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-invalid-face ((t (:background "red" :foreground "yellow"))))
+ '(custom-modified-face ((t (:background "blue" :foreground "white"))))
+ '(custom-rogue-face ((t (:background "black" :foreground "pink"))))
+ '(custom-saved-face ((t (:underline t))))
+ '(custom-set-face ((t (:background "white" :foreground "blue"))))
+ '(custom-state-face ((t (:foreground "lime green"))))
+ '(custom-variable-button-face ((t (:bold t :underline t :weight bold
+ :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))))
+
+ '(diary ((t (:foreground "IndianRed"))))
+ '(diary-anniversary ((t (:foreground "Cyan1"))))
+ '(diary-button ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button)))))
+ '(diary-face ((t (:foreground "IndianRed"))))
+ '(diary-time ((t (:foreground "LightGoldenrod"))))
+ '(diff-added ((t (:foreground "Green"))))
+ '(diff-added-face ((t (:foreground "Green"))))
+ '(diff-changed-face ((t (:foreground "Khaki"))))
+ '(diff-context-face ((t (:foreground "grey70"))))
+ '(diff-file-header ((t (:bold t :background "grey20" :foreground "ivory1" :weight bold))))
+ '(diff-file-header-face ((t (:bold t :background "grey20" :foreground "ivory1" :weight bold))))
+ '(diff-function-face ((t (:foreground "SpringGreen1"))))
+ '(diff-header-face ((t (:background "SlateBlue4"))))
+ '(diff-hunk-header ((t (:slant italic :background "DodgerBlue4"))))
+ '(diff-hunk-header-face ((t (:slant italic :background "DodgerBlue4"))))
+ '(diff-index-face ((t (:bold t :weight bold :background "SteelBlue4" :foreground "linen" ))))
+ '(diff-nonexistent ((t (:bold t :weight bold :background "Black" :foreground "Wheat1"))))
+ '(diff-nonexistent-face ((t (:bold t :weight bold :background "Black" :foreground "Wheat1"))))
+ '(diff-removed ((t (:foreground "salmon1"))))
+ '(diff-removed-face ((t (:foreground "salmon1"))))
+ '(diff-refine-change-face ((t (:background "MidnightBlue"))))
+ '(diff-refine-change ((t (:background "MidnightBlue"))))
+
+ '(ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green"))))
+ '(ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed"))))
+ '(ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow"))))
+ '(ediff-current-diff-face-C ((t (:foreground "Navy" :background "Pink"))))
+ '(ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey"))))
+ '(ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey"))))
+ '(ediff-even-diff-face-B ((t (:foreground "White" :background "Grey"))))
+ '(ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey"))))
+ '(ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue"))))
+ '(ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green"))))
+ '(ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan"))))
+ '(ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise"))))
+ '(ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey"))))
+ '(ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey"))))
+ '(ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey"))))
+ '(ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey"))))
+
+ '(eieio-custom-slot-tag-face ((t (:foreground "light blue"))))
+ '(eldoc-highlight-function-argument ((t (:bold t :weight bold))))
+ '(epa-field-body ((t (:italic t :foreground "turquoise" :slant italic))))
+ '(epa-field-name ((t (:bold t :foreground "PaleTurquoise" :weight bold))))
+ '(epa-mark ((t (:bold t :foreground "orange" :weight bold))))
+ '(epa-string ((t (:foreground "lightyellow"))))
+ '(epa-validity-disabled ((t (:italic t :slant italic))))
+ '(epa-validity-high ((t (:bold t :foreground "PaleTurquoise" :weight bold))))
+ '(epa-validity-low ((t (:italic t :slant italic))))
+ '(epa-validity-medium ((t (:italic t :foreground "PaleTurquoise" :slant italic))))
+
+ '(escape-glyph ((t (:foreground "cyan"))))
+
+ '(eshell-ls-archive-face ((t (:bold t :foreground "IndianRed"))))
+ '(eshell-ls-backup-face ((t (:foreground "Grey"))))
+ '(eshell-ls-clutter-face ((t (:foreground "DimGray"))))
+ '(eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue"))))
+ '(eshell-ls-executable-face ((t (:foreground "Coral"))))
+ '(eshell-ls-missing-face ((t (:foreground "black"))))
+ '(eshell-ls-picture-face ((t (:foreground "Violet"))))
+ '(eshell-ls-product-face ((t (:foreground "sandybrown"))))
+ '(eshell-ls-readonly-face ((t (:foreground "Aquamarine"))))
+ '(eshell-ls-special-face ((t (:foreground "Gold"))))
+ '(eshell-ls-symlink-face ((t (:foreground "DarkCyan" :bold t))))
+ '(eshell-ls-symlink-face ((t (:foreground "White"))))
+ '(eshell-ls-unreadable-face ((t (:foreground "DimGray"))))
+ '(eshell-prompt-face ((t (:foreground "MediumAquamarine"))))
+ '(eshell-test-failed-face ((t (:foreground "OrangeRed" :bold t))))
+ '(eshell-test-ok-face ((t (:foreground "Green" :bold t))))
+
+ '(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))))
+
+ '(fringe ((t (:background "grey30" :foreground "Wheat"))))
+ '(header-line ((t (:box (:line-width -1 :color "grey20" :style released-button) :background "grey20" :foreground "grey90" :height 0.9))))
+ '(help-argument-name ((t (:italic t :slant italic))))
+ '(highlight ((t (:background "gray10" :foreground "Old Lace"))))
+ '(hl-line ((t (:background "grey10" :foreground "Old Lace"))))
+ '(gnus-mouse-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(erc-button-mouse-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(align-highlight-change-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(goto-address-url-mouse-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(goto-address-url-mouse-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(ispell-highlight-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(ispell-highlight-face ((t (:background "darkseagreen2" :foreground "blue"))))
+ '(widget-mouse-face ((t (:background "darkseagreen2" :foreground "blue"))))
+
+ '(highlight-beyond-fill-column-face ((t (:underline t))))
+ '(highlight-changes ((t (:foreground nil :background "#382f2f"))))
+ '(highlight-changes-delete ((t (:foreground nil :background "#916868"))))
+
+ '(holiday ((t (:background "chocolate4"))))
+ '(holiday-face ((t (:background "chocolate4"))))
+
+ '(ibuffer-dired-buffer-face ((t (:foreground "mediumspringgreen" :weight bold :height 1.1))))
+ '(ibuffer-help-buffer-face ((t (:italic t :slant oblique :foreground "chocolate1"))))
+ '(ibuffer-hidden-buffer-face ((t (:bold t :foreground "Pink" :weight bold))))
+ '(ibuffer-occur-match-face ((t (:bold t :foreground "Pink" :weight bold))))
+ '(ibuffer-read-only-buffer-face ((t (:foreground "SteelBlue1"))))
+ '(ibuffer-special-buffer-face ((t (:foreground "SteelBlue1"))))
+
+ '(ido-first-match ((t (:bold t :weight bold))))
+ '(ido-incomplete-regexp ((t (:bold t :weight bold :foreground "Pink"))))
+ '(ido-indicator ((t (:background "red1" :foreground "yellow1" :width condensed))))
+ '(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-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"))))
+ '(info-xref ((t (:bold t :foreground "cyan" :weight bold))))
+ '(isearch ((t (:background "palevioletred2" :foreground "brown4"))))
+ '(isearch-fail ((t (:background "red4"))))
+ '(isearch-lazy-highlight-face ((t (:background "paleturquoise4"))))
+ '(isearch-secondary ((t (:foreground "red3"))))
+ '(italic ((t (:italic t))))
+
+ '(js2-builtin-face ((t (:foreground "sandy brown"))))
+ '(js2-comment-face ((t (:foreground "dark orchid"))))
+ '(js2-constant-face ((t (:foreground "pale violet red"))))
+ '(js2-error-face ((t (:background "indian red" :foreground "green" :bold t))))
+ '(js2-function-name-face ((t (:foreground "cadet blue"))))
+ '(js2-function-param-face ((t (:foreground "IndianRed1"))))
+ '(js2-instance-member-face ((t (:foreground "IndianRed1"))))
+ '(js2-jsdoc-tag-face ((t (:foreground "medium orchid"))))
+ '(js2-jsdoc-type-face ((t (:foreground "medium orchid"))))
+ '(js2-jsdoc-value-face ((t (:foreground "medium orchid"))))
+ '(js2-keyword-face ((t (:foreground "steel blue"))))
+ '(js2-private-function-call-face ((t (:foreground "cadet blue"))))
+ '(js2-private-member-face ((t (:foreground "IndianRed1"))))
+ '(js2-regexp-face ((t (:foreground "khaki"))))
+ '(js2-string-face ((t (:foreground "lemon chiffon"))))
+ '(js2-type-face ((t (:foreground "medium sea green"))))
+ '(js2-variable-name-face ((t (:foreground "IndianRed1"))))
+ '(js2-warning-face ((t (:background "indian red" :foreground "green"))))
+
+ '(lazy-highlight ((t (:background "paleturquoise4"))))
+ '(link ((t (:foreground "cyan1" :underline t))))
+ '(link-visited ((t (:underline t :foreground "violet"))))
+
+ '(makefile-space ((t (:background "hotpink"))))
+ '(man-bold ((t (:bold t))))
+ '(man-heading ((t (:bold t))))
+ '(man-italic ((t (:foreground "yellow"))))
+ '(man-xref ((t (:underline t))))
+ '(match ((t (:background "RoyalBlue3"))))
+ '(minibuffer-prompt ((t (:foreground "cyan"))))
+ '(mode-line ((t (:background "grey75" :foreground "Blue"
+ :box '(:line-width -1 :style released-button)
+ :height 0.9))))
+ '(mode-line-buffer-id ((t (:background "grey65" :foreground "red"
+ :bold t :weight bold :height 0.9))))
+ '(mode-line-emphasis ((t (:bold t :weight bold))))
+ '(mode-line-highlight ((t (:box (:line-width 2 :color "grey40"
+ :style released-button :height 0.9)))))
+ '(mode-line-inactive ((t (:background "grey30" :foreground "grey80"
+ :box '(:line-width -1 :color "grey40")
+ :weight light :height 0.9))))
+ '(mouse ((t (:background "OrangeRed"))))
+
+ '(next-error ((t (:background "blue3"))))
+ '(nobreak-space ((t (:foreground "cyan" :underline t))))
+ '(paren-blink-off ((t (:foreground "black"))))
+ '(paren-mismatch-face ((t (:bold t :background "white" :foreground "red"))))
+ '(paren-no-match-face ((t (:bold t :background "white" :foreground "red"))))
+ '(query-replace ((t (:foreground "brown4" :background "palevioletred2"))))
+ '(region ((t (:background "blue3"))))
+ '(scroll-bar ((t (:background "grey75" :foreground "WhiteSmoke"))))
+ '(secondary-selection ((t (:background "SkyBlue4"))))
+ '(semantic-dirty-token-face ((t (:background "lightyellow"))))
+ '(semantic-highlight-edits-face ((t (:background "gray20"))))
+ '(semantic-unmatched-syntax-face ((t (:underline "red"))))
+ '(senator-intangible-face ((t (:foreground "gray75"))))
+ '(senator-momentary-highlight-face ((t (:background "gray30"))))
+ '(senator-read-only-face ((t (:background "#664444"))))
+ '(sgml-doctype-face ((t (:foreground "orange"))))
+ '(sgml-end-tag-face ((t (:foreground "greenyellow"))))
+ '(sgml-entity-face ((t (:foreground "gold"))))
+ '(sgml-ignored-face ((t (:foreground "gray20" :background "gray60"))))
+ '(sgml-sgml-face ((t (:foreground "yellow"))))
+ '(sgml-start-tag-face ((t (:foreground "mediumspringgreen"))))
+ '(shadow ((t (:foreground "grey70"))))
+
+ '(show-paren-match ((t (:background "steelblue3"))))
+ '(show-paren-match-face ((t (:background "steelblue3"))))
+ '(show-paren-mismatch ((t (:background "purple" :foreground "white"))))
+ '(smerge-base ((t (:foreground "orange"))))
+ '(smerge-markers ((t (:background "grey30"))))
+ '(smerge-mine ((t (:foreground "cyan"))))
+ '(smerge-other ((t (:foreground "lightgreen"))))
+ '(smerge-refined-change ((t (:background "blue4"))))
+ '(speedbar-button-face ((t (:foreground "green3"))))
+ '(speedbar-directory-face ((t (:foreground "light blue"))))
+ '(speedbar-file-face ((t (:foreground "cyan"))))
+ '(speedbar-highlight-face ((t (:background "sea green"))))
+ '(speedbar-selected-face ((t (:foreground "red" :underline t))))
+ '(speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray"))))
+ '(speedbar-tag-face ((t (:foreground "yellow"))))
+ '(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"))))
+ '(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"))))
+ '(vhdl-font-lock-directive-face ((t (:foreground "CadetBlue"))))
+ '(vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4"))))
+ '(vhdl-font-lock-function-face ((t (:foreground "Orchid4"))))
+ '(vhdl-font-lock-prompt-face ((t (:foreground "Red" :bold t))))
+ '(vhdl-font-lock-reserved-words-face ((t (:foreground "Orange" :bold t))))
+ '(vhdl-font-lock-translate-off-face ((t (:background "LightGray"))))
+ '(vhdl-speedbar-architecture-face ((t (:foreground "Blue"))))
+ '(vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t))))
+ '(vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod"))))
+ '(vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t))))
+ '(vhdl-speedbar-entity-face ((t (:foreground "ForestGreen"))))
+ '(vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t))))
+ '(vhdl-speedbar-instantiation-face ((t (:foreground "Brown"))))
+ '(vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t))))
+ '(vhdl-speedbar-package-face ((t (:foreground "Grey50"))))
+ '(vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t))))
+
+ '(viper-minibuffer-emacs-face ((t (:foreground "Black" :background "darkseagreen2"))))
+ '(viper-minibuffer-insert-face ((t (:foreground "Black" :background "pink"))))
+ '(viper-minibuffer-vi-face ((t (:foreground "DarkGreen" :background "grey"))))
+ '(viper-replace-overlay-face ((t (:foreground "Black" :background "darkseagreen2"))))
+ '(viper-search-face ((t (:foreground "Black" :background "khaki"))))
+ '(vm-highlight-url-face ((t (:bold t :italic t :slant italic :weight bold))))
+ '(vm-highlighted-header-face ((t (:bold t :weight bold))))
+ '(vm-mime-button-face ((t (:background "grey75" :foreground "black" :box (:line-width 2 :style released-button)))))
+ '(vm-summary-highlight-face ((t (:bold t :weight bold))))
+ '(vm-xface ((t (:background "white" :foreground "black"))))
+
+ '(which-func ((t (:foreground "Blue1"))))
+ '(widget ((t (:height 1.2 :background "Gray80" :foreground "black"))))
+ '(widget-button ((t (:bold t :weight bold :box (:line-width 2 :style released-button)))))
+ '(widget-button-face ((t (:bold t :weight bold :box (:line-width 2 :style released-button)))))
+ '(widget-button-pressed ((t (:foreground "red1" :background "lightgrey" :box (:line-width 2 :style pressed-button)))))
+ '(widget-button-pressed-face ((t (:foreground "red1" :background "lightgrey" :box (:line-width 2 :style pressed-button)))))
+ '(widget-documentation ((t (:foreground "lime green"))))
+ '(widget-documentation-face ((t (:foreground "lime green"))))
+ '(widget-field ((t (:background "dim gray"))))
+ '(widget-field-face ((t (:background "dim gray"))))
+ '(widget-inactive ((t (:foreground "grey70"))))
+ '(widget-inactive-face ((t (:foreground "grey70"))))
+ '(widget-single-line-field ((t (:background "dim gray"))))
+ '(widget-single-line-field-face ((t (:background "dim gray"))))
+ '(woman-bold-face ((t (:bold t))))
+ '(woman-italic-face ((t (:foreground "beige"))))
+ '(woman-unknown-face ((t (:foreground "LightSalmon")))))
+
+(provide-theme 'manoj-dark)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; manoj-dark.el ends here
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index 864d31d9b09..ab4b2bc6191 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -22,7 +22,7 @@
;;; Code:
(deftheme misterioso
- "Theme for faces, using light colors on a dark gray background.")
+ "Predominantly blue/cyan faces on a dark cyan background.")
(let ((class '((class color) (min-colors 89))))
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index a5731ab7d7d..403370c90cb 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -28,7 +28,7 @@
;;; Code:
(deftheme tango-dark
- "Theme for faces, based on the Tango palette with a dark background.
+ "Face colors using the Tango palette (dark background).
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
Semantic, and Ansi-Color faces are included.")
@@ -86,7 +86,6 @@ Semantic, and Ansi-Color faces are included.")
`(font-lock-variable-name-face ((,class (:foreground ,orange-1))))
`(font-lock-warning-face ((,class (:foreground ,red-0))))
;; Button and link faces
- `(button ((,class (:underline t :foreground ,blue-1))))
`(link ((,class (:underline t :foreground ,blue-1))))
`(link-visited ((,class (:underline t :foreground ,blue-2))))
;; Gnus faces
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index 7be50a17f5f..9d0f0aca94a 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -28,7 +28,7 @@
;;; Code:
(deftheme tango
- "Theme for faces, based on the Tango palette with a light background.
+ "Face colors using the Tango palette (light background).
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
Semantic, and Ansi-Color faces are included.")
@@ -77,7 +77,6 @@ Semantic, and Ansi-Color faces are included.")
`(font-lock-variable-name-face ((,class (:foreground ,orange-4))))
`(font-lock-warning-face ((,class (:foreground ,red-2))))
;; Button and link faces
- `(button ((,class (:underline t :foreground ,blue-3))))
`(link ((,class (:underline t :foreground ,blue-3))))
`(link-visited ((,class (:underline t :foreground ,blue-2))))
;; Gnus faces
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index b4fe0b59237..82732765885 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -20,7 +20,8 @@
;;; Code:
(deftheme tsdh-dark
- "Theme with dark background used and created by Tassilo Horn.")
+ "Minor tweaks to the Emacs dark-background defaults.
+Used and created by Tassilo Horn.")
(custom-theme-set-faces
'tsdh-dark
@@ -32,6 +33,8 @@
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "dark red"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
+ '(gnus-button ((t (:inherit button))))
+ '(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight bold))))
'(header-line ((t (:inherit mode-line :inverse-video t))))
'(hl-line ((t (:background "grey28"))))
'(message-header-subject ((t (:foreground "SkyBlue"))))
@@ -52,6 +55,7 @@
'(outline-6 ((t (:inherit font-lock-constant-face :weight bold))))
'(outline-7 ((t (:inherit font-lock-builtin-face :weight bold))))
'(outline-8 ((t (:inherit font-lock-string-face :weight bold))))
+ '(rcirc-my-nick ((t (:foreground "LightSkyBlue" :weight bold))))
'(region ((t (:background "SteelBlue4"))))
'(show-paren-match ((t (:background "DarkGreen"))))
'(show-paren-mismatch ((t (:background "deep pink"))))
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index 4eda7a4b7c3..f62cea4eb47 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -20,7 +20,8 @@
;;; Code:
(deftheme tsdh-light
- "Black on white theme used and created by Tassilo Horn.")
+ "Minor tweaks to the Emacs white-background defaults.
+Used and created by Tassilo Horn.")
(custom-theme-set-faces
'tsdh-light
@@ -32,6 +33,8 @@
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
+ '(gnus-button ((t (:inherit button))))
+ '(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight bold))))
'(header-line ((t (:inherit mode-line :inverse-video t))))
'(hl-line ((t (:background "grey95"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
@@ -51,6 +54,7 @@
'(outline-6 ((t (:inherit font-lock-constant-face :weight bold))))
'(outline-7 ((t (:inherit font-lock-builtin-face :weight bold))))
'(outline-8 ((t (:inherit font-lock-string-face :weight bold))))
+ '(rcirc-my-nick ((t (:foreground "LightSkyBlue" :weight bold))))
'(region ((t (:background "lightgoldenrod1"))))
'(show-paren-match ((t (:background "LightCyan2"))))
'(show-paren-mismatch ((t (:background "deep pink"))))
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index 7fd241c5057..9f8772c4d6e 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -20,7 +20,7 @@
;;; Code:
(deftheme wheatgrass
- "A high-contrast theme with a black background.
+ "High-contrast green/blue/brown faces on a black background.
Basic, Font Lock, Isearch, Gnus, and Message faces are included.
The default face foreground is wheat, with other faces in shades
of green, brown, and blue.")
@@ -47,7 +47,6 @@ of green, brown, and blue.")
`(font-lock-variable-name-face ((,class (:foreground "yellow green"))))
`(font-lock-warning-face ((,class (:foreground "salmon1"))))
;; Button and link faces
- `(button ((,class (:underline t :foreground "cyan"))))
`(link ((,class (:underline t :foreground "cyan"))))
`(link-visited ((,class (:underline t :foreground "dark cyan"))))
;; Gnus faces
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index 6a16b52ee24..2aa64f894bf 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -22,7 +22,7 @@
;;; Code:
(deftheme wombat
- "Theme for faces, using easy-on-the eyes colors on a dark gray background.
+ "Medium-contrast faces with a dark gray background.
Adapted, with permission, from a Vim color scheme by Lars H. Nielsen.
Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces
are included.")
diff --git a/etc/tutorials/TUTORIAL.zh b/etc/tutorials/TUTORIAL.zh
index a7dc9e63a4a..da628a3af68 100644
--- a/etc/tutorials/TUTORIAL.zh
+++ b/etc/tutorials/TUTORIAL.zh
@@ -1,4 +1,4 @@
-Emacs §Ö³t«ü«n¡].
+Emacs §Ö³t«ü«n.
Emacs «ü¥O³q±`¥]§t¦³ CONTROL Áä¡]¦³®É­Ô¥H CTRL ©Î CTL ¨Ó¼Ð¥Ü¡^©Î¬O
META Áä¡]¦³®É­Ô¥H EDIT ©Î ALT ¨Ó¼Ð¥Ü¡^¡C¬°¤FÁקK¨C¤@¦¸³£­n¼g¥X¨ä¥þ¦W¡A
diff --git a/leim/CXTERM-DIC/4Corner.tit b/leim/CXTERM-DIC/4Corner.tit
index e95b970d651..9457dd88386 100644
--- a/leim/CXTERM-DIC/4Corner.tit
+++ b/leim/CXTERM-DIC/4Corner.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
# HANZI input table for cxterm
# To be used by cxterm, convert me to .cit format first
# .cit version 2
diff --git a/leim/CXTERM-DIC/ARRAY30.tit b/leim/CXTERM-DIC/ARRAY30.tit
index f1f7f1e2471..f29c8e479d7 100644
--- a/leim/CXTERM-DIC/ARRAY30.tit
+++ b/leim/CXTERM-DIC/ARRAY30.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
##############################################################
# ¦æ¦C¢²¢¯Áä¿é¤Jªk, CXTERM ±M¥Î¿é¤Jªk¸ê®Æªí®æ.
# µ¹ CXTERM ¨Ï¥Î«e, ½Ð±z¥ý¥Î tit2cit ±N¦¹ÀÉÂà´«¦¨ .cit ®æ¦¡¡C
diff --git a/leim/CXTERM-DIC/CCDOSPY.tit b/leim/CXTERM-DIC/CCDOSPY.tit
index 930f424839b..8c67c3bdfac 100644
--- a/leim/CXTERM-DIC/CCDOSPY.tit
+++ b/leim/CXTERM-DIC/CCDOSPY.tit
@@ -1,3 +1,4 @@
+# -*- coding: euc-china -*-
# Header added for Emacs
#
# This file is included in the directory contrib/clients/cxterm of the
diff --git a/leim/CXTERM-DIC/ECDICT.tit b/leim/CXTERM-DIC/ECDICT.tit
index 7508e6b1f21..e65181e884e 100644
--- a/leim/CXTERM-DIC/ECDICT.tit
+++ b/leim/CXTERM-DIC/ECDICT.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
AUTORELOAD: YES
AUTOSTUDY: NO
FULLCODE: YES
diff --git a/leim/CXTERM-DIC/ETZY.tit b/leim/CXTERM-DIC/ETZY.tit
index ab123a9fd41..6bf662e2805 100644
--- a/leim/CXTERM-DIC/ETZY.tit
+++ b/leim/CXTERM-DIC/ETZY.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
# HANZI input table for cxterm
# Generated from ETZY.cit by cit2tit
# To be used by cxterm, convert me to .cit format first
diff --git a/leim/CXTERM-DIC/PY-b5.tit b/leim/CXTERM-DIC/PY-b5.tit
index c3d88ca39de..72c20fe70ca 100644
--- a/leim/CXTERM-DIC/PY-b5.tit
+++ b/leim/CXTERM-DIC/PY-b5.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
# Header added for Emacs
#
# This file is included in the directory contrib/clients/cxterm of the
diff --git a/leim/CXTERM-DIC/Punct-b5.tit b/leim/CXTERM-DIC/Punct-b5.tit
index adff8b9430e..46f0323a108 100644
--- a/leim/CXTERM-DIC/Punct-b5.tit
+++ b/leim/CXTERM-DIC/Punct-b5.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
# HANZI input table for cxterm
# Generated from Punct-b5.cit by cit2tit
# To be used by cxterm, convert me to .cit format first
diff --git a/leim/CXTERM-DIC/Punct.tit b/leim/CXTERM-DIC/Punct.tit
index 09a23915bc8..3807d979a79 100644
--- a/leim/CXTERM-DIC/Punct.tit
+++ b/leim/CXTERM-DIC/Punct.tit
@@ -1,3 +1,4 @@
+# -*- coding: euc-china -*-
# HANZI input table for cxterm
# To be used by cxterm, convert me to .cit format first
# .cit version 1
diff --git a/leim/CXTERM-DIC/QJ-b5.tit b/leim/CXTERM-DIC/QJ-b5.tit
index 7ef537bd5c0..9ab03e83a47 100644
--- a/leim/CXTERM-DIC/QJ-b5.tit
+++ b/leim/CXTERM-DIC/QJ-b5.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
# HANZI input table for cxterm
# To be used by cxterm, convert me to .cit format first
# .cit version 2
diff --git a/leim/CXTERM-DIC/QJ.tit b/leim/CXTERM-DIC/QJ.tit
index e2b2c529ac9..fafeea4b866 100644
--- a/leim/CXTERM-DIC/QJ.tit
+++ b/leim/CXTERM-DIC/QJ.tit
@@ -1,3 +1,4 @@
+# -*- coding: euc-china -*-
# HANZI input table for cxterm
# To be used by cxterm, convert me to .cit format first
# .cit version 2
diff --git a/leim/CXTERM-DIC/SW.tit b/leim/CXTERM-DIC/SW.tit
index f95e24032e6..a30dcf01090 100644
--- a/leim/CXTERM-DIC/SW.tit
+++ b/leim/CXTERM-DIC/SW.tit
@@ -1,3 +1,4 @@
+# -*- coding: euc-china -*-
# Header added for Emacs
#
# This file is included in the directory contrib/clients/cxterm of the
diff --git a/leim/CXTERM-DIC/TONEPY.tit b/leim/CXTERM-DIC/TONEPY.tit
index 8d7deaeae41..4b97ce8f0b1 100644
--- a/leim/CXTERM-DIC/TONEPY.tit
+++ b/leim/CXTERM-DIC/TONEPY.tit
@@ -1,3 +1,4 @@
+# -*- coding: euc-china -*-
# Header added for Emacs
#
# This file is included in the directory contrib/clients/cxterm of the
diff --git a/leim/CXTERM-DIC/ZOZY.tit b/leim/CXTERM-DIC/ZOZY.tit
index ed4a7020120..7ac7acff3e6 100644
--- a/leim/CXTERM-DIC/ZOZY.tit
+++ b/leim/CXTERM-DIC/ZOZY.tit
@@ -1,3 +1,4 @@
+# -*- coding: cn-big5 -*-
# HANZI input table for cxterm
# Generated from ZOZY.cit by cit2tit
# To be used by cxterm, convert me to .cit format first
diff --git a/leim/ChangeLog b/leim/ChangeLog
index fdc54fd475c..6df1c507d02 100644
--- a/leim/ChangeLog
+++ b/leim/ChangeLog
@@ -1,3 +1,31 @@
+2011-06-12 Andreas Schwab <schwab@linux-m68k.org>
+
+ * SKK-DIC/SKK-JISYO.L: Add proper coding tag.
+ * CXTERM-DIC/4Corner.tit, CXTERM-DIC/ARRAY30.tit,
+ * CXTERM-DIC/CCDOSPY.tit, CXTERM-DIC/ECDICT.tit,
+ * CXTERM-DIC/ETZY.tit, CXTERM-DIC/PY-b5.tit,
+ * CXTERM-DIC/Punct-b5.tit, CXTERM-DIC/Punct.tit,
+ * CXTERM-DIC/QJ-b5.tit, CXTERM-DIC/QJ.tit, CXTERM-DIC/SW.tit,
+ * CXTERM-DIC/TONEPY.tit, CXTERM-DIC/ZOZY.tit: Likewise.
+ * MISC-DIC/cangjie-table.b5, MISC-DIC/cangjie-table.cns,
+ * MISC-DIC/pinyin.map, MISC-DIC/ziranma.cin: Likewise.
+
+ * Makefile.in (TIT_BIG5): Renamed from TIT-BIG5.
+
+2011-05-30 Oliver Scholz <epameinondas@gmx.de>
+
+ * quail/ipa-praat.el: New input method.
+
+2011-05-16 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in (OTHERS): Add $(srcdir)/quail/persian.elc.
+
+ * makefile.w32-in (MISC): Add $(srcdir)/quail/persian.elc.
+
+2011-05-16 Mohsen BANAN <libre@mohsen.banan.1.byname.net>
+
+ * quail/persian.el: New file.
+
2011-05-05 Eli Zaretskii <eliz@gnu.org>
* quail/latin-ltx.el <\beth, \gimel, \daleth>: Produce
diff --git a/leim/MISC-DIC/cangjie-table.b5 b/leim/MISC-DIC/cangjie-table.b5
index 7127ca02700..294488b8497 100644
--- a/leim/MISC-DIC/cangjie-table.b5
+++ b/leim/MISC-DIC/cangjie-table.b5
@@ -1,3 +1,4 @@
+# -*- coding: big5 -*-
# Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
#
# Permission to copy and distribute both modified and
diff --git a/leim/MISC-DIC/cangjie-table.cns b/leim/MISC-DIC/cangjie-table.cns
index 1829c9a2897..123013ad256 100644
--- a/leim/MISC-DIC/cangjie-table.cns
+++ b/leim/MISC-DIC/cangjie-table.cns
@@ -1,3 +1,4 @@
+# -*- coding: iso-2022-cn-ext -*-
# This file is automatically generated from the file cangjie-table.b5
# by Big5->CNS converter.
#
diff --git a/leim/MISC-DIC/pinyin.map b/leim/MISC-DIC/pinyin.map
index 47078e50282..a785235312c 100644
--- a/leim/MISC-DIC/pinyin.map
+++ b/leim/MISC-DIC/pinyin.map
@@ -1,3 +1,4 @@
+% -*- coding: cn-gb-2312 -*-
% Header added for Emacs
%
% This file is included in the free package called CCE. It is
diff --git a/leim/MISC-DIC/ziranma.cin b/leim/MISC-DIC/ziranma.cin
index fe380e9dc49..3c25655ece4 100644
--- a/leim/MISC-DIC/ziranma.cin
+++ b/leim/MISC-DIC/ziranma.cin
@@ -1,3 +1,4 @@
+% -*- coding: cn-gb-2312 -*-
% Header added for Emacs
%
% This file is included in the free package called CCE. It is
diff --git a/leim/Makefile.in b/leim/Makefile.in
index 531f0481f7a..18eb8b62a96 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -62,7 +62,7 @@ TIT_GB=\
quail/TONEPY.elc
# Files generated from TIT dictionaries for Chinese BIG5 character set.
-TIT-BIG5=\
+TIT_BIG5=\
quail/4Corner.elc \
quail/ARRAY30.elc \
quail/ECDICT.elc \
@@ -126,6 +126,7 @@ OTHERS= \
${srcdir}/quail/ipa.elc \
${srcdir}/quail/hebrew.elc \
${srcdir}/quail/georgian.elc \
+ $(srcdir)/quail/persian.elc \
${srcdir}/quail/sisheng.elc
MISC= \
diff --git a/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L
index d2e51a4c170..177ba7ce731 100644
--- a/leim/SKK-DIC/SKK-JISYO.L
+++ b/leim/SKK-DIC/SKK-JISYO.L
@@ -1,4 +1,4 @@
-;; -*- text -*-
+;; -*- text; coding: euc-jp -*-
;; SKK-JISYO.L.unannotated was generated automatically by unannotation.awk at Tue Jan 26 00:31:27 2010
;; -*- mode: fundamental; coding: euc-jp -*-
;; Large size dictionary for SKK system
diff --git a/leim/makefile.w32-in b/leim/makefile.w32-in
index 08b029db861..1ab14c72b3d 100644
--- a/leim/makefile.w32-in
+++ b/leim/makefile.w32-in
@@ -120,6 +120,7 @@ MISC= \
$(srcdir)/quail/ipa.elc \
$(srcdir)/quail/hebrew.elc \
$(srcdir)/quail/georgian.elc \
+ $(srcdir)/quail/persian.elc \
$(srcdir)/quail/sisheng.elc
MISC_DIC=\
diff --git a/leim/quail/ipa-praat.el b/leim/quail/ipa-praat.el
new file mode 100644
index 00000000000..25eb6d4b995
--- /dev/null
+++ b/leim/quail/ipa-praat.el
@@ -0,0 +1,346 @@
+;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Oliver Scholz <epameinondas@gmx.de>
+;; Keywords: multilingual, input method, IPA
+
+;; 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 new input method for IPA characters and diacritics, which follows
+;; the conventions of Praat, a GPLed program for phonetical analysis.
+;;
+;; This input method is much more complete than the current ipa.el.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "ipa-praat" "IPA" "IPAP" t
+ "International Phonetic Alphabet input method.
+This follows the input method of the phonetical analysis program
+Praat (http://www.fon.hum.uva.nl/praat/).
+
+
+* Vowels
+
+- Unrounded
+ | front | centr. | back
+-------------+-------+--------+------
+close | i i | ɨ \\i- | ɯ \\mt
+close centr. | ɪ \\ic | |
+close-mid | e e | ɘ \\e- | ɤ \\rh
+ | | É™ \\sw |
+open-mid | ɛ \\ef | ɜ \\er | ʌ \\vt
+ | æ \\ae | É \\at |
+open | a a | | É‘ \\as
+
+
+
+- Rounded
+ | front | centr. | back
+-------------+-------+--------+-------
+close | y y | ʉ \\u- | u u
+close centr. | Ê \\yc | | ÊŠ \\hs
+close-mid | ø \\o/ | ɵ \\o- | o o
+open-mid | Å“ \\oe | Éž \\kb | É” \\ct
+open | ɶ \\Oe | | ɒ \\ab
+
+
+
+For most of the codes, the first letter tells you the most
+similar letter of the English alphabet. The second letter can be
+t (turned), c (capital), s (script), r (reversed), - (barred or
+retracted), or / (slashed). One symbol (É›) is a phonetic version
+of a Greek letter. The codes for ə, ɤ, ʊ and ɞ are abbreviations
+for schwa, ram's horn, horseshoe, and kidney bean.
+
+
+* Consonants
+
+- Pulmonic
+
+ | plos. | nasal | fric. | approx. | trill | tap/flap | l. appr.
+-----------+-------+-------+-------+---------+-------+----------+---------
+bilabial | p p | m m | ɸ \\ff | | | |
+ | b b | | β \\bf | ʋ \\vs | ʙ \\bc | |
+labiodent. | | ɱ \\mj | f f | | | |
+ | | | v v | | | |
+dental | | | θ \\tf | | | |
+ | | | ð \\dh | | | |
+alveolar | t t | n n | s s | | | ɾ \\fh |
+ | d d | | z z | ɹ \\rt | r r | | l l
+alv. lat. | | | ɬ \\l- | | | ɺ \\rl |
+ | | | É® \\lz | l l | | | l l
+postalv. | | | ʃ \\sh | | | |
+ | | | Ê’ \\zh | | | |
+retroflex | ʈ \\t. | ɳ \\n. | ʂ \\s. | | | ɽ \\f. |
+ | É– \\d. | | Ê \\z. | É» \\r. | | | É­ \\l.
+alv.-pala. | | | É• \\cc | | | |
+ | | | Ê‘ \\zc | | | |
+palatal | c c | ɲ \\nj | ç \\c, | | | |
+ | ÉŸ \\j. | | Ê \\jc | j j | | | ÊŽ \\yt
+lab-pal. | | | | | | |
+ | | | | ɥ \\ht | | |
+lab.-vela. | | | Ê \\wt | | | |
+ | | | | w w | | |
+velar | k k | Å‹ \\ng | x x | | | | ÊŸ \\lc
+ | ɡ \\gs | | ɣ \\gf | ɰ \\ml | | |
+uvular | q q | ɴ \\nc | χ \\cf | | | |
+ | É¢ \\gc | | Ê \\ri | | Ê€ \\rc | |
+pharyngeal | | | ħ \\h- | | | |
+ | | | Ê• \\9e | | | |
+epiglottal | ʡ \\?- | | ʜ \\hc | | | |
+ | | | ʢ \\9- | | | |
+glottal | Ê” | | h h | | | |
+ | | | ɦ \\h^ | | | |
+
+- Nonpulmonic
+
+ | implosive | click
+----------+-----------+------
+bilabial | ɓ \\b^ | ʘ \\O.
+dental | | ǀ \\|1
+alveolar | É— \\d^ |
+alv.-lat. | | Ç \\|2
+postalv. | | Ç‚ \\|-
+retrofl. | | ! !
+palatal | Ê„ \\j^ |
+velar | É  \\g^ |
+uvular | Ê› \\G^ |
+
+For most of the codes, the first letter tells you the most
+similar letter of the English alphabet. The second letter can be
+t (turned), c (capital or curled), s (script), - (barred),
+l (with leg), i (inverted), or j (left tail). Some phonetic
+symbols are similar to Greek letters but have special
+phonetic (f) versions with serifs (ɸ, β, ɣ) or are otherwise
+slightly different (θ, χ). The codes for ŋ (engma), ð (eth),
+ʃ (esh), and ʒ (yogh) are traditional alternative spellings. The
+retroflexes have a period in the second place, because an
+alternative traditional spelling is to write a dot under
+them. The code for ɾ is an abbreviation for fishhook.
+
+
+* Diacritics
+
+- In line
+
+input | example | description
+------+---------+---------------------
+\\:f | Ë | phonetic length sign
+\\'1 | ˈ | primary stress
+\\'2 | ˌ | secondary stress
+\\cn | tÌš | unreleased plosive
+\\rh | ɜ˞ | rhotacized vowel
+
+- Understrikes
+
+input | example | description
+------+---------+--------------------------------
+\\|v | n̩ | syllabic consonant
+\\0v | b̥ | voiceless
+\\Tv | oÌž | lowered
+\\T^ | oÌ | raised
+\\T( | o̘ | advanced tongue root
+\\T) | oÌ™ | retracted tongue root
+\\-v | e̱ | backed
+\\+v | oÌŸ | fronted
+\\:v | o̤ | breathy voice
+\\~v | oÌ° | creaky voice
+\\Nv | d̪ | dental (as opposed to alveolar)
+\\Uv | d̺ | apical
+\\Dv | dÌ» | laminal
+\\nv | u̯ | nonsyllabic
+\\e3v | e̹ | slightly rounded
+\\cv | u̜ | slightly unrounded
+
+- Overstrikes
+
+input | example | description
+------+---------+--------------------------------------------
+\\0^ | ɣ̊ | voiceless
+\\'^ | | high tone
+\\`^ | | low tone
+\\-^ | | mid tone
+\\~^ | | nasalized
+\\v^ | | rising tone
+\\^^ | | falling tone
+\\:^ | | centralized
+\\N^ | | short
+\\li | k͡p | simultaneous articulation or single segment
+"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ;; plosives
+ ("\\t." ?ʈ) ; retroflex
+ ("\\d." ?É–) ; voiced retroflex
+ ("\\j-" ?ÉŸ) ; voiced palatal
+ ("\\gs" ?É¡) ; voiced velar
+ ("\\gc" ?É¢) ; voiced uvular
+ ("\\?-" ?Ê¡) ; epiglottal
+ ("\\?g" ?Ê”) ; glottal
+
+ ;; nasals
+ ("\\mj" ?ɱ) ; labiodental
+ ("\\n." ?ɳ) ; retroflex
+ ("\\nj" ?ɲ) ; palatal
+ ("\\ng" ?Å‹) ; velar
+ ("\\nc" ?É´) ; uvular
+
+ ;; fricatives
+ ("\\ff" ?ɸ) ; bilabial
+ ("\\bf" ?β) ; voiced bilabial
+ ("\\tf" ?θ) ; labiodental
+ ("\\dh" ?ð) ; voiced labiodental
+ ("\\sh" ?ʃ) ; postalveolar
+ ("\\l-" ?ɬ) ; alv. lateral
+ ("\\lz" ?É®) ; voiced alv. lateral
+ ("\\zh" ?Ê’) ; voiced postalveolar
+ ("\\s." ?Ê‚) ; retroflex
+ ("\\z." ?Ê) ; voiced retroflex
+ ("\\cc" ?É•) ; alveolo-palatal
+ ("\\zc" ?Ê‘) ; voiced alveolo-palatal
+ ("\\c," ?ç) ; palatal
+ ("\\jc" ?Ê) ; voiced palatal
+ ("\\wt" ?Ê) ; labial-velar
+ ("\\gf" ?É£) ; voiced velar
+ ("\\cf" ?χ) ; uvular
+ ("\\ri" ?Ê) ; voiced uvular
+ ("\\h-" ?ħ) ; pharyngeal
+ ("\\9e" ?Ê•) ; voiced pharyngeal
+ ("\\hc" ?ʜ) ; epiglottal
+ ("\\9-" ?Ê¢) ; voiced epiglottal
+ ("\\h^" ?ɦ) ; voiced glottal
+
+ ;; approximants
+ ("\\vs" ?Ê‹) ; labiodental
+ ("\\rt" ?ɹ) ; alveolar
+ ("\\r." ?É») ; retroflex
+ ("\\ht" ?É¥) ; labial-palatal
+ ("\\ml" ?É°) ; velar
+
+ ;; trills
+ ("\\bc" ?Ê™) ; bilabial
+ ("\\rc" ?Ê€) ; uvular
+
+ ;; taps or flaps
+ ; â±± -- labiodental
+ ("\\fh" ?ɾ) ; alveolar
+ ("\\rl" ?ɺ) ; alv.-lateral
+ ("\\f." ?ɽ) ; retroflex
+
+ ;; lateral approx.
+ ("\\l." ?É­) ; retroflex
+ ("\\yt" ?ÊŽ) ; palatal
+ ("\\lc" ?ÊŸ) ; velar
+
+ ;; implosives
+ ("\\b^" ?É“) ; bilabial
+ ("\\d^" ?É—) ; alveolar
+ ("\\j^" ?Ê„) ; palatal
+ ("\\g^" ?É ) ; velar
+ ("\\G^" ?Ê›) ; uvular
+
+ ;; clicks
+ ("\\O." ?ʘ) ; bilabial
+ ("\\|1" ?Ç€) ; dental
+ ("\\|2" ?Ç) ; alv. lateral
+ ("\\|-" ?Ç‚) ; postalveolar
+
+ ;; other
+ ("\\l~" ?É«) ; velarized l
+ ("\\hj" ?ɧ) ; post-alveolar & velar fricative
+
+ ;; vowels
+ ("\\i-" ?ɨ)
+ ("\\u-" ?ʉ)
+
+ ("\\mt" ?ɯ)
+
+ ("\\ic" ?ɪ)
+ ("\\yc" ?Ê)
+
+ ("\\hs" ?ÊŠ)
+
+ ("\\o/" ?ø)
+ ("\\e-" ?ɘ)
+ ("\\o-" ?ɵ)
+ ("\\rh" ?ɤ)
+
+ ("\\sw" ?É™)
+
+ ("\\ef" ?É›)
+ ("\\oe" ?Å“)
+ ("\\er" ?ɜ)
+ ("\\kb" ?Éž)
+ ("\\vt" ?ʌ)
+ ("\\ct" ?É”)
+
+ ("\\ae" ?æ)
+ ("\\at" ?É)
+
+ ("\\Oe" ?ɶ)
+ ("\\as" ?É‘)
+ ("\\ab" ?É’)
+
+ ("\\sr" ?Éš)
+
+ ;; diacritics
+ ("\\:f" ?Ë) ; phonetic length sign
+ ("\\'1" ?ˈ) ; primary stress
+ ("\\'2" ?ˌ) ; secondary stress
+ ("\\cn" #x031A) ; tÌš unreleased plosive
+ ("\\rh" #x02DE) ; ɜ˞ rhotacized vowel
+
+ ("\\|v" #x0329) ; n̩ syllabic consonant
+ ("\\0v" #x0325) ; b̥ voiceless
+ ("\\Tv" #x031E) ; oÌž lowered
+ ("\\T^" #x031D ) ; oÌ raised
+ ("\\T(" #x0318) ; o̘ advanced tongue root
+ ("\\T)" #x0319) ; oÌ™ retracted tongue root
+ ("\\-v" #x0331) ; e̱ backed
+ ("\\+v" #x031F) ; oÌŸ fronted
+ ("\\:v" #x0324) ; o̤ breathy voice
+ ("\\~v" #x0330) ; oÌ° creaky voice
+ ("\\Nv" #x032A) ; d̪ dental (as opposed to alveolar)
+ ("\\Uv" #x033A) ; d̺ apical
+ ("\\Dv" #x033B) ; dÌ» laminal
+ ("\\nv" #x032F) ; u̯ nonsyllabic
+ ("\\e3v" #x0339) ; e̹ slightly rounded
+ ("\\cv" #x031C) ; u̜ slightly unrounded
+
+ ("\\0^" #x030A) ; ɣ̊ voiceless
+ ("\\'^" #x0301) ; high tone
+ ("\\`^" #x0300) ; low tone
+ ("\\-^" #x0304) ; mid tone
+ ("\\~^" #x0303) ; nasalized
+ ("\\v^" #x030C) ; rising tone
+ ("\\^^" #x0302) ; falling tone
+ ("\\:^" #x0308) ; centralized
+ ("\\N^" #x0306) ; short
+ ("\\li" #x0361) ; k͡p simultaneous articulation or single segment
+ )
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; ipa-praat.el ends here
diff --git a/leim/quail/persian.el b/leim/quail/persian.el
new file mode 100644
index 00000000000..b664eb5995b
--- /dev/null
+++ b/leim/quail/persian.el
@@ -0,0 +1,296 @@
+;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8;-*-
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Mohsen BANAN <libre@mohsen.banan.1.byname.net>
+;; http://mohsen.banan.1.byname.net/contact
+
+;; Keywords: multilingual, input method, Farsi, Persian, keyboard
+
+;; 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/>.
+
+;; 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/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
+;;
+
+;;; Code:
+
+(require 'quail)
+
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; farsi
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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
+;; http://www.isiri.org/UserStd/DownloadStd.aspx?id=9147
+;;
+;; Only layers 1 and 2 of ISIRI-9147 are applicable to emacs.
+;;
+;; This input method was built using the Farsi table in X Keyboard Configuration Data Base.
+;;
+;; 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
+;;
+
+
+(quail-define-package
+ "farsi" "Farsi" " Ù" nil "Farsi input method.
+
+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 | دٔ| پء | و> | .< | /؟ |
+;; +-------------------------------------------+
+
+(quail-define-rules
+ ("1" ?Û±)
+ ("2" ?Û²)
+ ("3" ?Û³)
+ ("4" ?Û´)
+ ("5" ?Ûµ)
+ ("6" ?Û¶)
+ ("7" ?Û·)
+ ("8" ?Û¸)
+ ("9" ?Û¹)
+ ("0" ?Û°)
+ ("-" ?-)
+ ("=" ?=)
+ ;;("`" ?â€\)) ;; اتصال مجازى
+ ("q" ?ض)
+ ("w" ?ص)
+ ("e" ?Ø«)
+ ("r" ?Ù‚)
+ ("t" ?Ù)
+ ("y" ?غ)
+ ("u" ?ع)
+ ("i" ?Ù‡)
+ ("o" ?Ø®)
+ ("p" ?Ø­)
+ ("[" ?ج)
+ ("]" ?Ú†)
+ ("a" ?Ø´)
+ ("s" ?س)
+ ("d" ?ی)
+ ("f" ?ب)
+ ("g" ?Ù„)
+ ("h" ?ا)
+ ("j" ?ت)
+ ("k" ?Ù†)
+ ("l" ?Ù…)
+ (";" ?Ú©)
+ ("'" ?Ú¯)
+ ("\\" ?\\) ;; خط اريب وارو
+ ("z" ?ظ)
+ ("x" ?Ø·)
+ ("c" ?ز)
+ ("v" ?ر)
+ ("b" ?Ø°)
+ ("n" ?د)
+ ("m" ?Ù¾)
+ ("," ?Ùˆ)
+ ("." ?.)
+ ("/" ?/)
+
+ ("!" ?!)
+ ("@" ?Ù¬)
+ ("#" ?Ù«)
+ ("$" ?ï·¼)
+ ("%" ?Ùª)
+ ("^" ?×)
+ ("&" ?،)
+ ("*" ?*)
+ ("(" ?\))
+ (")" ?\()
+ ("_" ?Ù€)
+ ("+" ?+)
+ ("~" ?÷)
+ ("Q" ?Ù’) ;; ساکن Ùارسى
+ ("W" ?ÙŒ) ;; دو پيش Ùارسى -- تنوين رÙع
+ ("E" ?Ù) ;; دو زير Ùارسى -- تنوين جر
+ ("R" ?Ù‹) ;; دو زبر Ùارسى -- تنوين نصب
+ ("T" ?Ù) ;; پيش Ùارسى -- ضمه
+ ("Y" ?Ù) ;; زير Ùارسى -- کسره
+ ("U" ?ÙŽ) ;; زبر Ùارسى -- Ùتحه
+ ("I" ?Ù‘) ;; تشديد Ùارسى
+ ("O" ?\])
+ ("P" ?\[)
+ ("{" ?})
+ ("}" ?{)
+ ("A" ?ؤ)
+ ("S" ?ئ)
+ ("D" ?ÙŠ)
+ ("F" ?Ø¥)
+ ("G" ?Ø£)
+ ("H" ?Ø¢)
+ ("J" ?Ø©)
+ ("K" ?»)
+ ("L" ?«)
+ (":" ?:)
+ ("\"" ?Ø›)
+ ("|" ?|)
+ ("Z" ?Ùƒ)
+ ("X" ?Ù“)
+ ("C" ?Ú˜)
+ ("V" ?Ù°)
+ ;; ("B" ?‌‌) ;; Ùاصلهً مجازى
+ ("N" ?Ù”) ;; همزه Ùارسى بالا
+ ("M" ?Ø¡) ;; harf farsi hamzeh
+ ("<" ?>)
+ (">" ?<)
+ ("?" ?ØŸ)
+ )
+
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; farsi-translit
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; 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 inputing
+;;; the same character.
+;;;
+;;; 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.
+;;;
+
+
+
+(quail-define-package
+ "farsi-translit" "Farsi" "Ù¾" t
+ "Intuitive transliteration keyboard layout for persian/farsi.
+" nil t t t t nil nil nil nil nil t)
+
+
+(quail-define-rules
+ ("a" ?ا)
+ ("A" ?Ø¢) ;; alef madde
+ ("b" ?ب)
+ ("p" ?Ù¾)
+ ("t" ?ت)
+ ("c" ?Ø«)
+ ("j" ?ج)
+ ("ch" ?Ú†)
+ ("hh" ?Ø­)
+ ("kh" ?Ø®)
+ ("d" ?د)
+ ("Z" ?Ø°)
+ ("r" ?ر)
+ ("z" ?ز)
+ ("zh" ?Ú˜)
+ ("s" ?س)
+ ("sh" ?Ø´)
+ ("S" ?ص)
+ ("x" ?ض)
+ ("T" ?Ø·)
+ ("X" ?ظ)
+ ("w" ?ع)
+ ("Q" ?غ)
+ ("f" ?Ù)
+ ("q" ?Ù‚)
+ ("gh" ?Ù‚)
+ ("k" ?Ú©)
+ ("K" ?Ùƒ) ;; Arabic kaf
+ ("g" ?Ú¯)
+ ("l" ?Ù„)
+ ("lh" ?ï»»)
+ ("m" ?Ù…)
+ ("n" ?Ù†)
+ ("v" ?Ùˆ)
+ ("V" ?ؤ)
+ ("u" ?Ùˆ)
+ ("H" ?Ù‡)
+ ("h" ?Ù‡)
+ ("th" ?Ø©) ;; ta marbuteh
+ ("yh" ?Û€) ;; he ye
+ ("y" ?Ù‰)
+ ("i" ?ÙŠ)
+ ("I" ?ئ)
+
+ ("1" ?Û±)
+ ("2" ?Û²)
+ ("3" ?Û³)
+ ("4" ?Û´)
+ ("5" ?Ûµ)
+ ("6" ?Û¶)
+ ("7" ?Û·)
+ ("8" ?Û¸)
+ ("9" ?Û¹)
+ ("0" ?Û°)
+
+ ("F" ?Ø¥)
+ ("G" ?Ø£)
+
+ ("~" ?Ù‘) ;; tashdid ;; تشديد Ùارسى
+ ("`" ?Ù“)
+ ("e" ?Ù) ;; zir زير Ùارسى -- Ùتحه
+ ("E" ?Ù) ;; eizan ;; دو زير Ùارسى -- تنوين جر
+ ("#" ?Ù‹) ;; Ù‹ tanvin nasb ;; دو زبر Ùارسى -- تنوين نصب
+ ("@" ?Ù’) ;; ساکن Ùارسى
+ ("^" ?ÙŽ) ;; zbar ;; زبر Ùارسى -- Ùتحه
+ ("o" ?Ù) ;; peesh ;; پيش Ùارسى -- ضمه
+ ("O" ?ÙŒ) ;; دو پيش Ùارسى -- تنوين رÙع
+ ("?" ?ØŸ) ;; alamat soal
+ ("&" ?Ù”) ;; همزه Ùارسى بالا
+ ("$" ?Ø¡) ;; hamzeh
+ ("%" ?÷) ;;
+ ("*" ?×) ;;
+ (";" ?Ø›) ;;
+ (",h" ?،) ;; farsi
+ (",h" ?,) ;; latin
+ ("." ?.) ;;
+ ("_" ?Ù€) ;;
+)
+
+
+;;; persian.el ends here
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index c4a2df5bdbf..2a4c1024293 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,72 @@
+2011-07-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * update-game-score.c (usage): Update usage line.
+
+2011-07-02 Jason Rumney <jasonr@gnu.org>
+
+ * emacsclient.c (decode_options) [WINDOWSNT]: Avoid tty mode on
+ Windows (Bug#5486).
+
+2011-06-25 Glenn Morris <rgm@gnu.org>
+
+ * emacsclient.c (decode_options) <opt>: Add `F:'.
+ (print_help_and_exit): Mention --frame-parameters.
+
+2011-06-25 Andreas Rottmann <a.rottmann@gmx.at>
+
+ * emacsclient.c (longopts, decode_options, main): Add frame-parameters.
+
+2011-06-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * movemail.c: Fix race condition and related bugs (Bug#8836).
+ (main) [!MAIL_USE_SYSTEM_LOCK]: Prefer mkstemp to mktemp, as this
+ fixes some race conditions. Report mkstemp/mktemp errno rather
+ than a possibly-garbage errno. Reinitialize the template each
+ time through the loop, as earlier mkstemp/mktemp calls could have
+ trashed it. Pass 0600 (not 0666) to mktemp, for consistency
+ with mkstemp; the permissions don't matter anyway.
+
+2011-06-01 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * emacsclient.c (socket_status): Use constant pointer.
+
+2011-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use 'inline', not 'INLINE'.
+ * etags.c (hash): Now inline unconditionally.
+ * make-docfile.c (put_char): inline, not INLINE.
+
+2011-05-25 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (.c.o): Remove (every .o file has an explicit rule).
+ (insrcdir): New.
+ (stamp-rcs2log, stamp-rcs-checkin, stamp-grep-changelog, stamp-vcdiff):
+ Use $insrcdir to suppress unaesthetic ignored errors.
+ (clean): Simplify list of things to delete.
+ (all, clean): Use $EXE_FILES.
+
+ * Makefile.in (movemail${EXEEXT}): Build in one step, not via .o file.
+
+ * Makefile.in (REGEXPOBJ, REGEXPDEPS): Remove. Replace by expansion.
+ (etags${EXEEXT}): Just depend on regex.o, not regex.h as well.
+
+2011-05-24 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (update-game-score${EXEEXT}): Use a single rule.
+
+2011-05-19 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (echolisp): Remove rule that is no longer needed.
+ (clean): No more echolisp.tmp.
+
+2011-05-18 Glenn Morris <rgm@gnu.org>
+
+ * fakemail.c: Remove file.
+ * makefile.w32-in ($(BLD)/fakemail.exe, fakemail)
+ ($(BLD)/fakemail.$(O)): Remove.
+ * Makefile.in (UTILITIES): Remove fakemail${EXEEXT}.
+ (fakemail${EXEEXT}): Remove rule.
+
2011-04-24 Teodor Zlatanov <tzz@lifelogs.com>
* makefile.w32-in (obj): Add gnutls.o.
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 36366a4d2e7..f619febbb2b 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -117,8 +117,8 @@ STAMP_INST_SCRIPTS = stamp-rcs-checkin stamp-grep-changelog
# Things that Emacs runs internally, or during the build process,
# which should not be installed in bindir.
-UTILITIES = profile${EXEEXT} movemail${EXEEXT} fakemail${EXEEXT} \
- hexl${EXEEXT} update-game-score${EXEEXT}
+UTILITIES = profile${EXEEXT} movemail${EXEEXT} hexl${EXEEXT} \
+ update-game-score${EXEEXT}
DONT_INSTALL= test-distrib${EXEEXT} make-docfile${EXEEXT}
@@ -178,33 +178,27 @@ CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS}
LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
$(EXE_FILES): ../lib/libgnu.a
-## This is the default compilation command.
-## But we should never rely on it, because some make version failed to
-## find it for getopt.o.
-## Using an explicit command made it work.
-.c.o:
- ${CC} -c ${CPP_CFLAGS} $<
-
-all: ${DONT_INSTALL} ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
+all: ${EXE_FILES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
## These targets copy the scripts into the build directory so that
## they can be run from there in an uninstalled Emacs.
-## The "-" is prepended because some versions of cp barf when srcdir
-## is the current directory, and thus the file will be copied into itself.
+## Nothing to do if pwd = srcdir.
+insrcdir=[ "`/bin/pwd`" = "`(cd $(srcdir) && /bin/pwd)`" ]
+
stamp-rcs2log: $(srcdir)/rcs2log
- -cp -p $(srcdir)/rcs2log rcs2log
+ $(insrcdir) || cp -p $(srcdir)/rcs2log rcs2log
touch $@
stamp-rcs-checkin: $(srcdir)/rcs-checkin
- -cp -p $(srcdir)/rcs-checkin rcs-checkin
+ $(insrcdir) || cp -p $(srcdir)/rcs-checkin rcs-checkin
touch $@
stamp-grep-changelog: $(srcdir)/grep-changelog
- -cp -p $(srcdir)/grep-changelog grep-changelog
+ $(insrcdir) || cp -p $(srcdir)/grep-changelog grep-changelog
touch $@
stamp-vcdiff: $(srcdir)/vcdiff
- -cp -p $(srcdir)/vcdiff vcdiff
+ $(insrcdir) || cp -p $(srcdir)/vcdiff vcdiff
touch $@
## Only used if we need blessmail, but no harm in always defining.
@@ -281,8 +275,8 @@ mostlyclean:
-rm -f core *.o
clean: mostlyclean
- -rm -f ${INSTALLABLES} ${UTILITIES} ${DONT_INSTALL}
- -rm -f fns*.el *.tab.c *.tab.h stamp-*
+ -rm -f ${EXE_FILES}
+ -rm -f ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
distclean: clean
-rm -f TAGS
@@ -313,17 +307,14 @@ test-distrib${EXEEXT}: ${srcdir}/test-distrib.c
../lib/libgnu.a: ../src/config.h
cd ../lib && $(MAKE) libgnu.a
-REGEXPOBJ = regex.o
-REGEXPDEPS = $(REGEXPOBJ) $(srcdir)/../src/regex.h
-
regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h ../src/config.h
${CC} -c ${CPP_CFLAGS} -DCONFIG_BROKETS -DINHIBIT_STRING_HEADER \
${srcdir}/../src/regex.c
-etags${EXEEXT}: ${srcdir}/etags.c $(REGEXPDEPS) ../src/config.h
+etags${EXEEXT}: ${srcdir}/etags.c regex.o ../src/config.h
$(CC) ${ALL_CFLAGS} -DEMACS_NAME="\"GNU Emacs\"" \
-DVERSION="\"${version}\"" ${srcdir}/etags.c \
- $(REGEXPOBJ) $(LOADLIBES) -o etags
+ regex.o $(LOADLIBES) -o etags
ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h ../src/config.h
$(CC) ${ALL_CFLAGS} -DVERSION="\"${version}\"" \
@@ -334,7 +325,7 @@ ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h ../src/config.h
ctags${EXEEXT}: etags${EXEEXT}
$(CC) ${ALL_CFLAGS} -DCTAGS -DEMACS_NAME="\"GNU Emacs\"" \
-DVERSION="\"${version}\"" ${srcdir}/etags.c \
- $(REGEXPOBJ) $(LOADLIBES) -o ctags
+ regex.o $(LOADLIBES) -o ctags
profile${EXEEXT}: ${srcdir}/profile.c ../src/config.h
$(CC) ${ALL_CFLAGS} ${srcdir}/profile.c $(LOADLIBES) -o profile
@@ -343,19 +334,13 @@ make-docfile${EXEEXT}: ${srcdir}/make-docfile.c ../src/config.h
$(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) \
-o make-docfile
-movemail${EXEEXT}: movemail.o pop.o
- $(CC) ${LINK_CFLAGS} ${MOVE_FLAGS} movemail.o pop.o \
+movemail${EXEEXT}: ${srcdir}/movemail.c pop.o ../src/config.h
+ $(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} ${srcdir}/movemail.c pop.o \
$(LOADLIBES) $(LIBS_MOVE) -o movemail
-movemail.o: ${srcdir}/movemail.c ../src/config.h
- $(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} ${srcdir}/movemail.c
-
pop.o: ${srcdir}/pop.c ${srcdir}/../lib/min-max.h ../src/config.h
$(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} ${srcdir}/pop.c
-fakemail${EXEEXT}: ${srcdir}/fakemail.c ../src/config.h
- $(CC) ${ALL_CFLAGS} ${srcdir}/fakemail.c $(LOADLIBES) -o fakemail
-
emacsclient${EXEEXT}: ${srcdir}/emacsclient.c ../src/config.h
$(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c \
-DVERSION="\"${version}\"" \
@@ -364,12 +349,8 @@ emacsclient${EXEEXT}: ${srcdir}/emacsclient.c ../src/config.h
hexl${EXEEXT}: ${srcdir}/hexl.c ../src/config.h
$(CC) ${ALL_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o hexl
-update-game-score${EXEEXT}: update-game-score.o
- $(CC) ${LINK_CFLAGS} update-game-score.o \
- $(LOADLIBES) -o update-game-score
-
-update-game-score.o: ${srcdir}/update-game-score.c ../src/config.h
- $(CC) -c ${CPP_CFLAGS} ${srcdir}/update-game-score.c \
- -DHAVE_SHARED_GAME_DIR="\"$(gamedir)\""
+update-game-score${EXEEXT}: ${srcdir}/update-game-score.c ../src/config.h
+ $(CC) ${ALL_CFLAGS} -DHAVE_SHARED_GAME_DIR="\"$(gamedir)\"" \
+ ${srcdir}/update-game-score.c $(LOADLIBES) -o update-game-score
## Makefile ends here.
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 2aabc52e828..2af139aee6d 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -160,6 +160,10 @@ const char *server_file = NULL;
/* PID of the Emacs server process. */
int emacs_pid = 0;
+/* If non-NULL, a string that should form a frame parameter alist to
+ 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;
@@ -175,6 +179,7 @@ struct option longopts[] =
{ "nw", no_argument, NULL, 't' },
{ "create-frame", no_argument, NULL, 'c' },
{ "alternate-editor", required_argument, NULL, 'a' },
+ { "frame-parameters", required_argument, NULL, 'F' },
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
{ "socket-name", required_argument, NULL, 's' },
#endif
@@ -526,9 +531,9 @@ decode_options (int argc, char **argv)
{
int opt = getopt_long_only (argc, argv,
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
- "VHneqa:s:f:d:tc",
+ "VHneqa:s:f:d:F:tc",
#else
- "VHneqa:f:d:tc",
+ "VHneqa:f:d:F:tc",
#endif
longopts, 0);
@@ -599,6 +604,10 @@ decode_options (int argc, char **argv)
print_help_and_exit ();
break;
+ case 'F':
+ frame_parameters = optarg;
+ break;
+
default:
message (TRUE, "Try `%s --help' for more information\n", progname);
exit (EXIT_FAILURE);
@@ -643,6 +652,14 @@ decode_options (int argc, char **argv)
an empty string");
exit (EXIT_FAILURE);
}
+
+ /* TTY frames not supported on Windows. Continue using GUI rather than
+ forcing the user to change their command-line. This is required since
+ tty is set above if certain options are given and $DISPLAY is not set,
+ which is not obvious to users. */
+ if (tty)
+ tty = 0;
+
#endif /* WINDOWSNT */
}
@@ -665,6 +682,8 @@ The following OPTIONS are accepted:\n\
-nw, -t, --tty Open a new Emacs frame on the current terminal\n\
-c, --create-frame Create a new frame instead of trying to\n\
use the current Emacs frame\n\
+-F ALIST, --frame-parameters=ALIST\n\
+ Set the parameters of a new frame\n\
-e, --eval Evaluate the FILE arguments as ELisp expressions\n\
-n, --no-wait Don't wait for the server to return\n\
-q, --quiet Don't display messages on success\n\
@@ -1098,7 +1117,7 @@ find_tty (const char **tty_type, const char **tty_name, int noabort)
0 - success: none of the above */
static int
-socket_status (char *name)
+socket_status (const char *name)
{
struct stat statbfr;
@@ -1630,6 +1649,13 @@ main (int argc, char **argv)
send_to_emacs (emacs_socket, " ");
}
+ if (frame_parameters && !current_frame)
+ {
+ send_to_emacs (emacs_socket, "-frame-parameters ");
+ quote_argument (emacs_socket, frame_parameters);
+ 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. */
diff --git a/lib-src/etags.c b/lib-src/etags.c
index a2cdf26abc7..693c999047f 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -93,8 +93,11 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
#ifdef HAVE_CONFIG_H
# include <config.h>
- /* On some systems, Emacs defines static as nothing for the sake
- of unexec. We don't want that here since we don't use unexec. */
+ /* 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 *
@@ -2357,14 +2360,7 @@ and replace lines between %< and %> with its output, then:
struct C_stab_entry { const char *name; int c_ext; enum sym_type type; };
/* maximum key range = 33, duplicates = 0 */
-#ifdef __GNUC__
-__inline
-#else
-#ifdef __cplusplus
-inline
-#endif
-#endif
-static unsigned int
+static inline unsigned int
hash (register const char *str, register unsigned int len)
{
static unsigned char asso_values[] =
diff --git a/lib-src/fakemail.c b/lib-src/fakemail.c
deleted file mode 100644
index 435512125ff..00000000000
--- a/lib-src/fakemail.c
+++ /dev/null
@@ -1,744 +0,0 @@
-/* sendmail-like interface to /bin/mail for system V,
- Copyright (C) 1985, 1994, 1999, 2001-2011 Free Software Foundation, Inc.
-
-Author: Bill Rozas <jinx@martigny.ai.mit.edu>
-(according to ack.texi)
-
-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 _XOPEN_SOURCE 500 /* for cuserid */
-
-#ifdef HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-#if defined (BSD_SYSTEM) && !defined (USE_FAKEMAIL)
-/* This program isnot used in BSD, so just avoid loader complaints. */
-int
-main (void)
-{
- return 0;
-}
-#else /* not BSD 4.2 (or newer) */
-#ifdef MSDOS
-int
-main ()
-{
- return 0;
-}
-#else /* not MSDOS */
-/* This conditional contains all the rest of the file. */
-
-/* These are defined in config in some versions. */
-
-#ifdef static
-#undef static
-#endif
-
-#ifdef WINDOWSNT
-#include "ntlib.h"
-#endif
-
-#include <stdio.h>
-#include <string.h>
-#include <ctype.h>
-#include <time.h>
-#include <pwd.h>
-#include <stdlib.h>
-
-/* This is to declare cuserid. */
-#include <unistd.h>
-
-/* Type definitions */
-
-#define boolean int
-#define true 1
-#define false 0
-
-#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
-
-/* Various lists */
-
-struct line_record
-{
- char *string;
- struct line_record *continuation;
-};
-typedef struct line_record *line_list;
-
-struct header_record
-{
- line_list text;
- struct header_record *next;
- struct header_record *previous;
-};
-typedef struct header_record *header;
-
-struct stream_record
-{
- FILE *handle;
- int (*action)(FILE *);
- struct stream_record *rest_streams;
-};
-typedef struct stream_record *stream_list;
-
-/* A `struct linebuffer' is a structure which holds a line of text.
- * `readline' reads a line from a stream into a linebuffer
- * and works regardless of the length of the line.
- */
-
-struct linebuffer
-{
- long size;
- char *buffer;
-};
-
-struct linebuffer lb;
-
-#define new_list() \
- ((line_list) xmalloc (sizeof (struct line_record)))
-#define new_header() \
- ((header) xmalloc (sizeof (struct header_record)))
-#define new_stream() \
- ((stream_list) xmalloc (sizeof (struct stream_record)))
-#define alloc_string(nchars) \
- ((char *) xmalloc ((nchars) + 1))
-
-/* Global declarations */
-
-#define BUFLEN 1024
-#define KEYWORD_SIZE 256
-#define FROM_PREFIX "From"
-#define MY_NAME "fakemail"
-#define NIL ((line_list) NULL)
-#define INITIAL_LINE_SIZE 200
-
-#ifndef MAIL_PROGRAM_NAME
-#define MAIL_PROGRAM_NAME "/bin/mail"
-#endif
-
-static const char *my_name;
-static char *the_date;
-static char *the_user;
-static line_list file_preface;
-static stream_list the_streams;
-static boolean no_problems = true;
-
-static void fatal (const char *s1) NO_RETURN;
-
-#ifdef CURRENT_USER
-static struct passwd *my_entry;
-#define cuserid(s) \
-(my_entry = getpwuid (((int) geteuid ())), \
- my_entry->pw_name)
-#endif
-
-/* Utilities */
-
-/* Print error message. `s1' is printf control string, `s2' is arg for it. */
-
-static void
-error (const char *s1, const char *s2)
-{
- printf ("%s: ", my_name);
- printf (s1, s2);
- printf ("\n");
- no_problems = false;
-}
-
-/* Print error message and exit. */
-
-static void
-fatal (const char *s1)
-{
- error ("%s", s1);
- exit (EXIT_FAILURE);
-}
-
-/* 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");
- return result;
-}
-
-static void *
-xrealloc (void *ptr, size_t size)
-{
- void *result = realloc (ptr, size);
- if (! result)
- fatal ("virtual memory exhausted");
- return result;
-}
-
-/* Initialize a linebuffer for use */
-
-static void
-init_linebuffer (struct linebuffer *linebuffer)
-{
- linebuffer->size = INITIAL_LINE_SIZE;
- linebuffer->buffer = ((char *) xmalloc (INITIAL_LINE_SIZE));
-}
-
-/* Read a line of text from `stream' into `linebuffer'.
- Return the length of the line. */
-
-static long
-readline (struct linebuffer *linebuffer, FILE *stream)
-{
- char *buffer = linebuffer->buffer;
- char *p = linebuffer->buffer;
- char *end = p + linebuffer->size;
-
- while (true)
- {
- int c = getc (stream);
- if (p == end)
- {
- linebuffer->size *= 2;
- buffer = (char *) xrealloc (buffer, linebuffer->size);
- p = buffer + (p - linebuffer->buffer);
- end = buffer + linebuffer->size;
- linebuffer->buffer = buffer;
- }
- if (c < 0 || c == '\n')
- {
- *p = 0;
- break;
- }
- *p++ = c;
- }
-
- return p - buffer;
-}
-
-/* Extract a colon-terminated keyword from the string FIELD.
- Return that keyword as a string stored in a static buffer.
- Store the address of the rest of the string into *REST.
-
- If there is no keyword, return NULL and don't alter *REST. */
-
-static char *
-get_keyword (register char *field, char **rest)
-{
- static char keyword[KEYWORD_SIZE];
- register char *ptr;
- register int c;
-
- ptr = &keyword[0];
- c = (unsigned char) *field++;
- if (isspace (c) || c == ':')
- return ((char *) NULL);
- *ptr++ = (islower (c) ? toupper (c) : c);
- while (((c = (unsigned char) *field++) != ':') && ! isspace (c))
- *ptr++ = (islower (c) ? toupper (c) : c);
- *ptr++ = '\0';
- while (isspace (c))
- c = (unsigned char) *field++;
- if (c != ':')
- return ((char *) NULL);
- *rest = field;
- return &keyword[0];
-}
-
-/* Nonzero if the string FIELD starts with a colon-terminated keyword. */
-
-static boolean
-has_keyword (char *field)
-{
- char *ignored;
- return (get_keyword (field, &ignored) != ((char *) NULL));
-}
-
-/* Store the string FIELD, followed by any lines in THE_LIST,
- into the buffer WHERE.
- Concatenate lines, putting just a space between them.
- Delete everything contained in parentheses.
- When a recipient name contains <...>, we discard
- everything except what is inside the <...>.
-
- We don't pay attention to overflowing WHERE;
- the caller has to make it big enough. */
-
-static char *
-add_field (line_list the_list, register char *field, register char *where)
-{
- register char c;
- while (true)
- {
- char *this_recipient_where;
- int in_quotes = 0;
-
- *where++ = ' ';
- this_recipient_where = where;
-
- while ((c = *field++) != '\0')
- {
- if (c == '\\')
- *where++ = c;
- else if (c == '"')
- {
- in_quotes = ! in_quotes;
- *where++ = c;
- }
- else if (in_quotes)
- *where++ = c;
- else if (c == '(')
- {
- while (*field && *field != ')') ++field;
- if (! (*field++)) break; /* no close */
- continue;
- }
- else if (c == ',')
- {
- *where++ = ' ';
- /* When we get to the end of one recipient,
- don't discard it if the next one has <...>. */
- this_recipient_where = where;
- }
- else if (c == '<')
- /* Discard everything we got before the `<'. */
- where = this_recipient_where;
- else if (c == '>')
- /* Discard the rest of this name that follows the `>'. */
- {
- while (*field && *field != ',') ++field;
- if (! (*field++)) break; /* no comma */
- continue;
- }
- else
- *where++ = c;
- }
- if (the_list == NIL) break;
- field = the_list->string;
- the_list = the_list->continuation;
- }
- return where;
-}
-
-static line_list
-make_file_preface (void)
-{
- char *the_string, *temp;
- long idiotic_interface;
- struct tm *tm;
- long prefix_length;
- long user_length;
- long date_length;
- line_list result;
-
- prefix_length = strlen (FROM_PREFIX);
- time (&idiotic_interface);
- /* Convert to a string, checking for out-of-range time stamps.
- Don't use 'ctime', as that might dump core if the hardware clock
- is set to a bizarre value. */
- tm = localtime (&idiotic_interface);
- if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year)
- && (the_date = asctime (tm))))
- fatal ("current time is out of range");
- /* the_date has an unwanted newline at the end */
- date_length = strlen (the_date) - 1;
- the_date[date_length] = '\0';
- temp = cuserid ((char *) NULL);
- user_length = strlen (temp);
- the_user = alloc_string (user_length + 1);
- strcpy (the_user, temp);
- the_string = alloc_string (3 + prefix_length
- + user_length
- + date_length);
- temp = the_string;
- strcpy (temp, FROM_PREFIX);
- temp = &temp[prefix_length];
- *temp++ = ' ';
- strcpy (temp, the_user);
- temp = &temp[user_length];
- *temp++ = ' ';
- strcpy (temp, the_date);
- result = new_list ();
- result->string = the_string;
- result->continuation = ((line_list) NULL);
- return result;
-}
-
-static void
-write_line_list (register line_list the_list, FILE *the_stream)
-{
- for ( ;
- the_list != ((line_list) NULL) ;
- the_list = the_list->continuation)
- {
- fputs (the_list->string, the_stream);
- putc ('\n', the_stream);
- }
- return;
-}
-
-static int
-close_the_streams (void)
-{
- register stream_list rem;
- for (rem = the_streams;
- rem != ((stream_list) NULL);
- rem = rem->rest_streams)
- if (no_problems && (*rem->action) (rem->handle) != 0)
- error ("output error", NULL);
- the_streams = ((stream_list) NULL);
- return (no_problems ? EXIT_SUCCESS : EXIT_FAILURE);
-}
-
-static void
-add_a_stream (FILE *the_stream, int (*closing_action) (FILE *))
-{
- stream_list old = the_streams;
- the_streams = new_stream ();
- the_streams->handle = the_stream;
- the_streams->action = closing_action;
- the_streams->rest_streams = old;
- return;
-}
-
-static int
-my_fclose (FILE *the_file)
-{
- putc ('\n', the_file);
- fflush (the_file);
- if (ferror (the_file))
- return EOF;
- return fclose (the_file);
-}
-
-static boolean
-open_a_file (char *name)
-{
- FILE *the_stream = fopen (name, "a");
- if (the_stream != ((FILE *) NULL))
- {
- add_a_stream (the_stream, my_fclose);
- if (the_user == ((char *) NULL))
- file_preface = make_file_preface ();
- write_line_list (file_preface, the_stream);
- return true;
- }
- return false;
-}
-
-static void
-put_string (char *s)
-{
- register stream_list rem;
- for (rem = the_streams;
- rem != ((stream_list) NULL);
- rem = rem->rest_streams)
- fputs (s, rem->handle);
- return;
-}
-
-static void
-put_line (const char *string)
-{
- register stream_list rem;
- for (rem = the_streams;
- rem != ((stream_list) NULL);
- rem = rem->rest_streams)
- {
- const char *s = string;
- int column = 0;
-
- /* Divide STRING into lines. */
- while (*s != 0)
- {
- const char *breakpos;
-
- /* Find the last char that fits. */
- for (breakpos = s; *breakpos && column < 78; ++breakpos)
- {
- if (*breakpos == '\t')
- column += 8;
- else
- column++;
- }
- /* If we didn't reach end of line, break the line. */
- if (*breakpos)
- {
- /* Back up to just after the last comma that fits. */
- while (breakpos != s && breakpos[-1] != ',') --breakpos;
-
- if (breakpos == s)
- {
- /* If no comma fits, move past the first address anyway. */
- while (*breakpos != 0 && *breakpos != ',') ++breakpos;
- if (*breakpos != 0)
- /* Include the comma after it. */
- ++breakpos;
- }
- }
- /* Output that much, then break the line. */
- fwrite (s, 1, breakpos - s, rem->handle);
- column = 8;
-
- /* Skip whitespace and prepare to print more addresses. */
- s = breakpos;
- while (*s == ' ' || *s == '\t') ++s;
- if (*s != 0)
- fputs ("\n\t", rem->handle);
- }
- putc ('\n', rem->handle);
- }
- return;
-}
-
-#define mail_error error
-
-/* Handle an FCC field. FIELD is the text of the first line (after
- the header name), and THE_LIST holds the continuation lines if any.
- Call open_a_file for each file. */
-
-static void
-setup_files (register line_list the_list, register char *field)
-{
- register char *start;
- register char c;
- while (true)
- {
- while (((c = *field) != '\0')
- && (c == ' '
- || c == '\t'
- || c == ','))
- field += 1;
- if (c != '\0')
- {
- start = field;
- while (((c = *field) != '\0')
- && c != ' '
- && c != '\t'
- && c != ',')
- field += 1;
- *field = '\0';
- if (!open_a_file (start))
- mail_error ("Could not open file %s", start);
- *field = c;
- if (c != '\0') continue;
- }
- if (the_list == ((line_list) NULL))
- return;
- field = the_list->string;
- the_list = the_list->continuation;
- }
-}
-
-/* Compute the total size of all recipient names stored in THE_HEADER.
- The result says how big to make the buffer to pass to parse_header. */
-
-static int
-args_size (header the_header)
-{
- register header old = the_header;
- register line_list rem;
- register int size = 0;
- do
- {
- char *field;
- register char *keyword = get_keyword (the_header->text->string, &field);
- if ((strcmp (keyword, "TO") == 0)
- || (strcmp (keyword, "CC") == 0)
- || (strcmp (keyword, "BCC") == 0))
- {
- size += 1 + strlen (field);
- for (rem = the_header->text->continuation;
- rem != NIL;
- rem = rem->continuation)
- size += 1 + strlen (rem->string);
- }
- the_header = the_header->next;
- } while (the_header != old);
- return size;
-}
-
-/* Scan the header described by the lists THE_HEADER,
- and put all recipient names into the buffer WHERE.
- Precede each recipient name with a space.
-
- Also, if the header has any FCC fields, call setup_files for each one. */
-
-static void
-parse_header (header the_header, register char *where)
-{
- register header old = the_header;
- do
- {
- char *field;
- register char *keyword = get_keyword (the_header->text->string, &field);
- if (strcmp (keyword, "TO") == 0)
- where = add_field (the_header->text->continuation, field, where);
- else if (strcmp (keyword, "CC") == 0)
- where = add_field (the_header->text->continuation, field, where);
- else if (strcmp (keyword, "BCC") == 0)
- {
- where = add_field (the_header->text->continuation, field, where);
- the_header->previous->next = the_header->next;
- the_header->next->previous = the_header->previous;
- }
- else if (strcmp (keyword, "FCC") == 0)
- setup_files (the_header->text->continuation, field);
- the_header = the_header->next;
- } while (the_header != old);
- *where = '\0';
- return;
-}
-
-/* Read lines from the input until we get a blank line.
- Create a list of `header' objects, one for each header field,
- each of which points to a list of `line_list' objects,
- one for each line in that field.
- Continuation lines are grouped in the headers they continue. */
-
-static header
-read_header (void)
-{
- register header the_header = ((header) NULL);
- register line_list *next_line = ((line_list *) NULL);
-
- init_linebuffer (&lb);
-
- do
- {
- long length;
- register char *line;
-
- readline (&lb, stdin);
- line = lb.buffer;
- length = strlen (line);
- if (length == 0) break;
-
- if (has_keyword (line))
- {
- register header old = the_header;
- the_header = new_header ();
- if (old == ((header) NULL))
- {
- the_header->next = the_header;
- the_header->previous = the_header;
- }
- else
- {
- the_header->previous = old;
- the_header->next = old->next;
- old->next = the_header;
- }
- next_line = &(the_header->text);
- }
-
- if (next_line == ((line_list *) NULL))
- {
- /* Not a valid header */
- exit (EXIT_FAILURE);
- }
- *next_line = new_list ();
- (*next_line)->string = alloc_string (length);
- strcpy (((*next_line)->string), line);
- next_line = &((*next_line)->continuation);
- *next_line = NIL;
-
- } while (true);
-
- if (! the_header)
- fatal ("input message has no header");
- return the_header->next;
-}
-
-static void
-write_header (header the_header)
-{
- register header old = the_header;
- do
- {
- register line_list the_list;
- for (the_list = the_header->text;
- the_list != NIL;
- the_list = the_list->continuation)
- put_line (the_list->string);
- the_header = the_header->next;
- } while (the_header != old);
- put_line ("");
- return;
-}
-
-int
-main (int argc, char **argv)
-{
- char *command_line;
- header the_header;
- long name_length;
- const char *mail_program_name;
- char buf[BUFLEN + 1];
- register int size;
- FILE *the_pipe;
-
- mail_program_name = getenv ("FAKEMAILER");
- if (!(mail_program_name && *mail_program_name))
- mail_program_name = MAIL_PROGRAM_NAME;
- name_length = strlen (mail_program_name);
-
- my_name = MY_NAME;
- the_streams = ((stream_list) NULL);
- the_date = ((char *) NULL);
- the_user = ((char *) NULL);
-
- the_header = read_header ();
- command_line = alloc_string (name_length + args_size (the_header));
- strcpy (command_line, mail_program_name);
- parse_header (the_header, &command_line[name_length]);
-
- the_pipe = popen (command_line, "w");
- if (the_pipe == ((FILE *) NULL))
- fatal ("cannot open pipe to real mailer");
-
- add_a_stream (the_pipe, pclose);
-
- write_header (the_header);
-
- /* Dump the message itself */
-
- while (!feof (stdin))
- {
- size = fread (buf, 1, BUFLEN, stdin);
- buf[size] = '\0';
- put_string (buf);
- }
-
- if (no_problems && (ferror (stdin) || fclose (stdin) != 0))
- error ("input error", NULL);
-
- exit (close_the_streams ());
-}
-
-#endif /* not MSDOS */
-#endif /* not BSD 4.2 (or newer) */
-
-
-/* fakemail.c ends here */
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 9b804684a12..ba54202954b 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -291,7 +291,7 @@ struct rcsoc_state
/* Output CH to the file or buffer in STATE. Any pending newlines or
spaces are output first. */
-static INLINE void
+static inline void
put_char (int ch, struct rcsoc_state *state)
{
int out_ch;
diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in
index 38d453d5259..07f6170afe4 100644
--- a/lib-src/makefile.w32-in
+++ b/lib-src/makefile.w32-in
@@ -31,8 +31,6 @@ $(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)/fakemail.exe: $(BLD)/fakemail.$(O) $(BLD)/ntlib.$(O)
- $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/fakemail.$(O) $(BLD)/ntlib.$(O) $(LIBS)
$(BLD)/test-distrib.exe: $(BLD)/test-distrib.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/test-distrib.$(O) $(LIBS)
@@ -42,7 +40,6 @@ etags: stamp_BLD $(BLD)/etags.exe
ebrowse: stamp_BLD $(BLD)/ebrowse.exe
hexl: stamp_BLD $(BLD)/hexl.exe
movemail: stamp_BLD $(BLD)/movemail.exe
-fakemail: stamp_BLD $(BLD)/fakemail.exe
emacsclient: stamp_BLD $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe
test-distrib: stamp_BLD $(BLD)/test-distrib.exe
@@ -272,11 +269,6 @@ lisp2 = \
$(lispsource)window.elc \
$(lispsource)version.el
-# Used by batch-update-autoloads.
-echolisp:
- @echo $(lisp1)
- @echo $(lisp2)
-
# 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
# Emacs is rebuilt.
@@ -333,7 +325,6 @@ clean:
- $(DEL) ctags.c
- $(DEL_TREE) $(OBJDIR)
- $(DEL) stamp_BLD
- - $(DEL) echolisp.tmp
distclean: cleanall
- $(DEL) TAGS
@@ -406,14 +397,6 @@ $(BLD)/etags.$(O) : \
$(SRC)/ntlib.h \
$(EMACS_ROOT)/lib/getopt.h
-$(BLD)/fakemail.$(O) : \
- $(SRC)/fakemail.c \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(EMACS_ROOT)/nt/inc/pwd.h
-
$(BLD)/getdate.$(O) : \
$(SRC)/getdate.c \
$(EMACS_ROOT)/src/s/ms-w32.h \
@@ -483,7 +466,7 @@ $(BLD)/timer.$(O) : \
# The following dependencies are for supporting parallel builds, where
# we must make sure $(BLD) exists before any compilation starts.
#
-$(BLD)/make-docfile.$(O) $(BLD)/hexl.$(O) $(BLD)/fakemail.$(O): stamp_BLD
+$(BLD)/make-docfile.$(O) $(BLD)/hexl.$(O): stamp_BLD
$(BLD)/test-distrib.$(O) $(MOVEMAILOBJS): stamp_BLD
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index 4cf97cbac18..e8c09f090f3 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -168,8 +168,9 @@ main (int argc, char **argv)
#ifndef MAIL_USE_SYSTEM_LOCK
struct stat st;
int tem;
- char *lockname, *p;
+ char *lockname;
char *tempname;
+ size_t inname_dirlen;
int desc;
#endif /* not MAIL_USE_SYSTEM_LOCK */
@@ -298,26 +299,38 @@ main (int argc, char **argv)
to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */
lockname = concat (inname, ".lock", "");
- tempname = (char *) xmalloc (strlen (inname) + strlen ("EXXXXXX") + 1);
- strcpy (tempname, inname);
- p = tempname + strlen (tempname);
- while (p != tempname && !IS_DIRECTORY_SEP (p[-1]))
- p--;
- *p = 0;
- strcpy (p, "EXXXXXX");
- mktemp (tempname);
- unlink (tempname);
+ for (inname_dirlen = strlen (inname);
+ inname_dirlen && !IS_DIRECTORY_SEP (inname[inname_dirlen - 1]);
+ inname_dirlen--)
+ continue;
+ tempname = (char *) xmalloc (inname_dirlen + sizeof "EXXXXXX");
while (1)
{
/* Create the lock file, but not under the lock file name. */
/* Give up if cannot do that. */
- desc = open (tempname, O_WRONLY | O_CREAT | O_EXCL, 0666);
+
+ memcpy (tempname, inname, inname_dirlen);
+ strcpy (tempname + inname_dirlen, "EXXXXXX");
+#ifdef HAVE_MKSTEMP
+ desc = mkstemp (tempname);
+#else
+ mktemp (tempname);
+ if (!*tempname)
+ desc = -1;
+ else
+ {
+ unlink (tempname);
+ desc = open (tempname, O_WRONLY | O_CREAT | O_EXCL, 0600);
+ }
+#endif
if (desc < 0)
{
+ int mkstemp_errno = errno;
char *message = (char *) xmalloc (strlen (tempname) + 50);
sprintf (message, "creating %s, which would become the lock file",
tempname);
+ errno = mkstemp_errno;
pfatal_with_name (message);
}
close (desc);
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c
index e95e2ce259d..76483c371ff 100644
--- a/lib-src/update-game-score.c
+++ b/lib-src/update-game-score.c
@@ -71,7 +71,7 @@ static int usage (int err) NO_RETURN;
static int
usage (int err)
{
- fprintf (stdout, "Usage: update-game-score [-m MAX ] [ -r ] game/scorefile SCORE DATA\n");
+ fprintf (stdout, "Usage: update-game-score [-m MAX] [-r] [-d DIR] game/scorefile SCORE DATA\n");
fprintf (stdout, " update-game-score -h\n");
fprintf (stdout, " -h\t\tDisplay this help.\n");
fprintf (stdout, " -m MAX\t\tLimit the maximum number of scores to MAX.\n");
@@ -113,8 +113,7 @@ static void lose_syserr (const char *msg) NO_RETURN;
#ifndef HAVE_STRERROR
#ifndef WINDOWSNT
char *
-strerror (errnum)
- int errnum;
+strerror (int errnum)
{
extern char *sys_errlist[];
extern int sys_nerr;
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
new file mode 100644
index 00000000000..5b69c6c81a8
--- /dev/null
+++ b/lib/alloca.in.h
@@ -0,0 +1,56 @@
+/* Memory allocation on the stack.
+
+ Copyright (C) 1995, 1999, 2001-2004, 2006-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, 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, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+ USA. */
+
+/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H
+ means there is a real alloca function. */
+#ifndef _GL_ALLOCA_H
+#define _GL_ALLOCA_H
+
+/* alloca (N) returns a pointer to N bytes of memory
+ allocated on the stack, which will last until the function returns.
+ Use of alloca should be avoided:
+ - inside arguments of function calls - undefined behaviour,
+ - in inline functions - the allocation may actually last until the
+ calling function returns,
+ - for huge N (say, N >= 65536) - you never know how large (or small)
+ the stack is, and when the stack cannot fulfill the memory allocation
+ request, the program just crashes.
+ */
+
+#ifndef alloca
+# ifdef __GNUC__
+# define alloca __builtin_alloca
+# elif defined _AIX
+# define alloca __alloca
+# elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+# elif defined __DECC && defined __VMS
+# define alloca __ALLOCA
+# else
+# include <stddef.h>
+# ifdef __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+# endif
+#endif
+
+#endif /* _GL_ALLOCA_H */
diff --git a/lib/allocator.h b/lib/allocator.h
index 953117da83f..b8de95c0f50 100644
--- a/lib/allocator.h
+++ b/lib/allocator.h
@@ -45,10 +45,11 @@ struct allocator
/* Call FREE to free memory, like 'free'. */
void (*free) (void *);
- /* If nonnull, call DIE if MALLOC or REALLOC fails. DIE should not
- return. DIE can be used by code that detects memory overflow
- while calculating sizes to be passed to MALLOC or REALLOC. */
- void (*die) (void);
+ /* If nonnull, call DIE (SIZE) if MALLOC (SIZE) or REALLOC (...,
+ SIZE) fails. DIE should not return. SIZE should equal SIZE_MAX
+ if size_t overflow was detected while calculating sizes to be
+ passed to MALLOC or REALLOC. */
+ void (*die) (size_t);
};
/* An allocator using the stdlib functions and a null DIE function. */
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index e2909c766d5..751578b9a58 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -39,7 +39,6 @@
#include "allocator.h"
-#if ! HAVE_READLINKAT
/* Get the symbolic link value of FILENAME and put it into BUFFER, with
size BUFFER_SIZE. This function acts like readlink but has
readlinkat's signature. */
@@ -53,7 +52,6 @@ careadlinkatcwd (int fd, char const *filename, char *buffer,
abort ();
return readlink (filename, buffer, buffer_size);
}
-#endif
/* Assuming the current directory is FD, get the symbolic link value
of FILENAME as a null-terminated string and put it into a buffer.
@@ -135,6 +133,7 @@ careadlinkat (int fd, char const *filename,
if (buf == stack_buf)
{
char *b = (char *) alloc->allocate (link_size);
+ buf_size = link_size;
if (! b)
break;
memcpy (b, buf, link_size);
@@ -158,6 +157,11 @@ careadlinkat (int fd, char const *filename,
buf_size *= 2;
else if (buf_size < buf_size_max)
buf_size = buf_size_max;
+ else if (buf_size_max < SIZE_MAX)
+ {
+ errno = ENAMETOOLONG;
+ return NULL;
+ }
else
break;
buf = (char *) alloc->allocate (buf_size);
@@ -165,7 +169,7 @@ careadlinkat (int fd, char const *filename,
while (buf);
if (alloc->die)
- alloc->die ();
+ alloc->die (buf_size);
errno = ENOMEM;
return NULL;
}
diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h
index 4f0184bbc33..6576fb2cecc 100644
--- a/lib/careadlinkat.h
+++ b/lib/careadlinkat.h
@@ -56,8 +56,7 @@ char *careadlinkat (int fd, char const *filename,
when doing a plain readlink:
Pass FD = AT_FDCWD and PREADLINKAT = careadlinkatcwd. */
#if HAVE_READLINKAT
-/* AT_FDCWD is declared in <fcntl.h>, readlinkat in <unistd.h>. */
-# define careadlinkatcwd readlinkat
+/* AT_FDCWD is declared in <fcntl.h>. */
#else
/* Define AT_FDCWD independently, so that the careadlinkat module does
not depend on the fcntl-h module. The value does not matter, since
@@ -66,8 +65,8 @@ char *careadlinkat (int fd, char const *filename,
# ifndef AT_FDCWD
# define AT_FDCWD (-3041965)
# endif
+#endif
ssize_t careadlinkatcwd (int fd, char const *filename,
char *buffer, size_t buffer_size);
-#endif
#endif /* _GL_CAREADLINKAT_H */
diff --git a/lib/dup2.c b/lib/dup2.c
new file mode 100644
index 00000000000..e00dc7b2e3c
--- /dev/null
+++ b/lib/dup2.c
@@ -0,0 +1,132 @@
+/* Duplicate an open file descriptor to a specified file descriptor.
+
+ Copyright (C) 1999, 2004-2007, 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/>. */
+
+/* written by Paul Eggert */
+
+#include <config.h>
+
+/* Specification. */
+#include <unistd.h>
+
+#include <errno.h>
+#include <fcntl.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+/* Get declarations of the Win32 API functions. */
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
+
+#if HAVE_DUP2
+
+# undef dup2
+
+int
+rpl_dup2 (int fd, int desired_fd)
+{
+ int result;
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+ /* If fd is closed, mingw hangs on dup2 (fd, fd). If fd is open,
+ dup2 (fd, fd) returns 0, but all further attempts to use fd in
+ future dup2 calls will hang. */
+ if (fd == desired_fd)
+ {
+ if ((HANDLE) _get_osfhandle (fd) == INVALID_HANDLE_VALUE)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ return fd;
+ }
+ /* Wine 1.0.1 return 0 when desired_fd is negative but not -1:
+ http://bugs.winehq.org/show_bug.cgi?id=21289 */
+ if (desired_fd < 0)
+ {
+ errno = EBADF;
+ return -1;
+ }
+# elif !defined __linux__
+ /* On Haiku, dup2 (fd, fd) mistakenly clears FD_CLOEXEC. */
+ if (fd == desired_fd)
+ return fcntl (fd, F_GETFL) == -1 ? -1 : fd;
+# endif
+ result = dup2 (fd, desired_fd);
+# ifdef __linux__
+ /* Correct a Linux return value.
+ <http://git.kernel.org/?p=linux/kernel/git/stable/linux-2.6.30.y.git;a=commitdiff;h=2b79bc4f7ebbd5af3c8b867968f9f15602d5f802>
+ */
+ if (fd == desired_fd && result == (unsigned int) -EBADF)
+ {
+ errno = EBADF;
+ result = -1;
+ }
+# endif
+ if (result == 0)
+ result = desired_fd;
+ /* Correct a cygwin 1.5.x errno value. */
+ else if (result == -1 && errno == EMFILE)
+ errno = EBADF;
+# if REPLACE_FCHDIR
+ if (fd != desired_fd && result != -1)
+ result = _gl_register_dup (fd, result);
+# endif
+ return result;
+}
+
+#else /* !HAVE_DUP2 */
+
+/* On older platforms, dup2 did not exist. */
+
+# ifndef F_DUPFD
+static int
+dupfd (int fd, int desired_fd)
+{
+ int duplicated_fd = dup (fd);
+ if (duplicated_fd < 0 || duplicated_fd == desired_fd)
+ return duplicated_fd;
+ else
+ {
+ int r = dupfd (fd, desired_fd);
+ int e = errno;
+ close (duplicated_fd);
+ errno = e;
+ return r;
+ }
+}
+# endif
+
+int
+dup2 (int fd, int desired_fd)
+{
+ int result = fcntl (fd, F_GETFL) < 0 ? -1 : fd;
+ if (result == -1 || fd == desired_fd)
+ return result;
+ close (desired_fd);
+# ifdef F_DUPFD
+ result = fcntl (fd, F_DUPFD, desired_fd);
+# if REPLACE_FCHDIR
+ if (0 <= result)
+ result = _gl_register_dup (fd, result);
+# endif
+# else
+ result = dupfd (fd, desired_fd);
+# endif
+ if (result == -1 && (errno == EMFILE || errno == EINVAL))
+ errno = EBADF;
+ return result;
+}
+#endif /* !HAVE_DUP2 */
diff --git a/lib/ftoastr.c b/lib/ftoastr.c
index ff3d87ce22d..7c99ef00f38 100644
--- a/lib/ftoastr.c
+++ b/lib/ftoastr.c
@@ -40,14 +40,15 @@
# define FLOAT_MIN LDBL_MIN
# define FLOAT_PREC_BOUND _GL_LDBL_PREC_BOUND
# define FTOASTR ldtoastr
-# define STRTOF strtold
+# if HAVE_C99_STRTOLD
+# define STRTOF strtold
+# endif
#elif LENGTH == 2
# define FLOAT double
# define FLOAT_DIG DBL_DIG
# define FLOAT_MIN DBL_MIN
# define FLOAT_PREC_BOUND _GL_DBL_PREC_BOUND
# define FTOASTR dtoastr
-# define STRTOF strtod
#else
# define LENGTH 1
# define FLOAT float
@@ -55,14 +56,15 @@
# define FLOAT_MIN FLT_MIN
# define FLOAT_PREC_BOUND _GL_FLT_PREC_BOUND
# define FTOASTR ftoastr
-# define STRTOF strtof
+# if HAVE_STRTOF
+# define STRTOF strtof
+# endif
#endif
/* On pre-C99 hosts, approximate strtof and strtold with strtod. This
may generate one or two extra digits, but that's better than not
- working at all. Assume that strtof works if strtold does. */
-#if LENGTH != 2 && ! HAVE_C99_STRTOLD
-# undef STRTOF
+ working at all. */
+#ifndef STRTOF
# define STRTOF strtod
#endif
diff --git a/lib/getopt.c b/lib/getopt.c
index c8b301363f1..7c9f7040612 100644
--- a/lib/getopt.c
+++ b/lib/getopt.c
@@ -479,23 +479,28 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
|| !strchr (optstring, argv[d->optind][1])))))
{
char *nameend;
+ unsigned int namelen;
const struct option *p;
const struct option *pfound = NULL;
+ struct option_list
+ {
+ const struct option *p;
+ struct option_list *next;
+ } *ambig_list = NULL;
int exact = 0;
- int ambig = 0;
int indfound = -1;
int option_index;
for (nameend = d->__nextchar; *nameend && *nameend != '='; nameend++)
/* Do nothing. */ ;
+ namelen = nameend - d->__nextchar;
/* Test all long options for either exact match
or abbreviated matches. */
for (p = longopts, option_index = 0; p->name; p++, option_index++)
- if (!strncmp (p->name, d->__nextchar, nameend - d->__nextchar))
+ if (!strncmp (p->name, d->__nextchar, namelen))
{
- if ((unsigned int) (nameend - d->__nextchar)
- == (unsigned int) strlen (p->name))
+ if (namelen == (unsigned int) strlen (p->name))
{
/* Exact match found. */
pfound = p;
@@ -513,35 +518,71 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
|| pfound->has_arg != p->has_arg
|| pfound->flag != p->flag
|| pfound->val != p->val)
- /* Second or later nonexact match found. */
- ambig = 1;
+ {
+ /* Second or later nonexact match found. */
+ struct option_list *newp = malloc (sizeof (*newp));
+ newp->p = p;
+ newp->next = ambig_list;
+ ambig_list = newp;
+ }
}
- if (ambig && !exact)
+ if (ambig_list != NULL && !exact)
{
if (print_errors)
{
+ struct option_list first;
+ first.p = pfound;
+ first.next = ambig_list;
+ ambig_list = &first;
+
#if defined _LIBC && defined USE_IN_LIBIO
- char *buf;
+ char *buf = NULL;
+ size_t buflen = 0;
- if (__asprintf (&buf, _("%s: option '%s' is ambiguous\n"),
- argv[0], argv[d->optind]) >= 0)
+ FILE *fp = open_memstream (&buf, &buflen);
+ if (fp != NULL)
{
- _IO_flockfile (stderr);
+ fprintf (fp,
+ _("%s: option '%s' is ambiguous; possibilities:"),
+ argv[0], argv[d->optind]);
- int old_flags2 = ((_IO_FILE *) stderr)->_flags2;
- ((_IO_FILE *) stderr)->_flags2 |= _IO_FLAGS2_NOTCANCEL;
+ do
+ {
+ fprintf (fp, " '--%s'", ambig_list->p->name);
+ ambig_list = ambig_list->next;
+ }
+ while (ambig_list != NULL);
- __fxprintf (NULL, "%s", buf);
+ fputc_unlocked ('\n', fp);
- ((_IO_FILE *) stderr)->_flags2 = old_flags2;
- _IO_funlockfile (stderr);
+ if (__builtin_expect (fclose (fp) != EOF, 1))
+ {
+ _IO_flockfile (stderr);
- free (buf);
+ int old_flags2 = ((_IO_FILE *) stderr)->_flags2;
+ ((_IO_FILE *) stderr)->_flags2 |= _IO_FLAGS2_NOTCANCEL;
+
+ __fxprintf (NULL, "%s", buf);
+
+ ((_IO_FILE *) stderr)->_flags2 = old_flags2;
+ _IO_funlockfile (stderr);
+
+ free (buf);
+ }
}
#else
- fprintf (stderr, _("%s: option '%s' is ambiguous\n"),
+ fprintf (stderr,
+ _("%s: option '%s' is ambiguous; possibilities:"),
argv[0], argv[d->optind]);
+ do
+ {
+ fprintf (stderr, " '--%s'", ambig_list->p->name);
+ ambig_list = ambig_list->next;
+ }
+ while (ambig_list != NULL);
+
+ fputc ('\n', stderr);
#endif
}
d->__nextchar += strlen (d->__nextchar);
@@ -550,6 +591,13 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
return '?';
}
+ while (ambig_list != NULL)
+ {
+ struct option_list *pn = ambig_list->next;
+ free (ambig_list);
+ ambig_list = pn;
+ }
+
if (pfound != NULL)
{
option_index = indfound;
@@ -791,6 +839,9 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
int indfound = 0;
int option_index;
+ if (longopts == NULL)
+ goto no_longs;
+
/* This is an option that requires an argument. */
if (*d->__nextchar != '\0')
{
@@ -998,8 +1049,10 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
}
return pfound->val;
}
- d->__nextchar = NULL;
- return 'W'; /* Let the application handle it. */
+
+ no_longs:
+ d->__nextchar = NULL;
+ return 'W'; /* Let the application handle it. */
}
if (temp[1] == ':')
{
diff --git a/lib/getopt.in.h b/lib/getopt.in.h
index 82e2937d6d2..0f3918ab771 100644
--- a/lib/getopt.in.h
+++ b/lib/getopt.in.h
@@ -16,7 +16,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/>. */
-#ifndef _GL_GETOPT_H
+#ifndef _@GUARD_PREFIX@_GETOPT_H
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -32,10 +32,10 @@
# undef _GL_SYSTEM_GETOPT
#endif
-#ifndef _GL_GETOPT_H
+#ifndef _@GUARD_PREFIX@_GETOPT_H
#ifndef __need_getopt
-# define _GL_GETOPT_H 1
+# define _@GUARD_PREFIX@_GETOPT_H 1
#endif
/* Standalone applications should #define __GETOPT_PREFIX to an
@@ -249,5 +249,5 @@ extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
/* Make sure we later can get all the definitions and declarations. */
#undef __need_getopt
-#endif /* getopt.h */
-#endif /* getopt.h */
+#endif /* _@GUARD_PREFIX@_GETOPT_H */
+#endif /* _@GUARD_PREFIX@_GETOPT_H */
diff --git a/lib/getopt_.h b/lib/getopt_.h
index 43acccc0bfc..e0923962b4f 100644
--- a/lib/getopt_.h
+++ b/lib/getopt_.h
@@ -279,5 +279,5 @@ extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
/* Make sure we later can get all the definitions and declarations. */
#undef __need_getopt
-#endif /* getopt.h */
-#endif /* getopt.h */
+#endif /* _GL_GETOPT_H */
+#endif /* _GL_GETOPT_H */
diff --git a/lib/gnulib.mk b/lib/gnulib.mk
index 1466e430a4c..4341a5d184d 100644
--- a/lib/gnulib.mk
+++ b/lib/gnulib.mk
@@ -9,7 +9,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=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime 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=. --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
MOSTLYCLEANFILES += core *.stackdump
@@ -21,6 +21,29 @@ libgnu_a_LIBADD = $(gl_LIBOBJS)
libgnu_a_DEPENDENCIES = $(gl_LIBOBJS)
EXTRA_libgnu_a_SOURCES =
+## begin gnulib module alloca-opt
+
+BUILT_SOURCES += $(ALLOCA_H)
+
+# We need the following in order to create <alloca.h> when the system
+# doesn't have one that works with the given compiler.
+if GL_GENERATE_ALLOCA_H
+alloca.h: alloca.in.h $(top_builddir)/config.status
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ cat $(srcdir)/alloca.in.h; \
+ } > $@-t && \
+ mv -f $@-t $@
+else
+alloca.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += alloca.h alloca.h-t
+
+EXTRA_DIST += alloca.in.h
+
+## end gnulib module alloca-opt
+
## begin gnulib module allocator
libgnu_a_SOURCES += allocator.c
@@ -87,13 +110,36 @@ EXTRA_DIST += careadlinkat.h
## begin gnulib module crypto/md5
+libgnu_a_SOURCES += md5.c
-EXTRA_DIST += md5.c md5.h
-
-EXTRA_libgnu_a_SOURCES += md5.c
+EXTRA_DIST += md5.h
## end gnulib module crypto/md5
+## begin gnulib module crypto/sha1
+
+libgnu_a_SOURCES += sha1.c
+
+EXTRA_DIST += sha1.h
+
+## end gnulib module crypto/sha1
+
+## begin gnulib module crypto/sha256
+
+libgnu_a_SOURCES += sha256.c
+
+EXTRA_DIST += sha256.h
+
+## end gnulib module crypto/sha256
+
+## begin gnulib module crypto/sha512
+
+libgnu_a_SOURCES += sha512.c
+
+EXTRA_DIST += sha512.h
+
+## end gnulib module crypto/sha512
+
## begin gnulib module dosname
if gl_GNULIB_ENABLED_dosname
@@ -113,12 +159,20 @@ EXTRA_libgnu_a_SOURCES += ftoastr.c
## end gnulib module dtoastr
-## begin gnulib module filemode
+## begin gnulib module dup2
+
+
+EXTRA_DIST += dup2.c
+
+EXTRA_libgnu_a_SOURCES += dup2.c
+
+## end gnulib module dup2
+## begin gnulib module filemode
-EXTRA_DIST += filemode.c filemode.h
+libgnu_a_SOURCES += filemode.c
-EXTRA_libgnu_a_SOURCES += filemode.c
+EXTRA_DIST += filemode.h
## end gnulib module filemode
@@ -140,7 +194,8 @@ BUILT_SOURCES += $(GETOPT_H)
getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
- sed -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_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' \
@@ -167,7 +222,8 @@ endif
## begin gnulib module ignore-value
-libgnu_a_SOURCES += ignore-value.h
+
+EXTRA_DIST += ignore-value.h
## end gnulib module ignore-value
@@ -238,6 +294,15 @@ EXTRA_libgnu_a_SOURCES += mktime.c
## end gnulib module mktime
+## begin gnulib module pthread_sigmask
+
+
+EXTRA_DIST += pthread_sigmask.c
+
+EXTRA_libgnu_a_SOURCES += pthread_sigmask.c
+
+## end gnulib module pthread_sigmask
+
## begin gnulib module readlink
@@ -247,6 +312,56 @@ EXTRA_libgnu_a_SOURCES += readlink.c
## end gnulib module readlink
+## begin gnulib module signal
+
+BUILT_SOURCES += signal.h
+
+# We need the following in order to create <signal.h> when the system
+# doesn't have a complete one.
+signal.h: signal.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_SIGNAL_H''@|$(NEXT_SIGNAL_H)|g' \
+ -e 's|@''GNULIB_PTHREAD_SIGMASK''@|$(GNULIB_PTHREAD_SIGMASK)|g' \
+ -e 's/@''GNULIB_SIGNAL_H_SIGPIPE''@/$(GNULIB_SIGNAL_H_SIGPIPE)/g' \
+ -e 's/@''GNULIB_SIGPROCMASK''@/$(GNULIB_SIGPROCMASK)/g' \
+ -e 's/@''GNULIB_SIGACTION''@/$(GNULIB_SIGACTION)/g' \
+ -e 's|@''HAVE_POSIX_SIGNALBLOCKING''@|$(HAVE_POSIX_SIGNALBLOCKING)|g' \
+ -e 's|@''HAVE_PTHREAD_SIGMASK''@|$(HAVE_PTHREAD_SIGMASK)|g' \
+ -e 's|@''HAVE_SIGSET_T''@|$(HAVE_SIGSET_T)|g' \
+ -e 's|@''HAVE_SIGINFO_T''@|$(HAVE_SIGINFO_T)|g' \
+ -e 's|@''HAVE_SIGACTION''@|$(HAVE_SIGACTION)|g' \
+ -e 's|@''HAVE_STRUCT_SIGACTION_SA_SIGACTION''@|$(HAVE_STRUCT_SIGACTION_SA_SIGACTION)|g' \
+ -e 's|@''HAVE_TYPE_VOLATILE_SIG_ATOMIC_T''@|$(HAVE_TYPE_VOLATILE_SIG_ATOMIC_T)|g' \
+ -e 's|@''HAVE_SIGHANDLER_T''@|$(HAVE_SIGHANDLER_T)|g' \
+ -e 's|@''REPLACE_PTHREAD_SIGMASK''@|$(REPLACE_PTHREAD_SIGMASK)|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)/signal.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += signal.h signal.h-t
+
+EXTRA_DIST += signal.in.h
+
+## end gnulib module signal
+
+## 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 stat
if gl_GNULIB_ENABLED_stat
@@ -268,7 +383,8 @@ if GL_GENERATE_STDARG_H
stdarg.h: stdarg.in.h $(top_builddir)/config.status
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
- sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STDARG_H''@|$(NEXT_STDARG_H)|g' \
@@ -318,7 +434,8 @@ if GL_GENERATE_STDDEF_H
stddef.h: stddef.in.h $(top_builddir)/config.status
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
- sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \
@@ -347,7 +464,8 @@ if GL_GENERATE_STDINT_H
stdint.h: stdint.in.h $(top_builddir)/config.status
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
- sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_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' \
@@ -395,62 +513,63 @@ BUILT_SOURCES += stdio.h
stdio.h: stdio.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|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STDIO_H''@|$(NEXT_STDIO_H)|g' \
- -e 's|@''GNULIB_DPRINTF''@|$(GNULIB_DPRINTF)|g' \
- -e 's|@''GNULIB_FCLOSE''@|$(GNULIB_FCLOSE)|g' \
- -e 's|@''GNULIB_FFLUSH''@|$(GNULIB_FFLUSH)|g' \
- -e 's|@''GNULIB_FGETC''@|$(GNULIB_FGETC)|g' \
- -e 's|@''GNULIB_FGETS''@|$(GNULIB_FGETS)|g' \
- -e 's|@''GNULIB_FOPEN''@|$(GNULIB_FOPEN)|g' \
- -e 's|@''GNULIB_FPRINTF''@|$(GNULIB_FPRINTF)|g' \
- -e 's|@''GNULIB_FPRINTF_POSIX''@|$(GNULIB_FPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_FPURGE''@|$(GNULIB_FPURGE)|g' \
- -e 's|@''GNULIB_FPUTC''@|$(GNULIB_FPUTC)|g' \
- -e 's|@''GNULIB_FPUTS''@|$(GNULIB_FPUTS)|g' \
- -e 's|@''GNULIB_FREAD''@|$(GNULIB_FREAD)|g' \
- -e 's|@''GNULIB_FREOPEN''@|$(GNULIB_FREOPEN)|g' \
- -e 's|@''GNULIB_FSCANF''@|$(GNULIB_FSCANF)|g' \
- -e 's|@''GNULIB_FSEEK''@|$(GNULIB_FSEEK)|g' \
- -e 's|@''GNULIB_FSEEKO''@|$(GNULIB_FSEEKO)|g' \
- -e 's|@''GNULIB_FTELL''@|$(GNULIB_FTELL)|g' \
- -e 's|@''GNULIB_FTELLO''@|$(GNULIB_FTELLO)|g' \
- -e 's|@''GNULIB_FWRITE''@|$(GNULIB_FWRITE)|g' \
- -e 's|@''GNULIB_GETC''@|$(GNULIB_GETC)|g' \
- -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_PERROR''@|$(GNULIB_PERROR)|g' \
- -e 's|@''GNULIB_POPEN''@|$(GNULIB_POPEN)|g' \
- -e 's|@''GNULIB_PRINTF''@|$(GNULIB_PRINTF)|g' \
- -e 's|@''GNULIB_PRINTF_POSIX''@|$(GNULIB_PRINTF_POSIX)|g' \
- -e 's|@''GNULIB_PUTC''@|$(GNULIB_PUTC)|g' \
- -e 's|@''GNULIB_PUTCHAR''@|$(GNULIB_PUTCHAR)|g' \
- -e 's|@''GNULIB_PUTS''@|$(GNULIB_PUTS)|g' \
- -e 's|@''GNULIB_REMOVE''@|$(GNULIB_REMOVE)|g' \
- -e 's|@''GNULIB_RENAME''@|$(GNULIB_RENAME)|g' \
- -e 's|@''GNULIB_RENAMEAT''@|$(GNULIB_RENAMEAT)|g' \
- -e 's|@''GNULIB_SCANF''@|$(GNULIB_SCANF)|g' \
- -e 's|@''GNULIB_SNPRINTF''@|$(GNULIB_SNPRINTF)|g' \
- -e 's|@''GNULIB_SPRINTF_POSIX''@|$(GNULIB_SPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_STDIO_H_NONBLOCKING''@|$(GNULIB_STDIO_H_NONBLOCKING)|g' \
- -e 's|@''GNULIB_STDIO_H_SIGPIPE''@|$(GNULIB_STDIO_H_SIGPIPE)|g' \
- -e 's|@''GNULIB_TMPFILE''@|$(GNULIB_TMPFILE)|g' \
- -e 's|@''GNULIB_VASPRINTF''@|$(GNULIB_VASPRINTF)|g' \
- -e 's|@''GNULIB_VDPRINTF''@|$(GNULIB_VDPRINTF)|g' \
- -e 's|@''GNULIB_VFPRINTF''@|$(GNULIB_VFPRINTF)|g' \
- -e 's|@''GNULIB_VFPRINTF_POSIX''@|$(GNULIB_VFPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_VFSCANF''@|$(GNULIB_VFSCANF)|g' \
- -e 's|@''GNULIB_VSCANF''@|$(GNULIB_VSCANF)|g' \
- -e 's|@''GNULIB_VPRINTF''@|$(GNULIB_VPRINTF)|g' \
- -e 's|@''GNULIB_VPRINTF_POSIX''@|$(GNULIB_VPRINTF_POSIX)|g' \
- -e 's|@''GNULIB_VSNPRINTF''@|$(GNULIB_VSNPRINTF)|g' \
- -e 's|@''GNULIB_VSPRINTF_POSIX''@|$(GNULIB_VSPRINTF_POSIX)|g' \
+ -e 's/@''GNULIB_DPRINTF''@/$(GNULIB_DPRINTF)/g' \
+ -e 's/@''GNULIB_FCLOSE''@/$(GNULIB_FCLOSE)/g' \
+ -e 's/@''GNULIB_FFLUSH''@/$(GNULIB_FFLUSH)/g' \
+ -e 's/@''GNULIB_FGETC''@/$(GNULIB_FGETC)/g' \
+ -e 's/@''GNULIB_FGETS''@/$(GNULIB_FGETS)/g' \
+ -e 's/@''GNULIB_FOPEN''@/$(GNULIB_FOPEN)/g' \
+ -e 's/@''GNULIB_FPRINTF''@/$(GNULIB_FPRINTF)/g' \
+ -e 's/@''GNULIB_FPRINTF_POSIX''@/$(GNULIB_FPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_FPURGE''@/$(GNULIB_FPURGE)/g' \
+ -e 's/@''GNULIB_FPUTC''@/$(GNULIB_FPUTC)/g' \
+ -e 's/@''GNULIB_FPUTS''@/$(GNULIB_FPUTS)/g' \
+ -e 's/@''GNULIB_FREAD''@/$(GNULIB_FREAD)/g' \
+ -e 's/@''GNULIB_FREOPEN''@/$(GNULIB_FREOPEN)/g' \
+ -e 's/@''GNULIB_FSCANF''@/$(GNULIB_FSCANF)/g' \
+ -e 's/@''GNULIB_FSEEK''@/$(GNULIB_FSEEK)/g' \
+ -e 's/@''GNULIB_FSEEKO''@/$(GNULIB_FSEEKO)/g' \
+ -e 's/@''GNULIB_FTELL''@/$(GNULIB_FTELL)/g' \
+ -e 's/@''GNULIB_FTELLO''@/$(GNULIB_FTELLO)/g' \
+ -e 's/@''GNULIB_FWRITE''@/$(GNULIB_FWRITE)/g' \
+ -e 's/@''GNULIB_GETC''@/$(GNULIB_GETC)/g' \
+ -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_PERROR''@/$(GNULIB_PERROR)/g' \
+ -e 's/@''GNULIB_POPEN''@/$(GNULIB_POPEN)/g' \
+ -e 's/@''GNULIB_PRINTF''@/$(GNULIB_PRINTF)/g' \
+ -e 's/@''GNULIB_PRINTF_POSIX''@/$(GNULIB_PRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_PUTC''@/$(GNULIB_PUTC)/g' \
+ -e 's/@''GNULIB_PUTCHAR''@/$(GNULIB_PUTCHAR)/g' \
+ -e 's/@''GNULIB_PUTS''@/$(GNULIB_PUTS)/g' \
+ -e 's/@''GNULIB_REMOVE''@/$(GNULIB_REMOVE)/g' \
+ -e 's/@''GNULIB_RENAME''@/$(GNULIB_RENAME)/g' \
+ -e 's/@''GNULIB_RENAMEAT''@/$(GNULIB_RENAMEAT)/g' \
+ -e 's/@''GNULIB_SCANF''@/$(GNULIB_SCANF)/g' \
+ -e 's/@''GNULIB_SNPRINTF''@/$(GNULIB_SNPRINTF)/g' \
+ -e 's/@''GNULIB_SPRINTF_POSIX''@/$(GNULIB_SPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_STDIO_H_NONBLOCKING''@/$(GNULIB_STDIO_H_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_STDIO_H_SIGPIPE''@/$(GNULIB_STDIO_H_SIGPIPE)/g' \
+ -e 's/@''GNULIB_TMPFILE''@/$(GNULIB_TMPFILE)/g' \
+ -e 's/@''GNULIB_VASPRINTF''@/$(GNULIB_VASPRINTF)/g' \
+ -e 's/@''GNULIB_VDPRINTF''@/$(GNULIB_VDPRINTF)/g' \
+ -e 's/@''GNULIB_VFPRINTF''@/$(GNULIB_VFPRINTF)/g' \
+ -e 's/@''GNULIB_VFPRINTF_POSIX''@/$(GNULIB_VFPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_VFSCANF''@/$(GNULIB_VFSCANF)/g' \
+ -e 's/@''GNULIB_VSCANF''@/$(GNULIB_VSCANF)/g' \
+ -e 's/@''GNULIB_VPRINTF''@/$(GNULIB_VPRINTF)/g' \
+ -e 's/@''GNULIB_VPRINTF_POSIX''@/$(GNULIB_VPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_VSNPRINTF''@/$(GNULIB_VSNPRINTF)/g' \
+ -e 's/@''GNULIB_VSPRINTF_POSIX''@/$(GNULIB_VSPRINTF_POSIX)/g' \
< $(srcdir)/stdio.in.h | \
sed -e 's|@''HAVE_DECL_FPURGE''@|$(HAVE_DECL_FPURGE)|g' \
-e 's|@''HAVE_DECL_FSEEKO''@|$(HAVE_DECL_FSEEKO)|g' \
@@ -518,38 +637,39 @@ BUILT_SOURCES += stdlib.h
stdlib.h: stdlib.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|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \
- -e 's|@''GNULIB__EXIT''@|$(GNULIB__EXIT)|g' \
- -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \
- -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \
- -e 's|@''GNULIB_CANONICALIZE_FILE_NAME''@|$(GNULIB_CANONICALIZE_FILE_NAME)|g' \
- -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \
- -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \
- -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \
- -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \
- -e 's|@''GNULIB_MBTOWC''@|$(GNULIB_MBTOWC)|g' \
- -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \
- -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \
- -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \
- -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \
- -e 's|@''GNULIB_MKSTEMPS''@|$(GNULIB_MKSTEMPS)|g' \
- -e 's|@''GNULIB_PTSNAME''@|$(GNULIB_PTSNAME)|g' \
- -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|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' \
- -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \
- -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \
- -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \
- -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \
- -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \
- -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \
- -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \
- -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \
- -e 's|@''GNULIB_WCTOMB''@|$(GNULIB_WCTOMB)|g' \
+ -e 's/@''GNULIB__EXIT''@/$(GNULIB__EXIT)/g' \
+ -e 's/@''GNULIB_ATOLL''@/$(GNULIB_ATOLL)/g' \
+ -e 's/@''GNULIB_CALLOC_POSIX''@/$(GNULIB_CALLOC_POSIX)/g' \
+ -e 's/@''GNULIB_CANONICALIZE_FILE_NAME''@/$(GNULIB_CANONICALIZE_FILE_NAME)/g' \
+ -e 's/@''GNULIB_GETLOADAVG''@/$(GNULIB_GETLOADAVG)/g' \
+ -e 's/@''GNULIB_GETSUBOPT''@/$(GNULIB_GETSUBOPT)/g' \
+ -e 's/@''GNULIB_GRANTPT''@/$(GNULIB_GRANTPT)/g' \
+ -e 's/@''GNULIB_MALLOC_POSIX''@/$(GNULIB_MALLOC_POSIX)/g' \
+ -e 's/@''GNULIB_MBTOWC''@/$(GNULIB_MBTOWC)/g' \
+ -e 's/@''GNULIB_MKDTEMP''@/$(GNULIB_MKDTEMP)/g' \
+ -e 's/@''GNULIB_MKOSTEMP''@/$(GNULIB_MKOSTEMP)/g' \
+ -e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
+ -e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
+ -e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
+ -e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/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' \
+ -e 's/@''GNULIB_RPMATCH''@/$(GNULIB_RPMATCH)/g' \
+ -e 's/@''GNULIB_SETENV''@/$(GNULIB_SETENV)/g' \
+ -e 's/@''GNULIB_STRTOD''@/$(GNULIB_STRTOD)/g' \
+ -e 's/@''GNULIB_STRTOLL''@/$(GNULIB_STRTOLL)/g' \
+ -e 's/@''GNULIB_STRTOULL''@/$(GNULIB_STRTOULL)/g' \
+ -e 's/@''GNULIB_SYSTEM_POSIX''@/$(GNULIB_SYSTEM_POSIX)/g' \
+ -e 's/@''GNULIB_UNLOCKPT''@/$(GNULIB_UNLOCKPT)/g' \
+ -e 's/@''GNULIB_UNSETENV''@/$(GNULIB_UNSETENV)/g' \
+ -e 's/@''GNULIB_WCTOMB''@/$(GNULIB_WCTOMB)/g' \
< $(srcdir)/stdlib.in.h | \
sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \
-e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \
@@ -600,13 +720,32 @@ EXTRA_DIST += stdlib.in.h
## begin gnulib module strftime
+libgnu_a_SOURCES += strftime.c
-EXTRA_DIST += strftime.c strftime.h
-
-EXTRA_libgnu_a_SOURCES += strftime.c
+EXTRA_DIST += strftime.h
## end gnulib module strftime
+## begin gnulib module strtoimax
+
+
+EXTRA_DIST += strtoimax.c
+
+EXTRA_libgnu_a_SOURCES += strtoimax.c
+
+## end gnulib module strtoimax
+
+## begin gnulib module strtoll
+
+if gl_GNULIB_ENABLED_strtoll
+
+endif
+EXTRA_DIST += strtol.c strtoll.c
+
+EXTRA_libgnu_a_SOURCES += strtol.c strtoll.c
+
+## end gnulib module strtoll
+
## begin gnulib module strtoull
if gl_GNULIB_ENABLED_strtoull
@@ -646,22 +785,23 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
$(AM_V_at)$(MKDIR_P) sys
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
- sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \
- -e 's|@''GNULIB_FCHMODAT''@|$(GNULIB_FCHMODAT)|g' \
- -e 's|@''GNULIB_FSTATAT''@|$(GNULIB_FSTATAT)|g' \
- -e 's|@''GNULIB_FUTIMENS''@|$(GNULIB_FUTIMENS)|g' \
- -e 's|@''GNULIB_LCHMOD''@|$(GNULIB_LCHMOD)|g' \
- -e 's|@''GNULIB_LSTAT''@|$(GNULIB_LSTAT)|g' \
- -e 's|@''GNULIB_MKDIRAT''@|$(GNULIB_MKDIRAT)|g' \
- -e 's|@''GNULIB_MKFIFO''@|$(GNULIB_MKFIFO)|g' \
- -e 's|@''GNULIB_MKFIFOAT''@|$(GNULIB_MKFIFOAT)|g' \
- -e 's|@''GNULIB_MKNOD''@|$(GNULIB_MKNOD)|g' \
- -e 's|@''GNULIB_MKNODAT''@|$(GNULIB_MKNODAT)|g' \
- -e 's|@''GNULIB_STAT''@|$(GNULIB_STAT)|g' \
- -e 's|@''GNULIB_UTIMENSAT''@|$(GNULIB_UTIMENSAT)|g' \
+ -e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \
+ -e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
+ -e 's/@''GNULIB_FUTIMENS''@/$(GNULIB_FUTIMENS)/g' \
+ -e 's/@''GNULIB_LCHMOD''@/$(GNULIB_LCHMOD)/g' \
+ -e 's/@''GNULIB_LSTAT''@/$(GNULIB_LSTAT)/g' \
+ -e 's/@''GNULIB_MKDIRAT''@/$(GNULIB_MKDIRAT)/g' \
+ -e 's/@''GNULIB_MKFIFO''@/$(GNULIB_MKFIFO)/g' \
+ -e 's/@''GNULIB_MKFIFOAT''@/$(GNULIB_MKFIFOAT)/g' \
+ -e 's/@''GNULIB_MKNOD''@/$(GNULIB_MKNOD)/g' \
+ -e 's/@''GNULIB_MKNODAT''@/$(GNULIB_MKNODAT)/g' \
+ -e 's/@''GNULIB_STAT''@/$(GNULIB_STAT)/g' \
+ -e 's/@''GNULIB_UTIMENSAT''@/$(GNULIB_UTIMENSAT)/g' \
-e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \
-e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \
-e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \
@@ -704,15 +844,16 @@ BUILT_SOURCES += time.h
time.h: time.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|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ 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_TIME_H''@|$(NEXT_TIME_H)|g' \
- -e 's|@''GNULIB_MKTIME''@|$(GNULIB_MKTIME)|g' \
- -e 's|@''GNULIB_NANOSLEEP''@|$(GNULIB_NANOSLEEP)|g' \
- -e 's|@''GNULIB_STRPTIME''@|$(GNULIB_STRPTIME)|g' \
- -e 's|@''GNULIB_TIMEGM''@|$(GNULIB_TIMEGM)|g' \
- -e 's|@''GNULIB_TIME_R''@|$(GNULIB_TIME_R)|g' \
+ -e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \
+ -e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \
+ -e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \
+ -e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \
+ -e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \
-e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \
-e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
@@ -745,6 +886,13 @@ EXTRA_libgnu_a_SOURCES += time_r.c
## end gnulib module time_r
+## begin gnulib module u64
+
+
+EXTRA_DIST += u64.h
+
+## end gnulib module u64
+
## begin gnulib module unistd
BUILT_SOURCES += unistd.h
@@ -754,54 +902,56 @@ BUILT_SOURCES += unistd.h
unistd.h: unistd.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|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_H)|g' \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_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_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \
- -e 's|@''GNULIB_CHOWN''@|$(GNULIB_CHOWN)|g' \
- -e 's|@''GNULIB_CLOSE''@|$(GNULIB_CLOSE)|g' \
- -e 's|@''GNULIB_DUP2''@|$(GNULIB_DUP2)|g' \
- -e 's|@''GNULIB_DUP3''@|$(GNULIB_DUP3)|g' \
- -e 's|@''GNULIB_ENVIRON''@|$(GNULIB_ENVIRON)|g' \
- -e 's|@''GNULIB_EUIDACCESS''@|$(GNULIB_EUIDACCESS)|g' \
- -e 's|@''GNULIB_FACCESSAT''@|$(GNULIB_FACCESSAT)|g' \
- -e 's|@''GNULIB_FCHDIR''@|$(GNULIB_FCHDIR)|g' \
- -e 's|@''GNULIB_FCHOWNAT''@|$(GNULIB_FCHOWNAT)|g' \
- -e 's|@''GNULIB_FSYNC''@|$(GNULIB_FSYNC)|g' \
- -e 's|@''GNULIB_FTRUNCATE''@|$(GNULIB_FTRUNCATE)|g' \
- -e 's|@''GNULIB_GETCWD''@|$(GNULIB_GETCWD)|g' \
- -e 's|@''GNULIB_GETDOMAINNAME''@|$(GNULIB_GETDOMAINNAME)|g' \
- -e 's|@''GNULIB_GETDTABLESIZE''@|$(GNULIB_GETDTABLESIZE)|g' \
- -e 's|@''GNULIB_GETGROUPS''@|$(GNULIB_GETGROUPS)|g' \
- -e 's|@''GNULIB_GETHOSTNAME''@|$(GNULIB_GETHOSTNAME)|g' \
- -e 's|@''GNULIB_GETLOGIN''@|$(GNULIB_GETLOGIN)|g' \
- -e 's|@''GNULIB_GETLOGIN_R''@|$(GNULIB_GETLOGIN_R)|g' \
- -e 's|@''GNULIB_GETPAGESIZE''@|$(GNULIB_GETPAGESIZE)|g' \
- -e 's|@''GNULIB_GETUSERSHELL''@|$(GNULIB_GETUSERSHELL)|g' \
- -e 's|@''GNULIB_LCHOWN''@|$(GNULIB_LCHOWN)|g' \
- -e 's|@''GNULIB_LINK''@|$(GNULIB_LINK)|g' \
- -e 's|@''GNULIB_LINKAT''@|$(GNULIB_LINKAT)|g' \
- -e 's|@''GNULIB_LSEEK''@|$(GNULIB_LSEEK)|g' \
- -e 's|@''GNULIB_PIPE''@|$(GNULIB_PIPE)|g' \
- -e 's|@''GNULIB_PIPE2''@|$(GNULIB_PIPE2)|g' \
- -e 's|@''GNULIB_PREAD''@|$(GNULIB_PREAD)|g' \
- -e 's|@''GNULIB_PWRITE''@|$(GNULIB_PWRITE)|g' \
- -e 's|@''GNULIB_READ''@|$(GNULIB_READ)|g' \
- -e 's|@''GNULIB_READLINK''@|$(GNULIB_READLINK)|g' \
- -e 's|@''GNULIB_READLINKAT''@|$(GNULIB_READLINKAT)|g' \
- -e 's|@''GNULIB_RMDIR''@|$(GNULIB_RMDIR)|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_NONBLOCKING''@|$(GNULIB_UNISTD_H_NONBLOCKING)|g' \
- -e 's|@''GNULIB_UNISTD_H_SIGPIPE''@|$(GNULIB_UNISTD_H_SIGPIPE)|g' \
- -e 's|@''GNULIB_UNLINK''@|$(GNULIB_UNLINK)|g' \
- -e 's|@''GNULIB_UNLINKAT''@|$(GNULIB_UNLINKAT)|g' \
- -e 's|@''GNULIB_USLEEP''@|$(GNULIB_USLEEP)|g' \
- -e 's|@''GNULIB_WRITE''@|$(GNULIB_WRITE)|g' \
+ -e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \
+ -e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \
+ -e 's/@''GNULIB_DUP2''@/$(GNULIB_DUP2)/g' \
+ -e 's/@''GNULIB_DUP3''@/$(GNULIB_DUP3)/g' \
+ -e 's/@''GNULIB_ENVIRON''@/$(GNULIB_ENVIRON)/g' \
+ -e 's/@''GNULIB_EUIDACCESS''@/$(GNULIB_EUIDACCESS)/g' \
+ -e 's/@''GNULIB_FACCESSAT''@/$(GNULIB_FACCESSAT)/g' \
+ -e 's/@''GNULIB_FCHDIR''@/$(GNULIB_FCHDIR)/g' \
+ -e 's/@''GNULIB_FCHOWNAT''@/$(GNULIB_FCHOWNAT)/g' \
+ -e 's/@''GNULIB_FSYNC''@/$(GNULIB_FSYNC)/g' \
+ -e 's/@''GNULIB_FTRUNCATE''@/$(GNULIB_FTRUNCATE)/g' \
+ -e 's/@''GNULIB_GETCWD''@/$(GNULIB_GETCWD)/g' \
+ -e 's/@''GNULIB_GETDOMAINNAME''@/$(GNULIB_GETDOMAINNAME)/g' \
+ -e 's/@''GNULIB_GETDTABLESIZE''@/$(GNULIB_GETDTABLESIZE)/g' \
+ -e 's/@''GNULIB_GETGROUPS''@/$(GNULIB_GETGROUPS)/g' \
+ -e 's/@''GNULIB_GETHOSTNAME''@/$(GNULIB_GETHOSTNAME)/g' \
+ -e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \
+ -e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \
+ -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_LCHOWN''@/$(GNULIB_LCHOWN)/g' \
+ -e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \
+ -e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \
+ -e 's/@''GNULIB_LSEEK''@/$(GNULIB_LSEEK)/g' \
+ -e 's/@''GNULIB_PIPE''@/$(GNULIB_PIPE)/g' \
+ -e 's/@''GNULIB_PIPE2''@/$(GNULIB_PIPE2)/g' \
+ -e 's/@''GNULIB_PREAD''@/$(GNULIB_PREAD)/g' \
+ -e 's/@''GNULIB_PWRITE''@/$(GNULIB_PWRITE)/g' \
+ -e 's/@''GNULIB_READ''@/$(GNULIB_READ)/g' \
+ -e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \
+ -e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \
+ -e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/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_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \
+ -e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \
+ -e 's/@''GNULIB_UNLINKAT''@/$(GNULIB_UNLINKAT)/g' \
+ -e 's/@''GNULIB_USLEEP''@/$(GNULIB_USLEEP)/g' \
+ -e 's/@''GNULIB_WRITE''@/$(GNULIB_WRITE)/g' \
< $(srcdir)/unistd.in.h | \
sed -e 's|@''HAVE_CHOWN''@|$(HAVE_CHOWN)|g' \
-e 's|@''HAVE_DUP2''@|$(HAVE_DUP2)|g' \
@@ -817,6 +967,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \
-e 's|@''HAVE_GETLOGIN''@|$(HAVE_GETLOGIN)|g' \
-e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \
+ -e 's|@''HAVE_GROUP_MEMBER''@|$(HAVE_GROUP_MEMBER)|g' \
-e 's|@''HAVE_LCHOWN''@|$(HAVE_LCHOWN)|g' \
-e 's|@''HAVE_LINK''@|$(HAVE_LINK)|g' \
-e 's|@''HAVE_LINKAT''@|$(HAVE_LINKAT)|g' \
@@ -883,9 +1034,10 @@ EXTRA_DIST += unistd.in.h
## begin gnulib module verify
if gl_GNULIB_ENABLED_verify
-libgnu_a_SOURCES += verify.h
endif
+EXTRA_DIST += verify.h
+
## end gnulib module verify
## begin gnulib module warn-on-use
diff --git a/lib/intprops.h b/lib/intprops.h
index 58b1b3fbf44..1f6a539c183 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -17,70 +17,303 @@
/* Written by Paul Eggert. */
-#ifndef GL_INTPROPS_H
-# define GL_INTPROPS_H
+#ifndef _GL_INTPROPS_H
+#define _GL_INTPROPS_H
-# include <limits.h>
+#include <limits.h>
+
+/* Return an integer value, converted to the same type as the integer
+ expression E after integer type promotion. V is the unconverted value. */
+#define _GL_INT_CONVERT(e, v) (0 * (e) + (v))
+
+/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see
+ <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00406.html>. */
+#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v))
/* The extra casts in the following macros work around compiler bugs,
e.g., in Cray C 5.0.3.0. */
/* True if the arithmetic type T is an integer type. bool counts as
an integer. */
-# define TYPE_IS_INTEGER(t) ((t) 1.5 == 1)
+#define TYPE_IS_INTEGER(t) ((t) 1.5 == 1)
/* True if negative values of the signed integer type T use two's
complement, ones' complement, or signed magnitude representation,
respectively. Much GNU code assumes two's complement, but some
people like to be portable to all possible C hosts. */
-# define TYPE_TWOS_COMPLEMENT(t) ((t) ~ (t) 0 == (t) -1)
-# define TYPE_ONES_COMPLEMENT(t) ((t) ~ (t) 0 == 0)
-# define TYPE_SIGNED_MAGNITUDE(t) ((t) ~ (t) 0 < (t) -1)
+#define TYPE_TWOS_COMPLEMENT(t) ((t) ~ (t) 0 == (t) -1)
+#define TYPE_ONES_COMPLEMENT(t) ((t) ~ (t) 0 == 0)
+#define TYPE_SIGNED_MAGNITUDE(t) ((t) ~ (t) 0 < (t) -1)
+
+/* True if the signed integer expression E uses two's complement. */
+#define _GL_INT_TWOS_COMPLEMENT(e) (~ _GL_INT_CONVERT (e, 0) == -1)
/* True if the arithmetic type T is signed. */
-# define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
+#define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
+
+/* Return 1 if the integer expression E, after integer promotion, has
+ a signed type. */
+#define _GL_INT_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0)
+
-/* The maximum and minimum values for the integer type T. These
+/* Minimum and maximum values for integer types and expressions. These
macros have undefined behavior if T is signed and has padding bits.
If this is a problem for you, please let us know how to fix it for
your host. */
-# define TYPE_MINIMUM(t) \
- ((t) (! TYPE_SIGNED (t) \
- ? (t) 0 \
- : TYPE_SIGNED_MAGNITUDE (t) \
- ? ~ (t) 0 \
+
+/* The maximum and minimum values for the integer type T. */
+#define TYPE_MINIMUM(t) \
+ ((t) (! TYPE_SIGNED (t) \
+ ? (t) 0 \
+ : TYPE_SIGNED_MAGNITUDE (t) \
+ ? ~ (t) 0 \
: ~ TYPE_MAXIMUM (t)))
-# define TYPE_MAXIMUM(t) \
- ((t) (! TYPE_SIGNED (t) \
- ? (t) -1 \
+#define TYPE_MAXIMUM(t) \
+ ((t) (! TYPE_SIGNED (t) \
+ ? (t) -1 \
: ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1)))
-/* Return zero if T can be determined to be an unsigned type.
- Otherwise, return 1.
- When compiling with GCC, INT_STRLEN_BOUND uses this macro to obtain a
- tighter bound. Otherwise, it overestimates the true bound by one byte
- when applied to unsigned types of size 2, 4, 16, ... bytes.
- The symbol signed_type_or_expr__ is private to this header file. */
-# if __GNUC__ >= 2
-# define signed_type_or_expr__(t) TYPE_SIGNED (__typeof__ (t))
-# else
-# define signed_type_or_expr__(t) 1
-# endif
+/* The maximum and minimum values for the type of the expression E,
+ after integer promotion. E should not have side effects. */
+#define _GL_INT_MINIMUM(e) \
+ (_GL_INT_SIGNED (e) \
+ ? - _GL_INT_TWOS_COMPLEMENT (e) - _GL_SIGNED_INT_MAXIMUM (e) \
+ : _GL_INT_CONVERT (e, 0))
+#define _GL_INT_MAXIMUM(e) \
+ (_GL_INT_SIGNED (e) \
+ ? _GL_SIGNED_INT_MAXIMUM (e) \
+ : _GL_INT_NEGATE_CONVERT (e, 1))
+#define _GL_SIGNED_INT_MAXIMUM(e) \
+ (((_GL_INT_CONVERT (e, 1) << (sizeof ((e) + 0) * CHAR_BIT - 2)) - 1) * 2 + 1)
+
+
+/* Return 1 if the __typeof__ keyword works. This could be done by
+ 'configure', but for now it's easier to do it by hand. */
+#if 2 <= __GNUC__ || 0x5110 <= __SUNPRO_C
+# define _GL_HAVE___TYPEOF__ 1
+#else
+# define _GL_HAVE___TYPEOF__ 0
+#endif
+
+/* Return 1 if the integer type or expression T might be signed. Return 0
+ if it is definitely unsigned. This macro does not evaluate its argument,
+ and expands to an integer constant expression. */
+#if _GL_HAVE___TYPEOF__
+# define _GL_SIGNED_TYPE_OR_EXPR(t) TYPE_SIGNED (__typeof__ (t))
+#else
+# define _GL_SIGNED_TYPE_OR_EXPR(t) 1
+#endif
/* Bound on length of the string representing an unsigned integer
value representable in B bits. log10 (2.0) < 146/485. The
smallest value of B where this bound is not tight is 2621. */
-# define INT_BITS_STRLEN_BOUND(b) (((b) * 146 + 484) / 485)
+#define INT_BITS_STRLEN_BOUND(b) (((b) * 146 + 484) / 485)
/* Bound on length of the string representing an integer type or expression T.
Subtract 1 for the sign bit if T is signed, and then add 1 more for
- a minus sign if needed. */
-# define INT_STRLEN_BOUND(t) \
- (INT_BITS_STRLEN_BOUND (sizeof (t) * CHAR_BIT - signed_type_or_expr__ (t)) \
- + signed_type_or_expr__ (t))
+ a minus sign if needed.
+
+ Because _GL_SIGNED_TYPE_OR_EXPR sometimes returns 0 when its argument is
+ signed, this macro may overestimate the true bound by one byte when
+ applied to unsigned types of size 2, 4, 16, ... bytes. */
+#define INT_STRLEN_BOUND(t) \
+ (INT_BITS_STRLEN_BOUND (sizeof (t) * CHAR_BIT \
+ - _GL_SIGNED_TYPE_OR_EXPR (t)) \
+ + _GL_SIGNED_TYPE_OR_EXPR (t))
/* Bound on buffer size needed to represent an integer type or expression T,
including the terminating null. */
-# define INT_BUFSIZE_BOUND(t) (INT_STRLEN_BOUND (t) + 1)
+#define INT_BUFSIZE_BOUND(t) (INT_STRLEN_BOUND (t) + 1)
+
+
+/* Range overflow checks.
+
+ The INT_<op>_RANGE_OVERFLOW macros return 1 if the corresponding C
+ operators might not yield numerically correct answers due to
+ arithmetic overflow. They do not rely on undefined or
+ implementation-defined behavior. Their implementations are simple
+ and straightforward, but they are a bit harder to use than the
+ INT_<op>_OVERFLOW macros described below.
+
+ Example usage:
+
+ long int i = ...;
+ long int j = ...;
+ if (INT_MULTIPLY_RANGE_OVERFLOW (i, j, LONG_MIN, LONG_MAX))
+ printf ("multiply would overflow");
+ else
+ printf ("product is %ld", i * j);
+
+ Restrictions on *_RANGE_OVERFLOW macros:
+
+ These macros do not check for all possible numerical problems or
+ undefined or unspecified behavior: they do not check for division
+ by zero, for bad shift counts, or for shifting negative numbers.
+
+ These macros may evaluate their arguments zero or multiple times,
+ so the arguments should not have side effects. The arithmetic
+ arguments (including the MIN and MAX arguments) must be of the same
+ integer type after the usual arithmetic conversions, and the type
+ must have minimum value MIN and maximum MAX. Unsigned types should
+ use a zero MIN of the proper type.
+
+ These macros are tuned for constant MIN and MAX. For commutative
+ operations such as A + B, they are also tuned for constant B. */
+
+/* Return 1 if A + B would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. */
+#define INT_ADD_RANGE_OVERFLOW(a, b, min, max) \
+ ((b) < 0 \
+ ? (a) < (min) - (b) \
+ : (max) - (b) < (a))
+
+/* Return 1 if A - B would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. */
+#define INT_SUBTRACT_RANGE_OVERFLOW(a, b, min, max) \
+ ((b) < 0 \
+ ? (max) + (b) < (a) \
+ : (a) < (min) + (b))
+
+/* Return 1 if - A would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. */
+#define INT_NEGATE_RANGE_OVERFLOW(a, min, max) \
+ ((min) < 0 \
+ ? (a) < - (max) \
+ : 0 < (a))
+
+/* Return 1 if A * B would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. Avoid && and || as they tickle
+ bugs in Sun C 5.11 2010/08/13 and other compilers; see
+ <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00401.html>. */
+#define INT_MULTIPLY_RANGE_OVERFLOW(a, b, min, max) \
+ ((b) < 0 \
+ ? ((a) < 0 \
+ ? (a) < (max) / (b) \
+ : (b) == -1 \
+ ? 0 \
+ : (min) / (b) < (a)) \
+ : (b) == 0 \
+ ? 0 \
+ : ((a) < 0 \
+ ? (a) < (min) / (b) \
+ : (max) / (b) < (a)))
+
+/* Return 1 if A / B would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. Do not check for division by zero. */
+#define INT_DIVIDE_RANGE_OVERFLOW(a, b, min, max) \
+ ((min) < 0 && (b) == -1 && (a) < - (max))
+
+/* Return 1 if A % B would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. Do not check for division by zero.
+ Mathematically, % should never overflow, but on x86-like hosts
+ INT_MIN % -1 traps, and the C standard permits this, so treat this
+ as an overflow too. */
+#define INT_REMAINDER_RANGE_OVERFLOW(a, b, min, max) \
+ INT_DIVIDE_RANGE_OVERFLOW (a, b, min, max)
+
+/* Return 1 if A << B would overflow in [MIN,MAX] arithmetic.
+ See above for restrictions. Here, MIN and MAX are for A only, and B need
+ not be of the same type as the other arguments. The C standard says that
+ behavior is undefined for shifts unless 0 <= B < wordwidth, and that when
+ A is negative then A << B has undefined behavior and A >> B has
+ implementation-defined behavior, but do not check these other
+ restrictions. */
+#define INT_LEFT_SHIFT_RANGE_OVERFLOW(a, b, min, max) \
+ ((a) < 0 \
+ ? (a) < (min) >> (b) \
+ : (max) >> (b) < (a))
+
+
+/* The _GL*_OVERFLOW macros have the same restrictions as the
+ *_RANGE_OVERFLOW macros, except that they do not assume that operands
+ (e.g., A and B) have the same type as MIN and MAX. Instead, they assume
+ that the result (e.g., A + B) has that type. */
+#define _GL_ADD_OVERFLOW(a, b, min, max) \
+ ((min) < 0 ? INT_ADD_RANGE_OVERFLOW (a, b, min, max) \
+ : (a) < 0 ? (b) <= (a) + (b) \
+ : (b) < 0 ? (a) <= (a) + (b) \
+ : (a) + (b) < (b))
+#define _GL_SUBTRACT_OVERFLOW(a, b, min, max) \
+ ((min) < 0 ? INT_SUBTRACT_RANGE_OVERFLOW (a, b, min, max) \
+ : (a) < 0 ? 1 \
+ : (b) < 0 ? (a) - (b) <= (a) \
+ : (a) < (b))
+#define _GL_MULTIPLY_OVERFLOW(a, b, min, max) \
+ (((min) == 0 && (((a) < 0 && 0 < (b)) || ((b) < 0 && 0 < (a)))) \
+ || INT_MULTIPLY_RANGE_OVERFLOW (a, b, min, max))
+#define _GL_DIVIDE_OVERFLOW(a, b, min, max) \
+ ((min) < 0 ? (b) == _GL_INT_NEGATE_CONVERT (min, 1) && (a) < - (max) \
+ : (a) < 0 ? (b) <= (a) + (b) - 1 \
+ : (b) < 0 && (a) + (b) <= (a))
+#define _GL_REMAINDER_OVERFLOW(a, b, min, max) \
+ ((min) < 0 ? (b) == _GL_INT_NEGATE_CONVERT (min, 1) && (a) < - (max) \
+ : (a) < 0 ? (a) % (b) != ((max) - (b) + 1) % (b) \
+ : (b) < 0 && ! _GL_UNSIGNED_NEG_MULTIPLE (a, b, max))
+
+/* Return a nonzero value if A is a mathematical multiple of B, where
+ A is unsigned, B is negative, and MAX is the maximum value of A's
+ type. A's type must be the same as (A % B)'s type. Normally (A %
+ -B == 0) suffices, but things get tricky if -B would overflow. */
+#define _GL_UNSIGNED_NEG_MULTIPLE(a, b, max) \
+ (((b) < -_GL_SIGNED_INT_MAXIMUM (b) \
+ ? (_GL_SIGNED_INT_MAXIMUM (b) == (max) \
+ ? (a) \
+ : (a) % (_GL_INT_CONVERT (a, _GL_SIGNED_INT_MAXIMUM (b)) + 1)) \
+ : (a) % - (b)) \
+ == 0)
+
+
+/* Integer overflow checks.
+
+ The INT_<op>_OVERFLOW macros return 1 if the corresponding C operators
+ might not yield numerically correct answers due to arithmetic overflow.
+ They work correctly on all known practical hosts, and do not rely
+ on undefined behavior due to signed arithmetic overflow.
+
+ Example usage:
+
+ long int i = ...;
+ long int j = ...;
+ if (INT_MULTIPLY_OVERFLOW (i, j))
+ printf ("multiply would overflow");
+ else
+ printf ("product is %ld", i * j);
+
+ These macros do not check for all possible numerical problems or
+ undefined or unspecified behavior: they do not check for division
+ by zero, for bad shift counts, or for shifting negative numbers.
+
+ These macros may evaluate their arguments zero or multiple times, so the
+ arguments should not have side effects.
+
+ These macros are tuned for their last argument being a constant.
+
+ Return 1 if the integer expressions A * B, A - B, -A, A * B, A / B,
+ A % B, and A << B would overflow, respectively. */
+
+#define INT_ADD_OVERFLOW(a, b) \
+ _GL_BINARY_OP_OVERFLOW (a, b, _GL_ADD_OVERFLOW)
+#define INT_SUBTRACT_OVERFLOW(a, b) \
+ _GL_BINARY_OP_OVERFLOW (a, b, _GL_SUBTRACT_OVERFLOW)
+#define INT_NEGATE_OVERFLOW(a) \
+ INT_NEGATE_RANGE_OVERFLOW (a, _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a))
+#define INT_MULTIPLY_OVERFLOW(a, b) \
+ _GL_BINARY_OP_OVERFLOW (a, b, _GL_MULTIPLY_OVERFLOW)
+#define INT_DIVIDE_OVERFLOW(a, b) \
+ _GL_BINARY_OP_OVERFLOW (a, b, _GL_DIVIDE_OVERFLOW)
+#define INT_REMAINDER_OVERFLOW(a, b) \
+ _GL_BINARY_OP_OVERFLOW (a, b, _GL_REMAINDER_OVERFLOW)
+#define INT_LEFT_SHIFT_OVERFLOW(a, b) \
+ INT_LEFT_SHIFT_RANGE_OVERFLOW (a, b, \
+ _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a))
+
+/* Return 1 if the expression A <op> B would overflow,
+ where OP_RESULT_OVERFLOW (A, B, MIN, MAX) does the actual test,
+ assuming MIN and MAX are the minimum and maximum for the result type.
+ Arguments should be free of side effects. */
+#define _GL_BINARY_OP_OVERFLOW(a, b, op_result_overflow) \
+ op_result_overflow (a, b, \
+ _GL_INT_MINIMUM (0 * (b) + (a)), \
+ _GL_INT_MAXIMUM (0 * (b) + (a)))
-#endif /* GL_INTPROPS_H */
+#endif /* _GL_INTPROPS_H */
diff --git a/lib/makefile.w32-in b/lib/makefile.w32-in
index b2aececf251..df7f8e274f0 100644
--- a/lib/makefile.w32-in
+++ b/lib/makefile.w32-in
@@ -29,6 +29,9 @@ GNULIBOBJS = $(BLD)/dtoastr.$(O) \
$(BLD)/strftime.$(O) \
$(BLD)/time_r.$(O) \
$(BLD)/md5.$(O) \
+ $(BLD)/sha1.$(O) \
+ $(BLD)/sha256.$(O) \
+ $(BLD)/sha512.$(O) \
$(BLD)/filemode.$(O)
#
@@ -110,6 +113,33 @@ $(BLD)/md5.$(O) : \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.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
+
+$(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
+
+$(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
+
$(BLD)/filemode.$(O) : \
$(SRC)/filemode.c \
$(SRC)/filemode.h \
@@ -187,7 +217,8 @@ ARG_NONNULL_H = ../arg-nonnull.h
getopt_h:
- $(DEL) getopt_.h-t getopt_.h
- sed -e "s!@HAVE_GETOPT_H@!$(HAVE_GETOPT_H)!g" \
+ sed -e "s!@GUARD_PREFIX@!GL!g" \
+ -e "s!@HAVE_GETOPT_H@!$(HAVE_GETOPT_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" \
diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c
new file mode 100644
index 00000000000..1f460f13c48
--- /dev/null
+++ b/lib/pthread_sigmask.c
@@ -0,0 +1,29 @@
+/* POSIX compatible signal blocking for threads.
+ Copyright (C) 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/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include <signal.h>
+
+#include <errno.h>
+
+int
+pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask)
+{
+ int ret = sigprocmask (how, new_mask, old_mask);
+ return (ret < 0 ? errno : 0);
+}
diff --git a/lib/sha1.c b/lib/sha1.c
new file mode 100644
index 00000000000..f832d050574
--- /dev/null
+++ b/lib/sha1.c
@@ -0,0 +1,427 @@
+/* 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.
+
+ 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, write to the Free Software Foundation,
+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+/* Written by Scott G. Miller
+ Credits:
+ Robert Klep <robert@ilse.nl> -- Expansion function fix
+*/
+
+#include <config.h>
+
+#include "sha1.h"
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if USE_UNLOCKED_IO
+# include "unlocked-io.h"
+#endif
+
+#ifdef WORDS_BIGENDIAN
+# define SWAP(n) (n)
+#else
+# define SWAP(n) \
+ (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24))
+#endif
+
+#define BLOCKSIZE 32768
+#if BLOCKSIZE % 64 != 0
+# error "invalid BLOCKSIZE"
+#endif
+
+/* This array contains the bytes used to pad the buffer to the next
+ 64-byte boundary. (RFC 1321, 3.1: Step 1) */
+static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ };
+
+
+/* Take a pointer to a 160 bit block of data (five 32 bit ints) and
+ initialize it to the start constants of the SHA1 algorithm. This
+ must be called before using hash in the call to sha1_hash. */
+void
+sha1_init_ctx (struct sha1_ctx *ctx)
+{
+ ctx->A = 0x67452301;
+ ctx->B = 0xefcdab89;
+ ctx->C = 0x98badcfe;
+ ctx->D = 0x10325476;
+ ctx->E = 0xc3d2e1f0;
+
+ ctx->total[0] = ctx->total[1] = 0;
+ ctx->buflen = 0;
+}
+
+/* Copy the 4 byte value from v into the memory location pointed to by *cp,
+ If your architecture allows unaligned access this is equivalent to
+ * (uint32_t *) cp = v */
+static inline void
+set_uint32 (char *cp, uint32_t v)
+{
+ memcpy (cp, &v, sizeof v);
+}
+
+/* Put result from CTX in first 20 bytes following RESBUF. The result
+ must be in little endian byte order. */
+void *
+sha1_read_ctx (const struct sha1_ctx *ctx, void *resbuf)
+{
+ char *r = resbuf;
+ set_uint32 (r + 0 * sizeof ctx->A, SWAP (ctx->A));
+ set_uint32 (r + 1 * sizeof ctx->B, SWAP (ctx->B));
+ set_uint32 (r + 2 * sizeof ctx->C, SWAP (ctx->C));
+ set_uint32 (r + 3 * sizeof ctx->D, SWAP (ctx->D));
+ set_uint32 (r + 4 * sizeof ctx->E, SWAP (ctx->E));
+
+ return resbuf;
+}
+
+/* Process the remaining bytes in the internal buffer and the usual
+ prolog according to the standard and write the result to RESBUF. */
+void *
+sha1_finish_ctx (struct sha1_ctx *ctx, void *resbuf)
+{
+ /* Take yet unprocessed bytes into account. */
+ uint32_t bytes = ctx->buflen;
+ size_t size = (bytes < 56) ? 64 / 4 : 64 * 2 / 4;
+
+ /* Now count remaining bytes. */
+ ctx->total[0] += bytes;
+ if (ctx->total[0] < bytes)
+ ++ctx->total[1];
+
+ /* Put the 64-bit file length in *bits* at the end of the buffer. */
+ ctx->buffer[size - 2] = SWAP ((ctx->total[1] << 3) | (ctx->total[0] >> 29));
+ ctx->buffer[size - 1] = SWAP (ctx->total[0] << 3);
+
+ memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 4 - bytes);
+
+ /* Process last bytes. */
+ sha1_process_block (ctx->buffer, size * 4, ctx);
+
+ return sha1_read_ctx (ctx, resbuf);
+}
+
+/* Compute SHA1 message digest for bytes read from STREAM. The
+ resulting message digest number will be written into the 16 bytes
+ beginning at RESBLOCK. */
+int
+sha1_stream (FILE *stream, void *resblock)
+{
+ struct sha1_ctx ctx;
+ size_t sum;
+
+ char *buffer = malloc (BLOCKSIZE + 72);
+ if (!buffer)
+ return 1;
+
+ /* Initialize the computation context. */
+ sha1_init_ctx (&ctx);
+
+ /* Iterate over full file contents. */
+ while (1)
+ {
+ /* We read the file in blocks of BLOCKSIZE bytes. One call of the
+ computation function processes the whole buffer so that with the
+ next round of the loop another block can be read. */
+ size_t n;
+ sum = 0;
+
+ /* Read block. Take care for partial reads. */
+ while (1)
+ {
+ n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
+
+ sum += n;
+
+ if (sum == BLOCKSIZE)
+ break;
+
+ if (n == 0)
+ {
+ /* Check for the error flag IFF N == 0, so that we don't
+ exit the loop after a partial read due to e.g., EAGAIN
+ or EWOULDBLOCK. */
+ if (ferror (stream))
+ {
+ free (buffer);
+ return 1;
+ }
+ goto process_partial_block;
+ }
+
+ /* We've read at least one byte, so ignore errors. But always
+ check for EOF, since feof may be true even though N > 0.
+ Otherwise, we could end up calling fread after EOF. */
+ if (feof (stream))
+ goto process_partial_block;
+ }
+
+ /* Process buffer with BLOCKSIZE bytes. Note that
+ BLOCKSIZE % 64 == 0
+ */
+ sha1_process_block (buffer, BLOCKSIZE, &ctx);
+ }
+
+ process_partial_block:;
+
+ /* Process any remaining bytes. */
+ if (sum > 0)
+ sha1_process_bytes (buffer, sum, &ctx);
+
+ /* Construct result in desired memory. */
+ sha1_finish_ctx (&ctx, resblock);
+ free (buffer);
+ return 0;
+}
+
+/* Compute SHA1 message digest for LEN bytes beginning at BUFFER. The
+ result is always in little endian byte order, so that a byte-wise
+ output yields to the wanted ASCII representation of the message
+ digest. */
+void *
+sha1_buffer (const char *buffer, size_t len, void *resblock)
+{
+ struct sha1_ctx ctx;
+
+ /* Initialize the computation context. */
+ sha1_init_ctx (&ctx);
+
+ /* Process whole buffer but last len % 64 bytes. */
+ sha1_process_bytes (buffer, len, &ctx);
+
+ /* Put result in desired memory area. */
+ return sha1_finish_ctx (&ctx, resblock);
+}
+
+void
+sha1_process_bytes (const void *buffer, size_t len, struct sha1_ctx *ctx)
+{
+ /* When we already have some bits in our internal buffer concatenate
+ both inputs first. */
+ if (ctx->buflen != 0)
+ {
+ size_t left_over = ctx->buflen;
+ size_t add = 128 - left_over > len ? len : 128 - left_over;
+
+ memcpy (&((char *) ctx->buffer)[left_over], buffer, add);
+ ctx->buflen += add;
+
+ if (ctx->buflen > 64)
+ {
+ sha1_process_block (ctx->buffer, ctx->buflen & ~63, ctx);
+
+ ctx->buflen &= 63;
+ /* The regions in the following copy operation cannot overlap. */
+ memcpy (ctx->buffer,
+ &((char *) ctx->buffer)[(left_over + add) & ~63],
+ ctx->buflen);
+ }
+
+ buffer = (const char *) buffer + add;
+ len -= add;
+ }
+
+ /* Process available complete blocks. */
+ 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)
+ if (UNALIGNED_P (buffer))
+ while (len > 64)
+ {
+ sha1_process_block (memcpy (ctx->buffer, buffer, 64), 64, ctx);
+ buffer = (const char *) buffer + 64;
+ len -= 64;
+ }
+ else
+#endif
+ {
+ sha1_process_block (buffer, len & ~63, ctx);
+ buffer = (const char *) buffer + (len & ~63);
+ len &= 63;
+ }
+ }
+
+ /* Move remaining bytes in internal buffer. */
+ if (len > 0)
+ {
+ size_t left_over = ctx->buflen;
+
+ memcpy (&((char *) ctx->buffer)[left_over], buffer, len);
+ left_over += len;
+ if (left_over >= 64)
+ {
+ sha1_process_block (ctx->buffer, 64, ctx);
+ left_over -= 64;
+ memcpy (ctx->buffer, &ctx->buffer[16], left_over);
+ }
+ ctx->buflen = left_over;
+ }
+}
+
+/* --- Code below is the primary difference between md5.c and sha1.c --- */
+
+/* SHA1 round constants */
+#define K1 0x5a827999
+#define K2 0x6ed9eba1
+#define K3 0x8f1bbcdc
+#define K4 0xca62c1d6
+
+/* Round functions. Note that F2 is the same as F4. */
+#define F1(B,C,D) ( D ^ ( B & ( C ^ D ) ) )
+#define F2(B,C,D) (B ^ C ^ D)
+#define F3(B,C,D) ( ( B & C ) | ( D & ( B | C ) ) )
+#define F4(B,C,D) (B ^ C ^ D)
+
+/* Process LEN bytes of BUFFER, accumulating context into CTX.
+ It is assumed that LEN % 64 == 0.
+ Most of this code comes from GnuPG's cipher/sha1.c. */
+
+void
+sha1_process_block (const void *buffer, size_t len, struct sha1_ctx *ctx)
+{
+ const uint32_t *words = buffer;
+ size_t nwords = len / sizeof (uint32_t);
+ const uint32_t *endp = words + nwords;
+ uint32_t x[16];
+ uint32_t a = ctx->A;
+ uint32_t b = ctx->B;
+ uint32_t c = ctx->C;
+ uint32_t d = ctx->D;
+ uint32_t e = ctx->E;
+
+ /* 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];
+
+#define rol(x, n) (((x) << (n)) | ((uint32_t) (x) >> (32 - (n))))
+
+#define M(I) ( tm = x[I&0x0f] ^ x[(I-14)&0x0f] \
+ ^ x[(I-8)&0x0f] ^ x[(I-3)&0x0f] \
+ , (x[I&0x0f] = rol(tm, 1)) )
+
+#define R(A,B,C,D,E,F,K,M) do { E += rol( A, 5 ) \
+ + F( B, C, D ) \
+ + K \
+ + M; \
+ B = rol( B, 30 ); \
+ } while(0)
+
+ while (words < endp)
+ {
+ uint32_t tm;
+ int t;
+ for (t = 0; t < 16; t++)
+ {
+ x[t] = SWAP (*words);
+ words++;
+ }
+
+ R( a, b, c, d, e, F1, K1, x[ 0] );
+ R( e, a, b, c, d, F1, K1, x[ 1] );
+ R( d, e, a, b, c, F1, K1, x[ 2] );
+ R( c, d, e, a, b, F1, K1, x[ 3] );
+ R( b, c, d, e, a, F1, K1, x[ 4] );
+ R( a, b, c, d, e, F1, K1, x[ 5] );
+ R( e, a, b, c, d, F1, K1, x[ 6] );
+ R( d, e, a, b, c, F1, K1, x[ 7] );
+ R( c, d, e, a, b, F1, K1, x[ 8] );
+ R( b, c, d, e, a, F1, K1, x[ 9] );
+ R( a, b, c, d, e, F1, K1, x[10] );
+ R( e, a, b, c, d, F1, K1, x[11] );
+ R( d, e, a, b, c, F1, K1, x[12] );
+ R( c, d, e, a, b, F1, K1, x[13] );
+ R( b, c, d, e, a, F1, K1, x[14] );
+ R( a, b, c, d, e, F1, K1, x[15] );
+ R( e, a, b, c, d, F1, K1, M(16) );
+ R( d, e, a, b, c, F1, K1, M(17) );
+ R( c, d, e, a, b, F1, K1, M(18) );
+ R( b, c, d, e, a, F1, K1, M(19) );
+ R( a, b, c, d, e, F2, K2, M(20) );
+ R( e, a, b, c, d, F2, K2, M(21) );
+ R( d, e, a, b, c, F2, K2, M(22) );
+ R( c, d, e, a, b, F2, K2, M(23) );
+ R( b, c, d, e, a, F2, K2, M(24) );
+ R( a, b, c, d, e, F2, K2, M(25) );
+ R( e, a, b, c, d, F2, K2, M(26) );
+ R( d, e, a, b, c, F2, K2, M(27) );
+ R( c, d, e, a, b, F2, K2, M(28) );
+ R( b, c, d, e, a, F2, K2, M(29) );
+ R( a, b, c, d, e, F2, K2, M(30) );
+ R( e, a, b, c, d, F2, K2, M(31) );
+ R( d, e, a, b, c, F2, K2, M(32) );
+ R( c, d, e, a, b, F2, K2, M(33) );
+ R( b, c, d, e, a, F2, K2, M(34) );
+ R( a, b, c, d, e, F2, K2, M(35) );
+ R( e, a, b, c, d, F2, K2, M(36) );
+ R( d, e, a, b, c, F2, K2, M(37) );
+ R( c, d, e, a, b, F2, K2, M(38) );
+ R( b, c, d, e, a, F2, K2, M(39) );
+ R( a, b, c, d, e, F3, K3, M(40) );
+ R( e, a, b, c, d, F3, K3, M(41) );
+ R( d, e, a, b, c, F3, K3, M(42) );
+ R( c, d, e, a, b, F3, K3, M(43) );
+ R( b, c, d, e, a, F3, K3, M(44) );
+ R( a, b, c, d, e, F3, K3, M(45) );
+ R( e, a, b, c, d, F3, K3, M(46) );
+ R( d, e, a, b, c, F3, K3, M(47) );
+ R( c, d, e, a, b, F3, K3, M(48) );
+ R( b, c, d, e, a, F3, K3, M(49) );
+ R( a, b, c, d, e, F3, K3, M(50) );
+ R( e, a, b, c, d, F3, K3, M(51) );
+ R( d, e, a, b, c, F3, K3, M(52) );
+ R( c, d, e, a, b, F3, K3, M(53) );
+ R( b, c, d, e, a, F3, K3, M(54) );
+ R( a, b, c, d, e, F3, K3, M(55) );
+ R( e, a, b, c, d, F3, K3, M(56) );
+ R( d, e, a, b, c, F3, K3, M(57) );
+ R( c, d, e, a, b, F3, K3, M(58) );
+ R( b, c, d, e, a, F3, K3, M(59) );
+ R( a, b, c, d, e, F4, K4, M(60) );
+ R( e, a, b, c, d, F4, K4, M(61) );
+ R( d, e, a, b, c, F4, K4, M(62) );
+ R( c, d, e, a, b, F4, K4, M(63) );
+ R( b, c, d, e, a, F4, K4, M(64) );
+ R( a, b, c, d, e, F4, K4, M(65) );
+ R( e, a, b, c, d, F4, K4, M(66) );
+ R( d, e, a, b, c, F4, K4, M(67) );
+ R( c, d, e, a, b, F4, K4, M(68) );
+ R( b, c, d, e, a, F4, K4, M(69) );
+ R( a, b, c, d, e, F4, K4, M(70) );
+ R( e, a, b, c, d, F4, K4, M(71) );
+ R( d, e, a, b, c, F4, K4, M(72) );
+ R( c, d, e, a, b, F4, K4, M(73) );
+ R( b, c, d, e, a, F4, K4, M(74) );
+ R( a, b, c, d, e, F4, K4, M(75) );
+ R( e, a, b, c, d, F4, K4, M(76) );
+ R( d, e, a, b, c, F4, K4, M(77) );
+ R( c, d, e, a, b, F4, K4, M(78) );
+ R( b, c, d, e, a, F4, K4, M(79) );
+
+ a = ctx->A += a;
+ b = ctx->B += b;
+ c = ctx->C += c;
+ d = ctx->D += d;
+ e = ctx->E += e;
+ }
+}
diff --git a/lib/sha1.h b/lib/sha1.h
new file mode 100644
index 00000000000..47b56f2adfb
--- /dev/null
+++ b/lib/sha1.h
@@ -0,0 +1,92 @@
+/* Declarations of functions and data types used for SHA1 sum
+ library functions.
+ Copyright (C) 2000-2001, 2003, 2005-2006, 2008-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, 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, write to the Free Software Foundation,
+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#ifndef SHA1_H
+# define SHA1_H 1
+
+# include <stdio.h>
+# include <stdint.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+#define SHA1_DIGEST_SIZE 20
+
+/* Structure to save state of computation between the single steps. */
+struct sha1_ctx
+{
+ uint32_t A;
+ uint32_t B;
+ uint32_t C;
+ uint32_t D;
+ uint32_t E;
+
+ uint32_t total[2];
+ uint32_t buflen;
+ uint32_t buffer[32];
+};
+
+
+/* Initialize structure containing state of computation. */
+extern void sha1_init_ctx (struct sha1_ctx *ctx);
+
+/* Starting with the result of former calls of this function (or the
+ initialization function update the context for the next LEN bytes
+ starting at BUFFER.
+ It is necessary that LEN is a multiple of 64!!! */
+extern void sha1_process_block (const void *buffer, size_t len,
+ struct sha1_ctx *ctx);
+
+/* Starting with the result of former calls of this function (or the
+ initialization function update the context for the next LEN bytes
+ starting at BUFFER.
+ It is NOT required that LEN is a multiple of 64. */
+extern void sha1_process_bytes (const void *buffer, size_t len,
+ struct sha1_ctx *ctx);
+
+/* Process the remaining bytes in the buffer and put result from CTX
+ in first 20 bytes following RESBUF. The result is always in little
+ endian byte order, so that a byte-wise output yields to the wanted
+ ASCII representation of the message digest. */
+extern void *sha1_finish_ctx (struct sha1_ctx *ctx, void *resbuf);
+
+
+/* Put result from CTX in first 20 bytes following RESBUF. The result is
+ always in little endian byte order, so that a byte-wise output yields
+ to the wanted ASCII representation of the message digest. */
+extern void *sha1_read_ctx (const struct sha1_ctx *ctx, void *resbuf);
+
+
+/* Compute SHA1 message digest for bytes read from STREAM. The
+ resulting message digest number will be written into the 20 bytes
+ beginning at RESBLOCK. */
+extern int sha1_stream (FILE *stream, void *resblock);
+
+/* Compute SHA1 message digest for LEN bytes beginning at BUFFER. The
+ result is always in little endian byte order, so that a byte-wise
+ output yields to the wanted ASCII representation of the message
+ digest. */
+extern void *sha1_buffer (const char *buffer, size_t len, void *resblock);
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
diff --git a/lib/sha256.c b/lib/sha256.c
new file mode 100644
index 00000000000..c125542248b
--- /dev/null
+++ b/lib/sha256.c
@@ -0,0 +1,569 @@
+/* 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.
+
+ 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 Madore, considerably copypasting from
+ Scott G. Miller's sha1.c
+*/
+
+#include <config.h>
+
+#include "sha256.h"
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if USE_UNLOCKED_IO
+# include "unlocked-io.h"
+#endif
+
+#ifdef WORDS_BIGENDIAN
+# define SWAP(n) (n)
+#else
+# define SWAP(n) \
+ (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24))
+#endif
+
+#define BLOCKSIZE 32768
+#if BLOCKSIZE % 64 != 0
+# error "invalid BLOCKSIZE"
+#endif
+
+/* This array contains the bytes used to pad the buffer to the next
+ 64-byte boundary. */
+static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ };
+
+
+/*
+ Takes a pointer to a 256 bit block of data (eight 32 bit ints) and
+ intializes it to the start constants of the SHA256 algorithm. This
+ must be called before using hash in the call to sha256_hash
+*/
+void
+sha256_init_ctx (struct sha256_ctx *ctx)
+{
+ ctx->state[0] = 0x6a09e667UL;
+ ctx->state[1] = 0xbb67ae85UL;
+ ctx->state[2] = 0x3c6ef372UL;
+ ctx->state[3] = 0xa54ff53aUL;
+ ctx->state[4] = 0x510e527fUL;
+ ctx->state[5] = 0x9b05688cUL;
+ ctx->state[6] = 0x1f83d9abUL;
+ ctx->state[7] = 0x5be0cd19UL;
+
+ ctx->total[0] = ctx->total[1] = 0;
+ ctx->buflen = 0;
+}
+
+void
+sha224_init_ctx (struct sha256_ctx *ctx)
+{
+ ctx->state[0] = 0xc1059ed8UL;
+ ctx->state[1] = 0x367cd507UL;
+ ctx->state[2] = 0x3070dd17UL;
+ ctx->state[3] = 0xf70e5939UL;
+ ctx->state[4] = 0xffc00b31UL;
+ ctx->state[5] = 0x68581511UL;
+ ctx->state[6] = 0x64f98fa7UL;
+ ctx->state[7] = 0xbefa4fa4UL;
+
+ ctx->total[0] = ctx->total[1] = 0;
+ ctx->buflen = 0;
+}
+
+/* Copy the value from v into the memory location pointed to by *cp,
+ If your architecture allows unaligned access this is equivalent to
+ * (uint32_t *) cp = v */
+static inline void
+set_uint32 (char *cp, uint32_t v)
+{
+ memcpy (cp, &v, sizeof v);
+}
+
+/* Put result from CTX in first 32 bytes following RESBUF. The result
+ must be in little endian byte order. */
+void *
+sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf)
+{
+ int i;
+ char *r = resbuf;
+
+ for (i = 0; i < 8; i++)
+ set_uint32 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
+
+ return resbuf;
+}
+
+void *
+sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf)
+{
+ int i;
+ char *r = resbuf;
+
+ for (i = 0; i < 7; i++)
+ set_uint32 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
+
+ return resbuf;
+}
+
+/* Process the remaining bytes in the internal buffer and the usual
+ prolog according to the standard and write the result to RESBUF. */
+static void
+sha256_conclude_ctx (struct sha256_ctx *ctx)
+{
+ /* Take yet unprocessed bytes into account. */
+ size_t bytes = ctx->buflen;
+ size_t size = (bytes < 56) ? 64 / 4 : 64 * 2 / 4;
+
+ /* Now count remaining bytes. */
+ ctx->total[0] += bytes;
+ if (ctx->total[0] < bytes)
+ ++ctx->total[1];
+
+ /* Put the 64-bit file length in *bits* at the end of the buffer.
+ Use set_uint32 rather than a simple assignment, to avoid risk of
+ unaligned access. */
+ set_uint32 ((char *) &ctx->buffer[size - 2],
+ SWAP ((ctx->total[1] << 3) | (ctx->total[0] >> 29)));
+ set_uint32 ((char *) &ctx->buffer[size - 1],
+ SWAP (ctx->total[0] << 3));
+
+ memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 4 - bytes);
+
+ /* Process last bytes. */
+ sha256_process_block (ctx->buffer, size * 4, ctx);
+}
+
+void *
+sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf)
+{
+ sha256_conclude_ctx (ctx);
+ return sha256_read_ctx (ctx, resbuf);
+}
+
+void *
+sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf)
+{
+ sha256_conclude_ctx (ctx);
+ return sha224_read_ctx (ctx, resbuf);
+}
+
+/* Compute SHA256 message digest for bytes read from STREAM. The
+ resulting message digest number will be written into the 32 bytes
+ beginning at RESBLOCK. */
+int
+sha256_stream (FILE *stream, void *resblock)
+{
+ struct sha256_ctx ctx;
+ size_t sum;
+
+ char *buffer = malloc (BLOCKSIZE + 72);
+ if (!buffer)
+ return 1;
+
+ /* Initialize the computation context. */
+ sha256_init_ctx (&ctx);
+
+ /* Iterate over full file contents. */
+ while (1)
+ {
+ /* We read the file in blocks of BLOCKSIZE bytes. One call of the
+ computation function processes the whole buffer so that with the
+ next round of the loop another block can be read. */
+ size_t n;
+ sum = 0;
+
+ /* Read block. Take care for partial reads. */
+ while (1)
+ {
+ n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
+
+ sum += n;
+
+ if (sum == BLOCKSIZE)
+ break;
+
+ if (n == 0)
+ {
+ /* Check for the error flag IFF N == 0, so that we don't
+ exit the loop after a partial read due to e.g., EAGAIN
+ or EWOULDBLOCK. */
+ if (ferror (stream))
+ {
+ free (buffer);
+ return 1;
+ }
+ goto process_partial_block;
+ }
+
+ /* We've read at least one byte, so ignore errors. But always
+ check for EOF, since feof may be true even though N > 0.
+ Otherwise, we could end up calling fread after EOF. */
+ if (feof (stream))
+ goto process_partial_block;
+ }
+
+ /* Process buffer with BLOCKSIZE bytes. Note that
+ BLOCKSIZE % 64 == 0
+ */
+ sha256_process_block (buffer, BLOCKSIZE, &ctx);
+ }
+
+ process_partial_block:;
+
+ /* Process any remaining bytes. */
+ if (sum > 0)
+ sha256_process_bytes (buffer, sum, &ctx);
+
+ /* Construct result in desired memory. */
+ sha256_finish_ctx (&ctx, resblock);
+ free (buffer);
+ return 0;
+}
+
+/* FIXME: Avoid code duplication */
+int
+sha224_stream (FILE *stream, void *resblock)
+{
+ struct sha256_ctx ctx;
+ size_t sum;
+
+ char *buffer = malloc (BLOCKSIZE + 72);
+ if (!buffer)
+ return 1;
+
+ /* Initialize the computation context. */
+ sha224_init_ctx (&ctx);
+
+ /* Iterate over full file contents. */
+ while (1)
+ {
+ /* We read the file in blocks of BLOCKSIZE bytes. One call of the
+ computation function processes the whole buffer so that with the
+ next round of the loop another block can be read. */
+ size_t n;
+ sum = 0;
+
+ /* Read block. Take care for partial reads. */
+ while (1)
+ {
+ n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
+
+ sum += n;
+
+ if (sum == BLOCKSIZE)
+ break;
+
+ if (n == 0)
+ {
+ /* Check for the error flag IFF N == 0, so that we don't
+ exit the loop after a partial read due to e.g., EAGAIN
+ or EWOULDBLOCK. */
+ if (ferror (stream))
+ {
+ free (buffer);
+ return 1;
+ }
+ goto process_partial_block;
+ }
+
+ /* We've read at least one byte, so ignore errors. But always
+ check for EOF, since feof may be true even though N > 0.
+ Otherwise, we could end up calling fread after EOF. */
+ if (feof (stream))
+ goto process_partial_block;
+ }
+
+ /* Process buffer with BLOCKSIZE bytes. Note that
+ BLOCKSIZE % 64 == 0
+ */
+ sha256_process_block (buffer, BLOCKSIZE, &ctx);
+ }
+
+ process_partial_block:;
+
+ /* Process any remaining bytes. */
+ if (sum > 0)
+ sha256_process_bytes (buffer, sum, &ctx);
+
+ /* Construct result in desired memory. */
+ sha224_finish_ctx (&ctx, resblock);
+ free (buffer);
+ return 0;
+}
+
+/* Compute SHA512 message digest for LEN bytes beginning at BUFFER. The
+ result is always in little endian byte order, so that a byte-wise
+ output yields to the wanted ASCII representation of the message
+ digest. */
+void *
+sha256_buffer (const char *buffer, size_t len, void *resblock)
+{
+ struct sha256_ctx ctx;
+
+ /* Initialize the computation context. */
+ sha256_init_ctx (&ctx);
+
+ /* Process whole buffer but last len % 64 bytes. */
+ sha256_process_bytes (buffer, len, &ctx);
+
+ /* Put result in desired memory area. */
+ return sha256_finish_ctx (&ctx, resblock);
+}
+
+void *
+sha224_buffer (const char *buffer, size_t len, void *resblock)
+{
+ struct sha256_ctx ctx;
+
+ /* Initialize the computation context. */
+ sha224_init_ctx (&ctx);
+
+ /* Process whole buffer but last len % 64 bytes. */
+ sha256_process_bytes (buffer, len, &ctx);
+
+ /* Put result in desired memory area. */
+ return sha224_finish_ctx (&ctx, resblock);
+}
+
+void
+sha256_process_bytes (const void *buffer, size_t len, struct sha256_ctx *ctx)
+{
+ /* When we already have some bits in our internal buffer concatenate
+ both inputs first. */
+ if (ctx->buflen != 0)
+ {
+ size_t left_over = ctx->buflen;
+ size_t add = 128 - left_over > len ? len : 128 - left_over;
+
+ memcpy (&((char *) ctx->buffer)[left_over], buffer, add);
+ ctx->buflen += add;
+
+ if (ctx->buflen > 64)
+ {
+ sha256_process_block (ctx->buffer, ctx->buflen & ~63, ctx);
+
+ ctx->buflen &= 63;
+ /* The regions in the following copy operation cannot overlap. */
+ memcpy (ctx->buffer,
+ &((char *) ctx->buffer)[(left_over + add) & ~63],
+ ctx->buflen);
+ }
+
+ buffer = (const char *) buffer + add;
+ len -= add;
+ }
+
+ /* Process available complete blocks. */
+ 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)
+ if (UNALIGNED_P (buffer))
+ while (len > 64)
+ {
+ sha256_process_block (memcpy (ctx->buffer, buffer, 64), 64, ctx);
+ buffer = (const char *) buffer + 64;
+ len -= 64;
+ }
+ else
+#endif
+ {
+ sha256_process_block (buffer, len & ~63, ctx);
+ buffer = (const char *) buffer + (len & ~63);
+ len &= 63;
+ }
+ }
+
+ /* Move remaining bytes in internal buffer. */
+ if (len > 0)
+ {
+ size_t left_over = ctx->buflen;
+
+ memcpy (&((char *) ctx->buffer)[left_over], buffer, len);
+ left_over += len;
+ if (left_over >= 64)
+ {
+ sha256_process_block (ctx->buffer, 64, ctx);
+ left_over -= 64;
+ memcpy (ctx->buffer, &ctx->buffer[16], left_over);
+ }
+ ctx->buflen = left_over;
+ }
+}
+
+/* --- Code below is the primary difference between sha1.c and sha256.c --- */
+
+/* SHA256 round constants */
+#define K(I) sha256_round_constants[I]
+static const uint32_t sha256_round_constants[64] = {
+ 0x428a2f98UL, 0x71374491UL, 0xb5c0fbcfUL, 0xe9b5dba5UL,
+ 0x3956c25bUL, 0x59f111f1UL, 0x923f82a4UL, 0xab1c5ed5UL,
+ 0xd807aa98UL, 0x12835b01UL, 0x243185beUL, 0x550c7dc3UL,
+ 0x72be5d74UL, 0x80deb1feUL, 0x9bdc06a7UL, 0xc19bf174UL,
+ 0xe49b69c1UL, 0xefbe4786UL, 0x0fc19dc6UL, 0x240ca1ccUL,
+ 0x2de92c6fUL, 0x4a7484aaUL, 0x5cb0a9dcUL, 0x76f988daUL,
+ 0x983e5152UL, 0xa831c66dUL, 0xb00327c8UL, 0xbf597fc7UL,
+ 0xc6e00bf3UL, 0xd5a79147UL, 0x06ca6351UL, 0x14292967UL,
+ 0x27b70a85UL, 0x2e1b2138UL, 0x4d2c6dfcUL, 0x53380d13UL,
+ 0x650a7354UL, 0x766a0abbUL, 0x81c2c92eUL, 0x92722c85UL,
+ 0xa2bfe8a1UL, 0xa81a664bUL, 0xc24b8b70UL, 0xc76c51a3UL,
+ 0xd192e819UL, 0xd6990624UL, 0xf40e3585UL, 0x106aa070UL,
+ 0x19a4c116UL, 0x1e376c08UL, 0x2748774cUL, 0x34b0bcb5UL,
+ 0x391c0cb3UL, 0x4ed8aa4aUL, 0x5b9cca4fUL, 0x682e6ff3UL,
+ 0x748f82eeUL, 0x78a5636fUL, 0x84c87814UL, 0x8cc70208UL,
+ 0x90befffaUL, 0xa4506cebUL, 0xbef9a3f7UL, 0xc67178f2UL,
+};
+
+/* Round functions. */
+#define F2(A,B,C) ( ( A & B ) | ( C & ( A | B ) ) )
+#define F1(E,F,G) ( G ^ ( E & ( F ^ G ) ) )
+
+/* Process LEN bytes of BUFFER, accumulating context into CTX.
+ It is assumed that LEN % 64 == 0.
+ Most of this code comes from GnuPG's cipher/sha1.c. */
+
+void
+sha256_process_block (const void *buffer, size_t len, struct sha256_ctx *ctx)
+{
+ const uint32_t *words = buffer;
+ size_t nwords = len / sizeof (uint32_t);
+ const uint32_t *endp = words + nwords;
+ uint32_t x[16];
+ uint32_t a = ctx->state[0];
+ uint32_t b = ctx->state[1];
+ uint32_t c = ctx->state[2];
+ uint32_t d = ctx->state[3];
+ uint32_t e = ctx->state[4];
+ uint32_t f = ctx->state[5];
+ uint32_t g = ctx->state[6];
+ uint32_t h = ctx->state[7];
+
+ /* 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];
+
+#define rol(x, n) (((x) << (n)) | ((x) >> (32 - (n))))
+#define S0(x) (rol(x,25)^rol(x,14)^(x>>3))
+#define S1(x) (rol(x,15)^rol(x,13)^(x>>10))
+#define SS0(x) (rol(x,30)^rol(x,19)^rol(x,10))
+#define SS1(x) (rol(x,26)^rol(x,21)^rol(x,7))
+
+#define M(I) ( tm = S1(x[(I-2)&0x0f]) + x[(I-7)&0x0f] \
+ + S0(x[(I-15)&0x0f]) + x[I&0x0f] \
+ , x[I&0x0f] = tm )
+
+#define R(A,B,C,D,E,F,G,H,K,M) do { t0 = SS0(A) + F2(A,B,C); \
+ t1 = H + SS1(E) \
+ + F1(E,F,G) \
+ + K \
+ + M; \
+ D += t1; H = t0 + t1; \
+ } while(0)
+
+ while (words < endp)
+ {
+ uint32_t tm;
+ uint32_t t0, t1;
+ int t;
+ /* FIXME: see sha1.c for a better implementation. */
+ for (t = 0; t < 16; t++)
+ {
+ x[t] = SWAP (*words);
+ words++;
+ }
+
+ R( a, b, c, d, e, f, g, h, K( 0), x[ 0] );
+ R( h, a, b, c, d, e, f, g, K( 1), x[ 1] );
+ R( g, h, a, b, c, d, e, f, K( 2), x[ 2] );
+ R( f, g, h, a, b, c, d, e, K( 3), x[ 3] );
+ R( e, f, g, h, a, b, c, d, K( 4), x[ 4] );
+ R( d, e, f, g, h, a, b, c, K( 5), x[ 5] );
+ R( c, d, e, f, g, h, a, b, K( 6), x[ 6] );
+ R( b, c, d, e, f, g, h, a, K( 7), x[ 7] );
+ R( a, b, c, d, e, f, g, h, K( 8), x[ 8] );
+ R( h, a, b, c, d, e, f, g, K( 9), x[ 9] );
+ R( g, h, a, b, c, d, e, f, K(10), x[10] );
+ R( f, g, h, a, b, c, d, e, K(11), x[11] );
+ R( e, f, g, h, a, b, c, d, K(12), x[12] );
+ R( d, e, f, g, h, a, b, c, K(13), x[13] );
+ R( c, d, e, f, g, h, a, b, K(14), x[14] );
+ R( b, c, d, e, f, g, h, a, K(15), x[15] );
+ R( a, b, c, d, e, f, g, h, K(16), M(16) );
+ R( h, a, b, c, d, e, f, g, K(17), M(17) );
+ R( g, h, a, b, c, d, e, f, K(18), M(18) );
+ R( f, g, h, a, b, c, d, e, K(19), M(19) );
+ R( e, f, g, h, a, b, c, d, K(20), M(20) );
+ R( d, e, f, g, h, a, b, c, K(21), M(21) );
+ R( c, d, e, f, g, h, a, b, K(22), M(22) );
+ R( b, c, d, e, f, g, h, a, K(23), M(23) );
+ R( a, b, c, d, e, f, g, h, K(24), M(24) );
+ R( h, a, b, c, d, e, f, g, K(25), M(25) );
+ R( g, h, a, b, c, d, e, f, K(26), M(26) );
+ R( f, g, h, a, b, c, d, e, K(27), M(27) );
+ R( e, f, g, h, a, b, c, d, K(28), M(28) );
+ R( d, e, f, g, h, a, b, c, K(29), M(29) );
+ R( c, d, e, f, g, h, a, b, K(30), M(30) );
+ R( b, c, d, e, f, g, h, a, K(31), M(31) );
+ R( a, b, c, d, e, f, g, h, K(32), M(32) );
+ R( h, a, b, c, d, e, f, g, K(33), M(33) );
+ R( g, h, a, b, c, d, e, f, K(34), M(34) );
+ R( f, g, h, a, b, c, d, e, K(35), M(35) );
+ R( e, f, g, h, a, b, c, d, K(36), M(36) );
+ R( d, e, f, g, h, a, b, c, K(37), M(37) );
+ R( c, d, e, f, g, h, a, b, K(38), M(38) );
+ R( b, c, d, e, f, g, h, a, K(39), M(39) );
+ R( a, b, c, d, e, f, g, h, K(40), M(40) );
+ R( h, a, b, c, d, e, f, g, K(41), M(41) );
+ R( g, h, a, b, c, d, e, f, K(42), M(42) );
+ R( f, g, h, a, b, c, d, e, K(43), M(43) );
+ R( e, f, g, h, a, b, c, d, K(44), M(44) );
+ R( d, e, f, g, h, a, b, c, K(45), M(45) );
+ R( c, d, e, f, g, h, a, b, K(46), M(46) );
+ R( b, c, d, e, f, g, h, a, K(47), M(47) );
+ R( a, b, c, d, e, f, g, h, K(48), M(48) );
+ R( h, a, b, c, d, e, f, g, K(49), M(49) );
+ R( g, h, a, b, c, d, e, f, K(50), M(50) );
+ R( f, g, h, a, b, c, d, e, K(51), M(51) );
+ R( e, f, g, h, a, b, c, d, K(52), M(52) );
+ R( d, e, f, g, h, a, b, c, K(53), M(53) );
+ R( c, d, e, f, g, h, a, b, K(54), M(54) );
+ R( b, c, d, e, f, g, h, a, K(55), M(55) );
+ R( a, b, c, d, e, f, g, h, K(56), M(56) );
+ R( h, a, b, c, d, e, f, g, K(57), M(57) );
+ R( g, h, a, b, c, d, e, f, K(58), M(58) );
+ R( f, g, h, a, b, c, d, e, K(59), M(59) );
+ R( e, f, g, h, a, b, c, d, K(60), M(60) );
+ R( d, e, f, g, h, a, b, c, K(61), M(61) );
+ R( c, d, e, f, g, h, a, b, K(62), M(62) );
+ R( b, c, d, e, f, g, h, a, K(63), M(63) );
+
+ a = ctx->state[0] += a;
+ b = ctx->state[1] += b;
+ c = ctx->state[2] += c;
+ d = ctx->state[3] += d;
+ e = ctx->state[4] += e;
+ f = ctx->state[5] += f;
+ g = ctx->state[6] += g;
+ h = ctx->state[7] += h;
+ }
+}
diff --git a/lib/sha256.h b/lib/sha256.h
new file mode 100644
index 00000000000..9f6bf14bf0c
--- /dev/null
+++ b/lib/sha256.h
@@ -0,0 +1,91 @@
+/* Declarations of functions and data types used for SHA256 and SHA224 sum
+ library functions.
+ Copyright (C) 2005-2006, 2008-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/>. */
+
+#ifndef SHA256_H
+# define SHA256_H 1
+
+# include <stdio.h>
+# include <stdint.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+/* Structure to save state of computation between the single steps. */
+struct sha256_ctx
+{
+ uint32_t state[8];
+
+ uint32_t total[2];
+ size_t buflen;
+ uint32_t buffer[32];
+};
+
+enum { SHA224_DIGEST_SIZE = 224 / 8 };
+enum { SHA256_DIGEST_SIZE = 256 / 8 };
+
+/* Initialize structure containing state of computation. */
+extern void sha256_init_ctx (struct sha256_ctx *ctx);
+extern void sha224_init_ctx (struct sha256_ctx *ctx);
+
+/* Starting with the result of former calls of this function (or the
+ initialization function update the context for the next LEN bytes
+ starting at BUFFER.
+ It is necessary that LEN is a multiple of 64!!! */
+extern void sha256_process_block (const void *buffer, size_t len,
+ struct sha256_ctx *ctx);
+
+/* Starting with the result of former calls of this function (or the
+ initialization function update the context for the next LEN bytes
+ starting at BUFFER.
+ It is NOT required that LEN is a multiple of 64. */
+extern void sha256_process_bytes (const void *buffer, size_t len,
+ struct sha256_ctx *ctx);
+
+/* Process the remaining bytes in the buffer and put result from CTX
+ in first 32 (28) bytes following RESBUF. The result is always in little
+ endian byte order, so that a byte-wise output yields to the wanted
+ ASCII representation of the message digest. */
+extern void *sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf);
+extern void *sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf);
+
+
+/* Put result from CTX in first 32 (28) bytes following RESBUF. The result is
+ always in little endian byte order, so that a byte-wise output yields
+ to the wanted ASCII representation of the message digest. */
+extern void *sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf);
+extern void *sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf);
+
+
+/* Compute SHA256 (SHA224) message digest for bytes read from STREAM. The
+ resulting message digest number will be written into the 32 (28) bytes
+ beginning at RESBLOCK. */
+extern int sha256_stream (FILE *stream, void *resblock);
+extern int sha224_stream (FILE *stream, void *resblock);
+
+/* Compute SHA256 (SHA224) message digest for LEN bytes beginning at BUFFER. The
+ result is always in little endian byte order, so that a byte-wise
+ output yields to the wanted ASCII representation of the message
+ digest. */
+extern void *sha256_buffer (const char *buffer, size_t len, void *resblock);
+extern void *sha224_buffer (const char *buffer, size_t len, void *resblock);
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
diff --git a/lib/sha512.c b/lib/sha512.c
new file mode 100644
index 00000000000..c0bed95758f
--- /dev/null
+++ b/lib/sha512.c
@@ -0,0 +1,619 @@
+/* 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.
+
+ 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 Madore, considerably copypasting from
+ Scott G. Miller's sha1.c
+*/
+
+#include <config.h>
+
+#include "sha512.h"
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if USE_UNLOCKED_IO
+# include "unlocked-io.h"
+#endif
+
+#ifdef WORDS_BIGENDIAN
+# define SWAP(n) (n)
+#else
+# define SWAP(n) \
+ u64or (u64or (u64or (u64shl (n, 56), \
+ u64shl (u64and (n, u64lo (0x0000ff00)), 40)), \
+ u64or (u64shl (u64and (n, u64lo (0x00ff0000)), 24), \
+ u64shl (u64and (n, u64lo (0xff000000)), 8))), \
+ u64or (u64or (u64and (u64shr (n, 8), u64lo (0xff000000)), \
+ u64and (u64shr (n, 24), u64lo (0x00ff0000))), \
+ u64or (u64and (u64shr (n, 40), u64lo (0x0000ff00)), \
+ u64shr (n, 56))))
+#endif
+
+#define BLOCKSIZE 32768
+#if BLOCKSIZE % 128 != 0
+# error "invalid BLOCKSIZE"
+#endif
+
+/* This array contains the bytes used to pad the buffer to the next
+ 128-byte boundary. */
+static const unsigned char fillbuf[128] = { 0x80, 0 /* , 0, 0, ... */ };
+
+
+/*
+ Takes a pointer to a 512 bit block of data (eight 64 bit ints) and
+ intializes it to the start constants of the SHA512 algorithm. This
+ must be called before using hash in the call to sha512_hash
+*/
+void
+sha512_init_ctx (struct sha512_ctx *ctx)
+{
+ ctx->state[0] = u64hilo (0x6a09e667, 0xf3bcc908);
+ ctx->state[1] = u64hilo (0xbb67ae85, 0x84caa73b);
+ ctx->state[2] = u64hilo (0x3c6ef372, 0xfe94f82b);
+ ctx->state[3] = u64hilo (0xa54ff53a, 0x5f1d36f1);
+ ctx->state[4] = u64hilo (0x510e527f, 0xade682d1);
+ ctx->state[5] = u64hilo (0x9b05688c, 0x2b3e6c1f);
+ ctx->state[6] = u64hilo (0x1f83d9ab, 0xfb41bd6b);
+ ctx->state[7] = u64hilo (0x5be0cd19, 0x137e2179);
+
+ ctx->total[0] = ctx->total[1] = u64lo (0);
+ ctx->buflen = 0;
+}
+
+void
+sha384_init_ctx (struct sha512_ctx *ctx)
+{
+ ctx->state[0] = u64hilo (0xcbbb9d5d, 0xc1059ed8);
+ ctx->state[1] = u64hilo (0x629a292a, 0x367cd507);
+ ctx->state[2] = u64hilo (0x9159015a, 0x3070dd17);
+ ctx->state[3] = u64hilo (0x152fecd8, 0xf70e5939);
+ ctx->state[4] = u64hilo (0x67332667, 0xffc00b31);
+ ctx->state[5] = u64hilo (0x8eb44a87, 0x68581511);
+ ctx->state[6] = u64hilo (0xdb0c2e0d, 0x64f98fa7);
+ ctx->state[7] = u64hilo (0x47b5481d, 0xbefa4fa4);
+
+ ctx->total[0] = ctx->total[1] = u64lo (0);
+ ctx->buflen = 0;
+}
+
+/* Copy the value from V into the memory location pointed to by *CP,
+ If your architecture allows unaligned access, this is equivalent to
+ * (__typeof__ (v) *) cp = v */
+static inline void
+set_uint64 (char *cp, u64 v)
+{
+ memcpy (cp, &v, sizeof v);
+}
+
+/* Put result from CTX in first 64 bytes following RESBUF.
+ The result must be in little endian byte order. */
+void *
+sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf)
+{
+ int i;
+ char *r = resbuf;
+
+ for (i = 0; i < 8; i++)
+ set_uint64 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
+
+ return resbuf;
+}
+
+void *
+sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf)
+{
+ int i;
+ char *r = resbuf;
+
+ for (i = 0; i < 6; i++)
+ set_uint64 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
+
+ return resbuf;
+}
+
+/* Process the remaining bytes in the internal buffer and the usual
+ prolog according to the standard and write the result to RESBUF. */
+static void
+sha512_conclude_ctx (struct sha512_ctx *ctx)
+{
+ /* Take yet unprocessed bytes into account. */
+ size_t bytes = ctx->buflen;
+ size_t size = (bytes < 112) ? 128 / 8 : 128 * 2 / 8;
+
+ /* Now count remaining bytes. */
+ ctx->total[0] = u64plus (ctx->total[0], u64lo (bytes));
+ if (u64lt (ctx->total[0], u64lo (bytes)))
+ ctx->total[1] = u64plus (ctx->total[1], u64lo (1));
+
+ /* Put the 128-bit file length in *bits* at the end of the buffer.
+ Use set_uint64 rather than a simple assignment, to avoid risk of
+ unaligned access. */
+ set_uint64 ((char *) &ctx->buffer[size - 2],
+ SWAP (u64or (u64shl (ctx->total[1], 3),
+ u64shr (ctx->total[0], 61))));
+ set_uint64 ((char *) &ctx->buffer[size - 1],
+ SWAP (u64shl (ctx->total[0], 3)));
+
+ memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 8 - bytes);
+
+ /* Process last bytes. */
+ sha512_process_block (ctx->buffer, size * 8, ctx);
+}
+
+void *
+sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf)
+{
+ sha512_conclude_ctx (ctx);
+ return sha512_read_ctx (ctx, resbuf);
+}
+
+void *
+sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf)
+{
+ sha512_conclude_ctx (ctx);
+ return sha384_read_ctx (ctx, resbuf);
+}
+
+/* Compute SHA512 message digest for bytes read from STREAM. The
+ resulting message digest number will be written into the 64 bytes
+ beginning at RESBLOCK. */
+int
+sha512_stream (FILE *stream, void *resblock)
+{
+ struct sha512_ctx ctx;
+ size_t sum;
+
+ char *buffer = malloc (BLOCKSIZE + 72);
+ if (!buffer)
+ return 1;
+
+ /* Initialize the computation context. */
+ sha512_init_ctx (&ctx);
+
+ /* Iterate over full file contents. */
+ while (1)
+ {
+ /* We read the file in blocks of BLOCKSIZE bytes. One call of the
+ computation function processes the whole buffer so that with the
+ next round of the loop another block can be read. */
+ size_t n;
+ sum = 0;
+
+ /* Read block. Take care for partial reads. */
+ while (1)
+ {
+ n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
+
+ sum += n;
+
+ if (sum == BLOCKSIZE)
+ break;
+
+ if (n == 0)
+ {
+ /* Check for the error flag IFF N == 0, so that we don't
+ exit the loop after a partial read due to e.g., EAGAIN
+ or EWOULDBLOCK. */
+ if (ferror (stream))
+ {
+ free (buffer);
+ return 1;
+ }
+ goto process_partial_block;
+ }
+
+ /* We've read at least one byte, so ignore errors. But always
+ check for EOF, since feof may be true even though N > 0.
+ Otherwise, we could end up calling fread after EOF. */
+ if (feof (stream))
+ goto process_partial_block;
+ }
+
+ /* Process buffer with BLOCKSIZE bytes. Note that
+ BLOCKSIZE % 128 == 0
+ */
+ sha512_process_block (buffer, BLOCKSIZE, &ctx);
+ }
+
+ process_partial_block:;
+
+ /* Process any remaining bytes. */
+ if (sum > 0)
+ sha512_process_bytes (buffer, sum, &ctx);
+
+ /* Construct result in desired memory. */
+ sha512_finish_ctx (&ctx, resblock);
+ free (buffer);
+ return 0;
+}
+
+/* FIXME: Avoid code duplication */
+int
+sha384_stream (FILE *stream, void *resblock)
+{
+ struct sha512_ctx ctx;
+ size_t sum;
+
+ char *buffer = malloc (BLOCKSIZE + 72);
+ if (!buffer)
+ return 1;
+
+ /* Initialize the computation context. */
+ sha384_init_ctx (&ctx);
+
+ /* Iterate over full file contents. */
+ while (1)
+ {
+ /* We read the file in blocks of BLOCKSIZE bytes. One call of the
+ computation function processes the whole buffer so that with the
+ next round of the loop another block can be read. */
+ size_t n;
+ sum = 0;
+
+ /* Read block. Take care for partial reads. */
+ while (1)
+ {
+ n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
+
+ sum += n;
+
+ if (sum == BLOCKSIZE)
+ break;
+
+ if (n == 0)
+ {
+ /* Check for the error flag IFF N == 0, so that we don't
+ exit the loop after a partial read due to e.g., EAGAIN
+ or EWOULDBLOCK. */
+ if (ferror (stream))
+ {
+ free (buffer);
+ return 1;
+ }
+ goto process_partial_block;
+ }
+
+ /* We've read at least one byte, so ignore errors. But always
+ check for EOF, since feof may be true even though N > 0.
+ Otherwise, we could end up calling fread after EOF. */
+ if (feof (stream))
+ goto process_partial_block;
+ }
+
+ /* Process buffer with BLOCKSIZE bytes. Note that
+ BLOCKSIZE % 128 == 0
+ */
+ sha512_process_block (buffer, BLOCKSIZE, &ctx);
+ }
+
+ process_partial_block:;
+
+ /* Process any remaining bytes. */
+ if (sum > 0)
+ sha512_process_bytes (buffer, sum, &ctx);
+
+ /* Construct result in desired memory. */
+ sha384_finish_ctx (&ctx, resblock);
+ free (buffer);
+ return 0;
+}
+
+/* Compute SHA512 message digest for LEN bytes beginning at BUFFER. The
+ result is always in little endian byte order, so that a byte-wise
+ output yields to the wanted ASCII representation of the message
+ digest. */
+void *
+sha512_buffer (const char *buffer, size_t len, void *resblock)
+{
+ struct sha512_ctx ctx;
+
+ /* Initialize the computation context. */
+ sha512_init_ctx (&ctx);
+
+ /* Process whole buffer but last len % 128 bytes. */
+ sha512_process_bytes (buffer, len, &ctx);
+
+ /* Put result in desired memory area. */
+ return sha512_finish_ctx (&ctx, resblock);
+}
+
+void *
+sha384_buffer (const char *buffer, size_t len, void *resblock)
+{
+ struct sha512_ctx ctx;
+
+ /* Initialize the computation context. */
+ sha384_init_ctx (&ctx);
+
+ /* Process whole buffer but last len % 128 bytes. */
+ sha512_process_bytes (buffer, len, &ctx);
+
+ /* Put result in desired memory area. */
+ return sha384_finish_ctx (&ctx, resblock);
+}
+
+void
+sha512_process_bytes (const void *buffer, size_t len, struct sha512_ctx *ctx)
+{
+ /* When we already have some bits in our internal buffer concatenate
+ both inputs first. */
+ if (ctx->buflen != 0)
+ {
+ size_t left_over = ctx->buflen;
+ size_t add = 256 - left_over > len ? len : 256 - left_over;
+
+ memcpy (&((char *) ctx->buffer)[left_over], buffer, add);
+ ctx->buflen += add;
+
+ if (ctx->buflen > 128)
+ {
+ sha512_process_block (ctx->buffer, ctx->buflen & ~127, ctx);
+
+ ctx->buflen &= 127;
+ /* The regions in the following copy operation cannot overlap. */
+ memcpy (ctx->buffer,
+ &((char *) ctx->buffer)[(left_over + add) & ~127],
+ ctx->buflen);
+ }
+
+ buffer = (const char *) buffer + add;
+ len -= add;
+ }
+
+ /* Process available complete blocks. */
+ 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)
+ if (UNALIGNED_P (buffer))
+ while (len > 128)
+ {
+ sha512_process_block (memcpy (ctx->buffer, buffer, 128), 128, ctx);
+ buffer = (const char *) buffer + 128;
+ len -= 128;
+ }
+ else
+#endif
+ {
+ sha512_process_block (buffer, len & ~127, ctx);
+ buffer = (const char *) buffer + (len & ~127);
+ len &= 127;
+ }
+ }
+
+ /* Move remaining bytes in internal buffer. */
+ if (len > 0)
+ {
+ size_t left_over = ctx->buflen;
+
+ memcpy (&((char *) ctx->buffer)[left_over], buffer, len);
+ left_over += len;
+ if (left_over >= 128)
+ {
+ sha512_process_block (ctx->buffer, 128, ctx);
+ left_over -= 128;
+ memcpy (ctx->buffer, &ctx->buffer[16], left_over);
+ }
+ ctx->buflen = left_over;
+ }
+}
+
+/* --- Code below is the primary difference between sha1.c and sha512.c --- */
+
+/* SHA512 round constants */
+#define K(I) sha512_round_constants[I]
+static u64 const sha512_round_constants[80] = {
+ u64init (0x428a2f98, 0xd728ae22), u64init (0x71374491, 0x23ef65cd),
+ u64init (0xb5c0fbcf, 0xec4d3b2f), u64init (0xe9b5dba5, 0x8189dbbc),
+ u64init (0x3956c25b, 0xf348b538), u64init (0x59f111f1, 0xb605d019),
+ u64init (0x923f82a4, 0xaf194f9b), u64init (0xab1c5ed5, 0xda6d8118),
+ u64init (0xd807aa98, 0xa3030242), u64init (0x12835b01, 0x45706fbe),
+ u64init (0x243185be, 0x4ee4b28c), u64init (0x550c7dc3, 0xd5ffb4e2),
+ u64init (0x72be5d74, 0xf27b896f), u64init (0x80deb1fe, 0x3b1696b1),
+ u64init (0x9bdc06a7, 0x25c71235), u64init (0xc19bf174, 0xcf692694),
+ u64init (0xe49b69c1, 0x9ef14ad2), u64init (0xefbe4786, 0x384f25e3),
+ u64init (0x0fc19dc6, 0x8b8cd5b5), u64init (0x240ca1cc, 0x77ac9c65),
+ u64init (0x2de92c6f, 0x592b0275), u64init (0x4a7484aa, 0x6ea6e483),
+ u64init (0x5cb0a9dc, 0xbd41fbd4), u64init (0x76f988da, 0x831153b5),
+ u64init (0x983e5152, 0xee66dfab), u64init (0xa831c66d, 0x2db43210),
+ u64init (0xb00327c8, 0x98fb213f), u64init (0xbf597fc7, 0xbeef0ee4),
+ u64init (0xc6e00bf3, 0x3da88fc2), u64init (0xd5a79147, 0x930aa725),
+ u64init (0x06ca6351, 0xe003826f), u64init (0x14292967, 0x0a0e6e70),
+ u64init (0x27b70a85, 0x46d22ffc), u64init (0x2e1b2138, 0x5c26c926),
+ u64init (0x4d2c6dfc, 0x5ac42aed), u64init (0x53380d13, 0x9d95b3df),
+ u64init (0x650a7354, 0x8baf63de), u64init (0x766a0abb, 0x3c77b2a8),
+ u64init (0x81c2c92e, 0x47edaee6), u64init (0x92722c85, 0x1482353b),
+ u64init (0xa2bfe8a1, 0x4cf10364), u64init (0xa81a664b, 0xbc423001),
+ u64init (0xc24b8b70, 0xd0f89791), u64init (0xc76c51a3, 0x0654be30),
+ u64init (0xd192e819, 0xd6ef5218), u64init (0xd6990624, 0x5565a910),
+ u64init (0xf40e3585, 0x5771202a), u64init (0x106aa070, 0x32bbd1b8),
+ u64init (0x19a4c116, 0xb8d2d0c8), u64init (0x1e376c08, 0x5141ab53),
+ u64init (0x2748774c, 0xdf8eeb99), u64init (0x34b0bcb5, 0xe19b48a8),
+ u64init (0x391c0cb3, 0xc5c95a63), u64init (0x4ed8aa4a, 0xe3418acb),
+ u64init (0x5b9cca4f, 0x7763e373), u64init (0x682e6ff3, 0xd6b2b8a3),
+ u64init (0x748f82ee, 0x5defb2fc), u64init (0x78a5636f, 0x43172f60),
+ u64init (0x84c87814, 0xa1f0ab72), u64init (0x8cc70208, 0x1a6439ec),
+ u64init (0x90befffa, 0x23631e28), u64init (0xa4506ceb, 0xde82bde9),
+ u64init (0xbef9a3f7, 0xb2c67915), u64init (0xc67178f2, 0xe372532b),
+ u64init (0xca273ece, 0xea26619c), u64init (0xd186b8c7, 0x21c0c207),
+ u64init (0xeada7dd6, 0xcde0eb1e), u64init (0xf57d4f7f, 0xee6ed178),
+ u64init (0x06f067aa, 0x72176fba), u64init (0x0a637dc5, 0xa2c898a6),
+ u64init (0x113f9804, 0xbef90dae), u64init (0x1b710b35, 0x131c471b),
+ u64init (0x28db77f5, 0x23047d84), u64init (0x32caab7b, 0x40c72493),
+ u64init (0x3c9ebe0a, 0x15c9bebc), u64init (0x431d67c4, 0x9c100d4c),
+ u64init (0x4cc5d4be, 0xcb3e42b6), u64init (0x597f299c, 0xfc657e2a),
+ u64init (0x5fcb6fab, 0x3ad6faec), u64init (0x6c44198c, 0x4a475817),
+};
+
+/* Round functions. */
+#define F2(A, B, C) u64or (u64and (A, B), u64and (C, u64or (A, B)))
+#define F1(E, F, G) u64xor (G, u64and (E, u64xor (F, G)))
+
+/* Process LEN bytes of BUFFER, accumulating context into CTX.
+ It is assumed that LEN % 128 == 0.
+ Most of this code comes from GnuPG's cipher/sha1.c. */
+
+void
+sha512_process_block (const void *buffer, size_t len, struct sha512_ctx *ctx)
+{
+ u64 const *words = buffer;
+ u64 const *endp = words + len / sizeof (u64);
+ u64 x[16];
+ u64 a = ctx->state[0];
+ u64 b = ctx->state[1];
+ u64 c = ctx->state[2];
+ u64 d = ctx->state[3];
+ u64 e = ctx->state[4];
+ u64 f = ctx->state[5];
+ u64 g = ctx->state[6];
+ u64 h = ctx->state[7];
+
+ /* 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));
+
+#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)))
+#define SS0(x) u64xor (u64rol (x, 36), u64xor (u64rol (x, 30), u64rol (x, 25)))
+#define SS1(x) u64xor (u64rol(x, 50), u64xor (u64rol (x, 46), u64rol (x, 23)))
+
+#define M(I) (x[(I) & 15] \
+ = u64plus (x[(I) & 15], \
+ u64plus (S1 (x[((I) - 2) & 15]), \
+ u64plus (x[((I) - 7) & 15], \
+ S0 (x[((I) - 15) & 15])))))
+
+#define R(A, B, C, D, E, F, G, H, K, M) \
+ do \
+ { \
+ u64 t0 = u64plus (SS0 (A), F2 (A, B, C)); \
+ u64 t1 = \
+ u64plus (H, u64plus (SS1 (E), \
+ u64plus (F1 (E, F, G), u64plus (K, M)))); \
+ D = u64plus (D, t1); \
+ H = u64plus (t0, t1); \
+ } \
+ while (0)
+
+ while (words < endp)
+ {
+ int t;
+ /* FIXME: see sha1.c for a better implementation. */
+ for (t = 0; t < 16; t++)
+ {
+ x[t] = SWAP (*words);
+ words++;
+ }
+
+ R( a, b, c, d, e, f, g, h, K( 0), x[ 0] );
+ R( h, a, b, c, d, e, f, g, K( 1), x[ 1] );
+ R( g, h, a, b, c, d, e, f, K( 2), x[ 2] );
+ R( f, g, h, a, b, c, d, e, K( 3), x[ 3] );
+ R( e, f, g, h, a, b, c, d, K( 4), x[ 4] );
+ R( d, e, f, g, h, a, b, c, K( 5), x[ 5] );
+ R( c, d, e, f, g, h, a, b, K( 6), x[ 6] );
+ R( b, c, d, e, f, g, h, a, K( 7), x[ 7] );
+ R( a, b, c, d, e, f, g, h, K( 8), x[ 8] );
+ R( h, a, b, c, d, e, f, g, K( 9), x[ 9] );
+ R( g, h, a, b, c, d, e, f, K(10), x[10] );
+ R( f, g, h, a, b, c, d, e, K(11), x[11] );
+ R( e, f, g, h, a, b, c, d, K(12), x[12] );
+ R( d, e, f, g, h, a, b, c, K(13), x[13] );
+ R( c, d, e, f, g, h, a, b, K(14), x[14] );
+ R( b, c, d, e, f, g, h, a, K(15), x[15] );
+ R( a, b, c, d, e, f, g, h, K(16), M(16) );
+ R( h, a, b, c, d, e, f, g, K(17), M(17) );
+ R( g, h, a, b, c, d, e, f, K(18), M(18) );
+ R( f, g, h, a, b, c, d, e, K(19), M(19) );
+ R( e, f, g, h, a, b, c, d, K(20), M(20) );
+ R( d, e, f, g, h, a, b, c, K(21), M(21) );
+ R( c, d, e, f, g, h, a, b, K(22), M(22) );
+ R( b, c, d, e, f, g, h, a, K(23), M(23) );
+ R( a, b, c, d, e, f, g, h, K(24), M(24) );
+ R( h, a, b, c, d, e, f, g, K(25), M(25) );
+ R( g, h, a, b, c, d, e, f, K(26), M(26) );
+ R( f, g, h, a, b, c, d, e, K(27), M(27) );
+ R( e, f, g, h, a, b, c, d, K(28), M(28) );
+ R( d, e, f, g, h, a, b, c, K(29), M(29) );
+ R( c, d, e, f, g, h, a, b, K(30), M(30) );
+ R( b, c, d, e, f, g, h, a, K(31), M(31) );
+ R( a, b, c, d, e, f, g, h, K(32), M(32) );
+ R( h, a, b, c, d, e, f, g, K(33), M(33) );
+ R( g, h, a, b, c, d, e, f, K(34), M(34) );
+ R( f, g, h, a, b, c, d, e, K(35), M(35) );
+ R( e, f, g, h, a, b, c, d, K(36), M(36) );
+ R( d, e, f, g, h, a, b, c, K(37), M(37) );
+ R( c, d, e, f, g, h, a, b, K(38), M(38) );
+ R( b, c, d, e, f, g, h, a, K(39), M(39) );
+ R( a, b, c, d, e, f, g, h, K(40), M(40) );
+ R( h, a, b, c, d, e, f, g, K(41), M(41) );
+ R( g, h, a, b, c, d, e, f, K(42), M(42) );
+ R( f, g, h, a, b, c, d, e, K(43), M(43) );
+ R( e, f, g, h, a, b, c, d, K(44), M(44) );
+ R( d, e, f, g, h, a, b, c, K(45), M(45) );
+ R( c, d, e, f, g, h, a, b, K(46), M(46) );
+ R( b, c, d, e, f, g, h, a, K(47), M(47) );
+ R( a, b, c, d, e, f, g, h, K(48), M(48) );
+ R( h, a, b, c, d, e, f, g, K(49), M(49) );
+ R( g, h, a, b, c, d, e, f, K(50), M(50) );
+ R( f, g, h, a, b, c, d, e, K(51), M(51) );
+ R( e, f, g, h, a, b, c, d, K(52), M(52) );
+ R( d, e, f, g, h, a, b, c, K(53), M(53) );
+ R( c, d, e, f, g, h, a, b, K(54), M(54) );
+ R( b, c, d, e, f, g, h, a, K(55), M(55) );
+ R( a, b, c, d, e, f, g, h, K(56), M(56) );
+ R( h, a, b, c, d, e, f, g, K(57), M(57) );
+ R( g, h, a, b, c, d, e, f, K(58), M(58) );
+ R( f, g, h, a, b, c, d, e, K(59), M(59) );
+ R( e, f, g, h, a, b, c, d, K(60), M(60) );
+ R( d, e, f, g, h, a, b, c, K(61), M(61) );
+ R( c, d, e, f, g, h, a, b, K(62), M(62) );
+ R( b, c, d, e, f, g, h, a, K(63), M(63) );
+ R( a, b, c, d, e, f, g, h, K(64), M(64) );
+ R( h, a, b, c, d, e, f, g, K(65), M(65) );
+ R( g, h, a, b, c, d, e, f, K(66), M(66) );
+ R( f, g, h, a, b, c, d, e, K(67), M(67) );
+ R( e, f, g, h, a, b, c, d, K(68), M(68) );
+ R( d, e, f, g, h, a, b, c, K(69), M(69) );
+ R( c, d, e, f, g, h, a, b, K(70), M(70) );
+ R( b, c, d, e, f, g, h, a, K(71), M(71) );
+ R( a, b, c, d, e, f, g, h, K(72), M(72) );
+ R( h, a, b, c, d, e, f, g, K(73), M(73) );
+ R( g, h, a, b, c, d, e, f, K(74), M(74) );
+ R( f, g, h, a, b, c, d, e, K(75), M(75) );
+ R( e, f, g, h, a, b, c, d, K(76), M(76) );
+ R( d, e, f, g, h, a, b, c, K(77), M(77) );
+ R( c, d, e, f, g, h, a, b, K(78), M(78) );
+ R( b, c, d, e, f, g, h, a, K(79), M(79) );
+
+ a = ctx->state[0] = u64plus (ctx->state[0], a);
+ b = ctx->state[1] = u64plus (ctx->state[1], b);
+ c = ctx->state[2] = u64plus (ctx->state[2], c);
+ d = ctx->state[3] = u64plus (ctx->state[3], d);
+ e = ctx->state[4] = u64plus (ctx->state[4], e);
+ f = ctx->state[5] = u64plus (ctx->state[5], f);
+ g = ctx->state[6] = u64plus (ctx->state[6], g);
+ h = ctx->state[7] = u64plus (ctx->state[7], h);
+ }
+}
diff --git a/lib/sha512.h b/lib/sha512.h
new file mode 100644
index 00000000000..af8b354ebd0
--- /dev/null
+++ b/lib/sha512.h
@@ -0,0 +1,95 @@
+/* Declarations of functions and data types used for SHA512 and SHA384 sum
+ library functions.
+ Copyright (C) 2005-2006, 2008-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/>. */
+
+#ifndef SHA512_H
+# define SHA512_H 1
+
+# include <stdio.h>
+
+# include "u64.h"
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+/* Structure to save state of computation between the single steps. */
+struct sha512_ctx
+{
+ u64 state[8];
+
+ u64 total[2];
+ size_t buflen;
+ u64 buffer[32];
+};
+
+enum { SHA384_DIGEST_SIZE = 384 / 8 };
+enum { SHA512_DIGEST_SIZE = 512 / 8 };
+
+/* Initialize structure containing state of computation. */
+extern void sha512_init_ctx (struct sha512_ctx *ctx);
+extern void sha384_init_ctx (struct sha512_ctx *ctx);
+
+/* Starting with the result of former calls of this function (or the
+ initialization function update the context for the next LEN bytes
+ starting at BUFFER.
+ It is necessary that LEN is a multiple of 128!!! */
+extern void sha512_process_block (const void *buffer, size_t len,
+ struct sha512_ctx *ctx);
+
+/* Starting with the result of former calls of this function (or the
+ initialization function update the context for the next LEN bytes
+ starting at BUFFER.
+ It is NOT required that LEN is a multiple of 128. */
+extern void sha512_process_bytes (const void *buffer, size_t len,
+ struct sha512_ctx *ctx);
+
+/* Process the remaining bytes in the buffer and put result from CTX
+ in first 64 (48) bytes following RESBUF. The result is always in little
+ endian byte order, so that a byte-wise output yields to the wanted
+ ASCII representation of the message digest. */
+extern void *sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
+extern void *sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
+
+
+/* Put result from CTX in first 64 (48) bytes following RESBUF. The result is
+ always in little endian byte order, so that a byte-wise output yields
+ to the wanted ASCII representation of the message digest.
+
+ IMPORTANT: On some systems it is required that RESBUF is correctly
+ aligned for a 32 bits value. */
+extern void *sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf);
+extern void *sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf);
+
+
+/* Compute SHA512 (SHA384) message digest for bytes read from STREAM. The
+ resulting message digest number will be written into the 64 (48) bytes
+ beginning at RESBLOCK. */
+extern int sha512_stream (FILE *stream, void *resblock);
+extern int sha384_stream (FILE *stream, void *resblock);
+
+/* Compute SHA512 (SHA384) message digest for LEN bytes beginning at BUFFER. The
+ result is always in little endian byte order, so that a byte-wise
+ output yields to the wanted ASCII representation of the message
+ digest. */
+extern void *sha512_buffer (const char *buffer, size_t len, void *resblock);
+extern void *sha384_buffer (const char *buffer, size_t len, void *resblock);
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif
diff --git a/lib/signal.in.h b/lib/signal.in.h
new file mode 100644
index 00000000000..93787f753fa
--- /dev/null
+++ b/lib/signal.in.h
@@ -0,0 +1,428 @@
+/* A GNU-like <signal.h>.
+
+ Copyright (C) 2006-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/>. */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#if defined __need_sig_atomic_t || defined __need_sigset_t || defined _GL_ALREADY_INCLUDING_SIGNAL_H || (defined _SIGNAL_H && !defined __SIZEOF_PTHREAD_MUTEX_T)
+/* Special invocation convention:
+ - Inside glibc header files.
+ - On glibc systems we have a sequence of nested includes
+ <signal.h> -> <ucontext.h> -> <signal.h>.
+ In this situation, the functions are not yet declared, therefore we cannot
+ provide the C++ aliases.
+ - On glibc systems with GCC 4.3 we have a sequence of nested includes
+ <csignal> -> </usr/include/signal.h> -> <sys/ucontext.h> -> <signal.h>.
+ In this situation, some of the functions are not yet declared, therefore
+ we cannot provide the C++ aliases. */
+
+# @INCLUDE_NEXT@ @NEXT_SIGNAL_H@
+
+#else
+/* Normal invocation convention. */
+
+#ifndef _@GUARD_PREFIX@_SIGNAL_H
+
+#define _GL_ALREADY_INCLUDING_SIGNAL_H
+
+/* Define pid_t, uid_t.
+ Also, mingw defines sigset_t not in <signal.h>, but in <sys/types.h>.
+ On Solaris 10, <signal.h> includes <sys/types.h>, which eventually includes
+ us; so include <sys/types.h> now, before the second inclusion guard. */
+#include <sys/types.h>
+
+/* The include_next requires a split double-inclusion guard. */
+#@INCLUDE_NEXT@ @NEXT_SIGNAL_H@
+
+#undef _GL_ALREADY_INCLUDING_SIGNAL_H
+
+#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
+ pthread_sigmask in <pthread.h>, not in <signal.h>.
+ But avoid namespace pollution on glibc systems.*/
+#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
+ && ((defined __APPLE__ && defined __MACH__) || defined __FreeBSD__ || defined __OpenBSD__ || defined __osf__ || defined __sun) \
+ && ! defined __GLIBC__
+# include <pthread.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. */
+
+/* On AIX, sig_atomic_t already includes volatile. C99 requires that
+ 'volatile sig_atomic_t' ignore the extra modifier, but C89 did not.
+ Hence, redefine this to a non-volatile type as needed. */
+#if ! @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@
+# if !GNULIB_defined_sig_atomic_t
+typedef int rpl_sig_atomic_t;
+# undef sig_atomic_t
+# define sig_atomic_t rpl_sig_atomic_t
+# define GNULIB_defined_sig_atomic_t 1
+# endif
+#endif
+
+/* A set or mask of signals. */
+#if !@HAVE_SIGSET_T@
+# if !GNULIB_defined_sigset_t
+typedef unsigned int sigset_t;
+# define GNULIB_defined_sigset_t 1
+# endif
+#endif
+
+/* Define sighandler_t, the type of signal handlers. A GNU extension. */
+#if !@HAVE_SIGHANDLER_T@
+# ifdef __cplusplus
+extern "C" {
+# endif
+# if !GNULIB_defined_sighandler_t
+typedef void (*sighandler_t) (int);
+# define GNULIB_defined_sighandler_t 1
+# endif
+# ifdef __cplusplus
+}
+# endif
+#endif
+
+
+#if @GNULIB_SIGNAL_H_SIGPIPE@
+# ifndef SIGPIPE
+/* Define SIGPIPE to a value that does not overlap with other signals. */
+# define SIGPIPE 13
+# define GNULIB_defined_SIGPIPE 1
+/* To actually use SIGPIPE, you also need the gnulib modules 'sigprocmask',
+ 'write', 'stdio'. */
+# endif
+#endif
+
+
+/* Maximum signal number + 1. */
+#ifndef NSIG
+# if defined __TANDEM
+# define NSIG 32
+# endif
+#endif
+
+
+#if @GNULIB_PTHREAD_SIGMASK@
+# if @REPLACE_PTHREAD_SIGMASK@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef pthread_sigmask
+# define pthread_sigmask rpl_pthread_sigmask
+# endif
+_GL_FUNCDECL_RPL (pthread_sigmask, int,
+ (int how, const sigset_t *new_mask, sigset_t *old_mask));
+_GL_CXXALIAS_RPL (pthread_sigmask, int,
+ (int how, const sigset_t *new_mask, sigset_t *old_mask));
+# else
+# if !@HAVE_PTHREAD_SIGMASK@
+_GL_FUNCDECL_SYS (pthread_sigmask, int,
+ (int how, const sigset_t *new_mask, sigset_t *old_mask));
+# endif
+_GL_CXXALIAS_SYS (pthread_sigmask, int,
+ (int how, const sigset_t *new_mask, sigset_t *old_mask));
+# endif
+_GL_CXXALIASWARN (pthread_sigmask);
+#elif defined GNULIB_POSIXCHECK
+# undef pthread_sigmask
+# if HAVE_RAW_DECL_PTHREAD_SIGMASK
+_GL_WARN_ON_USE (pthread_sigmask, "pthread_sigmask is not portable - "
+ "use gnulib module pthread_sigmask for portability");
+# endif
+#endif
+
+
+#if @GNULIB_SIGPROCMASK@
+# if !@HAVE_POSIX_SIGNALBLOCKING@
+
+/* Maximum signal number + 1. */
+# ifndef NSIG
+# define NSIG 32
+# endif
+
+/* This code supports only 32 signals. */
+# if !GNULIB_defined_verify_NSIG_constraint
+typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1];
+# define GNULIB_defined_verify_NSIG_constraint 1
+# endif
+
+# endif
+
+/* 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. */
+# if defined __cplusplus && defined GNULIB_NAMESPACE
+# undef sigismember
+# endif
+# else
+_GL_FUNCDECL_SYS (sigismember, int, (const sigset_t *set, int sig)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (sigismember, int, (const sigset_t *set, int sig));
+_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. */
+# if defined __cplusplus && defined GNULIB_NAMESPACE
+# undef sigemptyset
+# endif
+# else
+_GL_FUNCDECL_SYS (sigemptyset, int, (sigset_t *set) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (sigemptyset, int, (sigset_t *set));
+_GL_CXXALIASWARN (sigemptyset);
+
+/* Add a signal to a signal set. */
+# if @HAVE_POSIX_SIGNALBLOCKING@
+/* This function is defined as a macro on MacOS X. */
+# if defined __cplusplus && defined GNULIB_NAMESPACE
+# undef sigaddset
+# endif
+# else
+_GL_FUNCDECL_SYS (sigaddset, int, (sigset_t *set, int sig)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (sigaddset, int, (sigset_t *set, int sig));
+_GL_CXXALIASWARN (sigaddset);
+
+/* Remove a signal from a signal set. */
+# if @HAVE_POSIX_SIGNALBLOCKING@
+/* This function is defined as a macro on MacOS X. */
+# if defined __cplusplus && defined GNULIB_NAMESPACE
+# undef sigdelset
+# endif
+# else
+_GL_FUNCDECL_SYS (sigdelset, int, (sigset_t *set, int sig)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (sigdelset, int, (sigset_t *set, int sig));
+_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. */
+# if defined __cplusplus && defined GNULIB_NAMESPACE
+# undef sigfillset
+# endif
+# else
+_GL_FUNCDECL_SYS (sigfillset, int, (sigset_t *set) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (sigfillset, int, (sigset_t *set));
+_GL_CXXALIASWARN (sigfillset);
+
+/* Return the set of those blocked signals that are pending. */
+# if !@HAVE_POSIX_SIGNALBLOCKING@
+_GL_FUNCDECL_SYS (sigpending, int, (sigset_t *set) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (sigpending, int, (sigset_t *set));
+_GL_CXXALIASWARN (sigpending);
+
+/* If OLD_SET is not NULL, put the current set of blocked signals in *OLD_SET.
+ Then, if SET is not NULL, affect the current set of blocked signals by
+ combining it with *SET as indicated in OPERATION.
+ In this implementation, you are not allowed to change a signal handler
+ while the signal is blocked. */
+# if !@HAVE_POSIX_SIGNALBLOCKING@
+# define SIG_BLOCK 0 /* blocked_set = blocked_set | *set; */
+# define SIG_SETMASK 1 /* blocked_set = *set; */
+# define SIG_UNBLOCK 2 /* blocked_set = blocked_set & ~*set; */
+_GL_FUNCDECL_SYS (sigprocmask, int,
+ (int operation, const sigset_t *set, sigset_t *old_set));
+# endif
+_GL_CXXALIAS_SYS (sigprocmask, int,
+ (int operation, const sigset_t *set, sigset_t *old_set));
+_GL_CXXALIASWARN (sigprocmask);
+
+/* Install the handler FUNC for signal SIG, and return the previous
+ handler. */
+# ifdef __cplusplus
+extern "C" {
+# endif
+# if !GNULIB_defined_function_taking_int_returning_void_t
+typedef void (*_gl_function_taking_int_returning_void_t) (int);
+# define GNULIB_defined_function_taking_int_returning_void_t 1
+# endif
+# ifdef __cplusplus
+}
+# endif
+# if !@HAVE_POSIX_SIGNALBLOCKING@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# define signal rpl_signal
+# endif
+_GL_FUNCDECL_RPL (signal, _gl_function_taking_int_returning_void_t,
+ (int sig, _gl_function_taking_int_returning_void_t func));
+_GL_CXXALIAS_RPL (signal, _gl_function_taking_int_returning_void_t,
+ (int sig, _gl_function_taking_int_returning_void_t func));
+# else
+_GL_CXXALIAS_SYS (signal, _gl_function_taking_int_returning_void_t,
+ (int sig, _gl_function_taking_int_returning_void_t func));
+# endif
+_GL_CXXALIASWARN (signal);
+
+/* Raise signal SIG. */
+# if !@HAVE_POSIX_SIGNALBLOCKING@ && GNULIB_defined_SIGPIPE
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef raise
+# define raise rpl_raise
+# endif
+_GL_FUNCDECL_RPL (raise, int, (int sig));
+_GL_CXXALIAS_RPL (raise, int, (int sig));
+# else
+_GL_CXXALIAS_SYS (raise, int, (int sig));
+# endif
+_GL_CXXALIASWARN (raise);
+
+#elif defined GNULIB_POSIXCHECK
+# undef sigaddset
+# if HAVE_RAW_DECL_SIGADDSET
+_GL_WARN_ON_USE (sigaddset, "sigaddset is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+# undef sigdelset
+# if HAVE_RAW_DECL_SIGDELSET
+_GL_WARN_ON_USE (sigdelset, "sigdelset is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+# undef sigemptyset
+# if HAVE_RAW_DECL_SIGEMPTYSET
+_GL_WARN_ON_USE (sigemptyset, "sigemptyset is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+# undef sigfillset
+# if HAVE_RAW_DECL_SIGFILLSET
+_GL_WARN_ON_USE (sigfillset, "sigfillset is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+# undef sigismember
+# if HAVE_RAW_DECL_SIGISMEMBER
+_GL_WARN_ON_USE (sigismember, "sigismember is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+# undef sigpending
+# if HAVE_RAW_DECL_SIGPENDING
+_GL_WARN_ON_USE (sigpending, "sigpending is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+# undef sigprocmask
+# if HAVE_RAW_DECL_SIGPROCMASK
+_GL_WARN_ON_USE (sigprocmask, "sigprocmask is unportable - "
+ "use the gnulib module sigprocmask for portability");
+# endif
+#endif /* @GNULIB_SIGPROCMASK@ */
+
+
+#if @GNULIB_SIGACTION@
+# if !@HAVE_SIGACTION@
+
+# if !@HAVE_SIGINFO_T@
+
+# if !GNULIB_defined_siginfo_types
+
+/* Present to allow compilation, but unsupported by gnulib. */
+union sigval
+{
+ int sival_int;
+ void *sival_ptr;
+};
+
+/* Present to allow compilation, but unsupported by gnulib. */
+struct siginfo_t
+{
+ int si_signo;
+ int si_code;
+ int si_errno;
+ pid_t si_pid;
+ uid_t si_uid;
+ void *si_addr;
+ int si_status;
+ long si_band;
+ union sigval si_value;
+};
+typedef struct siginfo_t siginfo_t;
+
+# define GNULIB_defined_siginfo_types 1
+# endif
+
+# endif /* !@HAVE_SIGINFO_T@ */
+
+/* We assume that platforms which lack the sigaction() function also lack
+ the 'struct sigaction' type, and vice versa. */
+
+# if !GNULIB_defined_struct_sigaction
+
+struct sigaction
+{
+ union
+ {
+ void (*_sa_handler) (int);
+ /* Present to allow compilation, but unsupported by gnulib. POSIX
+ says that implementations may, but not must, make sa_sigaction
+ overlap with sa_handler, but we know of no implementation where
+ they do not overlap. */
+ void (*_sa_sigaction) (int, siginfo_t *, void *);
+ } _sa_func;
+ sigset_t sa_mask;
+ /* Not all POSIX flags are supported. */
+ int sa_flags;
+};
+# define sa_handler _sa_func._sa_handler
+# define sa_sigaction _sa_func._sa_sigaction
+/* Unsupported flags are not present. */
+# define SA_RESETHAND 1
+# define SA_NODEFER 2
+# define SA_RESTART 4
+
+# define GNULIB_defined_struct_sigaction 1
+# endif
+
+_GL_FUNCDECL_SYS (sigaction, int, (int, const struct sigaction *restrict,
+ struct sigaction *restrict));
+
+# elif !@HAVE_STRUCT_SIGACTION_SA_SIGACTION@
+
+# define sa_sigaction sa_handler
+
+# endif /* !@HAVE_SIGACTION@, !@HAVE_STRUCT_SIGACTION_SA_SIGACTION@ */
+
+_GL_CXXALIAS_SYS (sigaction, int, (int, const struct sigaction *restrict,
+ struct sigaction *restrict));
+_GL_CXXALIASWARN (sigaction);
+
+#elif defined GNULIB_POSIXCHECK
+# undef sigaction
+# if HAVE_RAW_DECL_SIGACTION
+_GL_WARN_ON_USE (sigaction, "sigaction is unportable - "
+ "use the gnulib module sigaction for portability");
+# endif
+#endif
+
+/* Some systems don't have SA_NODEFER. */
+#ifndef SA_NODEFER
+# define SA_NODEFER 0
+#endif
+
+
+#endif /* _@GUARD_PREFIX@_SIGNAL_H */
+#endif /* _@GUARD_PREFIX@_SIGNAL_H */
+#endif
diff --git a/lib/sigprocmask.c b/lib/sigprocmask.c
new file mode 100644
index 00000000000..6780a37b14f
--- /dev/null
+++ b/lib/sigprocmask.c
@@ -0,0 +1,329 @@
+/* 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>
+
+/* 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);
+
+/* 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);
+ }
+}
+# 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 SIG. */
+int
+rpl_raise (int sig)
+# undef raise
+{
+ switch (sig)
+ {
+ case SIGPIPE:
+ if (blocked_set & (1U << sig))
+ pending_array[sig] = 1;
+ else
+ {
+ handler_t handler = SIGPIPE_handler;
+ if (handler == SIG_DFL)
+ exit (128 + SIGPIPE);
+ else if (handler != SIG_IGN)
+ (*handler) (sig);
+ }
+ return 0;
+ default: /* System defined signal */
+ return raise (sig);
+ }
+}
+#endif
diff --git a/lib/stat.c b/lib/stat.c
index cbc9100fd4d..f07370dd06b 100644
--- a/lib/stat.c
+++ b/lib/stat.c
@@ -38,6 +38,7 @@ orig_stat (const char *filename, struct stat *buf)
#include <stdbool.h>
#include <string.h>
#include "dosname.h"
+#include "verify.h"
/* Store information about NAME into ST. Work around bugs with
trailing slashes. Mingw has other bugs (such as st_ino always
@@ -63,6 +64,12 @@ rpl_stat (char const *name, struct stat *st)
}
#endif /* REPLACE_FUNC_STAT_FILE */
#if REPLACE_FUNC_STAT_DIR
+ /* The only known systems where REPLACE_FUNC_STAT_DIR is needed also
+ have a constant PATH_MAX. */
+# ifndef PATH_MAX
+# error "Please port this replacement to your platform"
+# endif
+
if (result == -1 && errno == ENOENT)
{
/* Due to mingw's oddities, there are some directories (like
@@ -77,6 +84,7 @@ rpl_stat (char const *name, struct stat *st)
char fixed_name[PATH_MAX + 1] = {0};
size_t len = strlen (name);
bool check_dir = false;
+ verify (PATH_MAX <= 4096);
if (PATH_MAX <= len)
errno = ENAMETOOLONG;
else if (len)
diff --git a/lib/stdarg.in.h b/lib/stdarg.in.h
index 4469d54e4f4..43f96070708 100644
--- a/lib/stdarg.in.h
+++ b/lib/stdarg.in.h
@@ -15,7 +15,7 @@
along with this program; if not, write to the Free Software Foundation,
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
-#ifndef _GL_STDARG_H
+#ifndef _@GUARD_PREFIX@_STDARG_H
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -25,12 +25,12 @@
/* The include_next requires a split double-inclusion guard. */
#@INCLUDE_NEXT@ @NEXT_STDARG_H@
-#ifndef _GL_STDARG_H
-#define _GL_STDARG_H
+#ifndef _@GUARD_PREFIX@_STDARG_H
+#define _@GUARD_PREFIX@_STDARG_H
#ifndef va_copy
# define va_copy(a,b) ((a) = (b))
#endif
-#endif /* _GL_STDARG_H */
-#endif /* _GL_STDARG_H */
+#endif /* _@GUARD_PREFIX@_STDARG_H */
+#endif /* _@GUARD_PREFIX@_STDARG_H */
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index 62a91a7a6a3..c7b98e7dcc5 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -38,9 +38,9 @@
remember if special invocation has ever been used to obtain wint_t,
in which case we need to clean up NULL yet again. */
-# if !(defined _GL_STDDEF_H && defined _GL_STDDEF_WINT_T)
+# if !(defined _@GUARD_PREFIX@_STDDEF_H && defined _GL_STDDEF_WINT_T)
# ifdef __need_wint_t
-# undef _GL_STDDEF_H
+# undef _@GUARD_PREFIX@_STDDEF_H
# define _GL_STDDEF_WINT_T
# endif
# @INCLUDE_NEXT@ @NEXT_STDDEF_H@
@@ -49,14 +49,14 @@
#else
/* Normal invocation convention. */
-# ifndef _GL_STDDEF_H
+# ifndef _@GUARD_PREFIX@_STDDEF_H
/* The include_next requires a split double-inclusion guard. */
# @INCLUDE_NEXT@ @NEXT_STDDEF_H@
-# ifndef _GL_STDDEF_H
-# define _GL_STDDEF_H
+# ifndef _@GUARD_PREFIX@_STDDEF_H
+# define _@GUARD_PREFIX@_STDDEF_H
/* On NetBSD 5.0, the definition of NULL lacks proper parentheses. */
#if @REPLACE_NULL@
@@ -82,6 +82,6 @@
# define wchar_t int
#endif
-# endif /* _GL_STDDEF_H */
-# endif /* _GL_STDDEF_H */
+# endif /* _@GUARD_PREFIX@_STDDEF_H */
+# endif /* _@GUARD_PREFIX@_STDDEF_H */
#endif /* __need_XXX */
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index b32227bb04c..b6d08c754ae 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -21,7 +21,7 @@
* <http://www.opengroup.org/susv3xbd/stdint.h.html>
*/
-#ifndef _GL_STDINT_H
+#ifndef _@GUARD_PREFIX@_STDINT_H
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -52,13 +52,13 @@
/* 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
- _GL_STDINT_H is defined.
+ _@GUARD_PREFIX@_STDINT_H is defined.
The include_next requires a split double-inclusion guard. */
# @INCLUDE_NEXT@ @NEXT_STDINT_H@
#endif
-#if ! defined _GL_STDINT_H && ! defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H
-#define _GL_STDINT_H
+#if ! defined _@GUARD_PREFIX@_STDINT_H && ! defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H
+#define _@GUARD_PREFIX@_STDINT_H
/* <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>).
@@ -93,7 +93,7 @@
#undef _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
-/* Minimum and maximum values for a integer type under the usual assumption.
+/* Minimum and maximum values for an integer type under the usual assumption.
Return an unspecified value if BITS == 0, adding a check to pacify
picky compilers. */
@@ -270,26 +270,36 @@ typedef unsigned long int gl_uintptr_t;
/* Note: These types are compiler dependent. It may be unwise to use them in
public header files. */
-#undef intmax_t
-#if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+/* If the system defines INTMAX_MAX, assume that intmax_t works, and
+ similarly for UINTMAX_MAX and uintmax_t. This avoids problems with
+ assuming one type where another is used by the system. */
+
+#ifndef INTMAX_MAX
+# undef INTMAX_C
+# undef intmax_t
+# if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
typedef long long int gl_intmax_t;
-# define intmax_t gl_intmax_t
-#elif defined GL_INT64_T
-# define intmax_t int64_t
-#else
+# define intmax_t gl_intmax_t
+# elif defined GL_INT64_T
+# define intmax_t int64_t
+# else
typedef long int gl_intmax_t;
-# define intmax_t gl_intmax_t
+# define intmax_t gl_intmax_t
+# endif
#endif
-#undef uintmax_t
-#if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+#ifndef UINTMAX_MAX
+# undef UINTMAX_C
+# undef uintmax_t
+# if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
typedef unsigned long long int gl_uintmax_t;
-# define uintmax_t gl_uintmax_t
-#elif defined GL_UINT64_T
-# define uintmax_t uint64_t
-#else
+# define uintmax_t gl_uintmax_t
+# elif defined GL_UINT64_T
+# define uintmax_t uint64_t
+# else
typedef unsigned long int gl_uintmax_t;
-# define uintmax_t gl_uintmax_t
+# define uintmax_t gl_uintmax_t
+# endif
#endif
/* Verify that intmax_t and uintmax_t have the same size. Too much code
@@ -431,21 +441,23 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
/* 7.18.2.5. Limits of greatest-width integer types */
-#undef INTMAX_MIN
-#undef INTMAX_MAX
-#ifdef INT64_MAX
-# define INTMAX_MIN INT64_MIN
-# define INTMAX_MAX INT64_MAX
-#else
-# define INTMAX_MIN INT32_MIN
-# define INTMAX_MAX INT32_MAX
+#ifndef INTMAX_MAX
+# undef INTMAX_MIN
+# ifdef INT64_MAX
+# define INTMAX_MIN INT64_MIN
+# define INTMAX_MAX INT64_MAX
+# else
+# define INTMAX_MIN INT32_MIN
+# define INTMAX_MAX INT32_MAX
+# endif
#endif
-#undef UINTMAX_MAX
-#ifdef UINT64_MAX
-# define UINTMAX_MAX UINT64_MAX
-#else
-# define UINTMAX_MAX UINT32_MAX
+#ifndef UINTMAX_MAX
+# ifdef UINT64_MAX
+# define UINTMAX_MAX UINT64_MAX
+# else
+# define UINTMAX_MAX UINT32_MAX
+# endif
#endif
/* 7.18.3. Limits of other integer types */
@@ -568,25 +580,27 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
/* 7.18.4.2. Macros for greatest-width integer constants */
-#undef INTMAX_C
-#if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
-# define INTMAX_C(x) x##LL
-#elif defined GL_INT64_T
-# define INTMAX_C(x) INT64_C(x)
-#else
-# define INTMAX_C(x) x##L
+#ifndef INTMAX_C
+# if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# define INTMAX_C(x) x##LL
+# elif defined GL_INT64_T
+# define INTMAX_C(x) INT64_C(x)
+# else
+# define INTMAX_C(x) x##L
+# endif
#endif
-#undef UINTMAX_C
-#if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
-# define UINTMAX_C(x) x##ULL
-#elif defined GL_UINT64_T
-# define UINTMAX_C(x) UINT64_C(x)
-#else
-# define UINTMAX_C(x) x##UL
+#ifndef UINTMAX_C
+# if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# define UINTMAX_C(x) x##ULL
+# elif defined GL_UINT64_T
+# define UINTMAX_C(x) UINT64_C(x)
+# else
+# define UINTMAX_C(x) x##UL
+# endif
#endif
#endif /* !defined __cplusplus || defined __STDC_CONSTANT_MACROS */
-#endif /* _GL_STDINT_H */
-#endif /* !defined _GL_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */
+#endif /* _@GUARD_PREFIX@_STDINT_H */
+#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 0b85d0c28cc..473c84ce3e4 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -35,7 +35,7 @@
#else
/* Normal invocation convention. */
-#ifndef _GL_STDIO_H
+#ifndef _@GUARD_PREFIX@_STDIO_H
#define _GL_ALREADY_INCLUDING_STDIO_H
@@ -44,8 +44,8 @@
#undef _GL_ALREADY_INCLUDING_STDIO_H
-#ifndef _GL_STDIO_H
-#define _GL_STDIO_H
+#ifndef _@GUARD_PREFIX@_STDIO_H
+#define _@GUARD_PREFIX@_STDIO_H
/* Get va_list. Needed on many systems, including glibc 2.8. */
#include <stdarg.h>
@@ -461,25 +461,6 @@ _GL_FUNCDECL_SYS (fseeko, int, (FILE *fp, off_t offset, int whence)
_GL_CXXALIAS_SYS (fseeko, int, (FILE *fp, off_t offset, int whence));
# endif
_GL_CXXALIASWARN (fseeko);
-# if (@REPLACE_FSEEKO@ || !@HAVE_FSEEKO@) && !@GNULIB_FSEEK@
- /* Provide an fseek function that is consistent with fseeko. */
- /* In order to avoid that fseek gets defined as a macro here, the
- developer can request the 'fseek' module. */
-# if !GNULIB_defined_fseek_function
-# undef fseek
-# define fseek rpl_fseek
-static inline int _GL_ARG_NONNULL ((1))
-rpl_fseek (FILE *fp, long offset, int whence)
-{
-# if @REPLACE_FSEEKO@
- return rpl_fseeko (fp, offset, whence);
-# else
- return fseeko (fp, offset, whence);
-# endif
-}
-# define GNULIB_defined_fseek_function 1
-# endif
-# endif
#elif defined GNULIB_POSIXCHECK
# define _GL_FSEEK_WARN /* Category 1, above. */
# undef fseek
@@ -539,25 +520,6 @@ _GL_FUNCDECL_SYS (ftello, off_t, (FILE *fp) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_SYS (ftello, off_t, (FILE *fp));
# endif
_GL_CXXALIASWARN (ftello);
-# if (@REPLACE_FTELLO@ || !@HAVE_FTELLO@) && !@GNULIB_FTELL@
- /* Provide an ftell function that is consistent with ftello. */
- /* In order to avoid that ftell gets defined as a macro here, the
- developer can request the 'ftell' module. */
-# if !GNULIB_defined_ftell_function
-# undef ftell
-# define ftell rpl_ftell
-static inline long _GL_ARG_NONNULL ((1))
-rpl_ftell (FILE *f)
-{
-# if @REPLACE_FTELLO@
- return rpl_ftello (f);
-# else
- return ftello (f);
-# endif
-}
-# define GNULIB_defined_ftell_function 1
-# endif
-# endif
#elif defined GNULIB_POSIXCHECK
# define _GL_FTELL_WARN /* Category 1, above. */
# undef ftell
@@ -1345,6 +1307,6 @@ _GL_WARN_ON_USE (vsprintf, "vsprintf is not always POSIX compliant - "
#endif
-#endif /* _GL_STDIO_H */
-#endif /* _GL_STDIO_H */
+#endif /* _@GUARD_PREFIX@_STDIO_H */
+#endif /* _@GUARD_PREFIX@_STDIO_H */
#endif
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 7513553b672..62a2ce920e6 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -28,13 +28,13 @@
#else
/* Normal invocation convention. */
-#ifndef _GL_STDLIB_H
+#ifndef _@GUARD_PREFIX@_STDLIB_H
/* The include_next requires a split double-inclusion guard. */
#@INCLUDE_NEXT@ @NEXT_STDLIB_H@
-#ifndef _GL_STDLIB_H
-#define _GL_STDLIB_H
+#ifndef _@GUARD_PREFIX@_STDLIB_H
+#define _@GUARD_PREFIX@_STDLIB_H
/* NetBSD 5.0 mis-defines NULL. */
#include <stddef.h>
@@ -761,6 +761,6 @@ _GL_CXXALIASWARN (wctomb);
#endif
-#endif /* _GL_STDLIB_H */
-#endif /* _GL_STDLIB_H */
+#endif /* _@GUARD_PREFIX@_STDLIB_H */
+#endif /* _@GUARD_PREFIX@_STDLIB_H */
#endif
diff --git a/lib/strtoll.c b/lib/strtoll.c
new file mode 100644
index 00000000000..75afa4d9bc9
--- /dev/null
+++ b/lib/strtoll.c
@@ -0,0 +1,33 @@
+/* Function to parse a `long long int' from text.
+ Copyright (C) 1995-1997, 1999, 2001, 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/>. */
+
+#define QUAD 1
+
+#include <strtol.c>
+
+#ifdef _LIBC
+# ifdef SHARED
+# include <shlib-compat.h>
+
+# if SHLIB_COMPAT (libc, GLIBC_2_0, GLIBC_2_2)
+compat_symbol (libc, __strtoll_internal, __strtoq_internal, GLIBC_2_0);
+# endif
+
+# endif
+weak_alias (strtoll, strtoq)
+#endif
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 13fae7b6703..5acee705f8a 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -34,7 +34,7 @@
#else
/* Normal invocation convention. */
-#ifndef _GL_SYS_STAT_H
+#ifndef _@GUARD_PREFIX@_SYS_STAT_H
/* Get nlink_t. */
#include <sys/types.h>
@@ -45,8 +45,8 @@
/* The include_next requires a split double-inclusion guard. */
#@INCLUDE_NEXT@ @NEXT_SYS_STAT_H@
-#ifndef _GL_SYS_STAT_H
-#define _GL_SYS_STAT_H
+#ifndef _@GUARD_PREFIX@_SYS_STAT_H
+#define _@GUARD_PREFIX@_SYS_STAT_H
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
@@ -653,6 +653,6 @@ _GL_WARN_ON_USE (utimensat, "utimensat is not portable - "
#endif
-#endif /* _GL_SYS_STAT_H */
-#endif /* _GL_SYS_STAT_H */
+#endif /* _@GUARD_PREFIX@_SYS_STAT_H */
+#endif /* _@GUARD_PREFIX@_SYS_STAT_H */
#endif
diff --git a/lib/time.in.h b/lib/time.in.h
index cb533a46e10..1fbebf47beb 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -28,13 +28,13 @@
without adding our own declarations. */
#if (defined __need_time_t || defined __need_clock_t \
|| defined __need_timespec \
- || defined _GL_TIME_H)
+ || defined _@GUARD_PREFIX@_TIME_H)
# @INCLUDE_NEXT@ @NEXT_TIME_H@
#else
-# define _GL_TIME_H
+# define _@GUARD_PREFIX@_TIME_H
# @INCLUDE_NEXT@ @NEXT_TIME_H@
diff --git a/lib/u64.h b/lib/u64.h
new file mode 100644
index 00000000000..182d64955aa
--- /dev/null
+++ b/lib/u64.h
@@ -0,0 +1,158 @@
+/* uint64_t-like operations that work even on hosts lacking uint64_t
+
+ Copyright (C) 2006, 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/>. */
+
+/* Written by Paul Eggert. */
+
+#include <stdint.h>
+
+/* Return X rotated left by N bits, where 0 < N < 64. */
+#define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n))
+
+#ifdef UINT64_MAX
+
+/* Native implementations are trivial. See below for comments on what
+ these operations do. */
+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 u64lt(x, y) ((x) < (y))
+# define u64and(x, y) ((x) & (y))
+# define u64or(x, y) ((x) | (y))
+# define u64xor(x, y) ((x) ^ (y))
+# define u64plus(x, y) ((x) + (y))
+# define u64shl(x, n) ((x) << (n))
+# define u64shr(x, n) ((x) >> (n))
+
+#else
+
+/* u64 is a 64-bit unsigned integer value.
+ u64init (HI, LO), is like u64hilo (HI, LO), but for use in
+ initializer contexts. */
+# ifdef WORDS_BIGENDIAN
+typedef struct { uint32_t hi, lo; } u64;
+# define u64init(hi, lo) { hi, lo }
+# else
+typedef struct { uint32_t lo, hi; } u64;
+# define u64init(hi, lo) { lo, hi }
+# endif
+
+/* Given the high and low-order 32-bit quantities HI and LO, return a u64
+ value representing (HI << 32) + LO. */
+static inline u64
+u64hilo (uint32_t hi, uint32_t lo)
+{
+ u64 r;
+ r.hi = hi;
+ r.lo = lo;
+ return r;
+}
+
+/* Return a u64 value representing LO. */
+static inline u64
+u64lo (uint32_t lo)
+{
+ u64 r;
+ r.hi = 0;
+ r.lo = lo;
+ return r;
+}
+
+/* Return X < Y. */
+static 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
+u64and (u64 x, u64 y)
+{
+ u64 r;
+ r.hi = x.hi & y.hi;
+ r.lo = x.lo & y.lo;
+ return r;
+}
+
+/* Return X | Y. */
+static inline u64
+u64or (u64 x, u64 y)
+{
+ u64 r;
+ r.hi = x.hi | y.hi;
+ r.lo = x.lo | y.lo;
+ return r;
+}
+
+/* Return X ^ Y. */
+static inline u64
+u64xor (u64 x, u64 y)
+{
+ u64 r;
+ r.hi = x.hi ^ y.hi;
+ r.lo = x.lo ^ y.lo;
+ return r;
+}
+
+/* Return X + Y. */
+static inline u64
+u64plus (u64 x, u64 y)
+{
+ u64 r;
+ r.lo = x.lo + y.lo;
+ r.hi = x.hi + y.hi + (r.lo < x.lo);
+ return r;
+}
+
+/* Return X << N. */
+static inline u64
+u64shl (u64 x, int n)
+{
+ u64 r;
+ if (n < 32)
+ {
+ r.hi = (x.hi << n) | (x.lo >> (32 - n));
+ r.lo = x.lo << n;
+ }
+ else
+ {
+ r.hi = x.lo << (n - 32);
+ r.lo = 0;
+ }
+ return r;
+}
+
+/* Return X >> N. */
+static inline u64
+u64shr (u64 x, int n)
+{
+ u64 r;
+ if (n < 32)
+ {
+ r.hi = x.hi >> n;
+ r.lo = (x.hi << (32 - n)) | (x.lo >> n);
+ }
+ else
+ {
+ r.hi = 0;
+ r.lo = x.hi >> (n - 32);
+ }
+ return r;
+}
+
+#endif
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 3b58d0f42a5..769ecf0d43f 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -36,7 +36,7 @@
# define _GL_WINSOCK2_H_WITNESS
/* Normal invocation. */
-#elif !defined _GL_UNISTD_H
+#elif !defined _@GUARD_PREFIX@_UNISTD_H
/* The include_next requires a split double-inclusion guard. */
#if @HAVE_UNISTD_H@
@@ -51,8 +51,8 @@
# undef _GL_INCLUDING_WINSOCK2_H
#endif
-#if !defined _GL_UNISTD_H && !defined _GL_INCLUDING_WINSOCK2_H
-#define _GL_UNISTD_H
+#if !defined _@GUARD_PREFIX@_UNISTD_H && !defined _GL_INCLUDING_WINSOCK2_H
+#define _@GUARD_PREFIX@_UNISTD_H
/* NetBSD 5.0 mis-defines NULL. Also get size_t. */
#include <stddef.h>
@@ -117,78 +117,77 @@
/* The definition of _GL_WARN_ON_USE is copied here. */
-#if @GNULIB_GETHOSTNAME@
-/* Get all possible declarations of gethostname(). */
-# if @UNISTD_H_HAVE_WINSOCK2_H@
-# if !defined _GL_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
+/* Hide some function declarations from <winsock2.h>. */
+
+#if @GNULIB_GETHOSTNAME@ && @UNISTD_H_HAVE_WINSOCK2_H@
+# 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
-# if !defined _GL_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
+# 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
@@ -871,6 +870,22 @@ _GL_WARN_ON_USE (endusershell, "endusershell is unportable - "
#endif
+#if @GNULIB_GROUP_MEMBER@
+/* Determine whether group id is in calling user's group list. */
+# if !@HAVE_GROUP_MEMBER@
+_GL_FUNCDECL_SYS (group_member, int, (gid_t gid));
+# endif
+_GL_CXXALIAS_SYS (group_member, int, (gid_t gid));
+_GL_CXXALIASWARN (group_member);
+#elif defined GNULIB_POSIXCHECK
+# undef group_member
+# if HAVE_RAW_DECL_GROUP_MEMBER
+_GL_WARN_ON_USE (group_member, "group_member is unportable - "
+ "use gnulib module group-member 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.
@@ -1046,6 +1061,7 @@ _GL_WARN_ON_USE (pipe2, "pipe2 is unportable - "
specification <http://www.opengroup.org/susv3xsh/pread.html>. */
# if @REPLACE_PREAD@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef pread
# define pread rpl_pread
# endif
_GL_FUNCDECL_RPL (pread, ssize_t,
@@ -1080,6 +1096,7 @@ _GL_WARN_ON_USE (pread, "pread is unportable - "
<http://www.opengroup.org/susv3xsh/pwrite.html>. */
# if @REPLACE_PWRITE@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef pwrite
# define pwrite rpl_pwrite
# endif
_GL_FUNCDECL_RPL (pwrite, ssize_t,
@@ -1400,5 +1417,5 @@ _GL_CXXALIASWARN (write);
#endif
-#endif /* _GL_UNISTD_H */
-#endif /* _GL_UNISTD_H */
+#endif /* _@GUARD_PREFIX@_UNISTD_H */
+#endif /* _@GUARD_PREFIX@_UNISTD_H */
diff --git a/lib/verify.h b/lib/verify.h
index e5065ffa00b..9a8caad001d 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -164,10 +164,13 @@
(!!sizeof (_GL_VERIFY_TYPE (R, DIAGNOSTIC)))
# ifdef __cplusplus
+# if !GNULIB_defined_struct__gl_verify_type
template <int w>
struct _gl_verify_type {
unsigned int _gl_verify_error_if_negative: w;
};
+# define GNULIB_defined_struct__gl_verify_type 1
+# endif
# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
_gl_verify_type<(R) ? 1 : -1>
# elif defined _GL_HAVE__STATIC_ASSERT
@@ -204,7 +207,9 @@ template <int w>
# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert
# define static_assert _Static_assert /* Draft C1X requires this #define. */
# endif
-# else
+# endif
+
+/* @assert.h omit start@ */
/* Each of these macros verifies that its argument R is nonzero. To
be portable, R should be an integer constant expression. Unlike
@@ -216,15 +221,23 @@ template <int w>
contexts, e.g., the top level. */
/* Verify requirement R at compile-time, as an integer constant expression.
- Return 1. */
+ Return 1. This is equivalent to verify_expr (R, 1).
-# define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")")
+ verify_true is obsolescent; please use verify_expr instead. */
+
+# define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")")
+
+/* Verify requirement R at compile-time. Return the value of the
+ expression E. */
+
+# define verify_expr(R, E) \
+ (_GL_VERIFY_TRUE (R, "verify_expr (" #R ", " #E ")") ? (E) : (E))
/* Verify requirement R at compile-time, as a declaration without a
trailing ';'. */
-# define verify(R) _GL_VERIFY (R, "verify (" #R ")")
+# define verify(R) _GL_VERIFY (R, "verify (" #R ")")
-# endif
+/* @assert.h omit end@ */
#endif
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9a4468d8b43..936dab89ae5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,18 +1,3275 @@
-2011-06-19 Eli Zaretskii <eliz@gnu.org>
+2011-07-14 Eli Zaretskii <eliz@gnu.org>
* buff-menu.el (Buffer-menu-buffer+size): Accept an additional
argument LRM; if non-nil, append an invisible LRM character to the
buffer name.
(list-buffers-noselect): Call Buffer-menu-buffer+size with the
last argument non-nil, when formatting buffer names.
+ (Buffer-menu-mode, list-buffers-noselect): Force left-to-right
+ paragraph direction.
-2011-06-18 Eli Zaretskii <eliz@gnu.org>
+2011-07-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * buff-menu.el (Buffer-menu-mode, list-buffers-noselect): Force
- left-to-right paragraph direction.
+ * image.el (put-image): Mention the `put-image' overlay property
+ (bug#7834).
+
+ * scroll-bar.el (set-scroll-bar-mode): Mention that
+ `scroll-bar-mode' lists the values (bug#7772).
+
+ * image-mode.el (image-mode-fit-frame): Mention that it's a toggle
+ command (bug#7729).
+
+ * rect.el (apply-on-rectangle): Return the point after the last
+ operation.
+ (string-rectangle): Go to the point after the last operation
+ (bug#7522).
+
+ * simple.el (current-kill): Clarify what
+ `interprogram-paste-function' does (bug#7500).
+
+ * printing.el (pr-toggle-region): Clarify the documentation
+ slightly (bug#7493).
+
+ * time.el (display-time-update): Allow
+ `display-time-mail-function' to return nil (bug#7158). Fix
+ suggested by Detlev Zundel.
+
+ * vc/diff.el (diff): Clarify the order the file names are read
+ (bug#7111).
+
+ * mouse.el (mouse-set-region): Link to `mouse-drag-copy-region' in
+ the doc string (bug#7015).
+
+ * font-lock.el (font-lock-maximum-decoration): Mention what
+ numeric levels mean (bug#6935).
+
+ * startup.el (initial-buffer-choice): Don't mention the `none'
+ selection, which is against policy.
+
+2011-07-14 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-normalize-special): Replace
+ `dedicated' by `dedicate' to dedicate window (Bug#9072).
+
+2011-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ * subr.el (version<, version<=, version=): Mention "-CVS" and
+ "-12345" alpha version numbers.
+
+2011-07-14 Chong Yidong <cyd@stupidchicken.com>
+
+ * bindings.el: Add advertised binding for set-mark-command
+ (Bug#5772).
+
+2011-07-14 Chong Yidong <cyd@stupidchicken.com>
+
+ * bindings.el (mode-line-other-buffer):
+ * bookmark.el (bookmark-bmenu-2-window):
+ * bs.el (bs-cycle-next, bs-cycle-previous):
+ * net/tramp-cmds.el (tramp-append-tramp-buffers): Revert to using
+ switch-to-buffer.
+
+ * net/tramp-compat.el (tramp-compat-pop-to-buffer-same-window):
+ Deleted.
+
+2011-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * follow.el (follow-debug-message, follow-redisplay):
+ * jka-cmpr-hook.el (with-auto-compression-mode):
+ Fix typos in docstrings.
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * subr.el (with-silent-modifications): Clarify somewhat what the
+ macro inhibits (bug#6525).
+
+ * simple.el (eval-expression): Note what it does if called
+ interactively (bug#6495).
+
+2011-07-13 Chong Yidong <cyd@stupidchicken.com>
+
+ * window.el (switch-to-buffer): New arg FORCE-SAME-WINDOW. Use
+ pop-to-buffer buffer-or-name if it is nil.
+
+ * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions):
+ Remove switch-to-buffer.
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * files.el (make-directory): Clarify that an error will be raised
+ if there's an error (bug#6397).
+
+ * startup.el (initial-buffer-choice): Add `none' as a choice
+ (bug#6234).
+
+ * subr.el (add-hook): Clarify section about buffer-local hooks
+ (bug#6218).
+
+ * dired.el (dired-flagged): Clarify doc string (bug#6117).
+
+2011-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * tabify.el (untabify): Preserve the current column so that point
+ doesn't move (bug#6032).
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * progmodes/cperl-mode.el (cperl-syntaxify-by-font-lock): Rewrite
+ to avoid awkward possessive "s" (bug#5986).
+
+2011-07-13 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-use-ls-dired): Doc fix. (Bug#9039).
+ (dired-insert-directory): Give a message the first time
+ if ls is found not to support --dired.
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * simple.el (toggle-truncate-lines): Clarify what is toggled
+ (bug#5580). Text by Drew Adams.
+
+2011-07-13 Chong Yidong <cyd@stupidchicken.com>
+
+ * simple.el (blink-matching-open): Make the error message from the
+ last change less verbose.
+
+2011-07-13 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * font-lock.el (font-lock-comment-face): Use the high contrast
+ "yellow" color for font-lock-comment-face on low color terminals
+ using a dark background color (bug#4221).
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dired.el (dired-insert-set-properties): Make the doc string
+ reflect what it does now (bug#5325).
+
+ * simple.el (blink-matching-open): Say that we were unable to find
+ the match within the limit, if we're limited (bug#5122).
+
+ * international/mule-cmds.el (prefer-coding-system): Add an
+ example (bug#4869).
+
+ * progmodes/etags.el (tags-search): Document `file-list-form'
+ (bug#4731).
+
+2011-07-13 Lawrence Mitchell <wence@gmx.li>
+
+ * net/browse-url.el (browse-url-default-browser)
+ (browse-url-browser-function): Make the default browser choice a
+ bit more logical (bug#4300). Also clean up the doc string.
+
+2011-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * bindings.el (completion-ignored-extensions): Add OpenMCL/Clozure
+ binary endings (bug#4440).
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * info.el (info-insert-file-contents): Inhibit jka-compr messages,
+ which can be pretty annoying (bug#8971).
+
+ * jka-compr.el (jka-compr-verbose): New variable, and use
+ throughout (bug#8971).
+
+ * info.el (Info-find-file): Fall back on the installation
+ directory if we can't find the info node anywhere else.
+
+2011-07-13 Sergei Organov <osv@javad.com> (tiny change)
+
+ * vc/vc.el (vc-revert-file):
+ Don't set file time-stamp in the past. (Bug#5181)
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * files.el (after-find-file): Give a better error message when
+ trying to find a symlink that points to a file that doesn't exist
+ (bug#4398).
+
+ * progmodes/cc-vars.el: Remove (probably) misleading comment
+ (bug#4396).
+
+2011-07-12 Johan Bockgård <bojohan@gnu.org>
+
+ * mouse-sel.el (mouse-sel-primary-overlay): Use the `region' face.
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * mouse-sel.el: Hack restoring functionality, while keeping
+ compatibility with 2010-07-03 changes to mouse selection.
+ (mouse-sel-primary-overlay): New var.
+ (mouse-sel-selection-alist): Use it.
+ (mouse-sel-mode): Doc fix; remove points that are default features
+ of mouse.el.
+
+2011-07-12 Johan Bockgård <bojohan@gnu.org>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Fix previous fix (bug#2490).
+
+2011-07-12 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-initialize): Use
+ pop-to-buffer-same-window.
+ (bibtex-search-entries): Fix interactive call.
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Fontise bytecomp Error lines more correctly (bug#2490). Fix
+ suggested by Johan Bockgård.
+
+ * subr.el (remove-duplicates): Remove; `delete-dups' is sufficient.
+
+ * dired-x.el (dired-guess-default): Use `delete-dups'.
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * dired.el (dired-mark-prompt):
+ * dired-aux.el (dired-read-shell-command): Doc fix.
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/sendmail.el (sendmail-query-once): Use
+ `customize-save-variable' unconditionally, now that it works under
+ emacs -Q.
+
+ * mail/smtpmail.el (smtpmail-query-smtp-server): Ditto.
+
+ * cus-edit.el (custom-file): Take an optional no-error variable.
+ (customize-save-variable): Set the variable, and give a warning if
+ running under "emacs -q".
+
+2011-07-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * loadhist.el (unload-feature-special-hooks):
+ Add `auto-coding-functions', `fill-nobreak-predicate' and
+ `find-directory-functions' (bug#5327).
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * vc/ediff.el (ediff-patch-file): Clarify doc string (bug#3138).
+
+ * cus-edit.el (custom-guess-name-alist): -alist variables should
+ use the `alist' type (bug#3120). Suggested by Drew Adams.
+
+ * printing.el: Add documentation to all the `pr-toggle-' commands.
+
+2011-07-11 Leo <sdl.web@gmail.com> (tiny change)
+
+ * files.el (toggle-read-only): Only do the `C-x C-q' warning on VC
+ backends where it makes sense (bug#2623).
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dired-x.el (dired-guess-default): Remove duplicate shell command
+ entries (bug#2028).
+ (dired-guess-default): Fix grammar in doc string (bug#2028).
+ (dired-guess-shell-alist-user): Clarify the example a bit (bug#2030).
+
+ * subr.el (remove-duplicates): New conveniency function.
+
+2011-07-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * tool-bar.el (tool-bar-mode): Clarify positive/negative arguments
+ (bug#1526).
+
+2011-07-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-normalize-default): Don't invert
+ meaning of even-window-heights. Reported by Eli Zaretskii
+ <eliz@gnu.org>.
+
+2011-07-10 Bob Rogers <rogers@rgrjr.dyndns.org>
+
+ * vc/vc.el (vc-diff-internal): Fix race condition (Bug#1256).
+
+2011-07-10 Chong Yidong <cyd@stupidchicken.com>
+
+ * window.el (display-buffer): Fix arguments to
+ display-buffer-reuse-window in last change.
+
+ * faces.el (link): Use a less saturated blue on light backgrounds.
+
+ * startup.el (fancy-startup-text, fancy-about-text)
+ (fancy-startup-tail): Use font-lock faces, for background safety.
+
+2011-07-09 Bob Nnamtrop <bobnnamtrop@gmail.com> (tiny change)
+
+ * emulation/viper-cmd.el (viper-change-state-to-vi): Limit
+ triggering of abbrev expansion (Bug#9038).
+
+2011-07-09 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-default-specifiers): Remove.
+ (display-buffer-macro-specifiers): Remove default specifiers.
+ (display-buffer-alist): Default to nil.
+ (display-buffer-reuse-window): New optional argument
+ other-window.
+ (display-buffer-pop-up-window): Allow splitting internal
+ windows. Check whether a live window was created.
+ (display-buffer-other-window-means-other-frame)
+ (display-buffer-normalize-arguments): Rename to
+ display-buffer-normalize-argument and rewrite. Set the
+ other-window specifier.
+ (display-buffer-normalize-special): New function.
+ (display-buffer-normalize-options): Rename to
+ display-buffer-normalize-default and rewrite.
+ (display-buffer-normalize-options-inhibit): Remove.
+ (display-buffer-normalize-specifiers): Rewrite.
+ (display-buffer): Process other-window specifier and call
+ display-buffer-reuse-window with it. Emulate Emacs 23 behavior
+ more faithfully.
+ (pop-up-windows, even-window-heights): Restore Emacs 23 default
+ values.
+ (display-buffer-alist-set): Don't handle 'unset default values.
+ (display-buffer-in-window, display-buffer-alist-set): Replace
+ symbol "dedicated" by "dedicate". Reported by Tassilo Horn
+ <tassilo@member.fsf.org>.
+
+2011-07-09 Leo Liu <sdl.web@gmail.com>
+
+ * register.el (insert-register): Restore accidental change on
+ 2011-06-26. (Bug#9028)
+
+2011-07-09 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (remq): Handle the empty list. (Bug#9024)
+
+2011-07-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * mail/sendmail.el (send-mail-function): No longer delay custom
+ initialization.
+ * custom.el (custom-initialize-delay): Doc fix.
+
+2011-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * abbrev.el (expand-abbrev): Try to preserve point (bug#5805).
+
+2011-07-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process): Use a
+ human-friendly prompt.
+
+2011-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-bzr.el (vc-bzr-revision-keywords): Remove svn, it's only
+ provided by a particular plugin.
+
+2011-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/sendmail.el (sendmail-query-once): If we aren't allowed to
+ save customizations (with "emacs -Q"), just set the variable
+ instead of erroring out.
+
+ * mail/smtpmail.el (smtpmail-query-smtp-server): Ditto.
+
+2011-07-08 Juri Linkov <juri@jurta.org>
+
+ * arc-mode.el (archive-zip-expunge, archive-zip-update)
+ (archive-zip-update-case): Use 7z if found by `executable-find'.
+ The order of searching the available programs is the same as in
+ `archive-zip-extract' (bug#8968).
+
+2011-07-07 Chong Yidong <cyd@stupidchicken.com>
+
+ * menu-bar.el (menu-bar-line-wrapping-menu): Revert last change.
+ (menu-bar-options-menu): Tweak descriptions.
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * menu-bar.el (menu-bar-line-wrapping-menu): Make all the Options
+ menu items into verb phrases (bug#1421). Also refill to fit under
+ 80 columns.
+
+2011-07-07 Chong Yidong <cyd@stupidchicken.com>
+
+ * info.el (info, Info-read-node-name-2, Info-read-node-name-1)
+ (Info-read-node-name): Doc fix (Bug#1084).
+
+ * thingatpt.el (forward-thing, bounds-of-thing-at-point)
+ (thing-at-point, beginning-of-thing, end-of-thing, in-string-p)
+ (end-of-sexp, beginning-of-sexp)
+ (thing-at-point-bounds-of-list-at-point, forward-whitespace)
+ (forward-symbol, forward-same-syntax, word-at-point)
+ (sentence-at-point): Doc fix (Bug#1144).
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * info.el (Info-mode-map): Remove S-TAB binding, since [backtab]
+ should cover it (bug#1281).
+
+ * cus-edit.el (custom-show): Mark as obsolete.
+
+ * net/network-stream.el (network-stream-open-starttls): If gnutls
+ negotiation fails, then possibly try again with a non-encrypted
+ connection (bug#9017).
+
+ * mail/smtpmail.el (smtpmail-stream-type): Note that `plain' can
+ be used.
+
+2011-07-07 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el (rmail-next-error-move): Use `compilation-message'
+ property, and handle its changed format.
+ Look for the correct line number.
+ Use file's line contents (but not past first =) to find
+ correct line in message.
+
+2011-07-07 Kenichi Handa <handa@m17n.org>
+
+ * international/characters.el (build-unicode-category-table):
+ Delete it.
+ (unicode-category-table): Set it by unicode-property-table-internal.
+
+ * international/mule-cmds.el (char-code-property-alist): Move to
+ to src/chartab.c.
+ (get-char-code-property): Call unicode-property-table-internal to
+ load a file. Call get-unicode-property-internal where necessary.
+ (put-char-code-property): Call unicode-property-table-internal to
+ load a file. Call put-unicode-property-internal where necessary.
+ put-unicode-property-internal where necessary.
+ (char-code-property-description):
+ Call unicode-property-table-internal to load a file.
+
+ * international/charprop.el:
+ * international/uni-bidi.el:
+ * international/uni-category.el:
+ * international/uni-combining.el:
+ * international/uni-comment.el:
+ * international/uni-decimal.el:
+ * international/uni-decomposition.el:
+ * international/uni-digit.el:
+ * international/uni-lowercase.el:
+ * international/uni-mirrored.el:
+ * international/uni-name.el:
+ * international/uni-numeric.el:
+ * international/uni-old-name.el:
+ * international/uni-titlecase.el:
+ * international/uni-uppercase.el: Regenerate.
+
+ * loadup.el: Load international/charprop.el before
+ international/characters.
+
+2011-07-07 Chong Yidong <cyd@stupidchicken.com>
+
+ * window.el (next-buffer, previous-buffer): Signal an error if
+ called from a minibuffer window.
+
+ * bindings.el: Revert 2011-07-04 change.
+
+2011-07-06 Richard Stallman <rms@gnu.org>
+
+ * mail/rmailmm.el (rmail-mime-process): Use markers for buf positions.
+ (rmail-mime-insert-bulk, rmail-mime-insert-text):
+ Treat markers like ints.
+ (rmail-mime-entity): Doc fix.
+
+2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-default-smtp-server): Made into a
+ defcustom again for backwards compatibility.
+
+ * simple.el (shell-command-on-region): Fill.
+
+ * dired-aux.el (dired-kill-line): Add a doc string.
+
+ * dabbrev.el (dabbrev-abbrev-char-regexp): Note that nil defaults
+ to "\\sw\\|\\s_" (bug#358).
+
+ * dired.el (dired-mode): Clarify "unmark or unflag" (bug#8770).
+ (dired-unmark-backward): Ditto.
+ (dired-flag-backup-files): Ditto.
+
+ * dired-x.el (dired-mark-sexp): Ditto.
+
+2011-07-06 Richard Stallman <rms@gnu.org>
+
+ * mail/rmailmm.el: Give entity a new slot, TRUNCATED.
+ (rmail-mime-entity): New arg TRUNCATED.
+ (rmail-mime-entity-truncated, rmail-mime-entity-set-truncated):
+ New functions.
+ (rmail-mime-save): Warn if entity is truncated.
+ (rmail-mime-toggle-hidden): Likewise, for showing.
+ (rmail-mime-process-multipart): Record when an entity is truncated.
+
+ * mail/rmailmm.el (rmail-search-mime-message): Don't get confused
+ if ENTITY is a string.
+
+2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * emacs-lisp/lisp-mode.el (eval-defun-1): Update the documentation
+ of faces when `M-C-x'-ing their definitions (bug#8378).
+ Also clean up the code slightly.
+
+ * progmodes/grep.el (rgrep): Don't bind `process-connection-type',
+ because that makes the colours go away.
+
+ * mail/sendmail.el (send-mail-function): Change the default to
+ `sendmail-query-once'.
+ (sendmail-query-once): Add an autoload cookie.
+
+ * net/network-stream.el (network-stream-open-starttls): Try using
+ a plain connection even if the server offered STARTTLS, and we
+ kinda wanted to use it, if Emacs doesn't have any STARTTLS
+ capability. This should make smtpmail.el work in slightly more
+ configurations.
+
+2011-07-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-compat.el (tramp-compat-pop-to-buffer-same-window):
+ New defun.
+ * net/tramp-cmds.el (tramp-append-tramp-buffers): Use it.
+
+2011-07-06 Michael R. Mauger <mmaug@yahoo.com>
+
+ * progmodes/sql.el: Version 3.0
+ (sql-product-alist): Add product :completion-object,
+ :completion-column, and :statement attributes.
+ (sql-mode-menu, sql-interactive-mode-map): Fix List entries.
+ (sql-mode-syntax-table): Mark all punctuation.
+ (sql-font-lock-keywords-builder): Temporarily remove fallback on
+ ansi keywords.
+ (sql-regexp-abbrev, sql-regexp-abbrev-list): New functions.
+ (sql-mode-oracle-font-lock-keywords): Improve.
+ (sql-oracle-show-reserved-words): New function for development.
+ (sql-product-font-lock): Simplify for source code buffers.
+ (sql-product-syntax-table, sql-product-font-lock-syntax-alist):
+ New functions.
+ (sql-highlight-product): Set product specific syntax table.
+ (sql-mode-map): Add statement movement functions.
+ (sql-ansi-statement-starters, sql-oracle-statement-starters):
+ New variable.
+ (sql-statement-regexp, sql-beginning-of-statement)
+ (sql-end-of-statement, sql-signum): New functions.
+ (sql-buffer-live-p, sql=find-sqli-buffer): Add CONNECTION parameter.
+ (sql-show-sqli-buffer): Bug fix.
+ (sql-interactive-mode): Store connection data as buffer local.
+ (sql-connect): Add NEW-NAME parameter. Redesign interaction
+ with sql-interactive-mode.
+ (sql-save-connection): Save buffer local settings.
+ (sql-connection-menu-filter): Change menu entry name.
+ (sql-product-interactive): Bug fix.
+ (sql-preoutput-hold): New variable.
+ (sql-interactive-remove-continuation-prompt): Bug fixes.
+ (sql-debug-redirect): New variable.
+ (sql-str-literal): New function.
+ (sql-redirect, sql-redirect-one, sql-redirect-value, sql-execute):
+ Redesign.
+ (sql-oracle-save-settings, sql-oracle-restore-settings)
+ (sql-oracle-list-all, sql-oracle-list-table): New functions.
+ (sql-completion-object, sql-completion-column)
+ (sql-completion-sqlbuf): New variables.
+ (sql-build-completions-1, sql-build-completions)
+ (sql-try-completion): New functions.
+ (sql-read-table-name): Use them.
+ (sql-contains-names): New buffer local variable.
+ (sql-list-all, sql-list-table): Use it.
+ (sql-oracle-completion-types): New variable.
+ (sql-oracle-completion-object, sql-sqlite-completion-object)
+ (sql-postgres-completion-object): New functions.
+
+2011-07-06 Glenn Morris <rgm@gnu.org>
+
+ * window.el (pop-to-buffer): Doc fix.
+
+2011-07-06 Markus Heiser <markus.heiser@darmarit.de> (tiny change)
+
+ * progmodes/gud.el (gud-pdb-marker-regexp): Accept \r char (Bug#5653).
+
+2011-07-06 Chong Yidong <cyd@stupidchicken.com>
+
+ * window.el (special-display-popup-frame): Doc fix (Bug#8853).
+
+ * info.el (Info-directory-toc-nodes): Minor doc fix (Bug#8833).
+
+2011-07-05 Chong Yidong <cyd@stupidchicken.com>
+
+ * button.el (button): Inherit from link face. Suggested by Dan
+ Nicolaescu.
+
+2011-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gdb-mi.el: Fit in 80 columns.
+ (gdb-setup-windows, gdb-restore-windows): Avoid other-window and
+ switch-to-buffer.
+
+ * progmodes/which-func.el (which-func-ff-hook): Don't output a message
+ if imenu is simply not configured (bug#8941).
+
+2011-07-05 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el (allout-post-undo-hook): New allout outline-change
+ event hook to signal undo activity.
+ (allout-post-command-business): Run allout-post-undo-hook if an
+ undo just occurred.
+ (allout-after-copy-or-kill-hook, allout-mode): Minor docstring changes.
+ * allout-widgets.el (allout-widgets-after-undo-function):
+ Ensure the integrity of the current item's decoration after it has been
+ in the vicinity of an undo.
+ (allout-widgets-mode): Include allout-widgets-after-undo-function
+ on the new allout-post-undo-hook.
+
+2011-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (lisp-interaction-mode-abbrev-table):
+ Let define-derived-mode define it.
+ * emacs-lisp/derived.el (define-derived-mode): Try to avoid creating
+ cycles of abbrev-table inheritance (bug#8998).
+
+2011-07-05 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el: Add support for biblatex.
+ (bibtex-BibTeX-entry-alist, bibtex-biblatex-entry-alist)
+ (bibtex-BibTeX-field-alist, bibtex-biblatex-field-alist)
+ (bibtex-dialect-list, bibtex-dialect, bibtex-no-opt-remove-re)
+ (bibtex-entry-alist, bibtex-field-alist): New variables.
+ (bibtex-entry-field-alist): Obsolete alias for
+ bibtex-BibTeX-entry-alist.
+ (bibtex-entry-alist, bibtex-field-alist): New widgets.
+ (bibtex-set-dialect): New command.
+ (bibtex-entry-type, bibtex-entry-head)
+ (bibtex-entry-maybe-empty-head, bibtex-any-valid-entry-type):
+ Bind via bibtex-set-dialect.
+ (bibtex-Article, bibtex-Book, bibtex-Booklet, bibtex-InBook)
+ (bibtex-InCollection, bibtex-InProceedings, bibtex-Manual)
+ (bibtex-MastersThesis, bibtex-Misc, bibtex-PhdThesis)
+ (bibtex-Proceedings, bibtex-TechReport, bibtex-Unpublished):
+ Define via bibtex-set-dialect.
+ (bibtex-name-in-field, bibtex-remove-OPT-or-ALT):
+ Obey bibtex-no-opt-remove-re.
+ (bibtex-vec-push, bibtex-vec-incr): New functions.
+ (bibtex-format-entry, bibtex-field-list)
+ (bibtex-print-help-message, bibtex-validate)
+ (bibtex-search-entries): Use new format of bibtex-entry-alist.
+
+2011-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/compile.el (compilation-goto-locus):
+ * net/tramp-cmds.el (tramp-append-tramp-buffers):
+ * bs.el (bs-cycle-next, bs-cycle-previous):
+ * bookmark.el (bookmark-bmenu-list, bookmark-bmenu-2-window):
+ * bindings.el (mode-line-other-buffer):
+ * autoinsert.el (auto-insert):
+ * arc-mode.el (archive-extract):
+ * abbrev.el (edit-abbrevs): Fix some uses of switch-to-buffer.
+
+2011-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lock.el (emacs-lock-mode): Fix typo in variable name.
+ Fix check of `emacs-lock-unlockable-modes'.
+ Coerce true values of `emacs-lock--try-unlocking' to t.
+
+2011-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * obsolete/old-emacs-lock.el: Rename from emacs-lock.el.
+ * emacs-lock.el: New file.
+
+2011-07-05 Julien Danjou <julien@danjou.info>
+
+ * textmodes/rst.el (rst-define-level-faces): Use `facep' rather
+ than `boundp' to check if face is set.
+
+2011-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * register.el (registerv-make):
+ * window.el (window-min-height): Fix typos in docstrings.
+
+2011-07-05 Jan Djärv <jan.h.d@swipnet.se>
+
+ * dynamic-setting.el (dynamic-setting-handle-config-changed-event):
+ Update doc string.
+
+2011-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * server.el (server-execute): Catch quit and call
+ `server-return-error' to pass the error back to emacsclient and
+ close the connection (bug#8942).
+
+2011-07-04 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el (allout-encrypt-unencrypted-on-saves): Do not provide
+ insecure exception for current topic. Also note that auto-saves
+ are handled differently.
+
+ (allout-auto-save-temporarily-disabled), (allout-just-did-undo):
+ State variables for tracking auto-save inhibition situation.
+
+ (allout-write-contents-hook-handler): Rename from
+ 'allout-write-file-hook-handler', and describe how it depends on
+ write-contents-functions sensitivity to non-nil value to prevent
+ file write.
+
+ (allout-auto-save-hook-handler): Remove. auto-save does not check
+ this in individual buffers, only in the starting buffer, so this
+ is not the right way for us to inhibit auto-save in a buffer
+ according to its condition.
+
+ (allout-mode): Use new allout-write-contents-hook-handler, and
+ only with write-contents-functions. Remove auto-save provisions -
+ they're implemented elsewhere.
+
+ (allout-before-change-handler): If undo is in progress, note that
+ for attention of allout-post-command-business.
+
+ (allout-post-command-business): If the command we're following was
+ an undo, check for change in the status of encrypted items and
+ adjust auto-save inhibitions accordingly.
+
+ (allout-toggle-subtree-encryption): Adjust auto-save inhibition
+ according to whether there are or aren't any plain-text topics
+ pending encryption.
+
+ (allout-inhibit-auto-save-info-for-decryption):
+ Adjust buffer-saved-size and some allout state to inhibit auto-saves if
+ there are plain-text topics pending encryption.
+
+ (allout-maybe-resume-auto-save-info-after-encryption): Adjust
+ buffer-saved-size and some allout state to not inhibit auto-saves
+ if there are no longer any plain-text topics pending encryption.
+
+ (allout-next-topic-pending-encryption, allout-encrypt-decrypted):
+ No longer provide for exemption of the current topic.
+
+2011-07-04 Juri Linkov <juri@jurta.org>
+
+ Add 7z operations to delete and save changed members (bug#8968).
+ * arc-mode.el (archive-7z-expunge, archive-7z-update):
+ New defcustoms.
+ (archive-7z-write-file-member): New function.
+ (archive-7z-summarize): Fix the number of dashes in the
+ listing output.
+
+2011-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * pcmpl-linux.el (pcomplete-pare-list): Re-add, from pcomplete.el
+ (bug#8958).
+
+2011-07-04 Chong Yidong <cyd@stupidchicken.com>
+
+ * bindings.el: Ignore next-buffer and previous-buffer in
+ minibuffer-local-map.
+
+ * font-lock.el (font-lock-builtin-face): Change light background
+ color to dark slate blue (Bug#6693).
+
+2011-07-04 Wang Diancheng <dcwang@kingbase.com.cn> (tiny change)
+
+ * progmodes/gdb-mi.el (gdb): Use completion-at-point.
+
+2011-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (find-file): Use pop-to-buffer-same-window (bug#8911).
+ * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions):
+ Add switch-to-buffer.
+
+2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * isearch.el (isearch-search-fun-function): Clarify further the
+ meaning of the function returned.
+
+2011-07-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cmds.el (tramp-cleanup-this-connection): New command.
+
+ * net/tramp-sh.el (tramp-color-escape-sequence-regexp): New defconst.
+ (tramp-sh-handle-insert-directory, tramp-convert-file-attributes):
+ Use it.
+ (tramp-remote-path): Add "/bin" and "/usr/bin". On busyboxes,
+ `tramp-default-remote-path' does not exist.
+ (tramp-send-command-and-read): New optional argument NOERROR.
+ (tramp-open-connection-setup-interactive-shell)
+ (tramp-get-remote-path, tramp-get-remote-stat): Use it.
+ (tramp-get-remote-readlink): Do not mask with `ignore-errors'.
+ (tramp-process-sentinel): Flush also process' connection property.
+ (tramp-sh-handle-start-file-process): Do not set process
+ sentinel. It is done now ...
+ (tramp-maybe-open-connection): ... here. (Bug#8929)
+
+2011-07-04 MON KEY <monkey@sandpframing.com>
+
+ * play/animate.el (animate-string): Doc fixes and allow changing
+ the buffer name (bug#5417).
+
+2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * play/animate.el (animation-buffer-name): Rename from *animate*.
+
+2011-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs-lisp/timer.el: Use time-date fns rather than rolling our own.
+ This is simpler and helps future-proof the code.
+ (timer-until): Use time-subtract and float-time.
+ (timer--time-less-p): Use time-less-p.
+
+2011-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * type-break.el (timep): Use the value of `float-time' to avoid a
+ byte-compiler warning.
+
+ * server.el (server-eval-and-print): Return any result, even nil.
+
+2011-07-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * type-break.el: Accept time formats that the builtins accept.
+ (timep, type-break-time-difference): Accept any format that
+ float-time accepts, rather than insisting on (HIGH LOW USECS) format.
+ This is simpler and helps future-proof the code.
+ (type-break-time-difference): Round rather than ignoring
+ subseconds components.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * info.el (Info-apropos-matches): Make non-interactive, since it
+ doesn't seem to do anything useful as a command (bug#8829).
+
+2011-07-03 Chong Yidong <cyd@stupidchicken.com>
+
+ * frame.el (frame-background-mode, frame-set-background-mode):
+ Move from faces.el.
+ (frame-default-terminal-background): New function.
+
+ * custom.el (custom-push-theme): Don't record faces in `changed'
+ theme; this doesn't work correctly for per-frame face settings.
+ (disable-theme): Use face-set-after-frame-default to reset faces.
+ (custom--frame-color-default): New function.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dired.el (dired-flagging-regexp): Remove unused variable
+ (bug#8769).
+
+2011-03-29 Kevin Ryde <user42@zip.com.au>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ `perl-Test2' extend to match possible "fail #N" rep count
+ (bug#8377).
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/feedmail.el (feedmail-buffer-to-smtpmail):
+ `smtpmail-via-smtp' now returns the error instead of nil.
+
+ * isearch.el (isearch-search-fun-function): Clarify the doc string
+ (bug#8101).
+
+2011-07-03 Richard Kim <emacs18@gmail.com> (tiny change)
+
+ * textmodes/texnfo-upd.el (texinfo-insert-menu): Don't insert
+ unnecessary spaces (bug#8987).
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (open-network-stream): Use the
+ :end-of-capability command thoughout.
+
+2011-07-03 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
+
+ * net/network-stream.el (open-network-stream): Add the
+ :end-of-capability command parameter, used by pop3.el.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dired.el (dired-map-over-marks): Refill the doc string (bug#6814).
+
+ * fringe.el (fringe-query-style): Remove redundant text " (type ?
+ for list)" (bug#6475).
+
+ * files.el (file-expand-wildcards): Ignore non-readable
+ sub-directories while trying to find matches instead of signalling
+ an error (bug#6297).
+
+ * man.el (Man-reference-regexp): Allow matching possible
+ word-wrapped references (bug#6289).
+
+ * vc/vc.el (vc-modify-change-comment): Change *VC-log* to *vc-log*
+ for consistency with the other vc buffers (bug#6197).
+ (vc-checkin): Ditto.
+
+ * vc/vc-arch.el: Fix comments to match the *VC-log* name change.
+
+ * longlines.el (longlines-mode): Document what ARG does (bug#6150).
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * custom.el (defcustom): Clarify that :set is only used in the
+ Customize user interface (bug#6089).
+
+ * progmodes/flymake.el (flymake-mode): If the buffer isn't
+ associated with a file, refuse to run instead of erroring out
+ (bug#6084).
+
+ * textmodes/fill.el (fill-region): Remove the "Ordinarily" from
+ the doc string, since it appears that using `fill-column' always
+ controls the width (bug#7845).
+
+ * simple.el (shell-command-on-region): Say where the error output
+ went if `shell-command-default-error-buffer' is set (bug#6857).
+
+2011-07-02 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el (allout-yank-processing): Adjust cursor position for
+ backwards-deleted space.
+
+ (allout-rebullet-heading): Register changes with
+ allout-exposure-changed-hook, so the modified topic is properly
+ decorated.
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * minibuffer.el (completion-in-region): Document PREDICATE
+ (bug#7136).
+
+ * info-look.el (info-lookup-add-help): Clarify that ARGS is a list
+ of keyword/argument pairs (bug#6904).
+
+ * replace.el (multi-occur):
+ Mention `multi-occur-in-matching-buffers' in the doc string (bug#7566).
+
+2011-07-02 Drew Adams <drew.adams@oracle.com>
+
+ * dired.el (dired-mark-if): Make the message about whether it's
+ marking or unmarking clearer (bug#8523).
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * disp-table.el (display-table-print-array): New function.
+ (describe-display-table): Use it to print the vectors more pretty
+ (Bug#8859).
+
+2011-07-02 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-state-get-1): Don't assign clone numbers.
+ Add clone-of item to list of window parameters.
+ (window-state-put-2): Don't process clone numbers.
+ (display-buffer-alist): Fix doc-string.
+
+2011-07-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (remq): Don't allocate if it's not needed.
+ (keymap--menu-item-binding, keymap--menu-item-with-binding)
+ (keymap--merge-bindings): New functions.
+ (keymap-canonicalize): Use them to refine the canonicalization.
+ * minibuffer.el (minibuffer-local-completion-map)
+ (minibuffer-local-must-match-map): Move initialization from C.
+ (minibuffer-local-filename-completion-map): Move initialization from C;
+ don't inherit from anything here.
+ (minibuffer-local-filename-must-match-map): Make obsolete.
+ (completing-read-default): Use make-composed-keymap to combine
+ minibuffer-local-filename-completion-map with either
+ minibuffer-local-must-match-map or
+ minibuffer-local-filename-completion-map.
+
+2011-07-01 Glenn Morris <rgm@gnu.org>
+
+ * type-break.el (type-break-time-sum): Use dolist.
+
+ * textmodes/flyspell.el (flyspell-word-search-backward):
+ Replace CL function.
+
+2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse--strip-first-event): New function.
+ (function-key-map): Use it to map fringe clicks to normal clicks
+ by default.
+
+ * vc/vc-bzr.el (vc-bzr-revision-keywords): Update.
+ (vc-bzr-revision-completion-table): Add support for annotate and date.
+
+ * emacs-lisp/derived.el (define-derived-mode): Make abbrev-table
+ inherit from parent.
+
+2011-07-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dired-aux.el (dired-diff): Doc fixup (bug#8816).
+ (dired-show-file-type): Doc fixup (bug#8818).
+
+ * dired.el (dired-mode): Fix up the doc string as suggested by
+ Drew Adams (bug#8817).
+
+ * progmodes/flymake.el (flymake-find-file-hook): Add an `autoload'
+ cookie, since the manual says that it should be possible to add
+ this function to `find-file-hook' (bug#8709).
+
+2011-07-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el: Moved all cfengine3.el functionality
+ here. Noted Ted Zlatanov as the maintainer.
+ (cfengine-common-settings, cfengine-common-syntax): New functions
+ to set up common things between `cfengine-mode' and
+ `cfengine3-mode'.
+ (cfengine3-mode): New mode.
+ (cfengine3-defuns cfengine3-defuns-regex
+ (cfengine3-class-selector-regex cfengine3-category-regex)
+ (cfengine3-vartypes cfengine3-font-lock-keywords)
+ (cfengine3-beginning-of-defun, cfengine3-end-of-defun)
+ (cfengine3-indent-line): Add from cfengine3.el.
+
+2011-07-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-encoding-command-interactive): New defcustom.
+
+ * net/tramp-sh.el (tramp-maybe-open-connection): Use it.
+
+2011-07-01 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (same-window-buffer-names, same-window-regexps)
+ (same-window-p, special-display-frame-alist)
+ (special-display-popup-frame, special-display-function)
+ (special-display-buffer-names, special-display-regexps)
+ (special-display-p, pop-up-frame-alist, pop-up-frame-function)
+ (pop-up-frames, display-buffer-reuse-frames, pop-up-windows)
+ (split-window-preferred-function, split-height-threshold)
+ (split-width-threshold, even-window-heights)
+ (display-buffer-mark-dedicated, window-splittable-p)
+ (split-window-sensibly, window-safely-shrinkable-p):
+ Un-obsolete.
+ (display-buffer): Don't spread args with function specifier
+ because special-display-popup-frame won't like it.
+
+2011-07-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Time-stamp simplifications and fixes.
+ These improve accuracy slightly, and future-proof the code
+ against some potential changes to current-time format.
+
+ * woman.el (woman-decode-buffer, WoMan-log-end): Log fractional secs
+ by using time-since and float-time.
+
+ * vc/ediff-util.el (ediff-calc-command-time): Use time-since
+ and float-time. Say "NNN.NNN seconds" rather than "NNN seconds
+ + NNN microseconds".
+
+ * type-break.el (type-break-time-sum): Rewrite using time-add.
+
+ * play/hanoi.el (hanoi-current-time-float): Remove.
+ All uses replaced by float-time.
+
+ * nxml/rng-maint.el (rng-time-function): Rewrite using time-subtract.
+ This yields a more-accurate answer.
+ (rng-time-to-float): Remove; no longer needed.
+
+ * emacs-lisp/timer.el (timer-relative-time): Use time-add.
+
+ * calendar/timeclock.el (timeclock-seconds-to-time):
+ Defalias to seconds-to-time, since they're the same thing.
+
+ * emacs-lisp/elp.el (elp-elapsed-time):
+ * emacs-lisp/benchmark.el (benchmark-elapse):
+ * allout-widgets.el (allout-elapsed-time-seconds): Use float-time.
+
+2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (bury-buffer): Don't iconify the only frame.
+ (switch-to-buffer): Revert to Emacs<23 behavior, i.e. do not fallback
+ to pop-to-buffer. Use pop-to-buffer-same-frame if you don't like that.
+
+2011-07-01 Chong Yidong <cyd@stupidchicken.com>
+
+ * eshell/em-smart.el (eshell-smart-display-navigate-list):
+ Add mouse-yank-primary.
+
+2011-07-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine3.el: New file to support CFEngine 3.x.
+
+2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/find-func.el (find-library--load-name): New fun.
+ (find-library-name): Use it to find relative load names when provided
+ absolute file name (bug#8803).
+
+2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * textmodes/flyspell.el (flyspell-word): Consider words that
+ differ only in case as potential doublons (bug#5687).
+
+ * net/soap-client.el (soap-invoke, soap-wsdl-resolve-references):
+ Remove two rather uninteresting debugging-like messages to make
+ debbugs.el more silent.
+
+ * comint.el (comint-password-prompt-regexp): Accept "Response" as
+ a password-like phrase.
+
+2011-06-30 Mastake YAMATO <yamato@redhat.com>
+
+ * progmodes/cc-guess.el: New file.
+
+ * progmodes/cc-langs.el (c-mode-menu): Add "Style..." submenu.
+
+ * progmodes/cc-styles.el (cc-choose-style-for-mode): New function
+ derived from `c-basic-common-init'.
+
+ * progmodes/cc-mode.el (top-level): Require cc-guess.
+ (c-basic-common-init): Use `cc-choose-style-for-mode'.
+
+2011-06-30 Lawrence Mitchell <wence@gmx.li>
+
+ * progmodes/js.el (js-mode): Don't stomp on global settings (bug#8933).
+
+2011-06-30 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-guess-continued-construct):
+ Correct the handling of template-args-cont, particularly for when font
+ lock is disabled. Name this case as "CASE G".
+
+2011-06-30 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el (allout-yank-processing): Fix injection of extra space
+ between bullet and non-whitespace character in first topic when
+ pasting, ensuring that the actual spacing in the pasted topic
+ following the bullet char is preserved. This extra space was
+ causing pasted encrypted topics to get a decrypted status even
+ when the content was actually still encrypted. Now the decryption
+ status from before the paste is preserved.
+
+ (allout-flag-region): Set all allout overlays so they evaporate
+ when reduced to zero length (evanescent), to prevent overlay
+ leakage.
+
+2011-06-30 Glenn Morris <rgm@gnu.org>
+
+ * w32-fns.el (w32-charset-info-alist): Declare.
+
+ * find-dired.el (find-grep-options): Simplify.
+
+ * term/ns-win.el (ns-set-resource): Declare.
+
+ * ses.el (row, col): Declare dynamic variables honestly.
+
+ * textmodes/reftex-parse.el (index-tags): Declare.
+
+2011-06-30 Chong Yidong <cyd@stupidchicken.com>
+
+ * cus-edit.el (customize-push-and-save): New function.
+
+ * files.el (hack-local-variables-confirm): Use it.
+
+ * custom.el (load-theme): New arg NO-CONFIRM.
+ Use customize-push-and-save (Bug#8720).
+ (custom-enabled-themes): Doc fix.
+
+ * cus-theme.el (customize-create-theme)
+ (custom-theme-merge-theme): Callers to load-theme changed.
+
+2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * thingatpt.el (thing-at-point-short-url-regexp): Require that
+ short URLs have at least one dot in them (bug #7614).
+
+ * progmodes/grep.el (rgrep): Bind `process-connection-type' to
+ nil, because using a pty is apparently too slow (bug #895).
+
+2011-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/sendmail.el (sendmail-query-once): New function.
+ (sendmail-query-once-function): New variable.
+
+2011-06-29 Glenn Morris <rgm@gnu.org>
+
+ * files.el (auto-mode-alist): Add .f03, .f08 for f90-mode.
+
+ * ses.el (top-level): Require cl when compiling.
+ (ses-set-localvars): Fix error statement.
+ Call it at compile time to silence a storm of warnings.
+
+2011-06-29 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (normalize-live-buffer): Rename to
+ window-normalize-buffer.
+ (normalize-live-frame): Rename to window-normalize-frame.
+ (normalize-any-window): Rename to window-normalize-any-window.
+ (normalize-live-window): Rename to window-normalize-live-window.
+ (make-window-atom): Rename to window-make-atom.
+ (window-resize-reset): Rename to window--resize-reset.
+ (window-resize-reset-1): Rename to window--resize-reset-1.
+ (resize-mini-window): Rename to window--resize-mini-window.
+ (resize-subwindows-skip-p): Rename to
+ window--resize-subwindows-skip-p.
+ (resize-subwindows-normal): Rename to
+ window--resize-subwindows-normal.
+ (resize-subwindows): Rename to window--resize-subwindows.
+ (resize-other-windows): Rename to window--resize-siblings.
+ (resize-this-window): Rename to window--resize-this-window.
+ (resize-root-window): Rename to window--resize-root-window.
+ (resize-root-window-vertically): Rename to
+ window--resize-root-window-vertically.
+ (normalize-buffer-to-display): Rename to
+ window-normalize-buffer-to-display.
+ (normalize-buffer-to-switch-to): Rename to
+ window-normalize-buffer-to-switch-to.
+ Correspondingly update all callers of the functions listed
+ above.
+ (display-buffer-alist, display-buffer-normalize-arguments)
+ (display-buffer-normalize-options, display-buffer)
+ (display-buffer-alist-set): Use "function" instead of
+ "fun-with-args".
+
+2011-06-28 Chong Yidong <cyd@stupidchicken.com>
+
+ * mail/emacsbug.el (report-emacs-bug): Handle non-gnu bug
+ addresses more clearly. Add hyperlinks for bug-gnu-emacs and
+ debbugs.gnu.org. Mention acknowledgment email.
+
+2011-06-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-send-it): Leave off changing the
+ buffer multibyteness, since it shouldn't matter.
+
+2011-06-28 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-in-side-window): Handle dedicated
+ windows as in display-buffer-reuse-window.
+ (display-buffer-normalize-alist): Use value of override
+ specifier.
+ (display-buffer-normalize-specifiers): Use value of
+ other-window-means-other-frame specifier.
+ (display-buffer-alist): Rewrite some texts in widgets.
+ (display-buffer): Spread arguments when calling function
+ specified by fun-with-args.
+
+2011-06-28 Deniz Dogan <deniz@dogan.se>
+
+ * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table):
+ Unnest `let'.
+
+ * textmodes/css-mode.el (css-font-lock-keywords): Fix grouped
+ selectors (Bug#5732).
+ (css-proprietary-nmstart-re): Use `regexp-opt'.
+
+2011-06-27 Jari Aalto <jari.aalto@cante.net>
+
+ * eshell/em-ls.el: Display `ls -l' dates in ISO format (Bug#8440).
+ (eshell-ls-date-format): New defcustom.
+ (eshell-ls-file): Use it.
+
+2011-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (describe-variable): Fix message for terminal-local vars.
+
+2011-06-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * net/ange-ftp.el: Allow loading .gz files (Bug#6923).
+ (ange-ftp-make-tmp-name): New arg.
+ (ange-ftp-file-local-copy): Use it.
+
+2011-06-27 Jambunathan K <kjambunathan@gmail.com>
+
+ * tar-mode.el (tar-untar-buffer): Set coding-system-for-write to
+ no-conversion (Bug#8870).
+
+2011-06-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-right, window-left, window-child)
+ (window-child-count, window-last-child)
+ (window-iso-combination-p, walk-window-tree-1)
+ (window-atom-check-1, window-tree-1, delete-window)
+ (window-state-get-1, display-buffer-even-window-sizes): Adapt to
+ new naming conventions - window-vchild, window-hchild,
+ window-next and window-prev are now called window-top-child,
+ window-left-child, window-next-sibling and window-prev-sibling
+ respectively.
+ (resize-window-reset): Rename to window-resize-reset.
+ (resize-window-reset-1): Rename to window-resize-reset-1.
+ (resize-window): Rename to window-resize.
+ (window-min-height, window-min-width)
+ (resize-mini-window, resize-this-window, resize-root-window)
+ (resize-root-window-vertically, adjust-window-trailing-edge)
+ (enlarge-window, shrink-window, maximize-window)
+ (minimize-window, delete-window, quit-restore-window)
+ (split-window, balance-windows, balance-windows-area-adjust)
+ (balance-windows-area, window-state-put-2)
+ (display-buffer-even-window-sizes, display-buffer-set-height)
+ (display-buffer-set-width, set-window-text-height)
+ (fit-window-to-buffer): Rename all "resize-window" prefixed
+ calls to use the "window-resize" prefix convention.
+ (display-buffer-alist): Fix symbol for label specifier.
+ (display-buffer-reuse-window): Set reuse-dedicated to cdr of
+ corresponding specifier.
+ Reported by Juanma Barranquero <lekktu@gmail.com>.
+
+2011-06-27 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-destroy-cell-variable-range): Fix heading comment
+ convention.
+ (ses-call-printer): Does not pass an empty string to formatter when the
+ cell is empty to keep from barking printer Calc math-format-value.
+
+2011-06-27 Richard Stallman <rms@gnu.org>
+
+ * battery.el (battery-mode-line-limit): New variable.
+ (battery-update): Handle it.
+
+ * mail/rmailmm.el (rmail-mime-process-multipart):
+ Handle truncated messages.
+
+2011-06-27 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/flymake.el (flymake-err-line-patterns):
+ Allow for column numbers in the ant/javac pattern. (Bug#8866)
+
+2011-06-27 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-relocate-range): Keep rest of arguments for ses-range.
+ (ses--clean-!, ses--clean-_): New functions.
+ (ses-range): Add configurability of readout order, and conversion
+ to Calc vector.
+
+ * ses.el (ses-repair-cell-reference-all): New function.
+ (ses-cell-symbol): Set macro as safe, so that it can be used in
+ formulas.
+
+ * ses.el: Update cycle detection algorithm.
+ (ses-localvars): Add ses--Dijkstra-attempt-nb and
+ ses--Dijkstra-weight-bound, and initial values thereof when applicable.
+ (ses-set-localvars): New function.
+ (ses-make-cell): Add property-list as a cell element.
+ (ses-cell-property-get-fun, ses-cell-property-get)
+ (ses-cell-property-delq-fun, ses-cell-property-set-fun)
+ (ses-cell-property-pop-fun, ses-cell-property-get-handle-fun):
+ New functions.
+ (ses-cell-property-set, ses-cell-property-pop)
+ (ses-cell-property-get-handle): New macro.
+ (ses-cell-property-handle-car, ses-cell-property-handle-setcar):
+ New aliases, used for code readability.
+ (ses-calculate-cell, ses-update-cells): Use Dijkstra algorithm for
+ cycle detection.
+ (ses-self-reference-early-detection): New defcustom.
+ (ses-formula-references): Robustify against self-refering cells.
+ (ses-mode): Use ses-set-localvars.
+ (ses-command-hook): Add call to ses-initialize-Dijkstra-attempt
+ before lauching the update processing.
+ (ses-initialize-Dijkstra-attempt): New function.
+ (ses-recalculate-cell): Update for cycle detection based on
+ Dijkstra algorithm.
+
+ * ses.el: Fix commenting and indenting convention.
+
+2011-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bs.el (bs-cycle-next): Complete last change.
+
+2011-06-27 Drew Adams <drew.adams@oracle.com>
+
+ * faces.el (list-faces-display): Add help-mode-map to output (bug#8939).
+
+2011-06-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (network-stream-open-starttls):
+ Don't re-get capabilities unless we've reestablished connection.
+ (network-stream-open-starttls): Fix stupid typo with gnutls-clii.
+
+ * mail/smtpmail.el (smtpmail-via-smtp): Bind coding-system-for-*
+ to binary to possibly avoid line encoding issues on Windows (among
+ other things).
+
+2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (open-network-stream): Return an :error
+ saying what the problem was, if possible.
+
+ * mail/smtpmail.el (smtpmail-via-smtp): Report the error from the
+ server.
+
+ * net/network-stream.el (network-stream-open-starttls): If we
+ wanted to use STARTTLS, and the server offered it, but we weren't
+ able to because we had no STARTTLS support, then close the connection.
+ (open-network-stream): Return an :error element, if present.
+
+2011-06-26 Chong Yidong <cyd@stupidchicken.com>
+
+ * hl-line.el (hl-line-sticky-flag): Doc fix.
+ (global-hl-line-sticky-flag): New option (Bug#8323).
+ (global-hl-line-highlight): Obey it.
+
+ * vc/vc.el (vc-revert-show-diff): Default to t.
+
+2011-06-26 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout-widgets.el (allout-widgets-post-command-business):
+ Stop decorating intermediate isearch matches. They're not being
+ undecorated when an isearch is continued past, and isearch
+ automatically collapses them. This leads to "widget leaks", where
+ decorated items accumulate in collapsed areas. Lines with lots of
+ hidden widgets can slow down cursor travel, substantially.
+ Too much complicated machinery would be needed to ensure undecoration,
+ so we're doing without this nicety.
+
+ (allout-widgets-tally-string): Don't try to do a hash-table-count
+ of allout-widgets-tally when it's nil. This eliminates spurious "Error
+ during redisplay: (wrong-type-argument hash-table-p nil)" warnings in
+ *Messages* when allout-widgets-maintain-tally is t.
+
+2011-06-26 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-normalize-argument): Rename to
+ display-buffer-normalize-arguments. Handle special meaning of
+ LABEL argument. Respect special-display-function when popping up
+ a new frame. Fix code searching for a window showing the buffer
+ on another frame.
+ (display-buffer-normalize-specifiers):
+ Call display-buffer-normalize-arguments.
+ (display-buffer-in-window): Don't undedicate the window if its
+ buffer remains the same.
+ Reported by Drew Adams <drew.adams@oracle.com>.
+ (display-buffer-alist): Add choice for same-window macro
+ specfier.
+ (display-buffer): Mention special meaning of LABEL argument in
+ doc-string. Fix quoting. Don't pop up a new frame even as
+ fallback.
+
+2011-06-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs-cycle-next): Pass current buffer to `bury-buffer' to
+ avoid deleting the current window in some cases (bug#8911).
+
+2011-06-26 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/smie.el (smie-bnf->prec2): Fix last change.
+ (Bug#8934)
+
+2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (network-stream-open-starttls):
+ Use built-in TLS support if `gnutls-available-p' is true.
+ (network-stream-open-tls): Ditto.
+
+2011-06-26 Leo Liu <sdl.web@gmail.com>
+
+ * register.el (registerv): New struct.
+ (registerv-make): New function.
+ (jump-to-register, describe-register-1, insert-register):
+ Support the jump-func, print-func and insert-func slot of a registerv
+ struct. (Bug#8415)
+
+2011-06-26 Chong Yidong <cyd@stupidchicken.com>
+
+ * vc/vc.el (vc-revert-show-diff): New defcustom.
+ (vc-diff-internal): New arg specifying diff buffer.
+ (vc-revert): Obey vc-revert-show-diff. If we show a diff, don't
+ reuse an existing *vc-diff* buffer (Bug#8927).
+
+ * progmodes/cperl-mode.el (cperl-mode): Derive from prog-mode.
+
+2011-06-26 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-critical-indent): New option.
+ (f90-font-lock-keywords-2, f90-blocks-re, f90-end-block-re)
+ (f90-start-block-re, f90-mode-abbrev-table): Add block, critical.
+ (f90-mode): Doc fix.
+ (f90-looking-at-critical, f90-looking-at-end-critical): New funcs.
+ (f90-no-block-limit, f90-calculate-indent, f90-end-of-block)
+ (f90-beginning-of-block, f90-next-block, f90-indent-region)
+ (f90-match-end): Handle block, critical.
+
+2011-06-25 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-included-files): Doc fix.
+ (diary-include-files): New function, extracted from
+ diary-include-other-diary-files and diary-mark-included-diary-files.
+ (diary-include-other-diary-files, diary-mark-included-diary-files):
+ Just call diary-include-files.
+ (diary-mark-entries): Reset diary-included-files on first call.
+
+ * calendar/diary-lib.el (diary-mark-entries)
+ (diary-mark-included-diary-files):
+ Visit included diary-files in temp buffers.
+
+ * progmodes/f90.el (f90-keywords-re, f90-font-lock-keywords-1)
+ (f90-blocks-re, f90-program-block-re, f90-end-block-re)
+ (f90-start-block-re, f90-imenu-generic-expression)
+ (f90-looking-at-program-block-start, f90-no-block-limit):
+ Add support for submodules.
+
+ * progmodes/f90.el (f90-keywords-re, f90-keywords-level-3-re)
+ (f90-procedures-re, f90-constants-re): Add some F2008 stuff.
+
+2011-06-25 Eli Zaretskii <eliz@gnu.org>
+
+ * net/ange-ftp.el (ange-ftp-insert-file-contents): Let-bind
+ buffer-file-type before setting its value, to avoid disastrous
+ global effects on decoding files for DOS/Windows systems. (Bug#8780)
+
+2011-06-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * allout.el (allout-unload-function): Pass -1 to `allout-mode'.
+
+ * ses.el (ses-unload-function):
+ * emacs-lisp/re-builder.el (re-builder-unload-function): Simplify.
+
+ * proced.el (proced-unload-function):
+ * progmodes/cperl-mode.el (cperl-mode-unload-function): Remove.
+
+2011-06-25 Andreas Rottmann <a.rottmann@gmx.at>
+
+ * server.el (server-create-window-system-frame): Add parameters arg.
+ (server-process-filter): Doc fix. Handle frame-parameters.
+
+2011-06-25 Juanma Barranquero <lekktu@gmail.com>
+
+ Fix bug#8730, bug#8781.
+
+ * loadhist.el (unload--set-major-mode): New function.
+ (unload-feature): Use it.
+
+ * progmodes/python.el (python-after-info-look): Add autoload cookie.
+ (python-unload-function): New function.
+
+2011-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mail/rmail.el (rmail-show-message-1): Use restore-buffer-modified-p.
+
+2011-06-25 Giuseppe Scrivano <gscrivano@gnu.org>
+
+ * net/browse-url.el (browse-url-firefox-program): Add icecat to
+ the candidates list.
+
+2011-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/verilog-mode.el (verilog-mode): Fix test for bound variable.
+
+2011-06-23 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el: Going to grep hit in Rmail buffer finds the message.
+ (rmail-variables): Set next-error-move-function.
+ (rmail-what-message): Take argument POS.
+ (rmail-next-error-move): New function.
+
+2011-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-bnf->prec2): Give more understandable error
+ messages for adjacent non-terminals.
+
+2011-06-23 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el (rmail-retry-ignored-headers): Add message-id.
+ (rmail-show-message-1): Preserve buffer modified flag.
+ (rmail-start-mail): Don't specify use of rmail-mail-return;
+ that's done by mail-bury now.
+ (rmail-mail-return): Handle arg NEWBUF.
+
+2011-06-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-method-out-of-band-p): Check, whether
+ SIZE is a number.
+
+2011-06-23 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (get-lru-window, get-mru-window)
+ (get-largest-window): Never return a minibuffer window.
+ (display-buffer-pop-up-window): Fix a bug that could lead to
+ reusing the minibuffer window.
+ (display-buffer): Pass original specifier argument to
+ display-buffer-function instead of the normalized one.
+ Reported by Thierry Volpiatto <thierry.volpiatto@gmail.com>.
+
+2011-06-22 Leo Liu <sdl.web@gmail.com>
+
+ * minibuffer.el (completing-read-function)
+ (completing-read-default): Move from minibuf.c
+
+2011-06-22 Richard Stallman <rms@gnu.org>
+
+ * mail/sendmail.el (mail-bury): If Rmail is in use, return nicely
+ to Rmail even if not started by a special Rmail command.
+
+ * mail/rmailmm.el (rmail-insert-mime-forwarded-message):
+ Copy the buffer currently showing just one message.
+
+2011-06-22 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-entry-update): Use mapc.
+ (bibtex-clean-entry): First delete the old key so that a
+ customized algorithm for generating the new key does not get
+ confused by the old key.
+ (bibtex-url): Obey regexp of first step.
+ (bibtex-search-entries): Do not use add-to-list with local
+ list-var.
+
+2011-06-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-try-auth-methods): If the user has
+ stored a user name, then query for the password first, instead of
+ waiting for SMTP to give an error message and the trying again.
+
+2011-06-22 Lawrence Mitchell <wence@gmx.li>
+
+ * net/browse-url.el (browse-url-xdg-open): Use 0, rather than nil
+ BUFFER in call-process.
+
+2011-06-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-via-smtp): Make sure we don't send
+ QUIT twice.
+ (smtpmail-try-auth-methods): Require user name and password from
+ auth-source.
+
+2011-06-22 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-default-specifiers)
+ (display-buffer-alist): Remove entries for pop-up-frame-alist.
+ Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
+ (split-window): Normalize SIDE argument (Bug#8916).
+
+ * frame.el (pop-up-frame-alist, pop-up-frame-function)
+ (special-display-frame-alist, special-display-popup-frame):
+ Remove duplicate declarations. These are now in window.el.
+
+2011-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-via-smtp):
+ Set :use-starttls-if-possible so that we always use STARTTLS if the
+ server supports it. SMTP servers that support STARTTLS commonly
+ require it.
+
+ * net/network-stream.el (network-stream-open-starttls): Support
+ upgrading to STARTTLS always, even if we don't have built-in support.
+ (open-network-stream): Add the :always-query-capabilies keyword.
+
+ * mail/smtpmail.el: Rewritten to do opportunistic STARTTLS
+ upgrades with `open-network-stream', and rely solely on
+ auth-source for all credentials. Big changes throughout the file,
+ but in particular:
+ (smtpmail-auth-credentials): Remove.
+ (smtpmail-starttls-credentials): Remove.
+ (smtpmail-via-smtp): Check for servers saying they want AUTH after
+ MAIL FROM, too.
+
+ * net/network-stream.el (network-stream-open-starttls):
+ Provide support for client certificates both for external and built-in
+ STARTTLS.
+ (auth-source): Require.
+ (open-network-stream): Document the :client-certificate keyword.
+ (network-stream-certificate): Change cert-cert to cert and
+ cert-key to key.
+
+2011-06-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (top): Don't load the persistency file when
+ "emacs -Q" has been called.
+
+2011-06-21 Tim Harper <timcharper@gmail.com>
+
+ * term/ns-win.el (ns-initialize-window-system):
+ Set application-specific `ApplePressAndHoldEnabled' system
+ resource to NO as it is not yet supported by the NS port.
+
+2011-06-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * misc.el (list-dynamic-libraries--refresh): Compute header here...
+ (list-dynamic-libraries): ...not here.
+
+2011-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (sha1): Implement sha1 using secure-hash.
+
+2011-06-21 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-alist): In default value do not
+ enforce searching a window on any but the selected frame.
+ Reported by Katsumi Yamaoka <yamaoka@jpl.org>.
+ (display-buffer-select-window): Remove function.
+ (display-buffer-in-window): When a window on another frame gets
+ reused, do not select it any more but just raise its frame if
+ necessary (Bug#8851) and (Bug#8856).
+ (display-buffer-normalize-options): Handle pop-up-frames related
+ options more faithfully.
+ (pop-to-buffer): Don't rely on `display-buffer' selecting the
+ window if it is on another frame.
+ (display-buffer-alist, display-buffer-default-specifiers):
+ Don't make new frame unsplittable by default.
+ (display-buffer-normalize-argument): Fix doc-string typo and use
+ 'same-frame-other-window instead of 'other-window when associating
+ with display-buffer-macro-specifiers.
+
+2011-06-21 Vincent Belaïche <vincent.b.1@hotmail.fr>
+
+ * play/5x5.el (5x5-solve-rotate-left, 5x5-solve-rotate-right):
+ New functions.
+ (5x5-mode-map, 5x5-mode-menu): Bind them.
+ (5x5-draw-grid): Tweak the solver's rendering.
+
+2011-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist): Rename
+ `caml' to `python-tracebacks-and-caml'; allow leading tabs (bug#8585).
+
+2011-06-21 Drew Adams <drew.adams@oracle.com>
+
+ * menu-bar.el: Use function variable instead of switch-to-buffer.
+ (menu-bar-select-buffer-function): New variable.
+ (menu-bar-update-buffers): Use it (bug#8876).
+
+2011-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (add-to-list): Add handler to check the
+ variable's status.
+
+2011-06-20 Jan Djärv <jan.h.d@swipnet.se>
+
+ * x-dnd.el (x-dnd-version-from-flags)
+ (x-dnd-more-than-3-from-flags): New functions that handle long-as-cons
+ and long as number (Bug#8899).
+ (x-dnd-handle-xdnd): Call functions above (Bug#8899).
+
+2011-06-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-metadata): Add `metadata' to the alist.
+ (completion-try-completion, completion-all-completions): Compute the
+ metadata argument if it's missing; make it optional (bug#8795).
+
+ * wid-edit.el: Use lex-bind and move towards completion-at-point.
+ (widget-complete): Use new :completion-function property.
+ (widget-completions-at-point): New function.
+ (default): Use :completion-function instead of :complete.
+ (widget-default-completions): Rename from widget-default-complete;
+ Rewrite.
+ (widget-string-complete, widget-file-complete, widget-color-complete):
+ Remove functions.
+ (file, symbol, function, variable, coding-system, color):
+ * international/mule-cmds.el (default-input-method, charset)
+ (language-info-custom-alist):
+ * cus-edit.el (face): Use new property :completions.
+
+ * progmodes/pascal.el (pascal-completions-at-point): New function.
+ (pascal-mode): Use it.
+ (pascal-mode-map): Use completion-at-point.
+ (pascal-toggle-completions): Make obsolete.
+ (pascal-complete-word, pascal-show-completions):
+ * progmodes/octave-mod.el (octave-complete-symbol):
+ Redefine as obsolete alias.
+ * progmodes/octave-inf.el (inferior-octave-completion-at-point):
+ Signal absence of completion info for old Octave,
+ (inferior-octave-complete): Redefine as obsolete alias.
+ * progmodes/meta-mode.el: Use lexical-binding and completion-at-point.
+ (meta-completions-at-point): Rename from meta-complete-symbol and
+ adapt it for use on completion-at-point-functions.
+ (meta-common-mode): Use it.
+ (meta-looking-at-backward, meta-match-buffer): Remove.
+ (meta-complete-symbol): Redefine as obsolete alias.
+ (meta-common-mode-map): Use completion-at-point.
+ * progmodes/make-mode.el: Use lexical-binding and completion-at-point.
+ (makefile-mode-map): Use completion-at-point.
+ (makefile-completions-at-point): Rename from makefile-complete and
+ adapt it for use on completion-at-point-functions.
+ (makefile-mode): Use it.
+ (makefile-complete): Redefine as obsolete alias.
+
+2011-06-20 Deniz Dogan <deniz@dogan.se>
+
+ * net/rcirc.el: Delete trailing whitespaces once and for all.
+
+2011-06-20 Daniel Colascione <dan.colascione@gmail.com>
+
+ * emacs-lisp/syntax.el (syntax-ppss): Further improve docstring.
+
+2011-06-19 Chong Yidong <cyd@stupidchicken.com>
+
+ * files.el (auto-mode-alist): Entry for m2-mode (Bug#8852).
+
+ * info.el (Info-apropos-toc-nodes): Minor doc fix (Bug#8833).
+
+2011-06-19 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-other-window-means-other-frame):
+ Call display-buffer-normalize-alist.
+ (display-buffer-normalize-specifiers-1): Rename to
+ display-buffer-normalize-argument. New argument other-frame.
+ Rewrite.
+ (display-buffer-normalize-specifiers-2): Rename to
+ display-buffer-normalize-options.
+ (display-buffer-normalize-alist-1): New function.
+ (display-buffer-normalize-specifiers-3): Rename to
+ display-buffer-normalize-alist.
+ Call display-buffer-normalize-alist-1.
+ (display-buffer-normalize-options-inhibit): New variable.
+ (display-buffer-normalize-specifiers): Rewrite calling
+ display-buffer-normalize-alist,
+ display-buffer-normalize-argument, and
+ display-buffer-normalize-options. Don't call the latter if
+ display-buffer-normalize-options-inhibit is non-nil.
+ (frame-auto-delete): New option.
+ (window-deletable-p): Use frame-auto-delete.
+ (window-list-no-nils, window-state-ignored-parameters)
+ (window-state-get-1, window-state-get, window-state-put-list)
+ (window-state-put-1, window-state-put-2, window-state-put):
+ New functions.
+ (display-buffer-normalize-options): Move special-display-p group
+ after pop-up-frame group (Bug#8851) and (Bug#8856).
+
+2011-06-18 Chong Yidong <cyd@stupidchicken.com>
+
+ * emacs-lisp/rx.el (rx-constituents): Add support for numbered
+ groups (Bug#8776).
+ (rx-submatch-n): New function.
+ (rx): Document it.
+
+ * dired-x.el (dired-mark-unmarked-files): Fix interactive spec
+ (Bug#8768).
+
+ * replace.el (occur-mode-map): Set occur-edit-mode binding to "e".
+
+ * textmodes/fill.el (default-justification): Add :safe (Bug#8879).
+
+ * cus-face.el (custom-declare-face): Call custom-theme-recalc face
+ anytime existing face settings are present (Bug#8889).
+
+ * progmodes/delphi.el (delphi-mode-syntax-table): Use defvar.
+ (delphi-mode): Use define-derived-mode to inherit from prog-mode.
+ Remove unused argument.
+
+2011-06-18 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-default-specifiers):
+ Remove pop-up-frame. Add pop-up-window-min-height,
+ pop-up-window-min-width, and another reuse-window specifier
+ (Bug#8882). Reported by Dan Nicolaescu <dann@gnu.org>.
+ (display-buffer-normalize-specifiers-2):
+ Handle split-height-threshold and split-width-threshold also when
+ pop-up-windows is unset. Add a reuse-window specifier for the
+ case popping up a new window fails.
+ (special-display-popup-frame): Remove double quoting.
+ (display-buffer-normalize-specifiers-1): Fix thinko.
+
+2011-06-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-completion-vars): Set pcomplete-termination-string
+ according to comint-completion-addsuffix.
+
+ * pcomplete.el: Convert to lexical binding and fix bug#8819.
+ (pcomplete-suffix-list): Mark as obsolete.
+ (pcomplete-completions-at-point): Capture pcomplete-norm-func and
+ pcomplete-seen in the closure.
+ (pcomplete-comint-setup): Setup completion-at-point as well.
+ (pcomplete--entries): New function.
+ (pcomplete--env-regexp): New var.
+ (pcomplete-entries): Rewrite to work with partial-completion and
+ without relying on pcomplete-suffix-list.
+ (pcomplete-pare-list): Remove, unused.
+
+2011-06-17 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-alist): Set pop-up-window-min-height
+ and pop-up-window-min-width in default value. Reported by
+ Thierry Volpiatto <thierry.volpiatto@gmail.com>. New specifier
+ other-window-means-other-frame.
+ (display-buffer-macro-specifiers): Comment out entry for
+ other-window specifier.
+ (display-buffer-other-window-means-other-frame): New function.
+ (display-buffer-normalize-specifiers-1): New arguments
+ buffer-name and label. Treat other-window case specially.
+ (display-buffer-normalize-specifiers-2): Treat other-window case
+ specially.
+ (display-buffer-normalize-specifiers-3): New function.
+ (display-buffer-normalize-specifiers):
+ Call display-buffer-normalize-specifiers-3.
+
+2011-06-17 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (same-window-p): Fix two typos introduced when
+ adding with-no-warnings.
+ (display-buffer-normalize-specifiers-1): Don't check
+ pop-up-frames for 'unset initialization.
+ (display-buffer-normalize-specifiers-2): Major rewrite using
+ special-display-p and same-window-p (Bug#8851) and (Bug#8856).
+ (pop-up-frames, display-buffer-reuse-frames)
+ (display-buffer-mark-dedicated): Don't initialize to 'unset.
+ Suggested by David Engster <deng@randomsample.de>.
+ (even-window-heights): Initialize to 'unset.
+ (display-buffer-alist-set): Handle new 'unset initializations.
+ (display-buffer-macro-specifiers): Don't pop up a new frame in the
+ other window case.
+
+2011-06-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-normalize-specifiers-1):
+ Respect current value of pop-up-frames for most reasonable values of
+ second argument of display-buffer (Bug#8865).
+ (switch-to-buffer-same-frame, switch-to-buffer-other-window)
+ (switch-to-buffer-other-window-same-frame)
+ (switch-to-buffer-other-frame): Fix doc-strings. Reported by Drew
+ Adams (Bug#8875).
+ (display-buffer): Don't check noninteractive when calling
+ display-buffer-pop-up-frame.
+ (display-buffer-pop-up-frame): Never pop up a frame in
+ noninteractive mode (Bug#8857).
+ (enlarge-window, shrink-window): Don't report an error when the
+ window can't be resized as requested (Bug#8862).
+
+2011-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * pcmpl-rpm.el (pcomplete/rpm): Minor simplification.
+
+ * emacs-lisp/debug.el (debug): Don't leave the buffer in Debugger.
+
+ * abbrev.el (define-abbrev-table): Don't add a table multiple times.
+
+2011-06-15 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-fonts.el (c-font-lock-declarations): 1: Whilst checking
+ for declarators, disable knr checking to speed up for normal files.
+ 2: Refactor, replacing a sequence of nested if forms by a cond form.
+
+2011-06-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (open-network-stream): Add the keyword
+ :always-query-capabilities for the case where you want to force a
+ `plain' network connection, but the protocol still requires the
+ capabilitiy command (i.e., SMTP and EHLO).
+
+ * subr.el (process-live-p): Rename from `process-alive-p' for
+ consistency with other `-live-p' functions.
+
+2011-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (same-window-buffer-names, same-window-regexps)
+ (special-display-frame-alist, special-display-popup-frame)
+ (special-display-function, special-display-buffer-names)
+ (special-display-regexps, pop-up-frame-alist)
+ (pop-up-frame-function, pop-up-frames, display-buffer-reuse-frames)
+ (pop-up-windows, split-window-preferred-function)
+ (split-height-threshold, split-width-threshold, even-window-heights)
+ (display-buffer-mark-dedicated): Don't encourage the use of
+ display-buffer-alist from Elisp code.
+
+2011-06-15 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * progmodes/python.el (python-mode): Derive from prog-mode.
+ * progmodes/ps-mode.el (ps-mode):
+ * progmodes/mixal-mode.el (mixal-mode):
+ * progmodes/cfengine.el (cfengine-mode):
+ * progmodes/ld-script.el (ld-script-mode): Likewise.
+
+2011-06-15 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-alist): Trim default value to avoid
+ popping up a new frame (Bug#8857) or reusing an arbitrary window
+ on another frame.
+ (display-buffer): Do not fall back on popping up a new frame in
+ batch mode (Bug#8857).
+
+2011-06-14 Chong Yidong <cyd@stupidchicken.com>
+
+ * cus-theme.el (describe-theme-1): Use custom-theme-p.
+ (custom-theme-summary): New function.
+ (customize-themes): Use it.
+
+2011-06-13 Glenn Morris <rgm@gnu.org>
+
+ * cus-dep.el (custom-make-dependencies): Use up command-line-args-left.
+
+2011-06-13 Martin Rudalics <rudalics@gmx.at>
+
+ * help.el (help-window): Remove variable.
+ (help-window-point-marker, temp-buffer-max-height)
+ (temp-buffer-resize-mode, help-window-select): Rewrite doc-strings.
+ (help-print-return-message): Don't set help-window.
+ (resize-temp-buffer-window): Rewrite cod eand doc-string.
+ (help-window-setup-finish): Remove.
+ (help-window-display-message, help-window-setup)
+ (with-help-window): Major rewrite based on new
+ display-buffer-window variable.
+
+ * help-mode.el (help-mode-finish): Remove help-window related
+ code.
+
+ * view.el (view-exits-all-viewing-windows): Remove reference to
+ view-return-to-alist in doc-string.
+ (view-return-to-alist): Make obsolete.
+ (view-buffer): Call pop-to-buffer-same-window and remove
+ undo-window code.
+ (view-buffer-other-window): Call pop-to-buffer-other-window and
+ simplify code. Ignore second argument.
+ (view-buffer-other-frame): Call pop-to-buffer-other-frame and
+ simplify code. Ignore second argument.
+ (view-return-to-alist-update): Make obsolete.
+ (view-mode-enter): Rename second argument to QUIT-RESTORE.
+ Rewrite using quit-restore window parameters.
+ (view-mode-exit): Rename second argument to EXIT-ONLY.
+ Rewrite using quit-restore-window.
+ (View-exit, View-exit-and-edit, View-leave, View-quit)
+ (View-quit-all, View-kill-and-leave): Call view-mode-exit with
+ appropriate arguments.
+ (view-end-message): Use quit-restore window parameter.
+
+ * window.el (display-buffer-function): Rewrite doc-string.
+ (display-buffer-window, display-buffer-alist): New variables.
+ (display-buffer-split-specifiers)
+ (display-buffer-side-specifiers)
+ (display-buffer-macro-specifiers): New constants.
+ (display-buffer-even-window-sizes, display-buffer-set-height)
+ (display-buffer-set-width, display-buffer-select-window)
+ (display-buffer-in-window, display-buffer-reuse-window)
+ (display-buffer-split-window-1, display-buffer-split-window)
+ (display-buffer-split-atom-window, display-buffer-pop-up-window)
+ (display-buffer-pop-up-frame, display-buffer-pop-up-side-window)
+ (display-buffer-in-side-window, normalize-buffer-to-display)
+ (display-buffer-normalize-specifiers-1)
+ (display-buffer-normalize-specifiers-2)
+ (display-buffer-normalize-specifiers, display-buffer-frame):
+ New functions.
+ (display-buffer): Major rewrite.
+ (display-buffer-other-window, display-buffer-other-frame)
+ (pop-to-buffer, switch-to-buffer-other-window)
+ (switch-to-buffer-other-frame): Rewrite.
+ (display-buffer-same-window, display-buffer-same-frame)
+ (display-buffer-same-frame-other-window)
+ (pop-to-buffer-same-window, pop-to-buffer-same-frame)
+ (pop-to-buffer-other-window)
+ (pop-to-buffer-same-frame-other-window)
+ (pop-to-buffer-other-frame, switch-to-buffer-same-frame)
+ (switch-to-buffer-other-window-same-frame): New functions.
+ (same-window-p, special-display-p): Rewrite disabling warnings.
+ Make obsolete.
+ (pop-up-frames, display-buffer-reuse-frames, pop-up-windows)
+ (display-buffer-mark-dedicated): Initialize to symbol 'unset.
+ Make obsolete
+ (same-window-buffer-names, same-window-regexps)
+ (special-display-frame-alist, special-display-popup-frame)
+ (special-display-function, special-display-buffer-names)
+ (special-display-regexps, pop-up-frame-alist)
+ (pop-up-frame-function, split-window-preferred-function)
+ (split-height-threshold, split-width-threshold)
+ (even-window-heights): Make obsolete.
+
+2011-06-12 Glenn Morris <rgm@gnu.org>
+
+ * term/xterm.el (terminal-init-xterm): `version' may be nil. (Bug#8838)
+ Misc simplifications.
+
+2011-06-12 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-safely-shrinkable-p): Restore function which
+ was inadvertently removed in change from 2011-06-11. Declare as
+ obsolete.
+
+ * calendar/calendar.el (calendar-generate-window):
+ Use window-iso-combined-p instead of combination of one-window-p and
+ window-safely-shrinkable-p.
+
+2011-06-12 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/fortran.el (fortran-mode-syntax-table):
+ * progmodes/f90.el (f90-mode-syntax-table):
+ Set % to punctuation. (Bug#8820)
+ (f90-find-tag-default): Remove, no longer needed.
+
+2011-06-12 Daniel Colascione <dan.colascione@gmail.com>
+
+ * emacs-lisp/syntax.el (syntax-ppss): Clarify which items are invalid.
+
+2011-06-11 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.el (image-animated-p): Return animation delay in seconds.
+ Avoid bit manipulation in Lisp; use `delay' entry in the metadata.
+ (image-animate-timeout): Remove DELAY argument. Don't assume
+ every subimage has the same delay; get it from image-animated-p.
+ (image-animate): Caller changed.
+
+2011-06-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-debug-message): Add `tramp-with-progress-reporter'
+ to ignored backtrace functions.
+
+2011-06-11 Glenn Morris <rgm@gnu.org>
+
+ * calendar/appt.el (appt-disp-window-function): Doc fix.
+ (appt-check): Handle overlapping appointments. (Bug#8337)
+
+2011-06-11 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-tree-1, window-tree): New functions, moving
+ the latter to window.el.
+ (bw-get-tree, bw-get-tree-1, bw-find-tree-sub)
+ (bw-find-tree-sub-1, bw-l, bw-t, bw-r, bw-b, bw-dir, bw-eqdir)
+ (bw-refresh-edges): Remove.
+ (balance-windows-1, balance-windows-2): New functions.
+ (balance-windows): Rewrite in terms of window tree functions,
+ balance-windows-1 and balance-windows-2.
+ (bw-adjust-window): Remove.
+ (balance-windows-area-adjust): New function with functionality of
+ bw-adjust-window but using resize-window.
+ (set-window-text-height): Rewrite doc-string.
+ Use normalize-live-window and resize-window.
+ (enlarge-window-horizontally, shrink-window-horizontally):
+ Rename argument to DELTA.
+ (window-buffer-height): New function.
+ (fit-window-to-buffer, shrink-window-if-larger-than-buffer):
+ Rewrite using new window resize routines.
+ (kill-buffer-and-window, mouse-autoselect-window-select):
+ Use ignore-errors instead of condition-case.
+ (quit-window): Call delete-frame instead of delete-windows-on
+ for the only buffer on frame.
+
+2011-06-10 Martin Rudalics <rudalics@gmx.at>
+
+ * loadup.el (top-level): Load window before files for the sake
+ of replace-buffer-in-windows.
+
+ * files.el (read-buffer-to-switch)
+ (switch-to-buffer-other-window)
+ (switch-to-buffer-other-frame, display-buffer-other-frame):
+ Move to window.el.
+
+ * simple.el (get-next-valid-buffer, last-buffer, next-buffer)
+ (previous-buffer): Move to window.el.
+
+ * bindings.el (unbury-buffer): Move to window.el.
+
+ * window.el (delete-other-windows-vertically): Move after
+ definition of delete-other-windows.
+ (other-window, delete-windows-on, replace-buffer-in-windows):
+ Move here from window.c.
+ (record-window-buffer, unrecord-window-buffer)
+ (set-window-buffer-start-and-point, switch-to-prev-buffer)
+ (switch-to-next-buffer): New functions.
+ (get-next-valid-buffer, last-buffer, next-buffer): Move here
+ from simple.el. Call switch-to-next-buffer.
+ (previous-buffer): Move here from simple.el.
+ Call switch-to-prev-buffer.
+ (bury-buffer): Move here from buffer.c. Switch to previous
+ buffer when window cannot be deleted.
+ (unbury-buffer): Move here from bindings.el.
+ (ctl-x-map): Move binding for other-window from window.c to
+ here.
+ (read-buffer-to-switch, switch-to-buffer-other-window)
+ (switch-to-buffer-other-frame): Move here from files.el.
+ (normalize-buffer-to-switch-to): New functions.
+ (switch-to-buffer): Move here from buffer.c.
+ Use read-buffer-to-switch and normalize-buffer-to-switch-to.
+
+2011-06-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-min-height, window-min-width): Move here
+ from window.c. Add defcustoms and rewrite doc-strings.
+ (resize-mini-window, resize-window): New functions.
+ (adjust-window-trailing-edge, enlarge-window, shrink-window):
+ Move here from window.c.
+ (maximize-window, minimize-window): New functions.
+ (delete-window, delete-other-windows, split-window): Move here
+ from window.c.
+ (window-split-min-size): New function.
+ (split-window-keep-point): Mention split-window-above-each-other
+ instead of split-window-vertically.
+ (split-window-above-each-other, split-window-vertically):
+ Rename split-window-vertically to split-window-above-each-other and
+ provide defalias for old definition.
+ (split-window-side-by-side, split-window-horizontally): Rename
+ split-window-horizontally to split-window-side-by-side and provide
+ defalias for the old definition.
+ (ctl-x-map): Move bindings for delete-window,
+ delete-other-windows and enlarge-window here from window.c.
+ Replace bindings for split-window-vertically and
+ split-window-horizontally by bindings for
+ split-window-above-each-other and split-window-side-by-side.
+
+ * cus-start.el (all): Remove entries for window-min-height and
+ window-min-width. Add entries for window-splits and
+ window-nest.
+
+2011-06-09 Glenn Morris <rgm@gnu.org>
+
+ * calendar/appt.el (appt-mode-line): New function.
+ (appt-check, appt-disp-window): Use it.
+
+ * files.el (hack-one-local-variable-eval-safep):
+ Allow minor-modes with explicit +/-1 arguments.
+
+2011-06-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * term/xterm.el (xterm): Add defgroup.
+ (xterm-extra-capabilities): Add defcustom to supply known xterm
+ capabilities, skip querying them, or query them (default).
+ (terminal-init-xterm): Use it.
+ (terminal-init-xterm-modify-other-keys): New function to set up
+ modifyOtherKeys support to simplify `terminal-init-xterm'.
+
+2011-06-09 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (resize-window-reset, resize-window-reset-1)
+ (resize-subwindows-skip-p, resize-subwindows-normal)
+ (resize-subwindows, resize-other-windows, resize-this-window)
+ (resize-root-window, resize-root-window-vertically)
+ (window-deletable-p, window-or-subwindow-p)
+ (frame-root-window-p): New functions.
+
+2011-06-09 Glenn Morris <rgm@gnu.org>
+
+ * net/ange-ftp.el (ange-ftp-switches-ok): New function.
+ (ange-ftp-get-files): Use it.
+
+2011-06-09 Alexander Klimov <alserkli@inbox.ru> (tiny change)
+
+ * mail/sendmail.el (mail-recover-1, mail-recover):
+ * files.el (recover-file, recover-session):
+ Handle dired-listing-switches not being just a single short option.
+
+2011-06-09 Glenn Morris <rgm@gnu.org>
+
+ * calendar/appt.el (appt-display-message, appt-disp-window):
+ Handle lists of appointments.
+
+2011-06-08 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (one-window-p): Move down in code.
+ Rewrite doc-string.
+ (window-current-scroll-bars): Rewrite doc-string.
+ Normalize live window argument.
+ (walk-windows, get-window-with-predicate, count-windows):
+ Rewrite doc-string. Use window-list-1.
+ (window-in-direction-2, window-in-direction, get-mru-window):
+ New functions.
+
+2011-06-08 Reuben Thomas <rrt@sc3d.org>
+
+ * progmodes/flymake.el (flymake-compilation-prevents-syntax-check):
+ Doc fix (Bug#8713).
+
+2011-06-08 Chong Yidong <cyd@stupidchicken.com>
+
+ * repeat.el (repeat-on-final-keystroke): Fix type (Bug#8696).
+
+2011-06-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * loadhist.el (unload-feature-special-hooks):
+ Add `comint-output-filter-functions'.
+
+2011-06-08 Ivan Kanis <gnu@kanis.fr>
+
+ * calendar/appt.el (appt-check): Move some initializations into the let.
+
+2011-06-08 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-height): Defalias to window-total-height.
+ (window-width): Defalias to window-body-width.
+
+2011-06-07 Chong Yidong <cyd@stupidchicken.com>
+
+ * image-mode.el (image-toggle-animation): New command.
+ (image-mode-map): Bind it to RET.
+ (image-mode): Update message.
+ (image-toggle-display-image): Avoid a spurious cache flush.
+ (image-transform-rotation): Doc fix.
+ (image-transform-properties): Return quickly in the normal case.
+ (image-animate-loop): Rename from image-animate-max-time.
+
+ * image.el (image-animate-max-time): Move to image-mode.el.
+ (create-animated-image): Remove unnecessary function.
+ (image-animate): Rename from image-animate-start. New arg.
+ (image-animate-stop): Remove; just use image-animate-timer.
+ (image-animate-timer): Use car-safe.
+ (image-animate-timeout): Rename argument.
+
+2011-06-07 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (get-lru-window, get-largest-window): Move here from
+ window.c. Rename first argument to ALL-FRAMES.
+ Rephrase doc-strings.
+ (get-buffer-window-list): Rewrite using window-list-1.
+ Rephrase doc-string.
+ (window-safe-min-height, window-safe-min-width): New constants.
+ (window-size-ignore, window-min-size, window-min-size-1)
+ (window-sizable, window-sizable-p, window-size-fixed-1)
+ (window-size-fixed-p, window-min-delta-1, window-min-delta)
+ (window-max-delta-1, window-max-delta, window-resizable)
+ (window-resizable-p, window-total-height, window-total-width)
+ (window-body-width): New functions.
+ (window-full-height-p, window-full-width-p): Rewrite using
+ window-total-size.
+ (window-body-height): Rewrite using window-body-size.
+
+2011-06-06 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-right, window-left, window-child)
+ (window-child-count, window-last-child, window-any-p)
+ (normalize-live-buffer, normalize-live-frame)
+ (normalize-any-window, normalize-live-window)
+ (window-iso-combination-p, window-iso-combined-p)
+ (window-iso-combinations)
+ (walk-window-tree-1, walk-window-tree, walk-window-subtree)
+ (windows-with-parameter, window-with-parameter)
+ (window-atom-root, make-window-atom, window-atom-check-1)
+ (window-atom-check, window-side-check, window-check):
+ New functions.
+ (ignore-window-parameters, window-sides, window-sides-vertical)
+ (window-sides-slots): New variables.
+ (window-size-fixed): Move down in code. Minor doc-string fix.
+
+2011-06-05 Andreas Schwab <schwab@linux-m68k.org>
+
+ * comint.el (comint-dynamic-complete-as-filename)
+ (comint-dynamic-complete-filename): Correctly call
+ completion-in-region.
+
+2011-06-05 Deniz Dogan <deniz@dogan.se>
+
+ * net/rcirc.el (rcirc-prompt-for-encryption): Fix bug introduced
+ in last change.
+
+2011-06-05 Deniz Dogan <deniz@dogan.se>
+
+ * net/rcirc.el (rcirc-prompt-for-encryption): New function.
+ (rcirc): Use it to prompt for encryption.
+
+2011-06-05 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-search-buffer): New variable.
+ (bibtex-search-entries): New command bound to C-c C-a.
+ (bibtex-display-entries): New function.
+
+2011-06-05 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-generate-url-list): Fix docstring.
+ (bibtex-insert-kill): After yanking insert newline if necessary.
+ (bibtex-initialize): Call bibtex-string-files-init only once.
+ (bibtex-mode): Do not call easy-menu-add.
+ (bibtex-validate-globally): Use save-excursion in bibtex buffers.
+ (bibtex-yank): Set arg properly if nil.
+
+2011-06-05 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-search-entry-globally):
+ New variable.
+ (bibtex-search-entry): Use it.
+
+2011-06-05 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-entry-format): New option
+ sort-fields.
+ (bibtex-format-entry, bibtex-reformat): Honor this option.
+ (bibtex-parse-entry): Return fields in proper order.
+
+2011-06-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * doc-view.el (doc-view-remove-if): Move computation of result out
+ of `dolist' to silence misleading lexical-binding warning.
+
+2011-06-04 Chong Yidong <cyd@stupidchicken.com>
+
+ * emacs-lisp/timer.el (timer-activate): Remove unused arg.
+ (timer-activate, timer-activate-when-idle): Doc fix (Bug#8793).
+
+2011-06-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-find-shell): Apply workaround also for
+ "SunOS 5.10".
+
+2011-06-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-set-completion-function, tramp-parse-rhosts)
+ (tramp-parse-shosts, tramp-parse-sconfig, tramp-parse-shostkeys)
+ (tramp-parse-hosts, tramp-parse-passwd, tramp-parse-netrc)
+ (tramp-parse-putty):
+ * net/tramp-sh.el (tramp-completion-function-alist-rsh)
+ (tramp-completion-function-alist-ssh)
+ (tramp-completion-function-alist-telnet)
+ (tramp-completion-function-alist-su)
+ (tramp-completion-function-alist-putty): Set `tramp-autoload'
+ cookie.
+
+ * net/tramp-ftp.el:
+ * net/tramp-sh.el:
+ * net/tramp-smb.el: Set `tramp-autoload' cookie, and eval after
+ load "tramp.el" `tramp-set-completion-function'.
+
+2011-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el: Require and use pcomplete.
+ (shell-dynamic-complete-functions): Add pcomplete-completions-at-point.
+ (shell-completion-vars): Set pcomplete-default-completion-function.
+
+2011-06-04 Deniz Dogan <deniz@dogan.se>
+
+ * iswitchb.el (iswitchb-window-buffer-p): Use `member' instead of
+ `memq' (Bug#8799).
+
+2011-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (make-progress-reporter): Add "..." by default (bug#8785).
+
+2011-06-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs--mark-unmark, bs--nth-wrapper):
+ * mpc.el (mpc-select-extend, mpc-songpointer-context):
+ * vc/log-view.el (log-view-beginning-of-defun):
+ * vc/smerge-mode.el (smerge-apply-resolution-patch)
+ (smerge-refine-forward, smerge-refine-chopup-region):
+ Silence warning for unused `dotimes' counter variables.
+
+2011-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/tramp.el (tramp-with-progress-reporter): Rename from
+ with-progress-reporter. Use `declare'.
+ * net/tramp-smb.el:
+ * net/tramp-sh.el:
+ * net/tramp-gvfs.el: Update all uses.
+
+2011-06-02 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-kill-stack-buffer): Make sure that the trail
+ buffer isn't killed before making it current.
+
+2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Silence various byte-compiler warnings.
+ * emacs-lisp/byte-run.el (make-obsolete-variable): New argument
+ `access-type' and new obsolescence format.
+ * emacs-lisp/bytecomp.el (byte-compile-warn-obsolete): Adjust to
+ new format.
+ (byte-compile-check-variable): New `access-type' argument.
+ Only warn if the access-type is obsolete.
+ (byte-compile-dynamic-variable-bind, byte-compile-variable-ref)
+ (byte-compile-variable-set): Adjust callers.
+ * help-fns.el (describe-variable): Adjust to new obsolescence format.
+ * mail/sendmail.el (mail-mailer-swallows-blank-line): Only mark
+ setting it as obsolete.
+ * simple.el (minibuffer-completing-symbol):
+ * font-lock.el (font-lock-beginning-of-syntax-function): Only mark read
+ access as obsolete.
+ * minibuffer.el (minibuffer-completing-file-name): Don't make it
+ obsolete yet.
+ * international/quail.el (quail-mouse-choose-completion): Remove unused
+ code referring to obsolete var.
+ (quail-choose-completion-string): Remove.
+ * server.el (server-clients-with, server-kill-buffer-query-function)
+ (server-kill-emacs-query-function): Silence "unused `proc'" warnings.
+ * proced.el (proced-send-signal):
+ * emacs-lisp/lisp.el (lisp-complete-symbol):
+ Replace completion-annotate-function with completion-extra-properties.
+
+2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (goto-line): Use read-number.
+ (overriding-map-is-bound): Remove.
+ (saved-overriding-map): Change default.
+ (save&set-overriding-map): Rename from ensure-overriding-map-is-bound;
+ Take the map as argument.
+ (universal-argument, negative-argument, digit-argument): Use it.
+ (restore-overriding-map): Adjust.
+ (do-auto-fill): Use fill-forward-paragraph.
+ (keyboard-quit): Don't signal an error when debug-on-quit is non-nil.
+
+ * minibuffer.el (minibuffer-inactive-mode-map): New var.
+ (minibuffer-inactive-mode): New major mode.
+ * mouse.el (mouse-drag-region): Remove the "mouse-1 pops up
+ the *Messages* buffer" hack.
+ (mouse-popup-menubar): Don't burp if the event is a normal key.
+
+ Miscellaneous tweaks.
+ * emacs-lisp/cl-macs.el (dolist, dotimes): Use the same strategy for
+ lexical scoping as in subr.el's dolist and dotimes.
+ * emacs-lisp/bytecomp.el (byte-compile-unfold-bcf):
+ Silence compiler warning.
+ * thingatpt.el (forward-whitespace): Trivial coding style fix.
+ * subr.el (with-output-to-temp-buffer): Provide an edebug spec.
+ * international/ccl.el (ccl-compile): Trivial simplification.
+ * help-fns.el (help-do-arg-highlight): Silence compiler warning.
+ * emacs-lisp/testcover.el (testcover-end): Remove spurious
+ `printflag' argument.
+ * emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable):
+ Purecopy the whole obsolescence data.
+
+2011-06-01 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-decode-coding-system): Revert last change;
+ improve doc-string as suggested by Marco Pessotto
+ <melmothx@gmail.com>.
+ (rcirc-print): Fix last change.
+
+2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (complete-with-action): Return nil for the metadata and
+ boundaries of non-functional tables.
+ (completion-table-dynamic): Return nil for the metadata.
+ (completion-table-with-terminator): Add default case, using
+ complete-with-action.
+ (completion--metadata): New function.
+ (completion-all-sorted-completions, minibuffer-completion-help): Use it
+ to try and avoid pathological performance problems.
+ (completion--embedded-envvar-table): Return `category' metadata.
+
+2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * subr.el (process-alive-p): New tiny convenience function.
+
+2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/debug.el (debug): Save&restore not just the buffer's
+ content but also its previous major mode.
+
+2011-05-31 Helmut Eller <eller.helmut@gmail.com>
+
+ * debug.el (debug): Restore the previous content of the
+ *Backtrace* buffer when we exit with C-M-c.
+
+2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el: Add metadata method to completion tables.
+ (completion-category-overrides): New defcustom.
+ (completion-metadata, completion--field-metadata)
+ (completion-metadata-get, completion--styles)
+ (completion--cycle-threshold): New functions.
+ (completion-try-completion, completion-all-completions):
+ Add `metadata' argument to choose completion-styles.
+ (completion--do-completion): Use metadata to choose cycling.
+ (completion-all-sorted-completions): Use metadata for sorting.
+ Remove :completion-cycle-penalty which is not needed any more.
+ (completion--try-word-completion): Add `metadata' argument.
+ (minibuffer-completion-help): Check metadata for annotation function
+ and sorting.
+ (completion-file-name-table): Return `category' metadata.
+ (minibuffer-completing-file-name): Make obsolete.
+ * simple.el (minibuffer-completing-symbol): Make obsolete.
+ * icomplete.el (icomplete-completions): Pass new `metadata' param to
+ completion-try-completion.
+
+2011-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mail/smtpmail.el (smtpmail-send-data): Add progress reporter.
+
+2011-05-30 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-debug-buffer): Use visible buffer name.
+ (rcirc-print): Decode all incoming messages (bug#8744).
+ (rcirc-decode-coding-system): Allow value nil for automatic coding
+ system detection.
+
+2011-06-01 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug-hook): Mailclient ignores From.
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.el (image-animate-max-time): Allow nil and t values.
+ Default to nil.
+ (create-animated-image): Doc fix.
+ (image-animate-start): Remove second arg; just use
+ image-animate-max-time.
+ (image-animate-timeout): Doc fix. Args changed.
+
+ * image-mode.el (image-toggle-display-image): Ensure that the
+ image spec passed to the animate timer is the same object as in
+ the the buffer's display property (Bug#6981).
+ (image-transform-properties): Doc fix.
+
+ * image.el (image-animate-max-time): Default to nil.
+
+2011-05-29 Martin Rudalics <rudalics@gmx.at>
+
+ * menu-bar.el (kill-this-buffer-enabled-p): Avoid looping over
+ entire buffer list (Bug#8184).
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.el (imagemagick-types-inhibit)
+ (imagemagick-register-types): Doc fix.
+
+2011-05-29 Deniz Dogan <deniz@dogan.se>
+
+ * net/rcirc.el (rcirc): Use the user's stored encryption method by
+ default.
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * select.el: Don't perform clipboard-manager saving in hooks;
+ leave the hooks empty.
+
+2011-05-28 Leo Liu <sdl.web@gmail.com>
+
+ * replace.el (occur-menu-map, occur-edit-mode-map): New vars.
+ (occur-mode-map): Bind occur-edit-mode. Use occur-menu-map.
+ (occur-edit-mode): New major mode (Bug#8463).
+ (occur-after-change-function): New function.
+ (occur-engine): Give Occur tags a read-only property.
+
+2011-05-28 Kevin Ryde <user42@zip.com.au>
+
+ * subr.el (def-edebug-spec): Doc fix (Bug#8430).
+
+2011-05-28 Chong Yidong <cyd@stupidchicken.com>
+
+ * bindings.el (help-echo): Make the initial non-indicator dash
+ empty on graphical terminals (Bug#7295).
+
+ * files.el (auto-mode-alist): Move config rule after the
+ in-stripping one (Bug#8547).
+
+ * newcomment.el (comment-end-skip): Doc fix (Bug#8659).
+
+ * startup.el (normal-splash-screen): Remove gratuitous mode-line
+ setting (Bug#8740).
+
+2011-05-28 Alp Aker <aker@pitt.edu> (tiny change)
+
+ * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort)
+ (Buffer-menu-buffer+size): Use Buffer-menu-buffer-column
+ (Bug#8539).
+
+2011-05-28 Chong Yidong <cyd@stupidchicken.com>
+
+ * emacs-lisp/re-builder.el (re-builder): Improve doc (Bug#8286).
+
+2011-05-28 Dima Kogan <dkogan@cds.caltech.edu> (tiny change)
+
+ * progmodes/hideshow.el (hs-looking-at-block-start-p): New fun.
+ (hs-hide-block-at-point, hs-find-block-beginning)
+ (hs-already-hidden-p, hs-hide-block, hs-show-block): Use it
+ (Bug#8279).
+
+2011-05-28 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (fancy-about-screen): Use standard mode line. (Bug#8740)
+
+2011-05-28 Chong Yidong <cyd@stupidchicken.com>
+
+ * help-fns.el (describe-function-1): If the function is a derived
+ major mode, print the parent mode.
+
+ * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode)
+ (idl-mode, pike-mode, awk-mode): Inherit from prog-mode.
+
+2011-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--capf-wrapper): Check applicability before
+ retuning non-nil for non-exclusive completion data.
+ * progmodes/etags.el (tags-completion-at-point-function):
+ * info-look.el (info-lookup-completions-at-point): Mark as
+ non-exclusive.
+ (info-complete): Adjust accordingly.
+
+ * info-look.el: Convert to lexical-binding and completion-at-point.
+ (info-lookup-completions-at-point): New function.
+ (info-complete): Use it and completion-in-region.
+
+2011-05-28 Drew Adams <drew.adams@oracle.com>
+
+ * isearch.el: Let M-e start with point at the first mismatched char.
+ (isearch-fail-pos): New function.
+ (isearch-edit-string): Use it.
+
+2011-05-28 Dmitry Kurochkin <dmitry.kurochkin@gmail.com> (tiny change)
+
+ * isearch.el (isearch-range-invisible): Use invisible-p (bug#8721).
+
+2009-11-23 Toby Cubitt <toby-predictive@dr-qubit.org>
+
+ * emacs-lisp/avl-tree.el: New avl-tree-stack datatype. Add new
+ traversal functions for avl-trees.
+ (avl-tree--stack): New struct.
+ (avl-tree-stack-p, avl-tree--stack-repopulate): New funs.
+ (avl-tree-enter): Add optional `updatefun' arg.
+ (avl-tree--do-enter): Add optional `updatefun' arg.
+ Change return value.
+ (avl-tree-delete): Add optional `test' and `nilflag' args.
+ (avl-tree--do-delete): Add `test' and `nilflag' args.
+ Change return value.
+ (avl-tree-member): Add optional `nilflag'
+ (avl-tree-member-p): New function.
+ (avl-tree-mapc, avl-tree-mapf, avl-tree-mapcar): New functions.
+ (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.
+ (avl-tree--enter-balance): Rename from avl-tree--enter-balance1 and
+ make it work both ways.
+ (avl-tree--enter-balance2): Remove.
+ (avl-tree--switch-dir, avl-tree--dir-to-sign, avl-tree--sign-to-dir):
+ New macros.
+ (avl-tree--mapc, avl-tree-map): Add direction argument.
+
+2011-05-27 David Michael <fedora.dm0@gmail.com> (tiny change)
+
+ * files.el (interpreter-mode-alist): Add rbash (bug#8745).
+
+2011-05-27 Chong Yidong <cyd@stupidchicken.com>
+
+ * select.el: Support clipboard managers with built-in function
+ x-clipboard-manager-save, via delete-frame-functions and
+ kill-emacs-hook.
+ (xselect-convert-to-targets): Add MULTIPLE target to list.
+ (xselect-convert-to-save-targets): New function.
+
+2011-05-27 Kenichi Handa <handa@m17n.org>
+
+ * mail/sendmail.el (mail-encode-header): Avoid double encoding by
+ let-binding rfc2047-encode-encoded-words to nil.
+
+2011-05-27 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el: Don't require url-util.
+
+ * shell.el (shell-directory-tracker): Case matters. (Bug#8735)
+
+ * files.el (set-auto-mode):
+ Also respect mode: entries at the end of the file. (Bug#8586)
+
+2011-05-26 Glenn Morris <rgm@gnu.org>
+
+ * files.el (hack-local-variables-prop-line, hack-local-variables):
+ Downcase mode names, as seems to be traditional.
+ (hack-local-variables, hack-local-variables-apply): Doc fixes.
+
+ * mail/emacsbug.el (report-emacs-bug): Mention checking From address.
+ (report-emacs-bug-hook): Try to validate the From address. (Bug#8038)
+
+2011-05-25 Julien Danjou <julien@danjou.info>
+
+ * textmodes/rst.el (rst-define-level-faces): Do not define face
+ symbol if it is already defined.
+
+2011-05-24 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * play/5x5.el (5x5-new-game, 5x5-randomize):
+ Reset 5x5-solver-output to nil when a new grid is cast.
+ (5x5-log-init, 5x5-log): Use defsubst instead of defmacro to shunt
+ these debugging traces, as defmacro breaks the compiled code.
+
+2011-05-24 Dmitry Kurochkin <dmitry.kurochkin@gmail.com> (tiny change)
+
+ * isearch.el (isearch-range-invisible): Use invisible-p (bug#8721).
+
+2011-05-24 Leo Liu <sdl.web@gmail.com>
+
+ * vc/vc-bzr.el (vc-bzr-sha1-program): Rename from sha1-program.
+ (vc-bzr-sha1): Adapt.
+
+ * sha1.el: Remove. Function `sha1' is now builtin.
+
+ * bindings.el: Provide sha1 feature.
+
+2011-05-24 Kenichi Handa <handa@m17n.org>
+
+ * mail/sendmail.el: Require `rfc2047'.
+ (mail-insert-from-field): Do not perform RFC2047 encoding.
+ (mail-encode-header): New function.
+ (sendmail-send-it): Set buffer-file-coding-system of the work
+ buffer to the return value of select-message-coding-system.
+ Call mail-encode-header.
+
+ * mail/smtpmail.el (smtpmail-send-it): Call mail-encode-header.
+
+2011-05-24 Sean Neakums <sneakums@zork.net> (tiny change)
+
+ * mail/supercite.el (sc-default-cite-frame):
+ Handle sc-nested-citation-p when sc-cite-blank-lines-p is non-nil.
+
+2011-05-24 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (brm-menu): Declare.
+
+ * emulation/viper.el (viper-set-hooks): Declare.
+
+ * play/5x5.el (5x5-log-init, 5x5-log): Evaluate when compiling.
+ (5x5-log-init, 5x5-log, 5x5-solver): Doc fixes.
+ (math-map-vec, math-sub, math-mul, math-make-intv, math-reduce-vec)
+ (math-format-number, math-pow, calcFunc-arrange, calcFunc-cvec)
+ (calcFunc-diag, calcFunc-trn, calcFunc-inv, calcFunc-mrow)
+ (calcFunc-mcol, calcFunc-vconcat, calcFunc-index): Declare.
+
+2011-05-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add an :exit-function for completion-at-point.
+
+ * minibuffer.el (completion--done): New fun.
+ (completion--do-completion): Use it. New arg `expect-exact'.
+ (minibuffer-complete, minibuffer-complete-word): Don't output message,
+ since completion--do-completion does it for us now.
+ (minibuffer-force-complete): Use completion--done and
+ completion--replace. Handle sole-completion case with more care.
+ (minibuffer-complete-and-exit): Use new `expect-exact' arg.
+ (completion-extra-properties): New var.
+ (completion-annotate-function): Make obsolete.
+ (minibuffer-completion-help): Adjust accordingly.
+ Use completion-list-insert-choice-function.
+ (completion-at-point, completion-help-at-point):
+ Bind completion-extra-properties.
+ (completion-pcm-word-delimiters): Add | (for uniquify, for example).
+ * simple.el (completion-list-insert-choice-function): New var.
+ (completion-setup-function): Preserve it.
+ (choose-completion): Pay attention to it, shuffle the code a bit.
+ (choose-completion-string): New arg `insert-function'.
+
+ * textmodes/bibtex.el: Convert to lexical binding.
+ (bibtex-mode-map): Use completion-at-point.
+ (bibtex-mode): Use define-derived-mode&completion-at-point-functions.
+ (bibtex-completion-at-point-function): New fun, from bibtex-complete.
+ (bibtex-complete): Define as obsolete alias.
+ (bibtex-complete-internal): Remove.
+ (bibtex-format-entry): Remove unused sub-group in regexp.
+ * shell.el (shell--command-completion-data)
+ (shell-environment-variable-completion):
+ * pcomplete.el (pcomplete-completions-at-point):
+ * comint.el (comint--complete-file-name-data): Use :exit-function
+ instead of completion-table-with-terminator so it also works for
+ choose-completion.
+
+2011-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * <lots-of-files>.el: Don't quote lambda expressions with `quote'.
+
+ * vc/smerge-mode.el (smerge-refine-subst): Don't deactivate the mark
+ (bug#8710).
+
+ * emacs-lisp/lisp.el (up-list): Fix forward movement (bug#8708).
+
+2011-05-23 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el (allout-inhibit-auto-fill-on-headline): Create new
+ customization variable and implement: If non-nil, auto-fill will
+ be inhibited while on topic's header line.
+
+2011-05-23 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * play/5x5.el: I/ Add an arithmetic solver to suggest positions to
+ click on. II/ Make 5x5 multisession. III/ Ensure that random grids
+ always have a solution in grid size = 5 cases.
+ (5x5-mode-map): Add keybinding to function `5x5-solve-suggest'.
+ (5x5-solver-output, 5x5-log-buffer): New vars.
+ (5x5-grid, 5x5-x-pos, 5x5-y-pos, 5x5-moves, 5x5-cracking):
+ Make these variables buffer local to achieve 5x5 multi-session-ness.
+ (5x5): Set 5x5-grid-size only if SIZE is non-negative.
+ (5x5-grid-to-vec, 5x5-vec-to-grid, 5x5-log-init, 5x5-log, 5x5-solver)
+ (5x5-solve-suggest): New funs.
+ (5x5-randomize): Use 5x5-make-move instead of 5x5-flip-cell to
+ randomize a grid so that we ensure that there is always a solution.
+ (5x5-make-random-grid): Allow other movement than flipping.
+
+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
+ advice and passes PREDICATE.
+
+2011-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-function-form): Only call
+ byte-compile-lambda if it's actually a lambda.
+
+ * emacs-lisp/eieio.el (eieio-defgeneric-form-primary-only-one):
+ Fix function quoting. Use backquote better.
+
+2011-05-22 Yuanle Song <sylecn@gmail.com>
+
+ * nxml/rng-xsd.el (rng-xsd-check-pattern): Use case-sensitive
+ matching (Bug#8516).
+
+2011-01-22 Jari Aalto <jari.aalto@cante.net>
+
+ * vc/vc-dir.el (vc-default-dir-printer): Give edited tag a
+ different face (Bug#8178).
+
+2011-05-22 Chong Yidong <cyd@stupidchicken.com>
+
+ * vc/diff-mode.el (diff-changed): Don't use terminal specs for
+ defface (Bug#8144).
+
+2011-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Convert ' to #' for
+ funcall as well (bug#8712). Warn when performing those conversions.
+ * emacs-lisp/bytecomp.el (byte-compile-form): Fix error report.
+
+ * progmodes/grep.el (grep-mode): Fix it for good (bug#8684)!
+
+2011-05-22 Glenn Morris <rgm@gnu.org>
+
+ * files.el (hack-local-variables-prop-line): Small simplifications.
+ (hack-local-variables, hack-local-variables-prop-line):
+ If MODE-ONLY, return the mode, rather than just `t'.
+
+2011-05-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/grep.el (grep-mode): Fix last change (bug#8684).
+
+2011-05-21 Glenn Morris <rgm@gnu.org>
+
+ * files.el (hack-local-variables-prop-line, hack-local-variables):
+ If only interested in the mode, don't bother doing the other stuff.
+
+ * image-mode.el (image-after-revert-hook):
+ Redraw all frames on which the image is visible. (Bug#8567)
+
+ * dired-aux.el (dired-touch-initial): Just use current-time. (Bug#6887)
+
+ * wid-edit.el (widget-checklist-match-inline):
+ Fix 2011-04-19 change. (Bug#8649)
+
+2011-05-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/checkdoc.el (checkdoc-sentencespace-region-engine):
+ Also allow singlespace after single-letter capitals followed by a dot.
+
+ * nxml/nxml-mode.el (nxml-electric-slash): Reindent when completion is
+ enabled. Suggested by James Ahlborn <jahlborn@gmail.com> (bug#8704).
+
+2011-05-20 Nix <nix@esperi.org.uk>
+
+ * files.el (basic-save-buffer-2):
+ Fix handling of break-hardlink-on-save with non-existent files.
+
+2011-05-19 Deniz Dogan <deniz@dogan.se>
+
+ * net/rcirc.el (rcirc-mode): Initialize rcirc-urls to nil.
+ (rcirc-markup-urls): Check if rcirc-url-regexp is nil.
+
+2011-05-19 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-type-def-re):
+ Handle "type, bind(c)". (Bug#8691)
+
+ * emacs-lisp/autoload.el (batch-update-autoloads):
+ Set autoload-excludes by parsing loadup.el rather than Makefiles.
+
+2011-05-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-process-actions): Set "first-password-request"
+ property for the correct connection in case of multihops.
+
+2011-05-18 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries): Remove fakemail.c.
+ * mail/sendmail.el (sendmail-program): Fall back to just "sendmail".
+
+ Rationalize calendar handling of day and month abbrev-arrays.
+ * calendar/calendar.el (calendar-customized-p): New function.
+ (calendar-abbrev-construct, calendar-make-alist): Change what it does.
+ (calendar-day-name-array, calendar-month-name-array): Doc fix.
+ Add :set function.
+ (calendar-abbrev-length, calendar-day-abbrev-array)
+ (calendar-month-abbrev-array): Make defcustoms, with appropriate :set.
+ (calendar-day-abbrev-array, calendar-month-abbrev-array):
+ Elements may no longer be nil.
+ (calendar-day-name, calendar-month-name):
+ Update for changed nature of abbrev arrays.
+ * calendar/diary-lib.el (diary-name-pattern):
+ Update for changed nature of abbrev arrays.
+ (diary-mark-entries-1): Update calendar-make-alist calls.
+ (diary-font-lock-date-forms): Doc fix for changed abbrev arrays.
+ * calendar/cal-html.el (cal-html-day-abbrev-array):
+ Simply inherit from calendar-day-abbrev-array.
+
+2011-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/grep.el (grep-mode): Disable default
+ compilation-directory-matcher setting (bug#8684).
+
+2011-05-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-insert-file-contents): Use "dd"
+ instead of "head" and "tail". There were problems with SunOS 5.9,
+ and it performs better.
+
+2011-05-17 Glenn Morris <rgm@gnu.org>
+
+ * mail/mail-utils.el (mail-dont-reply-to): Silence compiler.
+
+ * progmodes/idlw-shell.el (idlwave-shell-complete-filename):
+ Replace obsolete function.
+
+ * shell.el (pcomplete-parse-arguments-function): Declare.
+
+ * calendar/appt.el (appt-message-warning-time, appt-display-mode-line)
+ (appt-display-diary, appt-display-interval, appt-prev-comp-time)
+ (appt-check): Doc fixes.
+ (appt-disp-window-function, appt-delete-window-function):
+ Remove needless special case in custom :type.
+ (appt-display-count): Default to 0, not nil.
+ (appt-check): Reset appt-display-count to 0, not nil.
+
+2011-05-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/python.el (python-font-lock-keywords):
+ Add the Python 3.X keyword "nonlocal" (bug#8639).
+
+2011-05-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defmethod): Fix quoting of code (bug#8677).
+
+2011-05-16 Kevin Ryde <user42@zip.com.au>
+
+ * info-look.el (makefile-automake-mode): New setups, looking in
+ automake manual, then makefile-mode.
+ (makefile-mode): Remove automake manual, have it just in
+ makefile-automake-mode since there's various things different or
+ not relevant to plain make.
+ (makefile-mode): Remove "other-modes" non-existent automake-mode,
+ believe a hypothetical automake-mode would go to makefile-mode,
+ not the other way around.
+
+2011-05-15 Chong Yidong <cyd@stupidchicken.com>
+
+ * vc/diff-mode.el (diff-fixup-modifs): Locate correct position for
+ hunk-end tags (Bug#8672).
+
+ * vc/vc-annotate.el (vc-annotate-mode-map): Bind = to
+ vc-annotate-show-diff-revision-at-line (Bug#8671).
+
+2011-05-14 Glenn Morris <rgm@gnu.org>
+
+ * vc/add-log.el (add-change-log-entry): Don't start adding a new entry
+ in the middle of an existing one with multiple authors. (Bug#8645)
+ (change-log-font-lock-keywords): Also handle multiple author lines
+ with leading tabs. (Bug#8644)
+
+ * calendar/appt.el (appt-check): Rename some local variables.
+ Some simplification/reordering.
+
+ * mail/feedmail.el (feedmail-confirm-outgoing-timeout)
+ (feedmail-sendmail-f-doesnt-sell-me-out)
+ (feedmail-queue-slug-suspect-regexp, feedmail-debug)
+ (feedmail-debug-sit-for, feedmail-queue-express-hook)
+ (feedmail-queue-runner-message-sender): Set :version.
+ (bbdb-search, bbdb-records, smtp-via-smtp, smtp-server)
+ (bbdb-dwim-net-address, vm-mail): Declare.
+ (feedmail-binmail-gnulinuxish-template):
+ Rename from feedmail-binmail-linuxish-template.
+ (feedmail-buffer-to-smtp, feedmail-vm-mail-mode):
+ Use insert-buffer-substring.
+
+2011-05-14 Bill Carpenter <bill@carpenter.org>
+
+ * mail/feedmail.el (feedmail-patch-level): Increase.
+ (feedmail-debug): New custom group.
+ (feedmail-confirm-outgoing-timeout)
+ (feedmail-sendmail-f-doesnt-sell-me-out)
+ (feedmail-queue-slug-suspect-regexp, feedmail-debug)
+ (feedmail-debug-sit-for, feedmail-queue-express-hook): New options.
+ (feedmail-sender-line, feedmail-from-line)
+ (feedmail-fiddle-headers-upwardly, feedmail-enable-spray)
+ (feedmail-spray-this-address)
+ (feedmail-spray-address-fiddle-plex-list)
+ (feedmail-queue-use-send-time-for-date)
+ (feedmail-queue-use-send-time-for-message-id)
+ (feedmail-last-chance-hook, feedmail-queue-runner-mode-setter)
+ (feedmail-buffer-eating-function):
+ Doc fixes.
+ (feedmail-spray-via-bbdb, feedmail-buffer-to-smtp)
+ (feedmail-vm-mail-mode, feedmail-message-action-scroll-up)
+ (feedmail-message-action-scroll-down): New functions.
+ (feedmail-queue-directory, feedmail-queue-draft-directory):
+ Use expand-file-name.
+ (feedmail-prompt-before-queue-standard-alist): Add scroll entries.
+ Remove C-v help entry.
+ (feedmail-queue-buffer-file-name): New variable.
+ (feedmail-mail-send-hook-splitter, feedmail-buffer-to-binmail)
+ (feedmail-buffer-to-smtpmail, feedmail-queue-express-to-draft)
+ (feedmail-message-action-send-strong, feedmail-message-action-edit)
+ (feedmail-message-action-draft, feedmail-message-action-draft-strong)
+ (feedmail-message-action-queue, feedmail-message-action-queue-strong)
+ (feedmail-message-action-toggle-spray)
+ (feedmail-run-the-queue-no-prompts)
+ (feedmail-run-the-queue-global-prompt, feedmail-queue-reminder)
+ (feedmail-look-at-queue-directory, feedmail-queue-subject-slug-maker)
+ (feedmail-create-queue-filename, feedmail-rfc822-time-zone):
+ (feedmail-fiddle-header, feedmail-give-it-to-buffer-eater)
+ (feedmail-envelope-deducer, feedmail-fiddle-from)
+ (feedmail-fiddle-sender, feedmail-default-date-generator)
+ (feedmail-fiddle-date, feedmail-fiddle-message-id)
+ (feedmail-fiddle-spray-address)
+ (feedmail-fiddle-list-of-spray-fiddle-plexes)
+ (feedmail-fiddle-list-of-fiddle-plexes)
+ (feedmail-fill-to-cc-function, feedmail-fill-this-one)
+ (feedmail-one-last-look, feedmail-fqm-p): Add debug calls.
+ (feedmail-queue-runner-message-sender, feedmail-binmail-template):
+ Change default. Doc fix.
+ (feedmail-queue-runner-cleaner-upper): Use feedmail-say-chatter.
+ (feedmail-binmail-linuxish-template): New constant.
+ (feedmail-buffer-to-sendmail): Doc fix. Add debug call.
+ Respect feedmail-sendmail-f-doesnt-sell-me-out.
+ (feedmail-send-it): Add debug call.
+ Use feedmail-queue-buffer-file-name, and
+ feedmail-send-it-immediately-wrapper.
+ (feedmail-message-action-send): Add debug call.
+ Use feedmail-send-it-immediately-wrapper.
+ (feedmail-queue-express-to-queue): Add debug call.
+ Run feedmail-queue-express-hook.
+ (feedmail-message-action-help): Add debug call. Use feedmail-p-h-b-n.
+ (feedmail-message-action-help-blat):
+ Rename from feedmail-queue-send-edit-prompt-help-first.
+ (feedmail-run-the-queue): Add debug call. Set buffer-file-type.
+ Check line-endings. Handle errors better.
+ (feedmail-queue-reminder-brief, feedmail-queue-reminder-medium):
+ Doc fix. Add debug call.
+ (feedmail-queue-send-edit-prompt): Doc fix. Add debug call.
+ Use feedmail-queue-send-edit-prompt-inner.
+ (feedmail-queue-runner-prompt, feedmail-scroll-buffer): New functions.
+ (feedmail-queue-send-edit-prompt-inner): New function, extracted
+ from feedmail-queue-send-edit-prompt.
+ (feedmail-queue-send-edit-prompt-help)
+ (feedmail-queue-send-edit-prompt-help-later): Remove functions.
+ (feedmail-tidy-up-slug): Add debug call.
+ Respect feedmail-queue-slug-suspect-regexp.
+ (feedmail-queue-subject-slug-maker): Use buffer-substring-no-properties.
+ (feedmail-dump-message-to-queue): Add debug call.
+ Expand queue-directory.
+ (feedmail-dump-message-to-queue): Change message slightly.
+ Use feedmail-say-chatter.
+ (feedmail-rfc822-date): Add debug call. Bind system-time-locale.
+ (feedmail-send-it-immediately-wrapper): New function.
+ (feedmail-send-it-immediately): Add debug calls. Use let not let*.
+ Insert empty string rather than newline. Handle full-frame case.
+ Use catch/throw. Use feedmail-say-chatter.
+ (feedmail-fiddle-from): Try mail-host-address.
+ (feedmail-default-message-id-generator): Doc fix.
+ Bind system-time-locale. Handle missing end.
+ (feedmail-fiddle-x-mailer): Add debug call.
+ Handle feedmail-x-mailer-line being nil.
+ (feedmail-accume-n-nuke-header, feedmail-deduce-address-list):
+ Add debug call. Use buffer-substring-no-properties.
+ (feedmail-say-debug, feedmail-say-chatter): New functions.
+ (feedmail-find-eoh): Give an explicit error.
+
+2011-05-13 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-treeview.el (newsticker-treeview-face): Change default
+ family from helvetica to sans.
+ (newsticker-treeview-tool-bar-map): Move tool-bar icons to
+ etc/images/newsticker.
+
+ * net/newst-reader.el (newsticker-feed-face): Change default
+ family from helvetica to sans.
+
+ * 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): Change default family from
+ helvetica to sans.
+ (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
+ auto-marking.
+
+2011-05-13 Didier Verna <didier@xemacs.org>
+
+ Common Lisp indentation improvements on defmethod and lambda-lists.
+ * cl-indent.el: Advertise the changes and remove obsolete TODO entries.
+ (lisp-lambda-list-keyword-parameter-indentation)
+ (lisp-lambda-list-keyword-parameter-alignment)
+ (lisp-lambda-list-keyword-alignment): New customizable user options.
+ (lisp-indent-defun-method): Improve docstring.
+ (extended-loop-p): Fix comment.
+ (lisp-indent-lambda-list-keywords-regexp): New variable.
+ (lisp-indent-lambda-list): New function.
+ (lisp-indent-259): Use it.
+ (lisp-indent-defmethod): Support for more than one
+ method qualifier and properly indent methods lambda-lists.
+ (defgeneric): Provide a missing common-lisp-indent-function property.
+
+2011-05-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * thingatpt.el (bounds-of-thing-at-point): Return nil rather than
+ bounds for the empty string (bug#8667).
+
+2011-05-13 Glenn Morris <rgm@gnu.org>
+
+ * mail/feedmail.el (feedmail-buffer-to-sendmail): Require sendmail.
+
+ * mail/sendmail.el (sendmail-program): Try executable-find first.
+ (sendmail-send-it): `sendmail-program' cannot be unbound.
+
+ * calendar/appt.el (appt-make-list): Simplify.
+ (appt-time-msg-list): Doc fix.
+ (appt-check): Change mode-line message at the time of the appointment.
+
+2011-05-12 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/ld-script.el (ld-script-keywords)
+ (ld-script-builtins): Update keywords list.
+
+2011-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/grep.el (grep-filter): Don't trip on partial lines.
+
+ * shell.el (shell-completion-vars): New function.
+ (shell-mode):
+ * simple.el (read-shell-command): Use it.
+ (blink-matching-open): No need for " [...]" in minibuffer-message.
+
+2011-05-12 Glenn Morris <rgm@gnu.org>
+
+ * calendar/appt.el (appt-now-displayed): Remove pointless variable.
+ (appt-check): Simplify.
+
+2011-05-12 Eli Zaretskii <eliz@gnu.org>
+
+ * smerge-mode.el (smerge-resolve): Use null-device rather than a
+ literal "/dev/null".
+
+2011-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp.el (lisp-complete-symbol, lisp-completion-at-point):
+ Fix typo.
+
+2011-05-12 Ralph Schleicher <rs@ralph-schleicher.de>
+
+ * progmodes/which-func.el (which-function):
+ Use add-log-current-defun instead of add-log-current-defun-function,
+ which might not be defined (Bug#8260).
+
+2011-05-12 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble):
+ Let byte-compile-initial-macro-environment always take precedence.
+
+2011-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/rcirc.el: Add support for SSL/TLS connections.
+ (rcirc-server-alist): New field `encryption'.
+ (rcirc): Check `encryption' settings.
+ (rcirc-connect): New arg `encryption'. Use open-network-stream.
+ Merge make-local-variable into `set'.
+ (rcirc--connection-open-p): New function.
+ (rcirc-send-string, rcirc-clean-up-buffer): Use it to handle case where
+ the process is not a network process (e.g. running gnutls-cli).
+ (set-rcirc-decode-coding-system, set-rcirc-encode-coding-system):
+ Make rcirc-(en|de)code-coding-system local here.
+ (rcirc-mode): Merge make-local-variable into `set'.
+ (rcirc-parent-buffer): Make permanent buffer-local.
+ (rcirc-multiline-minor-mode): Don't do it here.
+ (rcirc-switch-to-server-buffer): Don't switch to a random buffer if
+ there's no server buffer.
+
+2011-05-11 Glenn Morris <rgm@gnu.org>
+
+ * newcomment.el (comment-kill): Prefix "unused" local.
+
+ * term/w32console.el (get-screen-color): Declare.
+
+ * emacs-lisp/bytecomp.el (byte-compile-arglist-warn):
+ Handle symbol elements of byte-compile-initial-macro-environment.
+
+2011-05-10 Leo Liu <sdl.web@gmail.com>
+
+ * bookmark.el (bookmark-bmenu-mode-map):
+ Bind bookmark-bmenu-search to `/'.
+
+ * mail/footnote.el: Convert to utf-8 encoding.
+ (footnote-unicode-string, footnote-unicode-regexp): New variable.
+ (Footnote-unicode): New function.
+ (footnote-style-alist): Add unicode style to the list.
+ (footnote-style): Doc fix.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ Fix doubled-word typos.
+ * international/quail.el (quail-insert-kbd-layout): and and -> and
+ * kermit.el: and and -> and
+ * net/ldap.el (ldap-search-internal): to to -> to
+ * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise.
+ * progmodes/js.el (js-mode): and and -> and
+ * textmodes/artist.el (artist-move-to-xy): at at -> at
+ (artist-draw-region-trim-line-endings): if if -> if
+ And Safetyc -> Safety.
+ * 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)
@@ -31,8 +3288,8 @@
2011-05-09 Chong Yidong <cyd@stupidchicken.com>
- * progmodes/compile.el (compilation-start): Run
- compilation-filter-hook for the async case too.
+ * progmodes/compile.el (compilation-start):
+ Run compilation-filter-hook for the async case too.
(compilation-filter-hook): Doc fix.
2011-05-09 Deniz Dogan <deniz@dogan.se>
@@ -49,8 +3306,8 @@
2011-05-09 Chong Yidong <cyd@stupidchicken.com>
- * progmodes/compile.el (compilation-error-regexp-alist-alist): Fix
- the ant regexp to handle end-line and end-column info from jikes.
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Fix the ant regexp to handle end-line and end-column info from jikes.
Re-introduce maven regexp. Give the ruby-Test::Unit regexp a
higher priority to avoid clobbering by gnu.
@@ -61,16 +3318,16 @@
2011-05-08 Ralph Schleicher <rs@ralph-schleicher.de>
- * progmodes/perl-mode.el (perl-imenu-generic-expression): Only
- match variables declared via `my' or `our' (Bug#8261).
+ * progmodes/perl-mode.el (perl-imenu-generic-expression):
+ Only match variables declared via `my' or `our' (Bug#8261).
* net/browse-url.el (browse-url-of-dired-file): Allow browsing of
special file names `.' and `..' (Bug#8259).
2011-05-08 Chong Yidong <cyd@stupidchicken.com>
- * progmodes/grep.el (grep-mode-font-lock-keywords): Remove
- buffer-changing entries.
+ * progmodes/grep.el (grep-mode-font-lock-keywords):
+ Remove buffer-changing entries.
(grep-filter): New function.
(grep-mode): Add it to compilation-filter-hook.
@@ -789,7 +4046,7 @@
2011-04-20 felix <EmacsWiki> (tiny change)
- * whitespace.el (global-whitespace-mode): keep highlight when
+ * whitespace.el (global-whitespace-mode): Keep highlight when
switching between major modes on a file.
2011-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index c1313cfd16f..eeed5d7797c 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -4421,7 +4421,7 @@
2008-12-06 Chong Yidong <cyd@stupidchicken.com>
* term/xterm.el (terminal-init-xterm): Discard pending input
- before reading a reply to the terminal attributes query.
+ before reading a reply to the terminal attributes query. (Bug#1495)
2008-12-05 Andreas Schwab <schwab@suse.de>
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 3cb6c00b6ee..190be56dd09 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -8424,7 +8424,7 @@
* dabbrev.el (dabbrev-completion): Fix typo in docstring.
-2010-08-08 MON KEY <monkey@sandpframing.com> (tiny change)
+2010-08-08 MON KEY <monkey@sandpframing.com>
* emacs-lisp/syntax.el (syntax-ppss-toplevel-pos):
Fix typo in docstring (bug#6747).
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index 2f73c290231..7ba9261ccf0 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -6892,7 +6892,7 @@
(find-file-noselect): Use it if new optional argument `rawfile' is
non-nil.
- * startup.el (command-line-1): Add option --eval to evalute an
+ * startup.el (command-line-1): Add option --eval to evaluate an
expression on the command line and print the result.
1995-08-14 Richard Stallman <rms@mole.gnu.ai.mit.edu>
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index b2cd2064da2..3795dd46010 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -159,7 +159,7 @@ 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)))
+ (pop-to-buffer-same-window (prepare-abbrev-list-buffer)))
(defun edit-abbrevs-redefine ()
"Redefine abbrevs according to current buffer contents."
@@ -814,19 +814,28 @@ Returns the abbrev symbol, if expansion took place."
(destructuring-bind (&optional sym name wordstart wordend)
(abbrev--before-point)
(when sym
- (unless (or ;; executing-kbd-macro
- noninteractive
- (window-minibuffer-p (selected-window)))
- ;; Add an undo boundary, in case we are doing this for
- ;; a self-inserting command which has avoided making one so far.
- (undo-boundary))
- ;; Now sym is the abbrev symbol.
- (setq last-abbrev-text name)
- (setq last-abbrev sym)
- (setq last-abbrev-location wordstart)
- ;; If this abbrev has an expansion, delete the abbrev
- ;; and insert the expansion.
- (abbrev-insert sym name wordstart wordend)))))
+ (let ((startpos (copy-marker (point) t))
+ (endmark (copy-marker wordend t)))
+ (unless (or ;; executing-kbd-macro
+ noninteractive
+ (window-minibuffer-p (selected-window)))
+ ;; Add an undo boundary, in case we are doing this for
+ ;; a self-inserting command which has avoided making one so far.
+ (undo-boundary))
+ ;; Now sym is the abbrev symbol.
+ (setq last-abbrev-text name)
+ (setq last-abbrev sym)
+ (setq last-abbrev-location wordstart)
+ ;; If this abbrev has an expansion, delete the abbrev
+ ;; and insert the expansion.
+ (prog1
+ (abbrev-insert sym name wordstart wordend)
+ ;; Yuck!! If expand-abbrev is called with point slightly
+ ;; further than the end of the abbrev, move point back to
+ ;; where it started.
+ (if (and (> startpos endmark)
+ (= (point) endmark)) ;Obey skeletons that move point.
+ (goto-char startpos))))))))
(defun unexpand-abbrev ()
"Undo the expansion of the last abbrev that expanded.
@@ -935,7 +944,8 @@ Properties with special meaning:
(unless table
(setq table (make-abbrev-table))
(set tablename table)
- (push tablename abbrev-table-name-list))
+ (unless (memq tablename abbrev-table-name-list)
+ (push tablename abbrev-table-name-list)))
;; We used to just pass them to `make-abbrev-table', but that fails
;; if the table was pre-existing as is the case if it was created by
;; loading the user's abbrev file.
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index a83e5a2a85c..ef75e7157e6 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -258,7 +258,9 @@ widgets are locally inhibited.
The number varies according to the evanescence of objects on a
hash table with weak keys, so tracking of widget erasures is often delayed."
- (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit))
+ (when (and allout-widgets-maintain-tally
+ (not allout-widgets-mode-inhibit)
+ allout-widgets-tally)
(format ":%s" (hash-table-count allout-widgets-tally))))
;;;_ = allout-widgets-track-decoration nil
(defcustom allout-widgets-track-decoration nil
@@ -302,7 +304,7 @@ buffers where this is set to enable and disable widget
enhancements, directly.")
;;;###autoload
(put 'allout-widgets-mode-inhibit 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+ (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
(make-variable-buffer-local 'allout-widgets-mode-inhibit)
;;;_ = allout-inhibit-body-modification-hook
(defvar allout-inhibit-body-modification-hook nil
@@ -559,6 +561,8 @@ outline hot-spot navigation \(see `allout-mode')."
'allout-widgets-shifts-recorder nil 'local)
(add-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function nil 'local)
+ (add-hook 'allout-post-undo-hook
+ 'allout-widgets-after-undo-function nil 'local)
(add-hook 'before-change-functions 'allout-widgets-before-change-handler
nil 'local)
@@ -748,20 +752,23 @@ Optional RECURSING is for internal use, to limit recursion."
(message replaced-message)
(message "")))))
- ;; Detect undecorated items, eg during isearch into previously
- ;; unexposed topics, and decorate "economically". Some
- ;; undecorated stuff is often exposed, to reduce lag, but the
- ;; item containing the cursor is decorated. We constrain
- ;; recursion to avoid being trapped by unexpectedly undecoratable
- ;; items.
- (when (and (not recursing)
- (not (allout-current-decorated-p))
- (or (not (equal (allout-depth) 0))
- (not allout-container-item-widget)))
- (let ((buffer-undo-list t))
- (allout-widgets-exposure-change-recorder
- allout-recent-prefix-beginning allout-recent-prefix-end nil)
- (allout-widgets-post-command-business 'recursing)))
+ ;; alas, decorated intermediate matches are not easily undecorated
+ ;; when they're automatically rehidden by isearch, so we're
+ ;; dropping this nicety.
+ ;; ;; Detect undecorated items, eg during isearch into previously
+ ;; ;; unexposed topics, and decorate "economically". Some
+ ;; ;; undecorated stuff is often exposed, to reduce lag, but the
+ ;; ;; item containing the cursor is decorated. We constrain
+ ;; ;; recursion to avoid being trapped by unexpectedly undecoratable
+ ;; ;; items.
+ ;; (when (and (not recursing)
+ ;; (not (allout-current-decorated-p))
+ ;; (or (not (equal (allout-depth) 0))
+ ;; (not allout-container-item-widget)))
+ ;; (let ((buffer-undo-list t))
+ ;; (allout-widgets-exposure-change-recorder
+ ;; allout-recent-prefix-beginning allout-recent-prefix-end nil)
+ ;; (allout-widgets-post-command-business 'recursing)))
;; Detect and rectify fouled outline structure - decorated item
;; not at beginning of line.
@@ -1125,6 +1132,14 @@ Dispatched by `allout-widgets-post-command-business' in response to
Intended for use on allout-after-copy-or-kill-hook."
(if (car kill-ring)
(setcar kill-ring (allout-widgets-undecorate-text (car kill-ring)))))
+;;;_ > allout-widgets-after-undo-function ()
+(defun allout-widgets-after-undo-function ()
+ "Do allout-widgets processing of text after an undo.
+
+Intended for use on allout-post-undo-hook."
+ (save-excursion
+ (if (allout-goto-prefix)
+ (allout-redecorate-item (allout-get-or-create-item-widget)))))
;;;_ > allout-widgets-exposure-undo-recorder (widget from-state)
(defun allout-widgets-exposure-undo-recorder (widget)
@@ -2319,9 +2334,7 @@ We use a caching strategy, so the caller doesn't need to do so."
(defun allout-elapsed-time-seconds (end start)
"Return seconds between `current-time' style time START/END triples."
(let ((elapsed (time-subtract end start)))
- (+ (* (car elapsed) (expt 2.0 16))
- (cadr elapsed)
- (/ (caddr elapsed) (expt 10.0 6)))))
+ (float-time elapsed)))
;;;_ > allout-frame-property (frame property)
(defalias 'allout-frame-property
(cond ((fboundp 'frame-parameter)
diff --git a/lisp/allout.el b/lisp/allout.el
index 736ec42718b..592a64c647a 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -399,6 +399,12 @@ else allout's special hanging-indent maintaining auto-fill function,
:type 'boolean
:group 'allout)
(make-variable-buffer-local 'allout-inhibit-auto-fill)
+;;;_ = 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."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'allout-inhibit-auto-fill-on-headline)
;;;_ = allout-use-hanging-indents
(defcustom allout-use-hanging-indents t
"If non-nil, topic body text auto-indent defaults to indent of the header.
@@ -410,7 +416,7 @@ where auto-fill occurs."
(make-variable-buffer-local 'allout-use-hanging-indents)
;;;###autoload
(put 'allout-use-hanging-indents 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+ (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
;;;_ = allout-reindent-bodies
(defcustom allout-reindent-bodies (if allout-use-hanging-indents
'text)
@@ -429,7 +435,7 @@ those that do not have the variable `comment-start' set. A value of
(make-variable-buffer-local 'allout-reindent-bodies)
;;;###autoload
(put 'allout-reindent-bodies 'safe-local-variable
- '(lambda (x) (memq x '(nil t text force))))
+ (lambda (x) (memq x '(nil t text force))))
;;;_ = allout-show-bodies
(defcustom allout-show-bodies nil
@@ -440,7 +446,7 @@ just the header."
(make-variable-buffer-local 'allout-show-bodies)
;;;###autoload
(put 'allout-show-bodies 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+ (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
@@ -632,7 +638,7 @@ undesired.]"
:group 'allout)
;;;###autoload
(put 'allout-use-mode-specific-leader 'safe-local-variable
- '(lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start))
+ (lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start))
(stringp x))))
;;;_ = allout-mode-leaders
(defvar allout-mode-leaders '()
@@ -662,7 +668,7 @@ are always respected by the topic maneuvering functions."
(make-variable-buffer-local 'allout-old-style-prefixes)
;;;###autoload
(put 'allout-old-style-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+ (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
"Do fancy stuff with topic prefix bullets according to level, etc.
@@ -711,7 +717,7 @@ is non-nil."
(make-variable-buffer-local 'allout-stylish-prefixes)
;;;###autoload
(put 'allout-stylish-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+ (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
@@ -728,7 +734,7 @@ disables numbering maintenance."
(put 'allout-numbered-bullet 'safe-local-variable
(if (fboundp 'string-or-null-p)
'string-or-null-p
- '(lambda (x) (or (stringp x) (null x)))))
+ (lambda (x) (or (stringp x) (null x)))))
;;;_ = allout-file-xref-bullet
(defcustom allout-file-xref-bullet "@"
"Bullet signifying file cross-references, for `allout-resolve-xref'.
@@ -740,7 +746,7 @@ Set this var to the bullet you want to use for file cross-references."
(put 'allout-file-xref-bullet 'safe-local-variable
(if (fboundp 'string-or-null-p)
'string-or-null-p
- '(lambda (x) (or (stringp x) (null x)))))
+ (lambda (x) (or (stringp x) (null x)))))
;;;_ = allout-presentation-padding
(defcustom allout-presentation-padding 2
"Presentation-format white-space padding factor, for greater indent."
@@ -817,37 +823,32 @@ formatted copy."
:group 'allout-encryption)
;;;_ = allout-encrypt-unencrypted-on-saves
(defcustom allout-encrypt-unencrypted-on-saves t
- "When saving, should topics pending encryption be encrypted?
-
-The idea is to prevent file-system exposure of any un-encrypted stuff, and
-mostly covers both deliberate file writes and auto-saves.
-
- - Yes: encrypt all topics pending encryption, even if it's the one
- currently being edited. (In that case, the currently edited topic
- will be automatically decrypted before any user interaction, so they
- can continue editing but the copy on the file system will be
- encrypted.)
- Auto-saves will use the \"All except current topic\" mode if this
- one is selected, to avoid practical difficulties -- see below.
- - All except current topic: skip the topic currently being edited, even if
- it's pending encryption. This may expose the current topic on the
- file sytem, but avoids the nuisance of prompts for the encryption
- passphrase in the middle of editing for, eg, autosaves.
- This mode is used for auto-saves for both this option and \"Yes\".
- - No: leave it to the user to encrypt any unencrypted topics.
-
-For practical reasons, auto-saves always use the 'except-current policy
-when auto-encryption is enabled. (Otherwise, spurious passphrase prompts
-and unavoidable timing collisions are too disruptive.) If security for a
-file requires that even the current topic is never auto-saved in the clear,
-disable auto-saves for that file."
-
- :type '(choice (const :tag "Yes" t)
- (const :tag "All except current topic" except-current)
- (const :tag "No" nil))
- :version "22.1"
+ "If non-nil, topics pending encryption are encrypted during buffer saves.
+
+This provents file-system exposure of un-encrypted contents of
+items marked for encryption.
+
+When non-nil, if the topic currently being edited is decrypted,
+it will be encrypted for saving but automatically decrypted
+before any subsequent user interaction, so it is once again clear
+text for editing though the file system copy is encrypted.
+
+\(Auto-saves are handled differently. Buffers with plain-text
+exposed encrypted topics are exempted from auto saves until all
+such topics are encrypted.)"
+
+ :type 'boolean
+ :version "23.1"
:group 'allout-encryption)
(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves)
+(defvar allout-auto-save-temporarily-disabled nil
+ "True while topic encryption is pending and auto-saving was active.
+
+The value of buffer-saved-size at the time of decryption is used,
+for restoring when all encryptions are established.")
+(defvar allout-just-did-undo nil
+ "True just after undo commands, until allout-post-command-business.")
+(make-variable-buffer-local 'allout-just-did-undo)
;;;_ + Developer
;;;_ = allout-developer group
@@ -935,7 +936,7 @@ case the value of `allout-default-layout' is used.")
(make-variable-buffer-local 'allout-layout)
;;;###autoload
(put 'allout-layout 'safe-local-variable
- '(lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
+ (lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
;;;_ : Topic header format
;;;_ = allout-regexp
@@ -1460,7 +1461,15 @@ This hook might be invoked multiple times by a single command.")
(defvar allout-after-copy-or-kill-hook nil
"*Hook that's run after copying outline text.
-Functions on the hook should not take any arguments.")
+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.
+
+The item that's current when the hook is run *may* be the one
+that was affected by the undo.
+
+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.
@@ -1558,39 +1567,43 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
(defmacro allout-mode-p ()
"Return t if `allout-mode' is active in current buffer."
'allout-mode)
-;;;_ > allout-write-file-hook-handler ()
-(defun allout-write-file-hook-handler ()
- "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes."
+;;;_ > allout-write-contents-hook-handler ()
+(defun allout-write-contents-hook-handler ()
+ "Implement `allout-encrypt-unencrypted-on-saves' for file writes
+
+Return nil if all goes smoothly, or else return an informative
+message if an error is encountered. The message will serve as a
+non-nil return on `write-contents-functions' to prevent saving of
+the buffer while it has decrypted content.
+
+This behavior depends on emacs versions that implement the
+`write-contents-functions' hook."
(if (or (not (allout-mode-p))
(not (boundp 'allout-encrypt-unencrypted-on-saves))
(not allout-encrypt-unencrypted-on-saves))
nil
- (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves
- 'except-current)
- (point-marker))))
- (if (save-excursion (goto-char (point-min))
- (allout-next-topic-pending-encryption except-mark))
- (progn
- (message "auto-encrypting pending topics")
- (sit-for 0)
- (condition-case failure
+ (if (save-excursion (goto-char (point-min))
+ (allout-next-topic-pending-encryption))
+ (progn
+ (message "auto-encrypting pending topics")
+ (sit-for 0)
+ (condition-case failure
+ (progn
(setq allout-after-save-decrypt
- (allout-encrypt-decrypted except-mark))
- (error (message
- "allout-write-file-hook-handler suppressing error %s"
- failure)
- (sit-for 2)))))
- ))
- nil)
-;;;_ > allout-auto-save-hook-handler ()
-(defun allout-auto-save-hook-handler ()
- "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save."
-
- (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves)
- ;; Always implement 'except-current policy when enabled.
- (let ((allout-encrypt-unencrypted-on-saves 'except-current))
- (allout-write-file-hook-handler))))
+ (allout-encrypt-decrypted))
+ ;; aok - return nil:
+ nil)
+ (error
+ ;; whoops - probably some still-decrypted items, return non-nil:
+ (let ((text (format (concat "%s contents write inhibited due to"
+ " encrypted topic encryption error:"
+ " %s")
+ (buffer-name (current-buffer))
+ failure)))
+ (message text)(sit-for 2)
+ text)))))
+ ))
;;;_ > allout-after-saves-handler ()
(defun allout-after-saves-handler ()
"Decrypt topic encrypted for save, if it's currently being edited.
@@ -1869,6 +1882,7 @@ without changes to the allout core. Here are key ones:
`allout-structure-deleted-hook'
`allout-structure-shifted-hook'
`allout-after-copy-or-kill-hook'
+`allout-post-undo-hook'
Terminology
@@ -1954,12 +1968,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
:lighter " Allout"
:keymap 'allout-mode-map
- (let ((write-file-hook-var-name (cond ((boundp 'write-file-functions)
- 'write-file-functions)
- ((boundp 'write-file-hooks)
- 'write-file-hooks)
- (t 'local-write-file-hooks)))
- (use-layout (if (listp allout-layout)
+ (let ((use-layout (if (listp allout-layout)
allout-layout
allout-default-layout)))
@@ -1978,9 +1987,8 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(remove-hook 'post-command-hook 'allout-post-command-business t)
(remove-hook 'before-change-functions 'allout-before-change-handler t)
(remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
- (remove-hook write-file-hook-var-name
- 'allout-write-file-hook-handler t)
- (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
+ (remove-hook 'write-contents-functions
+ 'allout-write-contents-hook-handler t)
(remove-overlays (point-min) (point-max)
'category 'allout-exposure-category))
@@ -2013,9 +2021,8 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(add-hook 'post-command-hook 'allout-post-command-business nil t)
(add-hook 'before-change-functions 'allout-before-change-handler nil t)
(add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
- (add-hook write-file-hook-var-name 'allout-write-file-hook-handler
+ (add-hook 'write-contents-functions 'allout-write-contents-hook-handler
nil t)
- (add-hook 'auto-save-hook 'allout-auto-save-hook-handler nil t)
;; Stash auto-fill settings and adjust so custom allout auto-fill
;; func will be used if auto-fill is active or activated. (The
@@ -2079,7 +2086,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(save-current-buffer
(dolist (buffer (buffer-list))
(set-buffer buffer)
- (when (allout-mode-p) (allout-mode))))
+ (when (allout-mode-p) (allout-mode -1))))
;; continue standard unloading
nil)
@@ -2148,8 +2155,10 @@ internal functions use this feature cohesively bunch changes."
See `allout-overlay-interior-modification-handler' for details."
- (when (and (allout-mode-p) undo-in-progress (allout-hidden-p))
- (allout-show-children))
+ (when (and (allout-mode-p) undo-in-progress)
+ (setq allout-just-did-undo t)
+ (if (allout-hidden-p)
+ (allout-show-children)))
;; allout-overlay-interior-modification-handler on an overlay handles
;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
@@ -3302,12 +3311,30 @@ coordinating with allout activity.")
- Implement (and clear) `allout-post-goto-bullet', for hot-spot
outline commands.
+- If the command we're following was an undo, check for change in
+ the status of encrypted items and adjust auto-save inhibitions
+ accordingly.
+
- Decrypt topic currently being edited if it was encrypted for a save."
- ; Apply any external change func:
(if (not (allout-mode-p)) ; In allout-mode.
nil
+ (when allout-just-did-undo
+ (setq allout-just-did-undo nil)
+ (run-hooks 'allout-post-undo-hook)
+ (cond ((and (= buffer-saved-size -1)
+ allout-auto-save-temporarily-disabled)
+ ;; user possibly undid a decryption, deinhibit auto-save:
+ (allout-maybe-resume-auto-save-info-after-encryption))
+ ((save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (not (allout-next-topic-pending-encryption))))
+ ;; plain-text encrypted items are present, inhibit auto-save:
+ (allout-inhibit-auto-save-info-for-decryption (buffer-size)))))
+
(if (and (boundp 'allout-after-save-decrypt)
allout-after-save-decrypt)
(allout-after-saves-handler))
@@ -3848,7 +3875,9 @@ topic prior to the current one."
Maintains outline hanging topic indentation if
`allout-use-hanging-indents' is set."
- (when (not allout-inhibit-auto-fill)
+ (when (and (not allout-inhibit-auto-fill)
+ (or (not allout-inhibit-auto-fill-on-headline)
+ (not (allout-on-current-heading-p))))
(let ((fill-prefix (if allout-use-hanging-indents
;; Check for topic header indentation:
(save-match-data
@@ -4028,6 +4057,8 @@ 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)
+
;; Recursively rectify successive siblings of orig topic if
;; caller elected for it:
(if do-successors
@@ -4597,8 +4628,9 @@ however, are left exactly like normal, non-allout-specific yanks."
; and delete residual subj
; prefix digits and space:
(while (looking-at "[0-9]") (delete-char 1))
- (if (looking-at " ")
- (delete-char 1))))
+ (delete-char -1)
+ (if (not (eolp))
+ (forward-char))))
;; Assert new topic's bullet - minimal effort if unchanged:
(allout-rebullet-heading (string-to-char prefix-bullet)))
(exchange-point-and-mark))))
@@ -4728,6 +4760,7 @@ arguments as this function, after the exposure changes are made."
(when flag
(let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
+ (overlay-put o 'evaporate t)
(when (featurep 'xemacs)
(let ((props (symbol-plist 'allout-exposure-category)))
(while props
@@ -5887,6 +5920,8 @@ See `allout-toggle-current-subtree-encryption' for more details."
" shift it in to make it encryptable")))
(let* ((allout-buffer (current-buffer))
+ ;; for use with allout-auto-save-temporarily-disabled, if necessary:
+ (was-buffer-saved-size buffer-saved-size)
;; Assess location:
(bullet-pos allout-recent-prefix-beginning)
(after-bullet-pos (point))
@@ -5966,6 +6001,12 @@ See `allout-toggle-current-subtree-encryption' for more details."
;; Add the is-encrypted bullet qualifier:
(goto-char after-bullet-pos)
(insert "*"))))
+
+ ;; adjust buffer's auto-save eligibility:
+ (if was-encrypted
+ (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
bullet-pos subtree-end))))
;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
@@ -6017,6 +6058,7 @@ signal."
(epg-context-set-passphrase-callback
context #'epa-passphrase-callback-function)
context))
+
(encoding (with-current-buffer allout-buffer
buffer-file-coding-system))
(multibyte (with-current-buffer allout-buffer
@@ -6138,8 +6180,29 @@ signal."
result-text))
(error (concat "Encryption produced non-armored text, which"
"conflicts with allout mode -- reconfigure!")))
-
(t result-text))))
+;;;_ > allout-inhibit-auto-save-info-for-decryption
+(defun allout-inhibit-auto-save-info-for-decryption (was-buffer-saved-size)
+ "Temporarily prevent auto-saves in this buffer when an item is decrypted.
+
+WAS-BUFFER-SAVED-SIZE is the value of buffer-saved-size *before*
+the decryption."
+ (when (not (or (= buffer-saved-size -1) (= was-buffer-saved-size -1)))
+ (setq allout-auto-save-temporarily-disabled was-buffer-saved-size
+ buffer-saved-size -1)))
+;;;_ > allout-maybe-resume-auto-save-info-after-encryption ()
+(defun allout-maybe-resume-auto-save-info-after-encryption ()
+ "Restore auto-save info, *if* there are no topics pending encryption."
+ (when (and allout-auto-save-temporarily-disabled
+ (= buffer-saved-size -1)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (not (allout-next-topic-pending-encryption)))))
+ (setq buffer-saved-size allout-auto-save-temporarily-disabled
+ allout-auto-save-temporarily-disabled nil)))
+
;;;_ > allout-encrypted-topic-p ()
(defun allout-encrypted-topic-p ()
"True if the current topic is encryptable and encrypted."
@@ -6150,14 +6213,10 @@ signal."
(save-match-data (looking-at "\\*")))
)
)
-;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
-(defun allout-next-topic-pending-encryption (&optional except-mark)
+;;;_ > allout-next-topic-pending-encryption ()
+(defun allout-next-topic-pending-encryption ()
"Return the point of the next topic pending encryption, or nil if none.
-EXCEPT-MARK identifies a point whose containing topics should be excluded
-from encryption. This supports 'except-current mode of
-`allout-encrypt-unencrypted-on-saves'.
-
Such a topic has the `allout-topic-encryption-bullet' without an
immediately following '*' that would mark the topic as being encrypted. It
must also have content."
@@ -6192,10 +6251,7 @@ must also have content."
(setq content-beg (point))
(backward-char 1)
(allout-end-of-subtree)
- (if (or (<= (point) content-beg)
- (and except-mark
- (<= content-beg except-mark)
- (>= (point) except-mark)))
+ (if (<= (point) content-beg)
;; Continue looking
(setq got nil)
;; Got it!
@@ -6207,14 +6263,10 @@ must also have content."
)
)
)
-;;;_ > allout-encrypt-decrypted (&optional except-mark)
-(defun allout-encrypt-decrypted (&optional except-mark)
+;;;_ > allout-encrypt-decrypted ()
+(defun allout-encrypt-decrypted ()
"Encrypt topics pending encryption except those containing exemption point.
-EXCEPT-MARK identifies a point whose containing topics should be excluded
-from encryption. This supports the `except-current' mode of
-`allout-encrypt-unencrypted-on-saves'.
-
If a topic that is currently being edited was encrypted, we return a list
containing the location of the topic and the location of the cursor just
before the topic was encrypted. This can be used, eg, to decrypt the topic
@@ -6230,7 +6282,7 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info."
bo-subtree
editing-topic editing-point)
(goto-char (point-min))
- (while (allout-next-topic-pending-encryption except-mark)
+ (while (allout-next-topic-pending-encryption)
(setq was-modified (buffer-modified-p))
(when (save-excursion
(and (boundp 'allout-encrypt-unencrypted-on-saves)
@@ -6507,7 +6559,7 @@ If BEG is bigger than END we return 0."
(defun allout-mark-marker (&optional force buffer)
"Accommodate the different signature for `mark-marker' across Emacsen.
-XEmacs takes two optional args, while mainline GNU Emacs does not,
+XEmacs takes two optional args, while Emacs does not,
so pass them along when appropriate."
(if (featurep 'xemacs)
(apply 'mark-marker force buffer)
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 0d129856f1d..ea875b9989d 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -55,9 +55,9 @@
;; --------------------------------------------
;; View listing Intern Intern Intern Intern Y Y
;; Extract member Y Y Y Y Y Y
-;; Save changed member Y Y Y Y N N
+;; Save changed member Y Y Y Y N Y
;; Add new member N N N N N N
-;; Delete member Y Y Y Y N N
+;; Delete member Y Y Y Y N Y
;; Rename member Y Y N N N N
;; Chmod - Y Y - N N
;; Chown - Y - - N N
@@ -216,10 +216,10 @@ Archive and member name will be added."
;; Zip archive configuration
(defcustom archive-zip-extract
- (cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
- ((executable-find "7z") '("7z" "x" "-so"))
+ (cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
+ ((executable-find "7z") '("7z" "x" "-so"))
((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
- (t '("unzip" "-qq" "-c")))
+ (t '("unzip" "-qq" "-c")))
"Program and its options to run in order to extract a zip file member.
Extraction should happen to standard output. Archive and member name will
be added."
@@ -235,44 +235,44 @@ be added."
;; names.
(defcustom archive-zip-expunge
- (if (and (not (executable-find "zip"))
- (executable-find "pkzip"))
- '("pkzip" "-d")
- '("zip" "-d" "-q"))
+ (cond ((executable-find "zip") '("zip" "-d" "-q"))
+ ((executable-find "7z") '("7z" "d"))
+ ((executable-find "pkzip") '("pkzip" "-d"))
+ (t '("zip" "-d" "-q")))
"Program and its options to run in order to delete zip file members.
Archive and member names will be added."
:type '(list (string :tag "Program")
- (repeat :tag "Options"
- :inline t
- (string :format "%v")))
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
:group 'archive-zip)
(defcustom archive-zip-update
- (if (and (not (executable-find "zip"))
- (executable-find "pkzip"))
- '("pkzip" "-u" "-P")
- '("zip" "-q"))
+ (cond ((executable-find "zip") '("zip" "-q"))
+ ((executable-find "7z") '("7z" "u"))
+ ((executable-find "pkzip") '("pkzip" "-u" "-P"))
+ (t '("zip" "-q")))
"Program and its options to run in order to update a zip file member.
Options should ensure that specified directory will be put into the zip
file. Archive and member name will be added."
:type '(list (string :tag "Program")
- (repeat :tag "Options"
- :inline t
- (string :format "%v")))
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
:group 'archive-zip)
(defcustom archive-zip-update-case
- (if (and (not (executable-find "zip"))
- (executable-find "pkzip"))
- '("pkzip" "-u" "-P")
- '("zip" "-q" "-k"))
+ (cond ((executable-find "zip") '("zip" "-q" "-k"))
+ ((executable-find "7z") '("7z" "u"))
+ ((executable-find "pkzip") '("pkzip" "-u" "-P"))
+ (t '("zip" "-q" "-k")))
"Program and its options to run in order to update a case fiddled zip member.
Options should ensure that specified directory will be put into the zip file.
Archive and member name will be added."
:type '(list (string :tag "Program")
- (repeat :tag "Options"
- :inline t
- (string :format "%v")))
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
:group 'archive-zip)
(defcustom archive-zip-case-fiddle t
@@ -323,9 +323,30 @@ Archive and member name will be added."
Extraction should happen to standard output. Archive and member name will
be added."
:type '(list (string :tag "Program")
- (repeat :tag "Options"
- :inline t
- (string :format "%v")))
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
+ :group 'archive-7z)
+
+(defcustom archive-7z-expunge
+ '("7z" "d")
+ "Program and its options to run in order to delete 7z file members.
+Archive and member names will be added."
+ :type '(list (string :tag "Program")
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
+ :group 'archive-7z)
+
+(defcustom archive-7z-update
+ '("7z" "u")
+ "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."
+ :type '(list (string :tag "Program")
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
:group 'archive-7z)
;; -------------------------------------------------------------------------
@@ -1062,7 +1083,7 @@ using `make-temp-file', and the generated name is returned."
(view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
((eq other-window-p 'display) (display-buffer buffer))
(other-window-p (switch-to-buffer-other-window buffer))
- (t (switch-to-buffer buffer))))))
+ (t (pop-to-buffer-same-window buffer))))))
(defun archive-*-extract (archive name command)
(let* ((default-directory (file-name-as-directory archive-tmpdir))
@@ -2037,7 +2058,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(with-temp-buffer
(call-process "7z" nil t nil "l" "-slt" file)
(goto-char (point-min))
- (re-search-forward "^-+\n")
+ ;; Four dashes start the meta info section that should be skipped.
+ ;; Archive members start with more than four dashes.
+ (re-search-forward "^-----+\n")
(while (re-search-forward "^Path = \\(.*\\)\n" nil t)
(goto-char (match-end 0))
(let ((name (match-string 1))
@@ -2084,6 +2107,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(message "%s" (buffer-string)))
(delete-file tmpfile)))))
+(defun archive-7z-write-file-member (archive descr)
+ (archive-*-write-file-member
+ archive
+ descr
+ archive-7z-update))
+
;; -------------------------------------------------------------------------
;;; Section `ar' archives.
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 5793c3180be..3b849cece22 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -360,7 +360,7 @@ Matches the visited file name against the elements of `auto-insert-alist'."
(save-window-excursion
;; make buffer visible before skeleton or function
;; which might ask the user for something
- (switch-to-buffer (current-buffer))
+ (pop-to-buffer-same-window (current-buffer))
(if (and (consp action)
(not (eq (car action) 'lambda)))
(skeleton-insert action)
diff --git a/lisp/battery.el b/lisp/battery.el
index 9afe9de7b98..d7d3045fa58 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -102,6 +102,11 @@ string are substituted as defined by the current value of the variable
"String to display in the mode line.")
;;;###autoload (put 'battery-mode-line-string 'risky-local-variable t)
+(defcustom battery-mode-line-limit 100
+ "Percentage of full battery load below which display battery status"
+ :type 'integer
+ :group 'battery)
+
(defcustom battery-mode-line-format
(cond ((eq battery-status-function 'battery-linux-proc-acpi)
"[%b%p%%,%d°C]")
@@ -182,16 +187,21 @@ seconds."
(defun battery-update ()
"Update battery status information in the mode line."
- (setq battery-mode-line-string
- (propertize (if (and battery-mode-line-format
- battery-status-function)
- (battery-format
- battery-mode-line-format
- (funcall battery-status-function))
- "")
- 'help-echo "Battery status information"))
+ (let ((data (and battery-status-function (funcall battery-status-function))))
+ (setq battery-mode-line-string
+ (propertize (if (and battery-mode-line-format
+ (<= (car (read-from-string (cdr (assq ?p data))))
+ battery-mode-line-limit))
+ (battery-format
+ battery-mode-line-format
+ data)
+ "")
+ 'face
+ (and (<= (car (read-from-string (cdr (assq ?p data))))
+ battery-load-critical)
+ 'font-lock-warning-face)
+ 'help-echo "Battery status information")))
(force-mode-line-update))
-
;;; `/proc/apm' interface for Linux.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 8c48bdc5d59..c4f9369219a 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -321,7 +321,9 @@ mouse-3: Remove current window from display")
(standard-mode-line-format
(list
"%e"
- (propertize "-" 'help-echo help-echo)
+ `(: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
@@ -452,11 +454,6 @@ Major modes that edit things other than ordinary files may change this
(put 'mode-line-buffer-identification 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-buffer-identification)
-(defun unbury-buffer () "\
-Switch to the last buffer in the buffer list."
- (interactive)
- (switch-to-buffer (last-buffer)))
-
(defun mode-line-unbury-buffer (event) "\
Call `unbury-buffer' in this window."
(interactive "e")
@@ -474,7 +471,7 @@ Like `bury-buffer', but temporarily select EVENT's window."
(defun mode-line-other-buffer () "\
Switch to the most recently selected buffer other than the current one."
(interactive)
- (switch-to-buffer (other-buffer)))
+ (switch-to-buffer (other-buffer) nil t))
(defun mode-line-next-buffer (event)
"Like `next-buffer', but temporarily select EVENT's window."
@@ -596,9 +593,12 @@ is okay. See `mode-line-format'.")
".fas" ".lib" ".mem"
;; CMUCL
".x86f" ".sparcf"
- ;; Other CL implementations (Allegro, LispWorks, OpenMCL)
- ".fasl" ".ufsl" ".fsl" ".dxl" ".pfsl" ".dfsl"
- ".p64fsl" ".d64fsl" ".dx64fsl"
+ ;; OpenMCL / Clozure CL
+ ".dfsl" ".pfsl" ".d64fsl" ".p64fsl" ".lx64fsl" ".lx32fsl"
+ ".dx64fsl" ".dx32fsl" ".fx64fsl" ".fx32fsl" ".sx64fsl"
+ ".sx32fsl" ".wx64fsl" ".wx32fsl"
+ ;; Other CL implementations (Allegro, LispWorks)
+ ".fasl" ".ufsl" ".fsl" ".dxl"
;; Libtool
".lo" ".la"
;; Gettext
@@ -646,9 +646,10 @@ is okay. See `mode-line-format'.")
(make-variable-buffer-local 'indent-tabs-mode)
-;; We have base64 and md5 functions built in now.
+;; We have base64, md5 and sha1 functions built in now.
(provide 'base64)
(provide 'md5)
+(provide 'sha1)
(provide 'overlay '(display syntax-table field))
(provide 'text-properties '(display syntax-table field point-entered))
@@ -848,6 +849,8 @@ if `inhibit-field-text-motion' is non-nil."
(define-key global-map "\C-@" 'set-mark-command)
;; Many people are used to typing C-SPC and getting C-@.
(define-key global-map [?\C- ] 'set-mark-command)
+(put 'set-mark-command :advertised-binding [?\C- ])
+
(define-key ctl-x-map "\C-x" 'exchange-point-and-mark)
(define-key ctl-x-map "\C-@" 'pop-global-mark)
(define-key ctl-x-map [?\C- ] 'pop-global-mark)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index d3db54c81d4..bb7ad153e8b 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1504,9 +1504,7 @@ method buffers use to resolve name collisions."
(define-key map "a" 'bookmark-bmenu-show-annotation)
(define-key map "A" 'bookmark-bmenu-show-all-annotations)
(define-key map "e" 'bookmark-bmenu-edit-annotation)
- ;; The original binding of M-g hides the M-g prefix map.
- ;; If someone has a better idea than M-g s, I'm open to suggestions.
- (define-key map [?\M-g ?s] 'bookmark-bmenu-search)
+ (define-key map "/" 'bookmark-bmenu-search)
(define-key map [mouse-2] 'bookmark-bmenu-other-window-with-mouse)
map))
@@ -1541,9 +1539,7 @@ deletion, or > if it is flagged for displaying."
(bookmark-maybe-load-default-file)
(let ((buf (get-buffer-create "*Bookmark List*")))
(if (called-interactively-p 'interactive)
- (if (or (window-dedicated-p) (window-minibuffer-p))
- (pop-to-buffer buf)
- (switch-to-buffer buf))
+ (pop-to-buffer-same-window buf)
(set-buffer buf)))
(let ((inhibit-read-only t))
(erase-buffer)
@@ -1845,7 +1841,7 @@ With a prefix arg, prompts for a file to save them in."
(menu (current-buffer))
(pop-up-windows t))
(delete-other-windows)
- (switch-to-buffer (other-buffer))
+ (switch-to-buffer (other-buffer) nil t)
(bookmark--jump-via bmrk 'pop-to-buffer)
(bury-buffer menu)))
diff --git a/lisp/bs.el b/lisp/bs.el
index 6965af1368c..49ffb3f822c 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -865,7 +865,7 @@ the status of buffer on current line."
(defun bs--mark-unmark (count fun)
"Call FUN on COUNT consecutive buffers of *buffer-selection*."
(let ((dir (if (> count 0) 1 -1)))
- (dotimes (i (abs count))
+ (dotimes (_i (abs count))
(let ((buffer (bs--current-buffer)))
(when buffer (funcall fun buffer))
(bs--update-current-line)
@@ -976,7 +976,7 @@ Uses function `toggle-read-only'."
(defun bs--nth-wrapper (count fun &rest args)
"Call COUNT times function FUN with arguments ARGS."
- (dotimes (i (or count 1))
+ (dotimes (_i (or count 1))
(apply fun args)))
(defun bs-up (arg)
@@ -1212,11 +1212,10 @@ by buffer configuration `bs-cycle-configuration-name'."
bs--cycle-list)))
(next (car tupel))
(cycle-list (cdr tupel)))
- (unless (window-dedicated-p (selected-window))
- ;; We don't want the frame iconified if the only window in the frame
- ;; happens to be dedicated; let's get the error from switch-to-buffer
- (bury-buffer))
- (switch-to-buffer next)
+ ;; We don't want the frame iconified if the only window in the frame
+ ;; happens to be dedicated.
+ (bury-buffer (current-buffer))
+ (switch-to-buffer next nil t)
(setq bs--cycle-list (append (cdr cycle-list)
(list (car cycle-list))))
(bs-message-without-log "Next buffers: %s"
@@ -1245,7 +1244,7 @@ by buffer configuration `bs-cycle-configuration-name'."
bs--cycle-list)))
(prev-buffer (car tupel))
(cycle-list (cdr tupel)))
- (switch-to-buffer prev-buffer)
+ (switch-to-buffer prev-buffer nil t)
(setq bs--cycle-list (append (last cycle-list)
(reverse (cdr (reverse cycle-list)))))
(bs-message-without-log "Previous buffers: %s"
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 57eab6755c8..f0a44747378 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -281,7 +281,7 @@ Letters do not insert themselves; instead, they are commands.
(let ((opoint (point))
(eobp (eobp))
(ocol (current-column))
- (oline (progn (move-to-column 4)
+ (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.
@@ -699,7 +699,9 @@ For more information, see the function `buffer-menu'."
(concat name
(propertize (make-string (- name+space-width (string-width name))
?\s)
- 'display `(space :align-to ,(+ 4 name+space-width)))
+ 'display `(space :align-to
+ ,(+ Buffer-menu-buffer-column
+ name+space-width)))
size)))
(defun Buffer-menu-sort (column)
@@ -714,7 +716,11 @@ For more information, see the function `buffer-menu'."
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
- (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer)))
+ (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))
@@ -726,7 +732,9 @@ For more information, see the function `buffer-menu'."
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
- (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l))
+ (when (setq buf (assq (get-text-property (+ (point)
+ Buffer-menu-buffer-column)
+ 'buffer) l))
(setq m1 (cadr buf)
m2 (cadr (cdr buf)))
(when m1
diff --git a/lisp/button.el b/lisp/button.el
index 2e485547745..6ef79532ae7 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -54,10 +54,7 @@
;; Use color for the MS-DOS port because it doesn't support underline.
;; FIXME if MS-DOS correctly answers the (supports) question, it need
;; no longer be a special case.
-(defface button '((((type pc) (class color))
- (:foreground "lightblue"))
- (((supports :underline t)) :underline t)
- (t (:foreground "lightblue")))
+(defface button '((t :inherit link))
"Default face used for buttons."
:group 'basic-faces)
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 728acf5b0f1..274f399fe6a 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -415,17 +415,14 @@
(defmacro math-defsimplify (funcs &rest code)
- (append '(progn)
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-simplify
- (list 'nconc
- (list 'get (list 'quote func) ''math-simplify)
- (list 'list
- (list 'function
- (append '(lambda (math-simplify-expr))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs))))
+ (cons 'progn
+ (mapcar #'(lambda (func)
+ `(put ',func 'math-simplify
+ (nconc
+ (get ',func 'math-simplify)
+ (list
+ #'(lambda (math-simplify-expr) ,@code)))))
+ (if (symbolp funcs) (list funcs) funcs))))
(put 'math-defsimplify 'lisp-indent-hook 1)
;; The function created by math-defsimplify uses the variable
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 9ea773fbb98..6e05cdb07e5 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -2872,33 +2872,25 @@ If X is not an error form, return 1."
(defmacro math-defintegral (funcs &rest code)
(setq math-integral-cache nil)
- (append '(progn)
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-integral
- (list 'nconc
- (list 'get (list 'quote func) ''math-integral)
- (list 'list
- (list 'function
- (append '(lambda (u))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs))))
+ (cons 'progn
+ (mapcar #'(lambda (func)
+ `(put ',func 'math-integral
+ (nconc
+ (get ',func 'math-integral)
+ (list
+ #'(lambda (u) ,@code)))))
+ (if (symbolp funcs) (list funcs) funcs))))
(put 'math-defintegral 'lisp-indent-hook 1)
(defmacro math-defintegral-2 (funcs &rest code)
(setq math-integral-cache nil)
- (append '(progn)
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-integral-2
- (list 'nconc
- (list 'get (list 'quote func)
- ''math-integral-2)
- (list 'list
- (list 'function
- (append '(lambda (u v))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs))))
+ (cons 'progn
+ (mapcar #'(lambda (func)
+ `(put ',func 'math-integral-2
+ `(nconc
+ (get ',func 'math-integral-2)
+ (list #'(lambda (u v) ,@code)))))
+ (if (symbolp funcs) (list funcs) funcs))))
(put 'math-defintegral-2 'lisp-indent-hook 1)
(defvar var-IntegAfterRules 'calc-IntegAfterRules)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 41f549cbe2c..55ac412b435 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1293,19 +1293,20 @@ the trail buffer."
(if (not info-list)
(progn
(setq calc-buffer-list (delete cb calc-buffer-list))
- (with-current-buffer calc-trail-buffer
- (if (eq cb calc-main-buffer)
- ;; If there are other Calc stacks, make another one
- ;; the calc-main-buffer ...
- (if calc-buffer-list
- (setq calc-main-buffer (car calc-buffer-list))
- ;; ... otherwise kill the trail and its windows.
- (let ((wl (get-buffer-window-list calc-trail-buffer)))
- (while wl
- (delete-window (car wl))
- (setq wl (cdr wl))))
- (kill-buffer calc-trail-buffer)
- (setq calc-trail-buffer nil))))
+ (if (buffer-live-p calc-trail-buffer)
+ (with-current-buffer calc-trail-buffer
+ (if (eq cb calc-main-buffer)
+ ;; If there are other Calc stacks, make another one
+ ;; the calc-main-buffer ...
+ (if calc-buffer-list
+ (setq calc-main-buffer (car calc-buffer-list))
+ ;; ... otherwise kill the trail and its windows.
+ (let ((wl (get-buffer-window-list calc-trail-buffer)))
+ (while wl
+ (delete-window (car wl))
+ (setq wl (cdr wl))))
+ (kill-buffer calc-trail-buffer)))))
+ (setq calc-trail-buffer nil)
t))))
(defun calc-mode ()
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 45ed699c4f5..2cc7f5f6569 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -198,11 +198,11 @@ For example, use this to define the golden ratio number:
(setq calculator-user-registers '((?g . 1.61803398875)))
before you load calculator."
:type '(repeat (cons character number))
- :set '(lambda (_ val)
- (and (boundp 'calculator-registers)
- (setq calculator-registers
- (append val calculator-registers)))
- (setq calculator-user-registers val))
+ :set (lambda (_ val)
+ (and (boundp 'calculator-registers)
+ (setq calculator-registers
+ (append val calculator-registers)))
+ (setq calculator-user-registers val))
:group 'calculator)
(defcustom calculator-user-operators nil
@@ -482,7 +482,7 @@ Used for repeating operations in calculator-repR/L.")
["Electric mode"
(progn (calculator-quit)
(setq calculator-restart-other-mode t)
- (run-with-timer 0.1 nil '(lambda () (message nil)))
+ (run-with-timer 0.1 nil (lambda () (message nil)))
;; the message from the menu will be visible,
;; couldn't make it go away...
(calculator))
@@ -706,7 +706,7 @@ See the documentation for `calculator-mode' for more information."
(Electric-command-loop
'calculator-done
;; can't use 'noprompt, bug in electric.el
- '(lambda () 'noprompt)
+ (lambda () 'noprompt)
nil
(lambda (x y) (calculator-update-display))))
(and calculator-buffer
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index d1483c5445d..c44eb6e1b5d 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -62,15 +62,10 @@
;; `appt-check' reads.
;;
;; You can change the way the appointment window is created/deleted by
-;; setting the variables
-;;
-;; appt-disp-window-function
-;; and
-;; appt-delete-window-function
-;;
-;; For instance, these variables could be set to functions that display
-;; appointments in pop-up frames, which are lowered or iconified after
-;; `appt-display-interval' minutes.
+;; setting the variables `appt-disp-window-function' and
+;; `appt-delete-window-function'. For instance, you could be set them
+;; to functions that display appointments in pop-up frames, which are
+;; lowered or iconified after `appt-display-interval' minutes.
;;
;;; Code:
@@ -84,7 +79,8 @@
:group 'calendar)
(defcustom appt-message-warning-time 12
- "Default time in minutes before an appointment that the warning begins."
+ "Default time in minutes before an appointment that the warning begins.
+You probably want to make `appt-display-interval' a factor of this."
:type 'integer
:group 'appt)
@@ -122,7 +118,9 @@ See also `appt-audible' and `appt-display-mode-line'."
(defcustom appt-display-mode-line t
"Non-nil means display minutes to appointment and time on the mode line.
-This is in addition to any other display of appointment messages."
+This is in addition to any other display of appointment messages.
+The mode line updates every minute, independent of the value of
+`appt-display-interval'."
:type 'boolean
:group 'appt)
@@ -134,12 +132,21 @@ Only relevant if reminders are to be displayed in their own window."
(defcustom appt-display-diary t
"Non-nil displays the diary when the appointment list is first initialized.
-This will occur at midnight when the appointment list is updated."
+This occurs when this package is first activated, and then at
+midnight when the appointment list updates."
:type 'boolean
:group 'appt)
(defcustom appt-display-interval 3
- "Number of minutes to wait between checking the appointment list."
+ "Interval in minutes at which to display appointment reminders.
+Once an appointment becomes due, Emacs displays reminders every
+`appt-display-interval' minutes. You probably want to make
+`appt-message-warning-time' be a multiple of this, so that you get
+a final message displayed precisely when the appointment is due.
+
+Note that this variable controls the interval at which
+`appt-display-message' is called. The mode line display (if active)
+always updates every minute."
:type 'integer
:group 'appt)
@@ -147,16 +154,16 @@ This will occur at midnight when the appointment list is updated."
"Function called to display appointment window.
Only relevant if reminders are being displayed in a window.
It should take three string arguments: the number of minutes till
-the appointment, the current time, and the text of the appointment."
- :type '(choice (const appt-disp-window)
- function)
+the appointment, the current time, and the text of the appointment.
+Each argument may also be a list, if multiple appointments are
+relevant at any one time."
+ :type 'function
:group 'appt)
(defcustom appt-delete-window-function 'appt-delete-window
"Function called to remove appointment window and buffer.
Only relevant if reminders are being displayed in a window."
- :type '(choice (const appt-delete-window)
- function)
+ :type 'function
:group 'appt)
@@ -167,16 +174,16 @@ Only relevant if reminders are being displayed in a window."
;; TODO Turn this into an alist? It would be easier to add more
;; optional elements.
-;; TODO There should be a way to set WARNTIME (and other properties)
-;; from the diary-file. Implementing that would be a good reason
-;; to change this to an alist.
+;; Why is the first element (MINUTES) rather than just MINUTES?
+;; It may just inherit from diary-entries-list, where we have
+;; ((MONTH DAY YEAR) ENTRY)
(defvar appt-time-msg-list nil
"The list of appointments for today.
Use `appt-add' and `appt-delete' to add and delete appointments.
The original list is generated from today's `diary-entries-list', and
can be regenerated using the function `appt-check'.
Each element of the generated list has the form
-\(MINUTES STRING [FLAG] [WARNTIME])
+\((MINUTES) STRING [FLAG] [WARNTIME])
where MINUTES is the time in minutes of the appointment after midnight,
and STRING is the description of the appointment.
FLAG and WARNTIME are not always present. A non-nil FLAG
@@ -194,13 +201,9 @@ Only used if `appt-display-mode-line' is non-nil.")
(put 'appt-mode-string 'risky-local-variable t) ; for 'face property
(defvar appt-prev-comp-time nil
- "Time of day (mins since midnight) at which we last checked appointments.
-A nil value forces the diary file to be (re-)checked for appointments.")
+ "Time of day (mins since midnight) at which we last checked appointments.")
-(defvar appt-now-displayed nil
- "Non-nil when we have started notifying about a appointment that is near.")
-
-(defvar appt-display-count nil
+(defvar appt-display-count 0
"Internal variable used to count number of consecutive reminders.")
(defvar appt-timer nil
@@ -213,21 +216,60 @@ If this is non-nil, appointment checking is active.")
(defun appt-display-message (string mins)
"Display a reminder about an appointment.
The string STRING describes the appointment, due in integer MINS minutes.
-The format of the visible reminder is controlled by `appt-display-format'.
-The variable `appt-audible' controls the audible reminder."
+The arguments may also be lists, where each element relates to a
+separate appointment. The variable `appt-display-format' controls
+the format of the visible reminder. If `appt-audible' is non-nil,
+also calls `beep' for an audible reminder."
(if appt-audible (beep 1))
+ ;; Backwards compatibility: avoid passing lists to a-d-w-f if not necessary.
+ (and (listp mins)
+ (= (length mins) 1)
+ (setq mins (car mins)
+ string (car string)))
(cond ((eq appt-display-format 'window)
- (funcall appt-disp-window-function
- (number-to-string mins)
- ;; TODO - use calendar-month-abbrev-array rather than %b?
- (format-time-string "%a %b %e " (current-time))
- string)
+ ;; TODO use calendar-month-abbrev-array rather than %b?
+ (let ((time (format-time-string "%a %b %e " (current-time)))
+ err)
+ (condition-case err
+ (funcall appt-disp-window-function
+ (if (listp mins)
+ (mapcar 'number-to-string mins)
+ (number-to-string mins))
+ time string)
+ (wrong-type-argument
+ (if (not (listp mins))
+ (signal (car err) (cdr err))
+ (message "Argtype error in `appt-disp-window-function' - \
+update it for multiple appts?")
+ ;; Fallback to just displaying the first appt, as we used to.
+ (funcall appt-disp-window-function
+ (number-to-string (car mins)) time
+ (car string))))))
(run-at-time (format "%d sec" appt-display-duration)
nil
appt-delete-window-function))
((eq appt-display-format 'echo)
- (message "%s" string))))
-
+ (message "%s" (if (listp string)
+ (mapconcat 'identity string "\n")
+ string)))))
+
+(defun appt-mode-line (min-to-app &optional abbrev)
+ "Return an appointment string suitable for use in the mode-line.
+MIN-TO-APP is a list of minutes, as strings.
+If ABBREV is non-nil, abbreviates some text."
+ ;; All this silliness is just to make the formatting slightly nicer.
+ (let* ((multiple (> (length min-to-app) 1))
+ (imin (if (or (not multiple)
+ (not (delete (car min-to-app) min-to-app)))
+ (car min-to-app))))
+ (format "%s%s %s"
+ (if abbrev "App't" "Appointment")
+ (if multiple "s" "")
+ (if (equal imin "0") "now"
+ (format "in %s %s"
+ (or imin (mapconcat 'identity min-to-app ","))
+ (if abbrev "min."
+ (format "minute%s" (if (equal imin "1") "" "s"))))))))
(defun appt-check (&optional force)
"Check for an appointment and update any reminder display.
@@ -252,29 +294,28 @@ The following variables control appointment notification:
Controls the format in which reminders are displayed.
`appt-audible'
- Variable used to determine if reminder is audible.
- Default is t.
+ Non-nil means there is an audible component to reminders.
`appt-message-warning-time'
- Variable used to determine when appointment message
- should first be displayed.
+ The default number of minutes in advance at which reminders
+ should start.
`appt-display-mode-line'
- If non-nil, a generic message giving the time remaining
- is shown in the mode-line when an appointment is due.
+ Non-nil means show in the mode line a countdown to the
+ time of each appointment, once reminders start.
`appt-display-interval'
- Interval in minutes at which to check for pending appointments.
+ Interval in minutes at which to display appointment messages.
`appt-display-diary'
- Display the diary buffer when the appointment list is
- initialized for the first time in a day.
+ Non-nil means display the diary whenever the appointment list is
+ initialized (e.g. the first time we check for appointments each day).
The following variables are only relevant if reminders are being
displayed in a window:
`appt-display-duration'
- The number of seconds an appointment message is displayed.
+ Number of seconds for which an appointment message is displayed.
`appt-disp-window-function'
Function called to display appointment window.
@@ -282,54 +323,48 @@ displayed in a window:
`appt-delete-window-function'
Function called to remove appointment window and buffer."
(interactive "P") ; so people can force updates
- (let* ((min-to-app -1)
- (prev-appt-mode-string appt-mode-string)
- (prev-appt-display-count (or appt-display-count 0))
- ;; Non-nil means do a full check for pending appointments and
- ;; display in whatever ways the user has selected. When no
- ;; appointment is being displayed, we always do a full check.
- (full-check
- (or (not appt-now-displayed)
- ;; This is true every appt-display-interval minutes.
- (zerop (mod prev-appt-display-count appt-display-interval))))
- ;; Non-nil means only update the interval displayed in the mode line.
- (mode-line-only (unless full-check appt-now-displayed))
- now cur-comp-time appt-comp-time appt-warn-time)
- (when (or full-check mode-line-only)
- (save-excursion ; FIXME ?
- ;; Convert current time to minutes after midnight (12.01am = 1).
- (setq now (decode-time)
- cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now)))
- ;; At first check in any day, update appointments to today's list.
- (if (or force ; eg initialize, diary save
- (null appt-prev-comp-time) ; first check
- (< cur-comp-time appt-prev-comp-time)) ; new day
- (ignore-errors
- (let ((diary-hook (if (assoc 'appt-make-list diary-hook)
- diary-hook
- (cons 'appt-make-list diary-hook))))
- (if appt-display-diary
- (diary)
- ;; Not displaying the diary, so we can ignore
- ;; diary-number-of-entries. Since appt.el only
- ;; works on a daily basis, no need for more entries.
- (diary-list-entries (calendar-current-date) 1 t)))))
- (setq appt-prev-comp-time cur-comp-time
- appt-mode-string nil
- appt-display-count nil)
- ;; If there are entries in the list, and the user wants a
- ;; message issued, get the first time off of the list and
- ;; calculate the number of minutes until the appointment.
- (when appt-time-msg-list
- (setq appt-comp-time (caar (car appt-time-msg-list))
- appt-warn-time (or (nth 3 (car appt-time-msg-list))
- appt-message-warning-time)
- min-to-app (- appt-comp-time cur-comp-time))
- (while (and appt-time-msg-list
- (< appt-comp-time cur-comp-time))
+ (let* ((prev-appt-mode-string appt-mode-string)
+ (prev-appt-display-count appt-display-count)
+ ;; Convert current time to minutes after midnight (12.01am = 1).
+ (now (decode-time))
+ (now-mins (+ (* 60 (nth 2 now)) (nth 1 now)))
+ appt-mins appt-warn-time min-to-app min-list string-list)
+ (save-excursion ; FIXME ?
+ ;; At first check in any day, update appointments to today's list.
+ (if (or force ; eg initialize, diary save
+ (null appt-prev-comp-time) ; first check
+ (< now-mins appt-prev-comp-time)) ; new day
+ (ignore-errors
+ (let ((diary-hook (if (assoc 'appt-make-list diary-hook)
+ diary-hook
+ (cons 'appt-make-list diary-hook))))
+ (if appt-display-diary
+ (diary)
+ ;; Not displaying the diary, so we can ignore
+ ;; diary-number-of-entries. Since appt.el only
+ ;; works on a daily basis, no need for more entries.
+ (diary-list-entries (calendar-current-date) 1 t)))))
+ ;; Reset everything now in case we somehow missed a minute,
+ ;; or (more likely) an appt was deleted. (This is the only
+ ;; reason we need prev-appt-display-count.)
+ (setq appt-prev-comp-time now-mins
+ appt-mode-string nil
+ appt-display-count 0)
+ ;; If there are entries in the list get each time off of the
+ ;; list and calculate the number of minutes until the appointment.
+ ;; TODO we are looping over all the appointments each time.
+ ;; We could instead sort them by the time at which we need to
+ ;; start warning. But then removing entries in the past becomes
+ ;; less straightforward.
+ (dolist (appt appt-time-msg-list)
+ ;; Remove any entries that are in the past.
+ ;; FIXME how can there be any such entries, given that this
+ ;; function removes entries when they hit zero minutes,
+ ;; and appt-make-list doesn't add any in the past in the first place?
+ (if (< (setq appt-mins (caar appt)) now-mins)
(setq appt-time-msg-list (cdr appt-time-msg-list))
- (if appt-time-msg-list
- (setq appt-comp-time (caar (car appt-time-msg-list)))))
+ (setq appt-warn-time (or (nth 3 appt) appt-message-warning-time)
+ min-to-app (- appt-mins now-mins))
;; If we have an appointment between midnight and
;; `appt-warn-time' minutes after midnight, we
;; must begin to issue a message before midnight. Midnight
@@ -338,45 +373,59 @@ displayed in a window:
;; appointment variable. It is equal to the number of
;; minutes before midnight plus the number of minutes after
;; midnight our appointment is.
- (if (and (< appt-comp-time appt-warn-time)
- (> (+ cur-comp-time appt-warn-time)
- appt-max-time))
- (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time)
- appt-comp-time)))
- ;; Issue warning if the appointment time is within
- ;; appt-message-warning time.
+ ;; FIXME but appt-make-list constructs appt-time-msg-list to only
+ ;; contain entries with today's date, so this cannot work?
+ ;; Also above we just removed anything with appt-mins < now-mins.
+ (if (and (< appt-mins appt-warn-time)
+ (> (+ now-mins appt-warn-time) appt-max-time))
+ (setq min-to-app (+ (- (1+ appt-max-time) now-mins)
+ appt-mins)))
+ ;; Issue warning if the appointment time is within the warning time.
(when (and (<= min-to-app appt-warn-time)
(>= min-to-app 0))
- (setq appt-now-displayed t
- appt-display-count (1+ prev-appt-display-count))
- (unless mode-line-only
- (appt-display-message (cadr (car appt-time-msg-list))
- min-to-app))
- (when appt-display-mode-line
- (setq appt-mode-string
- (concat " " (propertize
- (format "App't in %s min." min-to-app)
- 'face 'mode-line-emphasis))))
- ;; When an appointment is reached, delete it from the
- ;; list. Reset the count to 0 in case we display another
- ;; appointment on the next cycle.
+ (push min-to-app min-list)
+ (push (cadr appt) string-list)
+ ;; When an appointment is reached, delete it from the list.
(if (zerop min-to-app)
- (setq appt-time-msg-list (cdr appt-time-msg-list)
- appt-display-count nil))))
- ;; If we have changed the mode line string, redisplay all mode lines.
- (and appt-display-mode-line
- (not (string-equal appt-mode-string
- prev-appt-mode-string))
- (progn
- (force-mode-line-update t)
- ;; If the string now has a notification, redisplay right now.
- (if appt-mode-string
- (sit-for 0))))))))
+ (setq appt-time-msg-list (delete appt appt-time-msg-list))))))
+ (when min-list
+ (setq min-list (nreverse min-list)
+ string-list (nreverse string-list))
+ ;; This is true every appt-display-interval minutes from the
+ ;; time at which we first started reminding.
+ ;; TODO in the case of multiple appointments, whose interval
+ ;; should we respect? The first one that we started warning about?
+ ;; That's what we do now, and this makes sense if you interpret
+ ;; a-d-i as "don't remind me any more frequently than this".
+ ;; But should we always show a message when a new appt becomes due?
+ ;; When one appt gets removed, should we switch to the interval
+ ;; of the next?
+ (and (zerop (mod prev-appt-display-count appt-display-interval))
+ (appt-display-message string-list min-list))
+ (when appt-display-mode-line
+ (setq appt-mode-string
+ (concat " " (propertize
+ (appt-mode-line (mapcar 'number-to-string
+ min-list) t)
+ 'face 'mode-line-emphasis))))
+ ;; Reset count to 0 in case we display another appt on the next cycle.
+ (setq appt-display-count (if (eq '(0) min-list) 0
+ (1+ prev-appt-display-count))))
+ ;; If we have changed the mode line string, redisplay all mode lines.
+ (and appt-display-mode-line
+ (not (string-equal appt-mode-string prev-appt-mode-string))
+ (progn
+ (force-mode-line-update t)
+ ;; If the string now has a notification, redisplay right now.
+ (if appt-mode-string
+ (sit-for 0)))))))
(defun appt-disp-window (min-to-app new-time appt-msg)
"Display appointment due in MIN-TO-APP (a string) minutes.
-NEW-TIME is a string giving the date. Displays the appointment
-message APPT-MSG in a separate buffer."
+NEW-TIME is a string giving the current date.
+Displays the appointment message APPT-MSG in a separate buffer.
+The arguments may also be lists, where each element relates to a
+separate appointment."
(let ((this-window (selected-window))
(appt-disp-buf (get-buffer-create appt-buffer-name)))
;; Make sure we're not in the minibuffer before splitting the window.
@@ -397,17 +446,29 @@ message APPT-MSG in a separate buffer."
(when (>= (window-height) (* 2 window-min-height))
(select-window (split-window))))
(switch-to-buffer appt-disp-buf))
+ (or (listp min-to-app)
+ (setq min-to-app (list min-to-app)
+ appt-msg (list appt-msg)))
+ ;; I don't really see the point of the new-time argument.
+ ;; It repeatedly reminds you of the date?
+ ;; It would make more sense if it was eg the time of the appointment.
+ ;; Let's allow it to be a list or not independent of the other elements.
+ (or (listp new-time)
+ (setq new-time (list new-time)))
;; FIXME Link to diary entry?
(calendar-set-mode-line
- (format " Appointment %s. %s "
- (if (string-equal "0" min-to-app) "now"
- (format "in %s minute%s" min-to-app
- (if (string-equal "1" min-to-app) "" "s")))
- new-time))
+ (format " %s. %s" (appt-mode-line min-to-app)
+ (mapconcat 'identity new-time ", ")))
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
- (insert appt-msg)
+ ;; If we have appointments at different times, prepend the times.
+ (if (or (= 1 (length min-to-app))
+ (not (delete (car min-to-app) min-to-app)))
+ (insert (mapconcat 'identity appt-msg "\n"))
+ (dotimes (i (length appt-msg))
+ (insert (format "%s%sm: %s" (if (> i 0) "\n" "")
+ (nth i min-to-app) (nth i appt-msg)))))
(shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
@@ -561,6 +622,8 @@ Any appointments made with `appt-add' are not affected by this function."
;; Get the whole string for this appointment.
(appt-time-string
(substring time-string beg end))
+ ;; FIXME why the list? It makes the first
+ ;; element (MINUTES) rather than MINUTES.
(appt-time (list (appt-convert-time only-time)))
(time-msg (append
(list appt-time appt-time-string)
@@ -582,15 +645,12 @@ Any appointments made with `appt-add' are not affected by this function."
(setq entry-list (cdr entry-list)))))
(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
;; Convert current time to minutes after midnight (12:01am = 1),
- ;; so that elements in the list that are earlier than the
- ;; present time can be removed.
+ ;; and remove elements in the list that are in the past.
(let* ((now (decode-time))
- (cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now)))
- (appt-comp-time (caar (car appt-time-msg-list))))
- (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
- (setq appt-time-msg-list (cdr appt-time-msg-list))
- (if appt-time-msg-list
- (setq appt-comp-time (caar (car appt-time-msg-list)))))))))
+ (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))))
+ (while (and appt-time-msg-list
+ (< (caar (car appt-time-msg-list)) now-mins))
+ (setq appt-time-msg-list (cdr appt-time-msg-list)))))))
(defun appt-sort-list (appt-list)
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index bcc19ccda0b..580b953170c 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -54,11 +54,16 @@
:type 'integer
:group 'calendar-html)
-(defcustom cal-html-day-abbrev-array
- (calendar-abbrev-construct calendar-day-abbrev-array
- calendar-day-name-array)
+(defcustom cal-html-day-abbrev-array calendar-day-abbrev-array
"Array of seven strings for abbreviated day names (starting with Sunday)."
- :type '(vector string string string string string string string)
+ :set-after '(calendar-day-abbrev-array)
+ :type '(vector (string :tag "Sun")
+ (string :tag "Mon")
+ (string :tag "Tue")
+ (string :tag "Wed")
+ (string :tag "Thu")
+ (string :tag "Fri")
+ (string :tag "Sat"))
:group 'calendar-html)
(defcustom cal-html-css-default
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index e81eb554458..2c38101588c 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1373,17 +1373,12 @@ Optional integers MON and YR are used instead of today's date."
;; Don't do any window-related stuff if we weren't called from a
;; window displaying the calendar.
(when in-calendar-window
- ;; The second test used to be window-full-width-p.
- ;; Not sure what it was/is for, except perhaps some way of saying
- ;; "try not to mess with existing configurations".
- ;; If did the wrong thing on wide frames, where we have done a
- ;; horizontal split in calendar-basic-setup.
- (if (or (one-window-p t) (not (window-safely-shrinkable-p)))
- ;; Don't mess with the window size, but ensure that the first
- ;; line is fully visible.
- (set-window-vscroll nil 0)
- ;; Adjust the window to exactly fit the displayed calendar.
- (fit-window-to-buffer nil nil calendar-minimum-window-height))
+ (if (window-iso-combined-p)
+ ;; Adjust the window to exactly fit the displayed calendar.
+ (fit-window-to-buffer nil nil calendar-minimum-window-height)
+ ;; For a full height window or a window that is horizontally
+ ;; combined don't fit height to that of its buffer.
+ (set-window-vscroll nil 0))
(sit-for 0))
(and (bound-and-true-p font-lock-mode)
(font-lock-fontify-buffer))
@@ -2034,18 +2029,40 @@ is a string to insert in the minibuffer before reading."
value))
-(defvar calendar-abbrev-length 3
- "*Length of abbreviations to be used for day and month names.
-See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.")
+(defun calendar-customized-p (symbol)
+ "Return non-nil if SYMBOL has been customized."
+ (and (default-boundp symbol)
+ (let ((standard (get symbol 'standard-value)))
+ (and standard
+ (not (equal (eval (car standard)) (default-value symbol)))))))
+
+(defun calendar-abbrev-construct (full)
+ "From sequence FULL, return a vector of abbreviations.
+Each abbreviation is no longer than `calendar-abbrev-length' characters."
+ (apply 'vector (mapcar
+ (lambda (f)
+ (substring f 0 (min calendar-abbrev-length (length f))))
+ full)))
-;; FIXME does it have to start from Sunday?
(defcustom calendar-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
- "Array of capitalized strings giving, in order, the day names.
+ "Array of capitalized strings giving, in order from Sunday, the day names.
The first two characters of each string will be used to head the
-day columns in the calendar. See also the variable
-`calendar-day-abbrev-array'."
+day columns in the calendar.
+If you change this without using customize after the calendar has loaded,
+then you may also want to change `calendar-day-abbrev-array'."
:group 'calendar
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
+ (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
+ (set symbol value)
+ (or dcustomized
+ (setq calendar-day-abbrev-array
+ (calendar-abbrev-construct calendar-day-name-array)))
+ (and (not hcustomized)
+ (boundp 'cal-html-day-abbrev-array)
+ (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
:type '(vector (string :tag "Sunday")
(string :tag "Monday")
(string :tag "Tuesday")
@@ -2054,23 +2071,74 @@ day columns in the calendar. See also the variable
(string :tag "Friday")
(string :tag "Saturday")))
-(defvar calendar-day-abbrev-array
- [nil nil nil nil nil nil nil]
- "*Array of capitalized strings giving the abbreviated day names.
+(defcustom calendar-abbrev-length 3
+ "Default length of abbreviations to use for day and month names.
+If you change this without using customize after the calendar has loaded,
+then you may also want to change `calendar-day-abbrev-array' and
+`calendar-month-abbrev-array'."
+ :group 'calendar
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (let ((dcustomized (calendar-customized-p 'calendar-day-abbrev-array))
+ (mcustomized (calendar-customized-p
+ 'calendar-month-abbrev-array))
+ (hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
+ (set symbol value)
+ (or dcustomized
+ (setq calendar-day-abbrev-array
+ (calendar-abbrev-construct calendar-day-name-array)))
+ (or mcustomized
+ (setq calendar-month-abbrev-array
+ (calendar-abbrev-construct calendar-month-name-array)))
+ (and (not hcustomized)
+ (boundp 'cal-html-day-abbrev-array)
+ (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
+ :type 'integer)
+
+(defcustom calendar-day-abbrev-array
+ (calendar-abbrev-construct calendar-day-name-array)
+ "Array of capitalized strings giving the abbreviated day names.
The order should be the same as that of the full names specified
in `calendar-day-name-array'. These abbreviations may be used
instead of the full names in the diary file. Do not include a
trailing `.' in the strings specified in this variable, though
-you may use such in the diary file. If any element of this array
-is nil, then the abbreviation will be constructed as the first
-`calendar-abbrev-length' characters of the corresponding full name.")
+you may use such in the diary file. By default, each string is
+the first `calendar-abbrev-length' characters of the corresponding
+full name."
+ :group 'calendar
+ :initialize 'custom-initialize-default
+ :set-after '(calendar-abbrev-length calendar-day-name-array)
+ :set (lambda (symbol value)
+ (let ((hcustomized (calendar-customized-p 'cal-html-day-abbrev-array)))
+ (set symbol value)
+ (and (not hcustomized)
+ (boundp 'cal-html-day-abbrev-array)
+ (setq cal-html-day-abbrev-array calendar-day-abbrev-array))))
+ :type '(vector (string :tag "Sun")
+ (string :tag "Mon")
+ (string :tag "Tue")
+ (string :tag "Wed")
+ (string :tag "Thu")
+ (string :tag "Fri")
+ (string :tag "Sat"))
+ ;; Made defcustom, changed defaults from nil nil...
+ :version "24.1")
(defcustom calendar-month-name-array
["January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December"]
"Array of capitalized strings giving, in order, the month names.
-See also the variable `calendar-month-abbrev-array'."
+If you change this without using customize after the calendar has loaded,
+then you may also want to change `calendar-month-abbrev-array'."
:group 'calendar
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (let ((mcustomized (calendar-customized-p
+ 'calendar-month-abbrev-array)))
+ (set symbol value)
+ (or mcustomized
+ (setq calendar-month-abbrev-array
+ (calendar-abbrev-construct calendar-month-name-array)))))
:type '(vector (string :tag "January")
(string :tag "February")
(string :tag "March")
@@ -2084,46 +2152,54 @@ See also the variable `calendar-month-abbrev-array'."
(string :tag "November")
(string :tag "December")))
-(defvar calendar-month-abbrev-array
- [nil nil nil nil nil nil nil nil nil nil nil nil]
- "*Array of capitalized strings giving the abbreviated month names.
+(defcustom calendar-month-abbrev-array
+ (calendar-abbrev-construct calendar-month-name-array)
+ "Array of capitalized strings giving the abbreviated month names.
The order should be the same as that of the full names specified
in `calendar-month-name-array'. These abbreviations are used in
the calendar menu entries, and can also be used in the diary
file. Do not include a trailing `.' in the strings specified in
-this variable, though you may use such in the diary file. If any
-element of this array is nil, then the abbreviation will be
-constructed as the first `calendar-abbrev-length' characters of the
-corresponding full name.")
-
-(defun calendar-make-alist (sequence &optional start-index filter abbrevs)
- "Make an assoc list corresponding to SEQUENCE.
-Each element of sequence will be associated with an integer, starting
-from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS
-is supplied, the function `calendar-abbrev-construct' is used to
-construct abbreviations corresponding to the elements in SEQUENCE.
-Each abbreviation is entered into the alist with the same
-association index as the full name it represents.
-If FILTER is provided, apply it to each key in the alist."
- (let ((index 0)
- (offset (or start-index 1))
- (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
- (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
- 'period)))
- alist elem)
- (dotimes (i (length sequence) (reverse alist))
- (setq index (+ i offset)
- elem (elt sequence i)
- alist
- (cons (cons (if filter (funcall filter elem) elem) index) alist))
- (if aseq
- (setq elem (elt aseq i)
- alist (cons (cons (if filter (funcall filter elem) elem)
- index) alist)))
- (if aseqp
- (setq elem (elt aseqp i)
- alist (cons (cons (if filter (funcall filter elem) elem)
- index) alist))))))
+this variable, though you may use such in the diary file. By
+default, each string is the first ``calendar-abbrev-length'
+characters of the corresponding full name."
+ :group 'calendar
+ :set-after '(calendar-abbrev-length calendar-month-name-array)
+ :type '(vector (string :tag "Jan")
+ (string :tag "Feb")
+ (string :tag "Mar")
+ (string :tag "Apr")
+ (string :tag "May")
+ (string :tag "Jun")
+ (string :tag "Jul")
+ (string :tag "Aug")
+ (string :tag "Sep")
+ (string :tag "Oct")
+ (string :tag "Nov")
+ (string :tag "Dec"))
+ ;; Made defcustom, changed defaults from nil nil...
+ :version "24.1")
+
+(defun calendar-make-alist (sequence &optional start-index filter
+ &rest sequences)
+ "Return an association list corresponding to SEQUENCE.
+Associates each element of SEQUENCE with an incremented integer,
+starting from START-INDEX (default 1). Applies the function FILTER,
+if provided, to each key in the alist. Repeats the process, with
+indices starting from START-INDEX each time, for any remaining
+arguments SEQUENCES."
+ (or start-index (setq start-index 1))
+ (let (index alist)
+ (mapc (lambda (seq)
+ (setq index start-index)
+ (mapc (lambda (elem)
+ (setq alist (cons
+ (cons (if filter (funcall filter elem) elem)
+ index)
+ alist)
+ index (1+ index)))
+ seq))
+ (append (list sequence) sequences))
+ (reverse alist)))
(defun calendar-read-date (&optional noday)
"Prompt for Gregorian date. Return a list (month day year).
@@ -2162,23 +2238,6 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on."
(+ (* 12 (- yr2 yr1))
(- mon2 mon1)))
-(defun calendar-abbrev-construct (abbrev full &optional period)
- "Internal calendar function to return a complete abbreviation array.
-ABBREV is an array of abbreviations, FULL the corresponding array
-of full names. The return value is the ABBREV array, with any nil
-elements replaced by the first three characters taken from the
-corresponding element of FULL. If optional argument PERIOD is non-nil,
-each element returned has a final `.' character."
- (let (elem array name)
- (dotimes (i (length full))
- (setq name (aref full i)
- elem (or (aref abbrev i)
- (substring name 0
- (min calendar-abbrev-length (length name))))
- elem (format "%s%s" elem (if period "." ""))
- array (append array (list elem))))
- (vconcat array)))
-
(defvar calendar-font-lock-keywords
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
" -?[0-9]+")
@@ -2204,10 +2263,7 @@ be an integer in the range 0 to 6 corresponding to the day of the
week. Day names are taken from the variable `calendar-day-name-array',
unless the optional argument ABBREV is non-nil, in which case
the variable `calendar-day-abbrev-array' is used."
- (aref (if abbrev
- (calendar-abbrev-construct calendar-day-abbrev-array
- calendar-day-name-array)
- calendar-day-name-array)
+ (aref (if abbrev calendar-day-abbrev-array calendar-day-name-array)
(if absolute date (calendar-day-of-week date))))
(defun calendar-month-name (month &optional abbrev)
@@ -2216,10 +2272,7 @@ Months are numbered from one. Month names are taken from the
variable `calendar-month-name-array', unless the optional
argument ABBREV is non-nil, in which case
`calendar-month-abbrev-array' is used."
- (aref (if abbrev
- (calendar-abbrev-construct calendar-month-abbrev-array
- calendar-month-name-array)
- calendar-month-name-array)
+ (aref (if abbrev calendar-month-abbrev-array calendar-month-name-array)
(1- month)))
(defun calendar-day-of-week (date)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 62da7579d50..1b980b3b1fa 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -776,7 +776,8 @@ of the appropriate type."
(goto-char (point-min)))
(defvar diary-included-files nil
- "List of any diary files included in the last call to `diary-list-entries'.")
+ "List of any diary files included in the last call to `diary-list-entries'.
+Or to `diary-mark-entries'.")
(defun diary-list-entries (date number &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'.
@@ -832,7 +833,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(let* ((original-date date) ; save for possible use in the hooks
(date-string (calendar-date-string date))
(diary-buffer (find-buffer-visiting diary-file))
- ;; Dynamically bound in diary-include-other-diary-files.
+ ;; Dynamically bound in diary-include-files.
(d-incp (and (boundp 'diary-including) diary-including))
diary-entries-list file-glob-attrs temp-buff)
(unless d-incp
@@ -921,19 +922,20 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(defvar original-date) ; bound in diary-list-entries
;(defvar number) ; already declared above
-(defun diary-include-other-diary-files ()
- "Add diary entries from included diary files to `diary-entries-list'.
+(defun diary-include-files (&optional mark)
+ "Process diary entries from included diary files.
+By default, lists included entries, but if optional argument MARK is non-nil
+marks entries instead.
For example, this enables you to share common diary files.
-To use, add this function to `diary-list-entries-hook'.
Specify include files using lines matching `diary-include-string', e.g.
#include \"filename\"
-This is recursive; that is, included files may include other files.
-See also `diary-mark-included-diary-files'."
+This is recursive; that is, included files may include other files."
(goto-char (point-min))
(while (re-search-forward
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
nil t)
(let ((diary-file (match-string-no-properties 1))
+ (diary-mark-entries-hook 'diary-mark-included-diary-files)
(diary-list-entries-hook 'diary-include-other-diary-files)
(diary-including t)
diary-hook diary-list-include-blanks efile)
@@ -943,10 +945,12 @@ See also `diary-mark-included-diary-files'."
diary-included-files)
(error "Recursive diary include for %s" diary-file)
(setq diary-included-files
- (append diary-included-files (list efile))
- diary-entries-list
- (append diary-entries-list
- (diary-list-entries original-date number t))))
+ (append diary-included-files (list efile)))
+ (if mark
+ (diary-mark-entries)
+ (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))
@@ -955,6 +959,13 @@ See also `diary-mark-included-diary-files'."
(sleep-for 2))))
(goto-char (point-min)))
+(defun diary-include-other-diary-files ()
+ "Add diary entries from included diary files to `diary-entries-list'.
+To use, add this function to `diary-list-entries-hook'.
+For details, see `diary-include-files'.
+See also `diary-mark-included-diary-files'."
+ (diary-include-files))
+
(define-obsolete-function-alias 'include-other-diary-files
'diary-include-other-diary-files "23.1")
@@ -1250,19 +1261,15 @@ should ensure that all relevant variables are set.
(defun diary-name-pattern (string-array &optional abbrev-array paren)
"Return a regexp matching the strings in the array STRING-ARRAY.
-If the optional argument ABBREV-ARRAY is present, then the function
-`calendar-abbrev-construct' is used to construct abbreviations from the
-two supplied arrays. The returned regexp will then also match these
-abbreviations, with or without final `.' characters. If the optional
-argument PAREN is non-nil, the regexp is surrounded by parentheses."
+If the optional argument ABBREV-ARRAY is present, the regexp
+also matches the supplied abbreviations, with or without final `.'
+characters. If the optional argument PAREN is non-nil, surrounds
+the regexp with parentheses."
(regexp-opt (append string-array
+ abbrev-array
(if abbrev-array
- (calendar-abbrev-construct abbrev-array
- string-array))
- (if abbrev-array
- (calendar-abbrev-construct abbrev-array
- string-array
- 'period))
+ (mapcar (lambda (e) (format "%s." e))
+ abbrev-array))
nil)
paren))
@@ -1363,7 +1370,11 @@ function that converts absolute dates to dates of the appropriate type. "
(cdr (assoc-string dd-name
(calendar-make-alist
calendar-day-name-array
- 0 nil calendar-day-abbrev-array) t)) marks)
+ 0 nil calendar-day-abbrev-array
+ (mapcar (lambda (e)
+ (format "%s." e))
+ calendar-day-abbrev-array))
+ t)) marks)
(if mm-name
(setq mm
(if (string-equal mm-name "*") 0
@@ -1372,7 +1383,11 @@ function that converts absolute dates to dates of the appropriate type. "
(if months (calendar-make-alist months)
(calendar-make-alist
calendar-month-name-array
- 1 nil calendar-month-abbrev-array)) t)))))
+ 1 nil calendar-month-abbrev-array
+ (mapcar (lambda (e)
+ (format "%s." e))
+ calendar-month-abbrev-array)))
+ t)))))
(funcall markfunc mm dd yy marks))))))))
;;;###cal-autoload
@@ -1401,22 +1416,37 @@ marks. This is intended to deal with deleted diary entries."
(setq calendar-mark-diary-entries-flag nil)
(calendar-redraw))
(let ((diary-marking-entries-flag t)
- file-glob-attrs)
- (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
- (save-excursion
- (when (eq major-mode (default-value 'major-mode)) (diary-mode))
- (setq calendar-mark-diary-entries-flag t)
- (message "Marking diary entries...")
- (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
- (with-syntax-table diary-syntax-table
- (diary-mark-entries-1 'calendar-mark-date-pattern)
- (diary-mark-sexp-entries)
- ;; Although it looks like mark-entries-hook runs every time,
- ;; diary-mark-included-diary-files binds it to nil
- ;; (essentially) when it runs in included files.
- (run-hooks 'diary-nongregorian-marking-hook
- 'diary-mark-entries-hook))
- (message "Marking diary entries...done")))))
+ (diary-buffer (find-buffer-visiting diary-file))
+ ;; Dynamically bound in diary-include-files.
+ (d-incp (and (boundp 'diary-including) diary-including))
+ file-glob-attrs temp-buff)
+ (unless d-incp
+ (setq diary-included-files nil)
+ (message "Marking diary entries..."))
+ (unwind-protect
+ (with-current-buffer (or diary-buffer
+ (if d-incp
+ (setq temp-buff (generate-new-buffer
+ " *diary-temp*"))
+ (find-file-noselect
+ (diary-check-diary-file) t)))
+ (if temp-buff
+ ;; If including, caller has already verified it is readable.
+ (insert-file-contents diary-file)
+ (if (eq major-mode (default-value 'major-mode)) (diary-mode)))
+ (setq calendar-mark-diary-entries-flag t)
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
+ (with-syntax-table diary-syntax-table
+ (save-excursion
+ (diary-mark-entries-1 'calendar-mark-date-pattern)
+ (diary-mark-sexp-entries)
+ ;; Although it looks like mark-entries-hook runs every time,
+ ;; diary-mark-included-diary-files binds it to nil
+ ;; (essentially) when it runs in included files.
+ (run-hooks 'diary-nongregorian-marking-hook
+ 'diary-mark-entries-hook))))
+ (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
+ (or d-incp (message "Marking diary entries...done"))))
;;;###cal-autoload
(define-obsolete-function-alias 'mark-diary-entries 'diary-mark-entries "23.1")
@@ -1500,32 +1530,10 @@ is marked. See the documentation for the function `diary-list-sexp-entries'."
(defun diary-mark-included-diary-files ()
"Mark diary entries from included diary files.
-For example, this enables you to share common diary files.
To use, add this function to `diary-mark-entries-hook'.
-Specify include files using lines matching `diary-include-string', e.g.
- #include \"filename\"
-This is recursive; that is, included files may include other files.
+For details, see `diary-include-files'.
See also `diary-include-other-diary-files'."
- (goto-char (point-min))
- (while (re-search-forward
- (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
- nil t)
- (let* ((diary-file (match-string-no-properties 1))
- (diary-mark-entries-hook 'diary-mark-included-diary-files)
- (dbuff (find-buffer-visiting diary-file)))
- (if (file-exists-p diary-file)
- (if (file-readable-p diary-file)
- (progn
- (diary-mark-entries)
- (unless dbuff
- (kill-buffer (find-buffer-visiting diary-file))))
- (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))))
- (goto-char (point-min)))
+ (diary-include-files t))
(define-obsolete-function-alias 'mark-included-diary-files
'diary-mark-included-diary-files "23.1")
@@ -2307,11 +2315,10 @@ Prefix argument ARG makes the entry nonmarking."
(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
"Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
-If given, optional SYMBOL must be a prefix to entries.
-If optional ABBREV-ARRAY is present, the abbreviations constructed
-from this array by the function `calendar-abbrev-construct' are
-matched (with or without a final `.'), in addition to the full month
-names."
+If given, optional SYMBOL must be a prefix to entries. If
+optional ABBREV-ARRAY is present, also matches the abbreviations
+from this array (with or without a final `.'), in addition to the
+full month names."
(let ((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array t))
(monthname (format "\\(%s\\|\\*\\)"
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 8fc3f762f29..1ec474e828e 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -545,11 +545,7 @@ non-nil, the amount returned will be relative to past time worked."
(defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time
'time-to-seconds))
-(defsubst timeclock-seconds-to-time (seconds)
- "Convert SECONDS (a floating point number) to an Emacs time structure."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
+(defalias 'timeclock-seconds-to-time 'seconds-to-time)
;; Should today-only be removed in favour of timeclock-relative? - gm
(defsubst timeclock-when-to-leave (&optional today-only)
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index b5ecfdd242f..60d7690a3c8 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,26 @@
+2011-07-04 Darren Hoo <darren.hoo@gmail.com> (tiny change)
+
+ * semantic/db.el (semanticdb-file-table-object): Don't bug out on
+ unconfigured projects if `global-ede-mode' is on (bug#8092).
+
+2011-07-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * semantic.el (semantic-elapsed-time): Rewrite using
+ time-subtract and float-time.
+
+2011-05-11 Glenn Morris <rgm@gnu.org>
+
+ * semantic/wisent/javascript.el (semantic-get-local-variables):
+ Use define-mode-local-override rather than its obsolete alias.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ Fix doubled-word typos.
+ * ede/pmake.el (ede-proj-makefile-garbage-patterns): the the -> the
+ * semantic/complete.el (semantic-complete-read-tag-local-members):
+ Likewise.
+ * ede.el (ede-auto-add-method): then then -> then
+
2011-04-23 Juanma Barranquero <lekktu@gmail.com>
* ede/pconf.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf):
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 67b648a44bb..307ccfdadd7 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -80,7 +80,7 @@ project file, all targets are queried to see if it should be added.
If the value is 'always, then the new file is added to the first
target encountered. If the value is 'multi-ask, then if more than one
target wants the file, the user is asked. If only one target wants
-the file, then then it is automatically added to that target. If the
+the file, then it is automatically added to that target. If the
value is 'ask, then the user is always asked, unless there is no
target willing to take the file. 'never means never perform the check."
:group 'ede
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 52a1d485324..d78e95af27f 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -478,7 +478,7 @@ These are removed with make clean."
(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
- ;; Get the the source object from THIS, and use the specified garbage.
+ ;; Get the source object from THIS, and use the specified garbage.
(let ((src (ede-target-sourcecode this))
(garb nil))
(while src
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index c899988dc36..ce9af0e12b5 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -379,9 +379,7 @@ Do not set this yourself. Call `semantic-debug'.")
(defun semantic-elapsed-time (start end)
"Copied from elp.el. Was `elp-elapsed-time'.
Argument START and END bound the time being calculated."
- (+ (* (- (car end) (car start)) 65536.0)
- (- (car (cdr end)) (car (cdr start)))
- (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
+ (float-time (time-subtract end start)))
(defun bovinate (&optional clear)
"Parse the current buffer. Show output in a temp buffer.
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 47cb722e005..18c7b5a1a50 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1825,7 +1825,7 @@ HISTORY is a symbol representing a variable to store the history in."
initial-input
history)
"Ask for a tag by name from the local type members.
-Available tags are from the the current scope.
+Available tags are from the current scope.
Completion options are presented in a traditional way, with highlighting
to resolve same-name collisions.
PROMPT is a string to prompt with.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index fa8de392b62..dca1b3bafea 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -880,7 +880,7 @@ If file does not have tags available, and DONTLOAD is nil,
then load the tags for FILE, and create a new table object for it.
DONTLOAD does not affect the creation of new database objects."
;; (message "Object Translate: %s" file)
- (when (file-exists-p file)
+ (when (and file (file-exists-p file))
(let* ((default-directory (file-name-directory file))
(tab (semanticdb-file-table-object-from-hash file))
(fullfile nil))
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index 9b261439d1a..16b729f3925 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -63,7 +63,7 @@ to this variable NAME."
;; These methods override aspects of how semantic-tools can access
;; the tags created by the javascript parser.
;; Local context
-(define-mode-overload-implementation semantic-get-local-variables
+(define-mode-local-override semantic-get-local-variables
javascript-mode ()
"Get local values from a specific context.
This function overrides `get-local-variables'."
diff --git a/lisp/comint.el b/lisp/comint.el
index 8608c0d31e9..2349fc0edd9 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -347,7 +347,7 @@ This variable is buffer-local."
" +\\)"
(regexp-opt
'("password" "Password" "passphrase" "Passphrase"
- "pass phrase" "Pass phrase"))
+ "pass phrase" "Pass phrase" "Response"))
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\
\\(?: for [^:]+\\)?:\\s *\\'")
"Regexp matching prompts for passwords in the inferior process.
@@ -3035,7 +3035,8 @@ Returns t if successful."
(when (comint--match-partial-filename)
(unless (window-minibuffer-p (selected-window))
(message "Completing file name..."))
- (apply #'completion-in-region (comint--complete-file-name-data))))
+ (let ((data (comint--complete-file-name-data)))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))))
(defun comint-filename-completion ()
"Return completion data for filename at point, if any."
@@ -3134,24 +3135,26 @@ in the same way as TABLE completes strings of the form (concat S2 S)."
#'comint--table-subvert
#'completion-file-name-table
(cdr prefixes) (car prefixes)))))
- (list
- filename-beg filename-end
- (lambda (string pred action)
- (let ((completion-ignore-case read-file-name-completion-ignore-case)
- (completion-ignored-extensions comint-completion-fignore))
- (if (zerop (length filesuffix))
- (complete-with-action action table string pred)
- ;; Add a space at the end of completion. Use a terminator-regexp
- ;; that never matches since the terminator cannot appear
- ;; within the completion field anyway.
- (completion-table-with-terminator
- (cons filesuffix "\\`a\\`")
- table string pred action)))))))
+ (nconc
+ (list
+ filename-beg filename-end
+ (lambda (string pred action)
+ (let ((completion-ignore-case read-file-name-completion-ignore-case)
+ (completion-ignored-extensions comint-completion-fignore))
+ (complete-with-action action table string pred))))
+ (unless (zerop (length filesuffix))
+ (list :exit-function
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at (regexp-quote filesuffix))
+ (goto-char (match-end 0))
+ (insert filesuffix)))))))))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
- (apply #'completion-in-region (comint--complete-file-name-data)))
+ (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")
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 5e74c68978f..091f832c092 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -42,9 +42,12 @@ ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
(defun custom-make-dependencies ()
"Batch function to extract custom dependencies from .el files.
Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
- (let ((enable-local-eval nil))
+ (let ((enable-local-eval nil)
+ subdir)
(with-temp-buffer
- (dolist (subdir command-line-args-left)
+ ;; Use up command-line-args-left else Emacs can try to open
+ ;; the args as directories after we are done.
+ (while (setq subdir (pop command-line-args-left))
(message "Directory %s" subdir)
(let ((files (directory-files subdir nil "\\`[^=].*\\.el\\'"))
(default-directory (expand-file-name subdir))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index f14c055d7a8..d443d6c160c 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -594,7 +594,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
("-function\\'" function)
("-functions\\'" (repeat function))
("-list\\'" (repeat sexp))
- ("-alist\\'" (repeat (cons sexp sexp))))
+ ("-alist\\'" (alist :key-type sexp :value-type sexp)))
"Alist of (MATCH TYPE).
MATCH should be a regexp matching the name of a symbol, and TYPE should
@@ -1033,9 +1033,36 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
(put variable 'saved-variable-comment comment)))
(put variable 'customized-value nil)
(put variable 'customized-variable-comment nil)
- (custom-save-all)
+ (if (custom-file t)
+ (custom-save-all)
+ (message "Setting `%s' temporarily since \"emacs -q\" would overwrite customizations"
+ variable)
+ (set variable value))
value)
+;; Some parts of Emacs might prompt the user to save customizations,
+;; during startup before customizations are loaded. This function
+;; handles this corner case by avoiding calling `custom-save-variable'
+;; too early, which could wipe out existing customizations.
+
+;;;###autoload
+(defun customize-push-and-save (list-var elts)
+ "Add ELTS to LIST-VAR and save for future sessions, safely.
+ELTS should be a list. This function adds each entry to the
+value of LIST-VAR using `add-to-list'.
+
+If Emacs is initialized, call `customize-save-variable' to save
+the resulting list value now. Otherwise, add an entry to
+`after-init-hook' to save it after initialization."
+ (dolist (entry elts)
+ (add-to-list list-var entry))
+ (if after-init-time
+ (let ((coding-system-for-read nil))
+ (customize-save-variable list-var (eval list-var)))
+ (add-hook 'after-init-hook
+ `(lambda ()
+ (customize-push-and-save ',list-var ',elts)))))
+
;;;###autoload
(defun customize ()
"Select a customization buffer which you can use to set user options.
@@ -1806,6 +1833,7 @@ item in another window.\n\n"))
;; We want simple widgets to be displayed by default, but complex
;; widgets to be hidden.
+;; This widget type is obsolete as of Emacs 24.1.
(widget-put (get 'item 'widget-type) :custom-show t)
(widget-put (get 'editable-field 'widget-type)
:custom-show (lambda (_widget value)
@@ -2234,6 +2262,7 @@ 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."
(let ((show (widget-get widget :custom-show)))
@@ -3830,9 +3859,8 @@ restoring it to the state of a face that has never been customized."
:sample-face-get 'widget-face-sample-face-get
:notify 'widget-face-notify
:match (lambda (_widget value) (facep value))
- :complete-function (lambda ()
- (interactive)
- (lisp-complete-symbol 'facep))
+ :completions (apply-partially #'completion-table-with-predicate
+ obarray #'facep 'strict)
:prompt-match 'facep
:prompt-history 'widget-face-prompt-value-history
:validate (lambda (widget)
@@ -4379,23 +4407,27 @@ Click on \"More\" \(or position point there and press RETURN)
if only the first line of the docstring is shown."))
:group 'customize)
-(defun custom-file ()
+(defun custom-file (&optional no-error)
"Return the file name for saving customizations."
- (file-chase-links
- (or custom-file
- (let ((user-init-file user-init-file)
- (default-init-file
- (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
- (when (null user-init-file)
- (if (or (file-exists-p default-init-file)
- (and (eq system-type 'windows-nt)
- (file-exists-p "~/_emacs")))
- ;; Started with -q, i.e. the file containing
- ;; Custom settings hasn't been read. Saving
- ;; settings there would overwrite other settings.
- (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
- (setq user-init-file default-init-file))
- user-init-file))))
+ (let ((file
+ (or custom-file
+ (let ((user-init-file user-init-file)
+ (default-init-file
+ (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
+ (when (null user-init-file)
+ (if (or (file-exists-p default-init-file)
+ (and (eq system-type 'windows-nt)
+ (file-exists-p "~/_emacs")))
+ ;; Started with -q, i.e. the file containing
+ ;; Custom settings hasn't been read. Saving
+ ;; settings there would overwrite other settings.
+ (if no-error
+ nil
+ (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (setq user-init-file default-init-file)))
+ user-init-file))))
+ (and file
+ (file-chase-links file))))
;; If recentf-mode is non-nil, this is defined.
(declare-function recentf-expand-file-name "recentf" (name))
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 90f21f32149..c23632ab885 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -34,30 +34,33 @@
(defun custom-declare-face (face spec doc &rest args)
"Like `defface', but FACE is evaluated as a normal argument."
(unless (get face 'face-defface-spec)
- (unless (facep face)
- ;; If the user has already created the face, respect that.
- (let ((value (or (get face 'saved-face) spec))
- (have-window-system (memq initial-window-system '(x w32))))
- ;; Create global face.
- (make-empty-face face)
- ;; Create frame-local faces
- (dolist (frame (frame-list))
- (face-spec-set-2 face frame value)
- (when (memq (window-system frame) '(x w32 ns))
- (setq have-window-system t)))
- ;; When making a face after frames already exist
- (if have-window-system
- (make-face-x-resource-internal face))))
- ;; Don't record SPEC until we see it causes no errors.
- (put face 'face-defface-spec (purecopy spec))
- (push (cons 'defface face) current-load-list)
- (when (and doc (null (face-documentation face)))
- (set-face-documentation face (purecopy doc)))
- (custom-handle-all-keywords face args 'custom-face)
- (run-hooks 'custom-define-hook)
- ;; If the face has an existing theme setting, recalculate it.
- (if (get face 'theme-face)
- (custom-theme-recalc-face face)))
+ (let ((facep (facep face)))
+ (unless facep
+ ;; If the user has already created the face, respect that.
+ (let ((value (or (get face 'saved-face) spec))
+ (have-window-system (memq initial-window-system '(x w32))))
+ ;; Create global face.
+ (make-empty-face face)
+ ;; Create frame-local faces
+ (dolist (frame (frame-list))
+ (face-spec-set-2 face frame value)
+ (when (memq (window-system frame) '(x w32 ns))
+ (setq have-window-system t)))
+ ;; When making a face after frames already exist
+ (if have-window-system
+ (make-face-x-resource-internal face))))
+ ;; Don't record SPEC until we see it causes no errors.
+ (put face 'face-defface-spec (purecopy spec))
+ (push (cons 'defface face) current-load-list)
+ (when (and doc (null (face-documentation face)))
+ (set-face-documentation face (purecopy doc)))
+ (custom-handle-all-keywords face args 'custom-face)
+ (run-hooks 'custom-define-hook)
+ ;; If the face had existing settings, recalculate it. For
+ ;; example, the user might load a theme with a face setting, and
+ ;; later load a library defining that face.
+ (if facep
+ (custom-theme-recalc-face face))))
face)
;;; Face attributes.
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 6113a4321c5..389716b35b9 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -388,19 +388,18 @@ since it could result in memory overflow and make Emacs crash."
;; window.c
(temp-buffer-show-function windows (choice (const nil) function))
(next-screen-context-lines windows integer)
- (window-min-height windows integer)
- (window-min-width windows integer)
(scroll-preserve-screen-position
windows (choice
(const :tag "Off (nil)" :value nil)
(const :tag "Full screen (t)" :value t)
(other :tag "Always" 1)) "22.1")
- (recenter-redisplay windows
- (choice
- (const :tag "Never (nil)" :value nil)
- (const :tag "Only on ttys" :value tty)
- (other :tag "Always" t))
- "23.1")
+ (recenter-redisplay
+ windows (choice
+ (const :tag "Never (nil)" :value nil)
+ (const :tag "Only on ttys" :value tty)
+ (other :tag "Always" t)) "23.1")
+ (window-splits windows boolean "24.1")
+ (window-nest windows boolean "24.1")
;; xdisp.c
(show-trailing-whitespace whitespace-faces boolean nil
:safe booleanp)
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 86fb43be72a..04a9e728b22 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -157,7 +157,7 @@ remove them from your saved Custom file.\n\n"))
;; Load the theme settings.
(when theme
(unless (eq theme 'user)
- (load-theme theme t))
+ (load-theme theme nil t))
(dolist (setting (get theme 'theme-settings))
(if (eq (car setting) 'theme-value)
(progn (push (nth 1 setting) vars)
@@ -326,7 +326,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
(unless (eq theme 'user)
(unless (custom-theme-name-valid-p theme)
(error "Invalid theme name `%s'" theme))
- (load-theme theme t))
+ (load-theme theme nil t))
(let ((settings (reverse (get theme 'theme-settings))))
(dolist (setting settings)
(funcall (if (eq (car setting) 'theme-value)
@@ -483,25 +483,24 @@ It includes all faces in list FACES."
'help-theme-def fn)
(princ "'"))
(princ ".\n")
- (if (not (memq theme custom-known-themes))
+ (if (custom-theme-p theme)
(progn
- (princ "It is not loaded.")
- ;; Attempt to grab the theme documentation
- (when fn
- (with-temp-buffer
- (insert-file-contents fn)
- (let ((sexp (let ((read-circle nil))
- (condition-case nil
- (read (current-buffer))
- (end-of-file nil)))))
- (and sexp (listp sexp)
- (eq (car sexp) 'deftheme)
- (setq doc (nth 2 sexp)))))))
- (if (custom-theme-enabled-p theme)
- (princ "It is loaded and enabled.")
- (princ "It is loaded but disabled."))
- (setq doc (get theme 'theme-documentation)))
-
+ (if (custom-theme-enabled-p theme)
+ (princ "It is loaded and enabled.")
+ (princ "It is loaded but disabled."))
+ (setq doc (get theme 'theme-documentation)))
+ (princ "It is not loaded.")
+ ;; Attempt to grab the theme documentation
+ (when fn
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (let ((sexp (let ((read-circle nil))
+ (condition-case nil
+ (read (current-buffer))
+ (end-of-file nil)))))
+ (and sexp (listp sexp)
+ (eq (car sexp) 'deftheme)
+ (setq doc (nth 2 sexp)))))))
(princ "\n\nDocumentation:\n")
(princ (if (stringp doc)
doc
@@ -605,26 +604,56 @@ Theme files are named *-theme.el in `"))
(widget-create 'checkbox
:value custom-theme-allow-multiple-selections
:action 'custom-theme-selections-toggle)
- (widget-insert (propertize " Allow more than one theme at a time"
+ (widget-insert (propertize " Select more than one theme at a time"
'face '(variable-pitch (:height 0.9))))
(widget-insert "\n\nAvailable Custom Themes:\n")
- (let (widget)
+ (let ((help-echo "mouse-2: Enable this theme for this session")
+ widget)
(dolist (theme (custom-available-themes))
(setq widget (widget-create 'checkbox
:value (custom-theme-enabled-p theme)
:theme-name theme
+ :help-echo help-echo
:action 'custom-theme-checkbox-toggle))
(push (cons theme widget) custom--listed-themes)
(widget-create-child-and-convert widget 'push-button
:button-face-get 'ignore
:mouse-face-get 'ignore
:value (format " %s" theme)
- :action 'widget-parent-action)
- (widget-insert ?\n)))
+ :action 'widget-parent-action
+ :help-echo help-echo)
+ (widget-insert " -- "
+ (propertize (custom-theme-summary theme)
+ 'face 'shadow)
+ ?\n)))
(goto-char (point-min))
(widget-setup))
+(defun custom-theme-summary (theme)
+ "Return the summary line of THEME."
+ (let (doc)
+ (if (custom-theme-p theme)
+ (setq doc (get theme 'theme-documentation))
+ (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+ (custom-theme--load-path)
+ '("" "c"))))
+ (when fn
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (let ((sexp (let ((read-circle nil))
+ (condition-case nil
+ (read (current-buffer))
+ (end-of-file nil)))))
+ (and sexp (listp sexp)
+ (eq (car sexp) 'deftheme)
+ (setq doc (nth 2 sexp))))))))
+ (cond ((null doc)
+ "(no documentation available)")
+ ((string-match ".*" doc)
+ (match-string 0 doc))
+ (t doc))))
+
(defun custom-theme-checkbox-toggle (widget &optional event)
(let ((this-theme (widget-get widget :theme-name)))
(if (widget-value widget)
diff --git a/lisp/custom.el b/lisp/custom.el
index 8295777f1f1..4f69c741468 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -120,8 +120,10 @@ 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.
-See `send-mail-function' in sendmail.el for an example."
+function, and another one setting the standard-value property."
+ ;; No longer true:
+ ;; "See `send-mail-function' in sendmail.el for an example."
+
;; Until the var is actually initialized, it is kept unbound.
;; This seemed to be at least as good as setting it to an arbitrary
;; value like nil (evaluating `value' is not an option because it
@@ -215,7 +217,8 @@ The following keywords are meaningful:
variable. It takes two arguments, the symbol and value
given in the `defcustom' call. The default is
`custom-initialize-reset'.
-:set VALUE should be a function to set the value of the symbol.
+:set VALUE should be a function to set the value of the symbol
+ when using the Customize user interface.
It takes two arguments, the symbol to set and the value to
give it. The default choice of function is `set-default'.
:get VALUE should be a function to extract the value of symbol.
@@ -854,25 +857,18 @@ See `custom-known-themes' for a list of known themes."
;; Add a new setting:
(t
(unless old
- ;; If the user changed the value outside of Customize, we
- ;; first save the current value to a fake theme, `changed'.
- ;; This ensures that the user-set value comes back if the
- ;; theme is later disabled.
- (cond ((and (eq prop 'theme-value)
- (boundp symbol))
- (let ((sv (get symbol 'standard-value))
- (val (symbol-value symbol)))
- (unless (and sv (equal (eval (car sv)) val))
- (setq old `((changed ,(custom-quote val)))))))
- ((and (facep symbol)
- (not (face-attr-match-p
- symbol
- (custom-fix-face-spec
- (face-spec-choose
- (get symbol 'face-defface-spec))))))
- (setq old `((changed
- (,(append '(t) (custom-face-attributes-get
- symbol nil)))))))))
+ ;; If the user changed a variable outside of Customize, save
+ ;; the value to a fake theme, `changed'. If the theme is
+ ;; later disabled, we use this to bring back the old value.
+ ;;
+ ;; For faces, we just use `face-new-frame-defaults' to
+ ;; recompute when the theme is disabled.
+ (when (and (eq prop 'theme-value)
+ (boundp symbol))
+ (let ((sv (get symbol 'standard-value))
+ (val (symbol-value symbol)))
+ (unless (and sv (equal (eval (car sv)) val))
+ (setq old `((changed ,(custom-quote val))))))))
(put symbol prop (cons (list theme value) old))
(put theme 'theme-settings
(cons (list prop symbol theme value) theme-settings))))))
@@ -1119,20 +1115,29 @@ Emacs theme directory (a directory named \"themes\" in
:risky t
:version "24.1")
-(defun load-theme (theme &optional no-enable)
+(defun load-theme (theme &optional no-confirm no-enable)
"Load Custom theme named THEME from its file.
-Normally, this also enables THEME. If optional arg NO-ENABLE is
-non-nil, load THEME but don't enable it.
-
The theme file is named THEME-theme.el, in one of the directories
specified by `custom-theme-load-path'.
+If THEME is not in `custom-safe-themes', prompt the user for
+confirmation, unless optional arg NO-CONFIRM is non-nil.
+
+Normally, this function also enables THEME; if optional arg
+NO-ENABLE is non-nil, load the theme but don't enable it.
+
+This function is normally called through Customize when setting
+`custom-enabled-themes'. If used directly in your init file, it
+should be called with a non-nil NO-CONFIRM argument, or after
+`custom-safe-themes' has been loaded.
+
Return t if THEME was successfully loaded, nil otherwise."
(interactive
(list
(intern (completing-read "Load custom theme: "
(mapcar 'symbol-name
- (custom-available-themes))))))
+ (custom-available-themes))))
+ nil nil))
(unless (custom-theme-name-valid-p theme)
(error "Invalid theme name `%s'" theme))
;; If reloading, clear out the old theme settings.
@@ -1152,7 +1157,8 @@ Return t if THEME was successfully loaded, nil otherwise."
(setq hash (sha1 (current-buffer)))
;; Check file safety with `custom-safe-themes', prompting the
;; user if necessary.
- (when (or (and (memq 'default custom-safe-themes)
+ (when (or no-confirm
+ (and (memq 'default custom-safe-themes)
(equal (file-name-directory fn)
(expand-file-name "themes/" data-directory)))
(member hash custom-safe-themes)
@@ -1211,10 +1217,7 @@ query also about adding HASH to `custom-safe-themes'."
;; 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? ")
- (let ((coding-system-for-read nil))
- (push hash custom-safe-themes)
- (customize-save-variable 'custom-safe-themes
- custom-safe-themes)))
+ (customize-push-and-save 'custom-safe-themes (list hash)))
t)))))
(defun custom-theme-name-valid-p (name)
@@ -1291,7 +1294,10 @@ This list does not include the `user' theme, which is set by
Customize and always takes precedence over other Custom Themes.
This variable cannot be defined inside a Custom theme; there, it
-is simply ignored."
+is simply ignored.
+
+Setting this variable through Customize calls `enable-theme' or
+`load-theme' for each theme in the list."
:group 'customize
:type '(repeat symbol)
:set-after '(custom-theme-directory custom-theme-load-path
@@ -1345,11 +1351,33 @@ See `custom-enabled-themes' for a list of enabled themes."
;; If the face spec specified by this theme is in the
;; saved-face property, reset that property.
(when (equal (nth 3 s) (get symbol 'saved-face))
- (put symbol 'saved-face (and val (cadr (car val)))))
- (custom-theme-recalc-face symbol)))))
+ (put symbol 'saved-face (and val (cadr (car val)))))))))
+ ;; Recompute faces on all frames.
+ (dolist (frame (frame-list))
+ ;; We must reset the fg and bg color frame parameters, or
+ ;; `face-set-after-frame-default' will use the existing
+ ;; parameters, which could be from the disabled theme.
+ (set-frame-parameter frame 'background-color
+ (custom--frame-color-default
+ frame :background "background" "Background"
+ "unspecified-bg" "white"))
+ (set-frame-parameter frame 'foreground-color
+ (custom--frame-color-default
+ frame :foreground "foreground" "Foreground"
+ "unspecified-fg" "black"))
+ (face-set-after-frame-default frame))
(setq custom-enabled-themes
(delq theme custom-enabled-themes)))))
+(defun custom--frame-color-default (frame attribute resource-attr resource-class
+ tty-default x-default)
+ (let ((col (face-attribute 'default attribute t)))
+ (cond
+ ((and col (not (eq col 'unspecified))) col)
+ ((null (window-system frame)) tty-default)
+ ((setq col (x-get-resource resource-attr resource-class)) col)
+ (t x-default))))
+
(defun custom-variable-theme-value (variable)
"Return (list VALUE) indicating the custom theme value of VARIABLE.
That is to say, it specifies what the value should be according to
@@ -1381,7 +1409,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
(face-spec-recalc face frame)))
-;;; XEmacs compability functions
+;;; XEmacs compatibility functions
;; In XEmacs, when you reset a Custom Theme, you have to specify the
;; theme to reset it to. We just apply the next available theme, so
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 00e2ec802e2..540b93faad8 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -206,7 +206,8 @@ starting with or containing `no-'. If you set this variable to
expanding `yes-or-no-' signals an error because `-' is not part of a word;
but expanding `yes-or-no' looks for a word starting with `no'.
-The recommended value is \"\\\\sw\\\\|\\\\s_\"."
+The recommended value is nil, which will make dabbrev default to
+using \"\\\\sw\\\\|\\\\s_\"."
:type '(choice (const nil)
regexp)
:group 'dabbrev)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 059a635cded..3103fbd5a7f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -56,9 +56,9 @@ into this list; they also should call `dired-log' to log the errors.")
"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'.
+The prompted-for FILE is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
-which is options for `diff'."
+which is the string of command switches for `diff'."
(interactive
(let* ((current (dired-get-filename t))
;; Get the file at the mark.
@@ -229,14 +229,17 @@ List has a form of (file-name full-file-name (attribute-list))."
(defun dired-touch-initial (files)
"Create initial input value for `touch' command."
- (let (initial)
- (while files
- (let ((current (nth 5 (file-attributes (car files)))))
- (if (and initial (not (equal initial current)))
- (setq initial (current-time) files nil)
- (setq initial current))
- (setq files (cdr files))))
- (format-time-string "%Y%m%d%H%M.%S" initial)))
+ ;; Nobody can explain what this version is supposed to do. (Bug#6887)
+ ;; Also, the manual says it uses "the present time".
+ ;;; (let (initial)
+ ;;; (while files
+ ;;; (let ((current (nth 5 (file-attributes (car files)))))
+ ;;; (if (and initial (not (equal initial current)))
+ ;;; (setq initial (current-time) files nil)
+ ;;; (setq initial current))
+ ;;; (setq files (cdr files))))
+ ;;; (format-time-string "%Y%m%d%H%M.%S" initial)))
+ (format-time-string "%Y%m%d%H%M.%S" (current-time)))
(defun dired-do-chxxx (attribute-name program op-symbol arg)
;; Change file attributes (mode, group, owner, timestamp) of marked files and
@@ -511,22 +514,25 @@ to the end of the list of defaults just after the default value."
;; This is an extra function so that you can redefine it, e.g., to use gmhist.
(defun dired-read-shell-command (prompt arg files)
- "Read a dired shell command prompting with PROMPT.
-Passes the prefix argument ARG to `dired-mark-prompt', so that it
-can be used in the prompt to indicate which FILES are affected.
-Normally reads the command with `read-shell-command', but if the
-`dired-x' packages is loaded, uses `dired-guess-shell-command' to offer
-a smarter default choice of shell command."
+ "Read a dired shell command.
+PROMPT should be a format string with one \"%s\" format sequence,
+which is replaced by the value returned by `dired-mark-prompt',
+with ARG and FILES as its arguments. FILES should be a list of
+file names. The result is used as the prompt.
+
+This normally reads using `read-shell-command', but if the
+`dired-x' package is loaded, use `dired-guess-shell-command' to
+offer a smarter default choice of shell command."
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
- (if (featurep 'dired-x)
+ (if (functionp 'dired-guess-shell-command)
(dired-mark-pop-up nil 'shell files
- #'dired-guess-shell-command prompt files)
+ 'dired-guess-shell-command prompt files)
(dired-mark-pop-up nil 'shell files
- #'read-shell-command prompt nil nil))))
+ 'read-shell-command prompt nil nil))))
;;;###autoload
(defun dired-do-async-shell-command (command &optional arg file-list)
@@ -696,6 +702,9 @@ can be produced by `dired-get-marked-files', for example."
;; Commands that delete or redisplay part of the dired buffer.
(defun dired-kill-line (&optional arg)
+ "Kill the current line (not the files).
+With a prefix argument, kill that many lines starting with the current line.
+\(A negative argument kills backward.)"
(interactive "P")
(setq arg (prefix-numeric-value arg))
(let (buffer-read-only file)
@@ -1005,7 +1014,7 @@ See Info node `(emacs)Subdir switches' for more details."
(dired-uncache
(if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename))
- ;; Postphone readin hook till we map
+ ;; Postpone readin hook till we map
;; over all marked files (Bug#6810).
(dired-after-readin-hook nil))
(message "Redisplaying... %s" fname)
@@ -2490,8 +2499,9 @@ with the command \\[tags-loop-continue]."
;;;###autoload
(defun dired-show-file-type (file &optional deref-symlinks)
"Print the type of FILE, according to the `file' command.
-If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
-true then the type of the file linked to by FILE is printed instead."
+If you give a prefix to this command, and FILE is a symbolic
+link, then the type of the file linked to by FILE is printed
+instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
(let (process-file-side-effects)
(with-temp-buffer
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 548728cf28d..0f2cfd4973f 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -546,11 +546,14 @@ This functions works by temporarily binding `dired-marker-char' to
;; Returns t if any work was done, nil otherwise.
(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
"Mark unmarked files matching REGEXP, displaying MSG.
-REGEXP is matched against the entire file name.
-Does not re-mark files which already have a mark.
+REGEXP is matched against the entire file name. When called
+interactively, prompt for REGEXP.
With prefix argument, unflag all those files.
Optional fourth argument LOCALP is as in `dired-get-filename'."
- (interactive "P")
+ (interactive
+ (list (dired-read-regexp
+ "Mark unmarked files matching regexp (default all): ")
+ nil current-prefix-arg nil))
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if
(and
@@ -1053,12 +1056,11 @@ You can set this variable in your ~/.emacs. For example, to add rules for
`.foo' and `.bar' files, write
\(setq dired-guess-shell-alist-user
- (list (list \"\\\\.foo\\\\'\" \"FOO-COMMAND\");; fixed rule
- ;; possibly more rules ...
- (list \"\\\\.bar\\\\'\";; rule with condition test
- '(if condition
- \"BAR-COMMAND-1\"
- \"BAR-COMMAND-2\")))\)"
+ '((\"\\\\.foo\\\\'\" \"FOO-COMMAND\")
+ (\"\\\\.bar\\\\'\"
+ (if condition
+ \"BAR-COMMAND-1\"
+ \"BAR-COMMAND-2\"))))"
:group 'dired-x
:type '(alist :key-type regexp :value-type (repeat sexp)))
@@ -1069,7 +1071,7 @@ You can set this variable in your ~/.emacs. For example, to add rules for
:type 'boolean)
(defun dired-guess-default (files)
- "Guess a shell commands for FILES. Return command or list of commands.
+ "Return a shell command, or a list of commands, appropriate for FILES.
See `dired-guess-shell-alist-user'."
(let* ((case-fold-search dired-guess-shell-case-fold-search)
@@ -1101,8 +1103,8 @@ See `dired-guess-shell-alist-user'."
;; Return commands or nil if flist is still non-nil.
;; Evaluate the commands in order that any logical testing will be done.
(if (cdr cmds)
- (mapcar #'eval cmds)
- (eval (car cmds))))) ; single command
+ (delete-dups (mapcar #'eval cmds))
+ (eval (car cmds))))) ; single command
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."
@@ -1403,7 +1405,7 @@ Considers buffers closer to the car of `buffer-list' to be more recent."
(defun dired-mark-sexp (predicate &optional unflag-p)
"Mark files for which PREDICATE returns non-nil.
-With a prefix arg, unflag those files instead.
+With a prefix arg, unmark or unflag those files instead.
PREDICATE is a lisp expression that can refer to the following symbols:
diff --git a/lisp/dired.el b/lisp/dired.el
index c581597494c..01d41bba27d 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -78,10 +78,22 @@ If nil, `dired-listing-switches' is used."
:type 'file)
(defcustom dired-use-ls-dired 'unspecified
- "Non-nil means Dired should use \"ls --dired\".
+ "Non-nil means Dired should pass the \"--dired\" option to \"ls\".
The special value of `unspecified' means to check explicitly, and
save the result in this variable. This is performed the first
-time `dired-insert-directory' is called."
+time `dired-insert-directory' is called.
+
+Note that if you set this option to nil, either through choice or
+because your \"ls\" program does not support \"--dired\", Dired
+will fail to parse some \"unusual\" file names, e.g. those with leading
+spaces. You might want to install ls from GNU Coreutils, which does
+support this option. Alternatively, you might want to use Emacs's
+own emulation of \"ls\", by using:
+ \(setq ls-lisp-use-insert-directory-program nil)
+ \(require 'ls-lisp)
+This is used by default on MS Windows, which does not have an \"ls\" program.
+Note that `ls-lisp' does not support as many options as GNU ls, though.
+For more details, see Info node `(emacs)ls in Lisp'."
:group 'dired
:type '(choice (const :tag "Check for --dired support" unspecified)
(const :tag "Do not use --dired" nil)
@@ -238,8 +250,6 @@ This is what the do-commands look for, and what the mark-commands store.")
;; (> baud-rate search-slow-speed)
"Non-nil means Dired shrinks the display buffer to fit the marked files.")
-(defvar dired-flagging-regexp nil);; Last regexp used to flag files.
-
(defvar dired-file-version-alist)
;;;###autoload
@@ -341,11 +351,11 @@ Subexpression 2 must end right before the \\n or \\r.")
(defface dired-flagged
'((t (:inherit font-lock-warning-face)))
- "Face used for flagged files."
+ "Face used for files flagged for deletion."
:group 'dired-faces
:version "22.1")
(defvar dired-flagged-face 'dired-flagged
- "Face name used for flagged files.")
+ "Face name used for files flagged for deletion.")
(defface dired-warning
;; Inherit from font-lock-warning-face since with min-colors 8
@@ -485,7 +495,16 @@ Return value is the number of files marked, or nil if none were marked."
`(let ((inhibit-read-only t) count)
(save-excursion
(setq count 0)
- (if ,msg (message "Marking %ss..." ,msg))
+ (when ,msg
+ (message "%s %ss%s..."
+ (cond ((eq dired-marker-char ?\040) "Unmarking")
+ ((eq dired-del-marker dired-marker-char)
+ "Flagging")
+ (t "Marking"))
+ ,msg
+ (if (eq dired-del-marker dired-marker-char)
+ " for deletion"
+ "")))
(goto-char (point-min))
(while (not (eobp))
(if ,predicate
@@ -506,24 +525,31 @@ Return value is the number of files marked, or nil if none were marked."
(defmacro dired-map-over-marks (body arg &optional show-progress
distinguish-one-marked)
"Eval BODY with point on each marked line. Return a list of BODY's results.
-If no marked file could be found, execute BODY on the current line.
-ARG, if non-nil, specifies the files to use instead of the marked files.
- If ARG is an integer, use the next ARG (or previous -ARG, if
- ARG<0) files. In that case, point is dragged along. This is
- so that commands on the next ARG (instead of the marked) files
- can be chained easily.
- For any other non-nil value of ARG, use the current file.
+If no marked file could be found, execute BODY on the current
+line. ARG, if non-nil, specifies the files to use instead of the
+marked files.
+
+If ARG is an integer, use the next ARG (or previous -ARG, if
+ARG<0) files. In that case, point is dragged along. This is so
+that commands on the next ARG (instead of the marked) files can
+be chained easily.
+For any other non-nil value of ARG, use the current file.
+
If optional third arg SHOW-PROGRESS evaluates to non-nil,
- redisplay the dired buffer after each file is processed.
-No guarantee is made about the position on the marked line.
- BODY must ensure this itself if it depends on this.
-Search starts at the beginning of the buffer, thus the car of the list
- corresponds to the line nearest to the buffer's bottom. This
- is also true for (positive and negative) integer values of ARG.
+redisplay the dired buffer after each file is processed.
+
+No guarantee is made about the position on the marked line. BODY
+must ensure this itself if it depends on this.
+
+Search starts at the beginning of the buffer, thus the car of the
+list corresponds to the line nearest to the buffer's bottom.
+This is also true for (positive and negative) integer values of
+ARG.
+
BODY should not be too long as it is expanded four times.
-If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
-return (t FILENAME) instead of (FILENAME)."
+If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one
+marked file, return (t FILENAME) instead of (FILENAME)."
;;
;;Warning: BODY must not add new lines before point - this may cause an
;;endless loop.
@@ -696,7 +722,6 @@ shell wildcards appended to select certain files). If DIRNAME is a cons,
its first element is taken as the directory name and the rest as an explicit
list of files to make directory entries for.
\\<dired-mode-map>\
-You can move around in it with the usual commands.
You can flag files for deletion with \\[dired-flag-file-deletion] and then
delete them by typing \\[dired-do-flagged-delete].
Type \\[describe-mode] after entering Dired for more info.
@@ -1106,9 +1131,13 @@ If HDR is non-nil, insert a header line with the directory name."
(or (if (eq dired-use-ls-dired 'unspecified)
;; Check whether "ls --dired" gives exit code 0, and
;; save the answer in `dired-use-ls-dired'.
- (setq dired-use-ls-dired
- (eq (call-process insert-directory-program nil nil nil "--dired")
- 0))
+ (or (setq dired-use-ls-dired
+ (eq 0 (call-process insert-directory-program
+ nil nil nil "--dired")))
+ (progn
+ (message "ls does not support --dired; \
+see `dired-use-ls-dired' for more details.")
+ nil))
dired-use-ls-dired)
(file-remote-p dir)))
(setq switches (concat "--dired " switches)))
@@ -1162,7 +1191,7 @@ If HDR is non-nil, insert a header line with the directory name."
(insert " wildcard " (file-name-nondirectory dir) "\n")))))
(defun dired-insert-set-properties (beg end)
- "Make the file names highlight when the mouse is on them."
+ "Add various text properties to the lines in the region."
(save-excursion
(goto-char beg)
(while (< (point) end)
@@ -1789,8 +1818,8 @@ In Dired, you are \"editing\" a list of the files in a directory and
files for later commands or \"flag\" them for deletion, either file
by file or all files matching certain criteria.
You can move using the usual cursor motion commands.\\<dired-mode-map>
-Letters no longer insert themselves. Digits are prefix arguments.
-Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion.
+The buffer is read-only. Digits are prefix arguments.
+Type \\[dired-flag-file-deletion] to flag a file `D' for deletion.
Type \\[dired-mark] to Mark a file or subdirectory for later commands.
Most commands operate on the marked files and use the current file
if no files are marked. Use a numeric prefix argument to operate on
@@ -1798,9 +1827,9 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands.
to operate on the current file only. Prefix arguments override marks.
Mark-using commands display a list of failures afterwards. Type \\[dired-summary]
to see why something went wrong.
-Type \\[dired-unmark] to Unmark a file or all files of a subdirectory.
-Type \\[dired-unmark-backward] to back up one line and unflag.
-Type \\[dired-do-flagged-delete] to eXecute the deletions requested.
+Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory.
+Type \\[dired-unmark-backward] to back up one line and unmark or unflag.
+Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'.
Type \\[dired-find-file] to Find the current line's file
(or dired it in another buffer, if it is a directory).
Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
@@ -1810,12 +1839,12 @@ Type \\[dired-do-copy] to Copy files.
Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
Type \\[revert-buffer] to read all currently expanded directories aGain.
This retains all marks and hides subdirs again that were hidden before.
-SPC and DEL can be used to move down and up by lines.
+Use `SPC' and `DEL' to move down and up by lines.
If Dired ever gets confused, you can either type \\[revert-buffer] \
to read the
directories again, type \\[dired-do-redisplay] \
-to relist a single or the marked files or a
+to relist the file at point or the marked files or a
subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
again for the directory tree.
@@ -2818,8 +2847,12 @@ also offers to kill buffers visiting deleted files and directories."
(if (= 1 count) "" "s"))
(defun dired-mark-prompt (arg files)
- "Return a string for use in a prompt, either the current file
-name, or the marker and a count of marked files."
+ "Return a string suitable for use in a Dired prompt.
+ARG is normally the prefix argument for the calling command.
+FILES should be a list of file names.
+
+The return value has a form like \"foo.txt\", \"[next 3 files]\",
+or \"* [3 files]\"."
;; distinguish-one-marked can cause the first element to be just t.
(if (eq (car files) t) (setq files (cdr files)))
(let ((count (length files)))
@@ -3015,8 +3048,9 @@ If on a subdir headerline, mark all its files except `.' and `..'."
(dired-mark arg)))
(defun dired-unmark-backward (arg)
- "In Dired, move up lines and remove deletion flag there.
-Optional prefix ARG says how many lines to unflag; default is one line."
+ "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."
(interactive "p")
(dired-unmark (- arg)))
@@ -3110,14 +3144,14 @@ The match is against the non-directory part of the filename. Use `^'
(defun dired-mark-symlinks (unflag-p)
"Mark all symbolic links.
-With prefix argument, unflag all those files."
+With prefix argument, unmark or unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (looking-at dired-re-sym) "symbolic link")))
(defun dired-mark-directories (unflag-p)
"Mark all directory file lines except `.' and `..'.
-With prefix argument, unflag all those files."
+With prefix argument, unmark or unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (and (looking-at dired-re-dir)
@@ -3126,7 +3160,7 @@ With prefix argument, unflag all those files."
(defun dired-mark-executables (unflag-p)
"Mark all executable files.
-With prefix argument, unflag all those files."
+With prefix argument, unmark or unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (looking-at dired-re-exe) "executable file")))
@@ -3136,7 +3170,7 @@ With prefix argument, unflag all those files."
(defun dired-flag-auto-save-files (&optional unflag-p)
"Flag for deletion files whose names suggest they are auto save files.
-A prefix argument says to unflag those files instead."
+A prefix argument says to unmark or unflag those files instead."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
(dired-mark-if
@@ -3176,7 +3210,7 @@ A prefix argument says to unflag those files instead."
(defun dired-flag-backup-files (&optional unflag-p)
"Flag all backup files (names ending with `~') for deletion.
-With prefix argument, unflag these files."
+With prefix argument, unmark or unflag these files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
@@ -3629,16 +3663,16 @@ 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" "e34e1bbdb701078d52466c319d8e0cda")
+;;;;;; dired-diff) "dired-aux" "dired-aux.el" "ab62f310329f404f96a29e4f0ab8df73")
;;; 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'.
+The prompted-for FILE is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
-which is options for `diff'.
+which is the string of command switches for `diff'.
\(fn FILE &optional SWITCHES)" t nil)
@@ -4081,15 +4115,16 @@ with the command \\[tags-loop-continue].
(autoload 'dired-show-file-type "dired-aux" "\
Print the type of FILE, according to the `file' command.
-If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
-true then the type of the file linked to by FILE is printed instead.
+If you give a prefix to this command, and FILE is a symbolic
+link, then the type of the file linked to by FILE is printed
+instead.
\(fn FILE &optional DEREF-SYMLINKS)" t nil)
;;;***
;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump)
-;;;;;; "dired-x" "dired-x.el" "94bd5ca0bd260e43402e3cd9f114970c")
+;;;;;; "dired-x" "dired-x.el" "219648338c42c7912fa336680b434db0")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 7a9043a6a0a..3befedac256 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -94,9 +94,27 @@ Valid symbols are `truncation', `wrap', `escape', `control',
(while (< i 256)
(aset vector i (aref dt i))
(setq i (1+ i)))
- (describe-vector vector))
+ (describe-vector
+ vector 'display-table-print-array))
(help-mode))))
+(defun display-table-print-array (desc)
+ (insert "[")
+ (let ((column (current-column))
+ (width (window-width))
+ string)
+ (dotimes (i (length desc))
+ (setq string (format "%s" (aref desc i)))
+ (cond
+ ((>= (+ (current-column) (length string) 1)
+ width)
+ (insert "\n")
+ (insert (make-string column ? )))
+ ((> i 0)
+ (insert " ")))
+ (insert string)))
+ (insert "]\n"))
+
;;;###autoload
(defun describe-current-display-table ()
"Describe the display table in use in the selected window and buffer."
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 7bd1a55011e..666c6a8b034 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -614,9 +614,10 @@ It's a subdirectory of `doc-view-cache-directory'."
(defun doc-view-remove-if (predicate list)
"Return LIST with all items removed that satisfy PREDICATE."
(let (new-list)
- (dolist (item list (nreverse new-list))
+ (dolist (item list)
(when (not (funcall predicate item))
- (setq new-list (cons item new-list))))))
+ (setq new-list (cons item new-list))))
+ (nreverse new-list)))
;;;###autoload
(defun doc-view-mode-p (type)
@@ -1549,7 +1550,7 @@ See the command `doc-view-mode' for more information on this mode."
(provide 'doc-view)
;; Local Variables:
-;; eval: (outline-minor-mode)
+;; eval: (outline-minor-mode 1)
;; End:
;;; doc-view.el ends here
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 36832df3c67..5dac6d22722 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -228,10 +228,10 @@ dealing with untranslated filesystems."
;; directory separators changed to directory-sep-char.
(let ((name nil))
(setq name (mapconcat
- '(lambda (char)
- (if (and (<= ?A char) (<= char ?Z))
- (char-to-string (+ (- char ?A) ?a))
- (char-to-string char)))
+ (lambda (char)
+ (if (and (<= ?A char) (<= char ?Z))
+ (char-to-string (+ (- char ?A) ?a))
+ (char-to-string char)))
filename nil))
;; Use expand-file-name to canonicalize directory separators, except
;; with bare drive letters (which would have the cwd appended).
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 81531c4a21f..167da69d1ca 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -86,7 +86,9 @@ current form for the frame (i.e. hinting or somesuch changed)."
Changes can be
The monospace font. If `font-use-system-font' is nil, the font
is not changed.
+ The normal font.
Xft parameters, like DPI and hinting.
+ The Gtk+ theme name.
The tool bar style."
(interactive "e")
(let ((type (nth 1 event))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 5934975e36a..a245a91c5c1 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2135,16 +2135,27 @@ Redefining advices affect the construction of an advised definition."
;; @@ Interactive input functions:
;; ===============================
+(declare-function 'function-called-at-point "help")
+
(defun ad-read-advised-function (&optional prompt predicate default)
"Read name of advised function with completion from the minibuffer.
An optional PROMPT will be used to prompt for the function. PREDICATE
plays the same role as for `try-completion' (which see). DEFAULT will
-be returned on empty input (defaults to the first advised function for
-which PREDICATE returns non-nil)."
+be returned on empty input (defaults to the first advised function or
+function at point for which PREDICATE returns non-nil)."
(if (null ad-advised-functions)
(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.
+ (let ((function (progn
+ (require 'help)
+ (function-called-at-point))))
+ (and function
+ (assoc (symbol-name function) ad-advised-functions)
+ (or (null predicate)
+ (funcall predicate function))
+ function))
(ad-do-advised-functions (function)
(if (or (null predicate)
(funcall predicate function))
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 163af883334..596b32f24c3 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -437,7 +437,7 @@ Changes to files in this list are not listed.")
;; No longer distributed.
;;; "vmspaths.h" "build.com" "compile.com" "kepteditor.com" "precomp.com"
;;; "vmsproc.el" :wrote "logout.com" "mailemacs.com")
- ("Guillermo J. Rozas" :wrote "fakemail.c")
+;;; ("Guillermo J. Rozas" :wrote "fakemail.c")
("Wolfgang Rupprecht" :changed "lisp-mode.el" "loadup.el"
"sort.el" "alloc.c" "callint.c"
;; config.in renamed from config.h.in; ecrt0.c from crt0.c.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index f8f8d9b00f2..6d5067151d3 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -769,52 +769,21 @@ Calls `update-directory-autoloads' on the command line arguments.
Definitions are written to `generated-autoload-file' (which
should be non-nil)."
;; For use during the Emacs build process only.
+ ;; Exclude those files that are preloaded on ALL platforms.
+ ;; These are the ones in loadup.el where "(load" is at the start
+ ;; of the line (crude, but it works).
(unless autoload-excludes
- (let* ((ldir (file-name-directory generated-autoload-file))
- (default-directory
- (file-name-as-directory
- (expand-file-name (if (eq system-type 'windows-nt)
- "../lib-src"
- "../src") ldir)))
- (mfile "Makefile")
- (tmpfile "echolisp.tmp")
- lim)
- ;; Windows uses the 'echolisp' approach because:
- ;; i) It does not have $lisp as a single simple definition, so
- ;; it would be harder to parse the Makefile.
- ;; ii) It can, since it already has $lisp broken up into pieces
- ;; that the command-line can handle.
- ;; Non-Windows builds do not use the 'echolisp' approach because
- ;; no-one knows (?) the maximum safe command-line length on all
- ;; supported systems. $lisp is much longer there since it uses
- ;; absolute paths, and it would seem a shame to split it just for this.
- (when (file-readable-p mfile)
- (if (eq system-type 'windows-nt)
- (when (ignore-errors
- (if (file-exists-p tmpfile) (delete-file tmpfile))
- ;; FIXME call-process is better, if it works.
- (shell-command (format "%s echolisp > %s"
- autoload-make-program tmpfile))
- (file-readable-p tmpfile))
- (with-temp-buffer
- (insert-file-contents tmpfile)
- ;; FIXME could be a single while loop.
- (while (not (eobp))
- (setq lim (line-end-position))
- (while (re-search-forward "\\([^ ]+\\.el\\)c?\\>" lim t)
- (push (expand-file-name (match-string 1))
- autoload-excludes))
- (forward-line 1))))
- (with-temp-buffer
- (insert-file-contents mfile)
- (when (re-search-forward "^shortlisp= " nil t)
- (while (and (not lim)
- (re-search-forward "\\.\\./lisp/\\([^ ]+\\.el\\)c?\\>"
- nil t))
- (push (expand-file-name (match-string 1) ldir)
- autoload-excludes)
- (skip-chars-forward " \t")
- (if (eolp) (setq lim t)))))))))
+ (let ((default-directory (file-name-directory generated-autoload-file))
+ file)
+ (when (file-readable-p "loadup.el")
+ (with-temp-buffer
+ (insert-file-contents "loadup.el")
+ (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
+ (setq file (match-string 1))
+ (or (string-match "\\.el\\'" file)
+ (setq file (format "%s.el" file)))
+ (or (string-match "\\`site-" file)
+ (push (expand-file-name file) autoload-excludes)))))))
(let ((args command-line-args-left))
(setq command-line-args-left nil)
(apply 'update-directory-autoloads args)))
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 0a637da0bc1..e8b7a1f9a8b 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -3,11 +3,12 @@
;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
-;; Inge Wallin <inge@lysator.liu.se>
-;; Thomas Bellman <bellman@lysator.liu.se>
+;; Inge Wallin <inge@lysator.liu.se>
+;; Thomas Bellman <bellman@lysator.liu.se>
+;; Toby Cubitt <toby-predictive@dr-qubit.org>
;; Maintainer: FSF
;; Created: 10 May 1991
-;; Keywords: extensions, data structures
+;; Keywords: extensions, data structures, AVL, tree
;; This file is part of GNU Emacs.
@@ -26,14 +27,24 @@
;;; Commentary:
-;; An AVL tree is a nearly-perfect balanced binary tree. A tree consists of
-;; two elements, the root node and the compare function. The actual tree
-;; has a dummy node as its root with the real root in the left pointer.
+;; An AVL tree is a self-balancing binary tree. As such, inserting,
+;; 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
+;; 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
+;; they are modified.
+;;
+;; Internally, a tree consists of two elements, the root node and the
+;; comparison function. The actual tree has a dummy node as its root
+;; with the real root in the left pointer, which allows the root node to
+;; be treated on a par with all other nodes.
;;
;; Each node of the tree consists of one data element, one left
-;; sub-tree and one right sub-tree. Each node also has a balance
-;; count, which is the difference in depth of the left and right
-;; sub-trees.
+;; sub-tree, one right sub-tree, and a balance count. The latter is the
+;; difference in depth of the left and right sub-trees.
;;
;; The functions with names of the form "avl-tree--" are intended for
;; internal use only.
@@ -42,43 +53,21 @@
(eval-when-compile (require 'cl))
-;; ================================================================
-;;; Functions and macros handling an AVL tree node.
-(defstruct (avl-tree--node
- ;; We force a representation without tag so it matches the
- ;; pre-defstruct representation. Also we use the underlying
- ;; representation in the implementation of avl-tree--node-branch.
- (:type vector)
- (:constructor nil)
- (:constructor avl-tree--node-create (left right data balance))
- (:copier nil))
- left right data balance)
-(defalias 'avl-tree--node-branch 'aref
- ;; This implementation is efficient but breaks the defstruct abstraction.
- ;; An alternative could be
- ;; (funcall (aref [avl-tree-left avl-tree-right avl-tree-data] branch) node)
- "Get value of a branch of a node.
+;; ================================================================
+;;; Internal functions and macros for use in the AVL tree package
-NODE is the node, and BRANCH is the branch.
-0 for left pointer, 1 for right pointer and 2 for the data.\"
-\(fn node branch)")
-;; The funcall/aref trick doesn't work for the setf method, unless we try
-;; and access the underlying setter function, but this wouldn't be
-;; portable either.
-(defsetf avl-tree--node-branch aset)
-
-;; ================================================================
-;;; Internal functions for use in the AVL tree package
+;; ----------------------------------------------------------------
+;; Functions and macros handling an AVL tree.
(defstruct (avl-tree-
;; A tagged list is the pre-defstruct representation.
;; (:type list)
:named
(:constructor nil)
- (:constructor avl-tree-create (cmpfun))
+ (:constructor avl-tree--create (cmpfun))
(:predicate avl-tree-p)
(:copier nil))
(dummyroot (avl-tree--node-create nil nil nil 0))
@@ -86,272 +75,304 @@ NODE is the node, and BRANCH is the branch.
(defmacro avl-tree--root (tree)
;; Return the root node for an avl-tree. INTERNAL USE ONLY.
- `(avl-tree--node-left (avl-tree--dummyroot tree)))
+ `(avl-tree--node-left (avl-tree--dummyroot ,tree)))
+
(defsetf avl-tree--root (tree) (node)
`(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
+
+
;; ----------------------------------------------------------------
-;; Deleting data
+;; Functions and macros handling an AVL tree node.
-(defun avl-tree--del-balance1 (node branch)
- ;; Rebalance a tree and return t if the height of the tree has shrunk.
- (let ((br (avl-tree--node-branch node branch))
- p1 b1 p2 b2 result)
- (cond
- ((< (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance br) 0)
- t)
+(defstruct (avl-tree--node
+ ;; We force a representation without tag so it matches the
+ ;; pre-defstruct representation. Also we use the underlying
+ ;; representation in the implementation of
+ ;; avl-tree--node-branch.
+ (:type vector)
+ (:constructor nil)
+ (:constructor avl-tree--node-create (left right data balance))
+ (:copier nil))
+ left right data balance)
- ((= (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance br) +1)
- nil)
- (t
- ;; Rebalance.
- (setq p1 (avl-tree--node-right br)
- b1 (avl-tree--node-balance p1))
- (if (>= b1 0)
- ;; Single RR rotation.
- (progn
- (setf (avl-tree--node-right br) (avl-tree--node-left p1))
- (setf (avl-tree--node-left p1) br)
- (if (= 0 b1)
- (progn
- (setf (avl-tree--node-balance br) +1)
- (setf (avl-tree--node-balance p1) -1)
- (setq result nil))
- (setf (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance p1) 0)
- (setq result t))
- (setf (avl-tree--node-branch node branch) p1)
- result)
-
- ;; Double RL rotation.
- (setq p2 (avl-tree--node-left p1)
- b2 (avl-tree--node-balance p2))
- (setf (avl-tree--node-left p1) (avl-tree--node-right p2))
- (setf (avl-tree--node-right p2) p1)
- (setf (avl-tree--node-right br) (avl-tree--node-left p2))
- (setf (avl-tree--node-left p2) br)
- (setf (avl-tree--node-balance br) (if (> b2 0) -1 0))
- (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0))
- (setf (avl-tree--node-branch node branch) p2)
- (setf (avl-tree--node-balance p2) 0)
- t)))))
+(defalias 'avl-tree--node-branch 'aref
+ ;; This implementation is efficient but breaks the defstruct
+ ;; abstraction. An alternative could be (funcall (aref [avl-tree-left
+ ;; avl-tree-right avl-tree-data] branch) node)
+ "Get value of a branch of a node.
+NODE is the node, and BRANCH is the branch.
+0 for left pointer, 1 for right pointer and 2 for the data.")
+
-(defun avl-tree--del-balance2 (node branch)
+;; The funcall/aref trick wouldn't work for the setf method, unless we
+;; tried to access the underlying setter function, but this wouldn't be
+;; portable either.
+(defsetf avl-tree--node-branch aset)
+
+
+
+;; ----------------------------------------------------------------
+;; Convenience macros
+
+(defmacro avl-tree--switch-dir (dir)
+ "Return opposite direction to DIR (0 = left, 1 = right)."
+ `(- 1 ,dir))
+
+(defmacro avl-tree--dir-to-sign (dir)
+ "Convert direction (0,1) to sign factor (-1,+1)."
+ `(1- (* 2 ,dir)))
+
+(defmacro avl-tree--sign-to-dir (dir)
+ "Convert sign factor (-x,+x) to direction (0,1)."
+ `(if (< ,dir 0) 0 1))
+
+
+;; ----------------------------------------------------------------
+;; Deleting data
+
+(defun avl-tree--del-balance (node branch dir)
+ "Rebalance a tree after deleting a node.
+The deletion was done from the left (DIR=0) or right (DIR=1) sub-tree of the
+left (BRANCH=0) or right (BRANCH=1) child of NODE.
+Return t if the height of the tree has shrunk."
+ ;; (or is it vice-versa for BRANCH?)
(let ((br (avl-tree--node-branch node branch))
- p1 b1 p2 b2 result)
+ ;; opposite direction: 0,1 -> 1,0
+ (opp (avl-tree--switch-dir dir))
+ ;; direction 0,1 -> sign factor -1,+1
+ (sgn (avl-tree--dir-to-sign dir))
+ p1 b1 p2 b2)
(cond
- ((> (avl-tree--node-balance br) 0)
+ ((> (* sgn (avl-tree--node-balance br)) 0)
(setf (avl-tree--node-balance br) 0)
t)
((= (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance br) -1)
+ (setf (avl-tree--node-balance br) (- sgn))
nil)
(t
;; Rebalance.
- (setq p1 (avl-tree--node-left br)
+ (setq p1 (avl-tree--node-branch br opp)
b1 (avl-tree--node-balance p1))
- (if (<= b1 0)
- ;; Single LL rotation.
+ (if (<= (* sgn b1) 0)
+ ;; Single rotation.
(progn
- (setf (avl-tree--node-left br) (avl-tree--node-right p1))
- (setf (avl-tree--node-right p1) br)
+ (setf (avl-tree--node-branch br opp)
+ (avl-tree--node-branch p1 dir)
+ (avl-tree--node-branch p1 dir) br
+ (avl-tree--node-branch node branch) p1)
(if (= 0 b1)
(progn
- (setf (avl-tree--node-balance br) -1)
- (setf (avl-tree--node-balance p1) +1)
- (setq result nil))
+ (setf (avl-tree--node-balance br) (- sgn)
+ (avl-tree--node-balance p1) sgn)
+ nil) ; height hasn't changed
(setf (avl-tree--node-balance br) 0)
(setf (avl-tree--node-balance p1) 0)
- (setq result t))
- (setf (avl-tree--node-branch node branch) p1)
- result)
-
- ;; Double LR rotation.
- (setq p2 (avl-tree--node-right p1)
- b2 (avl-tree--node-balance p2))
- (setf (avl-tree--node-right p1) (avl-tree--node-left p2))
- (setf (avl-tree--node-left p2) p1)
- (setf (avl-tree--node-left br) (avl-tree--node-right p2))
- (setf (avl-tree--node-right p2) br)
- (setf (avl-tree--node-balance br) (if (< b2 0) +1 0))
- (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0))
- (setf (avl-tree--node-branch node branch) p2)
- (setf (avl-tree--node-balance p2) 0)
+ t)) ; height has changed
+
+ ;; Double rotation.
+ (setf p2 (avl-tree--node-branch p1 dir)
+ b2 (avl-tree--node-balance p2)
+ (avl-tree--node-branch p1 dir)
+ (avl-tree--node-branch p2 opp)
+ (avl-tree--node-branch p2 opp) p1
+ (avl-tree--node-branch br opp)
+ (avl-tree--node-branch p2 dir)
+ (avl-tree--node-branch p2 dir) br
+ (avl-tree--node-balance br)
+ (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 p2) 0)
t)))))
(defun avl-tree--do-del-internal (node branch q)
(let ((br (avl-tree--node-branch node branch)))
(if (avl-tree--node-right br)
- (if (avl-tree--do-del-internal br +1 q)
- (avl-tree--del-balance2 node branch))
- (setf (avl-tree--node-data q) (avl-tree--node-data br))
- (setf (avl-tree--node-branch node branch)
- (avl-tree--node-left br))
+ (if (avl-tree--do-del-internal br 1 q)
+ (avl-tree--del-balance node branch 1))
+ (setf (avl-tree--node-data q) (avl-tree--node-data br)
+ (avl-tree--node-branch node branch)
+ (avl-tree--node-left br))
t)))
-(defun avl-tree--do-delete (cmpfun root branch data)
- ;; Return t if the height of the tree has shrunk.
+(defun avl-tree--do-delete (cmpfun root branch data test nilflag)
+ "Delete DATA from BRANCH of node ROOT.
+\(See `avl-tree-delete' for TEST and NILFLAG).
+
+Return cons cell (SHRUNK . DATA), where SHRUNK is t if the
+height of the tree has shrunk and nil otherwise, and DATA is
+the releted data."
(let ((br (avl-tree--node-branch root branch)))
(cond
+ ;; DATA not in tree.
((null br)
- nil)
+ (cons nil nilflag))
((funcall cmpfun data (avl-tree--node-data br))
- (if (avl-tree--do-delete cmpfun br 0 data)
- (avl-tree--del-balance1 root branch)))
+ (let ((ret (avl-tree--do-delete cmpfun br 0 data test nilflag)))
+ (cons (if (car ret) (avl-tree--del-balance root branch 0))
+ (cdr ret))))
((funcall cmpfun (avl-tree--node-data br) data)
- (if (avl-tree--do-delete cmpfun br 1 data)
- (avl-tree--del-balance2 root branch)))
-
- (t
- ;; Found it. Let's delete it.
- (cond
- ((null (avl-tree--node-right br))
- (setf (avl-tree--node-branch root branch) (avl-tree--node-left br))
- t)
+ (let ((ret (avl-tree--do-delete cmpfun br 1 data test nilflag)))
+ (cons (if (car ret) (avl-tree--del-balance root branch 1))
+ (cdr ret))))
+
+ (t ; Found it.
+ ;; if it fails TEST, do nothing
+ (if (and test (not (funcall test (avl-tree--node-data br))))
+ (cons nil nilflag)
+ (cond
+ ((null (avl-tree--node-right br))
+ (setf (avl-tree--node-branch root branch)
+ (avl-tree--node-left br))
+ (cons t (avl-tree--node-data br)))
+
+ ((null (avl-tree--node-left br))
+ (setf (avl-tree--node-branch root branch)
+ (avl-tree--node-right br))
+ (cons t (avl-tree--node-data br)))
+
+ (t
+ (if (avl-tree--do-del-internal br 0 br)
+ (cons (avl-tree--del-balance root branch 0)
+ (avl-tree--node-data br))
+ (cons nil (avl-tree--node-data br))))
+ ))))))
- ((null (avl-tree--node-left br))
- (setf (avl-tree--node-branch root branch) (avl-tree--node-right br))
- t)
- (t
- (if (avl-tree--do-del-internal br 0 br)
- (avl-tree--del-balance1 root branch))))))))
;; ----------------------------------------------------------------
;; Entering data
-(defun avl-tree--enter-balance1 (node branch)
- ;; Rebalance a tree and return t if the height of the tree has grown.
+(defun avl-tree--enter-balance (node branch dir)
+ "Rebalance tree after an insertion
+into the left (DIR=0) or right (DIR=1) sub-tree of the
+left (BRANCH=0) or right (BRANCH=1) child of NODE.
+Return t if the height of the tree has grown."
(let ((br (avl-tree--node-branch node branch))
+ ;; opposite direction: 0,1 -> 1,0
+ (opp (avl-tree--switch-dir dir))
+ ;; direction 0,1 -> sign factor -1,+1
+ (sgn (avl-tree--dir-to-sign dir))
p1 p2 b2 result)
(cond
- ((< (avl-tree--node-balance br) 0)
+ ((< (* sgn (avl-tree--node-balance br)) 0)
(setf (avl-tree--node-balance br) 0)
nil)
((= (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance br) +1)
+ (setf (avl-tree--node-balance br) sgn)
t)
(t
;; Tree has grown => Rebalance.
- (setq p1 (avl-tree--node-right br))
- (if (> (avl-tree--node-balance p1) 0)
- ;; Single RR rotation.
+ (setq p1 (avl-tree--node-branch br dir))
+ (if (> (* sgn (avl-tree--node-balance p1)) 0)
+ ;; Single rotation.
(progn
- (setf (avl-tree--node-right br) (avl-tree--node-left p1))
- (setf (avl-tree--node-left p1) br)
+ (setf (avl-tree--node-branch br dir)
+ (avl-tree--node-branch p1 opp))
+ (setf (avl-tree--node-branch p1 opp) br)
(setf (avl-tree--node-balance br) 0)
(setf (avl-tree--node-branch node branch) p1))
- ;; Double RL rotation.
- (setq p2 (avl-tree--node-left p1)
- b2 (avl-tree--node-balance p2))
- (setf (avl-tree--node-left p1) (avl-tree--node-right p2))
- (setf (avl-tree--node-right p2) p1)
- (setf (avl-tree--node-right br) (avl-tree--node-left p2))
- (setf (avl-tree--node-left p2) br)
- (setf (avl-tree--node-balance br) (if (> b2 0) -1 0))
- (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0))
- (setf (avl-tree--node-branch node branch) p2))
- (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0)
+ ;; Double rotation.
+ (setf p2 (avl-tree--node-branch p1 opp)
+ b2 (avl-tree--node-balance p2)
+ (avl-tree--node-branch p1 opp)
+ (avl-tree--node-branch p2 dir)
+ (avl-tree--node-branch p2 dir) p1
+ (avl-tree--node-branch br dir)
+ (avl-tree--node-branch p2 opp)
+ (avl-tree--node-branch p2 opp) br
+ (avl-tree--node-balance br)
+ (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))
nil))))
-(defun avl-tree--enter-balance2 (node branch)
- ;; Return t if the tree has grown.
- (let ((br (avl-tree--node-branch node branch))
- p1 p2 b2)
- (cond
- ((> (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance br) 0)
- nil)
-
- ((= (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-balance br) -1)
- t)
-
- (t
- ;; Balance was -1 => Rebalance.
- (setq p1 (avl-tree--node-left br))
- (if (< (avl-tree--node-balance p1) 0)
- ;; Single LL rotation.
- (progn
- (setf (avl-tree--node-left br) (avl-tree--node-right p1))
- (setf (avl-tree--node-right p1) br)
- (setf (avl-tree--node-balance br) 0)
- (setf (avl-tree--node-branch node branch) p1))
+(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
+ "Enter DATA in BRANCH of ROOT node.
+\(See `avl-tree-enter' for UPDATEFUN).
- ;; Double LR rotation.
- (setq p2 (avl-tree--node-right p1)
- b2 (avl-tree--node-balance p2))
- (setf (avl-tree--node-right p1) (avl-tree--node-left p2))
- (setf (avl-tree--node-left p2) p1)
- (setf (avl-tree--node-left br) (avl-tree--node-right p2))
- (setf (avl-tree--node-right p2) br)
- (setf (avl-tree--node-balance br) (if (< b2 0) +1 0))
- (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0))
- (setf (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)
- ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY.
+Return cons cell (GREW . DATA), where GREW is t if height
+of tree ROOT has grown and nil otherwise, and DATA is the
+inserted data."
(let ((br (avl-tree--node-branch root branch)))
(cond
((null br)
;; Data not in tree, insert it.
(setf (avl-tree--node-branch root branch)
(avl-tree--node-create nil nil data 0))
- t)
+ (cons t data))
((funcall cmpfun data (avl-tree--node-data br))
- (and (avl-tree--do-enter cmpfun br 0 data)
- (avl-tree--enter-balance2 root branch)))
+ (let ((ret (avl-tree--do-enter cmpfun br 0 data updatefun)))
+ (cons (and (car ret) (avl-tree--enter-balance root branch 0))
+ (cdr ret))))
((funcall cmpfun (avl-tree--node-data br) data)
- (and (avl-tree--do-enter cmpfun br 1 data)
- (avl-tree--enter-balance1 root branch)))
+ (let ((ret (avl-tree--do-enter cmpfun br 1 data updatefun)))
+ (cons (and (car ret) (avl-tree--enter-balance root branch 1))
+ (cdr ret))))
+ ;; Data already in tree, update it.
(t
- (setf (avl-tree--node-data br) data)
- nil))))
+ (let ((newdata
+ (if updatefun
+ (funcall updatefun data (avl-tree--node-data br))
+ data)))
+ (if (or (funcall cmpfun newdata data)
+ (funcall cmpfun data newdata))
+ (error "avl-tree-enter:\
+ updated data does not match existing data"))
+ (setf (avl-tree--node-data br) newdata)
+ (cons nil newdata)) ; return value
+ ))))
;; ----------------------------------------------------------------
-(defun avl-tree--mapc (map-function root)
- ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
- ;; The function is applied in-order.
- ;;
- ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
- ;; INTERNAL USE ONLY.
+
+;;; INTERNAL USE ONLY
+(defun avl-tree--mapc (map-function root dir)
+ "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
+The function is applied in-order, either ascending (DIR=0) or
+descending (DIR=1).
+
+Note: MAP-FUNCTION is applied to the node and not to the data
+itself."
(let ((node root)
(stack nil)
- (go-left t))
+ (go-dir t))
(push nil stack)
(while node
- (if (and go-left
- (avl-tree--node-left node))
- ;; Do the left subtree first.
+ (if (and go-dir
+ (avl-tree--node-branch node dir))
+ ;; Do the DIR subtree first.
(progn
(push node stack)
- (setq node (avl-tree--node-left node)))
+ (setq node (avl-tree--node-branch node dir)))
;; Apply the function...
(funcall map-function node)
- ;; and do the right subtree.
- (setq node (if (setq go-left (avl-tree--node-right node))
- (avl-tree--node-right node)
+ ;; and do the opposite subtree.
+ (setq node (if (setq go-dir (avl-tree--node-branch
+ node (avl-tree--switch-dir dir)))
+ (avl-tree--node-branch
+ node (avl-tree--switch-dir dir))
(pop stack)))))))
+;;; INTERNAL USE ONLY
(defun avl-tree--do-copy (root)
- ;; Copy the avl tree with ROOT as root.
- ;; Highly recursive. INTERNAL USE ONLY.
+ "Copy the avl tree with ROOT as root. Highly recursive."
(if (null root)
nil
(avl-tree--node-create
@@ -360,10 +381,40 @@ NODE is the node, and BRANCH is the branch.
(avl-tree--node-data root)
(avl-tree--node-balance root))))
-
+(defstruct (avl-tree--stack
+ (:constructor nil)
+ (:constructor avl-tree--stack-create
+ (tree &optional reverse
+ &aux
+ (store
+ (if (avl-tree-empty tree)
+ nil
+ (list (avl-tree--root tree))))))
+ (:copier nil))
+ reverse store)
+
+(defalias 'avl-tree-stack-p 'avl-tree--stack-p
+ "Return t if argument is an avl-tree-stack, nil otherwise.")
+
+(defun avl-tree--stack-repopulate (stack)
+ ;; Recursively push children of the node at the head of STACK onto the
+ ;; front of the STACK, until a leaf is reached.
+ (let ((node (car (avl-tree--stack-store stack)))
+ (dir (if (avl-tree--stack-reverse stack) 1 0)))
+ (when node ; check for emtpy stack
+ (while (setq node (avl-tree--node-branch node dir))
+ (push node (avl-tree--stack-store stack))))))
+
+
;; ================================================================
;;; The public functions which operate on AVL trees.
+;; define public alias for constructors so that we can set docstring
+(defalias 'avl-tree-create 'avl-tree--create
+ "Create an empty avl tree.
+COMPARE-FUNCTION is a function which takes two arguments, A and B,
+and returns non-nil if A is less than B, and nil otherwise.")
+
(defalias 'avl-tree-compare-function 'avl-tree--cmpfun
"Return the comparison function for the avl tree TREE.
@@ -373,53 +424,142 @@ NODE is the node, and BRANCH is the branch.
"Return t if avl tree TREE is emtpy, otherwise return nil."
(null (avl-tree--root tree)))
-(defun avl-tree-enter (tree data)
- "In the avl tree TREE insert DATA.
-Return DATA."
- (avl-tree--do-enter (avl-tree--cmpfun tree)
- (avl-tree--dummyroot tree)
- 0
- data)
- data)
-
-(defun avl-tree-delete (tree data)
- "From the avl tree TREE, delete DATA.
-Return the element in TREE which matched DATA,
-nil if no element matched."
- (avl-tree--do-delete (avl-tree--cmpfun tree)
- (avl-tree--dummyroot tree)
- 0
- data))
-
-(defun avl-tree-member (tree data)
+(defun avl-tree-enter (tree data &optional updatefun)
+ "Insert DATA into the avl tree TREE.
+
+If an element that matches DATA (according to the tree's
+comparison function, see `avl-tree-create') already exists in
+TREE, it will be replaced by DATA by default.
+
+If UPDATEFUN is supplied and an element matching DATA already
+exists in TREE, UPDATEFUN is called with two arguments: DATA, and
+the matching element. Its return value replaces the existing
+element. This value *must* itself match DATA (and hence the
+pre-existing data), or an error will occur.
+
+Returns the new data."
+ (cdr (avl-tree--do-enter (avl-tree--cmpfun tree)
+ (avl-tree--dummyroot tree)
+ 0 data updatefun)))
+
+(defun avl-tree-delete (tree data &optional test nilflag)
+ "Delete the element matching DATA from the avl tree TREE.
+Matching uses the comparison function previously specified in
+`avl-tree-create' when TREE was created.
+
+Returns the deleted element, or nil if no matching element was
+found.
+
+Optional argument NILFLAG specifies a value to return instead of
+nil if nothing was deleted, so that this case can be
+distinguished from the case of a successfully deleted null
+element.
+
+If supplied, TEST specifies a test that a matching element must
+pass before it is deleted. If a matching element is found, it is
+passed as an argument to TEST, and is deleted only if the return
+value is non-nil."
+ (cdr (avl-tree--do-delete (avl-tree--cmpfun tree)
+ (avl-tree--dummyroot tree)
+ 0 data test nilflag)))
+
+
+(defun avl-tree-member (tree data &optional nilflag)
"Return the element in the avl tree TREE which matches DATA.
-Matching uses the compare function previously specified in
+Matching uses the comparison function previously specified in
`avl-tree-create' when TREE was created.
-If there is no such element in the tree, the value is nil."
+If there is no such element in the tree, nil is
+returned. Optional argument NILFLAG specifies a value to return
+instead of nil in this case. This allows non-existent elements to
+be distinguished from a null element. (See also
+`avl-tree-member-p', which does this for you.)"
(let ((node (avl-tree--root tree))
- (compare-function (avl-tree--cmpfun tree))
- found)
- (while (and node
- (not found))
- (cond
- ((funcall compare-function data (avl-tree--node-data node))
- (setq node (avl-tree--node-left node)))
- ((funcall compare-function (avl-tree--node-data node) data)
- (setq node (avl-tree--node-right node)))
- (t
- (setq found t))))
- (if node
- (avl-tree--node-data node)
- nil)))
-
-(defun avl-tree-map (__map-function__ tree)
- "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE."
+ (compare-function (avl-tree--cmpfun tree)))
+ (catch 'found
+ (while node
+ (cond
+ ((funcall compare-function data (avl-tree--node-data node))
+ (setq node (avl-tree--node-left node)))
+ ((funcall compare-function (avl-tree--node-data node) data)
+ (setq node (avl-tree--node-right node)))
+ (t (throw 'found (avl-tree--node-data node)))))
+ nilflag)))
+
+
+(defun avl-tree-member-p (tree data)
+ "Return t if an element matching DATA exists in the avl tree TREE,
+otherwise return nil. Matching uses the comparison function
+previously specified in `avl-tree-create' when TREE was created."
+ (let ((flag '(nil)))
+ (not (eq (avl-tree-member tree data flag) flag))))
+
+
+(defun avl-tree-map (__map-function__ tree &optional reverse)
+ "Modify all elements in the avl tree TREE by applying FUNCTION.
+
+Each element is replaced by the return value of FUNCTION applied
+to that element.
+
+FUNCTION is applied to the elements in ascending order, or
+descending order if REVERSE is non-nil."
(avl-tree--mapc
(lambda (node)
(setf (avl-tree--node-data node)
(funcall __map-function__ (avl-tree--node-data node))))
- (avl-tree--root tree)))
+ (avl-tree--root tree)
+ (if reverse 1 0)))
+
+
+(defun avl-tree-mapc (__map-function__ tree &optional reverse)
+ "Apply FUNCTION to all elements in avl tree TREE,
+for side-effect only.
+
+FUNCTION is applied to the elements in ascending order, or
+descending order if REVERSE is non-nil."
+ (avl-tree--mapc
+ (lambda (node)
+ (funcall __map-function__ (avl-tree--node-data node)))
+ (avl-tree--root tree)
+ (if reverse 1 0)))
+
+
+(defun avl-tree-mapf
+ (__map-function__ combinator tree &optional reverse)
+ "Apply FUNCTION to all elements in avl tree TREE,
+and combine the results using COMBINATOR.
+
+The FUNCTION is applied and the results are combined in ascending
+order, or descending order if REVERSE is non-nil."
+ (let (avl-tree-mapf--accumulate)
+ (avl-tree--mapc
+ (lambda (node)
+ (setq avl-tree-mapf--accumulate
+ (funcall combinator
+ (funcall __map-function__
+ (avl-tree--node-data node))
+ avl-tree-mapf--accumulate)))
+ (avl-tree--root tree)
+ (if reverse 0 1))
+ (nreverse avl-tree-mapf--accumulate)))
+
+
+(defun avl-tree-mapcar (__map-function__ tree &optional reverse)
+ "Apply FUNCTION to all elements in avl tree TREE,
+and make a list of the results.
+
+The FUNCTION is applied and the list constructed in ascending
+order, or descending order if REVERSE is non-nil.
+
+Note that if you don't care about the order in which FUNCTION is
+applied, just that the resulting list is in the correct order,
+then
+
+ (avl-tree-mapf function 'cons tree (not reverse))
+
+is more efficient."
+ (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse)))
+
(defun avl-tree-first (tree)
"Return the first element in TREE, or nil if TREE is empty."
@@ -445,25 +585,83 @@ If there is no such element in the tree, the value is nil."
(defun avl-tree-flatten (tree)
"Return a sorted list containing all elements of TREE."
- (nreverse
(let ((treelist nil))
(avl-tree--mapc
(lambda (node) (push (avl-tree--node-data node) treelist))
- (avl-tree--root tree))
- treelist)))
+ (avl-tree--root tree) 1)
+ treelist))
(defun avl-tree-size (tree)
"Return the number of elements in TREE."
(let ((treesize 0))
(avl-tree--mapc
(lambda (data) (setq treesize (1+ treesize)))
- (avl-tree--root tree))
+ (avl-tree--root tree) 0)
treesize))
(defun avl-tree-clear (tree)
"Clear the avl tree TREE."
(setf (avl-tree--root tree) nil))
+
+(defun avl-tree-stack (tree &optional reverse)
+ "Return an object that behaves like a sorted stack
+of all elements of TREE.
+
+If REVERSE is non-nil, the stack is sorted in reverse order.
+\(See also `avl-tree-stack-pop'\).
+
+Note that any modification to TREE *immediately* invalidates all
+avl-tree-stacks created before the modification (in particular,
+calling `avl-tree-stack-pop' will give unpredictable results).
+
+Operations on these objects are significantly more efficient than
+constructing a real stack with `avl-tree-flatten' and using
+standard stack functions. As such, they can be useful in
+implementing efficient algorithms of AVL trees. However, in cases
+where mapping functions `avl-tree-mapc', `avl-tree-mapcar' or
+`avl-tree-mapf' would be sufficient, it is better to use one of
+those instead."
+ (let ((stack (avl-tree--stack-create tree reverse)))
+ (avl-tree--stack-repopulate stack)
+ stack))
+
+
+(defun avl-tree-stack-pop (avl-tree-stack &optional nilflag)
+ "Pop the first element from AVL-TREE-STACK.
+\(See also `avl-tree-stack'\).
+
+Returns nil if the stack is empty, or NILFLAG if specified. (The
+latter allows an empty stack to be distinguished from a null
+element stored in the AVL tree.)"
+ (let (node next)
+ (if (not (setq node (pop (avl-tree--stack-store avl-tree-stack))))
+ nilflag
+ (when (setq next
+ (avl-tree--node-branch
+ node
+ (if (avl-tree--stack-reverse avl-tree-stack) 0 1)))
+ (push next (avl-tree--stack-store avl-tree-stack))
+ (avl-tree--stack-repopulate avl-tree-stack))
+ (avl-tree--node-data node))))
+
+
+(defun avl-tree-stack-first (avl-tree-stack &optional nilflag)
+ "Return the first element of AVL-TREE-STACK, without removing it
+from the stack.
+
+Returns nil if the stack is empty, or NILFLAG if specified. (The
+latter allows an empty stack to be distinguished from a null
+element stored in the AVL tree.)"
+ (or (car (avl-tree--stack-store avl-tree-stack))
+ nilflag))
+
+
+(defun avl-tree-stack-empty-p (avl-tree-stack)
+ "Return t if AVL-TREE-STACK is empty, nil otherwise."
+ (null (avl-tree--stack-store avl-tree-stack)))
+
+
(provide 'avl-tree)
;;; avl-tree.el ends here
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 86063c512c6..aa84a075b76 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -39,9 +39,8 @@
(setq ,t1 (current-time))
,@forms
(setq ,t2 (current-time))
- (+ (* (- (car ,t2) (car ,t1)) 65536.0)
- (- (nth 1 ,t2) (nth 1 ,t1))
- (* (- (nth 2 ,t2) (nth 2 ,t1)) 1.0e-6)))))
+ (float-time (time-subtract ,t2 ,t1)))))
+
(put 'benchmark-elapse 'edebug-form-spec t)
(put 'benchmark-elapse 'lisp-indent-function 0)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 3fb3d841ed1..f79add14836 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -72,7 +72,7 @@ The return value of this function is not used."
;; "Cause the named functions to be open-coded when called from compiled code.
;; They will only be compiled open-coded when byte-compile-optimize is true."
;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
+;; (mapcar (lambda (x)
;; (or (memq (get x 'byte-optimizer)
;; '(nil byte-compile-inline-expand))
;; (error
@@ -85,7 +85,7 @@ The return value of this function is not used."
;; (defmacro proclaim-notinline (&rest fns)
;; "Cause the named functions to no longer be open-coded."
;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
+;; (mapcar (lambda (x)
;; (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand)
;; (put x 'byte-optimizer nil))
;; (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer)
@@ -120,13 +120,13 @@ convention was modified."
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).
-If provided, WHEN should be a string indicating when the function
+WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
(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.
- (list (purecopy current-name) nil (purecopy when)))
+ (purecopy (list current-name nil when)))
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
@@ -153,27 +153,21 @@ See the docstrings of `defalias' and `make-obsolete' for more details."
'define-obsolete-function-alias
'(obsolete-name current-name when &optional docstring) "23.1")
-(defun make-obsolete-variable (obsolete-name current-name &optional when)
+(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
-If provided, WHEN should be a string indicating when the variable
-was first made obsolete, for example a date or a release number."
- (interactive
- (list
- (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
- (if (equal str "") (error ""))
- (intern str))
- (car (read-from-string (read-string "Obsoletion replacement: ")))))
+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'."
(put obsolete-name 'byte-obsolete-variable
- (cons
- (if (stringp current-name)
- (purecopy current-name)
- current-name) (purecopy when)))
+ (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) "23.1")
+ '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)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 6ca8eed8ac6..127f93c6858 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1109,7 +1109,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let* ((funcp (get symbol 'byte-obsolete-info))
(obsolete (or funcp (get symbol 'byte-obsolete-variable)))
(instead (car obsolete))
- (asof (if funcp (nth 2 obsolete) (cdr obsolete))))
+ (asof (nth 2 obsolete)))
(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")
@@ -1314,7 +1314,14 @@ extra args."
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
(let* ((name (nth 1 form))
- (old (byte-compile-fdefinition name macrop)))
+ (old (byte-compile-fdefinition name macrop))
+ (initial (and macrop
+ (cdr (assq name
+ byte-compile-initial-macro-environment)))))
+ ;; Assumes an element of b-c-i-macro-env that is a symbol points
+ ;; to a defined function. (Bug#8646)
+ (and initial (symbolp initial)
+ (setq old (byte-compile-fdefinition initial nil)))
(if (and old (not (eq old t)))
(progn
(and (eq 'macro (car-safe old))
@@ -2414,7 +2421,11 @@ by side-effects."
(let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
(if this-one
- (setcdr this-one code)
+ ;; 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))))
@@ -2881,8 +2892,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
That command is designed for interactive use only" fn))
(if (and (fboundp (car form))
(eq (car-safe (symbol-function (car form))) 'macro))
- (byte-compile-report-error
- (format "Forgot to expand macro %s" (car form))))
+ (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
@@ -2980,7 +2991,7 @@ That command is designed for interactive use only" fn))
(cond
((<= (+ alen alen) fmax2)
;; Add missing &optional (or &rest) arguments.
- (dotimes (i (- (/ (1+ fmax2) 2) alen))
+ (dotimes (_ (- (/ (1+ fmax2) 2) alen))
(byte-compile-push-constant nil)))
((zerop (logand fmax2 1))
(byte-compile-log-warning "Too many arguments for inlined function"
@@ -3005,20 +3016,24 @@ That command is designed for interactive use only" fn))
(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 &optional binding)
- "Do various error checks before a use of the variable VAR.
-If BINDING is non-nil, VAR is being bound."
+(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))
(when (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn (if binding
+ (byte-compile-warn (if (eq access-type 'let-bind)
"attempt to let-bind %s `%s`"
"variable reference to %s `%s'")
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))))
- ((and (get var 'byte-obsolete-variable)
- (not (memq var byte-compile-not-obsolete-vars)))
+ ((let ((od (get var 'byte-obsolete-variable)))
+ (and od
+ (not (memq var byte-compile-not-obsolete-vars))
+ (or (case (nth 1 od)
+ (set (not (eq access-type 'reference)))
+ (get (eq access-type 'reference))
+ (t t)))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
@@ -3030,13 +3045,13 @@ If BINDING is non-nil, VAR is being bound."
(defun byte-compile-dynamic-variable-bind (var)
"Generate code to bind the lexical variable VAR to the top-of-stack value."
- (byte-compile-check-variable var t)
+ (byte-compile-check-variable var 'let-bind)
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
(defun byte-compile-variable-ref (var)
"Generate code to push the value of the variable VAR on the stack."
- (byte-compile-check-variable var)
+ (byte-compile-check-variable var 'reference)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
@@ -3052,7 +3067,7 @@ If BINDING is non-nil, VAR is being bound."
(defun byte-compile-variable-set (var)
"Generate code to set the variable VAR from the top-of-stack value."
- (byte-compile-check-variable var)
+ (byte-compile-check-variable var 'assign)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
@@ -3514,9 +3529,9 @@ discarding."
;; and (funcall (function foo)) will lose with autoloads.
(defun byte-compile-function-form (form)
- (byte-compile-constant (if (symbolp (nth 1 form))
- (nth 1 form)
- (byte-compile-lambda (nth 1 form)))))
+ (byte-compile-constant (if (eq 'lambda (car-safe (nth 1 form)))
+ (byte-compile-lambda (nth 1 form))
+ (nth 1 form))))
(defun byte-compile-indent-to (form)
(let ((len (length form)))
@@ -4144,6 +4159,8 @@ binding slots have been popped."
(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.
@@ -4227,6 +4244,25 @@ binding slots have been popped."
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
+(byte-defop-compiler-1 add-to-list byte-compile-add-to-list)
+(defun byte-compile-add-to-list (form)
+ ;; FIXME: This could be used for `set' as well, except that it's got
+ ;; its own opcode, so the final `byte-compile-normal-call' needs to
+ ;; be replaced with something else.
+ (pcase form
+ (`(,fun ',var . ,_)
+ (byte-compile-check-variable var 'assign)
+ (if (assq var byte-compile--lexical-environment)
+ (byte-compile-log-warning
+ (format "%s cannot use lexical var `%s'" fun var)
+ nil :error)
+ (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+ (boundp var)
+ (memq var byte-compile-bound-variables)
+ (memq var byte-compile-free-references))
+ (byte-compile-warn "assignment to free variable `%S'" var)
+ (push var byte-compile-free-references)))))
+ (byte-compile-normal-call form))
;;; tags
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 38584c437b8..742a98f5e7b 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -112,16 +112,6 @@
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
;; binders)))
-;; (defmacro letrec (binders &rest body)
-;; ;; Only useful in lexical-binding mode.
-;; ;; As a special-form, we could implement it more efficiently (and cleanly,
-;; ;; making the vars actually unbound during evaluation of the binders).
-;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
-;; binders)
-;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder)))
-;; binders))
-;; ,@body))
-
(eval-when-compile (require 'cl))
(defconst cconv-liftwhen 6
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 01eb1efdc3b..56930a74693 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -639,7 +639,7 @@ SORT-PRED if desired."
extlst "File Extensions"
cntlst "# of occurrences"
10
- '(lambda (a b) (> (cdr a) (cdr b))))
+ (lambda (a b) (> (cdr a) (cdr b))))
))
(defun chart-space-usage (d)
@@ -669,7 +669,7 @@ SORT-PRED if desired."
nmlst "File Name"
cntlst "File Size"
10
- '(lambda (a b) (> (cdr a) (cdr b))))
+ (lambda (a b) (> (cdr a) (cdr b))))
))
(defun chart-emacs-storage ()
@@ -737,7 +737,7 @@ SORT-PRED if desired."
nmlst "User Names"
cntlst "# of occurrences"
10
- '(lambda (a b) (> (cdr a) (cdr b))))
+ (lambda (a b) (> (cdr a) (cdr b))))
))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 9880e2918b0..7eb6e6ef765 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -38,8 +38,7 @@
;; or [menu-bar emacs-lisp eval-buffer]. Additional key-bindings
;; are also provided under C-c ? KEY
;; (require 'checkdoc)
-;; (add-hook 'emacs-lisp-mode-hook
-;; '(lambda () (checkdoc-minor-mode 1)))
+;; (add-hook 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
;;
;; Using `checkdoc':
;;
@@ -2046,7 +2045,7 @@ If the offending word is in a piece of quoted text, then it is skipped."
;; piece of an abbreviation
;; FIXME etc
(looking-at
- "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
+ "\\([a-zA-Z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
(error t))))
(if (checkdoc-autofix-ask-replace
b e
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 787f276ecae..40434636e62 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -31,22 +31,10 @@
;;
;; (setq lisp-indent-function 'common-lisp-indent-function)
-;;>> TODO
-;; :foo
-;; bar
-;; :baz
-;; zap
-;; &key (like &body)??
-
-;; &rest 1 in lambda-lists doesn't work
-;; -- really want (foo bar
-;; baz)
-;; not (foo bar
-;; baz)
-;; Need something better than &rest for such cases
-
;;; Code:
+(eval-when-compile (require 'cl))
+
(defgroup lisp-indent nil
"Indentation in Lisp."
:group 'lisp)
@@ -101,9 +89,55 @@ If nil, indent backquoted lists as data, i.e., like quoted lists."
:type 'integer
:group 'lisp-indent)
+(defcustom lisp-lambda-list-keyword-alignment nil
+ "Whether to vertically align lambda-list keywords together.
+If nil (the default), keyworded lambda-list parts are aligned
+with the initial mandatory arguments, like this:
+
+\(defun foo (arg1 arg2 &rest rest
+ &key key1 key2)
+ #|...|#)
+
+If non-nil, alignment is done with the first keyword
+\(or falls back to the previous case), as in:
+
+\(defun foo (arg1 arg2 &rest rest
+ &key key1 key2)
+ #|...|#)"
+ :type 'boolean
+ :group 'lisp-indent)
+
+(defcustom lisp-lambda-list-keyword-parameter-indentation 2
+ "Indentation of lambda list keyword parameters.
+See `lisp-lambda-list-keyword-parameter-alignment'
+for more information."
+ :type 'integer
+ :group 'lisp-indent)
+
+(defcustom lisp-lambda-list-keyword-parameter-alignment nil
+ "Whether to vertically align lambda-list keyword parameters together.
+If nil (the default), the parameters are aligned
+with their corresponding keyword, plus the value of
+`lisp-lambda-list-keyword-parameter-indentation', like this:
+
+\(defun foo (arg1 arg2 &key key1 key2
+ key3 key4)
+ #|...|#)
+
+If non-nil, alignment is done with the first parameter
+\(or falls back to the previous case), as in:
+
+\(defun foo (arg1 arg2 &key key1 key2
+ key3 key4)
+ #|...|#)"
+ :type 'boolean
+ :group 'lisp-indent)
+
(defvar lisp-indent-defun-method '(4 &lambda &body)
- "Indentation for function with `common-lisp-indent-function' property `defun'.")
+ "Defun-like indentation method.
+This applies when the value of the `common-lisp-indent-function' property
+is set to `defun'.")
(defun extended-loop-p (loop-start)
@@ -144,7 +178,7 @@ indentation function is called, and STATE is the
of this function.
If the indentation point is in a call to a Lisp function, that
-function's common-lisp-indent-function property specifies how
+function's `common-lisp-indent-function' property specifies how
this function should indent it. Possible values for this
property are:
@@ -217,8 +251,7 @@ For example, the function `case' has an indent property
(let ((depth 0)
;; Path describes the position of point in terms of
;; list-structure with respect to containing lists.
- ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)'
- ;; (Surely (0 3 1)?).
+ ;; `foo' has a path of (0 3 1) in `((a b c (d foo) f) g)'.
(path ())
;; set non-nil when somebody works out the indentation to use
calculated
@@ -381,10 +414,74 @@ For example, the function `case' has an indent property
;; Love those free variable references!!
lisp-indent-error-function 'common-lisp-indent-function m))
+
+;; Lambda-list indentation is now done in LISP-INDENT-LAMBDA-LIST.
+;; See also `lisp-lambda-list-keyword-alignment',
+;; `lisp-lambda-list-keyword-parameter-alignment' and
+;; `lisp-lambda-list-keyword-parameter-indentation' -- dvl
+
+(defvar lisp-indent-lambda-list-keywords-regexp
+ "&\\(\
+optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\
+\\)\\([ \t]\\|$\\)"
+ "Regular expression matching lambda-list keywords.")
+
+(defun lisp-indent-lambda-list
+ (indent-point sexp-column containing-form-start)
+ (let (limit)
+ (cond ((save-excursion
+ (goto-char indent-point)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (setq limit (point))
+ (looking-at lisp-indent-lambda-list-keywords-regexp))
+ ;; We're facing a lambda-list keyword.
+ (if lisp-lambda-list-keyword-alignment
+ ;; Align to the first keyword if any, or to the beginning of
+ ;; the lambda-list.
+ (save-excursion
+ (goto-char containing-form-start)
+ (save-match-data
+ (if (re-search-forward
+ lisp-indent-lambda-list-keywords-regexp
+ limit t)
+ (progn
+ (goto-char (match-beginning 0))
+ (current-column))
+ (1+ sexp-column))))
+ ;; Align to the beginning of the lambda-list.
+ (1+ sexp-column)))
+ (t
+ ;; Otherwise, align to the first argument of the last lambda-list
+ ;; keyword, the keyword itself, or the beginning of the
+ ;; lambda-list.
+ (save-excursion
+ (goto-char indent-point)
+ (forward-line -1)
+ (end-of-line)
+ (save-match-data
+ (if (re-search-backward lisp-indent-lambda-list-keywords-regexp
+ containing-form-start t)
+ (let* ((keyword-posn
+ (progn
+ (goto-char (match-beginning 0))
+ (current-column)))
+ (indented-keyword-posn
+ (+ keyword-posn
+ lisp-lambda-list-keyword-parameter-indentation)))
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (if (eolp)
+ indented-keyword-posn
+ (if lisp-lambda-list-keyword-parameter-alignment
+ (current-column)
+ indented-keyword-posn)))
+ (1+ sexp-column))))))))
+
;; Blame the crufty control structure on dynamic scoping
;; -- not on me!
-(defun lisp-indent-259 (method path state indent-point
- sexp-column normal-indent)
+(defun lisp-indent-259
+ (method path state indent-point sexp-column normal-indent)
(catch 'exit
(let ((p path)
(containing-form-start (elt state 1))
@@ -452,8 +549,14 @@ For example, the function `case' has an indent property
(cond ((null p)
(list (+ sexp-column 4) containing-form-start))
((null (cdr p))
- (+ sexp-column 1))
- (t normal-indent))))
+ ;; Indentation within a lambda-list. -- dvl
+ (list (lisp-indent-lambda-list
+ indent-point
+ sexp-column
+ containing-form-start)
+ containing-form-start))
+ (t
+ normal-indent))))
((integerp tem)
(throw 'exit
(if (null p) ;not in subforms
@@ -523,19 +626,26 @@ For example, the function `case' has an indent property
path state indent-point sexp-column normal-indent)))
-(defun lisp-indent-defmethod (path state indent-point sexp-column
- normal-indent)
- "Indentation function defmethod."
- (lisp-indent-259 (if (and (>= (car path) 3)
- (null (cdr path))
- (save-excursion (goto-char (elt state 1))
- (forward-char 1)
- (forward-sexp 3)
- (backward-sexp)
- (looking-at ":\\|\\sw+")))
- '(4 4 (&whole 4 &rest 4) &body)
- (get 'defun 'common-lisp-indent-function))
- path state indent-point sexp-column normal-indent))
+;; LISP-INDENT-DEFMETHOD now supports the presence of more than one method
+;; qualifier and indents the method's lambda list properly. -- dvl
+(defun lisp-indent-defmethod
+ (path state indent-point sexp-column normal-indent)
+ (lisp-indent-259
+ (let ((nqual 0))
+ (if (and (>= (car path) 3)
+ (save-excursion
+ (beginning-of-defun)
+ (forward-char 1)
+ (forward-sexp 2)
+ (skip-chars-forward " \t\n")
+ (while (looking-at "\\sw\\|\\s_")
+ (incf nqual)
+ (forward-sexp)
+ (skip-chars-forward " \t\n"))
+ (> nqual 0)))
+ (append '(4) (make-list nqual 4) '(&lambda &body))
+ (get 'defun 'common-lisp-indent-function)))
+ path state indent-point sexp-column normal-indent))
(defun lisp-indent-function-lambda-hack (path state indent-point
@@ -577,6 +687,7 @@ For example, the function `case' has an indent property
(define-modify-macro (4 &lambda &body))
(defsetf (4 &lambda 4 &body))
(defun (4 &lambda &body))
+ (defgeneric (4 &lambda &body))
(define-setf-method . defun)
(define-setf-expander . defun)
(defmacro . defun)
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 4c824d4a6d4..48c7386bd43 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -282,7 +282,7 @@ Not documented
;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
;;;;;; do* do loop return-from return block etypecase typecase ecase
;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fe8a5acbe14e32846a77578b2165fab5")
+;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "9f551dc739a39b3c8b420fbd1ab71879")
;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9ce3dd6a7fe..2813cc4f065 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1236,14 +1236,29 @@ Then evaluate RESULT to get return value, default nil.
\(fn (VAR LIST [RESULT]) BODY...)"
(let ((temp (make-symbol "--cl-dolist-temp--")))
- (list 'block nil
- (list* 'let (list (list temp (nth 1 spec)) (car spec))
- (list* 'while temp (list 'setq (car spec) (list 'car temp))
- (append body (list (list 'setq temp
- (list 'cdr temp)))))
- (if (cdr (cdr spec))
- (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
- '(nil))))))
+ ;; 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))))))))
;;;###autoload
(defmacro dotimes (spec &rest body)
@@ -1253,12 +1268,30 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
- (let ((temp (make-symbol "--cl-dotimes-temp--")))
- (list 'block nil
- (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
- (list* 'while (list '< (car spec) temp)
- (append body (list (list 'incf (car spec)))))
- (or (cdr (cdr spec)) '(nil))))))
+ (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)))))))
;;;###autoload
(defmacro do-symbols (spec &rest body)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 88633eaaa46..2fa339e62fe 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -118,6 +118,10 @@ first will be printed into the backtrace buffer."
(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-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
(debugger-step-after-exit nil)
@@ -214,8 +218,6 @@ first will be printed into the backtrace buffer."
;; 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
- (erase-buffer)
- (fundamental-mode)
(with-selected-window (get-buffer-window debugger-buffer 0)
(when (and (window-dedicated-p (selected-window))
(not debugger-will-be-back))
@@ -232,7 +234,18 @@ first will be printed into the backtrace buffer."
;; to be left at the top-level, still working on how
;; best to do that.
(bury-buffer))))
- (kill-buffer debugger-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))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 1db98ac39c8..4fda2bf1d52 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -253,8 +253,14 @@ No problems result if this variable is not bound.
`(let ((parent (char-table-parent ,syntax)))
(unless (and parent
(not (eq parent (standard-syntax-table))))
- (set-char-table-parent ,syntax (syntax-table)))))))
-
+ (set-char-table-parent ,syntax (syntax-table)))))
+ ,(when declare-abbrev
+ `(unless (or (abbrev-table-get ,abbrev :parents)
+ ;; This can happen if the major mode defines
+ ;; the abbrev-table to be its parent's.
+ (eq ,abbrev local-abbrev-table))
+ (abbrev-table-put ,abbrev :parents
+ (list local-abbrev-table))))))
(use-local-map ,map)
,(when syntax `(set-syntax-table ,syntax))
,(when abbrev `(setq local-abbrev-table ,abbrev))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 4fd10185c17..2a41e611dc0 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -251,10 +251,10 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
((eq (car-safe (car-safe arg)) 'byte-code)
(insert "(<byte code>...)\n")
(mapc ;recurse on list of byte-code objects
- '(lambda (obj)
- (disassemble-1
- obj
- (+ indent disassemble-recursive-indent)))
+ (lambda (obj)
+ (disassemble-1
+ obj
+ (+ indent disassemble-recursive-indent)))
arg))
(t
;; really just a constant
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 6abf9aa3657..83c09b6fe0f 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1226,29 +1226,28 @@ IMPL is the symbol holding the method implementation."
(if (not (eieio-object-p (car local-args)))
;; Not an object. Just signal.
(signal 'no-method-definition
- (list ,(list 'quote method) local-args))
+ (list ',method local-args))
;; We do have an object. Make sure it is the right type.
(if ,(if (eq class eieio-default-superclass)
- nil ; default superclass means just an obj. Already asked.
+ nil ; default superclass means just an obj. Already asked.
`(not (child-of-class-p (aref (car local-args) object-class)
- ,(list 'quote class)))
- )
+ ',class)))
;; If not the right kind of object, call no applicable
(apply 'no-applicable-method (car local-args)
- ,(list 'quote method) local-args)
+ ',method local-args)
;; It is ok, do the call.
;; Fill in inter-call variables then evaluate the method.
- (let ((scoped-class ,(list 'quote class))
+ (let ((scoped-class ',class)
(eieio-generic-call-next-method-list nil)
(eieio-generic-call-key method-primary)
- (eieio-generic-call-methodname ,(list 'quote method))
+ (eieio-generic-call-methodname ',method)
(eieio-generic-call-arglst local-args)
)
- (apply ,(list 'quote impl) local-args)
- ;(,impl local-args)
+ (apply #',impl local-args)
+ ;;(,impl local-args)
)))))))
(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
@@ -1308,7 +1307,7 @@ Summary:
(defgeneric ,method ,args
,(or (documentation code)
(format "Generically created method `%s'." method)))
- (eieio--defmethod ',method ',key ',class ',code))))
+ (eieio--defmethod ',method ',key ',class #',code))))
(defun eieio--defmethod (method kind argclass code)
"Work part of the `defmethod' macro defining METHOD with ARGS."
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 73af3a5708f..b89b6decfc9 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -282,7 +282,7 @@ FUNSYM must be a symbol of a defined function."
;; the function so that non-local exists are still recorded. TBD:
;; I haven't tested non-local exits at all, so no guarantees.
;;
- ;; The 1st element is the total amount of time in usecs that have
+ ;; 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.
;;
@@ -424,9 +424,7 @@ Use optional LIST if provided instead."
(defsubst elp-elapsed-time (start end)
- (+ (* (- (car end) (car start)) 65536.0)
- (- (car (cdr end)) (car (cdr start)))
- (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
+ (float-time (time-subtract end start)))
(defun elp-wrapper (funsym interactive-p args)
"This function has been instrumented for profiling by the ELP.
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9c4a3e9832c..0194af2e3a8 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -141,6 +141,15 @@ See the functions `find-function' and `find-variable'."
(dolist (suffix (get-load-suffixes) (nreverse suffixes))
(unless (string-match "elc" suffix) (push suffix suffixes)))))
+(defun find-library--load-name (library)
+ (let ((name library))
+ (dolist (dir load-path)
+ (let ((rel (file-relative-name library dir)))
+ (if (and (not (string-match "\\`\\.\\./" rel))
+ (< (length rel) (length name)))
+ (setq name rel))))
+ (unless (equal name library) name)))
+
(defun find-library-name (library)
"Return the absolute file name of the Emacs Lisp source of LIBRARY.
LIBRARY should be a string (the name of the library)."
@@ -148,13 +157,23 @@ LIBRARY should be a string (the name of the library)."
;; the same name.
(if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
(setq library (replace-match "" t t library)))
- (or
+ (or
(locate-file library
(or find-function-source-path load-path)
(find-library-suffixes))
(locate-file library
(or find-function-source-path load-path)
load-file-rep-suffixes)
+ (when (file-name-absolute-p library)
+ (let ((rel (find-library--load-name library)))
+ (when rel
+ (or
+ (locate-file rel
+ (or find-function-source-path load-path)
+ (find-library-suffixes))
+ (locate-file rel
+ (or find-function-source-path load-path)
+ load-file-rep-suffixes)))))
(error "Can't find library %s" library)))
(defvar find-function-C-source-directory
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 04299aec099..c8620aaa439 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -38,46 +38,46 @@
(define-abbrev-table 'lisp-mode-abbrev-table ())
(defvar emacs-lisp-mode-syntax-table
- (let ((table (make-syntax-table)))
- (let ((i 0))
- (while (< i ?0)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?9))
- (while (< i ?A)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?Z))
- (while (< i ?a)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?z))
- (while (< i 128)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (modify-syntax-entry ?\s " " table)
- ;; Non-break space acts as whitespace.
- (modify-syntax-entry ?\x8a0 " " table)
- (modify-syntax-entry ?\t " " table)
- (modify-syntax-entry ?\f " " table)
- (modify-syntax-entry ?\n "> " table)
- ;; This is probably obsolete since nowadays such features use overlays.
- ;; ;; 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)
- (modify-syntax-entry ?@ "' " table)
- ;; Used to be singlequote; changed for flonums.
- (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))
+ (let ((table (make-syntax-table))
+ (i 0))
+ (while (< i ?0)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?9))
+ (while (< i ?A)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?Z))
+ (while (< i ?a)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?z))
+ (while (< i 128)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (modify-syntax-entry ?\s " " table)
+ ;; Non-break space acts as whitespace.
+ (modify-syntax-entry ?\x8a0 " " table)
+ (modify-syntax-entry ?\t " " table)
+ (modify-syntax-entry ?\f " " table)
+ (modify-syntax-entry ?\n "> " table)
+ ;; This is probably obsolete since nowadays such features use overlays.
+ ;; ;; 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)
+ (modify-syntax-entry ?@ "' " table)
+ ;; Used to be singlequote; changed for flonums.
+ (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 used in `emacs-lisp-mode'.")
@@ -525,7 +525,6 @@ if that value is non-nil."
"Keymap for Lisp Interaction mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
-(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)
(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
"Major mode for typing and evaluating Lisp forms.
Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
@@ -790,25 +789,25 @@ Reinitialize the face according to the `defface' specification."
;; `defface' is macroexpanded to `custom-declare-face'.
((eq (car form) 'custom-declare-face)
;; Reset the face.
- (setq face-new-frame-defaults
- (assq-delete-all (eval (nth 1 form) lexical-binding)
- face-new-frame-defaults))
- (put (eval (nth 1 form) lexical-binding) 'face-defface-spec nil)
- ;; Setting `customized-face' to the new spec after calling
- ;; the form, but preserving the old saved spec in `saved-face',
- ;; imitates the situation when the new face spec is set
- ;; temporarily for the current session in the customize
- ;; buffer, thus allowing `face-user-default-spec' to use the
- ;; new customized spec instead of the saved spec.
- ;; Resetting `saved-face' temporarily to nil is needed to let
- ;; `defface' change the spec, regardless of a saved spec.
- (prog1 `(prog1 ,form
- (put ,(nth 1 form) 'saved-face
- ',(get (eval (nth 1 form) lexical-binding)
- 'saved-face))
- (put ,(nth 1 form) 'customized-face
- ,(nth 2 form)))
- (put (eval (nth 1 form) lexical-binding) 'saved-face nil)))
+ (let ((face-symbol (eval (nth 1 form) lexical-binding)))
+ (setq face-new-frame-defaults
+ (assq-delete-all face-symbol face-new-frame-defaults))
+ (put face-symbol 'face-defface-spec nil)
+ (put face-symbol 'face-documentation (nth 3 form))
+ ;; Setting `customized-face' to the new spec after calling
+ ;; the form, but preserving the old saved spec in `saved-face',
+ ;; imitates the situation when the new face spec is set
+ ;; temporarily for the current session in the customize
+ ;; buffer, thus allowing `face-user-default-spec' to use the
+ ;; new customized spec instead of the saved spec.
+ ;; Resetting `saved-face' temporarily to nil is needed to let
+ ;; `defface' change the spec, regardless of a saved spec.
+ (prog1 `(prog1 ,form
+ (put ,(nth 1 form) 'saved-face
+ ',(get face-symbol 'saved-face))
+ (put ,(nth 1 form) 'customized-face
+ ,(nth 2 form)))
+ (put face-symbol 'saved-face nil))))
((eq (car form) 'progn)
(cons 'progn (mapcar 'eval-defun-1 (cdr form))))
(t form)))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index deb06f52549..db6a03333d4 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -145,12 +145,12 @@ This command assumes point is not in a string or comment."
(while (/= arg 0)
(if (null forward-sexp-function)
(goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
- (condition-case err
- (while (progn (setq pos (point))
- (forward-sexp inc)
- (/= (point) pos)))
- (scan-error (goto-char (nth 2 err))))
- (if (= (point) pos)
+ (condition-case err
+ (while (progn (setq pos (point))
+ (forward-sexp inc)
+ (/= (point) pos)))
+ (scan-error (goto-char (nth (if (> arg 0) 3 2) err))))
+ (if (= (point) pos)
(signal 'scan-error
(list "Unbalanced parentheses" (point) (point)))))
(setq arg (- arg inc)))))
@@ -636,9 +636,8 @@ considered."
(plist (nthcdr 3 data)))
(if (null data)
(minibuffer-message "Nothing to complete")
- (let ((completion-annotate-function
- (plist-get plist :annotate-function)))
- (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
+ (let ((completion-extra-properties plist))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
(plist-get plist :predicate))))))
@@ -685,7 +684,7 @@ considered."
(when end
(list beg end obarray
:predicate predicate
- :annotate-function
+ :annotation-function
(unless (eq predicate 'fboundp)
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))))))))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index f0a075ace37..ccfdf2e0551 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -169,14 +169,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; here, so that any code that cares about the difference will
;; see the same transformation.
;; First arg is a function:
- (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc))
+ (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
',(and f `(lambda . ,_)) . ,args)
+ (byte-compile-log-warning
+ (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))))
;; Second arg is a function:
(`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
+ (byte-compile-log-warning
+ (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)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 50a65eb6bbb..ebbd6ff1fdf 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -351,9 +351,14 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
;;;###autoload
(defun re-builder ()
- "Construct a regexp interactively."
- (interactive)
+ "Construct a regexp interactively.
+This command makes the current buffer the \"target\" buffer of
+the regexp builder. It displays a buffer named \"*RE-Builder*\"
+in another window, initially containing an empty regexp.
+As you edit the regexp in the \"*RE-Builder*\" buffer, the
+matching parts of the target buffer will be highlighted."
+ (interactive)
(if (and (string= (buffer-name) reb-buffer)
(reb-mode-buffer-p))
(message "Already in the RE Builder")
@@ -709,8 +714,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(remove-hook 'after-change-functions 'reb-auto-update t)
(remove-hook 'kill-buffer-hook 'reb-kill-buffer t)
(when (reb-mode-buffer-p)
- (reb-delete-overlays)
- (funcall (or (default-value 'major-mode) 'fundamental-mode)))))
+ (reb-delete-overlays))))
;; continue standard unloading
nil)
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 7122de4789c..56efd142198 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -130,6 +130,8 @@
(** . (rx-** 2 nil)) ; SRE
(submatch . (rx-submatch 1 nil)) ; SRE
(group . submatch) ; sregex
+ (submatch-n . (rx-submatch-n 2 nil))
+ (group-n . submatch-n)
(zero-or-more . (rx-kleene 1 nil))
(one-or-more . (rx-kleene 1 nil))
(zero-or-one . (rx-kleene 1 nil))
@@ -690,6 +692,16 @@ FORM is either `(repeat N FORM1)' or `(repeat N M FORMS...)'."
(mapconcat (lambda (re) (rx-form re ':)) (cdr form) nil))
"\\)"))
+(defun rx-submatch-n (form)
+ "Parse and produce code from FORM, which is `(submatch-n N ...)'."
+ (let ((n (nth 1 form)))
+ (concat "\\(?" (number-to-string n) ":"
+ (if (= 3 (length form))
+ ;; Only one sub-form.
+ (rx-form (nth 2 form))
+ ;; Several sub-forms implicitly concatenated.
+ (mapconcat (lambda (re) (rx-form re ':)) (cddr form) nil))
+ "\\)")))
(defun rx-backref (form)
"Parse and produce code from FORM, which is `(backref N)'."
@@ -1072,6 +1084,11 @@ CHAR
like `and', but makes the match accessible with `match-end',
`match-beginning', and `match-string'.
+`(submatch-n N SEXP1 SEXP2 ...)'
+`(group-n N SEXP1 SEXP2 ...)'
+ like `group', but make it an explicitly-numbered group with
+ group number N.
+
`(or SEXP1 SEXP2 ...)'
`(| SEXP1 SEXP2 ...)'
matches anything that matches SEXP1 or SEXP2, etc. If all
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 2701d6b940b..cad7c8419b2 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -84,6 +84,26 @@
;; - Maybe accept two juxtaposed non-terminals in the BNF under the condition
;; that the first always ends with a terminal, or that the second always
;; starts with a terminal.
+;; - Permit EBNF-style notation.
+;; - If the grammar has conflicts, the only way is to make the lexer return
+;; different tokens for the different cases. This extra work performed by
+;; the lexer can be costly and unnecessary: we perform this extra work every
+;; time we find the conflicting token, regardless of whether or not the
+;; difference between the various situations is relevant to the current
+;; situation. E.g. we may try to determine whether a ";" is a ";-operator"
+;; or a ";-separator" in a case where we're skipping over a "begin..end" pair
+;; where the difference doesn't matter. For frequently occurring tokens and
+;; rarely occurring conflicts, this can be a significant performance problem.
+;; We could try and let the lexer return a "set of possible tokens
+;; plus a refinement function" and then let parser call the refinement
+;; function if needed.
+;; - Make it possible to better specify the behavior in the face of
+;; syntax errors. IOW provide some control over the choice of precedence
+;; levels within the limits of the constraints. E.g. make it possible for
+;; the grammar to specify that "begin..end" has lower precedence than
+;; "Module..EndModule", so that if a "begin" is missing, scanning from the
+;; "end" will stop at "Module" rather than going past it (and similarly,
+;; scanning from "Module" should not stop at a spurious "end").
;;; Code:
@@ -209,14 +229,18 @@ one of those elements share the same precedence level and associativity."
;; the trouble, and it lets the writer of the BNF
;; be a bit more sloppy by skipping uninteresting base
;; cases which are terminals but not OPs.
- (assert (not (member (cadr rhs) nts)))
+ (when (member (cadr rhs) nts)
+ (error "Adjacent non-terminals: %s %s"
+ (car rhs) (cadr rhs)))
(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)
(when (consp (cdr shr))
- (assert (not (member (cadr shr) nts)))
+ (when (member (cadr shr) nts)
+ (error "Adjacent non-terminals: %s %s"
+ (cadr shr) (car shr)))
(pushnew (cadr shr) last-ops)))))
(push (cons nt first-ops) first-ops-table)
(push (cons nt last-ops) last-ops-table)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index c012e48b590..200b3a6389b 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -398,8 +398,9 @@ point (where the PPSS is equivalent to nil).")
(defun syntax-ppss (&optional pos)
"Parse-Partial-Sexp State at POS, defaulting to point.
-The returned value is the same as `parse-partial-sexp' except that
-the 2nd and 6th values of the returned state cannot be relied upon.
+The returned value is the same as that of `parse-partial-sexp'
+run from point-min to POS except that values at positions 2 and 6
+in the returned list (counting from 0) cannot be relied upon.
Point is at POS when this function returns."
;; Default values.
(unless pos (setq pos (point)))
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index 2be026b98eb..cc3e633f098 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -29,13 +29,13 @@
;;;These forms are all considered safe
(defconst testcover-unsafep-safe
'(((lambda (x) (* x 2)) 14)
- (apply 'cdr (mapcar '(lambda (x) (car x)) y))
+ (apply 'cdr (mapcar (lambda (x) (car x)) y))
(cond ((= x 4) 5) (t 27))
(condition-case x (car y) (error (car x)))
(dolist (x y) (message "here: %s" x))
(dotimes (x 14 (* x 2)) (message "here: %d" x))
(let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
- (let (x) (apply '(lambda (x) (* x 2)) 14))
+ (let (x) (apply (lambda (x) (* x 2)) 14))
(let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
(let ((x 1) (y 2)) (setq x (+ x y)))
(let ((x 1)) (let ((y (+ x 3))) (* x y)))
@@ -90,7 +90,7 @@
. (function kill-buffer))
( (mapcar x y)
. (unquoted x))
- ( (mapcar '(lambda (x) (rename-file x "x")) '("unsafep.el"))
+ ( (mapcar (lambda (x) (rename-file x "x")) '("unsafep.el"))
. (function rename-file))
( (mapconcat x1 x2 " ")
. (unquoted x1))
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 08f757819f2..4c83e7e2e0d 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -28,7 +28,7 @@
;; * Use `testcover-mark-all' to add overlay "splotches" to the Lisp file's
;; buffer to show where coverage is lacking. Normally, a red splotch
;; indicates the form was never evaluated; a brown splotch means it always
-;; evaluted to the same value.
+;; evaluated to the same value.
;; * Use `testcover-next-mark' (bind it to a key!) to jump to the next spot
;; that has a splotch.
@@ -430,7 +430,7 @@ FUN should be `testcover-reinstrument' for compositional functions,
"Turn off instrumentation of all macros and functions in FILENAME."
(interactive "fStop covering file: ")
(let ((buf (find-file-noselect filename)))
- (eval-buffer buf t)))
+ (eval-buffer buf)))
;;;=========================================================================
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 5f069226aa9..0e007ff7176 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -110,38 +110,16 @@ of SECS seconds since the epoch. SECS may be a fraction."
(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."
- ;; FIXME: we should just use (time-add time (list 0 secs usecs))
- (let ((high (car time))
- (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
- (micro (if (numberp (car-safe (cdr-safe (cdr time))))
- (nth 2 time)
- 0)))
- ;; Add
- (if usecs (setq micro (+ micro usecs)))
- (if (floatp secs)
- (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
- (setq low (+ low (floor secs)))
-
- ;; Normalize
- ;; `/' rounds towards zero while `mod' returns a positive number,
- ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
- (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
- (setq micro (mod micro 1000000))
- (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
- (setq low (logand low 65535))
-
- (list high low (and (/= micro 0) micro))))
+ (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))))
+ (time-add time delta)))
(defun timer--time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
- ;; FIXME just use time-less-p.
- (destructuring-bind (high1 low1 micro1) (timer--time t1)
- (destructuring-bind (high2 low2 micro2) (timer--time t2)
- (or (< high1 high2)
- (and (= high1 high2)
- (or (< low1 low2)
- (and (= low1 low2)
- (< micro1 micro2))))))))
+ (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.
@@ -189,35 +167,35 @@ fire repeatedly that many seconds apart."
(setcdr reuse-cell timers))
(setq reuse-cell (cons timer timers)))
;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last reuse-cell)
- (if idle
- (setq timer-idle-list reuse-cell)
- (setq timer-list reuse-cell)))
+ (cond (last (setcdr last reuse-cell))
+ (idle (setq timer-idle-list reuse-cell))
+ (t (setq timer-list reuse-cell)))
(setf (timer--triggered timer) triggered-p)
(setf (timer--idle-delay timer) idle)
nil)
(error "Invalid or uninitialized timer")))
-(defun timer-activate (timer &optional triggered-p reuse-cell idle)
- "Put TIMER on the list of active timers.
+(defun timer-activate (timer &optional triggered-p reuse-cell)
+ "Insert TIMER into `timer-list'.
+If TRIGGERED-P is t, make TIMER inactive (put it on the list, but
+mark it as already triggered). To remove it, use `cancel-timer'.
-If TRIGGERED-P is t, that means to make the timer inactive
-\(put it on the list, but mark it as already triggered).
-To remove from the list, use `cancel-timer'.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse instead
-of allocating a new one."
+REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
+TIMER into `timer-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."
(timer--activate timer triggered-p reuse-cell nil))
(defun timer-activate-when-idle (timer &optional dont-wait reuse-cell)
- "Arrange to activate TIMER whenever Emacs is next idle.
-If optional argument DONT-WAIT is non-nil, then enable the
-timer to activate immediately, or at the right time, if Emacs
-is already idle.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse instead
-of allocating a new one."
+ "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.
+
+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."
(timer--activate timer (not dont-wait) reuse-cell 'idle))
(defalias 'disable-timeout 'cancel-timer)
@@ -273,10 +251,7 @@ how many will really happen.")
"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."
- ;; FIXME: (float-time (time-subtract (timer--time timer) time))
- (let ((high (- (car time) (timer--high-seconds timer)))
- (low (- (nth 1 time) (timer--low-seconds timer))))
- (+ low (* high 65536))))
+ (float-time (time-subtract time (timer--time timer))))
(defun timer-event-handler (timer)
"Call the handler for the timer TIMER.
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 1553aeae0d5..18411f7d2ef 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -1,9 +1,10 @@
-;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked
+;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
-;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc
+;; Copyright (C) 2011 Free Software Foundation, Inc
-;; Author: Tom Wurgler <twurgler@goodyear.com>
-;; Created: 12/8/94
+;; Author: Juanma Barranquero <lekktu@gmail.com>
+;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
+;; Maintainer: FSF
;; Keywords: extensions, processes
;; This file is part of GNU Emacs.
@@ -23,78 +24,220 @@
;;; Commentary:
-;; This code sets a buffer-local variable to t if toggle-emacs-lock is run,
-;; then if the user attempts to exit Emacs, the locked buffer name will be
-;; displayed and the exit aborted. This is just a way of protecting
-;; yourself from yourself. For example, if you have a shell running a big
-;; program and exiting Emacs would abort that program, you may want to lock
-;; that buffer, then if you forget about it after a while, you won't
-;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and
-;; run toggle-emacs-lock again.
+;; This package defines a minor mode Emacs Lock to mark a buffer as
+;; protected against accidental killing, or exiting Emacs, or both.
+;; Buffers associated with inferior modes, like shell or telnet, can
+;; be treated specially, by auto-unlocking them if their interior
+;; processes are dead.
;;; Code:
-(defvar emacs-lock-from-exiting nil
- "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.")
-(make-variable-buffer-local 'emacs-lock-from-exiting)
-
-(defvar emacs-lock-buffer-locked nil
- "Whether a shell or telnet buffer was locked when its process was killed.")
-(make-variable-buffer-local 'emacs-lock-buffer-locked)
-(put 'emacs-lock-buffer-locked 'permanent-local t)
+(defgroup emacs-lock nil
+ "Emacs-Lock mode."
+ :version "24.1"
+ :group 'convenience)
+
+(defcustom emacs-lock-default-locking-mode 'all
+ "Default locking mode of Emacs-Locked buffers.
+
+Its value is used as the default for `emacs-lock-mode' (which
+see) the first time that Emacs Lock mode is turned on in a buffer
+without passing an explicit locking mode.
+
+Possible values are:
+ exit -- Emacs cannot exit while the buffer is locked
+ kill -- the buffer cannot be killed, but Emacs can exit as usual
+ all -- the buffer is locked against both actions
+ nil -- the buffer is not locked"
+ :type '(choice
+ (const :tag "Do not allow Emacs to exit" exit)
+ (const :tag "Do not allow killing the buffer" kill)
+ (const :tag "Do not allow killing the buffer or exiting Emacs" all)
+ (const :tag "Do not lock the buffer" nil))
+ :group 'emacs-lock
+ :version "24.1")
+
+;; Note: as auto-unlocking can lead to data loss, it would be better
+;; to default to nil; but the value below is for compatibility with
+;; the old emacs-lock.el.
+(defcustom emacs-lock-unlockable-modes '((shell-mode . all)
+ (telnet-mode . all))
+ "Alist of auto-unlockable modes.
+Each element is a pair (MAJOR-MODE . ACTION), where ACTION is
+one of `kill', `exit' or `all'. Buffers with matching major
+modes are auto-unlocked for the specific action if their
+inferior processes are not alive. If this variable is t, all
+buffers associated to inferior processes are auto-unlockable
+for both actions (NOT RECOMMENDED)."
+ :type '(choice
+ (const :tag "All buffers with inferior processes" t)
+ (repeat :tag "Selected modes"
+ (cons :tag "Set auto-unlock for"
+ (symbol :tag "Major mode")
+ (radio
+ (const :tag "Allow exiting" exit)
+ (const :tag "Allow killing" kill)
+ (const :tag "Allow both" all)))))
+ :group 'emacs-lock
+ :version "24.1")
+
+(defvar emacs-lock-mode nil
+ "If non-nil, the current buffer is locked.
+It can be one of the following values:
+ exit -- Emacs cannot exit while the buffer is locked
+ kill -- the buffer cannot be killed, but Emacs can exit as usual
+ all -- the buffer is locked against both actions
+ nil -- the buffer is not locked")
+(make-variable-buffer-local 'emacs-lock-mode)
+(put 'emacs-lock-mode 'permanent-local t)
+
+(defvar emacs-lock--old-mode nil
+ "Most recent locking mode set on the buffer.
+Internal use only.")
+(make-variable-buffer-local 'emacs-lock--old-mode)
+(put 'emacs-lock--old-mode 'permanent-local t)
+
+(defvar emacs-lock--try-unlocking nil
+ "Non-nil if current buffer should be checked for auto-unlocking.
+Internal use only.")
+(make-variable-buffer-local 'emacs-lock--try-unlocking)
+(put 'emacs-lock--try-unlocking 'permanent-local t)
+
+(defun emacs-lock-live-process-p (buffer-or-name)
+ "Return t if BUFFER-OR-NAME is associated with a live process."
+ (let ((proc (get-buffer-process buffer-or-name)))
+ (and proc (process-live-p proc))))
+
+(defun emacs-lock--can-auto-unlock (action)
+ "Return t if the current buffer can auto-unlock for ACTION.
+ACTION must be one of `kill' or `exit'.
+See `emacs-lock-unlockable-modes'."
+ (and emacs-lock--try-unlocking
+ (not (emacs-lock-live-process-p (current-buffer)))
+ (or (eq emacs-lock-unlockable-modes t)
+ (let ((unlock (cdr (assq major-mode 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."
+ (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))))
+ 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))))
+
+(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))))
+
+(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)))
+
+(defun emacs-lock--set-mode (mode arg)
+ "Setter function for `emacs-lock-mode'."
+ (setq emacs-lock-mode
+ (cond ((memq arg '(all exit kill))
+ ;; explicit locking mode arg, use it
+ arg)
+ ((and (eq arg current-prefix-arg) (consp current-prefix-arg))
+ ;; called with C-u M-x emacs-lock-mode, so ask the user
+ (intern (completing-read "Locking mode: "
+ '("all" "exit" "kill")
+ nil t nil nil
+ (symbol-name
+ emacs-lock-default-locking-mode))))
+ ((eq mode t)
+ ;; turn on, so use previous setting, or customized default
+ (or emacs-lock--old-mode emacs-lock-default-locking-mode))
+ (t
+ ;; anything else (turn off)
+ mode))))
+
+;;;###autoload
+(define-minor-mode emacs-lock-mode
+ "Toggle Emacs Lock mode in the current buffer.
+
+With \\[universal-argument], ask for the locking mode to be used.
+With other prefix ARG, turn mode on if ARG is positive, off otherwise.
+
+Initially, if the user does not pass an explicit locking mode, it defaults
+to `emacs-lock-default-locking-mode' (which see); afterwards, the locking
+mode most recently set on the buffer is used instead.
+
+When called from Elisp code, ARG can be any locking mode:
+
+ exit -- Emacs cannot exit while the buffer is locked
+ kill -- the buffer cannot be killed, but Emacs can exit as usual
+ all -- the buffer is locked against both actions
+
+Other values are interpreted as usual."
+ :init-value nil
+ :lighter (""
+ (emacs-lock--try-unlocking " locked:" " Locked:")
+ (:eval (symbol-name emacs-lock-mode)))
+ :group 'emacs-lock
+ :variable (emacs-lock-mode .
+ (lambda (mode)
+ (emacs-lock--set-mode mode arg)))
+ (when emacs-lock-mode
+ (setq emacs-lock--old-mode emacs-lock-mode)
+ (setq emacs-lock--try-unlocking
+ (and (if (eq emacs-lock-unlockable-modes t)
+ (emacs-lock-live-process-p (current-buffer))
+ (assq major-mode emacs-lock-unlockable-modes))
+ t))))
-(defun check-emacs-lock ()
- "Check if variable `emacs-lock-from-exiting' is t for any buffer.
-If any locked buffer is found, signal error and display the buffer's name."
- (save-excursion
+(unless noninteractive
+ (add-hook 'kill-buffer-query-functions 'emacs-lock--kill-buffer-query-functions)
+ ;; We set a hook in both kill-emacs-hook and kill-emacs-query-functions because
+ ;; we really want to use k-e-q-f to stop as soon as possible, but don't want to
+ ;; be caught by surprise if someone calls `kill-emacs' instead.
+ (add-hook 'kill-emacs-hook 'emacs-lock--kill-emacs-hook)
+ (add-hook 'kill-emacs-query-functions 'emacs-lock--kill-emacs-query-functions))
+
+(defun emacs-lock-unload-function ()
+ "Unload the Emacs Lock library."
+ (catch :continue
(dolist (buffer (buffer-list))
(set-buffer buffer)
- (when emacs-lock-from-exiting
- (error "Emacs is locked from exit due to buffer: %s" (buffer-name))))))
+ (when emacs-lock-mode
+ (if (y-or-n-p (format "Buffer %S is locked, unlock it? " (buffer-name)))
+ (emacs-lock-mode -1)
+ (message "Unloading of feature `emacs-lock' aborted.")
+ (throw :continue t))))
+ ;; continue standard unloading
+ nil))
-(defun toggle-emacs-lock ()
- "Toggle `emacs-lock-from-exiting' for the current buffer.
-See `check-emacs-lock'."
- (interactive)
- (setq emacs-lock-from-exiting (not emacs-lock-from-exiting))
- (if emacs-lock-from-exiting
- (message "Buffer is now locked")
- (message "Buffer is now unlocked")))
-
-(defun emacs-lock-check-buffer-lock ()
- "Check if variable `emacs-lock-from-exiting' is t for a buffer.
-If the buffer is locked, signal error and display its name."
- (when emacs-lock-from-exiting
- (error "Buffer `%s' is locked, can't delete it" (buffer-name))))
-
-; These next defuns make it so if you exit a shell that is locked, the lock
-; is shut off for that shell so you can exit Emacs. Same for telnet.
-; Also, if a shell or a telnet buffer was locked and the process killed,
-; turn the lock back on again if the process is restarted.
-
-(defun emacs-lock-shell-sentinel ()
- (set-process-sentinel
- (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel)))
-
-(defun emacs-lock-clear-sentinel (_proc _str)
- (if emacs-lock-from-exiting
- (progn
- (setq emacs-lock-from-exiting nil)
- (setq emacs-lock-buffer-locked t)
- (message "Buffer is now unlocked"))
- (setq emacs-lock-buffer-locked nil)))
+;;; Compatibility
-(defun emacs-lock-was-buffer-locked ()
- (if emacs-lock-buffer-locked
- (setq emacs-lock-from-exiting t)))
+(define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1")
-(unless noninteractive
- (add-hook 'kill-emacs-hook 'check-emacs-lock))
-(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock)
-(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked)
-(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel)
-(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked)
-(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel)
+(defun toggle-emacs-lock ()
+ "Toggle `emacs-lock-from-exiting' for the current buffer."
+ (interactive)
+ (call-interactively 'emacs-lock-mode))
+(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1")
(provide 'emacs-lock)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 62ae3ffa7d5..5d90ac694a4 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -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)
- (setq lines (1+ lines))
- (if (and (> e s) (<= e (point-max)))
- (delete-region s e))))
+ (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)
@@ -750,7 +750,7 @@ If command is repeated at same position, delete the rectangle."
(when (/= left right)
(sit-for 0) ; make window top/bottom reliable
(cua--rectangle-operation nil t nil nil nil ; do not tabify
- '(lambda (s e l r v)
+ (lambda (s e l r v)
(let ((rface (if v 'cua-rectangle 'cua-rectangle-noselect))
overlay bs ms as)
(when (cua--rectangle-virtual-edges)
@@ -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))
@@ -852,7 +852,7 @@ If command is repeated at same position, delete the rectangle."
(if (cua--rectangle-right-side t)
(cua--rectangle-insert-col (current-column))
(setq indent (- (current-column) l))))
- '(lambda (l r)
+ (lambda (l r)
(when (and indent (> indent 0))
(aset cua--rectangle 2 (+ l indent))
(aset cua--rectangle 3 (+ r indent -1)))))))
@@ -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))
@@ -1042,7 +1042,7 @@ The text previously in the rectangle is overwritten by the blanks."
(interactive)
(let (x)
(cua--rectangle-operation 'clear nil t t nil
- '(lambda (s e l r)
+ (lambda (s e l r)
(let ((b (line-beginning-position)))
(skip-syntax-backward "^ " b)
(skip-syntax-backward " " b)
@@ -1050,7 +1050,7 @@ The text previously in the rectangle is overwritten by the blanks."
(skip-syntax-forward " " (line-end-position))
(delete-region s (point))
(indent-to l))
- '(lambda (l r)
+ (lambda (l r)
(move-to-column l)
;; (setq cua-save-point (point))
))))
@@ -1087,7 +1087,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,14 +1095,14 @@ 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)
"Replace CUA rectangle contents with CHARACTER."
(interactive "cFill rectangle with character: ")
(cua--rectangle-operation 'clear nil t 1 nil
- '(lambda (s e l r)
+ (lambda (s e l r)
(delete-region s e)
(move-to-column l t)
(insert-char character (- r l)))))
@@ -1113,7 +1113,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 +1121,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 +1154,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 +1218,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")
@@ -1266,7 +1266,7 @@ A numeric prefix argument is used a new width for the filled rectangle."
nil nil nil nil)))
(cua--rectangle-aux-replace width t t t 1
'cua--left-fill-rectangle
- '(lambda () (insert text))))
+ (lambda () (insert text))))
(defun cua-refill-rectangle (width)
"Fill contents of current rectagle.
@@ -1285,7 +1285,7 @@ With prefix arg, replace rectangle with output from command."
nil nil nil
'shell-command-history)))
(cua--rectangle-aux-replace -1 t t replace 1
- '(lambda (s e)
+ (lambda (s e)
(shell-command-on-region s e command
replace replace nil))))
@@ -1298,7 +1298,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 +1307,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 +1337,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)
@@ -1348,7 +1348,7 @@ With prefix arg, indent to that column."
(if (cua--rectangle-right-side t)
(cua--rectangle-insert-col (current-column))
(setq indent (- l (current-column))))))
- '(lambda (l r)
+ (lambda (l r)
(when (and indent (> indent 0))
(aset cua--rectangle 2 (- l indent))
(aset cua--rectangle 3 (- r indent 1)))))))
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index f86d3be0fc0..b4bf47a6504 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -1278,9 +1278,9 @@ kill modified buffers without asking."
(defun tpu-make-file-buffer-list (buffer-list)
"Return names from BUFFER-LIST excluding those beginning with a space or star."
- (delq nil (mapcar '(lambda (b)
- (if (or (= (aref (buffer-name b) 0) ? )
- (= (aref (buffer-name b) 0) ?*)) nil b))
+ (delq nil (mapcar (lambda (b)
+ (if (or (= (aref (buffer-name b) 0) ?\s)
+ (= (aref (buffer-name b) 0) ?*)) nil b))
buffer-list)))
(defun tpu-next-window nil
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 5daef7f9666..9d0eb6c0d14 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -617,7 +617,10 @@
(or (viper-overlay-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
- (if abbrev-mode (expand-abbrev))
+ ;; Expand abbrevs iff the previous character has word syntax.
+ (and abbrev-mode
+ (eq (char-syntax (preceding-char)) ?w)
+ (expand-abbrev))
(if (and auto-fill-function (> (current-column) fill-column))
(funcall auto-fill-function))
;; don't leave whitespace lines around
@@ -1084,7 +1087,7 @@ as a Meta key and any number of multiple escapes are allowed."
"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")))))
+ (lambda () (interactive) (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
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 4aace25fc9c..24a38236176 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -1080,7 +1080,7 @@ Otherwise return the normal value."
char-p (= (length base-key-name) 1))
(setq mod-char-list
(mapcar
- '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
+ (lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
modifiers))
(if char-p
(setq key-name
@@ -1153,7 +1153,7 @@ Otherwise return the normal value."
;; XEmacs only
(defun viper-event-vector-p (vec)
(and (vectorp vec)
- (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
+ (eval (cons 'and (mapcar (lambda (elt) (if (eventp elt) t)) vec)))))
;; check if vec is a vector of character symbols
@@ -1239,7 +1239,7 @@ Arguments become related buffers. This function should normally be used in
the `Local variables' section of a file."
(setq viper-related-files-and-buffers-ring
(make-ring (1+ (length other-files-or-buffers))))
- (mapc '(lambda (elt)
+ (mapc (lambda (elt)
(viper-ring-insert viper-related-files-and-buffers-ring elt))
other-files-or-buffers)
(viper-ring-insert viper-related-files-and-buffers-ring (buffer-name))
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 0da3345aae4..38a881845df 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -1,4 +1,4 @@
-;;; viper.el --- A full-featured Vi emulator for GNU Emacs and XEmacs,
+;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs,
;; a VI Plan for Emacs Rescue,
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
@@ -547,7 +547,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on."
"Viper Is a Package for Emacs Rebels,
a VI Plan for Emacs Rescue, and a venomous VI PERil.
-Incidentally, Viper emulates Vi under GNU Emacs 20 and XEmacs 20.
+Incidentally, Viper emulates Vi under Emacs/XEmacs 20.
It supports all of what is good in Vi and Ex, while extending
and improving upon much of it.
@@ -850,20 +850,21 @@ It also can't undo some Viper settings."
;; Zap bad bindings in flyspell-mouse-map, which prevent ESC from working
;; over misspelled words (due to the overlay keymaps)
(defvar flyspell-mode-hook)
+ (defvar flyspell-mouse-map)
(add-hook 'flyspell-mode-hook
- '(lambda ()
- (define-key flyspell-mouse-map viper-ESC-key nil)))
+ (lambda ()
+ (define-key flyspell-mouse-map viper-ESC-key nil)))
;; if viper is started from .emacs, it might be impossible to get certain
;; info about the display and windows until emacs initialization is complete
;; So do it via the window-setup-hook
(add-hook 'window-setup-hook
- '(lambda ()
- (modify-frame-parameters
- (selected-frame)
- (list (cons 'viper-vi-state-cursor-color
- (viper-get-cursor-color))))
- (setq viper-vi-state-cursor-color (viper-get-cursor-color))
- ))
+ (lambda ()
+ (modify-frame-parameters
+ (selected-frame)
+ (list (cons 'viper-vi-state-cursor-color
+ (viper-get-cursor-color))))
+ (setq viper-vi-state-cursor-color (viper-get-cursor-color))
+ ))
;; Tell vc-diff to put *vc* in Vi mode
(eval-after-load
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 187d338c1bc..1560f2a9049 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,24 @@
+2011-07-04 Vivek Dasmohapatra <vivek@etla.org>
+
+ * erc.el (erc-generate-new-buffer-name): Reuse old buffer names
+ when reconnecting (bug#5563).
+
+2011-06-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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-tls-stream): Use `open-network-stream' instead of
+ `open-tls-stream' directly to be able to use the built-in TLS
+ support.
+
+2011-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-pcomplete.el (erc-pcompletions-at-point): Mark the completion
+ data as non-exclusive if it's using the default-completion-function.
+ (pcomplete-erc-parse-arguments): Rename pcomplete-parse-erc-arguments.
+ (pcomplete-erc-setup): Use new name.
+
2011-05-03 Debarshi Ray <rishi@gnu.org> (tiny change)
* erc-backend.el (671): New response handler.
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index eb1398d5b05..a390fcfe84d 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -73,7 +73,10 @@ the most recent speakers are listed first."
"ERC completion data from pcomplete.
for use on `completion-at-point-function'."
(when (> (point) (erc-beg-of-input-line))
- (pcomplete-completions-at-point)))
+ (or (let ((pcomplete-default-completion-function #'ignore))
+ (pcomplete-completions-at-point))
+ (let ((c (pcomplete-completions-at-point)))
+ (if c (nconc c '(:exclusive no)))))))
(defun erc-pcomplete ()
"Complete the nick before point."
@@ -94,7 +97,7 @@ for use on `completion-at-point-function'."
(set (make-local-variable 'pcomplete-use-paring)
nil)
(set (make-local-variable 'pcomplete-parse-arguments-function)
- 'pcomplete-parse-erc-arguments)
+ 'pcomplete-erc-parse-arguments)
(set (make-local-variable 'pcomplete-command-completion-function)
'pcomplete/erc-mode/complete-command)
(set (make-local-variable 'pcomplete-command-name-function)
@@ -254,7 +257,7 @@ If optional argument IGNORE-SELF is non-nil, don't return the current nick."
(upcase (substring (pcomplete-arg 'first) 1))
"SAY"))
-(defun pcomplete-parse-erc-arguments ()
+(defun pcomplete-erc-parse-arguments ()
"Returns a list of parsed whitespace-separated arguments.
These are the words from the beginning of the line after the prompt
up to where point is right now."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a8c592696ad..a4040b239c1 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1555,26 +1555,33 @@ symbol, it may have these values:
(defun erc-generate-new-buffer-name (server port target &optional proc)
"Create a new buffer name based on the arguments."
(when (numberp port) (setq port (number-to-string port)))
- (let* ((buf-name (or target
- (or (let ((name (concat server ":" port)))
- (when (> (length name) 1)
- name))
- ; This fallback should in fact never happen
- "*erc-server-buffer*"))))
+ (let ((buf-name (or target
+ (or (let ((name (concat server ":" port)))
+ (when (> (length name) 1)
+ name))
+ ;; This fallback should in fact never happen
+ "*erc-server-buffer*")))
+ buffer-name)
;; Reuse existing buffers, but not if the buffer is a connected server
;; buffer and not if its associated with a different server than the
;; current ERC buffer.
- (if (and erc-reuse-buffers
- (get-buffer buf-name)
- (or target
- (with-current-buffer (get-buffer buf-name)
- (and (erc-server-buffer-p)
- (not (erc-server-process-alive)))))
- (with-current-buffer (get-buffer buf-name)
- (and (string= erc-session-server server)
- (erc-port-equal erc-session-port port))))
- buf-name
- (generate-new-buffer-name buf-name))))
+ ;; if buf-name is taken by a different connection (or by something !erc)
+ ;; then see if "buf-name/server" meets the same criteria
+ (dolist (candidate (list buf-name (concat buf-name "/" server)))
+ (if (and (not buffer-name)
+ erc-reuse-buffers
+ (get-buffer candidate)
+ (or target
+ (with-current-buffer (get-buffer candidate)
+ (and (erc-server-buffer-p)
+ (not (erc-server-process-alive)))))
+ (with-current-buffer (get-buffer candidate)
+ (and (string= erc-session-server server)
+ (erc-port-equal erc-session-port port))))
+ (setq buffer-name candidate)))
+ ;; if buffer-name is unset, neither candidate worked out for us,
+ ;; fallback to the old <N> uniquification method:
+ (or buffer-name (generate-new-buffer-name buf-name)) ))
(defun erc-get-buffer-create (server port target &optional proc)
"Create a new buffer based on the arguments."
@@ -2164,34 +2171,7 @@ be invoked for the values of the other parameters."
;;;###autoload
(defalias 'erc-select 'erc)
-
-(defun erc-ssl (&rest r)
- "Interactively select SSL connection parameters and run ERC.
-Arguments are the same as for `erc'."
- (interactive (erc-select-read-args))
- (let ((erc-server-connect-function 'erc-open-ssl-stream))
- (apply 'erc r)))
-
-(defalias 'erc-select-ssl 'erc-ssl)
-
-(declare-function open-ssl-stream "ext:ssl" (name buffer host service))
-
-(defun erc-open-ssl-stream (name buffer host port)
- "Open an SSL stream to an IRC server.
-The process will be given the name NAME, its target buffer will be
-BUFFER. HOST and PORT specify the connection target."
- (when (condition-case nil
- (require 'ssl)
- (error (message "You don't have ssl.el. %s"
- "Try using `erc-tls' instead.")
- nil))
- (let ((proc (open-ssl-stream name buffer host port)))
- ;; Ugly hack, but it works for now. Problem is it is
- ;; very hard to detect when ssl is established, because s_client
- ;; doesn't give any CONNECTIONESTABLISHED kind of message, and
- ;; most IRC servers send nothing and wait for you to identify.
- (sit-for 5)
- proc)))
+(defalias 'erc-ssl 'erc-tls)
(defun erc-tls (&rest r)
"Interactively select TLS connection parameters and run ERC.
@@ -2200,18 +2180,12 @@ Arguments are the same as for `erc'."
(let ((erc-server-connect-function 'erc-open-tls-stream))
(apply 'erc r)))
-(declare-function open-tls-stream "tls" (name buffer host port))
-
(defun erc-open-tls-stream (name buffer host port)
"Open an TLS stream to an IRC server.
The process will be given the name NAME, its target buffer will be
BUFFER. HOST and PORT specify the connection target."
- (when (condition-case nil
- (require 'tls)
- (error (message "You don't have tls.el. %s"
- "Try using `erc-ssl' instead.")
- nil))
- (open-tls-stream name buffer host port)))
+ (open-network-stream name buffer host port
+ :type 'tls))
;;; Displaying error messages
@@ -2395,7 +2369,7 @@ If STRING is nil, the function does nothing."
(cond ((integerp elt) ; POSITION
(incf (car list) shift))
((or (atom elt) ; nil, EXTENT
- ;; (eq t (car elt)) ; (t HIGH . LOW)
+ ;; (eq t (car elt)) ; (t . TIME)
(markerp (car elt))) ; (MARKER . DISTANCE)
nil)
((integerp (car elt)) ; (BEGIN . END)
@@ -6526,4 +6500,3 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 732c6c05bfe..db9b003895f 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -148,10 +148,10 @@ This option slows down recursive glob processing by quite a bit."
;; if this is a glob pattern than needs to be expanded, then it
;; will need to expand each member of the resulting glob list
(add-to-list 'eshell-current-modifiers
- '(lambda (list)
- (if (listp list)
- (mapcar 'expand-file-name list)
- (expand-file-name list)))))
+ (lambda (list)
+ (if (listp list)
+ (mapcar 'expand-file-name list)
+ (expand-file-name list)))))
(add-to-list 'eshell-current-modifiers 'eshell-extended-glob))
(defun eshell-parse-glob-chars ()
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 4ef259dee4b..17dbe3fbaf2 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -57,6 +57,13 @@ properties to colorize its output based on the setting of
:type 'hook
:group 'eshell-ls)
+(defcustom eshell-ls-date-format "%Y-%m-%d"
+ "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\"."
+ :type 'string
+ :group 'eshell-ls)
+
(defcustom eshell-ls-initial-args nil
"If non-nil, this list of args is included before any call to `ls'.
This is useful for enabling human-readable format (-h), for example."
@@ -508,7 +515,7 @@ whose cdr is the list of file attributes."
str))
" " (format-time-string
(concat
- "%b %e "
+ eshell-ls-date-format " "
(if (= (nth 5 (decode-time (current-time)))
(nth 5 (decode-time
(nth (cond
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index f3027ea9b5e..2308e08ed62 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -84,16 +84,16 @@ ordinary strings."
(?s . (eshell-pred-file-mode 4000)) ; setuid
(?S . (eshell-pred-file-mode 2000)) ; setgid
(?t . (eshell-pred-file-mode 1000)) ; sticky bit
- (?U . '(lambda (file) ; owned by effective uid
- (if (file-exists-p file)
- (= (nth 2 (file-attributes file)) (user-uid)))))
-;;; (?G . '(lambda (file) ; owned by effective gid
-;;; (if (file-exists-p file)
-;;; (= (nth 2 (file-attributes file)) (user-uid)))))
- (?* . '(lambda (file)
- (and (file-regular-p file)
- (not (file-symlink-p file))
- (file-executable-p file))))
+ (?U . #'(lambda (file) ; owned by effective uid
+ (if (file-exists-p file)
+ (= (nth 2 (file-attributes file)) (user-uid)))))
+ ;; (?G . #'(lambda (file) ; owned by effective gid
+ ;; (if (file-exists-p file)
+ ;; (= (nth 2 (file-attributes file)) (user-uid)))))
+ (?* . #'(lambda (file)
+ (and (file-regular-p file)
+ (not (file-symlink-p file))
+ (file-executable-p file))))
(?l . (eshell-pred-file-links))
(?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
(?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
@@ -111,36 +111,25 @@ The format of each entry is
(put 'eshell-predicate-alist 'risky-local-variable t)
(defcustom eshell-modifier-alist
- '((?E . '(lambda (lst)
- (mapcar
- (function
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str))))) lst)))
- (?L . '(lambda (lst)
- (mapcar 'downcase lst)))
- (?U . '(lambda (lst)
- (mapcar 'upcase lst)))
- (?C . '(lambda (lst)
- (mapcar 'capitalize lst)))
- (?h . '(lambda (lst)
- (mapcar 'file-name-directory lst)))
+ '((?E . #'(lambda (lst)
+ (mapcar
+ (function
+ (lambda (str)
+ (eshell-stringify
+ (car (eshell-parse-argument str))))) lst)))
+ (?L . #'(lambda (lst) (mapcar 'downcase lst)))
+ (?U . #'(lambda (lst) (mapcar 'upcase lst)))
+ (?C . #'(lambda (lst) (mapcar 'capitalize lst)))
+ (?h . #'(lambda (lst) (mapcar 'file-name-directory lst)))
(?i . (eshell-include-members))
(?x . (eshell-include-members t))
- (?r . '(lambda (lst)
- (mapcar 'file-name-sans-extension lst)))
- (?e . '(lambda (lst)
- (mapcar 'file-name-extension lst)))
- (?t . '(lambda (lst)
- (mapcar 'file-name-nondirectory lst)))
- (?q . '(lambda (lst)
- (mapcar 'eshell-escape-arg lst)))
- (?u . '(lambda (lst)
- (eshell-uniqify-list lst)))
- (?o . '(lambda (lst)
- (sort lst 'string-lessp)))
- (?O . '(lambda (lst)
- (nreverse (sort lst 'string-lessp))))
+ (?r . #'(lambda (lst) (mapcar 'file-name-sans-extension lst)))
+ (?e . #'(lambda (lst) (mapcar 'file-name-extension lst)))
+ (?t . #'(lambda (lst) (mapcar 'file-name-nondirectory lst)))
+ (?q . #'(lambda (lst) (mapcar 'eshell-escape-arg lst)))
+ (?u . #'(lambda (lst) (eshell-uniqify-list lst)))
+ (?o . #'(lambda (lst) (sort lst 'string-lessp)))
+ (?O . #'(lambda (lst) (nreverse (sort lst 'string-lessp))))
(?j . (eshell-join-members))
(?S . (eshell-split-members))
(?R . 'reverse)
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index f08fec8f8fa..259072d9750 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -120,6 +120,7 @@ only if that output can be presented in its entirely in the Eshell window."
(defcustom eshell-smart-display-navigate-list
'(insert-parentheses
mouse-yank-at-click
+ mouse-yank-primary
mouse-yank-secondary
yank-pop
yank-rectangle
diff --git a/lisp/faces.el b/lisp/faces.el
index 3fb8bc80931..302f8af35ac 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1255,7 +1255,7 @@ arg, prompt for a regular expression."
(insert
(substitute-command-keys
(concat
- "Use "
+ "\\<help-mode-map>>Use "
(if (display-mouse-p) "\\[help-follow-mouse] or ")
"\\[help-follow] on a face name to customize it\n"
"or on its sample text for a description of the face.\n\n")))
@@ -1821,109 +1821,6 @@ Return nil if it has no specified face."
(cond ((memq 'background-color face) (cdr (memq 'background-color face)))
((memq ':background face) (cadr (memq ':background face)))))
(t nil)))) ; Invalid face value.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Background mode.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defcustom frame-background-mode nil
- "The brightness of the background.
-Set this to the symbol `dark' if your background color is dark,
-`light' if your background is light, or nil (automatic by default)
-if you want Emacs to examine the brightness for you. Don't set this
-variable with `setq'; this won't have the expected effect."
- :group 'faces
- :set #'(lambda (var value)
- (set-default var value)
- (mapc 'frame-set-background-mode (frame-list)))
- :initialize 'custom-initialize-changed
- :type '(choice (const dark)
- (const light)
- (const :tag "automatic" nil)))
-
-
-(declare-function x-get-resource "frame.c"
- (attribute class &optional component subclass))
-
-(defvar inhibit-frame-set-background-mode nil)
-
-(defun frame-set-background-mode (frame &optional keep-face-specs)
- "Set up display-dependent faces on FRAME.
-Display-dependent faces are those which have different definitions
-according to the `background-mode' and `display-type' frame parameters.
-
-If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
-face specs for the new background mode."
- (unless inhibit-frame-set-background-mode
- (let* ((bg-resource
- (and (window-system frame)
- (x-get-resource "backgroundMode" "BackgroundMode")))
- (bg-color (frame-parameter frame 'background-color))
- (terminal-bg-mode (terminal-parameter frame 'background-mode))
- (tty-type (tty-type frame))
- (default-bg-mode
- (if (or (window-system frame)
- (and tty-type
- (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
- tty-type)))
- 'light
- 'dark))
- (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
- (bg-mode
- (cond (frame-background-mode)
- (bg-resource (intern (downcase bg-resource)))
- (terminal-bg-mode)
- ((equal bg-color "unspecified-fg") ; inverted colors
- non-default-bg-mode)
- ((not (color-values bg-color frame))
- default-bg-mode)
- ((>= (apply '+ (color-values bg-color frame))
- ;; Just looking at the screen, colors whose
- ;; values add up to .6 of the white total
- ;; still look dark to me.
- (* (apply '+ (color-values "white" frame)) .6))
- 'light)
- (t 'dark)))
- (display-type
- (cond ((null (window-system frame))
- (if (tty-display-color-p frame) 'color 'mono))
- ((display-color-p frame)
- 'color)
- ((x-display-grayscale-p frame)
- 'grayscale)
- (t 'mono)))
- (old-bg-mode
- (frame-parameter frame 'background-mode))
- (old-display-type
- (frame-parameter frame 'display-type)))
-
- (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
- (let ((locally-modified-faces nil)
- ;; Prevent face-spec-recalc from calling this function
- ;; again, resulting in a loop (bug#911).
- (inhibit-frame-set-background-mode t)
- (params (list (cons 'background-mode bg-mode)
- (cons 'display-type display-type))))
- (if keep-face-specs
- (modify-frame-parameters frame params)
- ;; If we are recomputing face specs, first collect a list
- ;; of faces that don't match their face-specs. These are
- ;; the faces modified on FRAME, and we avoid changing them
- ;; below. Use a negative list to avoid consing (we assume
- ;; most faces are unmodified).
- (dolist (face (face-list))
- (and (not (get face 'face-override-spec))
- (not (face-spec-match-p face
- (face-user-default-spec face)
- (selected-frame)))
- (push face locally-modified-faces)))
- ;; Now change to the new frame parameters
- (modify-frame-parameters frame params)
- ;; For all unmodified named faces, choose face specs
- ;; matching the new frame parameters.
- (dolist (face (face-list))
- (unless (memq face locally-modified-faces)
- (face-spec-recalc face frame)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2020,7 +1917,8 @@ settings, X resources, and `face-new-frame-defaults'.
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
(let ((window-system-p (memq (window-system frame) '(x w32))))
- (dolist (face (nreverse (face-list))) ;Why reverse? --Stef
+ ;; The `reverse' is so that `default' goes first.
+ (dolist (face (nreverse (face-list)))
(condition-case ()
(progn
;; Initialize faces from face spec and custom theme.
@@ -2211,7 +2109,7 @@ terminal type to a different value."
(defface link
'((((class color) (min-colors 88) (background light))
- :foreground "blue1" :underline t)
+ :foreground "RoyalBlue3" :underline t)
(((class color) (background light))
:foreground "blue" :underline t)
(((class color) (min-colors 88) (background dark))
diff --git a/lisp/files.el b/lisp/files.el
index 336a0a436f9..0b253fcc297 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -278,7 +278,7 @@ The value `never' means do not make them."
:group 'backup
:group 'vc)
(put 'version-control 'safe-local-variable
- '(lambda (x) (or (booleanp x) (equal x 'never))))
+ (lambda (x) (or (booleanp x) (equal x 'never))))
(defcustom dired-kept-versions 2
"When cleaning directory, number of versions to keep."
@@ -1288,100 +1288,6 @@ return value, which may be passed as the REQUIRE-MATCH arg to
'confirm)
(t nil)))
-(defun read-buffer-to-switch (prompt)
- "Read the name of a buffer to switch to and return as a string.
-It is intended for `switch-to-buffer' family of commands since they
-need to omit the name of current buffer from the list of completions
-and default values."
- (let ((rbts-completion-table (internal-complete-buffer-except)))
- (minibuffer-with-setup-hook
- (lambda ()
- (setq minibuffer-completion-table rbts-completion-table)
- ;; Since rbts-completion-table is built dynamically, we
- ;; can't just add it to the default value of
- ;; icomplete-with-completion-tables, so we add it
- ;; here manually.
- (if (and (boundp 'icomplete-with-completion-tables)
- (listp icomplete-with-completion-tables))
- (set (make-local-variable 'icomplete-with-completion-tables)
- (cons rbts-completion-table
- icomplete-with-completion-tables))))
- (read-buffer prompt (other-buffer (current-buffer))
- (confirm-nonexistent-file-or-buffer)))))
-
-(defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
- "Select the buffer specified by BUFFER-OR-NAME in another window.
-BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
-nil. Return the buffer switched to.
-
-If called interactively, prompt for the buffer name using the
-minibuffer. The variable `confirm-nonexistent-file-or-buffer'
-determines whether to request confirmation before creating a new
-buffer.
-
-If BUFFER-OR-NAME is a string and does not identify an existing
-buffer, create a new buffer with that name. If BUFFER-OR-NAME is
-nil, switch to the buffer returned by `other-buffer'.
-
-Optional second argument NORECORD non-nil means do not put this
-buffer at the front of the list of recently selected ones.
-
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
- (interactive
- (list (read-buffer-to-switch "Switch to buffer in other window: ")))
- (let ((pop-up-windows t)
- same-window-buffer-names same-window-regexps)
- (pop-to-buffer buffer-or-name t norecord)))
-
-(defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
- "Switch to buffer BUFFER-OR-NAME in another frame.
-BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
-nil. Return the buffer switched to.
-
-If called interactively, prompt for the buffer name using the
-minibuffer. The variable `confirm-nonexistent-file-or-buffer'
-determines whether to request confirmation before creating a new
-buffer.
-
-If BUFFER-OR-NAME is a string and does not identify an existing
-buffer, create a new buffer with that name. If BUFFER-OR-NAME is
-nil, switch to the buffer returned by `other-buffer'.
-
-Optional second arg NORECORD non-nil means do not put this
-buffer at the front of the list of recently selected ones.
-
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
- (interactive
- (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
- (let ((pop-up-frames t)
- same-window-buffer-names same-window-regexps)
- (pop-to-buffer buffer-or-name t norecord)))
-
-(defun display-buffer-other-frame (buffer)
- "Display buffer BUFFER in another frame.
-This uses the function `display-buffer' as a subroutine; see
-its documentation for additional customization information."
- (interactive "BDisplay buffer in other frame: ")
- (let ((pop-up-frames t)
- same-window-buffer-names same-window-regexps
- ;;(old-window (selected-window))
- new-window)
- (setq new-window (display-buffer buffer t))
- ;; This may have been here in order to prevent the new frame from hiding
- ;; the old frame. But it does more harm than good.
- ;; Maybe we should call `raise-window' on the old-frame instead? --Stef
- ;;(lower-frame (window-frame new-window))
-
- ;; This may have been here in order to make sure the old-frame gets the
- ;; focus. But not only can it cause an annoying flicker, with some
- ;; window-managers it just makes the window invisible, with no easy
- ;; way to recover it. --Stef
- ;;(make-frame-invisible (window-frame old-window))
- ;;(make-frame-visible (window-frame old-window))
- ))
-
(defmacro minibuffer-with-setup-hook (fun &rest body)
"Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
BODY should use the minibuffer at most once.
@@ -1435,8 +1341,8 @@ automatically choosing a major mode, use \\[find-file-literally]."
(confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
- (mapcar 'switch-to-buffer (nreverse value))
- (switch-to-buffer value))))
+ (mapcar #'pop-to-buffer-same-window (nreverse value))
+ (pop-to-buffer-same-window value))))
(defun find-file-other-window (filename &optional wildcards)
"Edit file FILENAME, in another window.
@@ -2154,7 +2060,11 @@ unless NOMODES is non-nil."
((not warn) nil)
((and error (file-attributes buffer-file-name))
(setq buffer-read-only t)
- "File exists, but cannot be read")
+ (if (and (file-symlink-p buffer-file-name)
+ (not (file-exists-p
+ (file-chase-links buffer-file-name))))
+ "Symbolic link that points to nonexistent file"
+ "File exists, but cannot be read"))
((not buffer-read-only)
(if (and warn
;; No need to warn if buffer is auto-saved
@@ -2241,6 +2151,8 @@ in that case, this function acts as if `enable-local-variables' were t."
(interactive)
(funcall (or (default-value 'major-mode) 'fundamental-mode))
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
+ ;; FIXME this is less efficient than it could be, since both
+ ;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
(report-errors "File mode specification error: %s"
(set-auto-mode))
(report-errors "File local-variables error: %s"
@@ -2360,7 +2272,12 @@ since only a single case-insensitive search through the alist is made."
("\\.icn\\'" . icon-mode)
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
+ ;; The Fortran standard does not say anything about file extensions.
+ ;; .f90 was widely used for F90, now we seem to be trapped into
+ ;; using a different extension for each language revision.
+ ;; Anyway, the following extensions are supported by gfortran.
("\\.f9[05]\\'" . f90-mode)
+ ("\\.f0[38]\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode)
("\\.srt\\'" . srecode-template-mode)
@@ -2425,6 +2342,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
("#\\*mail\\*" . mail-mode)
("\\.g\\'" . antlr-mode)
+ ("\\.mod\\'" . m2-mode)
("\\.ses\\'" . ses-mode)
("\\.docbook\\'" . sgml-mode)
("\\.com\\'" . dcl-mode)
@@ -2435,8 +2353,6 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
("\\.ppd\\'" . conf-ppd-mode)
("java.+\\.conf\\'" . conf-javaprop-mode)
("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
- ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
- ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
;; ChangeLog.old etc. Other change-log-mode entries are above;
@@ -2458,11 +2374,14 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
;; Using mode nil rather than `ignore' would let the search continue
;; through this list (with the shortened name) rather than start over.
("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
+ ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)
+ ;; This should come after "in" stripping (e.g. config.h.in).
+ ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
+ ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
;; The following should come after the ChangeLog pattern
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
- ("\\.[1-9]\\'" . nroff-mode)
- ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)))
+ ("\\.[1-9]\\'" . nroff-mode)))
"Alist of filename patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
\(NON-NIL stands for anything that is not nil; the value does not matter.)
@@ -2521,6 +2440,7 @@ and `magic-mode-alist', which determines modes based on file contents.")
("ksh" . sh-mode)
("oash" . sh-mode)
("pdksh" . sh-mode)
+ ("rbash" . sh-mode)
("rc" . sh-mode)
("rpm" . sh-mode)
("sh" . sh-mode)
@@ -2616,23 +2536,24 @@ Also applies to `magic-fallback-mode-alist'.")
"Select major mode appropriate for current buffer.
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'.
-It does not check for the `mode:' local variable in the
-Local Variables section of the file; for that, use `hack-local-variables'.
-
-If `enable-local-variables' is nil, this function does not check for a
--*- mode tag.
+If `enable-local-variables' is nil, this function does not check for
+any mode: tag anywhere in the file.
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)
- ;; Find a -*- mode tag
+ ;; 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.
+ ;; Find a -*- mode tag.
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
@@ -2667,6 +2588,14 @@ 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))))))
+ (and (not done)
+ enable-local-variables
+ (setq mode (hack-local-variables t))
+ (not (memq mode modes)) ; already tried and failed
+ (if (not (functionp mode))
+ (message "Ignoring unknown mode `%s'" mode)
+ (setq done t)
+ (set-auto-mode-0 mode keep-mode-if-same)))
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
@@ -3018,74 +2947,68 @@ n -- to ignore the local variables list.")
(setq char nil)))
(kill-buffer buf)
(when (and offer-save (= char ?!) unsafe-vars)
- (dolist (elt unsafe-vars)
- (add-to-list 'safe-local-variable-values elt))
- ;; When this is called from desktop-restore-file-buffer,
- ;; coding-system-for-read may be non-nil. Reset it before
- ;; writing to .emacs.
- (if (or custom-file user-init-file)
- (let ((coding-system-for-read nil))
- (customize-save-variable
- 'safe-local-variable-values
- safe-local-variable-values))))
+ (customize-push-and-save 'safe-local-variable-values unsafe-vars))
(memq char '(?! ?\s ?y))))))
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
-Ignore any specification for `mode:' and `coding:';
-`set-auto-mode' should already have handled `mode:',
-`set-auto-coding' should already have handled `coding:'.
-
-If MODE-ONLY is non-nil, all we do is check whether the major
-mode is specified, returning t if it is specified. Otherwise,
-return an alist of elements (VAR . VAL), where VAR is a variable
-and VAL is the specified value."
+Returns an alist of elements (VAR . VAL), where VAR is a variable
+and VAL is the specified value. Ignores any specification for
+`mode:' and `coding:' (which should have already been handled
+by `set-auto-mode' and `set-auto-coding', respectively).
+Throws an error if the -*- line is malformed.
+
+If MODE-ONLY is non-nil, just returns the symbol specifying the
+mode, if there is one, otherwise nil."
(save-excursion
(goto-char (point-min))
(let ((end (set-auto-mode-1))
- result mode-specified)
- ;; Parse the -*- line into the RESULT alist.
- ;; Also set MODE-SPECIFIED if we see a spec or `mode'.
+ result)
(cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
- ;; Simple form: "-*- MODENAME -*-". Already handled.
- (setq mode-specified t)
- nil)
+ ;; Simple form: "-*- MODENAME -*-".
+ (if mode-only
+ (intern (concat (match-string 1) "-mode"))))
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
;; (last ";" is optional).
- (while (< (point) end)
+ ;; If MODE-ONLY, just check for `mode'.
+ ;; Otherwise, parse the -*- line into the RESULT alist.
+ (while (and (or (not mode-only)
+ (not result))
+ (< (point) end))
(or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
(error "Malformed -*- line"))
(goto-char (match-end 0))
;; There used to be a downcase here,
;; but the manual didn't say so,
;; and people want to set var names that aren't all lc.
- (let ((key (intern (match-string 1)))
- (val (save-restriction
- (narrow-to-region (point) end)
- (let ((read-circle nil))
- (read (current-buffer))))))
- ;; It is traditional to ignore
- ;; case when checking for `mode' in set-auto-mode,
- ;; so we must do that here as well.
- ;; That is inconsistent, but we're stuck with it.
- ;; The same can be said for `coding' in set-auto-coding.
- (or (and (equal (downcase (symbol-name key)) "mode")
- (setq mode-specified t))
- (equal (downcase (symbol-name key)) "coding")
- (condition-case nil
- (push (cons (if (eq key 'eval)
- 'eval
- (indirect-variable key))
- val) result)
- (error nil)))
- (skip-chars-forward " \t;")))))
-
- (if mode-only
- mode-specified
- result))))
+ (let* ((key (intern (match-string 1)))
+ (val (save-restriction
+ (narrow-to-region (point) end)
+ (let ((read-circle nil))
+ (read (current-buffer)))))
+ ;; It is traditional to ignore
+ ;; case when checking for `mode' in set-auto-mode,
+ ;; so we must do that here as well.
+ ;; That is inconsistent, but we're stuck with it.
+ ;; The same can be said for `coding' in set-auto-coding.
+ (keyname (downcase (symbol-name key))))
+ (if mode-only
+ (and (equal keyname "mode")
+ (setq result
+ (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ (or (equal keyname "coding")
+ (condition-case nil
+ (push (cons (if (eq key 'eval)
+ 'eval
+ (indirect-variable key))
+ val) result)
+ (error nil))))
+ (skip-chars-forward " \t;")))
+ result)))))
(defun hack-local-variables-filter (variables dir-name)
"Filter local variable settings, querying the user if necessary.
@@ -3144,8 +3067,12 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil."
(defun hack-local-variables (&optional mode-only)
"Parse and put into effect this buffer's local variables spec.
-If MODE-ONLY is non-nil, all we do is check whether the major mode
-is specified, returning t if it is specified."
+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."
(let ((enable-local-variables
(and local-enable-local-variables enable-local-variables))
result)
@@ -3154,88 +3081,98 @@ is specified, returning t if it is specified."
(report-errors "Directory-local variables error: %s"
(hack-dir-local-variables)))
(when (or mode-only enable-local-variables)
- (setq result (hack-local-variables-prop-line mode-only))
- ;; Look for "Local variables:" line in last page.
- (save-excursion
- (goto-char (point-max))
- (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
- 'move)
- (when (let ((case-fold-search t))
- (search-forward "Local Variables:" nil t))
- (skip-chars-forward " \t")
- ;; suffix is what comes after "local variables:" in its line.
- ;; prefix is what comes before "local variables:" in its line.
- (let ((suffix
- (concat
- (regexp-quote (buffer-substring (point)
- (line-end-position)))
- "$"))
- (prefix
- (concat "^" (regexp-quote
- (buffer-substring (line-beginning-position)
- (match-beginning 0)))))
- beg)
-
- (forward-line 1)
- (let ((startpos (point))
- endpos
- (thisbuf (current-buffer)))
- (save-excursion
- (unless (let ((case-fold-search t))
- (re-search-forward
- (concat prefix "[ \t]*End:[ \t]*" suffix)
- nil t))
- ;; This used to be an error, but really all it means is
- ;; that this may simply not be a local-variables section,
- ;; so just ignore it.
- (message "Local variables list is not properly terminated"))
- (beginning-of-line)
- (setq endpos (point)))
-
- (with-temp-buffer
- (insert-buffer-substring thisbuf startpos endpos)
- (goto-char (point-min))
- (subst-char-in-region (point) (point-max) ?\^m ?\n)
- (while (not (eobp))
- ;; Discard the prefix.
- (if (looking-at prefix)
- (delete-region (point) (match-end 0))
- (error "Local variables entry is missing the prefix"))
- (end-of-line)
- ;; Discard the suffix.
- (if (looking-back suffix)
- (delete-region (match-beginning 0) (point))
- (error "Local variables entry is missing the suffix"))
- (forward-line 1))
- (goto-char (point-min))
-
- (while (not (eobp))
- ;; Find the variable name; strip whitespace.
- (skip-chars-forward " \t")
- (setq beg (point))
- (skip-chars-forward "^:\n")
- (if (eolp) (error "Missing colon in local variables entry"))
- (skip-chars-backward " \t")
- (let* ((str (buffer-substring beg (point)))
- (var (let ((read-circle nil))
- (read str)))
- val)
- ;; Read the variable value.
- (skip-chars-forward "^:")
- (forward-char 1)
- (let ((read-circle nil))
- (setq val (read (current-buffer))))
- (if mode-only
- (if (eq var 'mode)
- (setq result t))
- (unless (eq var 'coding)
- (condition-case nil
- (push (cons (if (eq var 'eval)
- 'eval
- (indirect-variable var))
- val) result)
- (error nil)))))
- (forward-line 1))))))))
+ ;; 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)
+ ;; Look for "Local variables:" line in last page.
+ (save-excursion
+ (goto-char (point-max))
+ (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
+ 'move)
+ (when (let ((case-fold-search t))
+ (search-forward "Local Variables:" nil t))
+ (skip-chars-forward " \t")
+ ;; suffix is what comes after "local variables:" in its line.
+ ;; prefix is what comes before "local variables:" in its line.
+ (let ((suffix
+ (concat
+ (regexp-quote (buffer-substring (point)
+ (line-end-position)))
+ "$"))
+ (prefix
+ (concat "^" (regexp-quote
+ (buffer-substring (line-beginning-position)
+ (match-beginning 0)))))
+ beg)
+
+ (forward-line 1)
+ (let ((startpos (point))
+ endpos
+ (thisbuf (current-buffer)))
+ (save-excursion
+ (unless (let ((case-fold-search t))
+ (re-search-forward
+ (concat prefix "[ \t]*End:[ \t]*" suffix)
+ nil t))
+ ;; This used to be an error, but really all it means is
+ ;; that this may simply not be a local-variables section,
+ ;; so just ignore it.
+ (message "Local variables list is not properly terminated"))
+ (beginning-of-line)
+ (setq endpos (point)))
+
+ (with-temp-buffer
+ (insert-buffer-substring thisbuf startpos endpos)
+ (goto-char (point-min))
+ (subst-char-in-region (point) (point-max) ?\^m ?\n)
+ (while (not (eobp))
+ ;; Discard the prefix.
+ (if (looking-at prefix)
+ (delete-region (point) (match-end 0))
+ (error "Local variables entry is missing the prefix"))
+ (end-of-line)
+ ;; Discard the suffix.
+ (if (looking-back suffix)
+ (delete-region (match-beginning 0) (point))
+ (error "Local variables entry is missing the suffix"))
+ (forward-line 1))
+ (goto-char (point-min))
+
+ (while (and (not (eobp))
+ (or (not mode-only)
+ (not result)))
+ ;; Find the variable name; strip whitespace.
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (skip-chars-forward "^:\n")
+ (if (eolp) (error "Missing colon in local variables entry"))
+ (skip-chars-backward " \t")
+ (let* ((str (buffer-substring beg (point)))
+ (var (let ((read-circle nil))
+ (read str)))
+ val val2)
+ ;; Read the variable value.
+ (skip-chars-forward "^:")
+ (forward-char 1)
+ (let ((read-circle nil))
+ (setq val (read (current-buffer))))
+ (if mode-only
+ (and (eq var 'mode)
+ ;; Specifying minor-modes via mode: is
+ ;; deprecated, but try to reject them anyway.
+ (not (string-match
+ "-minor\\'"
+ (setq val2 (downcase (symbol-name val)))))
+ (setq result (intern (concat val2 "-mode"))))
+ (unless (eq var 'coding)
+ (condition-case nil
+ (push (cons (if (eq var 'eval)
+ 'eval
+ (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)
@@ -3245,6 +3182,14 @@ is specified, returning t if it is specified."
(hack-local-variables-apply)))))
(defun hack-local-variables-apply ()
+ "Apply the elements of `file-local-variables-alist'.
+If there are any elements, runs `before-hack-local-variables-hook',
+then calls `hack-one-local-variable' to apply the alist elements one by one.
+Finishes by running `hack-local-variables-hook', regardless of whether
+the alist is empty or not.
+
+Note that this function ignores a `mode' entry if it specifies the same
+major mode as the buffer already has."
(when file-local-variables-alist
;; Any 'evals must run in the Right sequence.
(setq file-local-variables-alist
@@ -3329,7 +3274,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 (null (cdr exp))
+ (or (and (member (cdr exp) '(nil (1) (-1)))
(string-match "-mode\\'" (symbol-name (car exp))))
(let ((prop (get (car exp) 'safe-local-eval-function)))
(cond ((eq prop t)
@@ -4517,6 +4462,7 @@ Before and after saving the buffer, this function runs
(dir-writable (file-writable-p dir)))
(if (or (and file-precious-flag dir-writable)
(and break-hardlink-on-save
+ (file-exists-p buffer-file-name)
(> (file-nlinks buffer-file-name) 1)
(or dir-writable
(error (concat (format
@@ -4752,7 +4698,7 @@ and `view-read-only' is non-nil, enter view mode."
(view-mode-enter))
(t (setq buffer-read-only (not buffer-read-only))
(force-mode-line-update)))
- (if (vc-backend buffer-file-name)
+ (if (memq (vc-backend buffer-file-name) '(RCS SCCS))
(message "%s" (substitute-command-keys
(concat "File is under version-control; "
"use \\[vc-next-action] to check in/out"))))))
@@ -4832,7 +4778,10 @@ visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS, if
non-nil, says whether to create parent directories that don't
-exist. Interactively, this happens by default."
+exist. Interactively, this happens by default.
+
+If creating the directory or directories fail, an error will be
+raised."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
@@ -5217,7 +5166,7 @@ non-nil, it is called instead of rereading visited file contents."
(save-excursion
(let ((switches dired-listing-switches))
(if (file-symlink-p file)
- (setq switches (concat switches "L")))
+ (setq switches (concat switches " -L")))
(set-buffer standard-output)
;; Use insert-directory-safely, not insert-directory,
;; because these files might not exist. In particular,
@@ -5260,7 +5209,7 @@ Then you'll be asked about a number of files to recover."
(error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
(dired (concat auto-save-list-file-prefix "*")
- (concat dired-listing-switches "t")))
+ (concat dired-listing-switches " -t")))
(save-excursion
(goto-char (point-min))
(or (looking-at " Move to the session you want to recover,")
@@ -5618,7 +5567,8 @@ default directory. However, if FULL is non-nil, they are absolute."
contents)
(while dirs
(when (or (null (car dirs)) ; Possible if DIRPART is not wild.
- (file-directory-p (directory-file-name (car dirs))))
+ (and (file-directory-p (directory-file-name (car dirs)))
+ (file-readable-p (car dirs))))
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index a2b196dc029..491110bc898 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -86,8 +86,7 @@ them for `find-ls-option'."
(defcustom find-grep-options
(if (or (eq system-type 'berkeley-unix)
- (string-match "solaris2" system-configuration)
- (string-match "irix" system-configuration))
+ (string-match "solaris2\\|irix" system-configuration))
"-s" "-q")
"Option to grep to be as silent as possible.
On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
diff --git a/lisp/follow.el b/lisp/follow.el
index 9bf472e547c..94a542f1016 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -118,7 +118,7 @@
;; (setq pixel-vertical-clip-threshold 30)
-;; The correct way to cofigurate Follow mode, or any other mode for
+;; The correct way to configurate 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.
@@ -189,7 +189,7 @@
;; positions in the text? Here are two simple methods to use:
;;
;; 1) Use multiple frames; `follow' mode only affects windows displayed
-;; in the same frame. (My apoligies to you who can't use frames.)
+;; in the same frame. (My apologies to you who can't use frames.)
;;
;; 2) Bind `follow-mode' to key so you can turn it off whenever
;; you want to view two locations. Of course, `follow' mode can
@@ -209,15 +209,15 @@
;;
;; Follow mode does this in three places:
;; 1) After each user command.
-;; 2) After a process output has been perfomed.
+;; 2) After a process output has been performed.
;; 3) When a scrollbar has been moved.
;;
;; 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 windows unaligned. It will, however, pop right back
+;; 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.)
;;}}}
@@ -244,7 +244,7 @@
;; (funcall (symbol-function 'set) 'bar ...)
;;
;; Note: When this file is interpreted, `eval-when-compile' is
-;; evaluted. Since it doesn't hurt to evaluate it, but it is a bit
+;; 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...
;;
@@ -456,7 +456,7 @@ Used by `follow-window-size-change'.")
;; the variable is not set.
(defsubst follow-debug-message (&rest args)
- "Like message, but only active when `follow-debug' is non-nil."
+ "Like `message', but only active when `follow-debug' is non-nil."
(if (and (boundp 'follow-debug) follow-debug)
(apply 'message args)))
@@ -1000,7 +1000,7 @@ Note that this handles the case when the cache has been set to nil."
res))
-;; Make sure WIN always starts at the beginning of an whole screen
+;; Make sure WIN always starts at the beginning of a whole screen
;; line. If WIN is not aligned the start is updated which probably
;; will lead to a redisplay of the screen later on.
;;
@@ -1057,8 +1057,8 @@ Return the selected window."
win))
-;; Lets select a window showing the end. Make sure we only select it if it
-;; it wasn't just moved here. (i.e. M-> shall not unconditionally place
+;; 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.)
;;
;; (Compatibility cludge: in Emacs `window-end' is equal to `point-max';
@@ -1134,7 +1134,7 @@ Otherwise, return nil."
"Reposition the WINDOWS around WIN.
Should the point be too close to the roof we redisplay everything
from the top. WINDOWS should contain a list of windows to
-redisplay, it is assumed that WIN is a member of the list.
+redisplay; it is assumed that WIN is a member of the list.
Should WINDOWS be nil, the windows displaying the
same buffer as WIN, in the current frame, are used.
Should WIN be nil, the selected window is used.
@@ -1231,7 +1231,7 @@ should be a member of WINDOWS, starts at position START."
(setq done t res (point)))
((= win-start start) ; Perfect match, use this value
(setq done t res (point)))
- ((< win-start start) ; Walked to far, use preious result
+ ((< win-start start) ; Walked to far, use previous result
(setq done t))
(t ; Store result for next iteration
(setq res (point))))))
@@ -1241,12 +1241,12 @@ should be a member of WINDOWS, starts at position START."
;;{{{ Avoid tail recenter
;; This sets the window internal flag `force_start'. The effect is that
-;; windows only displaying the tail isn't recentered.
+;; 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 windows whose
+;; A window displaying only the tail, is a window whose
;; window-start position is equal to (point-max) of the buffer it
;; displays.
;;
@@ -1487,12 +1487,12 @@ non-first windows in Follow mode."
;;;; Scroll-bar support code.
;; Why is it needed? Well, if the selected window is in follow mode,
-;; all its follower stick to it blindly. If one of them is scrolled,
+;; 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 doesn't get compiled. Aestetically, this might be a
+;; 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
@@ -1700,8 +1700,8 @@ magic stuff before the real process filter is called."
;;}}}
;;{{{ Start/stop interception of processes.
-;; Normally, all new processed are intercepted by our `set-process-filter'.
-;; This is needed to intercept old processed that were started before we were
+;; 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'.
@@ -1749,7 +1749,7 @@ report this using the `report-emacs-bug' function."
;; 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 moves it back to its
+;; 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!)
@@ -1767,7 +1767,7 @@ report this using the `report-emacs-bug' function."
;; 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 hadnling code to sceduling a redisplay.
+ ;; provoke the process handling code to schedule a redisplay.
;(or (input-pending-p)
; (follow-avoid-tail-recenter))
@@ -1788,7 +1788,7 @@ report this using the `report-emacs-bug' function."
(inhibit-read-only t))
(save-excursion
(goto-char (process-mark proc))
- ;; `insert-before-markers' just in case the users next
+ ;; `insert-before-markers' just in case the user's next
;; command is M-y.
(insert-before-markers output)
(set-marker (process-mark proc) (point)))
@@ -1848,7 +1848,7 @@ report this using the `report-emacs-bug' function."
(t
(follow-debug-message "filter: nothing")))
- ;; Here we have slected a window. Make sure the
+ ;; 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
@@ -1866,7 +1866,7 @@ report this using the `report-emacs-bug' function."
;; return to the original window.
(if return-to-orig-win
(select-window orig-win))
- ;; Restore the orignal buffer, unless the filter explicitly
+ ;; 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))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 32fbb0608a2..6902ce98ab1 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -254,6 +254,7 @@ for buffers in Rmail mode, and size is irrelevant otherwise."
If nil, use the default decoration (typically the minimum available).
If t, use the maximum decoration available.
If a number, use that level of decoration (or if not available the maximum).
+The higher the number, the more decoration is done.
If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL),
where MAJOR-MODE is a symbol or t (meaning the default). For example:
((c-mode . t) (c++-mode . 2) (t . 1))
@@ -563,7 +564,7 @@ we recommend setting `syntax-begin-function' instead.
This is normally set via `font-lock-defaults'.")
(make-obsolete-variable 'font-lock-beginning-of-syntax-function
- 'syntax-begin-function "23.3")
+ '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.
@@ -1856,19 +1857,13 @@ Sets various variables using `font-lock-defaults' and
(((class color) (min-colors 8) (background light))
(:foreground "red"))
(((class color) (min-colors 8) (background dark))
- )
+ (:foreground "yellow"))
(t (:weight bold :slant italic)))
"Font Lock mode face used to highlight comments."
:group 'font-lock-faces)
(defface font-lock-comment-delimiter-face
- '((default :inherit font-lock-comment-face)
- (((class grayscale)))
- (((class color) (min-colors 16)))
- (((class color) (min-colors 8) (background light))
- :foreground "red")
- (((class color) (min-colors 8) (background dark))
- :foreground "red1"))
+ '((default :inherit font-lock-comment-face))
"Font Lock mode face used to highlight comment delimiters."
:group 'font-lock-faces)
@@ -1904,7 +1899,7 @@ Sets various variables using `font-lock-defaults' and
(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 "MediumOrchid4"))
+ (((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"))
diff --git a/lisp/frame.el b/lisp/frame.el
index a95e91c8eeb..d6f82750347 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -95,96 +95,6 @@ appended when the minibuffer frame is created."
(sexp :tag "Value")))
:group 'frames)
-(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.
-
-Since `pop-up-frame-function' is used by `display-buffer' for
-making new frames, any value specified here by default affects
-the automatic generation of new frames via `display-buffer' and
-all functions based on it. The behavior of `make-frame' is not
-affected by this variable."
- :type '(repeat (cons :format "%v"
- (symbol :tag "Parameter")
- (sexp :tag "Value")))
- :group 'frames)
-
-(defcustom pop-up-frame-function
- (lambda () (make-frame pop-up-frame-alist))
- "Function used by `display-buffer' for creating a new frame.
-This function is called with no arguments and should return a new
-frame. The default value calls `make-frame' with the argument
-`pop-up-frame-alist'."
- :type 'function
- :group 'frames)
-
-(defcustom special-display-frame-alist
- '((height . 14) (width . 80) (unsplittable . t))
- "Alist of parameters for special frames.
-Special frames are used for buffers whose names are listed in
-`special-display-buffer-names' and for buffers whose names match
-one of the regular expressions in `special-display-regexps'.
-
-This variable can be set in your init file, like this:
-
- (setq special-display-frame-alist '((width . 80) (height . 20)))
-
-These supersede the values given in `default-frame-alist'."
- :type '(repeat (cons :format "%v"
- (symbol :tag "Parameter")
- (sexp :tag "Value")))
- :group 'frames)
-
-(defun special-display-popup-frame (buffer &optional args)
- "Display BUFFER and return the window chosen.
-If BUFFER is already displayed in a visible or iconified frame,
-raise that frame. Otherwise, display BUFFER in a new frame.
-
-Optional argument ARGS is a list specifying additional
-information.
-
-If ARGS is an alist, use it as a list of frame parameters. If
-these parameters contain \(same-window . t), display BUFFER in
-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."
- (if (and args (symbolp (car args)))
- (apply (car args) buffer (cdr args))
- (let ((window (get-buffer-window buffer 0)))
- (or
- ;; If we have a window already, make it visible.
- (when window
- (let ((frame (window-frame window)))
- (make-frame-visible frame)
- (raise-frame frame)
- window))
- ;; Reuse the current window if the user requested it.
- (when (cdr (assq 'same-window args))
- (condition-case nil
- (progn (switch-to-buffer buffer) (selected-window))
- (error nil)))
- ;; Stay on the same frame if requested.
- (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
- (let* ((pop-up-windows t)
- pop-up-frames
- special-display-buffer-names special-display-regexps)
- (display-buffer buffer)))
- ;; If no window yet, make one in a new frame.
- (let ((frame
- (with-current-buffer buffer
- (make-frame (append args special-display-frame-alist)))))
- (set-window-buffer (frame-selected-window frame) buffer)
- (set-window-dedicated-p (frame-selected-window frame) t)
- (frame-selected-window frame))))))
-
(defun handle-delete-frame (event)
"Handle delete-frame events from the X server."
(interactive "e")
@@ -937,6 +847,116 @@ If there is no frame by that name, signal an error."
(if frame
(select-frame-set-input-focus frame)
(error "There is no frame named `%s'" name))))
+
+
+;;;; Background mode.
+
+(defcustom frame-background-mode nil
+ "The brightness of the background.
+Set this to the symbol `dark' if your background color is dark,
+`light' if your background is light, or nil (automatic by default)
+if you want Emacs to examine the brightness for you. Don't set this
+variable with `setq'; this won't have the expected effect."
+ :group 'faces
+ :set #'(lambda (var value)
+ (set-default var value)
+ (mapc 'frame-set-background-mode (frame-list)))
+ :initialize 'custom-initialize-changed
+ :type '(choice (const dark)
+ (const light)
+ (const :tag "automatic" nil)))
+
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
+
+(defvar inhibit-frame-set-background-mode nil)
+
+(defun frame-set-background-mode (frame &optional keep-face-specs)
+ "Set up display-dependent faces on FRAME.
+Display-dependent faces are those which have different definitions
+according to the `background-mode' and `display-type' frame parameters.
+
+If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
+face specs for the new background mode."
+ (unless inhibit-frame-set-background-mode
+ (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
+ (bg-color (frame-parameter frame 'background-color))
+ (tty-type (tty-type frame))
+ (default-bg-mode
+ (if (or (window-system frame)
+ (and tty-type
+ (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
+ tty-type)))
+ 'light
+ 'dark))
+ (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
+ (bg-mode
+ (cond (frame-default-bg-mode)
+ ((equal bg-color "unspecified-fg") ; inverted colors
+ non-default-bg-mode)
+ ((not (color-values bg-color frame))
+ default-bg-mode)
+ ((>= (apply '+ (color-values bg-color frame))
+ ;; Just looking at the screen, colors whose
+ ;; values add up to .6 of the white total
+ ;; still look dark to me.
+ (* (apply '+ (color-values "white" frame)) .6))
+ 'light)
+ (t 'dark)))
+ (display-type
+ (cond ((null (window-system frame))
+ (if (tty-display-color-p frame) 'color 'mono))
+ ((display-color-p frame)
+ 'color)
+ ((x-display-grayscale-p frame)
+ 'grayscale)
+ (t 'mono)))
+ (old-bg-mode
+ (frame-parameter frame 'background-mode))
+ (old-display-type
+ (frame-parameter frame 'display-type)))
+
+ (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
+ (let ((locally-modified-faces nil)
+ ;; Prevent face-spec-recalc from calling this function
+ ;; again, resulting in a loop (bug#911).
+ (inhibit-frame-set-background-mode t)
+ (params (list (cons 'background-mode bg-mode)
+ (cons 'display-type display-type))))
+ (if keep-face-specs
+ (modify-frame-parameters frame params)
+ ;; If we are recomputing face specs, first collect a list
+ ;; of faces that don't match their face-specs. These are
+ ;; the faces modified on FRAME, and we avoid changing them
+ ;; below. Use a negative list to avoid consing (we assume
+ ;; most faces are unmodified).
+ (dolist (face (face-list))
+ (and (not (get face 'face-override-spec))
+ (not (face-spec-match-p face
+ (face-user-default-spec face)
+ (selected-frame)))
+ (push face locally-modified-faces)))
+ ;; Now change to the new frame parameters
+ (modify-frame-parameters frame params)
+ ;; For all unmodified named faces, choose face specs
+ ;; matching the new frame parameters.
+ (dolist (face (face-list))
+ (unless (memq face locally-modified-faces)
+ (face-spec-recalc face frame)))))))))
+
+(defun frame-terminal-default-bg-mode (frame)
+ "Return the default background mode of FRAME.
+This checks the `frame-background-mode' variable, the X resource
+named \"backgroundMode\" (if FRAME is an X frame), and finally
+the `background-mode' terminal parameter."
+ (or frame-background-mode
+ (let ((bg-resource
+ (and (window-system frame)
+ (x-get-resource "backgroundMode" "BackgroundMode"))))
+ (if bg-resource
+ (intern (downcase bg-resource))))
+ (terminal-parameter frame 'background-mode)))
+
;;;; Frame configurations
diff --git a/lisp/fringe.el b/lisp/fringe.el
index ce24bb60100..fa5ebb6f0c6 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -192,7 +192,7 @@ frame parameter is used."
(concat
"Select fringe mode for "
(if all-frames "all frames" "selected frame")
- " (type ? for list): ")
+ ": ")
fringe-styles nil t))
(style (assoc (downcase mode) fringe-styles)))
(if style (cdr style)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 5f7cd9f546b..7c887dc5450 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,566 @@
+2011-07-14 Andrew Cohen <cohen@andy.bu.edu>
+
+ * nnimap.el (nnimap-request-thread): Ensure search is performed in
+ correct group.
+
+ * gnus-int.el (gnus-request-thread): Add group argument.
+
+ * gnus-sum.el (gnus-request-thread): Use it.
+
+2011-07-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): `debbugs-*'
+ renamed to `debbugs-gnu-*'.
+
+2011-07-08 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el: Revert the editing feature since it is not urgent.
+ (plstore-mode, plstore-mode-toggle-display, plstore-mode-original)
+ (plstore-mode-decoded): Remove.
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-bug): Don't insert user variables. It usually
+ isn't very interesting any more, and it leaks potentially secret data.
+ (gnus-debug): Removed.
+
+ * gnus-art.el (gnus-ignored-headers): Removed obsolete and non-working
+ use of :custom-show.
+
+2011-07-07 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el: Add documentation.
+ (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.
+
+2011-07-06 Glenn Morris <rgm@gnu.org>
+
+ * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Silence compiler.
+
+2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-refer-article-method): Remove mention of nnspool, which
+ no longer is much used.
+ (gnus-summary-line-format): Link to "Marking Articles" instead of "Read
+ Articles".
+
+2011-04-03 Kan-Ru Chen <kanru@kanru.info>
+
+ * nnir.el (nnir-notmuch-program, nnir-notmuch-additional-switches)
+ (nnir-notmuch-remove-prefix, nnir-engines, nnir-run-notmuch): New nnir
+ `notmuch' backend.
+
+2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-text-html-renderer): Doc fix.
+
+ * gnus-msg.el (gnus-bug): Fix the MML tag.
+
+ * pop3.el (pop3-open-server): -ERR is a valid response to CAPA.
+
+2011-07-05 Daiki Ueno <ueno@unixuser.org>
+
+ * gnus-start.el (gnus-get-unread-articles): Don't connect to the
+ secondary methods if started with `gnus-no-server'.
+
+2011-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * message.el (message-return-action): Fix typo in docstring.
+
+2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-read-ephemeral-bug-group): Allow fetching several
+ bug reports at once.
+
+ * nnimap.el (nnimap-request-scan): Say that splitting has finished.
+
+2011-07-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nndraft.el: Require gnus-group.
+ (nndraft-request-list): Declare.
+
+ * nndraft.el (nndraft-update-unread-articles): Don't show group having
+ no unread article unless it matches gnus-permanently-visible-groups.
+
+ * nndraft.el (nndraft-update-unread-articles): New function.
+ (nndraft-request-associate-buffer): Use it to update the number of
+ unread articles for the nndraft groups in the group buffer when saving
+ or killing a draft message.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-read-ephemeral-bug-group): Bind the coding
+ systems to binary before writing and reading the mbox files.
+
+ * gnus.el (gnus-summary-line-format): Link to the info node for %U
+ instead of trying to list them all (bug#8978).
+
+2011-07-03 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
+
+ * pop3.el (pop3-open-server): Use :end-of-capability.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Make sure that
+ the id is always a number.
+
+ * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Hook into
+ debbugs mode, if possible.
+
+2011-07-02 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el (auth-source-token-passphrase-callback-function):
+ Reindent.
+ (epg-context-operation): Remove unnecessary autoload.
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-list-debbugs): New command.
+
+ * gnus-group.el (gnus-bug-group-download-format-alist): Get the
+ mboxstat instead of the maintbox, since the stat seems to be fuller.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Don't try to select dead
+ summary buffers.
+
+ * message.el (message-get-reply-headers): Delete all duplicates,
+ instead of the first.
+ (message-get-reply-headers): Ensure that we have progress while
+ deleting duplicates.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Get the local
+ gnus-posting-style value from the summary buffer to make it easier to
+ make that a per-buffer conf.
+
+2011-07-02 Andrew Cohen <cohen@andy.bu.edu>
+
+ * nnir.el (nnir-run-imap): Allow halting a search when an article is
+ found by setting `shortcut' in 'query.
+ (nnir-request-article): Use `shortcut' setting when requesting article
+ by Message-ID.
+
+2011-07-02 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-msg.el (gnus-bug): Give the Version and Package headers to
+ debbugs with the X-Debbugs-Package and X-Debbugs-Version headers.
+ Bring the pseudo-headers back too.
+
+2011-07-01 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el (auth-source-token-passphrase-callback-function):
+ Simplify and remove EPA dependency.
+
+2011-07-01 Andrew Cohen <cohen@andy.bu.edu>
+
+ * nnir.el (nnir-request-article): Fix error message text.
+
+2011-07-01 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el (plstore-delete): Autoload.
+ (auth-source-plstore-search): Support delete operation.
+ * plstore.el (plstore-delete): New function.
+
+2011-07-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-draft.el (gnus-draft-clear-marks): Revert last change;
+ mark actually existing articles as unread rather than the ones that
+ active asserts.
+
+2011-07-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * nntp.el (nntp-record-command):
+ * gnus-util.el (gnus-message-with-timestamp-1):
+ Use format-time-string rather than decoding time stamps by hand.
+ This is simpler and insulates the code from potential changes to
+ current-time format.
+
+2011-07-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-draft.el (gnus-draft-clear-marks): Mark deleted articles as read.
+
+2011-07-01 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el (plstore-select-keys, plstore-encrypt-to): New variable.
+ (plstore-save): Support public key encryption.
+ (plstore--init-from-buffer): New function.
+ (plstore-open): Use it; fix error when opening a non-existent file.
+ (plstore-revert): Use plstore--init-from-buffer.
+
+2011-07-01 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el (auth-source-backend): Fix :initarg for data slot.
+
+2011-06-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mml2015.el (mml2015-use): Replace string-match-p with string-match
+ for old Emacsen.
+
+2011-06-30 Daiki Ueno <ueno@unixuser.org>
+
+ * mml2015.el (mml2015-use): Don't try to load PGG on Emacs 24, when EPG
+ is not fully working.
+
+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.
+
+ * auth-source.el (epg-context-set-passphrase-callback): Remove
+ duplicate autoload.
+
+2011-06-30 Andrew Cohen <cohen@andy.bu.edu>
+
+ * nnir.el (nnir-request-article): Allow requesting articles by
+ Message-ID with nnimap.
+
+ * gnus-sum.el (gnus-refer-article-methods): Allow (nnir) entry to use
+ current server.
+
+2011-06-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el: Autoload EPA/EPG functions.
+ (auth-source-netrc-use-gpg-tokens): Clarify that it should not be
+ changed when EPA/EPG is not available.
+ (auth-source-backend): Rename "arg" member to "data".
+ (auth-source-backend-parse, auth-source-plstore-search)
+ (auth-source-plstore-create): Use it.
+
+2011-06-30 Andrew Cohen <cohen@andy.bu.edu>
+
+ * gnus-art.el (gnus-request-article-this-buffer): Use existing function
+ `gnus-refer-article-methods'.
+
+2011-06-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el: Require EPA and EPG.
+ (auth-source-passphrase-alist): New variable.
+ (auth-source-passphrase-callback-function)
+ (auth-source-token-passphrase-callback-function): Callbacks for the
+ netrc field encryption (GPG tokens).
+ (auth-source-epa-extract-gpg-token, auth-source-epa-make-gpg-token):
+ Symmetric encryption and decryption of the netrc GPG tokens.
+ (auth-source-netrc-normalize): Use them, simplifying the closure.
+
+2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-split-incoming-mail): If `nnimap-split-fancy' is
+ non-nil, and `nnimap-split-methods' is nil, use the former.
+
+2011-06-30 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el (plstore-revert): New function.
+ (plstore-open): Use it; hide the buffer from user.
+
+2011-06-30 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el (auth-source-backend): New member "arg".
+ (auth-source-backend-parse): Handle new backend 'plstore.
+ * plstore.el: New file.
+
+2011-06-30 Glenn Morris <rgm@gnu.org>
+
+ * gnus-fun.el (gnus-convert-image-to-x-face-command): Doc fix.
+
+ * mm-util.el (mm-charset-synonym-alist): Move definition before use.
+
+2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-process-expiry-targets): Say what target we're
+ expiring articles to.
+
+ * mm-util.el (mm-charset-to-coding-system): Recognise all ANSI.x3.4
+ variations as ASCII (bug#5458).
+
+2011-06-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnmh.el (nnmh-request-list-1): Work on MS Windows.
+
+2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-point-in-header-p): Tweak the function to default
+ to saying that we're not in the headers if there is no separator at
+ all. This makes it possible to use the Message version of `M-q' in
+ buffers with no headers (bug#7987).
+ (message-point-in-header-p): Fix last checkin to work with an empty
+ mail-header-separator, too.
+
+ * auth-source.el (auth-source-netrc-saver): If the user says "don't ask
+ again, save the choice via customize.
+
+2011-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-send-mail-function): Add `sendmail-query-once'.
+
+ * nnimap.el (nnimap-finish-retrieve-group-infos): If the server has
+ ended the connection, bail out before waiting infinitely on a new
+ connection.
+
+2011-06-28 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-msg.el (gnus-bug): Add Package and Version pseudo-headers to bug
+ reports.
+
+ * gnus.el (gnus-bug-package): Use "gnus."
+ (gnus-maintainer): Direct bug reports to submit@debbugs.gnu.org.
+
+2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-stop-animations): New function to stop any
+ animations going on at article exit time.
+
+ * gnus-registry.el (gnus-registry-user-format-function-M): Reinstate,
+ since removing it breaks people upgrading.
+
+ * shr.el (shr-put-image): Use the new interface for animating images.
+ (shr-put-image): Animate for 60 seconds.
+
+ * auth-source.el (with-auth-source-epa-overrides): Fix compilation
+ error with `find-file-hooks' on Emacs 22.
+ (with-auth-source-epa-overrides): Ugly hack to Wrap the
+ `find-file-hook' things in `symbol-value' to avoid compilation warnings
+ on all architectures.
+
+ * spam.el (spam-stat): Require in a normal fashion without binding
+ `spam-stat-install-hooks' to avoid compilation warnings.
+
+ * spam-stat.el (spam-stat-install-hooks): Removed.
+ (spam-stat-install-hooks): Don't run automatically.
+
+2011-06-26 Timo Juhani Lindfors <timo.lindfors@iki.fi> (tiny change)
+
+ * gnus-msg.el (gnus-summary-reply-to-list-with-original): New command
+ and keystroke.
+
+2011-06-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * auth-source.el (auth-source-netrc-cache): Move forward.
+
+2011-06-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * auth-source.el (auth-source-netrc-create): Don't query the bits that
+ we already know.
+ (auth-source-forget-all-cached): Clear auth-source-netrc-cache, too.
+ (auth-source-netrc-create): Don't prompt for the stuff we already know.
+
+2011-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * auth-source.el (auth-source-netrc-create): Don't print all tokens in
+ %S format, since that looks odd.
+ (auth-sources): Prefer the ~/.authinfo file over the ~/.authinfo.gpg
+ file, especially when saving.
+
+2011-06-21 Andrew Cohen <cohen@andy.bu.edu>
+
+ * nnimap.el (nnimap-find-article-by-message-id): return nil when no
+ article found.
+
+2011-06-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el (auth-source-netrc-use-gpg-tokens): Replace
+ `auth-source-save-secrets' with a more sensitive alist that can be
+ configured per file. Experimental, so defaults to 'never.
+ (auth-source-netrc-create): Use it. Still experimental code.
+ (with-auth-source-epa-overrides): Use `find-file-hooks' if
+ `find-file-hook' is unbound (XEmacs fix). Fix backquoting bug.
+
+2011-06-16 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el (auth-source-save-secrets): New variable to control if
+ secret tokens should be saved encrypted.
+ (auth-source-netrc-parse, auth-source-netrc-search): Pass the file name
+ to `auth-source-netrc-normalize'.
+ (with-auth-source-epa-overrides): Add convenience macro. Don't depend
+ on the EPA variables being defined.
+ (auth-source-epa-make-gpg-token): Convert text to a "gpg:" token.
+ (auth-source-netrc-normalize): Convert "gpg:" tokens back to text in
+ the lexical-let closure.
+ (auth-source-netrc-create): Create "gpg:" tokens according to
+ `auth-source-save-secrets'.
+
+2011-06-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-group.el (gnus-group-update-group): Add new argument
+ `info-unchanged' that stops updating dribble buffer.
+
+ * gnus-start.el (gnus-dribble-enter): Add new argument `regexp' that
+ deletes lines matching to it in dribble buffer.
+
+ * gnus-agent.el (gnus-agent-fetch-group-1):
+ * gnus-group.el (gnus-group-update-group-line, gnus-group-make-group):
+ * gnus-srvr.el (gnus-server-update-server, gnus-server-set-info):
+ * gnus-start.el (gnus-group-change-level):
+ * gnus-sum.el (gnus-summary-move-article): Delete old dribble entry.
+
+ * gnus-sum.el (gnus-summary-update-info): Don't update dribble buffer
+ if newsgroup info is not changed.
+
+ * gnus-group.el (gnus-group-get-new-news-this-group):
+ * gnus-sum.el (gnus-summary-read-group-1, gnus-summary-exit-no-update):
+ Don't update dribble buffer.
+
+2011-06-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-remove-ignored): New function to
+ remove entries with groups we ignore.
+
+2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-rescale-image): Add an :ascent of 100 to images so that
+ the underline comes at the bottom.
+
+2011-05-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-article-marks-to-chars): Rename from
+ `gnus-registry-user-format-function-M' and declare the latter obsolete.
+ (gnus-registry-article-marks-to-names): Rename from
+ `gnus-registry-user-format-function-M2'.
+
+2011-05-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-exit): Make sure to kill article buffer in
+ ephemeral group.
+
+2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-browse-image): Copy the URL if called interactively.
+
+2011-05-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-mark-article-read): It's possible that we
+ want to have `gnus-newsgroup-unselected' kept sorted. If this isn't
+ done, then unselected articles may be marked as read.
+
+ * pop3.el (pop3-open-server): Erase the buffer after the greeting,
+ since not doing this seems to lead to a race condition in pop3-logon.
+
+ * nnvirtual.el (nnvirtual-request-article): Bind `gnus-command-method'
+ so that the call chain it correct when we call "upwards".
+
+ * gnus-sum.el (gnus-select-newsgroup): Auto-expiry doesn't make sense
+ in read-only groups.
+
+ * gnus-group.el (gnus-group-mark-article-read): Ditto.
+
+ * message.el (message-cite-reply-position): Doc string fix.
+
+ * nnimap.el (nnimap-transform-headers): Simplify regexp to hopefully
+ avoid regexp overflow.
+ (nnimap-transform-split-mail): Ditto.
+
+ * pop3.el (pop3-retr): Error out if the server closes the connection.
+
+2011-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mml1991.el (mml1991-mailcrypt-encrypt): Remove use of ill-designed
+ mm-with-unibyte-current-buffer. The buffer should not contain any
+ multibyte chars anyway at this stage.
+
+2011-05-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-urlify): Use shr-add-font to make underlines be less ugly
+ at the end of lines.
+
+2011-05-29 Julien Danjou <julien@danjou.info>
+
+ * smiley.el (gnus-smiley-file-types): Add gif as supported file type.
+
+2011-05-27 Glenn Morris <rgm@gnu.org>
+
+ * gnus-group.el (gnus-bug-group-download-format-alist):
+ Use the "maintainer" version of debian reports as well.
+
+2011-05-26 Glenn Morris <rgm@gnu.org>
+
+ * gnus-group.el (gnus-bug-group-download-format-alist):
+ Use the "maintainer" version of debbugs.gnu.org reports.
+
+2011-05-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-delete-part): Fix mm-handle-filename usage.
+
+2011-05-20 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sum.el (gnus-summary-hide-thread): Fix bug where moving to hide
+ the thread moves us backwards and so we loop forever.
+
+2011-05-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Allow leading
+ whitespace in base64 data lines.
+
+2011-05-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-user-format-function-M):
+ Use `mapconcat'.
+ (gnus-registry-user-format-function-M2): Use to see the full text of
+ the marks. Make "," the mark text separator.
+
+ * nntp.el (nntp-send-authinfo): Use the "force" token for NNTP
+ authentication with auth-source.
+
+2011-05-17 Glenn Morris <rgm@gnu.org>
+
+ * gnus-group.el (gnus-import-other-newsrc-file):
+ Use insert-file-contents.
+
+2011-05-16 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sum.el (gnus-summary-hide-all-threads): Add update message every
+ 1000 iterations.
+
+2011-05-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-open-connection): Check if process-type is available.
+
+2011-05-16 Julien Danjou <julien@danjou.info>
+
+ * shr.el (shr-tag-del): Add support for del tag.
+
+2011-05-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-html.el (gnus-html-put-image): Register a displayer.
+
+ * shr.el (shr-image-displayer): Don't remove text props from alt text.
+
+2011-05-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * registry.el (prune-factor): New initialization parameter defaulting
+ to 0.1.
+ (registry-prune-hard): Use it.
+
+ * gnus-registry.el (gnus-registry-fixup-registry): Set prune-factor to
+ 0.1 expicitly.
+
+2011-05-13 Glenn Morris <rgm@gnu.org>
+
+ * message.el (message-send-mail-with-sendmail): Assume sendmail-program
+ is bound, since this function requires sendmail.
+
+2011-05-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * registry.el (registry-usage-test): Disable pruning test.
+
+2011-05-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * registry.el (registry-prune-hard-candidates)
+ (registry-prune-soft-candidates): Helper methods for registry pruning.
+ (registry-prune): Use them. Make the sort function optional.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ * shr.el (shr-colorize-region): Fix typo "on on -> on".
+
+2011-05-10 Julien Danjou <julien@danjou.info>
+
+ * shr.el (shr-put-color-1): Do not bug out when old-props is a face
+ symbol and not a list.
+
2011-05-10 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-mode): Move binding of
@@ -308,12 +871,6 @@
* Makefile.in (fail-on-warning): New rule to compile with warnings as
errors.
- * dgnushack.el (dgnushack-compile-error-on-warn): New function to call
- dgnushack-compile with error-on-warn enabled, and to signal an error if
- clean compilation failed.
- (dgnushack-compile): New argument 'error-on-warn'. If non-nil, compile
- with `byte-compile-error-on-warn'. Return nil if errors occured.
-
2011-04-06 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el: Don't use ERT if it's not available. Load it
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 4882032f284..779c84296f4 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -9243,7 +9243,7 @@
(nnmaildir--with-nntp-buffer, nnmaildir--with-work-buffer,
nnmaildir--with-nov-buffer, nnmaildir--with-move-buffer,
nnmaildir--group-ls): New macros/functions. Use them.
- (nnmaildir--unlink): Evalutate argument only once.
+ (nnmaildir--unlink): Evaluate argument only once.
2002-03-27 Jesper Harder <harder@ifa.au.dk>
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index e0bea324a25..e249e97e826 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -43,6 +43,7 @@
(require 'mm-util)
(require 'gnus-util)
(require 'assoc)
+
(eval-when-compile (require 'cl))
(require 'eieio)
@@ -56,6 +57,19 @@
(autoload 'rfc2104-hash "rfc2104")
+(autoload 'plstore-open "plstore")
+(autoload 'plstore-find "plstore")
+(autoload 'plstore-put "plstore")
+(autoload 'plstore-delete "plstore")
+(autoload 'plstore-save "plstore")
+(autoload 'plstore-get-file "plstore")
+
+(autoload 'epg-make-context "epg")
+(autoload 'epg-context-set-passphrase-callback "epg")
+(autoload 'epg-decrypt-string "epg")
+(autoload 'epg-context-set-armor "epg")
+(autoload 'epg-encrypt-string "epg")
+
(defvar secrets-enabled)
(defgroup auth-source nil
@@ -75,6 +89,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.
(defclass auth-source-backend ()
((type :initarg :type
:initform 'netrc
@@ -100,6 +117,9 @@ let-binding."
:type t
:custom string
:documentation "The backend protocol.")
+ (data :initarg :data
+ :initform nil
+ :documentation "Internal backend data.")
(create-function :initarg :create-function
:initform ignore
:type function
@@ -154,6 +174,32 @@ let-binding."
(const :tag "Never save" nil)
(const :tag "Ask" ask)))
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+
+(defcustom auth-source-netrc-use-gpg-tokens 'never
+ "Set this to tell auth-source when to create GPG password
+tokens in netrc files. It's either an alist or `never'.
+Note that if EPA/EPG is not available, this should NOT be used."
+ :group 'auth-source
+ :version "23.2" ;; No Gnus
+ :type `(choice
+ (const :tag "Always use GPG password tokens" (t gpg))
+ (const :tag "Never use GPG password tokens" never)
+ (repeat :tag "Use a lookup list"
+ (list
+ (choice :tag "Matcher"
+ (const :tag "Match anything" t)
+ (const :tag "The EPA encrypted file extensions"
+ ,(if (boundp 'epa-file-auto-mode-alist-entry)
+ (car (symbol-value
+ 'epa-file-auto-mode-alist-entry))
+ "\\.gpg\\'"))
+ (regexp :tag "Regular expression"))
+ (choice :tag "What to do"
+ (const :tag "Save GPG-encrypted password tokens" gpg)
+ (const :tag "Don't encrypt tokens" never))))))
+
(defvar auth-source-magic "auth-source-magic ")
(defcustom auth-source-do-cache t
@@ -183,7 +229,7 @@ If the value is a function, debug messages are logged by calling
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
-(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
+(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
"List of authentication sources.
The default will get login and password information from
@@ -237,9 +283,11 @@ can get pretty complex."
,@auth-source-protocols-customize))
(list :tag "User" :inline t
(const :format "" :value :user)
- (choice :tag "Personality/Username"
- (const :tag "Any" t)
- (string :tag "Name")))))))))
+ (choice
+ :tag "Personality/Username"
+ (const :tag "Any" t)
+ (string
+ :tag "Name")))))))))
(defcustom auth-source-gpg-encrypt-to t
"List of recipient keys that `authinfo.gpg' encrypted to.
@@ -280,8 +328,8 @@ If the value is not a list, symmetric encryption will be used."
(defun auth-source-do-warn (&rest msg)
(apply
- ;; set logger to either the function in auth-source-debug or 'message
- ;; note that it will be 'message if auth-source-debug is nil
+ ;; set logger to either the function in auth-source-debug or 'message
+ ;; note that it will be 'message if auth-source-debug is nil
(if (functionp auth-source-debug)
auth-source-debug
'message)
@@ -348,12 +396,20 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
;; a file name with parameters
((stringp (plist-get entry :source))
- (auth-source-backend
- (plist-get entry :source)
- :source (plist-get entry :source)
- :type 'netrc
- :search-function 'auth-source-netrc-search
- :create-function 'auth-source-netrc-create))
+ (if (equal (file-name-extension (plist-get entry :source)) "plist")
+ (auth-source-backend
+ (plist-get entry :source)
+ :source (plist-get entry :source)
+ :type 'plstore
+ :search-function 'auth-source-plstore-search
+ :create-function 'auth-source-plstore-create
+ :data (plstore-open (plist-get entry :source)))
+ (auth-source-backend
+ (plist-get entry :source)
+ :source (plist-get entry :source)
+ :type 'netrc
+ :search-function 'auth-source-netrc-search
+ :create-function 'auth-source-netrc-create)))
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
@@ -627,7 +683,7 @@ must call it to obtain the actual value."
(when auth-source-do-cache
(auth-source-remember spec found)))
- found))
+ found))
(defun auth-source-search-backends (backends spec max create delete require)
(let (matches)
@@ -678,6 +734,8 @@ Returns the deleted entries."
(equal collection value)
(member value collection)))
+(defvar auth-source-netrc-cache nil)
+
(defun auth-source-forget-all-cached ()
"Forget all cached auth-source data."
(interactive)
@@ -686,7 +744,8 @@ Returns the deleted entries."
when (string-match (concat "^" auth-source-magic)
(symbol-name sym))
;; remove that key
- do (password-cache-remove (symbol-name sym))))
+ do (password-cache-remove (symbol-name sym)))
+ (setq auth-source-netrc-cache nil))
(defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC."
@@ -746,7 +805,7 @@ while \(:host t) would find all host entries."
(defun auth-source-specmatchp (spec stored)
(let ((keys (loop for i below (length spec) by 2
- collect (nth i spec))))
+ collect (nth i spec))))
(not (eq
(dolist (key keys)
(unless (auth-source-search-collection (plist-get stored key)
@@ -781,15 +840,13 @@ while \(:host t) would find all host entries."
(unless (listp values)
(setq values (list values)))
(mapcar (lambda (value)
- (if (numberp value)
- (format "%s" value)
- value))
- values))
+ (if (numberp value)
+ (format "%s" value)
+ value))
+ values))
;;; Backend specific parsing: netrc/authinfo backend
-(defvar auth-source-netrc-cache nil)
-
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
spec
@@ -831,7 +888,7 @@ Note that the MAX parameter is used so we can exit the parse early."
(base64-encode-string
(buffer-string)))))
(lambda () (base64-decode-string
- (rot13-string v)))))))
+ (rot13-string v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
@@ -898,7 +955,7 @@ Note that the MAX parameter is used so we can exit the parse early."
(null require)
;; every element of require is in the normalized list
(let ((normalized (nth 0 (auth-source-netrc-normalize
- (list alist)))))
+ (list alist) file))))
(loop for req in require
always (plist-get normalized req)))))
(decf max)
@@ -934,7 +991,61 @@ Note that the MAX parameter is used so we can exit the parse early."
(nreverse result))))))
-(defun auth-source-netrc-normalize (alist)
+(defvar auth-source-passphrase-alist nil)
+
+(defun auth-source-token-passphrase-callback-function (context key-id file)
+ (let* ((file (file-truename file))
+ (entry (assoc file auth-source-passphrase-alist))
+ passphrase)
+ ;; return the saved passphrase, calling a function if needed
+ (or (copy-sequence (if (functionp (cdr entry))
+ (funcall (cdr entry))
+ (cdr entry)))
+ (progn
+ (unless entry
+ (setq entry (list file))
+ (push entry auth-source-passphrase-alist))
+ (setq passphrase
+ (read-passwd
+ (format "Passphrase for %s tokens: " file)
+ t))
+ (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
+ (lambda () p)))
+ passphrase))))
+
+;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
+(defun auth-source-epa-extract-gpg-token (secret file)
+ "Pass either the decoded SECRET or the gpg:BASE64DATA version.
+FILE is the file from which we obtained this token."
+ (when (string-match "^gpg:\\(.+\\)" secret)
+ (setq secret (base64-decode-string (match-string 1 secret))))
+ (let ((context (epg-make-context 'OpenPGP))
+ plain)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'auth-source-token-passphrase-callback-function
+ file))
+ (epg-decrypt-string context secret)))
+
+;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
+(defun auth-source-epa-make-gpg-token (secret file)
+ (let ((context (epg-make-context 'OpenPGP))
+ (pp-escape-newlines nil)
+ cipher)
+ (epg-context-set-armor context t)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'auth-source-token-passphrase-callback-function
+ file))
+ (setq cipher (epg-encrypt-string context secret nil))
+ (with-temp-buffer
+ (insert cipher)
+ (base64-encode-region (point-min) (point-max) t)
+ (concat "gpg:" (buffer-substring-no-properties
+ (point-min)
+ (point-max))))))
+
+(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)
(let (ret item)
(while (setq item (pop entry))
@@ -950,13 +1061,25 @@ Note that the MAX parameter is used so we can exit the parse early."
;; send back the secret in a function (lexical binding)
(when (equal k "secret")
- (setq v (lexical-let ((v v))
- (lambda () v))))
-
+ (setq v (lexical-let ((lexv v)
+ (token-decoder nil))
+ (when (string-match "^gpg:" lexv)
+ ;; it's a GPG token: create a token decoder
+ ;; which unsets itself once
+ (setq token-decoder
+ (lambda (val)
+ (prog1
+ (auth-source-epa-extract-gpg-token
+ val
+ filename)
+ (setq token-decoder nil)))))
+ (lambda ()
+ (when token-decoder
+ (setq lexv (funcall token-decoder lexv)))
+ lexv))))
(setq ret (plist-put ret
(intern (concat ":" k))
- v))
- ))
+ v))))
ret))
alist))
@@ -968,7 +1091,7 @@ Note that the MAX parameter is used so we can exit the parse early."
&key backend require create delete
type max host user port
&allow-other-keys)
-"Given a property list SPEC, return search matches from the :backend.
+ "Given a property list SPEC, return search matches from the :backend.
See `auth-source-search' for details on SPEC."
;; just in case, check that the type is correct (null or same as the backend)
(assert (or (null type) (eq type (oref backend type)))
@@ -982,7 +1105,8 @@ See `auth-source-search' for details on SPEC."
:file (oref backend source)
:host (or host t)
:user (or user t)
- :port (or port t)))))
+ :port (or port t))
+ (oref backend source))))
;; if we need to create an entry AND none were found to match
(when (and create
@@ -1017,6 +1141,9 @@ See `auth-source-search' for details on SPEC."
;; we know (because of an assertion in auth-source-search) that the
;; :create parameter is either t or a list (which includes nil)
(create-extra (if (eq t create) nil create))
+ (current-data (car (auth-source-search :max 1
+ :host host
+ :port port)))
(required (append base-required create-extra))
(file (oref backend source))
(add "")
@@ -1051,7 +1178,9 @@ See `auth-source-search' for details on SPEC."
(dolist (r required)
(let* ((data (aget valist r))
;; take the first element if the data is a list
- (data (auth-source-netrc-element-or-first data))
+ (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))
;; the default supplementals are simple:
@@ -1098,7 +1227,36 @@ See `auth-source-search' for details on SPEC."
(cond
((and (null data) (eq r 'secret))
;; Special case prompt for passwords.
- (read-passwd prompt))
+ ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
+ ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+ (let* ((ep (format "Use GPG password tokens in %s?" file))
+ (gpg-encrypt
+ (cond
+ ((eq auth-source-netrc-use-gpg-tokens 'never)
+ 'never)
+ ((listp auth-source-netrc-use-gpg-tokens)
+ (let ((check (copy-sequence
+ auth-source-netrc-use-gpg-tokens))
+ item ret)
+ (while check
+ (setq item (pop check))
+ (when (or (eq (car item) t)
+ (string-match (car item) file))
+ (setq ret (cdr item))
+ (setq check nil)))))
+ (t 'never)))
+ (plain (read-passwd prompt)))
+ ;; ask if we don't know what to do (in which case
+ ;; auth-source-netrc-use-gpg-tokens must be a list)
+ (unless gpg-encrypt
+ (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
+ ;; TODO: save the defcustom now? or ask?
+ (setq auth-source-netrc-use-gpg-tokens
+ (cons `(,file ,gpg-encrypt)
+ auth-source-netrc-use-gpg-tokens)))
+ (if (eq gpg-encrypt 'gpg)
+ (auth-source-epa-make-gpg-token plain file)
+ plain)))
((null data)
(when default
(setq prompt
@@ -1125,7 +1283,7 @@ See `auth-source-search' for details on SPEC."
(let ((printer (lambda ()
;; append the key (the symbol name of r)
;; and the value in r
- (format "%s%s %S"
+ (format "%s%s %s"
;; prepend a space
(if (zerop (length add)) "" " ")
;; remap auth-source tokens to netrc
@@ -1135,8 +1293,9 @@ See `auth-source-search' for details on SPEC."
(secret "password")
(port "port") ; redundant but clearer
(t (symbol-name r)))
- ;; the value will be printed in %S format
- data))))
+ (if (string-match "[\" ]" data)
+ (format "%S" data)
+ data)))))
(setq add (concat add (funcall printer)))))))
(plist-put
@@ -1198,9 +1357,10 @@ Respects `auth-source-save-behavior'. Uses
(help-mode))))
(?n (setq add ""
done t))
- (?N (setq add ""
- done t
- auth-source-save-behavior nil))
+ (?N
+ (setq add ""
+ done t)
+ (customize-save-variable 'auth-source-save-behavior nil))
(?e (setq add (read-string "Line to add: " add)))
(t nil)))
@@ -1291,11 +1451,11 @@ authentication tokens:
(eq t (plist-get spec k)))
nil
(list k (plist-get spec k))))
- search-keys)))
+ search-keys)))
;; needed keys (always including host, login, port, and secret)
(returned-keys (mm-delete-duplicates (append
- '(:host :login :port :secret)
- search-keys)))
+ '(:host :login :port :secret)
+ search-keys)))
(items (loop for item in (apply 'secrets-search-items coll search-spec)
unless (and (stringp label)
(not (string-match label item)))
@@ -1337,6 +1497,210 @@ authentication tokens:
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
(debug spec))
+;;; Backend specific parsing: PLSTORE backend
+
+(defun* auth-source-plstore-search (&rest
+ spec
+ &key backend create delete label
+ type max host user port
+ &allow-other-keys)
+ "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))
+ (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)
+ (let ((v (plist-get spec k)))
+ (if (or (null v)
+ (eq t v))
+ nil
+ (if (stringp v)
+ (setq v (list v)))
+ (list k v))))
+ search-keys)))
+ ;; needed keys (always including host, login, port, and secret)
+ (returned-keys (mm-delete-duplicates (append
+ '(:host :login :port :secret)
+ search-keys)))
+ (items (plstore-find store search-spec))
+ (item-names (mapcar #'car items))
+ (items (butlast items (- (length items) max)))
+ ;; convert the item to a full plist
+ (items (mapcar (lambda (item)
+ (let* ((plist (copy-tree (cdr item)))
+ (secret (plist-member plist :secret)))
+ (if secret
+ (setcar
+ (cdr secret)
+ (lexical-let ((v (car (cdr secret))))
+ (lambda () v))))
+ plist))
+ items))
+ ;; 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)))
+ (cond
+ ;; if we need to create an entry AND none were found to match
+ ((and create
+ (not items))
+
+ ;; create based on the spec and record the value
+ (setq items (or
+ ;; if the user did not want to create the entry
+ ;; in the file, it will be returned
+ (apply (slot-value backend 'create-function) spec)
+ ;; if not, we do the search again without :create
+ ;; to get the updated data.
+
+ ;; the result will be returned, even if the search fails
+ (apply 'auth-source-plstore-search
+ (plist-put spec :create nil)))))
+ ((and delete
+ item-names)
+ (dolist (item-name item-names)
+ (plstore-delete store item-name))
+ (plstore-save store)))
+ items))
+
+(defun* auth-source-plstore-create (&rest spec
+ &key backend
+ secret host user port create
+ &allow-other-keys)
+ (let* ((base-required '(host user port secret))
+ (base-secret '(secret))
+ ;; we know (because of an assertion in auth-source-search) that the
+ ;; :create parameter is either t or a list (which includes nil)
+ (create-extra (if (eq t create) nil create))
+ (current-data (car (auth-source-search :max 1
+ :host host
+ :port port)))
+ (required (append base-required create-extra))
+ (file (oref backend source))
+ (add "")
+ ;; `valist' is an alist
+ valist
+ ;; `artificial' will be returned if no creation is needed
+ artificial
+ secret-artificial)
+
+ ;; only for base required elements (defined as function parameters):
+ ;; fill in the valist with whatever data we may have from the search
+ ;; we complete the first value if it's a list and use the value otherwise
+ (dolist (br base-required)
+ (when (symbol-value br)
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t (symbol-value br)) nil)
+ ;; just the value otherwise
+ (t (symbol-value br)))))
+ (when br-choice
+ (aput 'valist br br-choice)))))
+
+ ;; for extra required elements, see if the spec includes a value for them
+ (dolist (er create-extra)
+ (let ((name (concat ":" (symbol-name er)))
+ (keys (loop for i below (length spec) by 2
+ collect (nth i spec))))
+ (dolist (k keys)
+ (when (equal (symbol-name k) name)
+ (aput 'valist er (plist-get spec k))))))
+
+ ;; for each required element
+ (dolist (r required)
+ (let* ((data (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))
+ ;; the default supplementals are simple:
+ ;; for the user, try `given-default' and then (user-login-name);
+ ;; otherwise take `given-default'
+ (default (cond
+ ((and (not given-default) (eq r 'user))
+ (user-login-name))
+ (t given-default)))
+ (printable-defaults (list
+ (cons 'user
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'user))
+ (plist-get artificial :user)
+ "[any user]"))
+ (cons 'host
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'host))
+ (plist-get artificial :host)
+ "[any host]"))
+ (cons 'port
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'port))
+ (plist-get artificial :port)
+ "[any port]"))))
+ (prompt (or (aget auth-source-creation-prompts r)
+ (case r
+ (secret "%p password for %u@%h: ")
+ (user "%p user name for %h: ")
+ (host "%p host name for user %u: ")
+ (port "%p port for %u@%h: "))
+ (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))))))
+
+ ;; Store the data, prompting for the password if needed.
+ (setq data
+ (cond
+ ((and (null data) (eq r 'secret))
+ ;; Special case prompt for passwords.
+ (read-passwd prompt))
+ ((null data)
+ (when default
+ (setq prompt
+ (if (string-match ": *\\'" prompt)
+ (concat (substring prompt 0 (match-beginning 0))
+ " (default " default "): ")
+ (concat prompt "(default " default ") "))))
+ (read-string prompt nil nil default))
+ (t (or data default))))
+
+ (when data
+ (if (member r base-secret)
+ (setq secret-artificial
+ (plist-put secret-artificial
+ (intern (concat ":" (symbol-name r)))
+ data))
+ (setq artificial (plist-put artificial
+ (intern (concat ":" (symbol-name r)))
+ data))))))
+ (plstore-put (oref backend data)
+ (sha1 (format "%s@%s:%s"
+ (plist-get artificial :user)
+ (plist-get artificial :host)
+ (plist-get artificial :port)))
+ artificial secret-artificial)
+ (if (y-or-n-p (format "Save auth info to file %s? "
+ (plstore-get-file (oref backend data))))
+ (plstore-save (oref backend data)))))
+
;;; older API
;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
@@ -1411,14 +1775,14 @@ MODE can be \"login\" or \"password\"."
(cond
((equal "password" m)
(push (if (plist-get choice :secret)
- (funcall (plist-get choice :secret))
- nil) found))
+ (funcall (plist-get choice :secret))
+ nil) found))
((equal "login" m)
(push (plist-get choice :user) found)))))
(setq found (nreverse found))
(setq found (if listy found (car-safe found)))))
- found))
+ found))
(provide 'auth-source)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index b4f0dc38e7e..424c55c40f5 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -2614,7 +2614,9 @@ modified) original contents, they are first saved to their own file."
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string info)
- ")"))))))))))))
+ ")")
+ (concat "^(gnus-group-set-info '(\""
+ (regexp-quote group) "\""))))))))))))
;;;
;;; Agent Category Mode
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 5ba962d1d39..7255be416eb 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -163,8 +163,7 @@
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
- :type '(choice :custom-show nil
- regexp
+ :type '(choice regexp
(repeat regexp))
:group 'gnus-article-hiding)
@@ -4509,6 +4508,7 @@ commands:
t)))
(with-current-buffer name
(set (make-local-variable 'gnus-article-edit-mode) nil)
+ (gnus-article-stop-animations)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handles nil))
@@ -4533,6 +4533,12 @@ commands:
(gnus-start-date-timer gnus-article-update-date-headers))
(current-buffer)))))
+(defun gnus-article-stop-animations ()
+ (dolist (timer (and (boundp 'timer-list)
+ timer-list))
+ (when (eq (aref timer 5) 'image-animate-timeout)
+ (cancel-timer timer))))
+
;; 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)
@@ -5048,7 +5054,7 @@ Deleting parts may malfunction or destroy the article; continue? "))
(let ((desc (mm-handle-description data)))
(when desc
(mail-decode-encoded-word-string desc))))
- (filename (or (mm-handle-filename (mm-handle-disposition data)) "(none)"))
+ (filename (or (mm-handle-filename data) "(none)"))
(type (mm-handle-media-type data)))
(unless data
(error "No MIME part under point"))
@@ -6825,23 +6831,16 @@ If given a prefix, show the hidden text instead."
(numberp article))
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
- gnus-refer-article-method))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-refer-article-methods))))
(backend (car (gnus-find-method-for-group
gnus-newsgroup-name)))
result
(inhibit-read-only t))
- (if (or (not (listp methods))
- (and (symbolp (car methods))
- (assq (car methods) nnoo-definition-alist)))
- (setq methods (list methods)))
(when (and (null gnus-override-method)
methods)
(setq gnus-override-method (pop methods)))
(while (not result)
- (when (eq gnus-override-method 'current)
- (setq gnus-override-method
- (with-current-buffer gnus-summary-buffer
- gnus-current-select-method)))
(erase-buffer)
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 2f99abba22c..98f04263571 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1034,19 +1034,19 @@ articles in the thread.
(widget-create
'push-button
:notify
- '(lambda (&rest ignore)
- (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
- (widgets category-fields))
- (while widgets
- (let* ((widget (pop widgets))
- (value (condition-case nil (widget-value widget) (error))))
- (eval `(setf (,(widget-get widget :accessor) ',info)
- ',value)))))
- (gnus-category-write)
- (gnus-kill-buffer (current-buffer))
- (when (get-buffer gnus-category-buffer)
- (switch-to-buffer (get-buffer gnus-category-buffer))
- (gnus-category-list)))
+ (lambda (&rest ignore)
+ (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
+ (widgets category-fields))
+ (while widgets
+ (let* ((widget (pop widgets))
+ (value (condition-case nil (widget-value widget) (error))))
+ (eval `(setf (,(widget-get widget :accessor) ',info)
+ ',value)))))
+ (gnus-category-write)
+ (gnus-kill-buffer (current-buffer))
+ (when (get-buffer gnus-category-buffer)
+ (switch-to-buffer (get-buffer gnus-category-buffer))
+ (gnus-category-list)))
"Done")
(widget-insert
"\n Note: Empty fields default to the customizable global\
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index bfd17055ea5..c632cab422f 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -151,8 +151,7 @@ DELAY is a string, giving the length of the time. Possible values are:
(when (gnus-group-entry group)
(gnus-activate-group group)
(add-hook 'message-send-hook
- '(lambda ()
- (message-remove-header gnus-delay-header)))
+ (lambda () (message-remove-header gnus-delay-header)))
(setq articles (nndraft-articles))
(while (setq article (pop articles))
(gnus-request-head article group)
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 1709b1c4a05..40f5abda4f8 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -327,8 +327,7 @@ If DONT-POP is nil, display the buffer after setting it up."
(defun gnus-draft-clear-marks ()
(setq gnus-newsgroup-reads nil
gnus-newsgroup-marked nil
- gnus-newsgroup-unreads
- (gnus-uncompress-range (gnus-active gnus-newsgroup-name))))
+ gnus-newsgroup-unreads (nndraft-articles)))
(provide 'gnus-draft)
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index cb495623af2..1cc11383893 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -54,10 +54,7 @@
"convert -scale 48x48! %s xbm:- | xbm2xface.pl"
"Command for converting an image to an X-Face.
The command must take a image filename (use \"%s\") as input.
-The output must be the Face header data on stdout in PNG format.
-
-By default it takes a GIF filename and output the X-Face header data
-on stdout."
+The output must be the X-Face header data on stdout in PNG format."
:version "22.1"
:group 'gnus-fun
:type '(choice (const :tag "giftopnm, netpbm (GIF input only)"
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index c265538e19c..2ea2a5c9bc7 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1437,7 +1437,8 @@ if it is a string, only list groups matching REGEXP."
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string (nth 2 entry))
- ")")))
+ ")")
+ (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))
(setq gnus-group-indentation (gnus-group-group-indentation))
(gnus-delete-line)
(gnus-group-insert-group-line-info group)
@@ -1685,10 +1686,11 @@ and ends at END."
(gnus-active group))
(gnus-group-update-group group))
-(defun gnus-group-update-group (group &optional visible-only)
+(defun gnus-group-update-group (group &optional visible-only
+ info-unchanged)
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
+already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(with-current-buffer gnus-group-buffer
(save-excursion
;; The buffer may be narrowed.
@@ -1697,14 +1699,17 @@ already."
(let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
found buffer-read-only)
- ;; Enter the current status into the dribble buffer.
- (let ((entry (gnus-group-entry group)))
- (when (and entry
- (not (gnus-ephemeral-group-p group)))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (nth 2 entry))
- ")"))))
+ (unless info-unchanged
+ ;; Enter the current status into the dribble buffer.
+ (let ((entry (gnus-group-entry group)))
+ (when (and entry
+ (not (gnus-ephemeral-group-p group)))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (nth 2 entry))
+ ")")
+ (concat "^(gnus-group-set-info '(\""
+ (regexp-quote group) "\"")))))
;; Find all group instances. If topics are in use, each group
;; may be listed in more than once.
(while (setq loc (text-property-any
@@ -2410,33 +2415,41 @@ Valid input formats include:
(gnus-read-ephemeral-gmane-group group start range)))
(defcustom gnus-bug-group-download-format-alist
- '((emacs . "http://debbugs.gnu.org/%s;mbox=yes")
+ '((emacs . "http://debbugs.gnu.org/%s;mboxstat=yes")
(debian
- . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes"))
+ . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes"))
"Alist of symbols for bug trackers and the corresponding URL format string.
The URL format string must contain a single \"%s\", specifying
the bug number, and browsing the URL must return mbox output."
:group 'gnus-group-foreign
- :version "23.2" ;; No Gnus
+ ;; Added mboxmaint=yes. This gets the version with the messages as
+ ;; they went out, not as they came in.
+ ;; Eg bug-gnu-emacs is replaced by ###@debbugs.
+ :version "24.1"
:type '(repeat (cons (symbol) (string :tag "URL format string"))))
-(defun gnus-read-ephemeral-bug-group (number mbox-url)
+(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
"Browse bug NUMBER as ephemeral group."
(interactive (list (read-string "Enter bug number: "
(thing-at-point 'word) nil)
;; FIXME: Add completing-read from
;; `gnus-emacs-bug-group-download-format' ...
(cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
- (when (stringp number)
- (setq number (string-to-number number)))
- (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")))
+ (when (stringp ids)
+ (setq ids (string-to-number ids)))
+ (unless (listp ids)
+ (setq ids (list ids)))
+ (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))
+ (coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
(with-temp-file tmpfile
- (url-insert-file-contents (format mbox-url number))
+ (dolist (id ids)
+ (url-insert-file-contents (format mbox-url id)))
(goto-char (point-min))
;; Add the debbugs address so that we can respond to reports easily.
(while (re-search-forward "^To: " nil t)
(end-of-line)
- (insert (format ", %s@%s" number
+ (insert (format ", %s@%s" (car ids)
(gnus-replace-in-string
(gnus-replace-in-string mbox-url "^http://" "")
"/.*$" ""))))
@@ -2444,7 +2457,8 @@ the bug number, and browsing the URL must return mbox output."
(gnus-group-read-ephemeral-group
"gnus-read-ephemeral-bug"
`(nndoc ,tmpfile
- (nndoc-article-type mbox))))
+ (nndoc-article-type mbox))
+ nil window-conf))
(delete-file tmpfile)))
(defun gnus-read-ephemeral-debian-bug-group (number)
@@ -2455,13 +2469,23 @@ the bug number, and browsing the URL must return mbox output."
number
(cdr (assoc 'debian gnus-bug-group-download-format-alist))))
-(defun gnus-read-ephemeral-emacs-bug-group (number)
- "Browse Emacs bug NUMBER as ephemeral group."
- (interactive (list (read-string "Enter bug number: "
- (thing-at-point 'word) nil)))
+(defvar debbugs-gnu-bug-number) ; debbugs-gnu
+
+(defun gnus-read-ephemeral-emacs-bug-group (ids &optional window-conf)
+ "Browse Emacs bugs IDS as an ephemeral group."
+ (interactive (list (string-to-number
+ (read-string "Enter bug number: "
+ (thing-at-point 'word) nil))))
+ (unless (listp ids)
+ (setq ids (list ids)))
(gnus-read-ephemeral-bug-group
- number
- (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
+ ids
+ (cdr (assoc 'emacs gnus-bug-group-download-format-alist))
+ window-conf)
+ (when (fboundp 'debbugs-gnu-summary-mode)
+ (with-current-buffer (window-buffer (selected-window))
+ (debbugs-gnu-summary-mode 1)
+ (set (make-local-variable 'debbugs-gnu-bug-number) (car ids)))))
(defun gnus-group-jump-to-group (group &optional prompt)
"Jump to newsgroup GROUP.
@@ -2712,7 +2736,8 @@ server."
(unless (gnus-ephemeral-group-p name)
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (cdr info)) ")")))
+ (gnus-prin1-to-string (cdr info)) ")")
+ (concat "^(gnus-group-set-info '(\"" (regexp-quote name) "\"")))
;; Insert the line.
(gnus-group-insert-group-line-info nname)
(forward-line -1)
@@ -3564,7 +3589,8 @@ or nil if no action could be taken."
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
- (when (gnus-group-auto-expirable-p group)
+ (when (and (gnus-group-auto-expirable-p group)
+ (not (gnus-group-read-only-p group)))
(gnus-range-map
(lambda (article)
(gnus-add-marked-articles group 'expire (list article))
@@ -4028,7 +4054,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(when gnus-agent
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
- (gnus-group-update-group group))
+ (gnus-group-update-group group nil t))
(if (eq (gnus-server-status (gnus-find-method-for-group group))
'denied)
(gnus-error 3 "Server denied access")
@@ -4407,7 +4433,7 @@ and the second element is the address."
;; file. Use with caution, if at all.
(defun gnus-import-other-newsrc-file (file)
(with-temp-buffer
- (insert-file file)
+ (insert-file-contents file)
(let (form)
(while (ignore-errors
(setq form (read (current-buffer))))
@@ -4627,10 +4653,11 @@ This command may read the active file."
(push n gnus-newsgroup-unselected))
(setq n (1+ n)))
(setq gnus-newsgroup-unselected
- (nreverse gnus-newsgroup-unselected)))))
+ (sort gnus-newsgroup-unselected '<)))))
(gnus-activate-group group)
(gnus-group-make-articles-read group (list article))
- (when (gnus-group-auto-expirable-p group)
+ (when (and (gnus-group-auto-expirable-p group)
+ (not (gnus-group-read-only-p group)))
(gnus-add-marked-articles
group 'expire (list article))))))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index b7f0c0922a3..6ca3c8b7945 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -482,8 +482,14 @@ Return a string with image data."
(gnus-put-text-property start (point)
'gnus-alt-text alt-text)
(when url
- (gnus-put-text-property start (point)
- 'image-url url))
+ (gnus-add-text-properties
+ start (point)
+ `(image-url
+ ,url
+ image-displayer
+ (lambda (url start end)
+ (gnus-html-display-image url start end
+ ,alt-text)))))
(gnus-add-image 'external image)
t)
;; Bad image, try to show something else
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index ef15a479892..b9b191cd09c 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -516,11 +516,12 @@ If BUFFER, insert the article in that group."
article (gnus-group-real-name group)
(nth 1 gnus-command-method) buffer)))
-(defun gnus-request-thread (header)
+(defun gnus-request-thread (header group)
"Request the headers in the thread containing the article specified by HEADER."
- (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-thread)
- header)))
+ header
+ (gnus-group-real-name group))))
(defun gnus-warp-to-article ()
"Warps from an article in a virtual group to the article in its
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 093eec33fcd..9d3ec25c03a 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -351,6 +351,7 @@ Thank you for your help in stamping out bugs.
"r" gnus-summary-reply
"y" gnus-summary-yank-message
"R" gnus-summary-reply-with-original
+ "L" gnus-summary-reply-to-list-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
"v" gnus-summary-very-wide-reply
@@ -1154,6 +1155,16 @@ The original article will be yanked."
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n) wide))
+(defun gnus-summary-reply-to-list-with-original (n &optional wide)
+ "Start composing a reply mail to the current message.
+The reply goes only to the mailing list.
+The original article will be yanked."
+ (interactive "P")
+ (let ((message-reply-to-function
+ (lambda nil
+ `((To . ,(gnus-mailing-list-followup-to))))))
+ (gnus-summary-reply (gnus-summary-work-articles n) wide)))
+
(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
"Like `gnus-summary-reply' except removing reply-to field.
If prefix argument YANK is non-nil, the original article is yanked
@@ -1444,24 +1455,22 @@ If YANK is non-nil, include the original article."
(goto-char (point-min)))
(message-pop-to-buffer "*Gnus Bug*"))
(let ((message-this-is-mail t))
- (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
+ (message-setup `((To . ,gnus-maintainer)
+ (Subject . "")
+ (X-Debbugs-Package
+ . ,(format "%s" gnus-bug-package))
+ (X-Debbugs-Version
+ . ,(format "%s" (gnus-continuum-version))))))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
+ (message-goto-body)
+ (insert "\n\n\n\n\n")
(insert (gnus-version) "\n"
(emacs-version) "\n")
(when (and (boundp 'nntp-server-type)
(stringp nntp-server-type))
(insert nntp-server-type))
- (insert "\n\n\n\n\n")
- (let (text)
- (with-current-buffer (gnus-get-buffer-create " *gnus environment info*")
- (erase-buffer)
- (gnus-debug)
- (setq text (buffer-string)))
- (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
@@ -1481,62 +1490,6 @@ If YANK is non-nil, include the original article."
(with-current-buffer buffer
(message-yank-buffer gnus-article-buffer))))
-(defun gnus-debug ()
- "Attempts to go through the Gnus source file and report what variables have been changed.
-The source file has to be in the Emacs load path."
- (interactive)
- (let ((files gnus-debug-files)
- (point (point))
- file expr olist sym)
- (gnus-message 4 "Please wait while we snoop your variables...")
- (sit-for 0)
- ;; Go through all the files looking for non-default values for variables.
- (with-current-buffer (gnus-get-buffer-create " *gnus bug info*")
- (while files
- (erase-buffer)
- (when (and (setq file (locate-library (pop files)))
- (file-exists-p file))
- (insert-file-contents file)
- (goto-char (point-min))
- (if (not (re-search-forward "^;;* *Internal variables" nil t))
- (gnus-message 4 "Malformed sources in file %s" file)
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (setq expr (ignore-errors (read (current-buffer))))
- (ignore-errors
- (and (or (eq (car expr) 'defvar)
- (eq (car expr) 'defcustom))
- (stringp (nth 3 expr))
- (not (memq (nth 1 expr) gnus-debug-exclude-variables))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (push (nth 1 expr) olist)))))))
- (kill-buffer (current-buffer)))
- (when (setq olist (nreverse olist))
- (insert "------------------ Environment follows ------------------\n\n"))
- (while olist
- (if (boundp (car olist))
- (ignore-errors
- (gnus-pp
- `(setq ,(car olist)
- ,(if (or (consp (setq sym (symbol-value (car olist))))
- (and (symbolp sym)
- (not (or (eq sym nil)
- (eq sym t)))))
- (list 'quote (symbol-value (car olist)))
- (symbol-value (car olist))))))
- (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
- (setq olist (cdr olist)))
- (insert "\n\n")
- ;; Remove any control chars - they seem to cause trouble for some
- ;; mailers. (Byte-compiled output from the stuff above.)
- (goto-char point)
- (while (re-search-forward (mm-string-to-multibyte
- "[\000-\010\013-\037\200-\237]") nil t)
- (replace-match (format "\\%03o" (string-to-char (match-string 0)))
- t t))))
-
;;; Treatment of rejected articles.
;;; Bounced mail.
@@ -1777,7 +1730,10 @@ this is a reply."
"Configure posting styles according to `gnus-posting-styles'."
(unless gnus-inhibit-posting-styles
(let ((group (or group-name gnus-newsgroup-name ""))
- (styles gnus-posting-styles)
+ (styles (if (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-posting-styles)
+ gnus-posting-styles))
style match attribute value v results
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 02e4ce7e2e6..f8ff52f128f 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -57,6 +57,16 @@
;; You should also consider using the nnregistry backend to look up
;; articles. See the Gnus manual for more information.
+;; Finally, you can put %uM in your summary line format to show the
+;; registry marks if you do this:
+
+;; show the marks as single characters (see the :char property in
+;; `gnus-registry-marks'):
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+
+;; show the marks by name (see `gnus-registry-marks'):
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+
;; TODO:
;; - get the correct group on spool actions
@@ -244,6 +254,8 @@ the Bit Bucket."
(oset db :max-hard
(or gnus-registry-max-entries
most-positive-fixnum))
+ (oset db :prune-factor
+ 0.1)
(oset db :max-soft
(or gnus-registry-max-pruned-entries
most-positive-fixnum))
@@ -309,6 +321,20 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
(registry-size db) file)))
+(defun gnus-registry-remove-ignored ()
+ (interactive)
+ (let* ((db gnus-registry-db)
+ (grouphashtb (registry-lookup-secondary db 'group))
+ (old-size (registry-size db)))
+ (registry-reindex db)
+ (loop for k being the hash-keys of grouphashtb
+ using (hash-values v)
+ when (gnus-registry-ignore-group-p k)
+ do (registry-delete db v nil))
+ (registry-reindex db)
+ (gnus-message 4 "Removed %d ignored entries from the Gnus registry"
+ (- old-size (registry-size db)))))
+
;; article move/copy/spool/delete actions
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
@@ -885,22 +911,32 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
nil
(cons "Registry Marks" gnus-registry-misc-menus))))))
-;;; use like this:
-;;; (defalias 'gnus-user-format-function-M
-;;; 'gnus-registry-user-format-function-M)
-(defun gnus-registry-user-format-function-M (headers)
+(make-obsolete 'gnus-registry-user-format-function-M
+ 'gnus-registry-article-marks-to-chars "24.1") ?
+
+(defalias 'gnus-registry-user-format-function-M
+ 'gnus-registry-article-marks-to-chars)
+
+;; 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"
+ (let* ((id (mail-header-message-id headers))
+ (marks (when id (gnus-registry-get-id-key id 'mark))))
+ (mapconcat (lambda (mark)
+ (plist-get
+ (cdr-safe
+ (assoc mark gnus-registry-marks))
+ :char))
+ marks "")))
+
+;; 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"
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
- (apply 'concat (mapcar (lambda (mark)
- (let ((c
- (plist-get
- (cdr-safe
- (assoc mark gnus-registry-marks))
- :char)))
- (if c
- (list c)
- nil)))
- marks))))
+ (mapconcat (lambda (mark) (symbol-name mark)) marks ",")))
(defun gnus-registry-read-mark ()
"Read a mark name from the user with completion."
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 9bf2d37a3e4..ec98b2ff749 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -362,7 +362,8 @@ The following commands are available:
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string (cdr entry)) ")\n")))
+ (gnus-prin1-to-string (cdr entry)) ")\n")
+ (concat "^(gnus-server-set-info \"" (regexp-quote server) "\"")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
@@ -381,7 +382,8 @@ The following commands are available:
(when (and server info)
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string info) ")"))
+ (gnus-prin1-to-string info) ")")
+ (concat "^(gnus-server-set-info \"" (regexp-quote server) "\""))
(let* ((server (nth 1 info))
(entry (assoc server gnus-server-alist))
(cached (assoc server gnus-server-method-cache)))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 719d0c9e472..7c63d5e2653 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -832,13 +832,22 @@ prompt the user for the name of an NNTP server to use."
gnus-current-startup-file)
"-dribble"))
-(defun gnus-dribble-enter (string)
- "Enter STRING into the dribble buffer."
+(defun gnus-dribble-enter (string &optional regexp)
+ "Enter STRING into the dribble buffer.
+If REGEXP is given, lines that match it will be deleted."
(when (and (not gnus-dribble-ignore)
gnus-dribble-buffer
(buffer-name gnus-dribble-buffer))
(let ((obuf (current-buffer)))
(set-buffer gnus-dribble-buffer)
+ (when regexp
+ (goto-char (point-min))
+ (let (end)
+ (while (re-search-forward regexp nil t)
+ (unless (bolp) (forward-line 1))
+ (setq end (point))
+ (goto-char (match-beginning 0))
+ (delete-region (point-at-bol) end))))
(goto-char (point-max))
(insert string "\n")
;; This has been commented by Josh Huber <huber@alum.wpi.edu>
@@ -1034,7 +1043,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
- (gnus-get-unread-articles level))))
+ (gnus-get-unread-articles level dont-connect))))
(defun gnus-call-subscribe-functions (method group)
"Call METHOD to subscribe GROUP.
@@ -1354,8 +1363,8 @@ for new groups, and subscribe the new groups as zombies."
(when (cdr entry)
(setcdr (gnus-group-entry (caadr entry)) entry))
(gnus-dribble-enter
- (format
- "(gnus-group-set-info '%S)" info)))))
+ (format "(gnus-group-set-info '%S)" info)
+ (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))))
(when gnus-group-change-level-function
(funcall gnus-group-change-level-function
group level oldlevel previous)))))
@@ -1597,7 +1606,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)
+(defun gnus-get-unread-articles (&optional level dont-connect)
(setq gnus-server-method-cache nil)
(require 'gnus-agent)
(let* ((newsrc (cdr gnus-newsrc-alist))
@@ -1693,12 +1702,13 @@ If SCAN, request a scan of that group as well."
;; If we have primary/secondary select methods, but no groups from
;; them, we still want to issue a retrieval request from them.
- (dolist (method (cons gnus-select-method
- gnus-secondary-select-methods))
- (when (and (not (assoc method type-cache))
- (gnus-check-backend-function 'request-list (car method)))
- (with-current-buffer nntp-server-buffer
- (gnus-read-active-file-1 method nil))))
+ (unless dont-connect
+ (dolist (method (cons gnus-select-method
+ gnus-secondary-select-methods))
+ (when (and (not (assoc method type-cache))
+ (gnus-check-backend-function 'request-list (car method)))
+ (with-current-buffer nntp-server-buffer
+ (gnus-read-active-file-1 method nil)))))
;; Start early async retrieval of data.
(let ((done-methods nil)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 3cbb479e068..5a817e12104 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -4098,7 +4098,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(setq gnus-newsgroup-prepared t)
(gnus-run-hooks 'gnus-summary-prepared-hook)
(unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group))
+ (gnus-group-update-group group nil t))
t)))))
(defun gnus-summary-auto-select-subject ()
@@ -5715,7 +5715,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(gnus-summary-remove-list-identifiers)
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
- (gnus-group-auto-expirable-p group))
+ (and (gnus-group-auto-expirable-p group)
+ (not (gnus-group-read-only-p group))))
;; Set up the article buffer now, if necessary.
(unless (and gnus-single-article-buffer
(equal gnus-article-buffer "*Article*"))
@@ -7139,7 +7140,12 @@ The prefix argument ALL means to select all articles."
t)))
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((headers gnus-newsgroup-headers))
+ (let ((headers gnus-newsgroup-headers)
+ (ephemeral-p (gnus-ephemeral-group-p group))
+ info)
+ (unless ephemeral-p
+ (setq info (copy-sequence (gnus-get-info group))
+ info (delq (gnus-info-params info) info)))
;; Set the new ranges of read articles.
(with-current-buffer gnus-group-buffer
(gnus-undo-force-boundary))
@@ -7159,8 +7165,12 @@ The prefix argument ALL means to select all articles."
(gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
;; Do not switch windows but change the buffer to work.
(set-buffer gnus-group-buffer)
- (unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group)))))))
+ (unless ephemeral-p
+ (gnus-group-update-group
+ group nil
+ (equal info
+ (setq info (copy-sequence (gnus-get-info group))
+ info (delq (gnus-info-params info) info))))))))))
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
@@ -7193,7 +7203,11 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(article-buffer gnus-article-buffer)
(mode major-mode)
(group-point nil)
- (buf (current-buffer)))
+ (buf (current-buffer))
+ ;; `gnus-single-article-buffer' is nil buffer-locally in
+ ;; ephemeral group of which summary buffer will be killed,
+ ;; but the global value may be non-nil.
+ (single-article-buffer gnus-single-article-buffer))
(unless quit-config
;; Do adaptive scoring, and possibly save score files.
(when gnus-newsgroup-adaptive
@@ -7256,7 +7270,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-configure-windows 'group 'force)))
;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
+ (unless single-article-buffer
(when (gnus-buffer-live-p article-buffer)
(with-current-buffer article-buffer
;; Don't kill sticky article buffers
@@ -7284,6 +7298,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
+ (gnus-article-stop-animations)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
@@ -7309,7 +7324,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
;; Clear the current group name.
(setq gnus-newsgroup-name nil)
(unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group))
+ (gnus-group-update-group group nil t))
(when (equal (gnus-group-group-name) group)
(gnus-group-next-unread-group 1))
(when quit-config
@@ -8955,7 +8970,7 @@ variable."
'list gnus-newsgroup-headers
(if (gnus-check-backend-function
'request-thread gnus-newsgroup-name)
- (gnus-request-thread header)
+ (gnus-request-thread header gnus-newsgroup-name)
(let* ((last (if (numberp limit)
(min (+ (mail-header-number header)
limit)
@@ -9035,7 +9050,12 @@ variable."
(dolist (method gnus-refer-article-method)
(push (if (eq 'current method)
gnus-current-select-method
- method)
+ (if (eq 'nnir (car method))
+ (list
+ 'nnir
+ (or (cadr method)
+ (gnus-method-to-server gnus-current-select-method)))
+ method))
out))
(nreverse out)))
;; One single select method.
@@ -9565,6 +9585,7 @@ C-u g', show the raw article."
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
+ (gnus-article-stop-animations)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
@@ -9989,7 +10010,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string (gnus-get-info to-group))
- ")"))))
+ ")")
+ (concat "^(gnus-group-set-info '(\""
+ (regexp-quote to-group) "\""))))
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
@@ -11533,8 +11556,12 @@ will not be hidden."
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((end nil))
+ (let ((end nil)
+ (count 0))
(while (not end)
+ (incf count)
+ (when (zerop (mod count 1000))
+ (message "Hiding all threads... %d" count))
(when (or (not predicate)
(gnus-map-articles
predicate (gnus-summary-article-children)))
@@ -11565,7 +11592,10 @@ Returns nil if no threads were there to be hidden."
(let ((ol (gnus-make-overlay starteol (point) nil t nil)))
(gnus-overlay-put ol 'invisible 'gnus-sum)
(gnus-overlay-put ol 'evaporate t)))
- (gnus-summary-goto-subject article))
+ (gnus-summary-goto-subject article)
+ (when (> start (point))
+ (message "Hiding the thread moved us backwards, aborting!")
+ (goto-char (point-max))))
(goto-char start)
nil))))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 3f66b45aaab..7155c7f9607 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -540,8 +540,7 @@ but also to the ones displayed in the echo area."
(eval-when-compile
(defmacro gnus-message-with-timestamp-1 (format-string args)
- (let ((timestamp '((format-time-string "%Y%m%dT%H%M%S" time)
- "." (format "%03d" (/ (nth 2 time) 1000)) "> ")))
+ (let ((timestamp '(format-time-string "%Y%m%dT%H%M%S.%3N> " time)))
(if (featurep 'xemacs)
`(let (str time)
(if (or (and (null ,format-string) (null ,args))
@@ -554,10 +553,10 @@ but also to the ones displayed in the echo area."
(cond ((eq gnus-add-timestamp-to-message 'log)
(setq time (current-time))
(display-message 'no-log str)
- (log-message 'message (concat ,@timestamp str)))
+ (log-message 'message (concat ,timestamp str)))
(gnus-add-timestamp-to-message
(setq time (current-time))
- (display-message 'message (concat ,@timestamp str)))
+ (display-message 'message (concat ,timestamp str)))
(t
(display-message 'message str))))
str)
@@ -571,7 +570,7 @@ but also to the ones displayed in the echo area."
(setq time (current-time))
(with-current-buffer (get-buffer-create "*Messages*")
(goto-char (point-max))
- (insert ,@timestamp str "\n")
+ (insert ,timestamp str "\n")
(forward-line (- message-log-max))
(delete-region (point-min) (point))
(goto-char (point-max))))
@@ -585,7 +584,7 @@ but also to the ones displayed in the echo area."
(and ,format-string str)
(message nil))
(setq time (current-time))
- (message "%s" (concat ,@timestamp str))
+ (message "%s" (concat ,timestamp str))
str))
(t
(apply 'message ,format-string ,args))))))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 8797780251a..ac7db0e1d69 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1423,10 +1423,6 @@ no need to set this variable."
(defcustom gnus-refer-article-method 'current
"Preferred method for fetching an article by Message-ID.
-If you are reading news from the local spool (with nnspool), fetching
-articles by Message-ID is painfully slow. By setting this method to an
-nntp method, you might get acceptable results.
-
The value of this variable must be a valid select method as discussed
in the documentation of `gnus-select-method'.
@@ -2655,9 +2651,13 @@ such as a mark that says whether an article is stored in the cache
(defvar gnus-have-read-active-file nil)
(defconst gnus-maintainer
- "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
+ "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
+(defconst gnus-bug-package
+ "gnus"
+ "The package to use in the bug submission.")
+
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)Group Buffer")
(gnus-summary-mode "(gnus)Summary Buffer")
@@ -2962,8 +2962,8 @@ with some simple extensions.
on level one
%R \"A\" if this article has been replied to, \" \"
otherwise (character)
-%U Status of this article (character, \"R\", \"K\",
- \"-\" or \" \")
+%U \"Read\" status of this article.
+ See Info node `(gnus)Marking Articles'
%[ Opening bracket (character, \"[\" or \"<\")
%] Closing bracket (character, \"]\" or \">\")
%> Spaces of length thread-level (string)
@@ -4357,11 +4357,11 @@ current display is used."
(switch-to-buffer gnus-group-buffer)
(funcall gnus-other-frame-function arg)
(add-hook 'gnus-exit-gnus-hook
- '(lambda nil
- (when (and (frame-live-p gnus-other-frame-object)
- (cdr (frame-list)))
- (delete-frame gnus-other-frame-object))
- (setq gnus-other-frame-object nil)))))))
+ (lambda nil
+ (when (and (frame-live-p gnus-other-frame-object)
+ (cdr (frame-list)))
+ (delete-frame gnus-other-frame-object))
+ (setq gnus-other-frame-object nil)))))))
;;;###autoload
(defun gnus (&optional arg dont-connect slave)
@@ -4381,6 +4381,13 @@ prompt the user for the name of an NNTP server to use."
(gnus-1 arg dont-connect slave)
(gnus-final-warning)))
+(autoload 'debbugs-emacs "debbugs-gnu")
+(defun gnus-list-debbugs ()
+ "List all open Gnus bug reports."
+ (interactive)
+ (debbugs-emacs '("important" "normal" "minor" "wishlist")
+ "gnus"))
+
;; Allow redefinition of Gnus functions.
(gnus-ems-redefine)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 0971aed0e02..7d7cc01225b 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -659,6 +659,7 @@ Done before generating the new subject of a forward."
(defcustom message-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)))
@@ -1091,7 +1092,7 @@ Note: Many newsgroups frown upon nontraditional reply styles. You
probably want to set this variable only for specific groups,
e.g. using `gnus-posting-styles':
- (eval (set (make-local-variable 'message-cite-reply-above) 'above))"
+ (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
:type '(choice (const :tag "Reply inline" 'traditional)
(const :tag "Reply above" 'above)
(const :tag "Reply below" 'below))
@@ -1184,7 +1185,7 @@ It is a vector of the following headers:
(defvar message-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
(defvar message-return-action nil
- "Action to return to the caller after sending or postphoning a message.")
+ "Action to return to the caller after sending or postponing a message.")
(defvar message-exit-actions nil
"A list of actions to be performed upon exiting after sending a message.")
(defvar message-kill-actions nil
@@ -3424,8 +3425,12 @@ Message buffers and is not meant to be called directly."
(defun message-point-in-header-p ()
"Return t if point is in the header."
(save-excursion
- (not (re-search-backward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
+ (and
+ (not
+ (re-search-backward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
@@ -4621,6 +4626,8 @@ If you always want Gnus to send messages in one piece, set
(set-buffer mailbuf)
(push 'mail message-sent-message-via)))
+(defvar sendmail-program)
+
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(require 'sendmail)
@@ -4656,16 +4663,7 @@ If you always want Gnus to send messages in one piece, set
(cpr (apply
'call-process-region
(append
- (list (point-min) (point-max)
- (cond ((boundp 'sendmail-program)
- sendmail-program)
- ((file-exists-p "/usr/sbin/sendmail")
- "/usr/sbin/sendmail")
- ((file-exists-p "/usr/lib/sendmail")
- "/usr/lib/sendmail")
- ((file-exists-p "/usr/ucblib/sendmail")
- "/usr/ucblib/sendmail")
- (t "fakemail"))
+ (list (point-min) (point-max) sendmail-program
nil errbuf nil "-oi")
message-sendmail-extra-arguments
;; Always specify who from,
@@ -6751,10 +6749,13 @@ want to get rid of this query permanently.")))
addr))
(cons (downcase (mail-strip-quoted-names addr)) addr)))
(message-tokenize-header recipients)))
- ;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
+ ;; Remove all duplicates.
(let ((s recipients))
(while s
- (setq recipients (delq (assoc (car (pop s)) s) recipients))))
+ (let ((address (car (pop s))))
+ (while (assoc address s)
+ (setq recipients (delq (assoc address s) recipients)
+ s (delq (assoc address s) s))))))
;; Remove hierarchical lists that are contained within each other,
;; if message-hierarchical-addresses is defined.
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 9952f410f0d..695451ddc45 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -197,7 +197,8 @@ If TYPE is `text/plain' CRLF->LF translation may occur."
(while (re-search-forward "^[\t ]*\r?\n" nil t)
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-max))
- (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t)
+ (when (re-search-backward "^[\t ]*[A-Za-z0-9+/]+=*[\t ]*$"
+ nil t)
(forward-line))
(point))))
((memq encoding '(nil 7bit 8bit binary))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index f543920446b..a51c6630ac5 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -114,14 +114,14 @@
"Render of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
-`shr': use Gnus simple HTML renderer;
-`gnus-w3m' : use Gnus renderer based on w3m;
-`w3m' : use emacs-w3m;
-`w3m-standalone': use w3m;
+`shr': use the built-in Gnus HTML renderer;
+`gnus-w3m': use Gnus renderer based on w3m;
+`w3m': use emacs-w3m;
+`w3m-standalone': use plain w3m;
`links': use links;
-`lynx' : use lynx;
-`w3' : use Emacs/W3;
-`html2text' : use html2text;
+`lynx': use lynx;
+`w3': use Emacs/W3;
+`html2text': use html2text;
nil : use external viewer (default web browser)."
:version "24.1"
:type '(choice (const shr)
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 435c3bba00f..d57b61dac83 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -300,34 +300,6 @@ system object in XEmacs."
;; no-MULE XEmacs:
(car (memq cs (mm-get-coding-system-list))))))
-(defun mm-codepage-setup (number &optional alias)
- "Create a coding system cpNUMBER.
-The coding system is created using `codepage-setup'. If ALIAS is
-non-nil, an alias is created and added to
-`mm-charset-synonym-alist'. If ALIAS is a string, it's used as
-the alias. Else windows-NUMBER is used."
- (interactive
- (let ((completion-ignore-case t)
- (candidates (if (fboundp 'cp-supported-codepages)
- (cp-supported-codepages)
- ;; Removed in Emacs 23 (unicode), so signal an error:
- (error "`codepage-setup' not present in this Emacs version"))))
- (list (gnus-completing-read "Setup DOS Codepage" candidates
- t nil nil "437"))))
- (when alias
- (setq alias (if (stringp alias)
- (intern alias)
- (intern (format "windows-%s" number)))))
- (let* ((cp (intern (format "cp%s" number))))
- (unless (mm-coding-system-p cp)
- (if (fboundp 'codepage-setup) ; silence compiler
- (codepage-setup number)
- (error "`codepage-setup' not present in this Emacs version")))
- (when (and alias
- ;; Don't add alias if setup of cp failed.
- (mm-coding-system-p cp))
- (add-to-list 'mm-charset-synonym-alist (cons alias cp)))))
-
(defvar mm-charset-synonym-alist
`(
;; Not in XEmacs, but it's not a proper MIME charset anyhow.
@@ -376,6 +348,34 @@ the alias. Else windows-NUMBER is used."
See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.")
+(defun mm-codepage-setup (number &optional alias)
+ "Create a coding system cpNUMBER.
+The coding system is created using `codepage-setup'. If ALIAS is
+non-nil, an alias is created and added to
+`mm-charset-synonym-alist'. If ALIAS is a string, it's used as
+the alias. Else windows-NUMBER is used."
+ (interactive
+ (let ((completion-ignore-case t)
+ (candidates (if (fboundp 'cp-supported-codepages)
+ (cp-supported-codepages)
+ ;; Removed in Emacs 23 (unicode), so signal an error:
+ (error "`codepage-setup' not present in this Emacs version"))))
+ (list (gnus-completing-read "Setup DOS Codepage" candidates
+ t nil nil "437"))))
+ (when alias
+ (setq alias (if (stringp alias)
+ (intern alias)
+ (intern (format "windows-%s" number)))))
+ (let* ((cp (intern (format "cp%s" number))))
+ (unless (mm-coding-system-p cp)
+ (if (fboundp 'codepage-setup) ; silence compiler
+ (codepage-setup number)
+ (error "`codepage-setup' not present in this Emacs version")))
+ (when (and alias
+ ;; Don't add alias if setup of cp failed.
+ (mm-coding-system-p cp))
+ (add-to-list 'mm-charset-synonym-alist (cons alias cp)))))
+
(defcustom mm-codepage-iso-8859-list
(list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
;; Outlook users in Czech republic. Use this to allow reading of
@@ -550,7 +550,8 @@ is not available."
(let ((cs (cdr (assq charset mm-charset-override-alist))))
(and cs (mm-coding-system-p cs) cs))))
;; ascii
- ((eq charset 'us-ascii)
+ ((or (eq charset 'us-ascii)
+ (string-match "ansi.x3.4" (symbol-name charset)))
'ascii)
;; Check to see whether we can handle this charset. (This depends
;; on there being some coding system matching each `mime-charset'
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 0ce74b1d765..a5d778845c1 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -137,33 +137,32 @@ Whether the passphrase is cached at all is controlled by
(while (looking-at "^Content[^ ]+:") (forward-line))
(unless (bobp)
(delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer
- (with-temp-buffer
- (inline (mm-disable-multibyte))
- (setq cipher (current-buffer))
- (insert-buffer-substring text)
- (unless (mc-encrypt-generic
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- nil
- (point-min) (point-max)
- (message-options-get 'message-sender)
- 'sign)
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Encrypt error")))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- ;;(insert "Content-Type: application/pgp-encrypted\n\n")
- ;;(insert "Version: 1\n\n")
- (insert "\n")
- (insert-buffer-substring cipher)
- (goto-char (point-max))))))
+ (with-temp-buffer
+ (inline (mm-disable-multibyte))
+ (setq cipher (current-buffer))
+ (insert-buffer-substring text)
+ (unless (mc-encrypt-generic
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ nil
+ (point-min) (point-max)
+ (message-options-get 'message-sender)
+ 'sign)
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Encrypt error")))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (set-buffer text)
+ (delete-region (point-min) (point-max))
+ ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+ ;;(insert "Version: 1\n\n")
+ (insert "\n")
+ (insert-buffer-substring cipher)
+ (goto-char (point-max)))))
;; pgg wrapper
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index df106bb6de8..7d8a4119c0e 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -55,9 +55,15 @@
'epg)
(error))
(progn
- (ignore-errors (require 'pgg))
- (and (fboundp 'pgg-sign-region)
- 'pgg))
+ (let ((abs-file (locate-library "pgg")))
+ ;; Don't load PGG if it is marked as obsolete
+ ;; (Emacs 24).
+ (when (and abs-file
+ (not (string-match "/obsolete/[^/]*\\'"
+ abs-file)))
+ (ignore-errors (require 'pgg))
+ (and (fboundp 'pgg-sign-region)
+ 'pgg))))
(progn (ignore-errors
(load "mc-toplev"))
(and (fboundp 'mc-encrypt-generic)
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 006348869ef..f528222dd16 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -24,14 +24,21 @@
;;; Code:
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(require 'nnheader)
(require 'nnmail)
(require 'gnus-start)
+(require 'gnus-group)
(require 'nnmh)
(require 'nnoo)
(require 'mm-util)
(eval-when-compile (require 'cl))
+(declare-function nndraft-request-list "nnmh" (&rest args))
+
(nnoo-declare nndraft
nnmh)
@@ -161,6 +168,25 @@ are generated if and only if they are also in `message-draft-headers'.")
(message-headers-to-generate
nndraft-required-headers message-draft-headers nil))))
+(defun nndraft-update-unread-articles ()
+ "Update groups' unread articles in the group buffer."
+ (nndraft-request-list)
+ (with-current-buffer gnus-group-buffer
+ (let* ((groups (mapcar (lambda (elem)
+ (gnus-group-prefixed-name (car elem)
+ (list 'nndraft "")))
+ (nnmail-get-active)))
+ (gnus-group-marked (copy-sequence groups))
+ (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)))))))
+
(deffoo nndraft-request-associate-buffer (group)
"Associate the current buffer with some article in the draft group."
(nndraft-open-server "")
@@ -182,6 +208,10 @@ are generated if and only if they are also in `message-draft-headers'.")
'write-contents-hooks)))
(gnus-make-local-hook hook)
(add-hook hook 'nndraft-generate-headers nil t))
+ (gnus-make-local-hook 'after-save-hook)
+ (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t)
+ (message-add-action '(nndraft-update-unread-articles)
+ 'exit 'postpone 'kill)
article))
(deffoo nndraft-request-group (group &optional server dont-check info)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 6882ed63135..ef5bee71629 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -190,7 +190,7 @@ textual parts.")
(let (article bytes 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.+UID \\([0-9]+\\)"))
(delete-region (point) (progn (forward-line 1) (point)))
(when (eobp)
(return)))
@@ -420,9 +420,9 @@ textual parts.")
(nnimap-login (car credentials) (cadr credentials))))
(if (car login-result)
(progn
- ;; Save the credentials if a save function exists
- ;; (such a function will only be passed if a new
- ;; token was created).
+ ;; Save the credentials if a save function exists
+ ;; (such a function will only be passed if a new
+ ;; token was created).
(when (functionp (nth 2 credentials))
(funcall (nth 2 credentials)))
;; See if CAPABILITY is set as part of login
@@ -880,15 +880,18 @@ textual parts.")
(with-temp-buffer
(mm-disable-multibyte)
(when (nnimap-request-article article group server (current-buffer))
- (nnheader-message 7 "Expiring article %s:%d" group article)
(when (functionp target)
(setq target (funcall target group)))
- (when (and target
- (not (eq target 'delete)))
- (if (or (gnus-request-group target t)
- (gnus-request-create-group target))
- (nnmail-expiry-target-group target group)
- (setq target nil)))
+ (if (and target
+ (not (eq target 'delete)))
+ (if (or (gnus-request-group target t)
+ (gnus-request-create-group target))
+ (progn
+ (nnmail-expiry-target-group target group)
+ (nnheader-message 7 "Expiring article %s:%d to %s"
+ group article target))
+ (setq target nil))
+ (nnheader-message 7 "Expiring article %s:%d" group article))
(when target
(push article deleted-articles))))))))
;; Change back to the current group again.
@@ -929,7 +932,7 @@ textual parts.")
(car (setq result (nnimap-parse-response))))
;; Select the last instance of the message in the group.
(and (setq article
- (car (last (assoc "SEARCH" (cdr result)))))
+ (car (last (cdr (assoc "SEARCH" (cdr result))))))
(string-to-number article))))))
(defun nnimap-delete-article (articles)
@@ -953,7 +956,8 @@ textual parts.")
nnimap-inbox
nnimap-split-methods)
(nnheader-message 7 "nnimap %s splitting mail..." server)
- (nnimap-split-incoming-mail)))
+ (nnimap-split-incoming-mail)
+ (nnheader-message 7 "nnimap %s splitting mail...done" server)))
(defun nnimap-marks-to-flags (marks)
(let (flags flag)
@@ -1227,6 +1231,10 @@ textual parts.")
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(when (and sequences
+ ;; 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))
(with-current-buffer (nnimap-buffer)
;; Wait for the final data to trickle in.
@@ -1557,8 +1565,9 @@ textual parts.")
(declare-function gnus-fetch-headers "gnus-sum"
(articles &optional limit force-new dependencies))
-(deffoo nnimap-request-thread (header)
- (let* ((id (mail-header-id header))
+(deffoo nnimap-request-thread (header &optional group server)
+ (when (nnimap-possibly-change-group group server)
+ (let* ((id (mail-header-id header))
(refs (split-string
(or (mail-header-references header)
"")))
@@ -1576,7 +1585,7 @@ textual parts.")
(gnus-fetch-headers
(and (car result) (delete 0 (mapcar #'string-to-number
(cdr (assoc "SEARCH" (cdr result))))))
- nil t))))
+ nil t)))))
(defun nnimap-possibly-change-group (group server)
(let ((open-result t))
@@ -1798,9 +1807,14 @@ textual parts.")
(defun nnimap-split-incoming-mail ()
(with-current-buffer (nnimap-buffer)
(let ((nnimap-incoming-split-list nil)
- (nnmail-split-methods (if (eq nnimap-split-methods 'default)
- nnmail-split-methods
- nnimap-split-methods))
+ (nnmail-split-methods
+ (cond
+ ((eq nnimap-split-methods 'default)
+ nnmail-split-methods)
+ (nnimap-split-methods
+ nnimap-split-methods)
+ (nnimap-split-fancy
+ 'nnmail-split-fancy)))
(nnmail-split-fancy (or nnimap-split-fancy
nnmail-split-fancy))
(nnmail-inhibit-default-split-group t)
@@ -1904,7 +1918,7 @@ textual parts.")
(let (article bytes)
(block nil
(while (not (eobp))
- (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
+ (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)"))
(delete-region (point) (progn (forward-line 1) (point)))
(when (eobp)
(return)))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index eaaac3f88ce..8099cc2a7cc 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -499,6 +499,31 @@ arrive at the correct group name, \"mail.misc\"."
:type '(directory)
:group 'nnir)
+(defcustom nnir-notmuch-program "notmuch"
+ "*Name of notmuch search executable."
+ :type '(string)
+ :group 'nnir)
+
+(defcustom nnir-notmuch-additional-switches '()
+ "*A list of strings, to be given as additional arguments to notmuch.
+
+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\"))"
+ :type '(repeat (string))
+ :group 'nnir)
+
+(defcustom nnir-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "*The prefix to remove from each file name returned by notmuch
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable is very similar to `nnir-namazu-remove-prefix', except
+that it is for notmuch, not Namazu."
+ :type '(regexp)
+ :group 'nnir)
+
;;; Developer Extension Variable:
(defvar nnir-engines
@@ -519,6 +544,8 @@ arrive at the correct group name, \"mail.misc\"."
((group . "Swish-e Group spec: ")))
(namazu nnir-run-namazu
())
+ (notmuch nnir-run-notmuch
+ ())
(hyrex nnir-run-hyrex
((group . "Hyrex Group spec: ")))
(find-grep nnir-run-find-grep
@@ -657,22 +684,40 @@ Add an entry here when adding a new search engine.")
'nov)))
(deffoo nnir-request-article (article &optional group server to-buffer)
- (if (stringp article)
+ (if (and (stringp article)
+ (not (eq 'nnimap (car (gnus-server-to-method server)))))
(nnheader-report
'nnir
- "nnir-retrieve-headers doesn't grok message ids: %s"
- article)
+ "nnir-request-article only groks message ids for nnimap servers: %s"
+ server)
(save-excursion
- (let ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article)))
- (message "Requesting article %d from group %s"
- artno artfullgroup)
- (if to-buffer
- (with-current-buffer to-buffer
- (let ((gnus-article-decode-hook nil))
- (gnus-request-article-this-buffer artno artfullgroup)))
- (gnus-request-article artno artfullgroup))
- (cons artfullgroup artno)))))
+ (let ((article article)
+ query)
+ (when (stringp article)
+ (setq gnus-override-method (gnus-server-to-method server))
+ (setq query
+ (list
+ (cons 'query (format "HEADER Message-ID %s" article))
+ (cons 'unique-id article)
+ (cons 'criteria "")
+ (cons 'shortcut t)))
+ (unless (and (equal query nnir-current-query)
+ (equal server nnir-current-server))
+ (setq nnir-artlist (nnir-run-imap query server))
+ (setq nnir-current-query query)
+ (setq nnir-current-server server))
+ (setq article 1))
+ (unless (zerop (length nnir-artlist))
+ (let ((artfullgroup (nnir-article-group article))
+ (artno (nnir-article-number article)))
+ (message "Requesting article %d from group %s"
+ artno artfullgroup)
+ (if to-buffer
+ (with-current-buffer to-buffer
+ (let ((gnus-article-decode-hook nil))
+ (gnus-request-article-this-buffer artno artfullgroup)))
+ (gnus-request-article artno artfullgroup))
+ (cons artfullgroup artno)))))))
(deffoo nnir-request-move-article (article group server accept-form
&optional last internal-move-group)
@@ -774,7 +819,7 @@ ready to be added to the list of search results."
(defun nnir-run-imap (query srv &optional groups)
"Run a search against an IMAP back-end server.
This uses a custom query language parser; see `nnir-imap-make-query' for
-details on the language and supported extensions"
+details on the language and supported extensions."
(save-excursion
(let ((qstring (cdr (assq 'query query)))
(server (cadr (gnus-server-to-method srv)))
@@ -787,33 +832,36 @@ details on the language and supported extensions"
(message "Opening server %s" server)
(apply
'vconcat
- (mapcar
- (lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-possibly-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let ((arts 0)
- (result (nnimap-command "UID SEARCH %s"
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring)))))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (setq arts (1+ arts)))))
- (and (car result) (cdr (assoc "SEARCH" (cdr result)))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (nreverse artlist)))
- groups)))))
+ (catch 'found
+ (mapcar
+ (lambda (group)
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-possibly-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((arts 0)
+ (result (nnimap-command "UID SEARCH %s"
+ (if (string= criteria "")
+ qstring
+ (nnir-imap-make-query
+ criteria qstring)))))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list artlist)))
+ (setq arts (1+ arts)))))
+ (and (car result) (cdr (assoc "SEARCH" (cdr result)))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (nreverse artlist)))
+ groups))))))
(defun nnir-imap-make-query (criteria qstring)
"Parse the query string and criteria into an appropriate IMAP search
@@ -1317,6 +1365,80 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(> (nnir-artitem-rsv x)
(nnir-artitem-rsv y)))))))))
+(defun nnir-run-notmuch (query server &optional group)
+ "Run QUERY against notmuch.
+Returns a vector of (group name, file name) pairs (also vectors,
+actually)."
+
+ ;; (when group
+ ;; (error "The notmuch backend cannot search specific groups"))
+
+ (save-excursion
+ (let ( (qstring (cdr (assq 'query query)))
+ (groupspec (cdr (assq 'group query)))
+ (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server))
+ artlist
+ (article-pattern (if (string= (gnus-group-server server) "nnmaildir")
+ ":[0-9]+"
+ "^[0-9]+$"))
+ artno dirnam filenam)
+
+ (when (equal "" qstring)
+ (error "notmuch: You didn't enter anything"))
+
+ (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (erase-buffer)
+
+ (if groupspec
+ (message "Doing notmuch query %s on %s..." qstring groupspec)
+ (message "Doing notmuch query %s..." qstring))
+
+ (let* ((cp-list `( ,nnir-notmuch-program
+ nil ; input from /dev/null
+ t ; output
+ nil ; don't redisplay
+ "search"
+ "--format=text"
+ "--output=files"
+ ,@(nnir-read-server-parm 'nnir-notmuch-additional-switches server)
+ ,qstring ; the query, in notmuch format
+ ))
+ (exitstatus
+ (progn
+ (message "%s args: %s" nnir-notmuch-program
+ (mapconcat 'identity (cddddr cp-list) " ")) ;; ???
+ (apply 'call-process cp-list))))
+ (unless (or (null exitstatus)
+ (zerop exitstatus))
+ (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus)
+ ;; notmuch failure reason is in this buffer, show it if
+ ;; the user wants it.
+ (when (> gnus-verbose 6)
+ (display-buffer nnir-tmp-buffer))))
+
+ ;; The results are output in the format of:
+ ;; absolute-path-name
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq filenam (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ artno (file-name-nondirectory filenam)
+ dirnam (file-name-directory filenam))
+ (forward-line 1)
+
+ ;; don't match directories
+ (when (string-match article-pattern artno)
+ (when (not (null dirnam))
+
+ ;; maybe limit results to matching groups.
+ (when (or (not groupspec)
+ (string-match groupspec dirnam))
+ (nnir-add-result dirnam artno "" prefix server artlist)))))
+
+ (message "Massaging notmuch output...done")
+
+ artlist)))
+
(defun nnir-run-find-grep (query server &optional grouplist)
"Run find and grep to obtain matching articles."
(let* ((method (gnus-server-to-method server))
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 5fa1a89cf48..ec270eba2ce 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -210,7 +210,9 @@ as unread by Gnus.")
(max 0)
min rdir num subdirectoriesp file)
;; Recurse down directories.
- (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2))
+ (setq subdirectoriesp
+ ;; nth 1 of file-attributes always 1 on MS Windows :(
+ (/= (nth 1 (file-attributes (file-truename dir))) 2))
(dolist (rdir files)
(if (or (not subdirectoriesp)
(file-regular-p rdir))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index aa4b9184dbb..986fd51a613 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -338,10 +338,8 @@ backend doesn't catch this error.")
"Record the command STRING."
(with-current-buffer (get-buffer-create "*nntp-log*")
(goto-char (point-max))
- (let ((time (current-time)))
- (insert (format-time-string "%Y%m%dT%H%M%S" time)
- "." (format "%03d" (/ (nth 2 time) 1000))
- " " nntp-address " " string "\n"))))
+ (insert (format-time-string "%Y%m%dT%H%M%S.%3N")
+ " " nntp-address " " string "\n")))
(defun nntp-report (&rest args)
"Report an error from the nntp backend. The first string in ARGS
@@ -1227,17 +1225,20 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(require 'netrc)
(let* ((list (netrc-parse nntp-authinfo-file))
(alist (netrc-machine list nntp-address "nntp"))
- (force (or (netrc-get alist "force") nntp-authinfo-force))
(auth-info
(nth 0 (auth-source-search :max 1
;; TODO: allow the virtual server name too
:host nntp-address
:port '("119" "nntp"))))
(auth-user (plist-get auth-info :user))
+ (auth-force (plist-get auth-info :force))
(auth-passwd (plist-get auth-info :secret))
(auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
+ (force (or (netrc-get alist "force")
+ nntp-authinfo-force
+ auth-force))
(user (or
;; this is preferred to netrc-*
auth-user
@@ -1362,7 +1363,8 @@ password contained in '~/.nntp-authinfo'."
(nntp-kill-buffer pbuffer))
(when (and (buffer-name pbuffer)
process)
- (when (and (fboundp 'set-network-process-option)
+ (when (and (fboundp 'set-network-process-option) ;; Unavailable in XEmacs.
+ (fboundp 'process-type) ;; Emacs 22 doesn't provide it.
(eq (process-type process) 'network))
;; Use TCP-keepalive so that connections that pass through a NAT router
;; don't hang when left idle.
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 0cc53ad2332..ea64c247d99 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -194,10 +194,11 @@ component group will show up when you enter the virtual group.")
(when buffer
(set-buffer buffer))
(let* ((gnus-override-method nil)
- (method (gnus-find-method-for-group
- nnvirtual-last-accessed-component-group)))
- (funcall (gnus-get-function method 'request-article)
- article nil (nth 1 method) buffer)))))
+ (gnus-command-method
+ (gnus-find-method-for-group
+ nnvirtual-last-accessed-component-group)))
+ (funcall (gnus-get-function gnus-command-method 'request-article)
+ article nil (nth 1 gnus-command-method) buffer)))))
;; This is a fetch by number.
(let* ((amap (nnvirtual-map-article article))
(cgroup (car amap)))
diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el
new file mode 100644
index 00000000000..5f9a61aa843
--- /dev/null
+++ b/lisp/gnus/plstore.el
@@ -0,0 +1,438 @@
+;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: PGP, GnuPG
+
+;; 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
+
+;; Plist based data store providing search and partial encryption.
+;;
+;; Creating:
+;;
+;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
+;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
+;; ;; Both `:host' and `:port' are public property.
+;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
+;; ;; No encryption will be needed.
+;; (plstore-save store)
+;;
+;; ;; `:user' is marked as secret.
+;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
+;; ;; `:password' is marked as secret.
+;; (plstore-put store "baz" '(:host "baz.example.org") '(:password "test"))
+;; ;; Those secret properties are encrypted together.
+;; (plstore-save store)
+;;
+;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
+;; (plstore-close store)
+;;
+;; Searching:
+;;
+;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
+;;
+;; ;; As the entry "foo" associated with "foo.example.org" has no
+;; ;; secret properties, no need to decryption.
+;; (plstore-find store '(:host ("foo.example.org")))
+;;
+;; ;; As the entry "bar" associated with "bar.example.org" has a
+;; ;; secret property `:user', Emacs tries to decrypt the secret (and
+;; ;; thus you will need to input passphrase).
+;; (plstore-find store '(:host ("bar.example.org")))
+;;
+;; ;; While the entry "baz" associated with "baz.example.org" has also
+;; ;; a secret property `:password', it is encrypted together with
+;; ;; `:user' of "bar", so no need to decrypt the secret.
+;; (plstore-find store '(:host ("bar.example.org")))
+;;
+;; (plstore-close store)
+;;
+;; Editing:
+;;
+;; Currently not supported but in the future plstore will provide a
+;; major mode to edit PLSTORE files.
+
+;;; Code:
+
+(require 'epg)
+
+(defgroup plstore nil
+ "Searchable, partially encrypted, persistent plist store"
+ :version "24.1"
+ :group 'files)
+
+(defcustom plstore-select-keys 'silent
+ "Control whether or not to pop up the key selection dialog.
+
+If t, always asks user to select recipients.
+If nil, query user only when `plstore-encrypt-to' is not set.
+If neither t nor nil, doesn't ask user. In this case, symmetric
+encryption is used."
+ :type '(choice (const :tag "Ask always" t)
+ (const :tag "Ask when recipients are not set" nil)
+ (const :tag "Don't ask" silent))
+ :group 'plstore)
+
+(defvar plstore-encrypt-to nil
+ "*Recipient(s) used for encrypting secret entries.
+May either be a string or a list of strings.")
+
+(put 'plstore-encrypt-to 'safe-local-variable
+ (lambda (val)
+ (or (stringp val)
+ (and (listp val)
+ (catch 'safe
+ (mapc (lambda (elt)
+ (unless (stringp elt)
+ (throw 'safe nil)))
+ val)
+ t)))))
+
+(put 'plstore-encrypt-to 'permanent-local t)
+
+(defvar plstore-cache-passphrase-for-symmetric-encryption nil)
+(defvar plstore-passphrase-alist nil)
+
+(defun plstore-passphrase-callback-function (_context _key-id plstore)
+ (if plstore-cache-passphrase-for-symmetric-encryption
+ (let* ((file (file-truename (plstore--get-buffer plstore)))
+ (entry (assoc file plstore-passphrase-alist))
+ passphrase)
+ (or (copy-sequence (cdr entry))
+ (progn
+ (unless entry
+ (setq entry (list file)
+ plstore-passphrase-alist
+ (cons entry
+ plstore-passphrase-alist)))
+ (setq passphrase
+ (read-passwd (format "Passphrase for PLSTORE %s: "
+ (plstore--get-buffer plstore))))
+ (setcdr entry (copy-sequence passphrase))
+ passphrase)))
+ (read-passwd (format "Passphrase for PLSTORE %s: "
+ (plstore--get-buffer plstore)))))
+
+(defun plstore-progress-callback-function (_context _what _char current total
+ handback)
+ (if (= current total)
+ (message "%s...done" handback)
+ (message "%s...%d%%" handback
+ (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
+
+(defun plstore--get-buffer (this)
+ (aref this 0))
+
+(defun plstore--get-alist (this)
+ (aref this 1))
+
+(defun plstore--get-encrypted-data (this)
+ (aref this 2))
+
+(defun plstore--get-secret-alist (this)
+ (aref this 3))
+
+(defun plstore--get-merged-alist (this)
+ (aref this 4))
+
+(defun plstore--set-buffer (this buffer)
+ (aset this 0 buffer))
+
+(defun plstore--set-alist (this plist)
+ (aset this 1 plist))
+
+(defun plstore--set-encrypted-data (this encrypted-data)
+ (aset this 2 encrypted-data))
+
+(defun plstore--set-secret-alist (this secret-alist)
+ (aset this 3 secret-alist))
+
+(defun plstore--set-merged-alist (this merged-alist)
+ (aset this 4 merged-alist))
+
+(defun plstore-get-file (this)
+ (buffer-file-name (plstore--get-buffer this)))
+
+(defun plstore--make (&optional buffer alist encrypted-data secret-alist
+ merged-alist)
+ (vector buffer alist encrypted-data secret-alist merged-alist))
+
+(defun plstore--init-from-buffer (plstore)
+ (goto-char (point-min))
+ (when (looking-at ";;; public entries")
+ (forward-line)
+ (plstore--set-alist plstore (read (point-marker)))
+ (forward-sexp)
+ (forward-char)
+ (when (looking-at ";;; secret entries")
+ (forward-line)
+ (plstore--set-encrypted-data plstore (read (point-marker))))
+ (plstore--merge-secret plstore)))
+
+;;;###autoload
+(defun plstore-open (file)
+ "Create a plstore instance associated with FILE."
+ (let* ((filename (file-truename file))
+ (buffer (or (find-buffer-visiting filename)
+ (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)
+ (error))
+ (setq buffer-file-name (file-truename file))
+ (set-buffer-modified-p nil)
+ (plstore--init-from-buffer store)
+ store)))
+
+(defun plstore-revert (plstore)
+ "Replace current data in PLSTORE with the file on disk."
+ (with-current-buffer (plstore--get-buffer plstore)
+ (revert-buffer t t)
+ (plstore--init-from-buffer plstore)))
+
+(defun plstore-close (plstore)
+ "Destroy a plstore instance PLSTORE."
+ (kill-buffer (plstore--get-buffer plstore)))
+
+(defun plstore--merge-secret (plstore)
+ (let ((alist (plstore--get-secret-alist plstore))
+ modified-alist
+ modified-plist
+ modified-entry
+ entry
+ plist
+ placeholder)
+ (plstore--set-merged-alist
+ plstore
+ (copy-tree (plstore--get-alist plstore)))
+ (setq modified-alist (plstore--get-merged-alist plstore))
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist)
+ plist (cdr entry)
+ modified-entry (assoc (car entry) modified-alist)
+ modified-plist (cdr modified-entry))
+ (while plist
+ (setq placeholder
+ (plist-member
+ modified-plist
+ (intern (concat ":secret-"
+ (substring (symbol-name (car plist)) 1)))))
+ (if placeholder
+ (setcar placeholder (car plist)))
+ (setq modified-plist
+ (plist-put modified-plist (car plist) (car (cdr plist))))
+ (setq plist (nthcdr 2 plist)))
+ (setcdr modified-entry modified-plist))))
+
+(defun plstore--decrypt (plstore)
+ (if (plstore--get-encrypted-data plstore)
+ (let ((context (epg-make-context 'OpenPGP))
+ plain)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'plstore-passphrase-callback-function
+ plstore))
+ (epg-context-set-progress-callback
+ context
+ (cons #'plstore-progress-callback-function
+ (format "Decrypting %s" (plstore-get-file plstore))))
+ (setq plain
+ (epg-decrypt-string context
+ (plstore--get-encrypted-data plstore)))
+ (plstore--set-secret-alist plstore (car (read-from-string plain)))
+ (plstore--merge-secret plstore)
+ (plstore--set-encrypted-data plstore nil))))
+
+(defun plstore--match (entry keys skip-if-secret-found)
+ (let ((result t) key-name key-value prop-value secret-name)
+ (while keys
+ (setq key-name (car keys)
+ key-value (car (cdr keys))
+ prop-value (plist-get (cdr entry) key-name))
+ (unless (member prop-value key-value)
+ (if skip-if-secret-found
+ (progn
+ (setq secret-name
+ (intern (concat ":secret-"
+ (substring (symbol-name key-name) 1))))
+ (if (plist-member (cdr entry) secret-name)
+ (setq result 'secret)
+ (setq result nil
+ keys nil)))
+ (setq result nil
+ keys nil)))
+ (setq keys (nthcdr 2 keys)))
+ result))
+
+(defun plstore-find (plstore keys)
+ "Perform search on PLSTORE with KEYS.
+KEYS is a plist."
+ (let (entries alist entry match decrypt plist)
+ ;; First, go through the merged plist alist and collect entries
+ ;; matched with keys.
+ (setq alist (plstore--get-merged-alist plstore))
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist)
+ match (plstore--match entry keys t))
+ (if (eq match 'secret)
+ (setq decrypt t)
+ (when match
+ (setq plist (cdr entry))
+ (while plist
+ (if (string-match "\\`:secret-" (symbol-name (car plist)))
+ (setq decrypt t
+ plist nil))
+ (setq plist (nthcdr 2 plist)))
+ (setq entries (cons entry entries)))))
+ ;; Second, decrypt the encrypted plist and try again.
+ (when decrypt
+ (setq entries nil)
+ (plstore--decrypt plstore)
+ (setq alist (plstore--get-merged-alist plstore))
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist)
+ match (plstore--match entry keys nil))
+ (if match
+ (setq entries (cons entry entries)))))
+ (nreverse entries)))
+
+(defun plstore-get (plstore name)
+ "Get an entry with NAME in PLSTORE."
+ (let ((entry (assoc name (plstore--get-merged-alist plstore)))
+ plist)
+ (setq plist (cdr entry))
+ (while plist
+ (if (string-match "\\`:secret-" (symbol-name (car plist)))
+ (progn
+ (plstore--decrypt plstore)
+ (setq entry (assoc name (plstore--get-merged-alist plstore))
+ plist nil))
+ (setq plist (nthcdr 2 plist))))
+ entry))
+
+(defun plstore-put (plstore name keys secret-keys)
+ "Put an entry with NAME in PLSTORE.
+KEYS is a plist containing non-secret data.
+SECRET-KEYS is a plist containing secret data."
+ (let (entry
+ plist
+ secret-plist
+ symbol)
+ (if secret-keys
+ (plstore--decrypt plstore))
+ (while secret-keys
+ (setq symbol
+ (intern (concat ":secret-"
+ (substring (symbol-name (car secret-keys)) 1))))
+ (setq plist (plist-put plist symbol t)
+ secret-plist (plist-put secret-plist
+ (car secret-keys) (car (cdr secret-keys)))
+ secret-keys (nthcdr 2 secret-keys)))
+ (while keys
+ (setq symbol
+ (intern (concat ":secret-"
+ (substring (symbol-name (car keys)) 1))))
+ (setq plist (plist-put plist (car keys) (car (cdr keys)))
+ keys (nthcdr 2 keys)))
+ (setq entry (assoc name (plstore--get-alist plstore)))
+ (if entry
+ (setcdr entry plist)
+ (plstore--set-alist
+ plstore
+ (cons (cons name plist) (plstore--get-alist plstore))))
+ (when secret-plist
+ (setq entry (assoc name (plstore--get-secret-alist plstore)))
+ (if entry
+ (setcdr entry secret-plist)
+ (plstore--set-secret-alist
+ plstore
+ (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
+ (plstore--merge-secret plstore)))
+
+(defun plstore-delete (plstore name)
+ "Delete an entry with NAME from PLSTORE."
+ (let ((entry (assoc name (plstore--get-alist plstore))))
+ (if entry
+ (plstore--set-alist
+ plstore
+ (delq entry (plstore--get-alist plstore))))
+ (setq entry (assoc name (plstore--get-secret-alist plstore)))
+ (if entry
+ (plstore--set-secret-alist
+ plstore
+ (delq entry (plstore--get-secret-alist plstore))))
+ (setq entry (assoc name (plstore--get-merged-alist plstore)))
+ (if entry
+ (plstore--set-merged-alist
+ plstore
+ (delq entry (plstore--get-merged-alist plstore))))))
+
+(defvar pp-escape-newlines)
+(defun plstore--insert-buffer (plstore)
+ (insert ";;; public entries -*- mode: plstore -*- \n"
+ (pp-to-string (plstore--get-alist plstore)))
+ (if (plstore--get-secret-alist plstore)
+ (let ((context (epg-make-context 'OpenPGP))
+ (pp-escape-newlines nil)
+ (recipients
+ (cond
+ ((listp plstore-encrypt-to) plstore-encrypt-to)
+ ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
+ cipher)
+ (epg-context-set-armor context t)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'plstore-passphrase-callback-function
+ plstore))
+ (setq cipher (epg-encrypt-string
+ context
+ (pp-to-string
+ (plstore--get-secret-alist plstore))
+ (if (or (eq plstore-select-keys t)
+ (and (null plstore-select-keys)
+ (not (local-variable-p 'plstore-encrypt-to
+ (current-buffer)))))
+ (epa-select-keys
+ context
+ "Select recipents for encryption.
+If no one is selected, symmetric encryption will be performed. "
+ recipients)
+ (if plstore-encrypt-to
+ (epg-list-keys context recipients)))))
+ (goto-char (point-max))
+ (insert ";;; secret entries\n" (pp-to-string cipher)))))
+
+(defun plstore-save (plstore)
+ "Save the contents of PLSTORE associated with a FILE."
+ (with-current-buffer (plstore--get-buffer plstore)
+ (erase-buffer)
+ (plstore--insert-buffer plstore)
+ (save-buffer)))
+
+(provide 'plstore)
+
+;;; plstore.el ends here
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 6f12d3d63e1..e29ddb0d44e 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -306,7 +306,8 @@ Returns the process associated with the connection."
(t
(or pop3-stream-type 'network)))
:capability-command "CAPA\r\n"
- :end-of-command "^\\.\r?\n\\|^\\(-ERR\\|+OK \\).*\n"
+ :end-of-command "^\\(-ERR\\|+OK \\).*\n"
+ :end-of-capability "^\\.\r?\n\\|^-ERR"
:success "^\\+OK.*\n"
:return-list t
:starttls-function
@@ -319,6 +320,7 @@ Returns the process associated with the connection."
(substring response (or (string-match "<" response) 0)
(+ 1 (or (string-match ">" response) -1)))))
(pop3-set-process-query-on-exit-flag (car result) nil)
+ (erase-buffer)
(car result)))))
;; Support functions
@@ -514,6 +516,8 @@ Otherwise, return the size of the message-id MSG"
(let ((start pop3-read-point) end)
(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))
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el
index 4beafd4b845..8e158f7ca0f 100644
--- a/lisp/gnus/registry.el
+++ b/lisp/gnus/registry.el
@@ -116,6 +116,12 @@
:type integer
:custom integer
:documentation "Prune as much as possible to get to this size.")
+ (prune-factor
+ :initarg :prune-factor
+ :initform 0.1
+ :type float
+ :custom float
+ :documentation "At the max-hard limit, prune size * this entries.")
(tracked :initarg :tracked
:initform nil
:type t
@@ -314,29 +320,58 @@ Errors out if the key exists already."
This is the key count of the :data slot."
(hash-table-count (oref db :data)))
- (defmethod registry-prune ((db registry-db))
+ (defmethod registry-prune ((db registry-db) &optional sortfun)
"Prunes the registry-db object THIS.
-Removes only entries without the :precious keys."
+Removes only entries without the :precious keys if it can,
+then removes oldest entries first.
+Returns the number of deleted entries.
+If SORTFUN is given, tries to keep entries that sort *higher*.
+SORTFUN is passed only the two keys so it must look them up directly."
+ (dolist (collector '(registry-prune-soft-candidates
+ registry-prune-hard-candidates))
+ (let* ((size (registry-size db))
+ (collected (funcall collector db))
+ (limit (nth 0 collected))
+ (candidates (nth 1 collected))
+ ;; sort the candidates if SORTFUN was given
+ (candidates (if sortfun (sort candidates sortfun) candidates))
+ (candidates-count (length candidates))
+ ;; are we over max-soft?
+ (prune-needed (> size limit)))
+
+ ;; while we have more candidates than we need to remove...
+ (while (and (> candidates-count (- size limit)) candidates)
+ (decf candidates-count)
+ (setq candidates (cdr candidates)))
+
+ (registry-delete db candidates nil)
+ (length candidates))))
+
+ (defmethod registry-prune-soft-candidates ((db registry-db))
+ "Collects pruning candidates from the registry-db object THIS.
+Proposes only entries without the :precious keys."
(let* ((precious (oref db :precious))
(precious-p (lambda (entry-key)
(cdr (memq (car entry-key) precious))))
(data (oref db :data))
(limit (oref db :max-soft))
- (size (registry-size db))
(candidates (loop for k being the hash-keys of data
using (hash-values v)
when (notany precious-p v)
- collect k))
- (candidates-count (length candidates))
- ;; are we over max-soft?
- (prune-needed (> size limit)))
+ collect k)))
+ (list limit candidates)))
- ;; while we have more candidates than we need to remove...
- (while (and (> candidates-count (- size limit)) candidates)
- (decf candidates-count)
- (setq candidates (cdr candidates)))
-
- (registry-delete db candidates nil))))
+ (defmethod registry-prune-hard-candidates ((db registry-db))
+ "Collects pruning candidates from the registry-db object THIS.
+Proposes any entries over the max-hard limit minus size * prune-factor."
+ (let* ((data (oref db :data))
+ ;; prune to (size * prune-factor) below the max-hard limit so
+ ;; we're not pruning all the time
+ (limit (max 0 (- (oref db :max-hard)
+ (* (registry-size db) (oref db :prune-factor)))))
+ (candidates (loop for k being the hash-keys of data
+ collect k)))
+ (list limit candidates))))
(ert-deftest registry-instantiation-test ()
(should (registry-db "Testing")))
@@ -407,15 +442,15 @@ Removes only entries without the :precious keys."
(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 "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 ()
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index da27edca6e5..f8a85579b4f 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -183,14 +183,23 @@ redirects somewhere else."
(message "No image under point")
(message "%s" text))))
-(defun shr-browse-image ()
- "Browse the image under point."
- (interactive)
+(defun shr-browse-image (&optional copy-url)
+ "Browse the image under point.
+If COPY-URL (the prefix if called interactively) is non-nil, copy
+the URL of the image to the kill buffer instead."
+ (interactive "P")
(let ((url (get-text-property (point) 'image-url)))
- (if (not url)
- (message "No image under point")
+ (cond
+ ((not url)
+ (message "No image under point"))
+ (copy-url
+ (with-temp-buffer
+ (insert url)
+ (copy-region-as-kill (point-min) (point-max))
+ (message "Copied %s" url)))
+ (t
(message "Browsing %s..." url)
- (browse-url url))))
+ (browse-url url)))))
(defun shr-insert-image ()
"Insert the image under point into the buffer."
@@ -517,15 +526,18 @@ redirects somewhere else."
(when (and (> (current-column) 0)
(> (car (image-size image t)) 400))
(insert "\n"))
- (insert-image image (or alt "*")))
+ (insert-image image (or alt "*"))
+ (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)
- (let* ((image (create-image data nil t))
+ (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))
@@ -544,11 +556,9 @@ redirects somewhere else."
(when (> (car size) window-width)
(setq image (or
(create-image data 'imagemagick t
- :width window-width)
+ :width window-width
+ :ascent 100)
image)))
- (when (and (fboundp 'create-animated-image)
- (eq (image-type data nil t) 'gif))
- (setq image (create-animated-image data 'gif t)))
image)))
;; url-cache-extract autoloads url-cache.
@@ -582,7 +592,7 @@ START, and END. Note that START and END should be merkers."
(when image
(goto-char start)
(funcall shr-put-image-function
- image (buffer-substring-no-properties start end))
+ image (buffer-substring start end))
(delete-region (point) end))))
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start end)
@@ -601,7 +611,7 @@ START, and END. Note that START and END should be merkers."
:help-echo (if title (format "%s (%s)" url title) url)
:keymap shr-map
url)
- (put-text-property start (point) 'face 'shr-link)
+ (shr-add-font start (point) 'shr-link)
(put-text-property start (point) 'shr-url url))
(defun shr-encode-url (url)
@@ -643,7 +653,7 @@ ones, in case fg and bg are nil."
(shr-put-color start end :background (car new-colors))))
new-colors)))
-;; Put a color in the region, but avoid putting colors on on blank
+;; Put a color in the region, but avoid putting colors on blank
;; text at the start of the line, and the newline at the end, to avoid
;; ugliness. Also, don't overwrite any existing color information,
;; since this can be called recursively, and we want the "inner" color
@@ -716,7 +726,8 @@ ones, in case fg and bg are nil."
(defun shr-put-color-1 (start end type color)
(let* ((old-props (get-text-property start 'face))
- (do-put (not (memq type old-props)))
+ (do-put (and (listp old-props)
+ (not (memq type old-props))))
change)
(while (< start end)
(setq change (next-single-property-change start 'face nil end))
@@ -724,7 +735,8 @@ ones, in case fg and bg are nil."
(put-text-property start change 'face
(nconc (list type color) old-props)))
(setq old-props (get-text-property change 'face))
- (setq do-put (not (memq type old-props)))
+ (setq do-put (and (listp old-props)
+ (not (memq type old-props))))
(setq start change))
(when (and do-put
(> end start))
@@ -778,6 +790,9 @@ ones, in case fg and bg are nil."
(defun shr-tag-s (cont)
(shr-fontize-cont cont 'shr-strike-through))
+(defun shr-tag-del (cont)
+ (shr-fontize-cont cont 'shr-strike-through))
+
(defun shr-tag-b (cont)
(shr-fontize-cont cont 'bold))
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 2f5c74220ea..cf23deb174b 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -133,9 +133,11 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in
(let ((types (list "pbm")))
(when (gnus-image-type-available-p 'xpm)
(push "xpm" types))
+ (when (gnus-image-type-available-p 'gif)
+ (push "gif" types))
types)
"*List of suffixes on smiley file names to try."
- :version "22.1"
+ :version "24.1"
:type '(repeat string)
:group 'smiley)
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index b56d0c416ef..8b56c7bd537 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -138,12 +138,6 @@ See `spam-stat-to-hash-table' for the format of the file."
:type 'file
:group 'spam-stat)
-(defcustom spam-stat-install-hooks t
- "Whether spam-stat should install its hooks in Gnus.
-This is set to nil if you use spam-stat through spam.el."
- :type 'boolean
- :group 'spam-stat)
-
(defcustom spam-stat-unknown-word-score 0.2
"The score to use for unknown words.
Also used for words that don't appear often enough."
@@ -658,9 +652,6 @@ COUNT defaults to 5"
(add-hook 'gnus-select-article-hook
'spam-stat-store-gnus-article-buffer))
-(when spam-stat-install-hooks
- (spam-stat-install-hooks-function))
-
(defun spam-stat-unload-hook ()
"Uninstall the spam-stat function hooks."
(interactive)
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index cbffeeab69e..33dbaaa1f0c 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -2260,51 +2260,44 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
(autoload 'spam-stat-save "spam-stat")
(autoload 'spam-stat-split-fancy "spam-stat"))
-(eval-and-compile
- (when (condition-case nil
- (let ((spam-stat-install-hooks nil))
- (require 'spam-stat))
- (file-error
- (defalias 'spam-stat-register-ham-routine 'ignore)
- (defalias 'spam-stat-register-spam-routine 'ignore)
- nil))
+(require 'spam-stat)
- (defun spam-check-stat ()
- "Check the spam-stat backend for the classification of this message"
- (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
- (spam-stat-buffer (buffer-name)) ; stat the current buffer
- category return)
- (spam-stat-split-fancy)))
+(defun spam-check-stat ()
+ "Check the spam-stat backend for the classification of this message"
+ (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
+ (spam-stat-buffer (buffer-name)) ; stat the current buffer
+ category return)
+ (spam-stat-split-fancy)))
- (defun spam-stat-register-spam-routine (articles &optional unregister)
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (if unregister
- (spam-stat-buffer-change-to-non-spam)
- (spam-stat-buffer-is-spam))))))
+(defun spam-stat-register-spam-routine (articles &optional unregister)
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article)))
+ (with-temp-buffer
+ (insert article-string)
+ (if unregister
+ (spam-stat-buffer-change-to-non-spam)
+ (spam-stat-buffer-is-spam))))))
- (defun spam-stat-unregister-spam-routine (articles)
- (spam-stat-register-spam-routine articles t))
+(defun spam-stat-unregister-spam-routine (articles)
+ (spam-stat-register-spam-routine articles t))
- (defun spam-stat-register-ham-routine (articles &optional unregister)
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (if unregister
- (spam-stat-buffer-change-to-spam)
- (spam-stat-buffer-is-non-spam))))))
+(defun spam-stat-register-ham-routine (articles &optional unregister)
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article)))
+ (with-temp-buffer
+ (insert article-string)
+ (if unregister
+ (spam-stat-buffer-change-to-spam)
+ (spam-stat-buffer-is-non-spam))))))
- (defun spam-stat-unregister-ham-routine (articles)
- (spam-stat-register-ham-routine articles t))
+(defun spam-stat-unregister-ham-routine (articles)
+ (spam-stat-register-ham-routine articles t))
- (defun spam-maybe-spam-stat-load ()
- (when spam-use-stat (spam-stat-load)))
+(defun spam-maybe-spam-stat-load ()
+ (when spam-use-stat (spam-stat-load)))
- (defun spam-maybe-spam-stat-save ()
- (when spam-use-stat (spam-stat-save)))))
+(defun spam-maybe-spam-stat-save ()
+ (when spam-use-stat (spam-stat-save)))
;;}}}
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 97ce7ca44ef..b13e6a77d5d 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -222,7 +222,7 @@ if the variable `help-downcase-arguments' is non-nil."
(defun help-do-arg-highlight (doc args)
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\- "w")
- (dolist (arg args doc)
+ (dolist (arg args)
(setq doc (replace-regexp-in-string
;; This is heuristic, but covers all common cases
;; except ARG1-ARG2
@@ -236,7 +236,8 @@ if the variable `help-downcase-arguments' is non-nil."
"\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
"\\>") ; end of word
(help-highlight-arg arg)
- doc t t 1)))))
+ doc t t 1)))
+ doc))
(defun help-highlight-arguments (usage doc &rest args)
(when (and usage (string-match "^(" usage))
@@ -557,6 +558,21 @@ suitable file is found, return nil."
(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)
@@ -715,12 +731,18 @@ it is displayed along with the global value."
(delete-region (1- from) from)))))))
(terpri)
(when locus
- (if (bufferp locus)
- (princ (format "%socal in buffer %s; "
- (if (get variable 'permanent-local)
- "Permanently l" "L")
- (buffer-name)))
- (princ (format "It is a frame-local variable; ")))
+ (cond
+ ((bufferp locus)
+ (princ (format "%socal in buffer %s; "
+ (if (get variable 'permanent-local)
+ "Permanently l" "L")
+ (buffer-name))))
+ ((framep locus)
+ (princ (format "It is a frame-local variable; ")))
+ ((terminal-live-p locus)
+ (princ (format "It is a terminal-local variable; ")))
+ (t
+ (princ (format "It is local to %S" locus))))
(if (not (default-boundp variable))
(princ "globally void")
(let ((val (default-value variable)))
@@ -789,7 +811,8 @@ it is displayed along with the global value."
(when obsolete
(setq extra-line t)
(princ " This variable is obsolete")
- (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
+ (if (nth 2 obsolete)
+ (princ (format " since %s" (nth 2 obsolete))))
(princ (cond ((stringp use) (concat ";\n " use))
(use (format ";\n use `%s' instead." (car obsolete)))
(t ".")))
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 642dac71ba6..1a96f29c4cc 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -305,23 +305,6 @@ Commands:
;;;###autoload
(defun help-mode-finish ()
- (if (eq help-window t)
- ;; If `help-window' is t, `view-return-to-alist' is handled by
- ;; `with-help-window'. In this case set `help-window' to the
- ;; selected window since now is the only moment where we can
- ;; unambiguously identify it.
- (setq help-window (selected-window))
- (let ((entry (assq (selected-window) view-return-to-alist)))
- (if entry
- ;; When entering Help mode from the Help window,
- ;; such as by following a link, preserve the same
- ;; meaning for the q command.
- ;; (setcdr entry (cons (selected-window) help-return-method))
- nil
- (setq view-return-to-alist
- (cons (cons (selected-window) help-return-method)
- view-return-to-alist)))))
-
(when (eq major-mode 'help-mode)
;; View mode's read-only status of existing *Help* buffer is lost
;; by with-output-to-temp-buffer.
diff --git a/lisp/help.el b/lisp/help.el
index 3a943274a14..e6496f625d1 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -55,7 +55,7 @@
;; 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' of `help-window'.")
+ "Marker to override default `window-point' in help windows.")
(defvar help-map
(let ((map (make-sparse-keymap)))
@@ -144,8 +144,6 @@ It computes a message, and applies the optional argument FUNCTION to it.
If FUNCTION is nil, it applies `message', thus displaying the message.
In addition, this function sets up `help-return-method', which see, that
specifies what to do when the user exits the help buffer."
- ;; Reset `help-window' here to avoid confusing `help-mode-finish'.
- (setq help-window nil)
(and (not (get-buffer-window standard-output))
(let ((first-message
(cond ((or
@@ -914,6 +912,7 @@ appeared on the mode-line."
;; In order to list up all minor modes, minor-mode-list
;; is used here instead of minor-mode-alist.
(delq nil (mapcar 'symbol-name minor-mode-list)))
+
(defun describe-minor-mode-from-symbol (symbol)
"Display documentation of a minor mode given as a symbol, SYMBOL"
(interactive (list (intern (completing-read
@@ -937,6 +936,7 @@ appeared on the mode-line."
(t
i))))
minor-mode-alist)))
+
(defun describe-minor-mode-from-indicator (indicator)
"Display documentation of a minor mode specified by INDICATOR.
If you call this function interactively, you can give indicator which
@@ -972,28 +972,32 @@ is currently activated with completion."
minor-modes nil)
(setq minor-modes (cdr minor-modes)))))
result))
-
;;; Automatic resizing of temporary buffers.
-
(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (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 `resize-temp-buffer-window'
-will give to a window displaying a temporary buffer.
-It can also be a function to be called to choose the height for such a buffer.
-It gets one argumemt, the buffer, and should return a positive integer."
+The value is the maximum height (in lines) which
+`resize-temp-buffer-window' will give to a window displaying a
+temporary buffer. It can also be a function to be called to
+choose the height for such a buffer. It gets one argumemt, the
+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")
(define-minor-mode temp-buffer-resize-mode
- "Toggle the mode which makes windows smaller for temporary buffers.
-With prefix argument ARG, turn the resizing of windows displaying temporary
-buffers on if ARG is positive or off otherwise.
-This makes the window the right height for its contents, but never
-more than `temp-buffer-max-height' nor less than `window-min-height'.
-This applies to `help', `apropos' and `completion' buffers, and some others."
+ "Toggle mode which makes windows smaller for temporary buffers.
+With prefix argument ARG, turn the resizing of windows displaying
+temporary buffers on if ARG is positive or off otherwise.
+
+This mode makes a window the right height for its contents, but
+never more than `temp-buffer-max-height' nor less than
+`window-min-height'.
+
+This mode is used by `help', `apropos' and `completion' buffers,
+and some others."
:global t :group 'help
(if temp-buffer-resize-mode
;; `help-make-xrefs' may add a `back' button and thus increase the
@@ -1003,29 +1007,26 @@ This applies to `help', `apropos' and `completion' buffers, and some others."
(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 it is the only window on its frame, if it
-is not as wide as the frame or if some of the window's contents are scrolled
-out of view."
- (unless (or (one-window-p 'nomini)
- (not (pos-visible-in-window-p (point-min)))
- (not (window-full-width-p)))
+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-iso-combined-p))
(fit-window-to-buffer
- (selected-window)
+ nil
(if (functionp temp-buffer-max-height)
- (funcall temp-buffer-max-height (current-buffer))
+ (funcall temp-buffer-max-height (window-buffer))
temp-buffer-max-height))))
-
-;;; help-window
-
+;;; Help windows.
(defcustom help-window-select 'other
"Non-nil means select help window for viewing.
Choices are:
never (nil) Select help window only if there is no other window
on its frame.
other Select help window unless the selected window is the
- only other window on its frame.
+ only other window on the help window's frame.
always (t) Always select the help window.
This option has effect if and only if the help window was created
@@ -1036,175 +1037,79 @@ by `with-help-window'"
:group 'help
:version "23.1")
-(defun help-window-display-message (quit-part window &optional other)
+(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.
-Optional argument OTHER non-nil means return text telling how to
-scroll the \"other\" window."
+Optional argument SCROLL non-nil means tell how to scroll WINDOW.
+SCROLL equal `other' means tell how to scroll the \"other\"
+window."
(let ((scroll-part
(cond
+ ;; If we don't have QUIT-PART we probably reuse a window
+ ;; showing the same buffer so we don't show any message.
+ ((not quit-part) nil)
((pos-visible-in-window-p
(with-current-buffer (window-buffer window)
- (point-max)) window)
- ;; Buffer end is visible.
+ (point-max)) window t)
+ ;; Buffer end is at least partially visible, no need to talk
+ ;; about scrolling.
".")
- (other ", \\[scroll-other-window] to scroll help.")
- (t ", \\[scroll-up] to scroll help."))))
+ ((eq scroll 'other)
+ ", \\[scroll-other-window] to scroll help.")
+ (scroll ", \\[scroll-up] to scroll help."))))
(message "%s"
(substitute-command-keys (concat quit-part scroll-part)))))
-(defun help-window-setup-finish (window &optional reuse keep-frame)
- "Finish setting up help window WINDOW.
-Select WINDOW according to the value of `help-window-select'.
-Display message telling how to scroll and eventually quit WINDOW.
-
-Optional argument REUSE non-nil means WINDOW has been reused by
-`display-buffer'. Optional argument KEEP-FRAME non-nil means
-that quitting should not delete WINDOW's frame."
- (let ((number-of-windows
- (length (window-list (window-frame window) 'no-mini window))))
- (cond
- ((eq window (selected-window))
- ;; The help window is the selected window, probably the
- ;; `pop-up-windows' nil case.
- (help-window-display-message
- (if reuse
- "Type \"q\" to restore this window"
- ;; This should not be taken.
- "Type \"q\" to quit") window))
- ((= number-of-windows 1)
- ;; The help window is alone on a frame and not the selected
- ;; window, could be the `pop-up-frames' t case.
- (help-window-display-message
- (cond
- (keep-frame "Type \"q\" to delete this window")
- (reuse "Type \"q\" to restore this window")
- (view-remove-frame-by-deleting "Type \"q\" to delete this frame")
- (t "Type \"q\" to iconify this frame"))
- window))
- ((and (= number-of-windows 2)
- (eq (window-frame window) (window-frame (selected-window))))
- ;; There are two windows on the help window's frame and the other
- ;; window is the selected one.
- (if (memq help-window-select '(nil other))
- ;; Do not select the help window.
- (help-window-display-message
- (if reuse
- ;; Offer `display-buffer' for consistency with
- ;; `help-print-return-message'. This is hardly TRT when
- ;; the other window and the selected window display the
- ;; same buffer but has been handled this way ever since.
- "Type \\[display-buffer] RET to restore the other window"
- ;; The classic "two windows" configuration.
- "Type \\[delete-other-windows] to delete the help window")
- window t)
- ;; Select help window and tell how to quit.
- (select-window window)
- (help-window-display-message
- (if reuse
- "Type \"q\" to restore this window"
- "Type \"q\" to delete this window") window)))
- (help-window-select
- ;; Issuing a message with 3 or more windows on the same frame
- ;; without selecting the help window doesn't make any sense.
- (select-window window)
- (help-window-display-message
- (if reuse
- "Type \"q\" to restore this window"
- "Type \"q\" to delete this window") window)))))
-
-(defun help-window-setup (list-of-frames list-of-window-tuples)
- "Set up help window.
-LIST-OF-FRAMES and LIST-OF-WINDOW-TUPLES are the lists of frames
-and window quadruples built by `with-help-window'. The help
-window itself is specified by the variable `help-window'."
- (let* ((help-buffer (window-buffer help-window))
- ;; `help-buffer' now denotes the help window's buffer.
- (view-entry
- (assq help-window
- (buffer-local-value 'view-return-to-alist help-buffer)))
- (help-entry (assq help-window list-of-window-tuples)))
-
- ;; Handle `help-window-point-marker'.
- (when (eq (marker-buffer help-window-point-marker) help-buffer)
- (set-window-point help-window help-window-point-marker)
- ;; Reset `help-window-point-marker'.
- (set-marker help-window-point-marker nil))
+(defun help-window-setup ()
+ "Set up help window for `with-help-window'.
+This relies on `display-buffer-window' being correctly set up by
+`display-buffer'."
+ (let* ((help-window (car-safe display-buffer-window))
+ (help-buffer (when (window-live-p help-window)
+ (window-buffer help-window)))
+ (help-value (cdr-safe display-buffer-window)))
+ (when help-buffer
+ ;; Handle `help-window-point-marker'.
+ (when (eq (marker-buffer help-window-point-marker) help-buffer)
+ (set-window-point help-window help-window-point-marker)
+ ;; Reset `help-window-point-marker'.
+ (set-marker help-window-point-marker nil))
- (cond
- (view-entry
- ;; `view-return-to-alist' has an entry for the help window.
(cond
- ((eq help-window (selected-window))
- ;; The help window is the selected window, probably because the
- ;; user followed a backward/forward button or a cross reference.
- ;; In this case just purge stale entries from
- ;; `view-return-to-alist' but leave the entry alone and don't
- ;; display a message.
- (view-return-to-alist-update help-buffer))
- ((and help-entry (eq (cadr help-entry) help-buffer))
- ;; The help window was not selected but displayed the help
- ;; buffer. In this case reuse existing exit information but try
- ;; to get back to the selected window when quitting. Don't
- ;; display a message since the user must have seen one before.
- (view-return-to-alist-update
- help-buffer (cons help-window
- (cons (selected-window) (cddr view-entry)))))
- (help-entry
- ;; The help window was not selected, did display the help buffer
- ;; earlier, but displayed another buffer when help was invoked.
- ;; Set up things so that quitting will show that buffer again.
- (view-return-to-alist-update
- help-buffer (cons help-window
- (cons (selected-window) (cdr help-entry))))
- (help-window-setup-finish help-window t))
+ ((or (eq help-window (selected-window))
+ (and (or (eq help-window-select t)
+ (and (eq help-window-select 'other)
+ (eq (window-frame help-window) (selected-frame))
+ (> (length (window-list nil 'no-mini)) 2)))
+ (select-window help-window)))
+ ;; The help window is or gets selected ...
+ (help-window-display-message
+ (cond
+ ((eq help-value 'new-window)
+ ;; ... and is new, ...
+ "Type \"q\" to delete this window")
+ ((eq help-value 'new-frame)
+ ;; ... is on a new frame ...
+ "Type \"q\" to delete this frame")
+ ((eq help-value 'reuse-other-window)
+ ;; ... or displayed some other buffer before.
+ "Type \"q\" to restore previous buffer"))
+ help-window t))
+ ((and (eq (window-frame help-window) (selected-frame))
+ (= (length (window-list nil 'no-mini)) 2))
+ ;; There are two windows on the help window's frame and the
+ ;; other one is the selected one.
+ (help-window-display-message
+ (cond
+ ((eq help-value 'new-window)
+ "Type \\[delete-other-windows] to delete the help window")
+ ((eq help-value 'reuse-other-window)
+ "Type \\[switch-to-prev-buffer] RET to restore previous buffer"))
+ help-window 'other))
(t
- ;; The help window is new but `view-return-to-alist' had an
- ;; entry for it. This should never happen.
- (view-return-to-alist-update
- help-buffer (cons help-window
- (cons (selected-window) 'quit-window)))
- (help-window-setup-finish help-window t))))
- (help-entry
- ;; `view-return-to-alist' does not have an entry for help window
- ;; but `list-of-window-tuples' does. Hence `display-buffer' must
- ;; have reused an existing window.
- (if (eq (cadr help-entry) help-buffer)
- ;; The help window displayed `help-buffer' before but no
- ;; `view-return-to-alist' entry was found probably because the
- ;; user manually switched to the help buffer. Set up things
- ;; for `quit-window' although `view-exit-action' should be
- ;; able to handle this case all by itself.
- (progn
- (view-return-to-alist-update
- help-buffer (cons help-window
- (cons (selected-window) 'quit-window)))
- (help-window-setup-finish help-window t))
- ;; The help window displayed another buffer before. Set up
- ;; things in a way that quitting can orderly show that buffer
- ;; again. The window-start and window-point information from
- ;; `list-of-window-tuples' provide the necessary information.
- (view-return-to-alist-update
- help-buffer (cons help-window
- (cons (selected-window) (cdr help-entry))))
- (help-window-setup-finish help-window t)))
- ((memq (window-frame help-window) list-of-frames)
- ;; The help window is a new window on an existing frame. This
- ;; case must be handled specially by `help-window-setup-finish'
- ;; and `view-mode-exit' to ascertain that quitting does _not_
- ;; inadvertently delete the frame.
- (view-return-to-alist-update
- help-buffer (cons help-window
- (cons (selected-window) 'keep-frame)))
- (help-window-setup-finish help-window nil t))
- (t
- ;; The help window is shown on a new frame. In this case quitting
- ;; shall handle both, the help window _and_ its frame. We changed
- ;; the default of `view-remove-frame-by-deleting' to t in order to
- ;; intuitively DTRT here.
- (view-return-to-alist-update
- help-buffer (cons help-window (cons (selected-window) t)))
- (help-window-setup-finish help-window)))))
+ ;; Not much to say here.
+ (help-window-display-message
+ "Type \"q\" in help window to quit" help-window))))))
;; `with-help-window' is a wrapper for `with-output-to-temp-buffer'
;; providing the following additional twists:
@@ -1212,50 +1117,35 @@ window itself is specified by the variable `help-window'."
;; (1) Issue more accurate messages telling how to scroll and quit the
;; help window.
-;; (2) Make `view-mode-exit' DTRT in more cases.
-
-;; (3) An option (customizable via `help-window-select') to select the
+;; (2) An option (customizable via `help-window-select') to select the
;; help window automatically.
-;; (4) A marker (`help-window-point-marker') to move point in the help
+;; (3) A marker (`help-window-point-marker') to move point in the help
;; window to an arbitrary buffer position.
;; Note: It's usually always wrong to use `help-print-return-message' in
;; the body of `with-help-window'.
(defmacro with-help-window (buffer-name &rest body)
- "Display buffer BUFFER-NAME in a help window evaluating BODY.
+ "Display buffer with name BUFFER-NAME in a help window evaluating BODY.
Select help window if the actual value of the user option
-`help-window-select' says so. Return last value in BODY."
+`help-window-select' says so. Return last value in BODY.
+
+You can specify where and how to show the buffer by binding the
+variable `temp-buffer-show-specifiers' to an appropriate value."
(declare (indent 1) (debug t))
- ;; Bind list-of-frames to `frame-list' and list-of-window-tuples to a
- ;; list of one <window window-buffer window-start window-point> tuple
- ;; for each live window.
- `(let ((list-of-frames (frame-list))
- (list-of-window-tuples
- (let (list)
- (walk-windows
- (lambda (window)
- (push (list window (window-buffer window)
- (window-start window) (window-point window))
- list))
- 'no-mini t)
- list)))
- ;; Make `help-window' t to trigger `help-mode-finish' to set
- ;; `help-window' to the actual help window.
- (setq help-window t)
- ;; Make `help-window-point-marker' point nowhere (the only place
- ;; where this should be set to a buffer position is within BODY).
+ `(progn
+ ;; Reset `display-buffer-window': `display-buffer' is
+ ;; supposed to set this to the window displaying the buffer plus
+ ;; some additional information.
+ (setq display-buffer-window nil)
+ ;; Make `help-window-point-marker' point nowhere. The only place
+ ;; where this should be set to a buffer position is within BODY.
(set-marker help-window-point-marker nil)
(prog1
;; Return value returned by `with-output-to-temp-buffer'.
(with-output-to-temp-buffer ,buffer-name
(progn ,@body))
- (when (windowp help-window)
- ;; Set up help window.
- (help-window-setup list-of-frames list-of-window-tuples))
- ;; Reset `help-window' to nil to avoid confusing future calls of
- ;; `help-mode-finish' with plain `with-output-to-temp-buffer'.
- (setq help-window nil))))
+ (when display-buffer-window (help-window-setup)))))
;; Called from C, on encountering `help-char' when reading a char.
;; Don't print to *Help*; that would clobber Help history.
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 6591ef44ff0..041c1ee938b 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1025,9 +1025,8 @@ This is called when `global-highlight-changes-mode' is turned on."
;; (defun hilit-chg-debug-show (&optional beg end)
;; (interactive)
;; (message "--- hilit-chg-debug-show ---")
-;; (hilit-chg-map-changes '(lambda (prop start end)
-;; (message "%d-%d: %s" start end prop)
-;; )
+;; (hilit-chg-map-changes (lambda (prop start end)
+;; (message "%d-%d: %s" start end prop))
;; beg end
;; ))
;;
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 55704dccb33..846f5f95187 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -93,14 +93,26 @@
(overlay-put global-hl-line-overlay 'face hl-line-face))))
(defcustom hl-line-sticky-flag t
- "Non-nil means highlight the current line in all windows.
+ "Non-nil means the HL-Line mode highlight appears in all windows.
Otherwise Hl-Line mode will highlight only in the selected
window. Setting this variable takes effect the next time you use
-the command `hl-line-mode' to turn Hl-Line mode on."
+the command `hl-line-mode' to turn Hl-Line mode on.
+
+This variable has no effect in Global Highlight Line mode.
+For that, use `global-hl-line-sticky-flag'."
:type 'boolean
:version "22.1"
:group 'hl-line)
+(defcustom global-hl-line-sticky-flag nil
+ "Non-nil means the Global HL-Line mode highlight appears in all windows.
+Otherwise Global Hl-Line mode will highlight only in the selected
+window. Setting this variable takes effect the next time you use
+the command `global-hl-line-mode' to turn Global Hl-Line mode on."
+ :type 'boolean
+ :version "24.1"
+ :group 'hl-line)
+
(defvar hl-line-range-function nil
"If non-nil, function to call to return highlight range.
The function of no args should return a cons cell; its car value
@@ -162,6 +174,10 @@ addition to `hl-line-highlight' on `post-command-hook'."
"Global minor mode to highlight the line about point in the current window.
With ARG, turn Global-Hl-Line mode on if ARG is positive, off otherwise.
+If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode
+highlights the line about the current buffer's point in all
+windows.
+
Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
`global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'."
:global t
@@ -181,7 +197,9 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
(unless global-hl-line-overlay
(setq global-hl-line-overlay (make-overlay 1 1)) ; to be moved
(overlay-put global-hl-line-overlay 'face hl-line-face))
- (overlay-put global-hl-line-overlay 'window (selected-window))
+ (overlay-put global-hl-line-overlay 'window
+ (unless global-hl-line-sticky-flag
+ (selected-window)))
(hl-line-move global-hl-line-overlay))))
(defun global-hl-line-unhighlight ()
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index ab67fcfcdfd..5f3680630f4 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -287,6 +287,7 @@ matches exist. \(Keybindings for uniquely matched commands
are exhibited within the square braces.)"
(let* ((non-essential t)
+ (md (completion--field-metadata (field-beginning)))
(comps (completion-all-sorted-completions))
(last (if (consp comps) (last comps)))
(base-size (cdr last))
@@ -299,11 +300,11 @@ are exhibited within the square braces.)"
(let* ((most-try
(if (and base-size (> base-size 0))
(completion-try-completion
- name candidates predicate (length name))
+ name candidates predicate (length name) md)
;; If the `comps' are 0-based, the result should be
;; the same with `comps'.
(completion-try-completion
- name comps nil (length name))))
+ name comps nil (length name) md)))
(most (if (consp most-try) (car most-try)
(if most-try (car comps) "")))
;; Compare name and most, so we can determine if name is
diff --git a/lisp/ido.el b/lisp/ido.el
index d1b5fd07938..b50ddcc1254 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -3903,7 +3903,7 @@ This is to make them appear as if they were \"virtual buffers\"."
(funcall f completion-list
:help-string "ido "
:activate-callback
- '(lambda (x y z) (message "Doesn't work yet, sorry!"))))
+ (lambda (x y z) (message "Doesn't work yet, sorry!"))))
;; else running Emacs
;;(add-hook 'completion-setup-hook 'completion-setup-function)
(display-completion-list completion-list)))))))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index c445e647878..4397ea0b413 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -62,7 +62,7 @@ the remaining prompts will be accidentally messed up. You may
wish to put something like the following in your `.emacs' file:
\(add-hook 'ielm-mode-hook
- '(lambda ()
+ (lambda ()
(define-key ielm-map \"\\C-w\" 'comint-kill-region)
(define-key ielm-map [C-S-backspace]
'comint-kill-whole-line)))
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 31a6aed7206..ce351f13a19 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -2590,7 +2590,7 @@ tags to their respective image file. Internal function used by
;; `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f)))
;; (directory-files (image-dired-dir) t ".+\.thumb\..+$"))
;; ;; Sort function. Compare time between two files.
-;; '(lambda (l1 l2)
+;; (lambda (l1 l2)
;; (time-less-p (car l1) (car l2)))))
;; (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files))))
;; (while (> dirsize image-dired-dir-max-size)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 17f006e81a1..f75f4e20219 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -271,7 +271,7 @@ stopping if the top or bottom edge of the image is reached."
;; Adjust frame and image size.
(defun image-mode-fit-frame ()
- "Fit the frame to the current image.
+ "Toggle whether to fit the frame to the current image.
This function assumes the current frame has only one window."
;; FIXME: This does not take into account decorations like mode-line,
;; minibuffer, header-line, ...
@@ -308,6 +308,7 @@ This function assumes the current frame has only one window."
(define-key map "\C-c\C-c" 'image-toggle-display)
(define-key map (kbd "SPC") 'image-scroll-up)
(define-key map (kbd "DEL") 'image-scroll-down)
+ (define-key map (kbd "RET") 'image-toggle-animation)
(define-key map [remap forward-char] 'image-forward-hscroll)
(define-key map [remap backward-char] 'image-backward-hscroll)
(define-key map [remap right-char] 'image-forward-hscroll)
@@ -373,16 +374,26 @@ to toggle between display as an image and display as text."
(add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
(add-hook 'after-revert-hook 'image-after-revert-hook nil t)
(run-mode-hooks 'image-mode-hook)
- (message "%s" (concat
- (substitute-command-keys
- "Type \\[image-toggle-display] to view the image as ")
- (if (image-get-display-property)
- "text" "an image") ".")))
+ (let ((image (image-get-display-property))
+ (msg1 (substitute-command-keys
+ "Type \\[image-toggle-display] to view the image as ")))
+ (cond
+ ((null image)
+ (message "%s" (concat msg1 "an image.")))
+ ((image-animated-p image)
+ (message "%s"
+ (concat msg1 "text, or "
+ (substitute-command-keys
+ "\\[image-toggle-animation] to animate."))))
+ (t
+ (message "%s" (concat msg1 "text."))))))
+
(error
(image-mode-as-text)
(funcall
(if (called-interactively-p 'any) 'error 'message)
"Cannot display image: %s" (cdr err)))))
+
;;;###autoload
(define-minor-mode image-minor-mode
"Toggle Image minor mode.
@@ -484,18 +495,21 @@ was inserted."
(buffer-substring-no-properties (point-min) (point-max)))
filename))
(type (image-type file-or-data nil data-p))
- (image0 (create-animated-image file-or-data type data-p))
- (image (append image0
- (image-transform-properties image0)))
- (props
+ (image (create-image file-or-data type data-p))
+ (inhibit-read-only t)
+ (buffer-undo-list t)
+ (modified (buffer-modified-p))
+ props)
+
+ ;; Discard any stale image data before looking it up again.
+ (image-flush image)
+ (setq image (append image (image-transform-properties image)))
+ (setq props
`(display ,image
intangible ,image
rear-nonsticky (display intangible)
read-only t front-sticky (read-only)))
- (inhibit-read-only t)
- (buffer-undo-list t)
- (modified (buffer-modified-p)))
- (image-flush image)
+
(let ((buffer-file-truename nil)) ; avoid changing dir mtime by lock_file
(add-text-properties (point-min) (point-max) props)
(restore-buffer-modified-p modified))
@@ -532,10 +546,42 @@ the image by calling `image-mode'."
(when (image-get-display-property)
(image-toggle-display-text)
;; Update image display.
- (redraw-frame (selected-frame))
+ (mapc (lambda (window) (redraw-frame (window-frame window)))
+ (get-buffer-window-list (current-buffer) 'nomini 'visible))
(image-toggle-display-image)))
+;;; Animated images
+
+(defcustom image-animate-loop nil
+ "Whether to play animated images on a loop in Image mode."
+ :type 'boolean
+ :version "24.1"
+ :group 'image)
+
+(defun image-toggle-animation ()
+ "Start or stop animating the current image."
+ (interactive)
+ (let ((image (image-get-display-property))
+ animation)
+ (cond
+ ((null image)
+ (error "No image is present"))
+ ((null (setq animation (image-animated-p image)))
+ (message "No image animation."))
+ (t
+ (let ((timer (image-animate-timer image)))
+ (if timer
+ (cancel-timer timer)
+ (let ((index (plist-get (cdr image) :index)))
+ ;; If we're at the end, restart.
+ (and index
+ (>= index (1- (car animation)))
+ (setq index nil))
+ (image-animate image index
+ (if image-animate-loop t)))))))))
+
+
;;; Support for bookmark.el
(declare-function bookmark-make-record-default
"bookmark" (&optional no-file no-context posn))
@@ -580,30 +626,38 @@ Its value should be one of the following:
- `fit-width', meaning to fit the image to the window width.
- A number, which is a scale factor (the default size is 100).")
-(defvar image-transform-rotation 0.0)
-
-(defun image-transform-properties (display)
- "Rescale and/or rotate the current image.
-The scale factor and rotation angle are given by the variables
-`image-transform-resize' and `image-transform-rotation'. This
-takes effect only if Emacs is compiled with ImageMagick support."
- (let* ((size (image-size display t))
- (height
- (cond
- ((numberp image-transform-resize)
- (unless (= image-transform-resize 100)
- (* image-transform-resize (cdr size))))
- ((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)))))
+(defvar image-transform-rotation 0.0
+ "Rotation angle for the image in the current Image mode buffer.")
+
+(defun image-transform-properties (spec)
+ "Return rescaling/rotation properties for image SPEC.
+These properties are determined by the Image mode variables
+`image-transform-resize' and `image-transform-rotation'. The
+return value is suitable for appending to an image spec.
+
+Recaling and rotation properties only take effect if Emacs is
+compiled with ImageMagick support."
+ (when (or image-transform-resize
+ (not (equal 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
+ (cond
+ ((numberp image-transform-resize)
+ (unless (= image-transform-resize 100)
+ (* image-transform-resize (cdr size))))
+ ((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))))))
(defun image-transform-set-scale (scale)
"Prompt for a number, and resize the current image by that amount.
diff --git a/lisp/image.el b/lisp/image.el
index 3b90ac46bd1..b67367ad436 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -389,6 +389,7 @@ IMAGE must be an image created with `create-image' or `defimage'.
IMAGE is displayed by putting an overlay into the current buffer with a
`before-string' STRING that has a `display' property whose value is the
image. STRING is defaulted if you omit it.
+The overlay created will have the `put-overlay' property set to t.
POS may be an integer or marker.
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
@@ -590,39 +591,40 @@ Example:
;;; Animated image API
-(defcustom image-animate-max-time 30
- "Time in seconds to animate images."
- :type 'integer
- :version "24.1"
- :group 'image)
-
(defconst image-animated-types '(gif)
"List of supported animated image types.")
-;;;###autoload
-(defun create-animated-image (file-or-data &optional type data-p &rest props)
- "Create an animated image.
-FILE-OR-DATA is an image file name or image data.
-Optional TYPE is a symbol describing the image type. If TYPE is omitted
-or nil, try to determine the image type from its first few bytes
-of image data. If that doesn't work, and FILE-OR-DATA is a file name,
-use its file extension as image type.
-Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
-Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:mask MASK'.
-Value is the image created, or nil if images of type TYPE are not supported.
-
-Images should not be larger than specified by `max-image-size'."
- (setq type (image-type file-or-data type data-p))
- (when (image-type-available-p type)
- (let* ((animate (memq type image-animated-types))
- (image
- (append (list 'image :type type (if data-p :data :file) file-or-data)
- (if animate '(:index 0))
- props)))
- (if animate
- (image-animate-start image))
- image)))
+(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."
+ (cond
+ ((eq (plist-get (cdr image) :type) 'gif)
+ (let* ((metadata (image-metadata image))
+ (images (plist-get metadata 'count))
+ (delay (plist-get metadata 'delay)))
+ (when (and images (> images 1) (numberp delay))
+ (if (< delay 0) (setq delay 0.1))
+ (cons images delay))))))
+
+(defun image-animate (image &optional index limit)
+ "Start animating IMAGE.
+Animation occurs by destructively altering the IMAGE spec list.
+
+With optional INDEX, begin animating from that animation frame.
+LIMIT specifies how long to animate the image. If omitted or
+nil, play the animation until the end. If t, loop forever. If a
+number, play until that number of seconds has elapsed."
+ (let ((animation (image-animated-p image))
+ timer)
+ (when animation
+ (if (setq timer (image-animate-timer image))
+ (cancel-timer timer))
+ (run-with-timer 0.2 nil 'image-animate-timeout
+ image (or index 0) (car animation)
+ 0 limit))))
(defun image-animate-timer (image)
"Return the animation timer for image IMAGE."
@@ -631,98 +633,78 @@ Images should not be larger than specified by `max-image-size'."
(while tail
(setq timer (car tail)
tail (cdr tail))
- (if (and (eq (aref timer 5) #'image-animate-timeout)
- (consp (aref timer 6))
- (eq (car (aref timer 6)) image))
+ (if (and (eq (aref timer 5) 'image-animate-timeout)
+ (eq (car-safe (aref timer 6)) image))
(setq tail nil)
(setq timer nil)))
timer))
-(defun image-animate-start (image &optional max-time)
- "Start animation of image IMAGE.
-Optional second arg MAX-TIME is number of seconds to animate image,
-or t to animate infinitely."
- (let ((anim (image-animated-p image))
- timer tmo)
- (when anim
- (if (setq timer (image-animate-timer image))
- (setcar (nthcdr 3 (aref timer 6)) max-time)
- (setq tmo (* (cdr anim) 0.01))
- (setq max-time (or max-time image-animate-max-time))
- (run-with-timer tmo nil #'image-animate-timeout
- image 1 (car anim)
- (if (numberp max-time)
- (- max-time tmo)
- max-time))))))
-
-(defun image-animate-stop (image)
- "Stop animation of image."
- (let ((timer (image-animate-timer image)))
- (when timer
- (cancel-timer timer))))
-
-(defun image-animate-timeout (image ino count time-left)
- (if (>= ino count)
- (setq ino 0))
- (plist-put (cdr image) :index ino)
+(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."
+ (plist-put (cdr image) :index n)
(force-window-update)
- (let ((anim (image-animated-p image)) tmo)
- (when anim
- (setq tmo (* (cdr anim) 0.01))
- (unless (and (= ino 0) (numberp time-left) (< time-left tmo))
- (run-with-timer tmo nil #'image-animate-timeout
- image (1+ ino) count
- (if (numberp time-left)
- (- time-left tmo)
- time-left))))))
-
-(defun image-animated-p (image)
- "Return non-nil if image is animated.
-Actually, return value is a cons (IMAGES . DELAY) where IMAGES
-is the number of sub-images in the animated image, and DELAY
-is the delay in 100ths of a second until the next sub-image
-shall be displayed."
- (cond
- ((eq (plist-get (cdr image) :type) 'gif)
- (let* ((metadata (image-metadata image))
- (images (plist-get metadata 'count))
- (extdata (plist-get metadata 'extension-data))
- (anim (plist-get extdata #xF9))
- (tmo (and (integerp images) (> images 1)
- (stringp anim) (>= (length anim) 4)
- (+ (aref anim 1) (* (aref anim 2) 256)))))
- (when tmo
- (if (eq tmo 0) (setq tmo 10))
- (cons images tmo))))))
+ (setq n (1+ n))
+ (let* ((time (float-time))
+ (animation (image-animated-p image))
+ ;; Subtract off the time we took to load the image from the
+ ;; stated delay time.
+ (delay (max (+ (cdr animation) time (- (float-time)))
+ 0.01))
+ done)
+ (if (>= n count)
+ (if limit
+ (setq n 0)
+ (setq done t)))
+ (setq time-elapsed (+ delay time-elapsed))
+ (if (numberp limit)
+ (setq done (>= time-elapsed limit)))
+ (unless done
+ (run-with-timer delay nil 'image-animate-timeout
+ image n count time-elapsed limit))))
(defcustom imagemagick-types-inhibit
'(C HTML HTM TXT PDF)
- ;; FIXME what are the possible options?
- ;; Are these actually file-name extensions?
- ;; Why are these upper-case when eg image-types is lower-case?
- "Types the ImageMagick loader should not try to handle."
- :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil)
+ "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)
;;;###autoload
(defun imagemagick-register-types ()
- "Register the file types that ImageMagick is able to handle."
- (if (fboundp 'imagemagick-types)
- (let ((im-types (imagemagick-types)))
- (dolist (im-inhibit imagemagick-types-inhibit)
- (setq im-types (remove im-inhibit im-types)))
- (dolist (im-type im-types)
- (let ((extension (downcase (symbol-name im-type))))
- (push
- (cons (concat "\\." extension "\\'") 'image-mode)
- auto-mode-alist)
- (push
- (cons (concat "\\." extension "\\'") 'imagemagick)
- image-type-file-name-regexps))))
- (error "Emacs was not built with ImageMagick support")))
+ "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.
+
+If Emacs is compiled without ImageMagick support, do nothing."
+ (when (fboundp 'imagemagick-types)
+ (let ((im-types (imagemagick-types)))
+ (dolist (im-inhibit imagemagick-types-inhibit)
+ (setq im-types (delq im-inhibit im-types)))
+ (dolist (im-type im-types)
+ (let ((extension
+ (concat "\\." (downcase (symbol-name im-type))
+ "\\'")))
+ (push (cons extension 'image-mode) auto-mode-alist)
+ (push (cons extension 'imagemagick)
+ image-type-file-name-regexps))))))
(provide 'image)
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 6baed1c422d..13edc0269dd 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1,4 +1,4 @@
-;;; info-look.el --- major-mode-sensitive Info index lookup facility
+;;; 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.
@@ -127,9 +127,9 @@ OTHER-MODES is a list of cross references to other help modes.")
(defun info-lookup-add-help (&rest arg)
"Add or update a help specification.
-Function arguments are one or more options of the form
+Function arguments are specified as keyword/argument pairs:
- KEYWORD ARGUMENT
+ \(KEYWORD . ARGUMENT)
KEYWORD is either `:topic', `:mode', `:regexp', `:ignore-case',
`:doc-spec', `:parse-rule', or `:other-modes'.
@@ -357,7 +357,7 @@ If optional argument QUERY is non-nil, query for the help mode."
(setq node (nth 0 (car doc-spec))
prefix (nth 2 (car doc-spec))
suffix (nth 3 (car doc-spec)))
- (when (condition-case error-data
+ (when (condition-case nil
(progn
;; Don't need Index menu fontifications here, and
;; they slow down the lookup.
@@ -473,7 +473,7 @@ If optional argument QUERY is non-nil, query for the help mode."
(t (nth 1 (car doc-spec)))))
(with-current-buffer buffer
(message "Processing Info node `%s'..." node)
- (when (condition-case error-data
+ (when (condition-case nil
(progn
(Info-goto-node node)
(setq doc-found t))
@@ -641,44 +641,42 @@ Return nil if there is nothing appropriate in the buffer near point."
info-lookup-mode
(info-lookup-change-mode 'file)))))
+(defun info-lookup-completions-at-point (topic mode)
+ "Try to complete a help item."
+ (or mode (setq mode (info-lookup-select-mode)))
+ (when (info-lookup->mode-value topic mode)
+ (let ((modes (info-lookup-quick-all-modes topic mode))
+ (start (point))
+ try)
+ (while (and (not try) modes)
+ (setq mode (car modes)
+ modes (cdr modes)
+ try (info-lookup-guess-default* topic mode))
+ (goto-char start))
+ (when try
+ (let ((completions (info-lookup->completions topic mode)))
+ (when completions
+ (when (info-lookup->ignore-case topic mode)
+ (setq completions
+ (lambda (string pred action)
+ (let ((completion-ignore-case t))
+ (complete-with-action
+ action completions string pred)))))
+ (save-excursion
+ ;; Find the original symbol and zap it.
+ (end-of-line)
+ (while (and (search-backward try nil t)
+ (< start (point))))
+ (list (match-beginning 0) (match-end 0) completions
+ :exclusive 'no))))))))
+
(defun info-complete (topic mode)
"Try to complete a help item."
(barf-if-buffer-read-only)
- (or mode (setq mode (info-lookup-select-mode)))
- (or (info-lookup->mode-value topic mode)
- (error "No %s completion available for `%s'" topic mode))
- (let ((modes (info-lookup-quick-all-modes topic mode))
- (start (point))
- try)
- (while (and (not try) modes)
- (setq mode (car modes)
- modes (cdr modes)
- try (info-lookup-guess-default* topic mode))
- (goto-char start))
- (and (not try)
- (error "Found no %S to complete" topic))
- (let ((completions (info-lookup->completions topic mode))
- (completion-ignore-case (info-lookup->ignore-case topic mode))
- completion)
- (setq completion (try-completion try completions))
- (cond ((not completion)
- (ding)
- (message "No match"))
- ((stringp completion)
- (or (assoc completion completions)
- (setq completion (completing-read
- (format "Complete %S: " topic)
- completions nil t completion
- info-lookup-history)))
- ;; Find the original symbol and zap it.
- (end-of-line)
- (while (and (search-backward try nil t)
- (< start (point))))
- (replace-match "")
- (insert completion))
- (t
- (message "%s is complete"
- (capitalize (prin1-to-string topic))))))))
+ (let ((data (info-lookup-completions-at-point topic mode)))
+ (if (null data)
+ (error "No %s completion available for `%s' at point" topic mode)
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))))
;;; Initialize some common modes.
@@ -720,11 +718,31 @@ Return nil if there is nothing appropriate in the buffer near point."
:mode 'makefile-mode
:regexp "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z][_a-zA-Z0-9-]*"
:doc-spec '(("(make)Name Index" nil
- "^[ \t]*`" "'")
- ("(automake)Macro and Variable Index" nil
"^[ \t]*`" "'"))
- :parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+"
- :other-modes '(automake-mode))
+ :parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+")
+
+(info-lookup-maybe-add-help
+ :topic 'symbol
+ :mode 'makefile-automake-mode
+ ;; similar regexp/parse-rule as makefile-mode, but also the following
+ ;; (which have index entries),
+ ;; "##" special automake comment
+ ;; "+=" append operator, separate from the GNU make one
+ :regexp "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z][_a-zA-Z0-9-]*\\|##\\|\\+="
+ :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.
+ ("(automake)Variable Index" nil "^[ \t]*`" "'")
+ ;; In automake 1.4 macros and variables were a combined node.
+ ("(automake)Macro and Variable Index" nil "^[ \t]*`" "'")
+ ;; Directives like "if" are in the "General Index".
+ ;; Prefix "`" since the text for say `+=' isn't always an
+ ;; @item etc and so not always at the start of a line.
+ ("(automake)General Index" nil "`" "'")
+ ;; In automake 1.3 there was just a single "Index" node.
+ ("(automake)Index" nil "`" "'"))
+ :other-modes '(makefile-mode))
(info-lookup-maybe-add-help
:mode 'texinfo-mode
diff --git a/lisp/info.el b/lisp/info.el
index 796fd7e2256..cbdc8cc7ab3 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -464,6 +464,7 @@ be last in the list.")
"Insert the contents of an Info file in the current buffer.
Do the right thing if the file has been compressed or zipped."
(let* ((tail Info-suffix-list)
+ (jka-compr-verbose nil)
(lfn (if (fboundp 'msdos-long-file-names)
(msdos-long-file-names)
t))
@@ -621,7 +622,7 @@ in `Info-file-supports-index-cookies-list'."
Optional argument FILE-OR-NODE specifies the file to examine;
the default is the top-level directory of Info.
Called from a program, FILE-OR-NODE may specify an Info node of the form
-`(FILENAME)NODENAME'.
+\"(FILENAME)NODENAME\".
Optional argument BUFFER specifies the Info buffer name;
the default buffer name is *info*. If BUFFER exists,
just switch to BUFFER. Otherwise, create a new buffer
@@ -728,6 +729,11 @@ just return nil (no error)."
(append Info-directory-list
Info-additional-directory-list)
Info-directory-list)))))
+ ;; Fall back on the installation directory if we can't find
+ ;; the info node anywhere else.
+ (when installation-directory
+ (setq dirs (append dirs (list (expand-file-name
+ "info" installation-directory)))))
;; Search the directory list for file FILENAME.
(while (and dirs (not found))
(setq temp (expand-file-name filename (car dirs)))
@@ -1572,7 +1578,12 @@ If FORK is a string, it is the name to use for the new buffer."
(defvar Info-read-node-completion-table)
(defun Info-read-node-name-2 (dirs suffixes string pred action)
- "Virtual completion table for file names input in Info node names."
+ "Internal function used to complete Info node names.
+Return a completion table for Info files---the FILENAME part of a
+node named \"(FILENAME)NODENAME\". DIRS is a list of Info
+directories to search if FILENAME is not absolute; SUFFIXES is a
+list of valid filename suffixes for Info files. See
+`try-completion' for a description of the remaining arguments."
(setq suffixes (remove "" suffixes))
(when (file-name-absolute-p string)
(setq dirs (list (file-name-directory string))))
@@ -1602,10 +1613,9 @@ If FORK is a string, it is the name to use for the new buffer."
(push (if string-dir (concat string-dir file) file) names)))))
(complete-with-action action names string pred)))
-;; This function is used as the "completion table" while reading a node name.
-;; It does completion using the alist in Info-read-node-completion-table
-;; unless STRING starts with an open-paren.
(defun Info-read-node-name-1 (string predicate code)
+ "Internal function used by `Info-read-node-name'.
+See `completing-read' for a description of arguments and usage."
(cond
;; First complete embedded file names.
((string-match "\\`([^)]*\\'" string)
@@ -1618,7 +1628,6 @@ If FORK is a string, it is the name to use for the new buffer."
(substring string 1)
predicate
code))
-
;; If a file name was given, then any node is fair game.
((string-match "\\`(" string)
(cond
@@ -1630,9 +1639,10 @@ If FORK is a string, it is the name to use for the new buffer."
code Info-read-node-completion-table string predicate))))
;; Arrange to highlight the proper letters in the completion list buffer.
-
-
(defun Info-read-node-name (prompt)
+ "Read an Info node name with completion, prompting with PROMPT.
+A node name can have the form \"NODENAME\", referring to a node
+in the current Info file, or \"(FILENAME)NODENAME\"."
(let* ((completion-ignore-case t)
(Info-read-node-completion-table (Info-build-node-completions))
(nodename (completing-read prompt 'Info-read-node-name-1 nil t)))
@@ -2092,7 +2102,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
))
(defun Info-directory-toc-nodes (filename)
- "Directory-specific implementation of `Info-directory-toc-nodes'."
+ "Directory-specific implementation of `Info-toc-nodes'."
`(,filename
("Top" nil nil nil)))
@@ -3230,7 +3240,7 @@ STRING is the search string given as an argument to `info-apropos',
MATCHES is a list of index matches found by `Info-apropos-matches'.")
(defun Info-apropos-toc-nodes (filename)
- "Apropos-specific implementation of `Info-apropos-toc-nodes'."
+ "Apropos-specific implementation of `Info-toc-nodes'."
(let ((nodes (mapcar 'car (reverse Info-apropos-nodes))))
`(,filename
("Top" nil nil ,nodes)
@@ -3281,7 +3291,6 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.")
"Collect STRING matches from all known Info files on your system.
Return a list of matches where each element is in the format
\((FILENAME INDEXTEXT NODENAME LINENUMBER))."
- (interactive "sIndex apropos: ")
(unless (string= string "")
(let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
(regexp-quote string)))
@@ -3646,7 +3655,6 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "\C-m" 'Info-follow-nearest-node)
(define-key map "\t" 'Info-next-reference)
(define-key map "\e\t" 'Info-prev-reference)
- (define-key map [(shift tab)] 'Info-prev-reference)
(define-key map [backtab] 'Info-prev-reference)
(define-key map "1" 'Info-nth-menu-item)
(define-key map "2" 'Info-nth-menu-item)
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 2cae1262521..9614479072a 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -280,10 +280,10 @@ the current loop.")
;;;###autoload
(defun ccl-compile (ccl-program)
"Return the compiled code of CCL-PROGRAM as a vector of integers."
- (if (or (null (consp ccl-program))
- (null (integerp (car ccl-program)))
- (null (listp (car (cdr ccl-program)))))
- (error "CCL: Invalid CCL program: %s" ccl-program))
+ (unless (and (consp ccl-program)
+ (integerp (car ccl-program))
+ (listp (car (cdr ccl-program))))
+ (error "CCL: Invalid CCL program: %s" ccl-program))
(if (null (vectorp ccl-program-vector))
(setq ccl-program-vector (make-vector 8192 0)))
(setq ccl-loop-head nil ccl-breaks nil)
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 455cbe697d6..a9657c17b9f 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1206,22 +1206,8 @@ Setup char-width-table appropriate for non-CJK language environment."
;;; Setting unicode-category-table.
-;; This macro is to build unicode-category-table at compile time so
-;; that C code can access the table efficiently.
-(defmacro build-unicode-category-table ()
- (let ((table (make-char-table 'unicode-category-table nil)))
- (dotimes (i #x110000)
- (if (or (< i #xD800)
- (and (>= i #xF900) (< i #x30000))
- (and (>= i #xE0000) (< i #xE0200)))
- (aset table i (get-char-code-property i 'general-category))))
- (set-char-table-range table '(#xE000 . #xF8FF) 'Co)
- (set-char-table-range table '(#xF0000 . #xFFFFD) 'Co)
- (set-char-table-range table '(#x100000 . #x10FFFD) 'Co)
- (optimize-char-table table 'eq)
- table))
-
-(setq unicode-category-table (build-unicode-category-table))
+(setq unicode-category-table
+ (unicode-property-table-internal 'general-category))
(map-char-table #'(lambda (key val)
(if (and val
(or (and (/= (aref (symbol-name val) 0) ?M)
diff --git a/lisp/international/charprop.el b/lisp/international/charprop.el
index 5c3efcc9d07..919666010b1 100644
--- a/lisp/international/charprop.el
+++ b/lisp/international/charprop.el
@@ -1,8 +1,4 @@
-;; Copyright (C) 1991-2010 Unicode, Inc.
-;; This file was generated from the Unicode data file at
-;; http://www.unicode.org/Public/UNIDATA/UnicodeData.txt.
-;; See lisp/international/README for the copyright and permission notice.
-
+;; Automatically generated by unidata-gen.el.
;; FILE: uni-name.el
(define-char-code-property 'name "uni-name.el"
"Unicode character name.
@@ -45,7 +41,7 @@ Property value is an integer or a floating point.")
;; FILE: uni-mirrored.el
(define-char-code-property 'mirrored "uni-mirrored.el"
"Unicode bidi mirrored flag.
-Property value is a symbol `Y' or `N'.")
+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.
@@ -66,6 +62,11 @@ Property value is a character.")
(define-char-code-property 'titlecase "uni-titlecase.el"
"Unicode simple titlecase mapping.
Property value is a character.")
+;; FILE: uni-mirrored.el
+(define-char-code-property 'mirroring "uni-mirrored.el"
+ "Unicode bidi-mirroring characters.
+Property value is a character that has the corresponding mirroring image,
+or nil for non-mirrored character.")
;; Local Variables:
;; coding: utf-8
;; no-byte-compile: t
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 5f4d3ea849e..6a73aaaa838 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -397,7 +397,11 @@ If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
systems set by this function will use that type of EOL conversion.
A coding system that requires automatic detection of text+encoding
-\(e.g. undecided, unix) can't be preferred."
+\(e.g. undecided, unix) can't be preferred.
+
+To prefer, for instance, utf-8, say the following:
+
+ \(prefer-coding-system 'utf-8)"
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" coding-system))
@@ -1308,11 +1312,11 @@ This is the input method activated automatically by the command
`toggle-input-method' (\\[toggle-input-method])."
:link '(custom-manual "(emacs)Input Methods")
:group 'mule
- :type '(choice (const nil) (string
- :completion-ignore-case t
- :complete-function widget-string-complete
- :completion-alist input-method-alist
- :prompt-history input-method-history))
+ :type '(choice (const nil)
+ (string
+ :completions (apply-partially
+ #'completion-table-case-fold input-method-alist)
+ :prompt-history input-method-history))
:set-after '(current-language-environment))
(put 'input-method-function 'permanent-local t)
@@ -1875,10 +1879,10 @@ specifies the character set for the major languages of Western Europe."
(define-widget 'charset 'symbol
"An Emacs charset."
:tag "Charset"
- :complete-function (lambda ()
- (interactive)
- (lisp-complete-symbol 'charsetp))
- :completion-ignore-case t
+ :completions (apply-partially #'completion-table-with-predicate
+ (apply-partially #'completion-table-case-fold
+ obarray)
+ #'charsetp 'strict)
:value 'ascii
:validate (lambda (widget)
(unless (charsetp (widget-value widget))
@@ -1912,9 +1916,9 @@ See `set-language-info-alist' for use in programs."
(set-language-environment current-language-environment)))
:type `(alist
:key-type (string :tag "Language environment"
- :completion-ignore-case t
- :complete-function widget-string-complete
- :completion-alist language-info-alist)
+ :completions
+ (apply-partially #'completion-table-case-fold
+ language-info-alist))
:value-type
(alist :key-type symbol
:options ((documentation string)
@@ -1927,9 +1931,9 @@ See `set-language-info-alist' for use in programs."
(nonascii-translation charset)
(input-method
(string
- :completion-ignore-case t
- :complete-function widget-string-complete
- :completion-alist input-method-alist
+ :completions
+ (apply-partially #'completion-table-case-fold
+ input-method-alist)
:prompt-history input-method-history))
(features (repeat symbol))
(unibyte-display coding-system)))))
@@ -2709,16 +2713,6 @@ See also `locale-charset-language-names', `locale-language-names',
;;; Character property
-;; Each element has the form (PROP . TABLE).
-;; PROP is a symbol representing a character property.
-;; TABLE is a char-table containing the property value for each character.
-;; TABLE may be a name of file to load to build a char-table.
-;; Don't modify this variable directly but use `define-char-code-property'.
-
-(defvar char-code-property-alist nil
- "Alist of character property name vs char-table containing property values.
-Internal use only.")
-
(put 'char-code-property-table 'char-table-extra-slots 5)
(defun define-char-code-property (name table &optional docstring)
@@ -2770,32 +2764,23 @@ See also the documentation of `get-char-code-property' and
(defun get-char-code-property (char propname)
"Return the value of CHAR's PROPNAME property."
- (let ((slot (assq propname char-code-property-alist)))
- (if slot
- (let (table value func)
- (if (stringp (cdr slot))
- (load (cdr slot) nil t))
- (setq table (cdr slot)
- value (aref table char)
- func (char-table-extra-slot table 1))
+ (let ((table (unicode-property-table-internal propname)))
+ (if table
+ (let ((func (char-table-extra-slot table 1)))
(if (functionp func)
- (setq value (funcall func char value table)))
- value)
+ (funcall func char (aref table char) table)
+ (get-unicode-property-internal table char)))
(plist-get (aref char-code-property-table char) propname))))
(defun put-char-code-property (char propname value)
"Store CHAR's PROPNAME property with VALUE.
It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
- (let ((slot (assq propname char-code-property-alist)))
- (if slot
- (let (table func)
- (if (stringp (cdr slot))
- (load (cdr slot) nil t))
- (setq table (cdr slot)
- func (char-table-extra-slot table 2))
+ (let ((table (unicode-property-table-internal propname)))
+ (if table
+ (let ((func (char-table-extra-slot table 2)))
(if (functionp func)
(funcall func char value table)
- (aset table char value)))
+ (put-unicode-property-internal table char value)))
(let* ((plist (aref char-code-property-table char))
(x (plist-put plist propname value)))
(or (eq x plist)
@@ -2805,13 +2790,9 @@ It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
(defun char-code-property-description (prop value)
"Return a description string of character property PROP's value VALUE.
If there's no description string for VALUE, return nil."
- (let ((slot (assq prop char-code-property-alist)))
- (if slot
- (let (table func)
- (if (stringp (cdr slot))
- (load (cdr slot) nil t))
- (setq table (cdr slot)
- func (char-table-extra-slot table 3))
+ (let ((table (unicode-property-table-internal prop)))
+ (if table
+ (let ((func (char-table-extra-slot table 3)))
(if (functionp func)
(funcall func value))))))
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 2174beb19c9..f47d73a9508 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -818,7 +818,7 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
(bar "|")
lower upper row)
;; Make table without horizontal lines. Each column for a key
- ;; has the form "| LU |" where L is for lower key and and U is
+ ;; has the form "| LU |" where L is for lower key and U is
;; for a upper key. If width of L (U) is greater than 1,
;; preceding (following) space is not inserted.
(put-text-property 0 1 'face 'bold bar)
@@ -2253,12 +2253,10 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((buffer (window-buffer))
- choice
- base-size)
+ choice)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(if completion-reference-buffer
(setq buffer completion-reference-buffer))
- (setq base-size completion-base-size)
(save-excursion
(goto-char (posn-point (event-start event)))
(let (beg end)
@@ -2272,26 +2270,23 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
(setq choice (buffer-substring beg end)))))
-; (let ((owindow (selected-window)))
-; (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 owindow))
+ ;; (let ((owindow (selected-window)))
+ ;; (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 owindow))
(quail-delete-region)
- (quail-choose-completion-string choice buffer base-size)
+ (setq quail-current-str choice)
+ ;; FIXME: We need to pass `base-position' here.
+ ;; FIXME: why do we need choose-completion-string with all its
+ ;; completion-specific logic?
+ (choose-completion-string choice buffer)
(quail-terminate-translation)))
-;; BASE-SIZE here is for compatibility with an (unused) arg of a
-;; previous implementation.
-(defun quail-choose-completion-string (choice &optional buffer base-size)
- (setq quail-current-str choice)
- ;; FIXME: We need to pass `base-position' here.
- (choose-completion-string choice buffer))
-
(defun quail-build-decode-map (map-list key decode-map num
&optional maxnum ignores)
"Build a decoding map.
@@ -2458,10 +2453,10 @@ should be made by `quail-build-decode-map' (which see)."
(define-button-type 'quail-keyboard-layout-button
:supertype 'help-xref
- 'help-function '(lambda (layout)
- (help-setup-xref `(quail-keyboard-layout-button ,layout)
- nil)
- (quail-show-keyboard-layout layout))
+ 'help-function (lambda (layout)
+ (help-setup-xref `(quail-keyboard-layout-button ,layout)
+ nil)
+ (quail-show-keyboard-layout layout))
'help-echo (purecopy "mouse-2, RET: show keyboard layout"))
(define-button-type 'quail-keyboard-customize-button
diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el
index 9e571ef9d0d..e7682c6d8ff 100644
--- a/lisp/international/uni-bidi.el
+++ b/lisp/international/uni-bidi.el
Binary files differ
diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el
index 80538f7b416..a4455decc52 100644
--- a/lisp/international/uni-category.el
+++ b/lisp/international/uni-category.el
Binary files differ
diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el
index 2ee74d8b818..227b9d0af79 100644
--- a/lisp/international/uni-combining.el
+++ b/lisp/international/uni-combining.el
Binary files differ
diff --git a/lisp/international/uni-comment.el b/lisp/international/uni-comment.el
index dcc717977c7..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 22207a224b0..2c424ffb5de 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 f35bcebfed8..b0bf07bbe85 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 692dea1edc8..fc52fd8c28c 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 7cc601159f0..41890018204 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 5129a93396d..006cf575591 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 5b9e8323d21..7fac18b278d 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 278ad683fe4..d16e8c00870 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 2e283492408..4e704e5cdd0 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 729a469d103..b8098c81876 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 0714b14794f..899276eb725 100644
--- a/lisp/international/uni-uppercase.el
+++ b/lisp/international/uni-uppercase.el
Binary files differ
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 7db7f30dd89..50e7b331c85 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1062,6 +1062,22 @@ nonincremental search instead via `isearch-edit-string'."
(defvar minibuffer-history-symbol) ;; from external package gmhist.el
+(defun isearch-fail-pos ()
+ "Position of first mismatch in search string, or its length if none."
+ (let ((cmds isearch-cmds))
+ (if (and isearch-success (not isearch-error))
+ (length isearch-message)
+ (while (or (not (isearch-success-state (car cmds)))
+ (isearch-error-state (car cmds)))
+ (pop cmds))
+ (let ((succ-msg (and cmds (isearch-message-state (car cmds)))))
+ (if (and (stringp succ-msg)
+ (< (length succ-msg) (length isearch-message))
+ (equal succ-msg
+ (substring isearch-message 0 (length succ-msg))))
+ (length succ-msg)
+ 0)))))
+
(defun isearch-edit-string ()
"Edit the search string in the minibuffer.
The following additional command keys are active while editing.
@@ -1141,7 +1157,7 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
(setq isearch-new-string
(read-from-minibuffer
(isearch-message-prefix nil nil isearch-nonincremental)
- isearch-string
+ (cons isearch-string (1+ (isearch-fail-pos)))
minibuffer-local-isearch-map nil
(if isearch-regexp
(cons 'regexp-search-ring
@@ -2210,10 +2226,13 @@ If there is no completion possible, say so and continue searching."
;; Searching
(defvar isearch-search-fun-function nil
- "Override `isearch-search-fun'.
-This function should return the search function for Isearch to use.
-It will call this function with three arguments
-as if it were `search-forward'.")
+ "Overrides the default `isearch-search-fun' behaviour.
+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.
+
+This returned function will be used by `isearch-search-string' to
+search for the first occurrence of STRING or its translation.")
(defun isearch-search-fun ()
"Return the function to use for the search.
@@ -2434,14 +2453,8 @@ update the match data, and return point."
;; If the following character is currently invisible,
;; skip all characters with that same `invisible' property value.
;; Do that over and over.
- (while (and (< (point) end)
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (if (get-text-property (point) 'invisible)
+ (while (and (< (point) end) (invisible-p (point)))
+ (if (invisible-p (get-text-property (point) 'invisible))
(progn
(goto-char (next-single-property-change (point) 'invisible
nil end))
@@ -2456,10 +2469,7 @@ update the match data, and return point."
(while overlays
(setq o (car overlays)
invis-prop (overlay-get o 'invisible))
- (if (if (eq buffer-invisibility-spec t)
- invis-prop
- (or (memq invis-prop buffer-invisibility-spec)
- (assq invis-prop buffer-invisibility-spec)))
+ (if (invisible-p invis-prop)
(if (overlay-get o 'isearch-open-invisible)
(setq ov-list (cons o ov-list))
;; We found one overlay that cannot be
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index 171048e22dc..70dda5442d5 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -207,7 +207,7 @@
;; (delete-minibuffer-contents))
;;
;; (add-hook 'iswitchb-define-mode-map-hook
-;; '(lambda () (define-key
+;; (lambda () (define-key
;; iswitchb-mode-map "\C-o"
;; 'iswitchb-exclude-nonmatching)))
@@ -1118,10 +1118,9 @@ Return the modified list with the last element prepended to it."
If BUFFER is visible in the current frame, return nil."
(interactive)
(let ((blist (iswitchb-get-buffers-in-frames 'current)))
- ;;If the buffer is visible in current frame, return nil
- (if (memq buffer blist)
- nil
- ;; maybe in other frame or icon
+ ;; If the buffer is visible in current frame, return nil
+ (unless (member buffer blist)
+ ;; maybe in other frame or icon
(get-buffer-window buffer 0) ; better than 'visible
)))
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index fda9804bbb8..e1cf2a661ed 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -340,7 +340,7 @@ Return the new status of auto compression (non-nil means on)."
(t (jka-compr-uninstall)))))
(defmacro with-auto-compression-mode (&rest body)
- "Evalute BODY with automatic file compression and uncompression enabled."
+ "Evaluate BODY with automatic file compression and uncompression enabled."
(declare (indent 0))
(let ((already-installed (make-symbol "already-installed")))
`(let ((,already-installed (jka-compr-installed-p)))
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 37c9d40ec65..1893e982bbb 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -97,6 +97,11 @@ NOTE: Not used in MS-DOS and Windows systems."
:type 'string
:group 'jka-compr)
+(defcustom jka-compr-verbose t
+ "If non-nil, output messages whenever compressing or uncompressing files."
+ :type 'boolean
+ :group 'jka-compr)
+
(defvar jka-compr-use-shell
(not (memq system-type '(ms-dos windows-nt))))
@@ -309,6 +314,7 @@ There should be no more than seven characters after the final `/'."
(and
compress-message
+ jka-compr-verbose
(message "%s %s..." compress-message base-name))
(jka-compr-run-real-handler 'write-region
@@ -341,6 +347,7 @@ There should be no more than seven characters after the final `/'."
(and
compress-message
+ jka-compr-verbose
(message "%s %s...done" compress-message base-name))
(cond
@@ -404,6 +411,7 @@ There should be no more than seven characters after the final `/'."
(and
uncompress-message
+ jka-compr-verbose
(message "%s %s..." uncompress-message base-name))
(condition-case error-code
@@ -479,6 +487,7 @@ There should be no more than seven characters after the final `/'."
(and
uncompress-message
+ jka-compr-verbose
(message "%s %s...done" uncompress-message base-name))
(and
@@ -534,6 +543,7 @@ There should be no more than seven characters after the final `/'."
(and
uncompress-message
+ jka-compr-verbose
(message "%s %s..." uncompress-message base-name))
;; Here we must read the output of uncompress program
@@ -554,6 +564,7 @@ There should be no more than seven characters after the final `/'."
(and
uncompress-message
+ jka-compr-verbose
(message "%s %s...done" uncompress-message base-name))
(write-region
diff --git a/lisp/kermit.el b/lisp/kermit.el
index b91dbb00cfa..3c8f52db0cd 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -63,7 +63,7 @@
;; the -c (connect) command line option, which means you also have to specify a
;; line and baud on the command line, as in "kermit -l /dev/tty53 -b 9600 -c".
;; However, this will cause kermit to exit when the connection is closed. So
-;; in order to do a file transfer, you have to think ahead and and add -r
+;; in order to do a file transfer, you have to think ahead and add -r
;; (receive) to the command line. This means that you can't use the server
;; feature. The only fix I can see is to muck around with the source code for
;; kermit, although this probably wouldn't be too hard. What is needed is an
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index a89e760f0b9..75de9a9f9b2 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" (19889 21967))
+;;;;;; "play/5x5.el" (19968 28627))
;;; Generated autoloads from play/5x5.el
(autoload '5x5 "5x5" "\
@@ -16,18 +16,21 @@ squares you must fill the grid.
5x5 keyboard bindings are:
\\<5x5-mode-map>
-Flip \\[5x5-flip-current]
-Move up \\[5x5-up]
-Move down \\[5x5-down]
-Move left \\[5x5-left]
-Move right \\[5x5-right]
-Start new game \\[5x5-new-game]
-New game with random grid \\[5x5-randomize]
-Random cracker \\[5x5-crack-randomly]
-Mutate current cracker \\[5x5-crack-mutating-current]
-Mutate best cracker \\[5x5-crack-mutating-best]
-Mutate xor cracker \\[5x5-crack-xor-mutate]
-Quit current game \\[5x5-quit-game]
+Flip \\[5x5-flip-current]
+Move up \\[5x5-up]
+Move down \\[5x5-down]
+Move left \\[5x5-left]
+Move right \\[5x5-right]
+Start new game \\[5x5-new-game]
+New game with random grid \\[5x5-randomize]
+Random cracker \\[5x5-crack-randomly]
+Mutate current cracker \\[5x5-crack-mutating-current]
+Mutate best cracker \\[5x5-crack-mutating-best]
+Mutate xor cracker \\[5x5-crack-xor-mutate]
+Solve with Calc \\[5x5-solve-suggest]
+Rotate left Calc Solutions \\[5x5-solve-rotate-left]
+Rotate right Calc Solutions \\[5x5-solve-rotate-right]
+Quit current game \\[5x5-quit-game]
\(fn &optional SIZE)" t nil)
@@ -111,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"
-;;;;;; (19885 24894))
+;;;;;; (19931 11784))
;;; Generated autoloads from vc/add-log.el
(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
@@ -250,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" (19878 51661))
+;;;;;; "advice" "emacs-lisp/advice.el" (19931 11784))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action 'warn "\
@@ -486,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"
-;;;;;; (19859 11635))
+;;;;;; (19981 40664))
;;; Generated autoloads from allout.el
(autoload 'allout-auto-activation-helper "allout" "\
@@ -528,11 +531,11 @@ With value nil, inhibit any automatic allout-mode activation.")
(custom-autoload 'allout-auto-activation "allout" nil)
-(put 'allout-use-hanging-indents 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+(put 'allout-use-hanging-indents 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
-(put 'allout-reindent-bodies 'safe-local-variable '(lambda (x) (memq x '(nil t text force))))
+(put 'allout-reindent-bodies 'safe-local-variable (lambda (x) (memq x '(nil t text force))))
-(put 'allout-show-bodies 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+(put 'allout-show-bodies 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
(put 'allout-header-prefix 'safe-local-variable 'stringp)
@@ -542,19 +545,19 @@ With value nil, inhibit any automatic allout-mode activation.")
(put 'allout-distinctive-bullets-string 'safe-local-variable 'stringp)
-(put 'allout-use-mode-specific-leader 'safe-local-variable '(lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start)) (stringp x))))
+(put 'allout-use-mode-specific-leader 'safe-local-variable (lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start)) (stringp x))))
-(put 'allout-old-style-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+(put 'allout-old-style-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
-(put 'allout-stylish-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+(put 'allout-stylish-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
-(put 'allout-numbered-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p '(lambda (x) (or (stringp x) (null x)))))
+(put 'allout-numbered-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p (lambda (x) (or (stringp x) (null x)))))
-(put 'allout-file-xref-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p '(lambda (x) (or (stringp x) (null x)))))
+(put 'allout-file-xref-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p (lambda (x) (or (stringp x) (null x)))))
(put 'allout-presentation-padding 'safe-local-variable 'integerp)
-(put 'allout-layout 'safe-local-variable '(lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
+(put 'allout-layout 'safe-local-variable (lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
@@ -844,7 +847,7 @@ 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"
-;;;;;; (19859 11635))
+;;;;;; (19981 40664))
;;; 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))))
@@ -873,7 +876,7 @@ See `allout-widgets-mode' for allout widgets mode features.")
(custom-autoload 'allout-widgets-auto-activation "allout-widgets" nil)
-(put 'allout-widgets-mode-inhibit 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+(put 'allout-widgets-mode-inhibit 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
(autoload 'allout-widgets-mode "allout-widgets" "\
Allout-mode extension, providing graphical decoration of outline structure.
@@ -903,7 +906,7 @@ outline hot-spot navigation (see `allout-mode').
;;;***
;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp"
-;;;;;; "net/ange-ftp.el" (19845 45374))
+;;;;;; "net/ange-ftp.el" (19977 43600))
;;; Generated autoloads from net/ange-ftp.el
(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
@@ -1015,7 +1018,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'.
;;;***
;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el"
-;;;;;; (19885 24894))
+;;;;;; (19956 37456))
;;; Generated autoloads from calendar/appt.el
(autoload 'appt-add "appt" "\
@@ -1038,7 +1041,7 @@ 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" (19891 63700))
+;;;;;; apropos-read-pattern) "apropos" "apropos.el" (19909 7240))
;;; Generated autoloads from apropos.el
(autoload 'apropos-read-pattern "apropos" "\
@@ -1233,8 +1236,8 @@ Entering array mode calls the function `array-mode-hook'.
;;;***
-;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (19914
+;;;;;; 25180))
;;; Generated autoloads from textmodes/artist.el
(autoload 'artist-mode "artist" "\
@@ -1469,7 +1472,7 @@ Special commands:
;;;***
;;;### (autoloads (auth-source-cache-expiry) "auth-source" "gnus/auth-source.el"
-;;;;;; (19845 45374))
+;;;;;; (19981 40664))
;;; Generated autoloads from gnus/auth-source.el
(defvar auth-source-cache-expiry 7200 "\
@@ -1586,7 +1589,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"
-;;;;;; (19863 8742))
+;;;;;; (19924 47209))
;;; Generated autoloads from emacs-lisp/autoload.el
(put 'generated-autoload-file 'safe-local-variable 'stringp)
@@ -1594,30 +1597,42 @@ insert a template for the file depending on the mode of the buffer.
(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
(autoload 'update-file-autoloads "autoload" "\
-Update the autoloads for FILE in `generated-autoload-file'
-\(which FILE might bind in its local variables).
-If SAVE-AFTER is non-nil (which is always, when called interactively),
-save the buffer too.
+Update the autoloads for FILE.
+If prefix arg SAVE-AFTER is non-nil, save the buffer too.
+
+If FILE binds `generated-autoload-file' as a file-local variable,
+autoloads are written into that file. Otherwise, the autoloads
+file is determined by OUTFILE. If called interactively, prompt
+for OUTFILE; if called from Lisp with OUTFILE nil, use the
+existing value of `generated-autoload-file'.
Return FILE if there was no autoload cookie in it, else nil.
-\(fn FILE &optional SAVE-AFTER)" t nil)
+\(fn FILE &optional SAVE-AFTER OUTFILE)" t nil)
(autoload 'update-directory-autoloads "autoload" "\
-Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
-This uses `update-file-autoloads' (which see) to do its work.
-In an interactive call, you must give one argument, the name
-of a single directory. In a call from Lisp, you can supply multiple
+Update autoload definitions for Lisp files in the directories DIRS.
+In an interactive call, you must give one argument, the name of a
+single directory. In a call from Lisp, you can supply multiple
directories as separate arguments, but this usage is discouraged.
The function does NOT recursively descend into subdirectories of the
directory or directories specified.
+In an interactive call, prompt for a default output file for the
+autoload definitions, and temporarily bind the variable
+`generated-autoload-file' to this value. When called from Lisp,
+use the existing value of `generated-autoload-file'. If any Lisp
+file binds `generated-autoload-file' as a file-local variable,
+write its autoloads into the specified file instead.
+
\(fn &rest DIRS)" t nil)
(autoload 'batch-update-autoloads "autoload" "\
Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments.
+Definitions are written to `generated-autoload-file' (which
+should be non-nil).
\(fn)" nil nil)
@@ -1747,7 +1762,7 @@ definition of \"random distance\".)
;;;***
;;;### (autoloads (display-battery-mode battery) "battery" "battery.el"
-;;;;;; (19845 45374))
+;;;;;; (19976 22732))
;;; Generated autoloads from battery.el
(put 'battery-mode-line-string 'risky-local-variable t)
@@ -1779,7 +1794,7 @@ seconds.
;;;***
;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run)
-;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19845 45374))
+;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19981 40664))
;;; Generated autoloads from emacs-lisp/benchmark.el
(autoload 'benchmark-run "benchmark" "\
@@ -1812,7 +1827,7 @@ For non-interactive use see also `benchmark-run' and
;;;***
;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize)
-;;;;;; "bibtex" "textmodes/bibtex.el" (19845 45374))
+;;;;;; "bibtex" "textmodes/bibtex.el" (19971 4823))
;;; Generated autoloads from textmodes/bibtex.el
(autoload 'bibtex-initialize "bibtex" "\
@@ -1840,7 +1855,7 @@ new entry with the command \\[bibtex-clean-entry].
Some features of BibTeX mode are available only by setting the variable
`bibtex-maintain-sorted-entries' to non-nil. However, then BibTeX mode
-works only with buffers containing valid (syntactical correct) and sorted
+works only with buffers containing valid (syntactically correct) and sorted
entries. This is usually the case, if you have created a buffer completely
with BibTeX mode and finished every new entry with \\[bibtex-clean-entry].
@@ -1862,7 +1877,7 @@ the name of a field with \\[bibtex-remove-OPT-or-ALT].
\\[bibtex-remove-delimiters] removes the double-quotes or braces around the text of the current field.
\\[bibtex-empty-field] replaces the text of the current field with the default \"\" or {}.
\\[bibtex-find-text] moves point to the end of the current field.
-\\[bibtex-complete] completes word fragment before point according to context.
+\\[completion-at-point] completes word fragment before point according to context.
The command \\[bibtex-clean-entry] cleans the current entry, i.e. it removes OPT/ALT
from the names of all non-empty optional or alternative fields, checks that
@@ -1891,8 +1906,10 @@ is limited to the current buffer. Optional arg START is buffer position
where the search starts. If it is nil, start search at beginning of buffer.
If DISPLAY is non-nil, display the buffer containing KEY.
Otherwise, use `set-buffer'.
-When called interactively, GLOBAL is t if there is a prefix arg or the current
-mode is not `bibtex-mode', START is nil, and DISPLAY is t.
+When called interactively, START is nil, DISPLAY is t.
+Also, GLOBAL is t if the current mode is not `bibtex-mode'
+or `bibtex-search-entry-globally' is non-nil.
+A prefix arg negates the value of `bibtex-search-entry-globally'.
\(fn KEY &optional GLOBAL START DISPLAY)" t nil)
@@ -2058,7 +2075,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" (19845 45374))
+;;;;;; "bookmark.el" (19914 25180))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
@@ -2259,7 +2276,7 @@ Incremental search of bookmarks, hiding the non-matches as we go.
;;;;;; 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"
-;;;;;; (19870 57559))
+;;;;;; (19973 46551))
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function (cond ((memq system-type '(windows-nt ms-dos cygwin)) 'browse-url-default-windows-browser) ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) (t 'browse-url-default-browser)) "\
@@ -2581,7 +2598,7 @@ Return a vector containing the lines from `bruce-phrases-file'.
;;;***
;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next)
-;;;;;; "bs" "bs.el" (19870 57559))
+;;;;;; "bs" "bs.el" (19976 22732))
;;; Generated autoloads from bs.el
(autoload 'bs-cycle-next "bs" "\
@@ -2664,7 +2681,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" (19881 27850))
+;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (19968 28627))
;;; 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)
@@ -2822,8 +2839,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" (19845
-;;;;;; 45374))
+;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (19943
+;;;;;; 25429))
;;; Generated autoloads from calc/calc.el
(define-key ctl-x-map "*" 'calc-dispatch)
@@ -2918,8 +2935,8 @@ See Info node `(calc)Defining Functions'.
;;;***
-;;;### (autoloads (calculator) "calculator" "calculator.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (calculator) "calculator" "calculator.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from calculator.el
(autoload 'calculator "calculator" "\
@@ -2930,8 +2947,8 @@ See the documentation for `calculator-mode' for more information.
;;;***
-;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19885
-;;;;;; 24894))
+;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19956
+;;;;;; 37456))
;;; Generated autoloads from calendar/calendar.el
(autoload 'calendar "calendar" "\
@@ -3036,7 +3053,7 @@ Obsoletes `c-forward-into-nomenclature'.
;;;***
;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el"
-;;;;;; (19893 19022))
+;;;;;; (19981 40664))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
@@ -3046,9 +3063,109 @@ Return the syntactic context of the current line.
;;;***
-;;;### (autoloads (pike-mode idl-mode java-mode objc-mode c++-mode
-;;;;;; c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el"
-;;;;;; (19845 45374))
+;;;### (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))
+;;; Generated autoloads from progmodes/cc-guess.el
+
+(defvar c-guess-guessed-offsets-alist nil "\
+Currently guessed offsets-alist.")
+
+(defvar c-guess-guessed-basic-offset nil "\
+Currently guessed basic-offset.")
+
+(autoload 'c-guess "cc-guess" "\
+Guess the style in the region up to `c-guess-region-max', and install it.
+
+The style is given a name based on the file's absolute file name.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch.
+
+\(fn &optional ACCUMULATE)" t nil)
+
+(autoload 'c-guess-no-install "cc-guess" "\
+Guess the style in the region up to `c-guess-region-max'; don't install it.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch.
+
+\(fn &optional ACCUMULATE)" t nil)
+
+(autoload 'c-guess-buffer "cc-guess" "\
+Guess the style on the whole current buffer, and install it.
+
+The style is given a name based on the file's absolute file name.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch.
+
+\(fn &optional ACCUMULATE)" t nil)
+
+(autoload 'c-guess-buffer-no-install "cc-guess" "\
+Guess the style on the whole current buffer; don't install it.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch.
+
+\(fn &optional ACCUMULATE)" t nil)
+
+(autoload 'c-guess-region "cc-guess" "\
+Guess the style on the region and install it.
+
+The style is given a name based on the file's absolute file name.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch.
+
+\(fn START END &optional ACCUMULATE)" t nil)
+
+(autoload 'c-guess-region-no-install "cc-guess" "\
+Guess the style on the region; don't install it.
+
+Every line of code in the region is examined and values for the following two
+variables are guessed:
+
+* `c-basic-offset', and
+* the indentation values of the various syntactic symbols in
+ `c-offsets-alist'.
+
+The guessed values are put into `c-guess-guessed-basic-offset' and
+`c-guess-guessed-offsets-alist'.
+
+Frequencies of use are taken into account when guessing, so minor
+inconsistencies in the indentation style shouldn't produce wrong guesses.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous examination is extended, otherwise a new
+guess is made from scratch.
+
+Note that the larger the region to guess in, the slower the guessing.
+So you can limit the region with `c-guess-region-max'.
+
+\(fn START END &optional ACCUMULATE)" t nil)
+
+(autoload 'c-guess-install "cc-guess" "\
+Install the latest guessed style into the current buffer.
+\(This guessed style is a combination of `c-guess-guessed-basic-offset',
+`c-guess-guessed-offsets-alist' and `c-offsets-alist'.)
+
+The style is entered into CC Mode's style system by
+`c-add-style'. Its name is either STYLE-NAME, or a name based on
+the absolute file name of the file if STYLE-NAME is nil.
+
+\(fn &optional STYLE-NAME)" t 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"
+;;;;;; (19981 40664))
;;; Generated autoloads from progmodes/cc-mode.el
(autoload 'c-initialize-cc-mode "cc-mode" "\
@@ -3205,10 +3322,27 @@ Key bindings:
(add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
(autoload 'awk-mode "cc-mode" "Major mode for editing AWK code." t)
+(autoload 'awk-mode "cc-mode" "\
+Major mode for editing AWK code.
+To submit a problem report, enter `\\[c-submit-bug-report]' from an
+awk-mode buffer. This automatically sets up a mail buffer with version
+information already added. You just need to add a description of the
+problem, including a reproducible test case, and send the message.
+
+To see what version of CC Mode you are running, enter `\\[c-version]'.
+
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `awk-mode-hook'.
+
+Key bindings:
+\\{awk-mode-map}
+
+\(fn)" t nil)
+
;;;***
;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles"
-;;;;;; "progmodes/cc-styles.el" (19845 45374))
+;;;;;; "progmodes/cc-styles.el" (19981 40664))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload 'c-set-style "cc-styles" "\
@@ -3269,7 +3403,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"
-;;;;;; (19845 45374))
+;;;;;; (19943 25429))
;;; Generated autoloads from international/ccl.el
(autoload 'ccl-compile "ccl" "\
@@ -3530,7 +3664,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program.
;;;***
;;;### (autoloads (cconv-closure-convert) "cconv" "emacs-lisp/cconv.el"
-;;;;;; (19869 36706))
+;;;;;; (19943 25429))
;;; Generated autoloads from emacs-lisp/cconv.el
(autoload 'cconv-closure-convert "cconv" "\
@@ -3544,10 +3678,19 @@ Returns a form where all lambdas don't have any free variables.
;;;***
-;;;### (autoloads (cfengine-mode) "cfengine" "progmodes/cfengine.el"
-;;;;;; (19845 45374))
+;;;### (autoloads (cfengine-mode cfengine3-mode) "cfengine" "progmodes/cfengine.el"
+;;;;;; (19981 40664))
;;; Generated autoloads from progmodes/cfengine.el
+(autoload 'cfengine3-mode "cfengine" "\
+Major mode for editing cfengine input.
+There are no special keybindings by default.
+
+Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
+to the action header.
+
+\(fn)" t nil)
+
(autoload 'cfengine-mode "cfengine" "\
Major mode for editing cfengine input.
There are no special keybindings by default.
@@ -3560,7 +3703,7 @@ to the action header.
;;;***
;;;### (autoloads (check-declare-directory check-declare-file) "check-declare"
-;;;;;; "emacs-lisp/check-declare.el" (19845 45374))
+;;;;;; "emacs-lisp/check-declare.el" (19906 31087))
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
@@ -3585,7 +3728,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" (19845 45374))
+;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (19931 11784))
;;; 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)
@@ -3873,7 +4016,7 @@ a future Emacs interpreter will be able to use it.")
;;;***
;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el"
-;;;;;; (19845 45374))
+;;;;;; (19918 22236))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
@@ -3886,7 +4029,7 @@ indentation function is called, and STATE is the
of this function.
If the indentation point is in a call to a Lisp function, that
-function's common-lisp-indent-function property specifies how
+function's `common-lisp-indent-function' property specifies how
this function should indent it. Possible values for this
property are:
@@ -4016,7 +4159,7 @@ If FRAME cannot display COLOR, return nil.
;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list
;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command
;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el"
-;;;;;; (19888 1100))
+;;;;;; (19981 40664))
;;; Generated autoloads from comint.el
(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
@@ -4148,8 +4291,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" (19890
-;;;;;; 42850))
+;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19968
+;;;;;; 28627))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
@@ -4573,7 +4716,7 @@ 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" (19845 45374))
+;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19975 1875))
;;; Generated autoloads from progmodes/cperl-mode.el
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
@@ -4850,8 +4993,8 @@ INHERIT-INPUT-METHOD.
;;;***
-;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19863
-;;;;;; 8742))
+;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19978
+;;;;;; 37530))
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
@@ -4918,10 +5061,10 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
;;;;;; customize-rogue customize-unsaved customize-face-other-window
;;;;;; customize-face customize-changed-options customize-option-other-window
;;;;;; customize-option customize-group-other-window customize-group
-;;;;;; customize-mode customize 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"
-;;;;;; (19886 45771))
+;;;;;; 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" (19980 19797))
;;; Generated autoloads from cus-edit.el
(defvar custom-browse-sort-alphabetically nil "\
@@ -4987,6 +5130,17 @@ If given a prefix (or a COMMENT argument), also prompt for a comment.
\(fn VARIABLE VALUE &optional COMMENT)" t nil)
+(autoload 'customize-push-and-save "cus-edit" "\
+Add ELTS to LIST-VAR and save for future sessions, safely.
+ELTS should be a list. This function adds each entry to the
+value of LIST-VAR using `add-to-list'.
+
+If Emacs is initialized, call `customize-save-variable' to save
+the resulting list value now. Otherwise, add an entry to
+`after-init-hook' to save it after initialization.
+
+\(fn LIST-VAR ELTS)" nil nil)
+
(autoload 'customize "cus-edit" "\
Select a customization buffer which you can use to set user options.
User options are structured into \"groups\".
@@ -5224,8 +5378,8 @@ 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" (19886
-;;;;;; 45771))
+;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (19980
+;;;;;; 19797))
;;; Generated autoloads from cus-theme.el
(autoload 'customize-create-theme "cus-theme" "\
@@ -5401,8 +5555,8 @@ Create a new data-debug buffer with NAME.
;;;***
-;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from net/dbus.el
(autoload 'dbus-handle-event "dbus" "\
@@ -5543,7 +5697,7 @@ There is some minimal font-lock support (see vars
;;;***
;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug"
-;;;;;; "emacs-lisp/debug.el" (19845 45374))
+;;;;;; "emacs-lisp/debug.el" (19961 55377))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
@@ -5641,8 +5795,8 @@ START and END delimits the corners of text rectangle.
;;;***
-;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19890
-;;;;;; 42850))
+;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19965
+;;;;;; 52428))
;;; Generated autoloads from progmodes/delphi.el
(autoload 'delphi-mode "delphi" "\
@@ -5689,7 +5843,7 @@ Coloring:
Turning on Delphi mode calls the value of the variable `delphi-mode-hook'
with no args, if that value is non-nil.
-\(fn &optional SKIP-INITIAL-PARSING)" t nil)
+\(fn)" t nil)
;;;***
@@ -6035,7 +6189,7 @@ Deuglify broken Outlook (Express) articles and redisplay.
;;;***
;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib"
-;;;;;; "calendar/diary-lib.el" (19885 24894))
+;;;;;; "calendar/diary-lib.el" (19975 1875))
;;; Generated autoloads from calendar/diary-lib.el
(autoload 'diary "diary-lib" "\
@@ -6078,7 +6232,7 @@ Major mode for editing the diary file.
;;;***
;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command
-;;;;;; diff-switches) "diff" "vc/diff.el" (19845 45374))
+;;;;;; diff-switches) "diff" "vc/diff.el" (19903 54862))
;;; Generated autoloads from vc/diff.el
(defvar diff-switches (purecopy "-c") "\
@@ -6122,7 +6276,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"
-;;;;;; (19863 8742))
+;;;;;; (19930 13389))
;;; Generated autoloads from vc/diff-mode.el
(autoload 'diff-mode "diff-mode" "\
@@ -6162,7 +6316,7 @@ 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" (19886 46089))
+;;;;;; dired dired-listing-switches) "dired" "dired.el" (19966 16984))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
@@ -6311,8 +6465,8 @@ function `dirtrack-debug-mode' to turn on debugging output.
;;;***
-;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (19863
-;;;;;; 8742))
+;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from emacs-lisp/disass.el
(autoload 'disassemble "disass" "\
@@ -6514,8 +6668,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" (19872
-;;;;;; 12877))
+;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (19953
+;;;;;; 8437))
;;; Generated autoloads from doc-view.el
(autoload 'doc-view-mode-p "doc-view" "\
@@ -7331,7 +7485,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
;;;***
-;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (19845 45374))
+;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (19914 25180))
;;; Generated autoloads from cedet/ede.el
(defvar global-ede-mode nil "\
@@ -7686,7 +7840,7 @@ Display Ediff's registry.
;;;***
;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe)
-;;;;;; "ediff-util" "vc/ediff-util.el" (19845 45374))
+;;;;;; "ediff-util" "vc/ediff-util.el" (19981 40664))
;;; Generated autoloads from vc/ediff-util.el
(autoload 'ediff-toggle-multiframe "ediff-util" "\
@@ -7960,8 +8114,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" (19845
-;;;;;; 45374))
+;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (19981
+;;;;;; 40664))
;;; Generated autoloads from emacs-lisp/elp.el
(autoload 'elp-instrument-function "elp" "\
@@ -7996,7 +8150,7 @@ displayed.
;;;***
;;;### (autoloads (report-emacs-bug) "emacsbug" "mail/emacsbug.el"
-;;;;;; (19845 45374))
+;;;;;; (19978 37530))
;;; Generated autoloads from mail/emacsbug.el
(autoload 'report-emacs-bug "emacsbug" "\
@@ -8425,7 +8579,7 @@ Look at CONFIG and try to expand GROUP.
;;;***
;;;### (autoloads (erc-handle-irc-url erc erc-select-read-args) "erc"
-;;;;;; "erc/erc.el" (19895 48172))
+;;;;;; "erc/erc.el" (19981 40664))
;;; Generated autoloads from erc/erc.el
(autoload 'erc-select-read-args "erc" "\
@@ -8786,8 +8940,8 @@ with args, toggle notify status of people.
;;;***
-;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (19899
-;;;;;; 57784))
+;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (19936
+;;;;;; 52203))
;;; Generated autoloads from erc/erc-pcomplete.el
(autoload 'erc-completion-mode "erc-pcomplete" nil t)
@@ -9048,7 +9202,7 @@ 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"
-;;;;;; (19893 19022))
+;;;;;; (19936 52203))
;;; Generated autoloads from progmodes/etags.el
(defvar tags-file-name nil "\
@@ -9532,7 +9686,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"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from net/eudc.el
(autoload 'eudc-set-server "eudc" "\
@@ -9624,7 +9778,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" (19845 45374))
+;;;;;; "eudc-export" "net/eudc-export.el" (19931 11784))
;;; Generated autoloads from net/eudc-export.el
(autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\
@@ -9641,7 +9795,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record.
;;;***
;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from net/eudc-hotlist.el
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
@@ -9773,7 +9927,7 @@ This is used only in conjunction with `expand-add-abbrevs'.
;;;***
-;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19882 48702))
+;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19975 1875))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
@@ -9800,6 +9954,10 @@ Variables controlling indentation style and extra features:
`f90-program-indent'
Extra indentation within program/module/subroutine/function blocks
(default 2).
+`f90-associate-indent'
+ Extra indentation within associate blocks (default 2).
+`f90-critical-indent'
+ Extra indentation within critical/block blocks (default 2).
`f90-continuation-indent'
Extra indentation applied to continuation lines (default 5).
`f90-comment-region'
@@ -9980,7 +10138,7 @@ 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" (19845 45374))
+;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (19931 11784))
;;; Generated autoloads from mail/feedmail.el
(autoload 'feedmail-send-it "feedmail" "\
@@ -10255,7 +10413,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" (19864 29553))
+;;;;;; "find-dired.el" (19980 19797))
;;; Generated autoloads from find-dired.el
(autoload 'find-dired "find-dired" "\
@@ -10389,7 +10547,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" (19845 45374))
+;;;;;; "emacs-lisp/find-func.el" (19981 40664))
;;; Generated autoloads from emacs-lisp/find-func.el
(autoload 'find-library "find-func" "\
@@ -10625,7 +10783,7 @@ to get the effect of a C-q.
;;;***
;;;### (autoloads (flymake-mode-off flymake-mode-on flymake-mode)
-;;;;;; "flymake" "progmodes/flymake.el" (19890 42850))
+;;;;;; "flymake" "progmodes/flymake.el" (19976 22732))
;;; Generated autoloads from progmodes/flymake.el
(autoload 'flymake-mode "flymake" "\
@@ -10649,7 +10807,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" (19865 50420))
+;;;;;; "flyspell" "textmodes/flyspell.el" (19981 40664))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
@@ -10792,8 +10950,8 @@ in your `~/.emacs' file, replacing [f7] by your favourite key:
;;;***
-;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (19913
+;;;;;; 4309))
;;; Generated autoloads from mail/footnote.el
(autoload 'footnote-mode "footnote" "\
@@ -10844,7 +11002,7 @@ Visit a file in Forms mode in other window.
;;;***
;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el"
-;;;;;; (19890 42850))
+;;;;;; (19956 37456))
;;; Generated autoloads from progmodes/fortran.el
(autoload 'fortran-mode "fortran" "\
@@ -10922,7 +11080,7 @@ 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" (19889 21967))
+;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (19931 11784))
;;; Generated autoloads from play/fortune.el
(autoload 'fortune-add-fortune "fortune" "\
@@ -10971,7 +11129,7 @@ and choose the directory as the fortune-file.
;;;***
;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el"
-;;;;;; (19890 42850))
+;;;;;; (19931 11784))
;;; Generated autoloads from progmodes/gdb-mi.el
(defvar gdb-enable-debug nil "\
@@ -11110,7 +11268,7 @@ regular expression that can be used as an element of
;;;***
;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el"
-;;;;;; (19890 42850))
+;;;;;; (19906 31087))
;;; Generated autoloads from progmodes/glasses.el
(autoload 'glasses-mode "glasses" "\
@@ -11179,7 +11337,7 @@ 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" (19889 21967))
+;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19978 37530))
;;; Generated autoloads from gnus/gnus.el
(when (fboundp 'custom-autoload)
(custom-autoload 'gnus-select-method "gnus"))
@@ -11232,7 +11390,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" (19860 32495))
+;;;;;; "gnus/gnus-agent.el" (19953 61266))
;;; Generated autoloads from gnus/gnus-agent.el
(autoload 'gnus-unplugged "gnus-agent" "\
@@ -11323,7 +11481,7 @@ If CLEAN, obsolete (ignore).
;;;***
;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el"
-;;;;;; (19874 54611))
+;;;;;; (19981 40664))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
@@ -11402,7 +11560,7 @@ supported.
;;;***
;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article)
-;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19845 45374))
+;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19931 11784))
;;; Generated autoloads from gnus/gnus-delay.el
(autoload 'gnus-delay-article "gnus-delay" "\
@@ -11465,7 +11623,7 @@ Convenience method to turn on gnus-dired-mode.
;;;***
;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el"
-;;;;;; (19881 27850))
+;;;;;; (19981 40664))
;;; Generated autoloads from gnus/gnus-draft.el
(autoload 'gnus-draft-reminder "gnus-draft" "\
@@ -11477,8 +11635,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" (19845
-;;;;;; 45374))
+;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (19980
+;;;;;; 19797))
;;; Generated autoloads from gnus/gnus-fun.el
(autoload 'gnus-random-x-face "gnus-fun" "\
@@ -11541,7 +11699,7 @@ If gravatars are already displayed, remove them.
;;;***
;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group)
-;;;;;; "gnus-group" "gnus/gnus-group.el" (19845 45374))
+;;;;;; "gnus-group" "gnus/gnus-group.el" (19981 40664))
;;; Generated autoloads from gnus/gnus-group.el
(autoload 'gnus-fetch-group "gnus-group" "\
@@ -11559,7 +11717,7 @@ Pop up a frame and enter GROUP.
;;;***
;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html"
-;;;;;; "gnus/gnus-html.el" (19845 45374))
+;;;;;; "gnus/gnus-html.el" (19917 1372))
;;; Generated autoloads from gnus/gnus-html.el
(autoload 'gnus-article-html "gnus-html" "\
@@ -11716,7 +11874,7 @@ 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" (19845 45374))
+;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19978 37530))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload 'gnus-msg-mail "gnus-msg" "\
@@ -11837,7 +11995,7 @@ Add NUM into sorted LIST by side effect.
;;;***
;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize)
-;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19893 19022))
+;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19976 22732))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
@@ -11893,7 +12051,7 @@ Update the format specification near point.
;;;***
;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el"
-;;;;;; (19877 30798))
+;;;;;; (19953 61266))
;;; Generated autoloads from gnus/gnus-start.el
(autoload 'gnus-declare-backend "gnus-start" "\
@@ -11904,7 +12062,7 @@ Declare back end NAME with ABILITIES as a Gnus back end.
;;;***
;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el"
-;;;;;; (19890 42850))
+;;;;;; (19981 40664))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
@@ -12027,7 +12185,7 @@ 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" (19864 29553))
+;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19980 19797))
;;; Generated autoloads from progmodes/grep.el
(defvar grep-window-height nil "\
@@ -12198,7 +12356,7 @@ 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" (19890 42850))
+;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (19931 11784))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
@@ -12303,7 +12461,7 @@ Variables: `handwrite-linespace' (default 12)
;;;***
;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el"
-;;;;;; (19889 21967))
+;;;;;; (19981 40664))
;;; Generated autoloads from play/hanoi.el
(autoload 'hanoi "hanoi" "\
@@ -12507,7 +12665,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" (19878 51661))
+;;;;;; "help-fns" "help-fns.el" (19977 43600))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
@@ -12603,8 +12761,8 @@ 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" (19886
-;;;;;; 45771))
+;;;;;; help-mode-setup help-mode) "help-mode" "help-mode.el" (19958
+;;;;;; 33091))
;;; Generated autoloads from help-mode.el
(autoload 'help-mode "help-mode" "\
@@ -12984,7 +13142,7 @@ how the hiding is done:
;;;***
;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el"
-;;;;;; (19890 42850))
+;;;;;; (19938 7518))
;;; 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))) "\
@@ -13046,8 +13204,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" (19886
-;;;;;; 45771))
+;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from hilit-chg.el
(autoload 'highlight-changes-mode "hilit-chg" "\
@@ -13249,7 +13407,7 @@ argument VERBOSE non-nil makes the function verbose.
;;;***
;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el"
-;;;;;; (19845 45374))
+;;;;;; (19976 22732))
;;; Generated autoloads from hl-line.el
(autoload 'hl-line-mode "hl-line" "\
@@ -13282,6 +13440,10 @@ or call the function `global-hl-line-mode'.")
Global minor mode to highlight the line about point in the current window.
With ARG, turn Global-Hl-Line mode on if ARG is positive, off otherwise.
+If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode
+highlights the line about the current buffer's point in all
+windows.
+
Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
`global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'.
@@ -13677,8 +13839,8 @@ buffer `*icalendar-errors*'.
;;;***
-;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (19874
-;;;;;; 54611))
+;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (19940
+;;;;;; 49234))
;;; Generated autoloads from icomplete.el
(defvar icomplete-mode nil "\
@@ -13740,7 +13902,7 @@ with no args, if that value is non-nil.
;;;***
;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload 'idlwave-shell "idlw-shell" "\
@@ -13900,8 +14062,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" (19886
-;;;;;; 45771))
+;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
@@ -14162,7 +14324,7 @@ DEF, if non-nil, is the default value.
;;;***
-;;;### (autoloads (ielm) "ielm" "ielm.el" (19886 45771))
+;;;### (autoloads (ielm) "ielm" "ielm.el" (19931 11784))
;;; Generated autoloads from ielm.el
(add-hook 'same-window-buffer-names (purecopy "*ielm*"))
@@ -14186,12 +14348,12 @@ Toggle inline image minor mode.
;;;***
-;;;### (autoloads (imagemagick-register-types create-animated-image
-;;;;;; defimage find-image remove-images insert-sliced-image insert-image
-;;;;;; put-image create-image image-type-auto-detected-p image-type-available-p
+;;;### (autoloads (imagemagick-register-types defimage find-image
+;;;;;; remove-images insert-sliced-image insert-image put-image
+;;;;;; 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"
-;;;;;; (19849 29307))
+;;;;;; (19956 37456))
;;; Generated autoloads from image.el
(autoload 'image-type-from-data "image" "\
@@ -14367,24 +14529,14 @@ Example:
(put 'defimage 'doc-string-elt '3)
-(autoload 'create-animated-image "image" "\
-Create an animated image.
-FILE-OR-DATA is an image file name or image data.
-Optional TYPE is a symbol describing the image type. If TYPE is omitted
-or nil, try to determine the image type from its first few bytes
-of image data. If that doesn't work, and FILE-OR-DATA is a file name,
-use its file extension as image type.
-Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
-Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:mask MASK'.
-Value is the image created, or nil if images of type TYPE are not supported.
-
-Images should not be larger than specified by `max-image-size'.
-
-\(fn FILE-OR-DATA &optional TYPE DATA-P &rest PROPS)" nil nil)
-
(autoload 'imagemagick-register-types "image" "\
-Register the file types that ImageMagick is able to handle.
+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.
+
+If Emacs is compiled without ImageMagick support, do nothing.
\(fn)" nil nil)
@@ -14397,7 +14549,7 @@ Register the file types that ImageMagick is able to handle.
;;;;;; 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" (19886 45771))
+;;;;;; "image-dired" "image-dired.el" (19931 11784))
;;; Generated autoloads from image-dired.el
(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\
@@ -14597,7 +14749,7 @@ Image files are those whose name has an extension in
;;;***
;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode
-;;;;;; image-mode) "image-mode" "image-mode.el" (19890 42850))
+;;;;;; image-mode) "image-mode" "image-mode.el" (19951 19539))
;;; Generated autoloads from image-mode.el
(autoload 'image-mode "image-mode" "\
@@ -14855,7 +15007,7 @@ of `inferior-lisp-program'). Runs the hooks from
;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node
;;;;;; Info-mode info-finder info-apropos Info-index Info-directory
;;;;;; Info-on-current-buffer info-standalone info-emacs-manual
-;;;;;; info info-other-window) "info" "info.el" (19867 52471))
+;;;;;; info info-other-window) "info" "info.el" (19967 7755))
;;; Generated autoloads from info.el
(autoload 'info-other-window "info" "\
@@ -15042,7 +15194,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"
-;;;;;; (19845 45374))
+;;;;;; (19936 52203))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
@@ -15361,7 +15513,7 @@ Add submenus to the File menu, to convert to and from various formats.
;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings
;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell
;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary)
-;;;;;; "ispell" "textmodes/ispell.el" (19845 45374))
+;;;;;; "ispell" "textmodes/ispell.el" (19905 10215))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
@@ -15581,8 +15733,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;***
-;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19886
-;;;;;; 45771))
+;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19946
+;;;;;; 29209))
;;; Generated autoloads from iswitchb.el
(defvar iswitchb-mode nil "\
@@ -15708,7 +15860,7 @@ by `jka-compr-installed'.
;;;***
-;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19890 42850))
+;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19981 40664))
;;; Generated autoloads from progmodes/js.el
(autoload 'js-mode "js" "\
@@ -16096,7 +16248,7 @@ use either \\[customize] or the function `latin1-display'.")
;;;***
;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el"
-;;;;;; (19845 45374))
+;;;;;; (19961 55377))
;;; Generated autoloads from progmodes/ld-script.el
(autoload 'ld-script-mode "ld-script" "\
@@ -16194,8 +16346,8 @@ See `linum-mode' for more information on Linum mode.
;;;***
-;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (19975
+;;;;;; 1875))
;;; Generated autoloads from loadhist.el
(autoload 'unload-feature "loadhist" "\
@@ -16306,8 +16458,8 @@ uses the current buffer.
;;;***
-;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19863
-;;;;;; 8742))
+;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19946
+;;;;;; 1612))
;;; Generated autoloads from vc/log-view.el
(autoload 'log-view-mode "log-view" "\
@@ -16339,8 +16491,8 @@ are indicated with a symbol.
;;;***
;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer
-;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (19845
-;;;;;; 45374))
+;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (19909
+;;;;;; 7240))
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)))
@@ -16472,7 +16624,7 @@ A major mode to edit m4 macro files.
;;;***
;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el"
-;;;;;; (19863 8742))
+;;;;;; (19930 13389))
;;; Generated autoloads from emacs-lisp/macroexp.el
(autoload 'macroexpand-all "macroexp" "\
@@ -16639,7 +16791,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" (19845 45374))
+;;;;;; "mail-utils" "mail/mail-utils.el" (19922 19303))
;;; Generated autoloads from mail/mail-utils.el
(defvar mail-use-rfc822 nil "\
@@ -16711,8 +16863,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" (19845
-;;;;;; 45374))
+;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (19968
+;;;;;; 28627))
;;; Generated autoloads from mail/mailabbrev.el
(defvar mail-abbrevs-mode nil "\
@@ -16821,7 +16973,7 @@ 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" (19890 42850))
+;;;;;; "make-mode" "progmodes/make-mode.el" (19968 28627))
;;; Generated autoloads from progmodes/make-mode.el
(autoload 'makefile-mode "make-mode" "\
@@ -17059,7 +17211,7 @@ Returns non-nil if the new state is enabled.
;;;;;; 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" (19881 27850))
+;;;;;; "gnus/message.el" (19980 19797))
;;; 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)
@@ -17225,7 +17377,7 @@ which specify the range to operate on.
;;;***
;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (19968 28627))
;;; Generated autoloads from progmodes/meta-mode.el
(autoload 'metafont-mode "meta-mode" "\
@@ -17377,7 +17529,7 @@ delete the draft message.
;;;***
-;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (19898 36953))
+;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (19931 11784))
;;; Generated autoloads from mh-e/mh-e.el
(put 'mh-progs 'risky-local-variable t)
@@ -17530,7 +17682,8 @@ Returns non-nil if the new state is enabled.
;;;***
-;;;### (autoloads (butterfly) "misc" "misc.el" (19845 45374))
+;;;### (autoloads (list-dynamic-libraries butterfly) "misc" "misc.el"
+;;;;;; (19968 28627))
;;; Generated autoloads from misc.el
(autoload 'butterfly "misc" "\
@@ -17545,6 +17698,17 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'.
\(fn)" t nil)
+(autoload 'list-dynamic-libraries "misc" "\
+Display a list of all dynamic libraries known to Emacs.
+\(These are the libraries listed in `dynamic-library-alist'.)
+If optional argument LOADED-ONLY-P (interactively, prefix arg)
+is non-nil, only libraries already loaded are listed.
+Optional argument BUFFER specifies a buffer to use, instead of
+\"*Dynamic Libraries*\".
+The return value is always nil.
+
+\(fn &optional LOADED-ONLY-P BUFFER)" t nil)
+
;;;***
;;;### (autoloads (multi-isearch-files-regexp multi-isearch-files
@@ -17631,7 +17795,7 @@ whose file names match the specified wildcard.
;;;***
;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (19961 55377))
;;; Generated autoloads from progmodes/mixal-mode.el
(autoload 'mixal-mode "mixal-mode" "\
@@ -17712,7 +17876,7 @@ Assume text has been decoded if DECODED is non-nil.
;;;***
;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el"
-;;;;;; (19845 45374))
+;;;;;; (19940 49234))
;;; Generated autoloads from gnus/mml1991.el
(autoload 'mml1991-encrypt "mml1991" "\
@@ -17729,7 +17893,7 @@ Assume text has been decoded if DECODED is non-nil.
;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt
;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt)
-;;;;;; "mml2015" "gnus/mml2015.el" (19845 45374))
+;;;;;; "mml2015" "gnus/mml2015.el" (19981 40664))
;;; Generated autoloads from gnus/mml2015.el
(autoload 'mml2015-decrypt "mml2015" "\
@@ -17930,7 +18094,7 @@ primary selection and region.
;;;***
-;;;### (autoloads (mpc) "mpc" "mpc.el" (19863 8742))
+;;;### (autoloads (mpc) "mpc" "mpc.el" (19946 1612))
;;; Generated autoloads from mpc.el
(autoload 'mpc "mpc" "\
@@ -17950,7 +18114,7 @@ Multiplication puzzle with GNU Emacs.
;;;***
-;;;### (autoloads (msb-mode) "msb" "msb.el" (19845 45374))
+;;;### (autoloads (msb-mode) "msb" "msb.el" (19931 11784))
;;; Generated autoloads from msb.el
(defvar msb-mode nil "\
@@ -18363,7 +18527,7 @@ listed in the PORTS list.
;;;***
;;;### (autoloads (open-network-stream) "network-stream" "net/network-stream.el"
-;;;;;; (19893 19022))
+;;;;;; (19976 22732))
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
@@ -18427,6 +18591,23 @@ 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
+ capabilities, even if we're doing a `plain' network connection.
+
+:client-certificate should either be a list where the first
+ element is the certificate key file name, and the second
+ element is the certificate file name itself, or `t', which
+ means that `auth-source' will be queried for the key and the
+ 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.
+
+:nowait is a boolean that says the connection should be made
+ asynchronously, if possible.
+
\(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil)
(defalias 'open-protocol-stream 'open-network-stream)
@@ -18438,7 +18619,7 @@ values:
;;;;;; 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" (19863 8742))
+;;;;;; "newcomment.el" (19938 7518))
;;; Generated autoloads from newcomment.el
(defalias 'indent-for-comment 'comment-indent)
@@ -18477,7 +18658,7 @@ 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 up to its body.")
+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 "") "\
@@ -18638,7 +18819,7 @@ unless optional argument SOFT is non-nil.
;;;***
;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend"
-;;;;;; "net/newst-backend.el" (19845 45374))
+;;;;;; "net/newst-backend.el" (19918 22236))
;;; Generated autoloads from net/newst-backend.el
(autoload 'newsticker-running-p "newst-backend" "\
@@ -18660,7 +18841,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
;;;***
;;;### (autoloads (newsticker-plainview) "newst-plainview" "net/newst-plainview.el"
-;;;;;; (19845 45374))
+;;;;;; (19918 22236))
;;; Generated autoloads from net/newst-plainview.el
(autoload 'newsticker-plainview "newst-plainview" "\
@@ -18671,7 +18852,7 @@ Start newsticker plainview.
;;;***
;;;### (autoloads (newsticker-show-news) "newst-reader" "net/newst-reader.el"
-;;;;;; (19845 45374))
+;;;;;; (19918 22236))
;;; Generated autoloads from net/newst-reader.el
(autoload 'newsticker-show-news "newst-reader" "\
@@ -18703,7 +18884,7 @@ running already.
;;;***
;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el"
-;;;;;; (19845 45374))
+;;;;;; (19918 22236))
;;; Generated autoloads from net/newst-treeview.el
(autoload 'newsticker-treeview "newst-treeview" "\
@@ -18823,8 +19004,8 @@ Return nil if the face cannot display a glyph for N.
;;;***
-;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19927
+;;;;;; 37225))
;;; Generated autoloads from nxml/nxml-mode.el
(autoload 'nxml-mode "nxml-mode" "\
@@ -19168,7 +19349,7 @@ exported source code blocks by language.
;;;***
;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el"
-;;;;;; (19894 39890))
+;;;;;; (19968 28627))
;;; Generated autoloads from progmodes/octave-inf.el
(autoload 'inferior-octave "octave-inf" "\
@@ -19191,7 +19372,7 @@ startup file, `~/.emacs-octave'.
;;;***
;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el"
-;;;;;; (19894 39890))
+;;;;;; (19968 28627))
;;; Generated autoloads from progmodes/octave-mod.el
(autoload 'octave-mode "octave-mod" "\
@@ -19279,7 +19460,7 @@ including a reproducible test case and send the message.
;;;;;; 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"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from org/org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -19502,7 +19683,7 @@ Call the customize function with org as argument.
;;;;;; 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" (19845 45374))
+;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (19914 25180))
;;; Generated autoloads from org/org-agenda.el
(autoload 'org-agenda "org-agenda" "\
@@ -19772,8 +19953,8 @@ This command is set with the variable `org-archive-default-command'.
;;;### (autoloads (org-export-as-ascii org-export-region-as-ascii
;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer
;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer
-;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (19845
-;;;;;; 45374))
+;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from org/org-ascii.el
(autoload 'org-export-as-latin1 "org-ascii" "\
@@ -19846,8 +20027,8 @@ publishing directory.
;;;***
-;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from org/org-attach.el
(autoload 'org-attach "org-attach" "\
@@ -20019,7 +20200,7 @@ publishing directory.
;;;### (autoloads (org-insert-export-options-template org-export-as-org
;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from org/org-exp.el
(autoload 'org-export "org-exp" "\
@@ -20193,7 +20374,7 @@ Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE.
;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html
;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer
;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html"
-;;;;;; "org/org-html.el" (19845 45374))
+;;;;;; "org/org-html.el" (19931 11784))
;;; Generated autoloads from org/org-html.el
(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
@@ -20642,7 +20823,7 @@ See also the variable `org-reverse-note-order'.
;;;***
;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl)
-;;;;;; "org-table" "org/org-table.el" (19845 45374))
+;;;;;; "org-table" "org/org-table.el" (19914 25180))
;;; Generated autoloads from org/org-table.el
(autoload 'turn-on-orgtbl "org-table" "\
@@ -20929,16 +21110,16 @@ unknown are returned as nil.
;;;***
-;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19899
-;;;;;; 57784))
+;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19968
+;;;;;; 28627))
;;; Generated autoloads from progmodes/pascal.el
(autoload 'pascal-mode "pascal" "\
Major mode for editing Pascal code. \\<pascal-mode-map>
TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
-\\[pascal-complete-word] completes the word around current point with respect to position in code
-\\[pascal-show-completions] shows all possible completions at this point.
+\\[completion-at-point] completes the word around current point with respect to position in code
+\\[completion-help-at-point] shows all possible completions at this point.
Other useful functions are:
@@ -21124,8 +21305,8 @@ Completion for GNU/Linux `mount'.
;;;***
-;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19961
+;;;;;; 55377))
;;; Generated autoloads from pcmpl-rpm.el
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
@@ -21194,8 +21375,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" (19899
-;;;;;; 57784))
+;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (19964
+;;;;;; 31562))
;;; Generated autoloads from pcomplete.el
(autoload 'pcomplete "pcomplete" "\
@@ -21337,7 +21518,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
;;;***
;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el"
-;;;;;; (19890 42850))
+;;;;;; (19911 48973))
;;; Generated autoloads from progmodes/perl-mode.el
(put 'perl-indent-level 'safe-local-variable 'integerp)
(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
@@ -21479,6 +21660,17 @@ they are not defaultly assigned to keys.
;;;***
+;;;### (autoloads (plstore-open) "plstore" "gnus/plstore.el" (19981
+;;;;;; 40664))
+;;; Generated autoloads from gnus/plstore.el
+
+(autoload 'plstore-open "plstore" "\
+Create a plstore instance associated with FILE.
+
+\(fn FILE)" nil nil)
+
+;;;***
+
;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el"
;;;;;; (19845 45374))
;;; Generated autoloads from textmodes/po.el
@@ -21507,7 +21699,7 @@ pong-mode keybindings:\\<pong-mode-map>
;;;***
-;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (19845 45374))
+;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (19940 49234))
;;; Generated autoloads from gnus/pop3.el
(autoload 'pop3-movemail "pop3" "\
@@ -22175,7 +22367,7 @@ are both set to t.
;;;***
-;;;### (autoloads (proced) "proced" "proced.el" (19886 45771))
+;;;### (autoloads (proced) "proced" "proced.el" (19975 1875))
;;; Generated autoloads from proced.el
(autoload 'proced "proced" "\
@@ -22238,8 +22430,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
;;;***
-;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19890
-;;;;;; 42850))
+;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19961
+;;;;;; 55377))
;;; Generated autoloads from progmodes/ps-mode.el
(autoload 'ps-mode "ps-mode" "\
@@ -22290,8 +22482,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" (19886
-;;;;;; 45771))
+;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (19931
+;;;;;; 11784))
;;; 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"))) "\
@@ -22487,8 +22679,8 @@ If EXTENSION is any other symbol, it is ignored.
;;;***
-;;;### (autoloads (jython-mode python-mode run-python) "python" "progmodes/python.el"
-;;;;;; (19890 42850))
+;;;### (autoloads (jython-mode python-mode python-after-info-look
+;;;;;; run-python) "python" "progmodes/python.el" (19975 1875))
;;; Generated autoloads from progmodes/python.el
(add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode))
@@ -22520,6 +22712,12 @@ behavior, change `python-remove-cwd-from-path' to nil.
\(fn &optional CMD NOSHOW NEW)" t nil)
+(autoload 'python-after-info-look "python" "\
+Set up info-look for Python.
+Used with `eval-after-load'.
+
+\(fn)" nil nil)
+
(autoload 'python-mode "python" "\
Major mode for editing Python files.
Turns on Font Lock mode unconditionally since it is currently required
@@ -22591,7 +22789,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" (19845 45374))
+;;;;;; "international/quail.el" (19943 25429))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
@@ -22895,7 +23093,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'.
;;;***
;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc"
-;;;;;; "net/rcirc.el" (19898 36953))
+;;;;;; "net/rcirc.el" (19968 28627))
;;; Generated autoloads from net/rcirc.el
(autoload 'rcirc "rcirc" "\
@@ -22912,7 +23110,7 @@ If ARG is non-nil, instead prompt for connection parameters.
(autoload 'rcirc-connect "rcirc" "\
-\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD)" nil nil)
+\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION)" nil nil)
(defvar rcirc-track-minor-mode nil "\
Non-nil if Rcirc-Track minor mode is enabled.
@@ -22943,13 +23141,19 @@ See \\[compile].
;;;***
;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el"
-;;;;;; (19865 50420))
+;;;;;; (19975 1875))
;;; Generated autoloads from emacs-lisp/re-builder.el
(defalias 'regexp-builder 're-builder)
(autoload 're-builder "re-builder" "\
Construct a regexp interactively.
+This command makes the current buffer the \"target\" buffer of
+the regexp builder. It displays a buffer named \"*RE-Builder*\"
+in another window, initially containing an empty regexp.
+
+As you edit the regexp in the \"*RE-Builder*\" buffer, the
+matching parts of the target buffer will be highlighted.
\(fn)" t nil)
@@ -23266,7 +23470,7 @@ Here are all local bindings.
;;;***
;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el"
-;;;;;; (19845 45374))
+;;;;;; (19980 19797))
;;; Generated autoloads from textmodes/reftex-parse.el
(autoload 'reftex-all-document-files "reftex-parse" "\
@@ -23351,7 +23555,7 @@ Extract diary entries from the region.
;;;***
-;;;### (autoloads (repeat) "repeat" "repeat.el" (19845 45374))
+;;;### (autoloads (repeat) "repeat" "repeat.el" (19951 19539))
;;; Generated autoloads from repeat.el
(autoload 'repeat "repeat" "\
@@ -23533,7 +23737,7 @@ variable.
;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers
;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers
;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p)
-;;;;;; "rmail" "mail/rmail.el" (19845 45374))
+;;;;;; "rmail" "mail/rmail.el" (19976 23054))
;;; Generated autoloads from mail/rmail.el
(autoload 'rmail-movemail-variant-p "rmail" "\
@@ -23586,7 +23790,7 @@ If nil, display all header fields except those matched by
(custom-autoload 'rmail-displayed-headers "rmail" t)
-(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:") "\
+(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "\
Headers that should be stripped when retrying a failed message.")
(custom-autoload 'rmail-retry-ignored-headers "rmail" t)
@@ -23837,8 +24041,8 @@ to use for finding the schema.
;;;***
-;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (19930
+;;;;;; 13389))
;;; Generated autoloads from nxml/rng-xsd.el
(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile)
@@ -23937,7 +24141,7 @@ Toggle the use of ROT13 encoding for the current window.
;;;***
;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el"
-;;;;;; (19845 45374))
+;;;;;; (19932 55155))
;;; Generated autoloads from textmodes/rst.el
(add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
@@ -24012,8 +24216,8 @@ In Ruler mode, Emacs displays a ruler in the header line.
;;;***
-;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (19965
+;;;;;; 52428))
;;; Generated autoloads from emacs-lisp/rx.el
(autoload 'rx-to-string "rx" "\
@@ -24243,6 +24447,11 @@ CHAR
like `and', but makes the match accessible with `match-end',
`match-beginning', and `match-string'.
+`(submatch-n N SEXP1 SEXP2 ...)'
+`(group-n N SEXP1 SEXP2 ...)'
+ like `group', but make it an explicitly-numbered group with
+ group number N.
+
`(or SEXP1 SEXP2 ...)'
`(| SEXP1 SEXP2 ...)'
matches anything that matches SEXP1 or SEXP2, etc. If all
@@ -24449,7 +24658,7 @@ during scrolling.
;;;***
;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic"
-;;;;;; "cedet/semantic.el" (19845 45374))
+;;;;;; "cedet/semantic.el" (19981 40664))
;;; Generated autoloads from cedet/semantic.el
(defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\
@@ -24500,7 +24709,7 @@ Semantic mode.
;;;;;; mail-yank-prefix mail-setup-hook 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" (19881 27850))
+;;;;;; mail-from-style) "sendmail" "mail/sendmail.el" (19980 19797))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
@@ -24543,9 +24752,9 @@ Otherwise, let mailer send back a message to report errors.")
(custom-autoload 'mail-interactive "sendmail" t)
-(put 'send-mail-function 'standard-value '((if (and window-system (memq system-type '(darwin windows-nt))) 'mailclient-send-it 'sendmail-send-it)))
+(put 'send-mail-function 'standard-value '((if (or (and window-system (eq system-type 'darwin)) (eq system-type 'windows-nt)) 'mailclient-send-it 'sendmail-send-it)))
-(defvar send-mail-function (if (and window-system (memq system-type '(darwin windows-nt))) 'mailclient-send-it 'sendmail-send-it) "\
+(defvar send-mail-function (if (or (and window-system (eq system-type 'darwin)) (eq system-type 'windows-nt)) 'mailclient-send-it 'sendmail-send-it) "\
Function to call to send the current buffer as mail.
The headers should be delimited by a line which is
not a valid RFC822 header or continuation line,
@@ -24779,8 +24988,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" (19863
-;;;;;; 8742))
+;;;;;; server-force-delete server-start) "server" "server.el" (19975
+;;;;;; 1875))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
@@ -24843,7 +25052,7 @@ only these files will be asked to be saved.
;;;***
-;;;### (autoloads (ses-mode) "ses" "ses.el" (19845 45374))
+;;;### (autoloads (ses-mode) "ses" "ses.el" (19980 19797))
;;; Generated autoloads from ses.el
(autoload 'ses-mode "ses" "\
@@ -24992,20 +25201,6 @@ with your script for an edit-interpret-debug cycle.
;;;***
-;;;### (autoloads (sha1) "sha1" "sha1.el" (19845 45374))
-;;; Generated autoloads from sha1.el
-
-(autoload 'sha1 "sha1" "\
-Return the SHA1 (Secure Hash Algorithm) of an object.
-OBJECT is either a string or a buffer.
-Optional arguments BEG and END denote buffer positions for computing the
-hash of a portion of OBJECT.
-If BINARY is non-nil, return a string in binary form.
-
-\(fn OBJECT &optional BEG END BINARY)" nil nil)
-
-;;;***
-
;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el"
;;;;;; (19845 45374))
;;; Generated autoloads from emacs-lisp/shadow.el
@@ -25097,7 +25292,7 @@ Set up file shadowing.
;;;***
;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el"
-;;;;;; (19888 1100))
+;;;;;; (19964 31562))
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\
@@ -25146,8 +25341,8 @@ Otherwise, one argument `-i' is passed to the shell.
;;;***
-;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19899
-;;;;;; 57784))
+;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19976
+;;;;;; 22732))
;;; Generated autoloads from gnus/shr.el
(autoload 'shr-insert-document "shr" "\
@@ -25354,7 +25549,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" (19863 8742))
+;;;;;; "smerge-mode" "vc/smerge-mode.el" (19946 1612))
;;; Generated autoloads from vc/smerge-mode.el
(autoload 'smerge-ediff "smerge-mode" "\
@@ -25379,7 +25574,7 @@ If no conflict maker is found, turn off `smerge-mode'.
;;;***
;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el"
-;;;;;; (19845 45374))
+;;;;;; (19939 28373))
;;; Generated autoloads from gnus/smiley.el
(autoload 'smiley-region "smiley" "\
@@ -25397,7 +25592,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" (19845 45374))
+;;;;;; "mail/smtpmail.el" (19978 37530))
;;; Generated autoloads from mail/smtpmail.el
(autoload 'smtpmail-send-it "smtpmail" "\
@@ -25703,8 +25898,8 @@ From a program takes two point or marker arguments, BEG and END.
;;;***
-;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19867
-;;;;;; 52471))
+;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19976
+;;;;;; 22732))
;;; Generated autoloads from gnus/spam.el
(autoload 'spam-initialize "spam" "\
@@ -25807,7 +26002,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"
-;;;;;; (19890 42850))
+;;;;;; (19931 11784))
;;; Generated autoloads from progmodes/sql.el
(autoload 'sql-add-product-keywords "sql" "\
@@ -26523,7 +26718,7 @@ See `subword-mode' for more information on Subword mode.
;;;***
;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from mail/supercite.el
(autoload 'sc-cite-original "supercite" "\
@@ -27264,7 +27459,7 @@ Connect to the Emacs talk group from the current X display or tty frame.
;;;***
-;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (19886 45771))
+;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (19977 43600))
;;; Generated autoloads from tar-mode.el
(autoload 'tar-mode "tar-mode" "\
@@ -27364,7 +27559,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"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
@@ -27406,8 +27601,8 @@ use in that buffer.
;;;***
-;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (19886
-;;;;;; 45771))
+;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (19931
+;;;;;; 11784))
;;; Generated autoloads from terminal.el
(autoload 'terminal-emulator "terminal" "\
@@ -27444,7 +27639,7 @@ subprocess started.
;;;***
;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el"
-;;;;;; (19845 45374))
+;;;;;; (19943 25429))
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-this-defun "testcover" "\
@@ -27942,7 +28137,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" (19852 16697))
+;;;;;; "thingatpt" "thingatpt.el" (19980 19797))
;;; Generated autoloads from thingatpt.el
(autoload 'forward-thing "thingatpt" "\
@@ -27999,7 +28194,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"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from thumbs.el
(autoload 'thumbs-find-thumb "thumbs" "\
@@ -28360,7 +28555,7 @@ With ARG, turn time stamping on if and only if arg is positive.
;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out
;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in
;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el"
-;;;;;; (19845 45374))
+;;;;;; (19981 40664))
;;; Generated autoloads from calendar/timeclock.el
(autoload 'timeclock-modeline-display "timeclock" "\
@@ -28654,7 +28849,7 @@ holds a keymap.
;;;***
;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from emulation/tpu-edt.el
(defvar tpu-edt-mode nil "\
@@ -28766,7 +28961,7 @@ BUFFER defaults to `trace-buffer'.
;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion
;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers
;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp"
-;;;;;; "net/tramp.el" (19894 39890))
+;;;;;; "net/tramp.el" (19981 40664))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
@@ -28904,7 +29099,7 @@ Discard Tramp from loading remote files.
;;;***
;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el"
-;;;;;; (19845 45374))
+;;;;;; (19946 29209))
;;; Generated autoloads from net/tramp-ftp.el
(autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\
@@ -29002,7 +29197,7 @@ First column's text sSs Second column's text
;;;;;; 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"
-;;;;;; (19886 45771))
+;;;;;; (19981 40664))
;;; Generated autoloads from type-break.el
(defvar type-break-mode nil "\
@@ -29762,6 +29957,20 @@ Setup variables that expose info about you and your system.
;;;***
+;;;### (autoloads (url-queue-retrieve) "url-queue" "url/url-queue.el"
+;;;;;; (19943 25429))
+;;; 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.
+
+\(fn URL CALLBACK &optional CBARGS SILENT)" 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
@@ -30001,8 +30210,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" (19888
-;;;;;; 1100))
+;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (19976
+;;;;;; 22732))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
@@ -30285,7 +30494,7 @@ Return the branch part of a revision number REV.
;;;***
;;;### (autoloads (vc-annotate) "vc-annotate" "vc/vc-annotate.el"
-;;;;;; (19893 19022))
+;;;;;; (19920 63959))
;;; Generated autoloads from vc/vc-annotate.el
(autoload 'vc-annotate "vc-annotate" "\
@@ -30332,7 +30541,7 @@ mode-specific menu. `vc-annotate-color-map' and
;;;***
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (19845 45374))
+;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (19931 34253))
;;; Generated autoloads from vc/vc-bzr.el
(defconst vc-bzr-admin-dirname ".bzr" "\
@@ -30357,7 +30566,7 @@ Name of the directory containing Bzr repository status files.")
;;;***
-;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (19845 45374))
+;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (19930 13389))
;;; Generated autoloads from vc/vc-dir.el
(autoload 'vc-dir "vc-dir" "\
@@ -30545,7 +30754,7 @@ Key bindings:
;;;***
;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (19973 46551))
;;; Generated autoloads from progmodes/verilog-mode.el
(autoload 'verilog-mode "verilog-mode" "\
@@ -30682,7 +30891,7 @@ Key bindings specific to `verilog-mode-map' are:
;;;***
;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (19914 25180))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
@@ -31326,7 +31535,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" (19886 45771))
+;;;;;; "view" "view.el" (19958 33091))
;;; Generated autoloads from view.el
(defvar view-remove-frame-by-deleting t "\
@@ -31413,15 +31622,16 @@ EXIT-ACTION to `kill-buffer-if-not-modified' avoids this.
(autoload 'view-buffer-other-window "view" "\
View BUFFER in View mode in another window.
-Return to previous buffer when done, unless optional NOT-RETURN is
-non-nil. Emacs commands editing the buffer contents are not available;
-instead, a special set of commands (mostly letters and punctuation) are
-defined for moving around in the buffer.
+Emacs commands editing the buffer contents are not available;
+instead, a special set of commands (mostly letters and
+punctuation) are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
+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'.
@@ -31430,15 +31640,16 @@ this argument instead of explicitly setting `view-exit-action'.
(autoload 'view-buffer-other-frame "view" "\
View BUFFER in View mode in another frame.
-Return to previous buffer when done, unless optional NOT-RETURN is
-non-nil. Emacs commands editing the buffer contents are not available;
-instead, a special set of commands (mostly letters and punctuation) are
-defined for moving around in the buffer.
+Emacs commands editing the buffer contents are not available;
+instead, a special set of commands (mostly letters and
+punctuation) are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
+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'.
@@ -31539,31 +31750,20 @@ entry for the selected window, purge that entry from
(autoload 'view-mode-enter "view" "\
Enter View mode and set up exit from view mode depending on optional arguments.
-RETURN-TO non-nil means add RETURN-TO as an element to the buffer
-local alist `view-return-to-alist'. Save EXIT-ACTION in buffer
-local variable `view-exit-action'. It should be either nil or a
+Optional argument QUIT-RESTORE if non-nil must specify a valid
+entry for quitting and restoring any window showing the current
+buffer. This entry replaces any parameter installed by
+`display-buffer' and is used by `view-mode-exit'.
+
+Optional argument EXIT-ACTION, if non-nil, must specify a
function that takes a buffer as argument. This function will be
called by `view-mode-exit'.
-RETURN-TO is either nil, meaning do nothing when exiting view
-mode, or must have the format (WINDOW OLD-WINDOW . OLD-BUF-INFO).
-WINDOW is the window used for viewing. OLD-WINDOW is nil or the
-window to select after viewing. OLD-BUF-INFO tells what to do
-with WINDOW when exiting. It is one of:
-1) nil Do nothing.
-2) t Delete WINDOW or, if it is the only window and
- `view-remove-frame-by-deleting' is non-nil, its
- frame.
-3) (OLD-BUFF START POINT) Display buffer OLD-BUFF with displayed text
- starting at START and point at POINT in WINDOW.
-4) quit-window Do `quit-window' in WINDOW.
-5) keep-frame Like case 2) but do not delete the frame.
-
For a list of all View commands, type H or h while viewing.
This function runs the normal hook `view-mode-hook'.
-\(fn &optional RETURN-TO EXIT-ACTION)" nil nil)
+\(fn &optional QUIT-RESTORE EXIT-ACTION)" nil nil)
(autoload 'View-exit-and-edit "view" "\
Exit View mode and make the current buffer editable.
@@ -31589,7 +31789,7 @@ Turn on VIP emulation of VI.
;;;***
;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el"
-;;;;;; (19845 45374))
+;;;;;; (19931 11784))
;;; Generated autoloads from emulation/viper.el
(autoload 'toggle-viper-mode "viper" "\
@@ -31606,7 +31806,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'.
;;;***
;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el"
-;;;;;; (19845 45374))
+;;;;;; (19906 31087))
;;; Generated autoloads from emacs-lisp/warnings.el
(defvar warning-prefix-function nil "\
@@ -31623,7 +31823,7 @@ Non-nil means treat multiple `display-warning' calls as a series.
A marker indicates a position in the warnings buffer
which is the start of the current series; it means that
additional warnings in the same buffer should not move point.
-t means the next warning begins a series (and stores a marker here).
+If t, the next warning begins a series (and stores a marker here).
A symbol with a function definition is like t, except
also call that function before the next warning.")
@@ -31696,7 +31896,7 @@ this is equivalent to `display-warning', using
;;;***
;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el"
-;;;;;; (19886 45771))
+;;;;;; (19913 4309))
;;; Generated autoloads from wdired.el
(autoload 'wdired-change-to-wdired-mode "wdired" "\
@@ -31712,7 +31912,7 @@ See `wdired-mode'.
;;;***
-;;;### (autoloads (webjump) "webjump" "net/webjump.el" (19845 45374))
+;;;### (autoloads (webjump) "webjump" "net/webjump.el" (19931 11784))
;;; Generated autoloads from net/webjump.el
(autoload 'webjump "webjump" "\
@@ -31729,7 +31929,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
;;;***
;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el"
-;;;;;; (19845 45374))
+;;;;;; (19915 46047))
;;; Generated autoloads from progmodes/which-func.el
(put 'which-func-format 'risky-local-variable t)
(put 'which-func-current 'risky-local-variable t)
@@ -31760,7 +31960,7 @@ and off otherwise.
;;;### (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" (19901 13134))
+;;;;;; whitespace-mode) "whitespace" "whitespace.el" (19905 10215))
;;; Generated autoloads from whitespace.el
(autoload 'whitespace-mode "whitespace" "\
@@ -32190,8 +32390,8 @@ With arg, turn widget mode on if and only if arg is positive.
;;;***
;;;### (autoloads (widget-setup widget-insert widget-delete widget-create
-;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19886
-;;;;;; 45771))
+;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19968
+;;;;;; 28627))
;;; Generated autoloads from wid-edit.el
(autoload 'widgetp "wid-edit" "\
@@ -32307,7 +32507,7 @@ With arg, turn Winner mode on if and only if arg is positive.
;;;***
;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file
-;;;;;; woman woman-locale) "woman" "woman.el" (19886 45771))
+;;;;;; woman woman-locale) "woman" "woman.el" (19981 40664))
;;; Generated autoloads from woman.el
(defvar woman-locale nil "\
@@ -32620,46 +32820,47 @@ Zone out, completely.
;;;;;; "calc/calc-fin.el" "calc/calc-forms.el" "calc/calc-frac.el"
;;;;;; "calc/calc-funcs.el" "calc/calc-graph.el" "calc/calc-help.el"
;;;;;; "calc/calc-incom.el" "calc/calc-keypd.el" "calc/calc-lang.el"
-;;;;;; "calc/calc-macs.el" "calc/calc-map.el" "calc/calc-math.el"
-;;;;;; "calc/calc-menu.el" "calc/calc-misc.el" "calc/calc-mode.el"
-;;;;;; "calc/calc-mtx.el" "calc/calc-nlfit.el" "calc/calc-poly.el"
-;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el"
-;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el"
-;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-units.el"
-;;;;;; "calc/calc-vec.el" "calc/calc-yank.el" "calc/calcalg2.el"
-;;;;;; "calc/calcalg3.el" "calc/calccomp.el" "calc/calcsel2.el"
-;;;;;; "calendar/cal-bahai.el" "calendar/cal-coptic.el" "calendar/cal-french.el"
-;;;;;; "calendar/cal-html.el" "calendar/cal-islam.el" "calendar/cal-iso.el"
-;;;;;; "calendar/cal-julian.el" "calendar/cal-loaddefs.el" "calendar/cal-mayan.el"
-;;;;;; "calendar/cal-menu.el" "calendar/cal-move.el" "calendar/cal-persia.el"
-;;;;;; "calendar/cal-tex.el" "calendar/cal-x.el" "calendar/diary-loaddefs.el"
-;;;;;; "calendar/hol-loaddefs.el" "cdl.el" "cedet/cedet-cscope.el"
-;;;;;; "cedet/cedet-files.el" "cedet/cedet-global.el" "cedet/cedet-idutils.el"
-;;;;;; "cedet/cedet.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el"
-;;;;;; "cedet/ede/base.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el"
-;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el"
-;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/locate.el"
-;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el"
-;;;;;; "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el"
-;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el"
-;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el"
-;;;;;; "cedet/ede/proj-scheme.el" "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"
+;;;;;; "calc/calc-loaddefs.el" "calc/calc-macs.el" "calc/calc-map.el"
+;;;;;; "calc/calc-math.el" "calc/calc-menu.el" "calc/calc-misc.el"
+;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-nlfit.el"
+;;;;;; "calc/calc-poly.el" "calc/calc-prog.el" "calc/calc-rewr.el"
+;;;;;; "calc/calc-rules.el" "calc/calc-sel.el" "calc/calc-stat.el"
+;;;;;; "calc/calc-store.el" "calc/calc-stuff.el" "calc/calc-trail.el"
+;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el"
+;;;;;; "calc/calcalg2.el" "calc/calcalg3.el" "calc/calccomp.el"
+;;;;;; "calc/calcsel2.el" "calendar/cal-bahai.el" "calendar/cal-coptic.el"
+;;;;;; "calendar/cal-french.el" "calendar/cal-html.el" "calendar/cal-islam.el"
+;;;;;; "calendar/cal-iso.el" "calendar/cal-julian.el" "calendar/cal-loaddefs.el"
+;;;;;; "calendar/cal-mayan.el" "calendar/cal-menu.el" "calendar/cal-move.el"
+;;;;;; "calendar/cal-persia.el" "calendar/cal-tex.el" "calendar/cal-x.el"
+;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el"
+;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el"
+;;;;;; "cedet/cedet-idutils.el" "cedet/cedet.el" "cedet/ede/auto.el"
+;;;;;; "cedet/ede/autoconf-edit.el" "cedet/ede/base.el" "cedet/ede/cpp-root.el"
+;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el"
+;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el"
+;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el"
+;;;;;; "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" "cedet/ede/pmake.el"
+;;;;;; "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el"
+;;;;;; "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el"
+;;;;;; "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el"
+;;;;;; "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/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"
@@ -32667,13 +32868,13 @@ Zone out, completely.
;;;;;; "cedet/semantic/fw.el" "cedet/semantic/grammar-wy.el" "cedet/semantic/grammar.el"
;;;;;; "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el"
;;;;;; "cedet/semantic/idle.el" "cedet/semantic/imenu.el" "cedet/semantic/java.el"
-;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/mru-bookmark.el"
-;;;;;; "cedet/semantic/sb.el" "cedet/semantic/scope.el" "cedet/semantic/senator.el"
-;;;;;; "cedet/semantic/sort.el" "cedet/semantic/symref.el" "cedet/semantic/symref/cscope.el"
-;;;;;; "cedet/semantic/symref/filter.el" "cedet/semantic/symref/global.el"
-;;;;;; "cedet/semantic/symref/grep.el" "cedet/semantic/symref/idutils.el"
-;;;;;; "cedet/semantic/symref/list.el" "cedet/semantic/tag-file.el"
-;;;;;; "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el"
+;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el"
+;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/sb.el" "cedet/semantic/scope.el"
+;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el"
+;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/filter.el"
+;;;;;; "cedet/semantic/symref/global.el" "cedet/semantic/symref/grep.el"
+;;;;;; "cedet/semantic/symref/idutils.el" "cedet/semantic/symref/list.el"
+;;;;;; "cedet/semantic/tag-file.el" "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el"
;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el"
;;;;;; "cedet/semantic/util.el" "cedet/semantic/wisent.el" "cedet/semantic/wisent/comp.el"
;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el"
@@ -32685,32 +32886,33 @@ Zone out, completely.
;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/extract.el"
;;;;;; "cedet/srecode/fields.el" "cedet/srecode/filters.el" "cedet/srecode/find.el"
;;;;;; "cedet/srecode/getset.el" "cedet/srecode/insert.el" "cedet/srecode/java.el"
-;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "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" "emacs-lock.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"
+;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el"
+;;;;;; "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"
+;;;;;; "emacs-lock.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"
@@ -32736,8 +32938,8 @@ Zone out, completely.
;;;;;; "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/charprop.el" "international/cp51932.el" "international/eucjp-ms.el"
-;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.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"
@@ -32746,7 +32948,7 @@ Zone out, completely.
;;;;;; "international/uni-name.el" "international/uni-numeric.el"
;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el"
;;;;;; "international/uni-uppercase.el" "json.el" "kermit.el" "language/hanja-util.el"
-;;;;;; "language/thai-word.el" "ldefs-boot.el" "mail/blessmail.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"
@@ -32808,13 +33010,13 @@ Zone out, completely.
;;;;;; "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-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") (19901
-;;;;;; 13383 538856))
+;;;;;; "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") (19981 41048 99944))
;;;***
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 3395c41d2ff..0b569199935 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -115,20 +115,28 @@ from a file."
(defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks)
(defvar unload-feature-special-hooks
'(after-change-functions after-insert-file-functions
- after-make-frame-functions auto-fill-function before-change-functions
+ after-make-frame-functions auto-coding-functions
+ auto-fill-function before-change-functions
blink-paren-function buffer-access-fontify-functions
- choose-completion-string-functions command-line-functions
- comment-indent-function compilation-finish-functions delete-frame-functions
- disabled-command-function find-file-not-found-functions
- font-lock-beginning-of-syntax-function font-lock-fontify-buffer-function
- font-lock-fontify-region-function font-lock-mark-block-function
- font-lock-syntactic-face-function font-lock-unfontify-buffer-function
- font-lock-unfontify-region-function kill-buffer-query-functions
- kill-emacs-query-functions lisp-indent-function mouse-position-function
- redisplay-end-trigger-functions suspend-tty-functions
+ choose-completion-string-functions
+ comint-output-filter-functions command-line-functions
+ comment-indent-function compilation-finish-functions
+ delete-frame-functions disabled-command-function
+ fill-nobreak-predicate find-directory-functions
+ find-file-not-found-functions
+ font-lock-beginning-of-syntax-function
+ font-lock-fontify-buffer-function
+ font-lock-fontify-region-function
+ font-lock-mark-block-function
+ font-lock-syntactic-face-function
+ font-lock-unfontify-buffer-function
+ font-lock-unfontify-region-function
+ kill-buffer-query-functions kill-emacs-query-functions
+ lisp-indent-function mouse-position-function
+ redisplaylay-end-trigger-functions suspend-tty-functions
temp-buffer-show-function window-scroll-functions
- window-size-change-functions write-contents-functions write-file-functions
- write-region-annotate-functions)
+ window-size-change-functions write-contents-functions
+ write-file-functions write-region-annotate-functions)
"A list of special hooks from Info node `(elisp)Standard Hooks'.
These are symbols with hooklike values whose names don't end in
@@ -143,6 +151,19 @@ 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
+ (dolist (buffer (buffer-list))
+ (set-buffer buffer)
+ (let ((proposed major-mode))
+ ;; Look for an antecessor mode not defined in the feature we're processing
+ (while (and proposed (rassq proposed unload-function-defs-list))
+ (setq proposed (get proposed 'derived-mode-parent)))
+ (unless (eq proposed major-mode)
+ ;; Two cases: either proposed is nil, and we want to switch to fundamental
+ ;; mode, or proposed is not nil and not major-mode, and so we use it.
+ (funcall (or proposed 'fundamental-mode)))))))
+
;;;###autoload
(defun unload-feature (feature &optional force)
"Unload the library that provided FEATURE.
@@ -222,6 +243,10 @@ something strange, such as redefining an Emacs function."
(not (get (cdr y) 'autoload)))
(setq auto-mode-alist
(rassq-delete-all (cdr y) auto-mode-alist)))))
+
+ ;; Change major mode in all buffers using one defined in the feature being unloaded.
+ (unload--set-major-mode)
+
(when (fboundp 'elp-restore-function) ; remove ELP stuff first
(dolist (elt unload-function-defs-list)
(when (symbolp elt)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index d348456ae32..792827dd913 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -29,21 +29,15 @@
;; If you add/remove Lisp files to be loaded here, consider the
;; following issues:
-;; i) Any file loaded on all platforms should appear in $lisp
-;; and $shortlisp in src/Makefile.in. Use the .el or .elc version as
-;; appropriate.
+;; i) Any file loaded on any platform should appear in $lisp in src/lisp.mk.
+;; Use the .el or .elc version as appropriate.
-;; ii) Any file that is only loaded on some platforms should appear
-;; in the version of $lisp in the generated Makefile on that platform.
-;; At the present time, this is achieved by use of #ifdefs.
-;; It should also appear in $SOME_MACHINE_LISP on all platforms.
+;; This ensures both that the Lisp files are compiled (if necessary)
+;; before the emacs executable is dumped, and that they are passed to
+;; make-docfile. (Any that are not processed for DOC will not have
+;; doc strings in the dumped Emacs.) Because of this:
-;; The above steps ensure both that the Lisp files are compiled (if
-;; necessary) before the emacs executable is dumped, and that they are
-;; passed to make-docfile. (Any that are not processed for DOC will
-;; not have doc strings in the dumped Emacs.) Because of this:
-
-;; iii) If the file is loaded uncompiled, it should (where possible)
+;; ii) If the file is loaded uncompiled, it should (where possible)
;; obey the doc-string conventions expected by make-docfile.
;;; Code:
@@ -87,7 +81,7 @@
;; Do it after subr, since both after-load-functions and add-hook are
;; implemented in subr.el.
-(add-hook 'after-load-functions '(lambda (f) (garbage-collect)))
+(add-hook 'after-load-functions (lambda (f) (garbage-collect)))
;; We specify .el in case someone compiled version.el by mistake.
(load "version.el")
@@ -101,6 +95,7 @@
(load "env")
(load "format")
(load "bindings")
+(load "window") ; Needed here for `replace-buffer-in-windows'.
(setq load-source-file-function 'load-with-code-conversion)
(load "files")
@@ -128,11 +123,11 @@
;; multilingual text.
(load "international/mule-cmds")
(load "case-table")
-(load "international/characters")
-(load "composite")
;; This file doesn't exist when building a development version of Emacs
;; from the repository. It is generated just after temacs is built.
(load "international/charprop.el" t)
+(load "international/characters")
+(load "composite")
;; Load language-specific files.
(load "language/chinese")
@@ -162,7 +157,6 @@
(load "language/cham")
(load "indent")
-(load "window")
(load "frame")
(load "term/tty-colors")
(load "font-core")
@@ -310,7 +304,7 @@
(equal (nth 4 command-line-args) "bootstrap"))
(setcdr load-path nil))
-(remove-hook 'after-load-functions '(lambda (f) (garbage-collect)))
+(remove-hook 'after-load-functions (lambda (f) (garbage-collect)))
(setq inhibit-load-charset-map nil)
(clear-charset-maps)
diff --git a/lisp/longlines.el b/lisp/longlines.el
index 387ce394f50..e81a235a17b 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -95,11 +95,15 @@ This is used when `longlines-show-hard-newlines' is on."
;;;###autoload
(define-minor-mode longlines-mode
- "Toggle Long Lines mode.
+ "Minor mode to wrap long lines.
In Long Lines mode, long lines are wrapped if they extend beyond
`fill-column'. The soft newlines used for line wrapping will not
show up when the text is yanked or saved to disk.
+With no argument, this command toggles Flyspell mode.
+With a prefix argument ARG, turn Flyspell minor mode on if ARG is positive,
+otherwise turn it off.
+
If the variable `longlines-auto-wrap' is non-nil, lines are automatically
wrapped whenever the buffer is changed. You can always call
`fill-paragraph' to fill individual paragraphs.
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 9aac041e8bd..0722227d3d2 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -32,8 +32,6 @@
;;; Code:
-(require 'url-util)
-
(defgroup emacsbug nil
"Sending Emacs bug reports."
:group 'maint
@@ -126,7 +124,7 @@ Used for querying duplicates and linking to existing bugs.")
(if (and to subject body)
(if (report-emacs-bug-can-use-osx-open)
(start-process "/usr/bin/open" nil "open"
- (concat "mailto:" to
+ (concat "mailto:" to
"?subject=" (url-hexify-string subject)
"&body=" (url-hexify-string body)))
(start-process "xdg-email" nil "xdg-email"
@@ -152,8 +150,8 @@ Prompts for bug subject. Leaves you in a mail buffer."
;; Put these properties on semantically-void text.
;; report-emacs-bug-hook deletes these regions before sending.
(prompt-properties '(field emacsbug-prompt
- intangible but-helpful
- rear-nonsticky t))
+ intangible but-helpful
+ rear-nonsticky t))
(can-insert-mail (or (report-emacs-bug-can-use-xdg-email)
(report-emacs-bug-can-use-osx-open)))
user-point message-end-point)
@@ -177,24 +175,36 @@ Prompts for bug subject. Leaves you in a mail buffer."
(backward-char (length signature)))
(unless report-emacs-bug-no-explanations
;; Insert warnings for novice users.
- (when (string-match "@gnu\\.org$" report-emacs-bug-address)
- (insert "This bug report will be sent to the Free Software Foundation,\n")
- (let ((pos (point)))
- (insert "not to your local site managers!")
- (overlay-put (make-overlay pos (point)) 'face 'highlight)))
- (insert "\nPlease write in ")
- (let ((pos (point)))
- (insert "English")
- (overlay-put (make-overlay pos (point)) 'face 'highlight))
- (insert " if possible, because the Emacs maintainers
-usually do not have translators to read other languages for them.\n\n")
- (insert (format "Your report will be posted to the %s mailing list"
- report-emacs-bug-address))
- (insert "\nand the gnu.emacs.bug news group, and at http://debbugs.gnu.org.\n\n"))
-
- (insert "Please describe exactly what actions triggered the bug\n"
- "and the precise symptoms of the bug. If you can, give\n"
- "a recipe starting from `emacs -Q':\n\n")
+ (if (not (equal "bug-gnu-emacs@gnu.org" report-emacs-bug-address))
+ (insert (format "The report will be sent to %s.\n\n"
+ report-emacs-bug-address))
+ (insert "This bug report will be sent to the ")
+ (insert-button
+ "Bug-GNU-Emacs"
+ 'face 'link
+ 'help-echo (concat "mouse-2, RET: Follow this link")
+ 'action (lambda (button)
+ (browse-url "http://lists.gnu.org/archive/html/bug-gnu-emacs/"))
+ 'follow-link t)
+ (insert " mailing list\nand the GNU bug tracker at ")
+ (insert-button
+ "debbugs.gnu.org"
+ 'face 'link
+ 'help-echo (concat "mouse-2, RET: Follow this link")
+ 'action (lambda (button)
+ (browse-url "http://debbugs.gnu.org/"))
+ 'follow-link t)
+
+ (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.
+
+Please write in English if possible, as the Emacs maintainers
+usually do not have translators for other languages.\n\n")))
+
+ (insert "Please describe exactly what actions triggered the bug, and\n"
+ "the precise symptoms of the bug. If you can, give a recipe\n"
+ "starting from `emacs -Q':\n\n")
(add-text-properties (save-excursion
(rfc822-goto-eoh)
(line-beginning-position 2))
@@ -227,8 +237,8 @@ usually do not have translators to read other languages for them.\n\n")
system-configuration-options "'\n\n"))
(insert "Important settings:\n")
(mapc
- '(lambda (var)
- (insert (format " value of $%s: %s\n" var (getenv var))))
+ (lambda (var)
+ (insert (format " value of $%s: %s\n" var (getenv var))))
'("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))
@@ -330,6 +340,10 @@ usually do not have translators to read other languages for them.\n\n")
(interactive)
(info "(emacs)Bugs"))
+;; It's the default mail mode, so it seems OK to use its features.
+(autoload 'message-bogus-recipient-p "message")
+(defvar message-send-mail-function)
+
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
(save-excursion
@@ -340,11 +354,29 @@ usually do not have translators to read other languages for them.\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.
(unless (or report-emacs-bug-no-confirmation
- (yes-or-no-p
- "Send this bug report to the Emacs maintainers? "))
+ (yes-or-no-p
+ "Send this bug report to the Emacs maintainers? "))
(goto-char (point-min))
(if (search-forward "To: ")
(delete-region (point) (line-end-position)))
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 597344fb88a..f4b29958aab 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -4,7 +4,7 @@
;; This file is part of GNU Emacs.
;; Author: Bill Carpenter <bill@carpenter.ORG>
-;; Version: 8
+;; Version: 11
;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html>
@@ -13,14 +13,20 @@
;; A replacement for parts of Emacs' 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. If you are using
-;; fakemail as a subprocess, you can switch to feedmail and eliminate
-;; the use of fakemail. feedmail works with recent versions of
-;; Emacs (mostly, but not exclusively, tested against 19.34 on
-;; Win95; some testing on 20.x) and XEmacs (tested with 20.4 and
-;; later betas). It probably no longer works with Emacs 18,
-;; though I haven't tried that in a long time. Sorry, no manual yet
-;; in this release. Look for one with the next release.
+;; ability to queue messages for later sending. This replaces
+;; the standalone fakemail program that used to be distributed with Emacs.
+
+;; feedmail works with recent versions of Emacs (20.x series) and
+;; XEmacs (tested with 20.4 and later betas). It probably no longer
+;; works with Emacs v18, though I haven't tried that in a long
+;; time. Makoto.Nakagawa@jp.compaq.com reports: "I have a report
+;; that with a help of APEL library, feedmail works fine under emacs
+;; 19.28. You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/.
+;; you need apel-10.2 or later to make feedmail work under emacs
+;; 19.28."
+
+;; Sorry, no manual yet in this release. Look for one with the next
+;; release. Or the one after that. Or maybe later.
;; As far as I'm concerned, anyone can do anything they want with
;; this specific piece of code. No warranty or promise of support is
@@ -68,7 +74,8 @@
;; This file requires the mail-utils library.
;;
;; This file requires the smtpmail library if you use
-;; feedmail-buffer-to-smtpmail.
+;; feedmail-buffer-to-smtpmail. It requires the smtp library if
+;; you use feedmail-buffer-smtp.
;;
;; This file requires the custom library. Unfortunately, there are
;; two incompatible versions of the custom library. If you don't have
@@ -82,12 +89,11 @@
;; This code does in elisp a superset of the stuff that used to be done
;; by the separate program "fakemail" for processing outbound email.
;; In other words, it takes over after you hit "C-c C-c" in mail mode.
-;; By appropriate setting of options, you can still use "fakemail",
-;; or you can even revert to sendmail (which is not too popular
-;; locally). See the variables at the top of the elisp for how to
-;; achieve these effects (there are more features than in this bullet
-;; list, so trolling through the variable and function doc strings may
-;; be worth your while):
+;; By appropriate setting of options, you can even revert to sendmail
+;; (which is not too popular locally). See the variables at the top
+;; of the elisp for how to achieve these effects (there are more
+;; features than in this bullet list, so trolling through the variable
+;; and function doc strings may be worth your while):
;;
;; --- you can park outgoing messages into a disk-based queue and
;; stimulate sending them all later (handy for laptop users);
@@ -147,6 +153,32 @@
;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail")
;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
;;
+;; though VM users might find it more comfortable to use this instead of
+;; the above example's last line:
+;;
+;; (setq auto-mode-alist (cons '("\\.fqm$" . feedmail-vm-mail-mode) auto-mode-alist))
+;;
+;; If you end up getting asked about killing modified buffers all the time
+;; you are probably being prompted from outside feedmail. You can probably
+;; get cured by doing the defadvice stuff described in the documentation
+;; for the variable feedmail-queue-buffer-file-name below.
+;;
+;; If you are wondering how to send your messages to some SMTP server
+;; (which is not really a feedmail-specific issue), you are probably
+;; looking for smtpmail.el, and it is probably already present in your
+;; emacs installation. Look at smtpmail.el for how to set that up, and
+;; then do this to hook it into feedmail:
+;;
+;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t)
+;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail)
+;;
+;; Alternatively, the FLIM <http://www.m17n.org/FLIM/> project
+;; provides a library called smtp.el. If you want to use that, the above lines
+;; would be:
+;;
+;; (autoload 'feedmail-buffer-to-smtp "feedmail" nil t)
+;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtp)
+;;
;; If you are using the desktop.el library to restore your sessions, you might
;; like to add the suffix ".fqm" to the list of non-saved things via the variable
;; desktop-files-not-to-save.
@@ -174,13 +206,27 @@
;; (setq message-send-mail-function 'feedmail-send-it)
;; (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter)
;;
+;; If you use message-mode and you make use of feedmail's queueing
+;; stuff, you might also like to adjust these variables to appropriate
+;; values for message-mode:
+;;
+;; feedmail-queue-runner-mode-setter
+;; feedmail-queue-runner-message-sender
+;;
+;; If you are using the "cmail" email package, there is some built-in
+;; support for feedmail in recent versions. To enable it, you should:
+;;
+;; (setq cmail-use-feedmail t)
+;;
+;;;;;;;;
+;;
;; I think the LCD is no longer being updated, but if it were, this
;; would be a proper LCD record. There is an old version of
;; feedmail.el in the LCD archive. It works but is missing a lot of
;; features.
;;
;; LCD record:
-;; feedmail|Bill Carpenter|bill@bubblegum.net,bill@carpenter.ORG|Outbound mail queue handling|98-06-15|8|feedmail.el
+;; feedmail|WJCarpenter|bill-feedmail@carpenter.ORG|Outbound mail queue handling|01-??-??|11-beta-??|feedmail.el
;;
;; Change log:
;; original, 31 March 1991
@@ -277,14 +323,51 @@
;; feedmail-queue-auto-file-nuke
;; feedmail-queue-express-to-queue and feedmail-queue-express-to-draft
;; strong versions of "q"ueue and "d"raft answers (always make a new file)
+;; patchlevel 9, 23 March 2001
+;; feedmail-queue-buffer-file-name to work around undesirable mail-send prompt
+;; at message action prompt, can scroll message buffer with "<" and ">";
+;; C-v no longer scrolls help buffer
+;; conditionalize (discard-input) in message action prompt to avoid killing
+;; define-kbd-macro
+;; fixed error if feedmail-x-mailer-line was nil
+;; feedmail-binmail-template only uses /bin/rmail if it exists
+;; relocate feedmail-queue-alternative-mail-header-separator stuff
+;; added feedmail-vm-mail-mode, which make a good auto-mode-alist entry
+;; for FQM files if you're a VM user
+;; change buffer-substring calls to buffer-substring-no-properties for
+;; speed-up (suggested by Howard Melman <howard@silverstream.com>)
+;; feedmail-sendmail-f-doesnt-sell-me-out to contol "-f" in call to sendmail
+;; in feedmail-buffer-to-sendmail
+;; better trapping of odd conditions during the running of the queue;
+;; thanks to Yigal Hochberg for helping me test much of this by remote
+;; control
+;; feedmail-debug and feedmail-debug-sit-for
+;; feedmail-display-full-frame
+;; feedmail-queue-express-hook
+;; added example function feedmail-spray-via-bbdb
+;; use expand-file-name for setting default directory names
+;; define feedmail-binmail-gnulinuxish-template as a suggestion for
+;; the value of feedmail-binmail-template on GNU/Linux and maybe other
+;; systems with non-classic /bin/[r]mail behavior
+;; guard against nil user-mail-address in generating MESSAGE-ID:
+;; feedmail-queue-slug-suspect-regexp is now a variable to
+;; accommodate non-ASCII environments (thanks to
+;; Makoto.Nakagawa@jp.compaq.com for this suggestion)
+;; feedmail-buffer-to-smtp, to parallel feedmail-buffer-to-smtpmail
+;; patchlevel 10, 22 April 2001
+;; DATE: and MESSAGE-ID stuff now forces system-time-locale to "C"
+;; (brought to my attention by Makoto.Nakagawa@jp.compaq.com)
+;; patchlevel 11
+;; tweak default FROM: calculation to look at mail-host-address
+;; (suggested by "Jason Eisner" <jason@cs.jhu.edu>)
;;
-;; todo (probably in patchlevel 9):
+;; todo:
;; write texinfo manual
;; maybe partition into multiple files, including files of examples
;;
;;; Code:
-(defconst feedmail-patch-level "8")
+(defconst feedmail-patch-level "11-beta-1")
(require 'mail-utils) ; pick up mail-strip-quoted-names
@@ -312,6 +395,10 @@
"Options related to queuing messages for later sending."
:group 'feedmail)
+(defgroup feedmail-debug nil
+ "Options related to debug messages for later sending."
+ :group 'feedmail)
+
(defcustom feedmail-confirm-outgoing nil
"If non-nil, give a y-or-n confirmation prompt before sending mail.
@@ -329,12 +416,30 @@ cases. You can give a timeout for the prompt; see variable
)
+(defcustom feedmail-display-full-frame 'queued
+ "If non-nil, show prepped messages in a full frame.
+If nil, the prepped message will be shown, for confirmation or
+otherwise, in some window in the current frame without resizing
+anything. That may or may not display enough of the message to
+distinguish it from others. If set to the symbol 'queued, take
+this action only when running the queue. If set to the symbol
+'immediate, take this action only when sending immediately. For
+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."
+ :group 'feedmail-misc
+ :type 'boolean
+ )
+
+
(defcustom feedmail-confirm-outgoing-timeout nil
"If non-nil, a timeout in seconds at the send confirmation prompt.
If a positive number, it's a timeout before sending. If a negative
number, it's a timeout before not sending. This will not work if your
version of Emacs doesn't include the function `y-or-n-p-with-timeout'
\(e.g., some versions of XEmacs\)."
+ :version "24.1"
:group 'feedmail-misc
:type '(choice (const nil) integer)
)
@@ -472,11 +577,11 @@ itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"X-Sender\" or \"X-Resent-Sender\".
+by feedmail to either \"Sender\" or \"Resent-Sender\".
You can probably leave this nil, but if you feel like using it, a good
value would be a string of a fully-qualified domain name form of your
-address. For example, \"bill@bubblegum.net (WJCarpenter)\". The Sender:
+address. For example, \"bill@example.net (WJCarpenter)\". The Sender:
header is fiddled after the From: header is fiddled."
:group 'feedmail-headers
:type '(choice (const nil) string)
@@ -511,10 +616,10 @@ itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"X-From\" or \"X-Resent-From\".
+by feedmail to either \"From\" or \"Resent-From\".
A good value would be a string fully-qualified domain name form of
-your address. For example, \"bill@bubblegum.net (WJCarpenter)\". The
+your address. For example, \"bill@example.net (WJCarpenter)\". The
default value of this variable uses the standard elisp variable
`user-mail-address' which should be set on every system but has a decent
chance of being wrong. It also honors `mail-from-style'. Better to set
@@ -525,6 +630,29 @@ to arrange for the message to get a From: line."
)
+(defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
+ "Says whether the sendmail program issues a warning header if called with \"-f\".
+The sendmail program has a useful feature to let you set the envelope FROM
+address via a command line option, \"-f\". Unfortunately, it also has a widely
+disliked default behavior of selling you out if you do that by inserting
+an unattractive warning in the headers. It looks something like this:
+
+ X-Authentication-Warning: u1.example.com: niceguy set sender to niceguy@example.com using -f
+
+It is possible to configure sendmail to not do this, but such a reconfiguration
+is not an option for many users. As this is the default behavior of most
+sendmail installations, one can mostly only wish it were otherwise. If feedmail
+believes the sendmail program will sell you out this way, it won't use the \"-f\"
+option when calling sendmail. If it doesn't think sendmail will sell you out,
+it will use the \"-f\" \(since it is a handy feature\). You control what
+feedmail thinks with this variable. The default is nil, meaning that feedmail
+will believe that sendmail will sell you out."
+ :version "24.1"
+ :group 'feedmail-headers
+ :type 'boolean
+)
+
+
(defcustom feedmail-deduce-envelope-from t
"If non-nil, deduce message envelope \"from\" from header From: or Sender:.
In other words, if there is a Sender: header in the message, temporarily
@@ -674,7 +802,7 @@ in the saved message if you use Fcc:."
"Non-nil means fiddled header fields should go at the top of the header.
nil means insert them at the bottom. This is mostly a novelty issue since
the standards define the ordering of header fields to be immaterial and it's
-fairly likely that some MTA along the way will have its own idea of what the
+fairly likely that some MTA/MUA along the way will have its own idea of what the
order should be, regardless of what you specify."
:group 'feedmail-headers
:type 'boolean
@@ -718,19 +846,21 @@ headers of a message. Another use is to do a crude form of mailmerge, for
which see `feedmail-spray-address-fiddle-plex-list'.
If one of the calls to the buffer-eating function results in an error,
-what happens next is carelessly defined, so beware."
+what happens next is carelessly defined, so beware. This should get ironed
+out in some future release, and there could be other API changes for spraying
+as well."
:group 'feedmail-spray
:type 'boolean
)
(defvar feedmail-spray-this-address nil
- "Do not set or change this variable. See `feedmail-spray-address-fiddle-plex-list'.")
+ "Do not set this variable, except via `feedmail-spray-address-fiddle-plex-list'.")
(defcustom feedmail-spray-address-fiddle-plex-list nil
"User-supplied specification for a crude form of mailmerge capability.
When spraying is enabled, feedmail composes a list of envelope addresses.
In turn, `feedmail-spray-this-address' is temporarily set to each address
-\(stripped of any comments and angle brackets\) and calls a function which
+\(stripped of any comments and angle brackets\) and a function is called which
fiddles message headers according to this variable. See the documentation for
`feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
@@ -747,16 +877,20 @@ The fiddle-plex operator is 'supplement.
May be a function, in which case it is called with no arguments and is
expected to return nil, t, a string, another function, or a fiddle-plex.
-The result is used recursively.
+The result is used recursively. The function may alter the value of the
+variable feedmail-spray-this-address, perhaps to embellish it with a
+human name. It would be logical in such a case to return as a value a
+string naming a message header like \"TO\" or an appropriately constructed
+fiddle-plex. For an example, see feedmail-spray-via-bbdb.
-May be a list of any combination of the foregoing and fiddle-plexes. (A
-value for this variable which consists of a single fiddle-plex must be
-nested inside another list to avoid ambiguity.) If a list, each item
-is acted on in turn as described above.
+May be a list of any combination of the foregoing and/or
+fiddle-plexes. (A value for this variable which consists of a single
+fiddle-plex must be nested inside another list to avoid ambiguity.)
+If a list, each item is acted on in turn as described above.
For example,
- (setq feedmail-spray-address-fiddle-plex-list 'my-address-embellisher)
+ (setq feedmail-spray-address-fiddle-plex-list 'feedmail-spray-via-bbdb)
The idea of the example is that, during spray mode, as each message is
about to be transmitted to an individual address, the function will be
@@ -775,6 +909,28 @@ you are at accomplishing inherently inefficient things."
:type 'sexp ; too complex to be described accurately
)
+;; FIXME this is a macro?
+(declare-function bbdb-search "ext:bbdb-com"
+ (records &optional name company net notes phone))
+(declare-function bbdb-records "ext:bbdb"
+ (&optional dont-check-disk already-in-db-buffer))
+(declare-function bbdb-dwim-net-address "ext:bbdb-com" (record &optional net))
+
+(defun feedmail-spray-via-bbdb ()
+ "Example function for use with feedmail spray mode.
+NB: it's up to the user to have the BBDB environment already set up properly
+before using this."
+ (let (net-rec q-net-addy embellish)
+ (setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$"))
+ (setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy))
+ (if (and (car net-rec) (not (cdr net-rec)))
+ (setq net-rec (car net-rec))
+ (setq net-rec nil))
+ (if net-rec (setq embellish (bbdb-dwim-net-address net-rec)))
+ (if embellish
+ (list "To" embellish 'supplement)
+ (list "To" feedmail-spray-this-address 'supplement))))
+
(defcustom feedmail-enable-queue nil
"If non-nil, provide for stashing outgoing messages in a queue.
@@ -813,20 +969,20 @@ without having to answer no to the individual message prompts."
(defcustom feedmail-queue-directory
- (concat (getenv "HOME") "/mail/q")
+ (expand-file-name "~/mail/q")
"Name of a directory where messages will be queued.
Directory will be created if necessary. Should be a string that
-doesn't end with a slash. Default is \"$HOME/mail/q\"."
+doesn't end with a slash. Default is \"~/mail/q\"."
:group 'feedmail-queue
:type 'string
)
(defcustom feedmail-queue-draft-directory
- (concat (getenv "HOME") "/mail/draft")
+ (expand-file-name "~/mail/draft")
"Name of a directory where draft messages will be queued.
Directory will be created if necessary. Should be a string that
-doesn't end with a slash. Default is \"$HOME/mail/draft\"."
+doesn't end with a slash. Default is \"~/mail/draft\"."
:group 'feedmail-queue
:type 'string
)
@@ -894,7 +1050,10 @@ the help for the message action prompt."
(?* . feedmail-message-action-toggle-spray)
- (?\C-v . feedmail-message-action-help)
+ (?> . feedmail-message-action-scroll-up)
+ (?< . feedmail-message-action-scroll-down)
+ (? . feedmail-message-action-scroll-up)
+ ;; (?\C-v . feedmail-message-action-help)
(?? . feedmail-message-action-help))
"An alist of choices for the message action prompt.
All of the values are function names, except help, which is a special
@@ -987,7 +1146,10 @@ This variable is used by the default date generating function,
feedmail-default-date-generator. If nil, the default, the
last-modified timestamp of the queue file is used to create the
message Date: header; if there is no queue file, the current time is
-used."
+used. If you are using VM, it might be supplying this header for
+you. To suppress VM's version
+
+ (setq vm-mail-header-insert-date nil)"
:group 'feedmail-queue
:type 'boolean
)
@@ -999,7 +1161,10 @@ This variable is used by the default Message-Id: generating function,
`feedmail-default-message-id-generator'. If nil, the default, the
last-modified timestamp of the queue file is used to create the
message Message-Id: header; if there is no queue file, the current time is
-used."
+used. If you are using VM, it might be supplying this header for
+you. To suppress VM's version
+
+ (setq vm-mail-header-insert-date nil)"
:group 'feedmail-queue
:type 'boolean
)
@@ -1035,6 +1200,22 @@ any."
)
+(defcustom feedmail-queue-slug-suspect-regexp "[^a-z0-9-]+"
+ "Regular expression for characters/substrings to be replaced.
+When feedmail creates a filename from a subject string, it puts hyphens
+in place of strings which may cause problems in filenames. By default,
+only alphanumeric and hyphen characters are kept, and all others are
+converted. In non-ASCII environments, it may be more helpful to
+tweak this regular expression to reflect local or personal language
+conventions. Substitutions are done repeatedly until the regular expression
+no longer matches to transformed string. Used by function
+feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
+ :version "24.1"
+ :group 'feedmail-queue
+ :type 'string
+)
+
+
(defcustom feedmail-queue-default-file-slug t
"Indicates what to use for subject-less messages when forming a file name.
When feedmail queues a message, it creates a unique file name. By default,
@@ -1095,6 +1276,61 @@ the file without bothering you."
)
+(defcustom feedmail-debug nil
+ "If non-nil, blat a debug messages and such in the mini-buffer.
+This is intended as an aid to tracing what's going on but is probably
+of casual real use only to the feedmail developer."
+ :version "24.1"
+ :group 'feedmail-debug
+ :type 'boolean
+)
+
+
+(defcustom feedmail-debug-sit-for 0
+ "Duration of pause after feedmail-debug messages.
+After some messages are divulged, it may be helpful to pause before
+something else obliterates them. This value controls the duration of
+the pause. If the value is nil or 0, the sit-for is not done, which
+has the effect of not pausing at all. Debug messages can be seen after
+the fact in the messages buffer."
+ :version "24.1"
+ :group 'feedmail-debug
+ :type 'integer
+)
+
+
+(defvar feedmail-queue-buffer-file-name nil
+ "If non-nil, has the value normally expected of 'buffer-file-name'.
+You are not intended to set this to something in your configuration. Rather,
+you might programmatically set it to something via a hook or function
+advice or whatever. You might like to do this if you are using a mail
+composition program that eventually uses sendmail.el's 'mail-send'
+function to process the message. If there is a filename associated
+with the message buffer, 'mail-send' will ask you for confirmation.
+There's no trivial way to avoid it. It's unwise to just set the value
+of 'buffer-file-name' to nil because that will defeat feedmail's file
+management features. Instead, arrange for this variable to be set to
+the value of 'buffer-file-name' before setting that to nil. An easy way
+to do that would be with defadvice on 'mail-send' \(undoing the
+assignments in a later advice\).
+
+feedmail will pretend that 'buffer-file-name', if nil, has the value
+assigned of 'feedmail-queue-buffer-file-name' and carry out its normal
+activities. feedmail does not restore the non-nil value of
+'buffer-file-name'. For safe bookkeeping, the user should insure that
+feedmail-queue-buffer-file-name is restored to nil.
+
+Example 'defadvice' for mail-send:
+
+ (defadvice mail-send (before feedmail-mail-send-before-advice activate)
+ (setq feedmail-queue-buffer-file-name buffer-file-name)
+ (setq buffer-file-name nil))
+
+ (defadvice mail-send (after feedmail-mail-send-after-advice activate)
+ (if feedmail-queue-buffer-file-name (setq buffer-file-name feedmail-queue-buffer-file-name))
+ (setq feedmail-queue-buffer-file-name nil))
+")
+
;; defvars to make byte-compiler happy(er)
(defvar feedmail-error-buffer nil)
(defvar feedmail-prepped-text-buffer nil)
@@ -1126,6 +1362,7 @@ buffer (typically by typing C-c C-c), whether the message is sent immediately
or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is
called when messages are being sent from the queue directory, typically via a
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))
@@ -1155,21 +1392,33 @@ It shows the simple addresses and gets a confirmation. Use as:
(defcustom feedmail-last-chance-hook nil
"User's last opportunity to modify the message on its way out.
-It has already had all the header prepping from the standard package.
-The next step after running the hook will be to push the buffer into a
-subprocess that mails the mail. The hook might be interested in
-these: (1) `feedmail-prepped-text-buffer' contains the header and body
-of the message, ready to go; (2) `feedmail-address-list' contains a list
+When this hook runs, the current buffer is already the appropriate
+buffer. It has already had all the header prepping from the standard
+package. The next step after running the hook will be to save the
+message via FCC: processing. The hook might be interested in these:
+\(1) `feedmail-prepped-text-buffer' contains the header and body of the
+message, ready to go; (2) `feedmail-address-list' contains a list
of simplified recipients of addresses which are to be given to the
subprocess (the hook may change the list); (3) `feedmail-error-buffer'
is an empty buffer intended to soak up errors for display to the user.
If the hook allows interactive activity, the user should not send more
mail while in the hook since some of the internal buffers will be
-reused and things will get confused."
+reused and things will get confused. It's not necessary to
+arrange for the undoing of any changes you make to the buffer."
:group 'feedmail-misc
:type 'hook
)
+(defcustom feedmail-queue-express-hook nil
+ "Chance to modify a message being sent directly to a queue.
+Run by feedmail-queue-express-to-queue and feedmail-queue-express-to-draft.
+For example, you might want to run vm-mime-encode-composition to take
+care of attachments. If you subsequently edit the message buffer, you
+can undo the encoding."
+ :version "24.1"
+ :group 'feedmail-queue
+ :type 'hook
+)
(defcustom feedmail-before-fcc-hook nil
"User's last opportunity to modify the message before Fcc action.
@@ -1188,7 +1437,7 @@ internal buffers will be reused and things will get confused."
)
(defcustom feedmail-queue-runner-mode-setter
- '(lambda (&optional arg) (mail-mode))
+ (lambda (&optional arg) (mail-mode))
"A function to set the proper mode of a message file.
Called when the message is read back out of the queue directory with a single
argument, the optional argument used in the call to
@@ -1197,6 +1446,9 @@ argument, the optional argument used in the call to
Most people want `mail-mode', so the default value is an anonymous
function which is just a wrapper to ignore the supplied argument when
calling it, but here's your chance to have something different.
+If you are a VM user, you might like feedmail-vm-mail-mode, though you
+really don't need that (and it's not particularly well-tested).
+
Called with funcall, not `call-interactively'."
:group 'feedmail-queue
:type 'function
@@ -1220,24 +1472,28 @@ set `mail-header-separator' to the value of
)
-(defcustom feedmail-queue-runner-message-sender 'mail-send-and-exit
+(defcustom feedmail-queue-runner-message-sender
+ (lambda (&optional arg) (mail-send))
"Function to initiate sending a message file.
Called for each message read back out of the queue directory with a
single argument, the optional argument used in the call to
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
-Interactively, that argument will be the prefix argument. Most people
-want `mail-send-and-exit' (bound to C-c C-c in mail-mode), but here's
-your chance to have something different. Called with `funcall', not
-`call-interactively'."
+Interactively, that argument will be the prefix argument.
+Most people want `mail-send' (bound to C-c C-s in mail-mode), but here's
+your chance to have something different. The default value is just a
+wrapper function which discards the optional argument and calls
+mail-send. If you are a VM user, you might like vm-mail-send, though
+you really don't need that. Called with funcall, not call-interactively."
+ :version "24.1" ; changed default
:group 'feedmail-queue
:type 'function
)
(defcustom feedmail-queue-runner-cleaner-upper
- '(lambda (fqm-file &optional arg)
+ (lambda (fqm-file &optional arg)
(delete-file fqm-file)
- (if (and arg feedmail-queue-chatty) (message "FQM: Nuked %s" fqm-file)))
+ (if arg (feedmail-say-chatter "Nuked %s" fqm-file)))
"Function that will be called after a message has been sent.
Not called in the case of errors. This function is called with two
arguments: the name of the message queue file for the message just sent,
@@ -1269,29 +1525,60 @@ variable, but may depend on its value as described here.")
The function's three (mandatory) arguments are: (1) the buffer
containing the prepped message; (2) a buffer where errors should be
directed; and (3) a list containing the addresses individually as
-strings. Three popular choices for this are
-`feedmail-buffer-to-binmail', `feedmail-buffer-to-smtpmail', and
-`feedmail-buffer-to-sendmail'. If you use the sendmail form, you
-probably want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc'
-to nil. If you use the binmail form, check the value of
-`feedmail-binmail-template'."
+strings. Popular choices for this are `feedmail-buffer-to-binmail',
+`feedmail-buffer-to-smtpmail', `feedmail-buffer-to-sendmail', and
+`feedmail-buffer-to-smtp'. If you use the sendmail form, you probably
+want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc to nil'.
+If you use the binmail form, check the value of `feedmail-binmail-template'."
:group 'feedmail-misc
:type 'function
)
+(defconst feedmail-binmail-gnulinuxish-template
+ (concat
+ "(echo From "
+ (if (boundp 'user-login-name) user-login-name "feedmail")
+ " ; cat -) | /usr/bin/rmail %s")
+ "Good candidate for GNU/Linux systems and maybe others.
+You may need to modify this if your \"rmail\" is in a different place.
+For example, I hear that in some Debian systems, it's /usr/sbin/rmail.
+See feedmail-binmail-template documentation."
+ )
-(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s")
+(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s"
+ (if (file-exists-p "/bin/rmail")
+ "/bin/rmail %s" "/bin/mail %s"))
"Command template for the subprocess which will get rid of the mail.
It can result in any command understandable by /bin/sh. Might not
-work at all in non-Unix environments. The single '%s', if present,
+work at all in non-UNIX environments. The single '%s', if present,
gets replaced by the space-separated, simplified list of addressees.
Used in `feedmail-buffer-to-binmail' to form the shell command which
-will receive the contents of the prepped buffer as stdin. If you'd
-like your errors to come back as mail instead of immediately in a
-buffer, try /bin/rmail instead of /bin/mail (this can be accomplished
-by keeping the default nil setting of `mail-interactive'). You might
-also like to consult local mail experts for any other interesting
-command line possibilities."
+will receive the contents of the prepped buffer as stdin. The default
+value uses /bin/rmail (if it exists) unless `mail-interactive' has been
+set non-nil.
+
+If you'd like your errors to come back as mail instead of immediately
+in a buffer, try /bin/rmail instead of /bin/mail. If /bin/rmail
+exists, this can be accomplished by keeping the default nil setting of
+`mail-interactive'. You might also like to consult local mail experts
+for any other interesting command line possibilities. Some versions
+of UNIX have an rmail program which behaves differently than
+/bin/rmail and complains if feedmail gives it a message on stdin. If
+you don't know about such things and if there is no local expert to
+consult, stick with /bin/mail or use one of the other buffer eating
+functions.
+
+The above description applies to \"classic\" UNIX /bin/mail and /bin/rmail.
+On most GNU/Linux systems and perhaps other places, /bin/mail behaves
+completely differently and shouldn't be used at all in this template.
+Instead of /bin/rmail, there is a /usr/bin/rmail, and it can be used
+with a wrapper. The wrapper is necessary because /usr/bin/rmail on such
+systems requires that the first line of the message appearing on standard
+input have a UNIX-style From_ postmark. If you have such a system, the
+wrapping can be accomplished by setting the value of `feedmail-binmail-template'
+to `feedmail-binmail-gnulinuxish-template'. You should then send some test
+messages to make sure it works as expected."
+ :version "24.1" ; changed default
:group 'feedmail-misc
:type 'string
)
@@ -1304,6 +1591,7 @@ command line possibilities."
(defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
"Function which actually calls /bin/mail as a subprocess.
Feeds the buffer to it."
+ (feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid)
(set-buffer prepped)
(apply
'call-process-region
@@ -1312,25 +1600,23 @@ Feeds the buffer to it."
(mapconcat 'identity addr-listoid " "))))))
+(defvar sendmail-program)
+
(defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
"Function which actually calls sendmail as a subprocess.
Feeds the buffer to it. Probably has some flaws for Resent-* and other
-complicated cases."
+complicated cases. Takes addresses from message headers and
+might disappoint you with BCC: handling. In case of odd results, consult
+local gurus."
+ (require 'sendmail)
+ (feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
(set-buffer prepped)
(apply 'call-process-region
- (append (list (point-min) (point-max)
- (cond ((boundp 'sendmail-program)
- sendmail-program)
- ((file-exists-p "/usr/sbin/sendmail")
- "/usr/sbin/sendmail")
- ((file-exists-p "/usr/lib/sendmail")
- "/usr/lib/sendmail")
- ((file-exists-p "/usr/ucblib/sendmail")
- "/usr/ucblib/sendmail")
- (t "fakemail"))
+ (append (list (point-min) (point-max) sendmail-program
nil errors-to nil "-oi" "-t")
;; provide envelope "from" to sendmail; results will vary
- (list "-f" user-mail-address)
+ (if feedmail-sendmail-f-doesnt-sell-me-out
+ (list "-f" user-mail-address))
;; These mean "report errors by mail" and "deliver in background".
(if (null mail-interactive) '("-oem" "-odb")))))
@@ -1345,24 +1631,48 @@ complicated cases."
;; I'm not sure smtpmail.el is careful about the following
;; return value, but it also uses it internally, so I will fear
;; no evil.
+ (feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid)
(require 'smtpmail)
- (if (not (smtpmail-via-smtp addr-listoid prepped))
- (progn
- (set-buffer errors-to)
- (insert "Send via smtpmail failed. Probable SMTP protocol error.\n")
- (insert "Look for details below or in the *Messages* buffer.\n\n")
- (let ((case-fold-search t)
- ;; don't be overconfident about the name of the trace buffer
- (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
- (mapcar
- '(lambda (buffy)
- (if (string-match tracer (buffer-name buffy))
- (progn
- (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
- (insert-buffer-substring buffy)
- (insert "\n\n"))))
- (buffer-list))))))
-
+ (let ((result (smtpmail-via-smtp addr-listoid prepped)))
+ (when result
+ (set-buffer errors-to)
+ (insert "Send via smtpmail failed: %s" result)
+ (let ((case-fold-search t)
+ ;; don't be overconfident about the name of the trace buffer
+ (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
+ (mapcar
+ (lambda (buffy)
+ (if (string-match tracer (buffer-name buffy))
+ (progn
+ (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
+ (insert-buffer-substring buffy)
+ (insert "\n\n"))))
+ (buffer-list))))))
+
+(declare-function smtp-via-smtp "ext:smtp" (sender recipients smtp-text-buffer))
+(defvar smtp-server)
+
+;; FLIM's smtp.el pointed out to me by Kenichi Handa <handa@etl.go.jp>
+(defun feedmail-buffer-to-smtp (prepped errors-to addr-listoid)
+ "Function which actually calls smtp-via-smtp to send buffer as e-mail."
+ (feedmail-say-debug ">in-> feedmail-buffer-to-smtp %s" addr-listoid)
+ (require 'smtp)
+ (if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
+ (progn
+ (set-buffer errors-to)
+ (insert "Send via smtp failed. Probable SMTP protocol error.\n")
+ (insert "Look for details below or in the *Messages* buffer.\n\n")
+ (let ((case-fold-search t)
+ ;; don't be overconfident about the name of the trace buffer
+ (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
+ (mapcar
+ (lambda (buffy)
+ (if (string-match tracer (buffer-name buffy))
+ (progn
+ (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
+ (insert-buffer-substring buffy)
+ (insert "\n\n"))))
+ (buffer-list))))))
;; just a place to park a docstring
(defconst feedmail-fiddle-plex-blurb nil
@@ -1420,34 +1730,80 @@ FOLDING can be nil, in which case VALUE is used as-is. If FOLDING is
non-nil, feedmail \"smart filling\" is done on VALUE just before
insertion.")
+(declare-function vm-mail "ext:vm" (&optional to subject))
+
+(defun feedmail-vm-mail-mode (&optional arg)
+ "Make something like a buffer that has been created via `vm-mail'.
+The optional argument is ignored and is just for argument compatibility with
+`feedmail-queue-runner-mode-setter'. This function is suitable for being
+applied to a file after you've just read it from disk: for example, a
+feedmail FQM message file from a queue. You could use something like
+this:
+
+\(setq auto-mode-alist \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\)
+"
+ (feedmail-say-debug ">in-> feedmail-vm-mail-mode")
+ (let ((the-buf (current-buffer)))
+ (vm-mail)
+ (delete-region (point-min) (point-max))
+ (insert-buffer-substring the-buf)
+ (setq buffer-file-name (buffer-file-name the-buf))
+ (set-buffer-modified-p (buffer-modified-p the-buf))
+ ;; For some versions of emacs, saving the message to a queue
+ ;; triggers running the mode function on the buffer, and that
+ ;; leads (through a series of events I don't really understand)
+ ;; to this function being called while the buffer is still
+ ;; marked modified even though it is in the process of being
+ ;; saved. I guess the function gets called during the renaming
+ ;; that takes place en route to the save.
+ ;;
+ ;; This clearing of the marker probably wastes a buffer copy
+ ;; but it's easy to do and more reliable than figuring out what
+ ;; each variant of emacs does in this strange case.
+ (with-current-buffer the-buf
+ (set-buffer-modified-p nil))
+ (kill-buffer the-buf)
+ ))
+
;;;###autoload
(defun feedmail-send-it ()
"Send the current mail buffer using the Feedmail package.
This is a suitable value for `send-mail-function'. It can be used
with various lower-level mechanisms to provide features such as queueing."
-
+ (feedmail-say-debug ">in-> feedmail-send-it")
+ (save-excursion
+ (let ((bfn-jiggle nil))
+ ;; if buffer-file-name is nil, temporarily use the stashed value
+ (if (and (not buffer-file-name) feedmail-queue-buffer-file-name)
+ (setq buffer-file-name feedmail-queue-buffer-file-name
+ bfn-jiggle t))
;; avoid matching trouble over slash vs backslash by getting canonical
(if feedmail-queue-directory
(setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
(if feedmail-queue-draft-directory
(setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
- (if (not feedmail-enable-queue) (feedmail-send-it-immediately)
+ (if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper)
;; else, queuing is enabled, should we ask about it or just do it?
(if feedmail-ask-before-queue
(funcall (feedmail-queue-send-edit-prompt))
- (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))))
-
+ (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)))
+ ;; put this back
+ (if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name))
+ )))
(defun feedmail-message-action-send ()
;; hooks can make this take a while so clear the prompt
+ (feedmail-say-debug ">in-> feedmail-message-action-send")
(message "FQM: Immediate send...")
- (feedmail-send-it-immediately))
+ (feedmail-send-it-immediately-wrapper))
;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu>
(defun feedmail-queue-express-to-queue ()
"Send message directly to the queue, with a minimum of fuss and bother."
(interactive)
+ (feedmail-say-debug ">in-> feedmail-queue-express-to-queue")
+ (run-hooks 'feedmail-queue-express-hook)
(let ((feedmail-enable-queue t)
(feedmail-ask-before-queue nil)
(feedmail-queue-reminder-alist nil)
@@ -1460,6 +1816,7 @@ with various lower-level mechanisms to provide features such as queueing."
(defun feedmail-queue-express-to-draft ()
"Send message directly to the draft queue, with a minimum of fuss and bother."
(interactive)
+ (feedmail-say-debug ">in-> feedmail-queue-express-to-draft")
(let ((feedmail-queue-directory feedmail-queue-draft-directory))
(feedmail-queue-express-to-queue)
)
@@ -1467,32 +1824,39 @@ with various lower-level mechanisms to provide features such as queueing."
(defun feedmail-message-action-send-strong ()
+ (feedmail-say-debug ">in-> feedmail-message-action-send-strong")
(let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send)))
(defun feedmail-message-action-edit ()
+ (feedmail-say-debug ">in-> feedmail-message-action-edit")
(error "FQM: Message not queued; returning to edit"))
(defun feedmail-message-action-draft ()
+ (feedmail-say-debug ">in-> feedmail-message-action-draft")
(feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft))
(defun feedmail-message-action-draft-strong ()
+ (feedmail-say-debug ">in-> feedmail-message-action-draft-strong")
(let ((buffer-file-name nil))
(feedmail-message-action-draft)))
(defun feedmail-message-action-queue ()
+ (feedmail-say-debug ">in-> feedmail-message-action-queue")
(feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))
(defun feedmail-message-action-queue-strong ()
+ (feedmail-say-debug ">in-> feedmail-message-action-queue-strong")
(let ((buffer-file-name nil))
(feedmail-message-action-queue)))
(defun feedmail-message-action-toggle-spray ()
+ (feedmail-say-debug ">in-> feedmail-message-action-toggle-spray")
(let ((feedmail-enable-spray (not feedmail-enable-spray)))
(if feedmail-enable-spray
(message "FQM: For this message, spray toggled ON")
@@ -1502,20 +1866,79 @@ with various lower-level mechanisms to provide features such as queueing."
(feedmail-send-it)))
+(defconst feedmail-p-h-b-n "*FQM Help*")
+
(defun feedmail-message-action-help ()
- (let ((d-string " "))
+ (feedmail-say-debug ">in-> feedmail-message-action-help")
+ (let ((d-string " ")
+ (fqm-help (get-buffer feedmail-p-h-b-n)))
(if (stringp feedmail-ask-before-queue-default)
(setq d-string feedmail-ask-before-queue-default)
(setq d-string (char-to-string feedmail-ask-before-queue-default)))
- (feedmail-queue-send-edit-prompt-help d-string)
+ (if (and fqm-help (get-buffer-window fqm-help))
+ (feedmail-scroll-buffer 'up fqm-help)
+ (feedmail-message-action-help-blat d-string))
;; recursive, but no worries (it goes deeper on user action)
(feedmail-send-it)))
+(defun feedmail-message-action-help-blat (d-string)
+ (feedmail-say-debug ">in-> feedmail-message-action-help-blat")
+ (with-output-to-temp-buffer feedmail-p-h-b-n
+ (princ "You're dispatching a message and feedmail queuing is enabled.
+Typing ? again will normally scroll this help buffer.
+
+Choices:
+ q QUEUE for later sending \(via feedmail-run-the-queue\)
+ Q QUEUE! like \"q\", but always make a new file
+ i IMMEDIATELY send this \(but not the other queued messages\)
+ I IMMEDIATELY! like \"i\", but skip following confirmation prompt
+ d DRAFT queue in the draft directory
+ D DRAFT! like \"d\", but always make a new file
+ e EDIT return to the message edit buffer \(don't send or queue\)
+ * SPRAY toggle spray mode \(individual message transmissions\)
+ > SCROLL UP scroll message up \(toward end of message\)
+ < SCROLL DOWN scroll message down \(toward beginning of message\)
+ ? HELP show or scroll this help buffer
+
+Synonyms:
+ s SEND immediately \(same as \"i\"\)
+ S SEND! immediately \(same as \"I\"\)
+ r ROUGH draft \(same as \"d\"\)
+ R ROUGH! draft \(same as \"D\"\)
+ n NOPE didn't mean it \(same as \"e\"\)
+ y YUP do the default behavior \(same as \"C-m\"\)
+ SPC SCROLL UP \(same as \">\"\)
+
+The user-configurable default is currently \"")
+ (princ d-string)
+ (princ "\". For other possibilities,
+see the variable feedmail-prompt-before-queue-user-alist.
+")
+ (and (stringp feedmail-prompt-before-queue-help-supplement)
+ (princ feedmail-prompt-before-queue-help-supplement))
+ (with-current-buffer standard-output
+ (if (fboundp 'help-mode) (help-mode)))))
+
+
+(defun feedmail-message-action-scroll-up ()
+ (feedmail-say-debug ">in-> feedmail-message-action-scroll-up")
+ (feedmail-scroll-buffer 'up)
+ ;; recursive, but no worries (it goes deeper on user action)
+ (feedmail-send-it))
+
+
+(defun feedmail-message-action-scroll-down ()
+ (feedmail-say-debug ">in-> feedmail-message-action-scroll-down")
+ (feedmail-scroll-buffer 'down)
+ ;; recursive, but no worries (it goes deeper on user action)
+ (feedmail-send-it))
+
;;;###autoload
(defun feedmail-run-the-queue-no-prompts (&optional arg)
"Like `feedmail-run-the-queue', but suppress confirmation prompts."
(interactive "p")
+ (feedmail-say-debug ">in-> feedmail-run-the-queue-no-prompts")
(let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
;;;###autoload
@@ -1524,6 +1947,7 @@ with various lower-level mechanisms to provide features such as queueing."
This is generally most useful if run non-interactively, since you can
bail out with an appropriate answer to the global confirmation prompt."
(interactive "p")
+ (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.
@@ -1536,6 +1960,7 @@ Return value is a list of three things: number of messages sent, number of
messages skipped, and number of non-message things in the queue (commonly
backup file names and the like)."
(interactive "p")
+ (feedmail-say-debug ">in-> feedmail-run-the-queue")
;; avoid matching trouble over slash vs backslash by getting canonical
(if feedmail-queue-directory
(setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
@@ -1552,7 +1977,6 @@ backup file names and the like)."
(messages-skipped 0)
(blobby-buffer)
(already-buffer)
- (this-mhsep)
(do-the-run t)
(list-of-possible-fqms))
(if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
@@ -1571,7 +1995,7 @@ backup file names and the like)."
(if feedmail-queue-run-orderer
(setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
(mapc
- '(lambda (blobby)
+ (lambda (blobby)
(setq maybe-file (expand-file-name blobby feedmail-queue-directory))
(cond
((file-directory-p maybe-file) nil) ; don't care about subdirs
@@ -1596,38 +2020,34 @@ backup file names and the like)."
(setq buffer-offer-save nil)
(buffer-disable-undo blobby-buffer)
(insert-file-contents-literally maybe-file)
- ;; work around text-vs-binary weirdness and also around rmail-resend's creative
- ;; manipulation of mail-header-separator
- ;;
- ;; if we don't find the normal M-H-S, and the alternative is defined but also
- ;; not found, try reading the file a different way
- ;;
- ;; if M-H-S not found and (a-M-H-S is nil or not found)
- (if (and (not (feedmail-find-eoh t))
- (or (not feedmail-queue-alternative-mail-header-separator)
- (not
- (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
- (feedmail-find-eoh t)))))
- (letf ((file-name-buffer-file-type-alist nil)
- ((default-value 'buffer-file-type) nil))
- (erase-buffer) (insert-file-contents maybe-file)))
- ;; if M-H-S not found and (a-M-H-S is non-nil and is found)
- ;; temporarily set M-H-S to the value of a-M-H-S
- (if (and (not (feedmail-find-eoh t))
- feedmail-queue-alternative-mail-header-separator
- (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
- (feedmail-find-eoh t)))
- (setq this-mhsep feedmail-queue-alternative-mail-header-separator)
- (setq this-mhsep mail-header-separator))
+ (setq buffer-file-type t) ; binary
+ (goto-char (point-min))
+ ;; if at least two line-endings with CRLF, translate the file
+ (if (looking-at ".*\r\n.*\r\n")
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" nil t)))
+;; ;; work around text-vs-binary wierdness
+;; ;; 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 nil ; don't give up the loop if user skips some
+ (condition-case signal-stuff ; don't give up the loop if user skips some
(let ((feedmail-enable-queue nil)
- (mail-header-separator this-mhsep)
(feedmail-queue-runner-is-active maybe-file))
- (funcall feedmail-queue-runner-message-sender arg)
+ ;; if can't find EOH, this is no message!
+ (unless (feedmail-find-eoh t)
+ (feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file)
+ (error "FQM: you should never see this message"))
+ (feedmail-say-debug "Prepping %s" maybe-file)
+ ;; the catch is a way out for users to voluntarily skip sending a message
+ (catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg))
(set-buffer blobby-buffer)
(if (buffer-modified-p) ; still modified, means wasn't sent
- (setq messages-skipped (1+ messages-skipped))
+ (progn
+ (setq messages-skipped (1+ messages-skipped))
+ (feedmail-say-chatter "%s wasn't sent by %s" maybe-file feedmail-buffer-eating-function))
(setq messages-sent (1+ messages-sent))
(funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
(if (and already-buffer (not (file-exists-p maybe-file)))
@@ -1635,20 +2055,25 @@ backup file names and the like)."
;; buffer, so update the buffer's notion of that
(with-current-buffer already-buffer
(setq buffer-file-name nil)))))
- (error (setq messages-skipped (1+ messages-skipped))))
+ ;; the handler for the condition-case
+ (error (setq messages-skipped (1+ messages-skipped))
+ (ding t)
+ (message "FQM: Trapped '%s', message left in queue." (car signal-stuff))
+ (sit-for 3)
+ (message "FQM: Trap details: \"%s\""
+ (mapconcat 'identity (cdr signal-stuff) "\" \""))
+ (sit-for 3)))
(kill-buffer blobby-buffer)
- (if feedmail-queue-chatty
- (progn
- (message "FQM: %d to go, %d sent, %d skipped (%d other files ignored)"
- (- q-cnt messages-sent messages-skipped)
- messages-sent messages-skipped q-oth)
- (sit-for feedmail-queue-chatty-sit-for))))))
+ (feedmail-say-chatter
+ "%d to go, %d sent, %d skipped (%d other files ignored)"
+ (- q-cnt messages-sent messages-skipped)
+ messages-sent messages-skipped q-oth)
+ )))
list-of-possible-fqms)))
(if feedmail-queue-chatty
(progn
- (message "FQM: %d sent, %d skipped (%d other files ignored)"
- messages-sent messages-skipped q-oth)
- (sit-for feedmail-queue-chatty-sit-for)
+ (feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)"
+ messages-sent messages-skipped q-oth)
(feedmail-queue-reminder 'after-run)
(sit-for feedmail-queue-chatty-sit-for)))
(list messages-sent messages-skipped q-oth)))
@@ -1674,6 +2099,7 @@ to perform the reminder activity. You can supply your own reminder functions
by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders,
you can set `feedmail-queue-reminder-alist' to nil."
(interactive "p")
+ (feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event)
(let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
(setq entry (assoc key feedmail-queue-reminder-alist))
(setq reminder (cdr entry))
@@ -1682,8 +2108,9 @@ you can set `feedmail-queue-reminder-alist' to nil."
(defun feedmail-queue-reminder-brief ()
- "Brief display of draft and queued message counts in modeline."
+ "Brief display of draft and queued message counts in minibuffer."
(interactive)
+ (feedmail-say-debug ">in-> feedmail-queue-reminder-brief")
(let (q-cnt d-cnt q-lis d-lis)
(setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
(setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
@@ -1696,8 +2123,9 @@ you can set `feedmail-queue-reminder-alist' to nil."
(defun feedmail-queue-reminder-medium ()
- "Verbose display of draft and queued message counts in modeline."
+ "Verbose display of draft and queued message counts in minibuffer."
(interactive)
+ (feedmail-say-debug ">in-> feedmail-queue-reminder-medium")
(let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
(setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
(setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
@@ -1714,25 +2142,49 @@ you can set `feedmail-queue-reminder-alist' to nil."
(defun feedmail-queue-send-edit-prompt ()
- "Ask whether to queue, send immediately, or return to editing a message."
+ "Ask whether to queue, send immediately, or return to editing a message, etc."
+ (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt")
+ (feedmail-queue-send-edit-prompt-inner
+ feedmail-ask-before-queue-default
+ feedmail-ask-before-queue-prompt
+ feedmail-ask-before-queue-reprompt
+ 'feedmail-message-action-help
+ feedmail-prompt-before-queue-standard-alist
+ feedmail-prompt-before-queue-user-alist
+ ))
+
+(defun feedmail-queue-runner-prompt ()
+ "Ask whether to queue, send immediately, or return to editing a message, etc."
+ (feedmail-say-debug ">in-> feedmail-queue-runner-prompt")
+ (feedmail-queue-send-edit-prompt-inner
+ feedmail-ask-before-queue-default
+ feedmail-ask-before-queue-prompt
+ feedmail-ask-before-queue-reprompt
+ 'feedmail-message-action-help
+ feedmail-prompt-before-queue-standard-alist
+ feedmail-prompt-before-queue-user-alist
+ ))
+(defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper
+ standard-alist user-alist)
+ (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner")
;; Some implementation ideas here came from the userlock.el code
- (discard-input)
+ (or defining-kbd-macro (discard-input))
(save-window-excursion
(let ((answer) (d-char) (d-string " "))
- (if (stringp feedmail-ask-before-queue-default)
+ (if (stringp default)
(progn
- (setq d-char (string-to-char feedmail-ask-before-queue-default))
- (setq d-string feedmail-ask-before-queue-default))
- (setq d-string (char-to-string feedmail-ask-before-queue-default))
- (setq d-char feedmail-ask-before-queue-default)
+ (setq d-char (string-to-char default)
+ d-string default))
+ (setq d-string (char-to-string default))
+ (setq d-char default)
)
(while (null answer)
- (message feedmail-ask-before-queue-prompt d-string)
+ (message prompt d-string)
(let ((user-sez
(let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
(read-char-exclusive))))
(if (= user-sez help-char)
- (setq answer '(^ . feedmail-message-action-help))
+ (setq answer '(^ . helper))
(if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
(setq user-sez d-char))
;; these char-to-int things are because of some
@@ -1740,73 +2192,39 @@ you can set `feedmail-queue-reminder-alist' to nil."
;; byte-compiled stuff between Emacs and XEmacs
;; (well, I'm sure someone could comprehend it,
;; but I say 'uncle')
- (setq answer (or (assoc user-sez feedmail-prompt-before-queue-user-alist)
+ (setq answer (or (assoc user-sez user-alist)
(and (fboundp 'char-to-int)
- (assoc (char-to-int user-sez) feedmail-prompt-before-queue-user-alist))
- (assoc user-sez feedmail-prompt-before-queue-standard-alist)
+ (assoc (char-to-int user-sez) user-alist))
+ (assoc user-sez standard-alist)
(and (fboundp 'char-to-int)
- (assoc (char-to-int user-sez) feedmail-prompt-before-queue-standard-alist))))
+ (assoc (char-to-int user-sez) standard-alist))))
(if (or (null answer) (null (cdr answer)))
(progn
(beep)
- (message feedmail-ask-before-queue-reprompt d-string)
+ (message reprompt d-string)
(sit-for 3)))
)))
(cdr answer)
)))
-(defconst feedmail-p-h-b-n "*FQM Help*")
-
-(defun feedmail-queue-send-edit-prompt-help (d-string)
- (let ((fqm-help (get-buffer feedmail-p-h-b-n)))
- (if (and fqm-help (get-buffer-window fqm-help 'visible))
- (feedmail-queue-send-edit-prompt-help-later fqm-help d-string)
- (feedmail-queue-send-edit-prompt-help-first d-string))))
-
-(defun feedmail-queue-send-edit-prompt-help-later (fqm-help d-string)
+(defun feedmail-scroll-buffer (direction &optional buffy)
;; scrolling fun
+ ;; emacs convention is that scroll-up moves text up, window down
+ (feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction)
(save-selected-window
(let ((signal-error-on-buffer-boundary nil)
- (fqm-window (display-buffer fqm-help)))
+ (fqm-window (display-buffer (if buffy buffy (current-buffer)))))
(select-window fqm-window)
+ (if (eq direction 'up)
(if (pos-visible-in-window-p (point-max) fqm-window)
- (feedmail-queue-send-edit-prompt-help-first d-string)
- ;;(goto-char (point-min))
- (scroll-up nil)
- ))))
-
-(defun feedmail-queue-send-edit-prompt-help-first (d-string)
- (with-output-to-temp-buffer feedmail-p-h-b-n
- (princ "You're dispatching a message and feedmail queuing is enabled.
-Typing ? or C-v will normally scroll this help buffer.
-
-Choices:
- q QUEUE for later sending (via feedmail-run-the-queue)
- Q QUEUE! like \"q\", but always make a new file
- i IMMEDIATELY send this (but not the other queued messages)
- I IMMEDIATELY! like \"i\", but skip following confirmation prompt
- d DRAFT queue in the draft directory
- D DRAFT! like \"d\", but always make a new file
- e EDIT return to the message edit buffer (don't send or queue)
- * SPRAY toggle spray mode (individual message transmissions)
-
-Synonyms:
- s SEND immediately (same as \"i\")
- S SEND! immediately (same as \"I\")
- r ROUGH draft (same as \"d\")
- R ROUGH! draft (same as \"D\")
- n NOPE didn't mean it (same as \"e\")
- y YUP do the default behavior (same as \"C-m\")
+ ;; originally just (goto-char (point-min)), but
+ ;; pos-visible-in-window-p seems oblivious to that
+ (scroll-down 999999)
+ (scroll-up))
+ (if (pos-visible-in-window-p (point-min) fqm-window)
+ (scroll-up 999999)
+ (scroll-down))))))
-The user-configurable default is currently \"")
- (princ d-string)
- (princ "\". For other possibilities,
-see the variable feedmail-prompt-before-queue-user-alist.
-")
- (and (stringp feedmail-prompt-before-queue-help-supplement)
- (princ feedmail-prompt-before-queue-help-supplement))
- (with-current-buffer standard-output
- (if (fboundp 'help-mode) (help-mode)))))
(defun feedmail-look-at-queue-directory (queue-directory)
"Find out some things about a queue directory.
@@ -1814,11 +2232,12 @@ Result is a list containing a count of queued messages in the
directory, a count of other files in the directory, and a high water
mark for prefix sequence numbers. Subdirectories are not included in
the counts."
+ (feedmail-say-debug ">in-> feedmail-look-at-queue-directory %s" queue-directory)
(let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
;; iterate, counting things we find along the way in the directory
(if (file-directory-p queue-directory)
(mapc
- '(lambda (blobby)
+ (lambda (blobby)
(cond
((file-directory-p blobby) nil) ; don't care about subdirs
((feedmail-fqm-p blobby)
@@ -1835,10 +2254,11 @@ the counts."
(defun feedmail-tidy-up-slug (slug)
"Utility for mapping out suspect characters in a potential filename."
+ (feedmail-say-debug ">in-> feedmail-tidy-up-slug %s" slug)
;; even programmers deserve a break sometimes, so cover nil for them
(if (null slug) (setq slug ""))
;; replace all non-alphanumerics with hyphen for safety
- (while (string-match "[^a-z0-9-]+" slug) (setq slug (replace-match "-" nil nil slug)))
+ (while (string-match feedmail-queue-slug-suspect-regexp slug) (setq slug (replace-match "-" nil nil slug)))
;; collapse multiple hyphens to one
(while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
;; for tidyness, peel off leading hyphens
@@ -1855,6 +2275,7 @@ file will be placed. The name is based on the Subject: header (if
there is one). If there is no subject,
`feedmail-queue-default-file-slug' is consulted. Special characters are
mapped to mostly alphanumerics for safety."
+ (feedmail-say-debug ">in-> feedmail-queue-subject-slug-maker %s" queue-directory)
(let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
(setq eoh-marker (feedmail-find-eoh))
(goto-char (point-min))
@@ -1862,7 +2283,7 @@ mapped to mostly alphanumerics for safety."
(if (re-search-forward "^Subject:" eoh-marker t)
(progn (setq s-point (point))
(end-of-line)
- (setq subject (buffer-substring s-point (point)))))
+ (setq subject (buffer-substring-no-properties s-point (point)))))
(setq subject (feedmail-tidy-up-slug subject))
(if (zerop (length subject))
(setq subject
@@ -1882,6 +2303,7 @@ mapped to mostly alphanumerics for safety."
(defun feedmail-create-queue-filename (queue-directory)
+ (feedmail-say-debug ">in-> feedmail-create-queue-filename %s" queue-directory)
(let ((slug "wjc"))
(cond
(feedmail-queue-slug-maker
@@ -1900,6 +2322,7 @@ mapped to mostly alphanumerics for safety."
(defun feedmail-dump-message-to-queue (queue-directory what-event)
+ (feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s" queue-directory what-event)
(or (file-accessible-directory-p queue-directory)
;; progn to get nil result no matter what
(progn (make-directory queue-directory t) nil)
@@ -1913,7 +2336,8 @@ mapped to mostly alphanumerics for safety."
(progn
(setq is-fqm (feedmail-fqm-p buffer-file-name))
(setq is-in-this-dir (string-equal
- (directory-file-name queue-directory)
+ (directory-file-name
+ (expand-file-name queue-directory))
(directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
;; if visiting a queued message, just save
(if (and is-fqm is-in-this-dir)
@@ -1924,7 +2348,14 @@ mapped to mostly alphanumerics for safety."
(write-file filename))
;; convenient for moving from draft to q, for example
(if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
- (y-or-n-p (format "FQM: Was previously %s; delete that? " previous-buffer-file-name)))
+ (let (d b s)
+ (setq b (file-name-nondirectory previous-buffer-file-name))
+ (setq d (file-name-directory previous-buffer-file-name))
+ (setq s (substring d (1- (length d))))
+ (setq d (substring d 0 (1- (length d))))
+ (setq d (file-name-nondirectory d))
+ (y-or-n-p (format "FQM: Was previously %s%s%s; delete that? "
+ d s b))))
(delete-file previous-buffer-file-name))
(if feedmail-nuke-buffer-after-queue
(let ((a-s-file-name buffer-auto-save-file-name))
@@ -1933,9 +2364,7 @@ mapped to mostly alphanumerics for safety."
delete-auto-save-files
(file-exists-p a-s-file-name)
(delete-file a-s-file-name))))
- (if feedmail-queue-chatty
- (progn (message "%s" (concat "FQM: Queued in " filename))
- (sit-for feedmail-queue-chatty-sit-for)))
+ (feedmail-say-chatter "Queued in %s" filename)
(if feedmail-queue-chatty
(progn
(feedmail-queue-reminder what-event)
@@ -1944,37 +2373,46 @@ mapped to mostly alphanumerics for safety."
;; from a similar function in mail-utils.el
(defun feedmail-rfc822-time-zone (time)
+ (feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
(let* ((sec (or (car (current-time-zone time)) 0))
(absmin (/ (abs sec) 60)))
(format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
(defun feedmail-rfc822-date (arg-time)
- (let ((time (if arg-time arg-time (current-time))))
+ (feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
+ (let ((time (if arg-time arg-time (current-time)))
+ (system-time-locale "C"))
(concat
(format-time-string "%a, %e %b %Y %T " time)
(feedmail-rfc822-time-zone time)
)))
+(defun feedmail-send-it-immediately-wrapper ()
+ "Wrapper to catch skip-me-i"
+ (if (eq 'skip-me-i (catch 'skip-me-i (feedmail-send-it-immediately)))
+ (error "FQM: Sending...abandoned!")))
+
(declare-function expand-mail-aliases "mailalias" (beg end &optional exclude))
(defun feedmail-send-it-immediately ()
"Handle immediate sending, including during a queue run."
- (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)
- (bcc-holder)
- (resent-bcc-holder)
- (a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):")
- (a-re-rtc "^Resent-\\(To\\|Cc\\):")
- (a-re-rb "^Resent-Bcc:")
- (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
- (a-re-dtc "^\\(To\\|Cc\\):")
- (a-re-db "^Bcc:")
- ;; to get a temporary changable copy
- (mail-header-separator mail-header-separator)
- )
+ (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*"))
+ (feedmail-raw-text-buffer (current-buffer))
+ (feedmail-address-list)
+ (eoh-marker)
+ (bcc-holder)
+ (resent-bcc-holder)
+ (a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):")
+ (a-re-rtc "^Resent-\\(To\\|Cc\\):")
+ (a-re-rb "^Resent-Bcc:")
+ (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
+ (a-re-dtc "^\\(To\\|Cc\\):")
+ (a-re-db "^Bcc:")
+ ;; to get a temporary changable copy
+ (mail-header-separator mail-header-separator)
+ )
(unwind-protect
(save-current-buffer
(set-buffer feedmail-error-buffer) (erase-buffer)
@@ -1990,11 +2428,16 @@ mapped to mostly alphanumerics for safety."
(let ((case-fold-search nil))
;; Change header-delimiter to be what mailers expect (empty line).
;; leaves match data in place or signals error
+ (feedmail-say-debug "looking for m-h-s \"%s\""
+ mail-header-separator)
(setq eoh-marker (feedmail-find-eoh))
- (replace-match "\n")
- (setq mail-header-separator ""))
+ (feedmail-say-debug "found m-h-s %s" eoh-marker)
+ (setq mail-header-separator "")
+ (replace-match ""))
+;; (replace-match "\\1")) ;; might be empty or "\r"
;; mail-aliases nil = mail-abbrevs.el
+ (feedmail-say-debug "expanding mail aliases")
(if (or feedmail-force-expand-mail-aliases
(and (fboundp 'expand-mail-aliases) mail-aliases))
(expand-mail-aliases (point-min) eoh-marker))
@@ -2066,18 +2509,31 @@ mapped to mostly alphanumerics for safety."
(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)
(run-hooks 'feedmail-last-chance-hook)
+ (save-window-excursion
(let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:"))
(also-file)
(confirm (cond
((eq feedmail-confirm-outgoing 'immediate)
(not feedmail-queue-runner-is-active))
((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
- (t feedmail-confirm-outgoing))))
+ (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)
+ (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)))
+ (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
(setq also-file (expand-file-name also-file))
@@ -2111,8 +2567,11 @@ mapped to mostly alphanumerics for safety."
))
(mail-do-fcc eoh-marker)
)))
- (error "FQM: Sending...abandoned") ; user bailed out of one-last-look
- ))) ; unwind-protect body (save-excursion)
+ ;; 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
(kill-buffer feedmail-prepped-text-buffer)
@@ -2120,8 +2579,10 @@ mapped to mostly alphanumerics for safety."
(if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
(progn (display-buffer feedmail-error-buffer)
;; read fast ... the meter is running
- (if (and feedmail-queue-runner-is-active feedmail-queue-chatty)
- (progn (message "FQM: Sending...failed") (ding t) (sit-for 3)))
+ (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
@@ -2137,6 +2598,8 @@ mapped to mostly alphanumerics for safety."
NAME, VALUE, ACTION, and FOLDING are the four elements of a
fiddle-plex, as described in the documentation for the variable
`feedmail-fiddle-plex-blurb'."
+ (feedmail-say-debug ">in-> feedmail-fiddle-header %s %s %s %s"
+ name value action folding)
(let ((case-fold-search t)
(header-colon (concat (regexp-quote name) ":"))
header-regexp eoh-marker has-like ag-like val-like that-point)
@@ -2197,10 +2660,11 @@ fiddle-plex, as described in the documentation for the variable
))
(defun feedmail-give-it-to-buffer-eater ()
+ (feedmail-say-debug ">in-> feedmail-give-it-to-buffer-eater")
(save-excursion
(if feedmail-enable-spray
(mapcar
- '(lambda (feedmail-spray-this-address)
+ (lambda (feedmail-spray-this-address)
(let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*")))
(with-current-buffer spray-buffer
(erase-buffer)
@@ -2227,6 +2691,8 @@ fiddle-plex, as described in the documentation for the variable
(kill-buffer spray-buffer)
))
feedmail-address-list)
+ (feedmail-say-debug "calling buffer-eater %s"
+ feedmail-buffer-eating-function)
(funcall feedmail-buffer-eating-function
feedmail-prepped-text-buffer
feedmail-error-buffer
@@ -2237,6 +2703,7 @@ fiddle-plex, as described in the documentation for the variable
"If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'.
Else, look for Sender: or From: (or Resent-*) and
return that value."
+ (feedmail-say-debug ">in-> feedmail-envelope-deducer %s" eoh-marker)
(if (not feedmail-deduce-envelope-from)
user-mail-address
(let ((from-list))
@@ -2254,6 +2721,7 @@ return that value."
(defun feedmail-fiddle-from ()
"Fiddle From:."
+ (feedmail-say-debug ">in-> feedmail-fiddle-from")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@@ -2262,10 +2730,14 @@ return that value."
;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
;; improvement using user-mail-address suggested by
;; gray@austin.apc.slb.com (Douglas Gray Stephens)
+ ;; improvement using mail-host-address suggested by "Jason Eisner" <jason@cs.jhu.edu>
+ ;; ((this situation really is hopeless, though)
((eq t feedmail-from-line)
(let ((feedmail-from-line
(let ((at-stuff
- (if user-mail-address user-mail-address (concat (user-login-name) "@" (system-name)))))
+ (if user-mail-address user-mail-address
+ (concat (user-login-name) "@"
+ (or mail-host-address (system-name))))))
(cond
((eq mail-from-style nil) at-stuff)
((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")"))
@@ -2294,6 +2766,7 @@ return that value."
(defun feedmail-fiddle-sender ()
"Fiddle Sender:."
+ (feedmail-say-debug ">in-> feedmail-fiddle-sender")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@@ -2322,6 +2795,11 @@ return that value."
(defun feedmail-default-date-generator (maybe-file)
"Default function for generating Date: header contents."
+ (feedmail-say-debug ">in-> feedmail-default-date-generator")
+ (when maybe-file
+ (feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (nth 4 (file-attributes maybe-file)))))
+ (feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (nth 5 (file-attributes maybe-file)))))
+ (feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (nth 6 (file-attributes maybe-file))))))
(let ((date-time))
(if (and (not feedmail-queue-use-send-time-for-date) maybe-file)
(setq date-time (nth 5 (file-attributes maybe-file))))
@@ -2331,6 +2809,7 @@ return that value."
(defun feedmail-fiddle-date (maybe-file)
"Fiddle Date:. See documentation of `feedmail-date-generator'."
+ (feedmail-say-debug ">in-> feedmail-fiddle-date")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@@ -2363,9 +2842,14 @@ return that value."
"Default function for generating Message-Id: header contents.
Based on a date and a sort of random number for tie breaking. Unless
`feedmail-message-id-suffix' is defined, uses `user-mail-address', so be
-sure it's set."
+sure it's set. If both are nil, creates a quasi-random suffix that is
+probably not appropriate for you."
+ (feedmail-say-debug ">in-> feedmail-default-message-id-generator %s"
+ maybe-file)
(let ((date-time)
+ (system-time-locale "C")
(end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
+ (if (not end-stuff) (setq end-stuff (format "%d.example.com" (random))))
(if (string-match "^\\(.*\\)@" end-stuff)
(setq end-stuff
(concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff))
@@ -2381,6 +2865,7 @@ sure it's set."
(defun feedmail-fiddle-message-id (maybe-file)
"Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'."
+ (feedmail-say-debug ">in-> feedmail-fiddle-message-id %s" maybe-file)
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@@ -2422,8 +2907,11 @@ sure it's set."
(defun feedmail-fiddle-x-mailer ()
"Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'."
+ (feedmail-say-debug ">in-> feedmail-fiddle-x-mailer")
;; default is to fall off the end of the list and do nothing
(cond
+ ;; nil means do nothing
+ ((eq nil feedmail-x-mailer-line) nil)
;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse
((eq t feedmail-x-mailer-line)
(let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
@@ -2450,6 +2938,7 @@ sure it's set."
(defun feedmail-fiddle-spray-address (addy-plex)
"Fiddle header for single spray address. Uses `feedmail-spray-this-address'."
+ (feedmail-say-debug ">in-> feedmail-fiddle-spray-address %s" addy-plex)
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@@ -2481,6 +2970,7 @@ sure it's set."
(defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes)
"Fiddling based on a list of fiddle-plexes for spraying."
+ (feedmail-say-debug ">in-> feedmail-fiddle-list-of-spray-fiddle-plexes")
;; default is to fall off the end of the list and do nothing
(let ((lofp list-of-fiddle-plexes) fp)
(if (listp lofp)
@@ -2493,6 +2983,7 @@ sure it's set."
(defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
"Fiddling based on a list of fiddle-plexes. Values t, nil, and string are pointless."
+ (feedmail-say-debug ">in-> feedmail-fiddle-list-of-fiddle-plexes")
;; default is to fall off the end of the list and do nothing
(let ((lofp list-of-fiddle-plexes) fp)
(while lofp
@@ -2518,18 +3009,20 @@ sure it's set."
There may be multiple such lines, and each may have arbitrarily
many continuation lines. Return an accumulation of the deleted
headers, including the intervening newlines."
+ (feedmail-say-debug ">in-> feedmail-accume-n-nuke-header %s %s"
+ header-end header-regexp)
(let ((case-fold-search t) (dropout))
(save-excursion
(goto-char (point-min))
;; iterate over all matching lines
(while (re-search-forward header-regexp header-end t)
(forward-line 1)
- (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point))))
+ (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
(delete-region (match-beginning 0) (point))
;; get rid of any continuation lines
(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
(forward-line 1)
- (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point))))
+ (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
(replace-match ""))))
(identity dropout)))
@@ -2539,6 +3032,7 @@ The filling tries to avoid splitting lines except at commas. This
avoids, in particular, splitting within parenthesized comments in
addresses. Headers filled include From:, Reply-To:, To:, Cc:, Bcc:,
Resent-To:, Resent-Cc:, and Resent-Bcc:."
+ (feedmail-say-debug ">in-> feedmail-fill-to-cc-function")
(let ((case-fold-search t)
this-line
this-line-end)
@@ -2563,6 +3057,7 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:."
(defun feedmail-fill-this-one (this-line this-line-end)
"In-place smart filling of the region bounded by the two arguments."
+ (feedmail-say-debug ">in-> feedmail-fill-this-one")
(let ((fill-prefix "\t")
(fill-column feedmail-fill-to-cc-fill-column))
;; The general idea is to break only on commas. Collapse
@@ -2593,6 +3088,7 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:."
Addresses are collected only from headers whose names match the fourth
argument. Returns a list of strings. Duplicate addresses will have
been weeded out."
+ (feedmail-say-debug ">in-> feedmail-deduce-address-list %s %s" addr-regexp address-list)
(let ((simple-address)
(address-blob)
(this-line)
@@ -2613,7 +3109,7 @@ been weeded out."
(setq this-line-end (point-marker))
;; only keep if we don't have it already
(setq address-blob
- (mail-strip-quoted-names (buffer-substring this-line this-line-end)))
+ (mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end)))
(while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
(setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
(setq address-blob (replace-match "" t t address-blob))
@@ -2626,6 +3122,7 @@ been weeded out."
(defun feedmail-one-last-look (feedmail-prepped-text-buffer)
"Offer the user one last chance to give it up."
+ (feedmail-say-debug ">in-> feedmail-one-last-look")
(save-excursion
(save-window-excursion
(switch-to-buffer feedmail-prepped-text-buffer)
@@ -2639,26 +3136,43 @@ been weeded out."
(defun feedmail-fqm-p (might-be)
"Internal; does filename end with FQM suffix?"
+ (feedmail-say-debug ">in-> feedmail-fqm-p %s" might-be)
(string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be))
+(defun feedmail-say-debug (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
+ "Internal; emits debug messages in standard format."
+ (when feedmail-debug
+ (funcall 'message (concat "FQM DB: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
+ (and feedmail-debug-sit-for (not (= 0 feedmail-debug-sit-for))
+ (sit-for feedmail-debug-sit-for))))
+
+(defun feedmail-say-chatter (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
+ "Internal; emits queue chatter messages in standard format."
+ (when feedmail-queue-chatty
+ (funcall 'message (concat "FQM: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
+ (and feedmail-queue-chatty-sit-for (not (= 0 feedmail-queue-chatty-sit-for))
+ (sit-for feedmail-queue-chatty-sit-for))))
(defun feedmail-find-eoh (&optional noerror)
"Internal; finds the end of message header fields, returns mark just before it"
+ ;; all this funny business with line endings is to account for CRLF
+ ;; weirdness that I don't think I'll ever figure out
+ (feedmail-say-debug ">in-> feedmail-find-eoh %s" noerror)
+ (let ((mhs mail-header-separator)
+ (alt-mhs feedmail-queue-alternative-mail-header-separator)
+ r-mhs r-alt-mhs)
+ (setq r-mhs (concat "^" (regexp-quote mhs) "$"))
+ (setq r-alt-mhs (concat "^" (regexp-quote (or alt-mhs "")) "$"))
(save-excursion
(goto-char (point-min))
- (when (or (re-search-forward (concat "^"
- (regexp-quote mail-header-separator)
- "\n")
- nil noerror)
- (and feedmail-queue-alternative-mail-header-separator
- (re-search-forward
- (concat "^"
- (regexp-quote
- feedmail-queue-alternative-mail-header-separator)
- "\n")
- nil noerror)))
- (forward-line -1)
- (point-marker))))
+ (if (or (re-search-forward r-mhs nil t)
+ (and alt-mhs (re-search-forward r-alt-mhs nil t)))
+ (progn
+ (beginning-of-line)
+ (point-marker))
+ (if noerror
+ nil
+ (error "FQM: Can't find message-header-separator or alternate"))))))
(provide 'feedmail)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 4a4ded22886..8dac3be0e5f 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -1,4 +1,4 @@
-;;; footnote.el --- footnote support for message mode -*- coding: iso-latin-1;-*-
+;;; footnote.el --- footnote support for message mode -*- coding: utf-8;-*-
;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
@@ -278,7 +278,7 @@ Wrapping around the alphabet implies successive repetitions of letters."
;; Latin-1
-(defconst footnote-latin-string "¹²³ºª§¶"
+(defconst footnote-latin-string "¹²³ºª§¶"
"String of Latin-1 footnoting characters.")
;; Note not [...]+, because this style cycles.
@@ -291,6 +291,25 @@ Use a range of Latin-1 non-ASCII characters for footnoting."
(string (aref footnote-latin-string
(mod (1- n) (length footnote-latin-string)))))
+;; Unicode
+
+(defconst footnote-unicode-string "â°Â¹Â²Â³â´âµâ¶â·â¸â¹"
+ "String of unicode footnoting characters.")
+
+(defconst footnote-unicode-regexp (concat "[" footnote-unicode-string "]+")
+ "Regexp for unicode footnoting characters.")
+
+(defun Footnote-unicode (n)
+ "Unicode footnote style.
+Use unicode characters for footnoting."
+ (let (modulus result done)
+ (while (not done)
+ (setq modulus (mod n 10)
+ n (truncate n 10))
+ (and (zerop n) (setq done t))
+ (push (aref footnote-unicode-string modulus) result))
+ (apply #'string result)))
+
;;; list of all footnote styles
(defvar footnote-style-alist
`((numeric Footnote-numeric ,footnote-numeric-regexp)
@@ -298,7 +317,8 @@ Use a range of Latin-1 non-ASCII characters for footnoting."
(english-upper Footnote-english-upper ,footnote-english-upper-regexp)
(roman-lower Footnote-roman-lower ,footnote-roman-lower-regexp)
(roman-upper Footnote-roman-upper ,footnote-roman-upper-regexp)
- (latin Footnote-latin ,footnote-latin-regexp))
+ (latin Footnote-latin ,footnote-latin-regexp)
+ (unicode Footnote-unicode ,footnote-unicode-regexp))
"Styles of footnote tags available.
By default only boring Arabic numbers, English letters and Roman Numerals
are available.
@@ -312,9 +332,13 @@ english-lower == a, b, c, ...
english-upper == A, B, C, ...
roman-lower == i, ii, iii, iv, v, ...
roman-upper == I, II, III, IV, V, ...
-latin == ¹ ² ³ º ª § ¶
+latin == ¹ ² ³ º ª § ¶
+unicode == ¹, ², ³, ...
See also variables `footnote-start-tag' and `footnote-end-tag'.
+Note: some characters in the unicode style may not show up
+properly if the default font does not contain those characters.
+
Customizing this variable has no effect on buffers already
displaying footnotes. To change the style of footnotes in such a
buffer use the command `Footnote-set-style'."
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 328a5d50d34..2e6f06a6758 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -236,7 +236,7 @@ comma-separated list, and return the pruned list."
(setq mail-dont-reply-to-names
(concat
;; `rmail-default-dont-reply-to-names' is obsolete.
- (if rmail-default-dont-reply-to-names
+ (if (bound-and-true-p rmail-default-dont-reply-to-names)
(concat rmail-default-dont-reply-to-names "\\|")
"")
(if (and user-mail-address
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index b4827cf10ba..901eb002dc1 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -565,7 +565,6 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(defun mail-abbrev-complete-alias ()
"Perform completion on alias preceding point."
- ;; Based on lisp.el:lisp-complete-symbol
(interactive)
(mail-abbrev-make-syntax-table)
(let ((end (point))
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 862cb2a1eee..9af59672689 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -215,12 +215,12 @@ your primary spool is. If this fails, set it to something like
;; Mailing list inboxes
;; must have VM already loaded to get vm-folder-directory.
- (mapcar '(lambda (s)
- "make the appropriate entry for vm-spool-files"
- (list
- (concat mspools-folder-directory s)
- (concat mspools-folder-directory s "." mspools-suffix)
- (concat mspools-folder-directory s ".crash")))
+ (mapcar (lambda (s)
+ "make the appropriate entry for vm-spool-files"
+ (list
+ (concat mspools-folder-directory s)
+ (concat mspools-folder-directory s "." mspools-suffix)
+ (concat mspools-folder-directory s ".crash")))
;; So I create a vm-spool-files entry for each of those mail drops
(mapcar 'file-name-sans-extension
(directory-files mspools-folder-directory nil
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 200aadda651..c43ec9e5611 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -349,7 +349,7 @@ If nil, display all header fields except those matched by
:group 'rmail-headers)
;;;###autoload
-(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:")
+(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:")
"Headers that should be stripped when retrying a failed message."
:type '(choice regexp (const nil :tag "None"))
:group 'rmail-headers
@@ -1444,7 +1444,8 @@ If so restore the actual mbox message collection."
(make-local-variable 'file-precious-flag)
(setq file-precious-flag t)
(make-local-variable 'desktop-save-buffer)
- (setq desktop-save-buffer t))
+ (setq desktop-save-buffer t)
+ (setq next-error-move-function 'rmail-next-error-move))
;; Handle M-x revert-buffer done in an rmail-mode buffer.
(defun rmail-revert (arg noconfirm)
@@ -2669,8 +2670,11 @@ The current mail message becomes the message displayed."
(t (setq rmail-current-message msg)))
(with-current-buffer rmail-buffer
(setq header-style rmail-header-style)
- ;; Mark the message as seen
- (rmail-set-attribute rmail-unseen-attr-index nil)
+ ;; Mark the message as seen, but preserve buffer modified flag.
+ (let ((modiff (buffer-modified-p)))
+ (rmail-set-attribute rmail-unseen-attr-index nil)
+ (unless modiff
+ (restore-buffer-modified-p modiff)))
;; bracket the message in the mail
;; buffer and determine the coding system the transfer encoding.
(rmail-swap-buffers-maybe)
@@ -3016,15 +3020,97 @@ or forward if N is negative."
(rmail-maybe-set-message-counters)
(rmail-show-message rmail-total-messages))
-(defun rmail-what-message ()
- "For debugging Rmail: find the message number that point is in."
+(defun rmail-next-error-move (msg-pos bad-marker)
+ "Move to an error locus (probably grep hit) in an Rmail buffer.
+MSG-POS is a marker pointing at the error message in the grep buffer.
+BAD-MARKER is a marker that ought to point at where to move to,
+but probably is garbage."
+
+ (let* ((message-loc (compilation--message->loc
+ (get-text-property msg-pos 'compilation-message
+ (marker-buffer msg-pos))))
+ (column (car message-loc))
+ (linenum (cadr message-loc))
+ line-text
+ pos
+ msgnum msgbeg msgend
+ header-field
+ line-number-within)
+
+ ;; Look at the whole Rmail file.
+ (rmail-swap-buffers-maybe)
+
+ (save-restriction
+ (widen)
+ (save-excursion
+ ;; Find the line that the error message points at.
+ (goto-char (point-min))
+ (forward-line (1- linenum))
+ (setq pos (point))
+
+ ;; Find the text at the start of the line,
+ ;; before the first = sign.
+ ;; This text has a good chance of being also in the
+ ;; decoded message.
+ (save-excursion
+ (skip-chars-forward "^=\n")
+ (setq line-text (buffer-substring pos (point))))
+
+ ;; Find which message this position is in,
+ ;; and the limits of that message.
+ (setq msgnum (rmail-what-message pos))
+ (setq msgbeg (rmail-msgbeg msgnum))
+ (setq msgend (rmail-msgend msgnum))
+
+ ;; Find which header this locus is in,
+ ;; or if it's in the message body,
+ ;; and the line-based position within that.
+ (goto-char msgbeg)
+ (let ((header-end msgend))
+ (if (search-forward "\n\n" nil t)
+ (setq header-end (point)))
+ (if (>= pos header-end)
+ (setq line-number-within
+ (count-lines header-end pos))
+ (goto-char pos)
+ (unless (looking-at "^[^ \t]")
+ (re-search-backward "^[^ \t]"))
+ (looking-at "[^:\n]*[:\n]")
+ (setq header-field (match-string 0)
+ line-number-within (count-lines (point) pos))))))
+
+ ;; Display the right message.
+ (rmail-show-message msgnum)
+
+ ;; Move to the right position within the displayed message.
+ ;; Or at least try. The decoded message's lines may not
+ ;; correspond to the lines in the inbox file.
+ (goto-char (point-min))
+ (if header-field
+ (progn
+ (re-search-forward (concat "^" (regexp-quote header-field)) nil t)
+ (forward-line line-number-within))
+ (search-forward "\n\n" nil t)
+ (if (re-search-forward (concat "^" (regexp-quote line-text)) nil t)
+ (goto-char (match-beginning 0))))
+ (if (eobp)
+ ;; If the decoded message doesn't have enough lines,
+ ;; go to the beginning rather than the end.
+ (goto-char (point-min))
+ ;; Otherwise, go to the right column.
+ (if column
+ (forward-char column)))))
+
+(defun rmail-what-message (&optional pos)
+ "Return message number POS (or point) is in."
(let* ((high rmail-total-messages)
(mid (/ high 2))
(low 1)
- (where (with-current-buffer (if (rmail-buffers-swapped-p)
- rmail-view-buffer
- (current-buffer))
- (point))))
+ (where (or pos
+ (with-current-buffer (if (rmail-buffers-swapped-p)
+ rmail-view-buffer
+ (current-buffer))
+ (point)))))
(while (> (- high low) 1)
(if (>= where (rmail-msgbeg mid))
(setq low mid)
@@ -3455,15 +3541,15 @@ 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
- '(rmail-mail-return))
+ switch-function yank-action sendactions)
(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)
'((mail-dedicated-frame . t)))))))
-(defun rmail-mail-return ()
+(defun rmail-mail-return (&optional newbuf)
+ "NEWBUF is a 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.
@@ -3488,7 +3574,8 @@ does not pop any summary buffer."
(if rmail-flag
;; If the Rmail buffer has a summary, show that.
(if summary-buffer (switch-to-buffer summary-buffer)
- (delete-window)))))
+ (delete-window))
+ (switch-to-buffer newbuf))))
;; If the frame was probably made for this buffer, the user
;; probably wants to delete it now.
((display-multi-frame-p)
@@ -4316,7 +4403,7 @@ With prefix argument N moves forward N messages with these labels.
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "c530622b53038152ca84f2ec9313bd7a")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "a7d3e7205efa4e20ca9038c9b260ce83")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 96132739b20..597068562b5 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -153,20 +153,21 @@ MIME entities.")
;;; MIME-entity object
(defun rmail-mime-entity (type disposition transfer-encoding
- display header tagline body children handler)
+ display header tagline body children handler
+ &optional truncated)
"Retrun a newly created MIME-entity object from arguments.
-A MIME-entity is a vector of 9 elements:
+A MIME-entity is a vector of 10 elements:
[TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
- CHILDREN HANDLER]
+ CHILDREN HANDLER TRUNCATED]
TYPE and DISPOSITION correspond to MIME headers Content-Type and
-Cotent-Disposition respectively, and has this format:
+Content-Disposition respectively, and have this format:
\(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
-VALUE is a string and ATTRIBUTE is a symbol.
+Each VALUE is a string and each ATTRIBUTE is a string.
Consider the following header, for example:
@@ -192,8 +193,8 @@ has these values:
raw: displayed by the raw MIME data (for the header and body only)
HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
-END specify the region of the header or body lines in RMAIL's
-data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
+END are markers that specify the region of the header or body lines
+in RMAIL's data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
header or body is, by default, displayed by the decoded
presentation form.
@@ -208,9 +209,12 @@ entity have one or more children. A \"message/rfc822\" entity
has just one child. Any other entity has no child.
HANDLER is a function to insert the entity according to DISPLAY.
-It is called with one argument ENTITY."
+It is called with one argument ENTITY.
+
+TRUNCATED is non-nil if the text of this entity was truncated."
+
(vector type disposition transfer-encoding
- display header tagline body children handler))
+ display header tagline body children handler truncated))
;; Accessors for a MIME-entity object.
(defsubst rmail-mime-entity-type (entity) (aref entity 0))
@@ -222,6 +226,9 @@ It is called with one argument ENTITY."
(defsubst rmail-mime-entity-body (entity) (aref entity 6))
(defsubst rmail-mime-entity-children (entity) (aref entity 7))
(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
+(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
+(defsubst rmail-mime-entity-set-truncated (entity truncated)
+ (aset entity 9 truncated))
(defsubst rmail-mime-message-p ()
"Non-nil if and only if the current message is a MIME."
@@ -237,6 +244,10 @@ It is called with one argument ENTITY."
(directory (button-get button 'directory))
(data (button-get button 'data))
(ofilename filename))
+ (if (and (not (stringp data))
+ (rmail-mime-entity-truncated data))
+ (unless (y-or-n-p "This entity is truncated; save anyway? ")
+ (error "Aborted")))
(setq filename (expand-file-name
(read-file-name (format "Save as (default: %s): " filename)
directory
@@ -387,6 +398,11 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where
(if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
(let ((new (aref (rmail-mime-entity-display entity) 1)))
(aset new 0 t))))
+ ;; Query as a warning before showing if truncated.
+ (if (and (not (stringp entity))
+ (rmail-mime-entity-truncated entity))
+ (unless (y-or-n-p "This entity is truncated; show anyway? ")
+ (error "Aborted")))
;; Enter the shown mode.
(rmail-mime-shown-mode entity)
;; Force this body shown.
@@ -531,7 +547,7 @@ HEADER is a header component of a MIME-entity object (see
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
- (or (integerp (aref body 0))
+ (or (integerp (aref body 0)) (markerp (aref body 0))
(let ((data (buffer-string)))
(aset body 0 data)
(delete-region (point-min) (point-max))))
@@ -688,7 +704,7 @@ directly."
(segment (rmail-mime-entity-segment (point) entity))
beg data size)
- (if (integerp (aref body 0))
+ (if (or (integerp (aref body 0)) (markerp (aref body 0)))
(setq data entity
size (car bulk-data))
(if (stringp (aref body 0))
@@ -816,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)
+ beg end next entities truncated)
(unless boundary
(rmail-mm-get-boundary-error-message
"No boundary defined" content-type content-disposition
@@ -843,8 +859,18 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
;; the beginning of the next part. The current point is just
;; after the boundary tag.
(setq beg (point-min))
- (while (search-forward boundary nil t)
- (setq end (match-beginning 0))
+
+ (while (or (and (search-forward boundary nil t)
+ (setq truncated nil end (match-beginning 0)))
+ ;; If the boundary does not appear at all,
+ ;; the message was truncated.
+ ;; 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
+ (skip-chars-forward "\n")
+ (> (point-max) (point)))
+ (setq truncated t end (point-max))))
;; If this is the last boundary according to RFC 2046, hide the
;; epilogue, else hide the boundary only. Use a marker for
;; `next' because `rmail-mime-show' may change the buffer.
@@ -852,6 +878,9 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
(setq next (point-max-marker)))
((looking-at "[ \t]*\n")
(setq next (copy-marker (match-end 0) t)))
+ (truncated
+ ;; We're handling what's left of a truncated message.
+ (setq next (point-max-marker)))
(t
;; The original code signalled an error as below, but
;; this line may be a boundary of nested multipart. So,
@@ -873,6 +902,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
;; Display a tagline.
(aset (aref (rmail-mime-entity-display child) 1) 1
(aset (rmail-mime-entity-tagline child) 2 t))
+ (rmail-mime-entity-set-truncated child truncated)
(push child entities)))
(delete-region end next)
@@ -1099,9 +1129,10 @@ modified."
(if parse-tag
(let* ((is-inline (string= (car content-disposition) "inline"))
- (header (vector (point-min) end nil))
+ (hdr-end (copy-marker end))
+ (header (vector (point-min-marker) hdr-end nil))
(tagline (vector parse-tag (cons nil nil) t))
- (body (vector end (point-max) is-inline))
+ (body (vector hdr-end (point-max-marker) is-inline))
(new (vector (aref header 2) (aref tagline 2) (aref body 2)))
children handler entity)
(cond ((string-match "multipart/.*" (car content-type))
@@ -1150,11 +1181,11 @@ modified."
;; Hide headers and handle the part.
(put-text-property (point-min) (point-max) 'rmail-mime-entity
(rmail-mime-entity
- content-type content-disposition
- content-transfer-encoding
- (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
- (vector nil nil 'raw) (vector "" (cons nil nil) nil)
- (vector nil nil 'raw) nil nil))
+ content-type content-disposition
+ content-transfer-encoding
+ (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
+ (vector nil nil 'raw) (vector "" (cons nil nil) nil)
+ (vector nil nil 'raw) nil nil))
(save-restriction
(cond ((string= (car content-type) "message/rfc822")
(narrow-to-region end (point-max)))
@@ -1333,12 +1364,16 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
(setq rmail-show-mime-function 'rmail-show-mime)
(defun rmail-insert-mime-forwarded-message (forward-buffer)
- "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)."
- (let ((rmail-mime-mbox-buffer
- (with-current-buffer forward-buffer rmail-view-buffer)))
+ "Insert the message in FORWARD-BUFFER as a forwarded message.
+This is the usual value of `rmail-insert-mime-forwarded-message-function'."
+ (let ((message-buffer
+ (with-current-buffer forward-buffer
+ (if rmail-buffer-swapped
+ forward-buffer
+ rmail-view-buffer))))
(save-restriction
(narrow-to-region (point) (point))
- (message-forward-make-body-mime rmail-mime-mbox-buffer))))
+ (message-forward-make-body-mime message-buffer))))
(setq rmail-insert-mime-forwarded-message-function
'rmail-insert-mime-forwarded-message)
@@ -1374,6 +1409,8 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
(re-search-forward regexp nil t))
;; Next, search the body.
(if (and entity
+ ;; RMS: I am not sure why, but sometimes this is a string.
+ (not (stringp entity))
(let* ((content-type (rmail-mime-entity-type entity))
(charset (cdr (assq 'charset (cdr content-type)))))
(or (not (string-match "text/.*" (car content-type)))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 069ad9662a2..fe20ad921da 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -29,7 +29,7 @@
;;; Code:
(require 'mail-utils)
-(autoload 'rfc2047-encode-string "rfc2047")
+(require 'rfc2047)
(defgroup sendmail nil
"Mail sending commands for Emacs."
@@ -43,12 +43,14 @@
:version "22.1")
(defcustom sendmail-program
- (cond
- ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
- ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
- ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
- (t "fakemail")) ;In ../etc, to interface to /bin/mail.
+ (or (executable-find "sendmail")
+ (cond
+ ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
+ ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
+ ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
+ (t "sendmail")))
"Program used to send messages."
+ :version "24.1" ; add executable-find, remove fakemail
:group 'mail
:type 'file)
@@ -136,25 +138,9 @@ Otherwise, let mailer send back a message to report errors."
:group 'sendmail
:version "23.1")
-;; Prevent problems with `window-system' not having the correct value
-;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the
-;; standard value.
-;;;###autoload
-(put 'send-mail-function 'standard-value
- ;; MS-Windows can access the clipboard even under -nw.
- '((if (or (and window-system (eq system-type 'darwin))
- (eq system-type 'windows-nt))
- 'mailclient-send-it
- 'sendmail-send-it)))
-
;; Useful to set in site-init.el
;;;###autoload
-(defcustom send-mail-function
- (if (or (and window-system (eq system-type 'darwin))
- ;; MS-Windows can access the clipboard even under -nw.
- (eq system-type 'windows-nt))
- 'mailclient-send-it
- 'sendmail-send-it)
+(defcustom send-mail-function 'sendmail-query-once
"Function to call to send the current buffer as mail.
The headers should be delimited by a line which is
not a valid RFC822 header or continuation line,
@@ -162,14 +148,56 @@ that matches the variable `mail-header-separator'.
This is used by the default mail-sending commands. See also
`message-send-mail-function' for use with the Message package."
:type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
+ (function-item sendmail-query-once :tag "Query the user")
(function-item smtpmail-send-it :tag "Use SMTPmail package")
(function-item feedmail-send-it :tag "Use Feedmail package")
(function-item mailclient-send-it :tag "Use Mailclient package")
function)
- :initialize 'custom-initialize-delay
+ :version "24.1"
:group 'sendmail)
-;;;###autoload(custom-initialize-delay 'send-mail-function nil)
+(defvar sendmail-query-once-function 'query
+ "Either a function to send email, or the symbol `query'.")
+
+;;;###autoload
+(defun sendmail-query-once ()
+ "Send an email via `sendmail-query-once-function'.
+If `sendmail-query-once-function' is `query', ask the user what
+function to use, and then save that choice."
+ (when (equal sendmail-query-once-function 'query)
+ (let* ((default
+ (cond
+ ((or (and window-system (eq system-type 'darwin))
+ (eq system-type 'windows-nt))
+ 'mailclient-send-it)
+ ((and sendmail-program
+ (executable-find sendmail-program))
+ 'sendmail-send-it)))
+ (function
+ (if (or (not default)
+ ;; We have detected no OS-level mail senders, or we
+ ;; have already configured smtpmail, so we use the
+ ;; internal SMTP service.
+ (and (boundp 'smtpmail-smtp-server)
+ smtpmail-smtp-server))
+ 'smtpmail-send-it
+ ;; Query the user.
+ (unwind-protect
+ (progn
+ (pop-to-buffer "*Mail Help*")
+ (erase-buffer)
+ (insert "Sending mail from Emacs hasn't been set up yet.\n\n"
+ "Type `y' to configure outgoing SMTP, or `n' to use\n"
+ "the default mail sender on your system.\n\n"
+ "To change this again at a later date, customize the\n"
+ "`send-mail-function' variable.\n")
+ (goto-char (point-min))
+ (if (y-or-n-p "Configure outgoing SMTP in Emacs? ")
+ 'smtpmail-send-it
+ default))
+ (kill-buffer (current-buffer))))))
+ (customize-save-variable 'sendmail-query-once-function function)))
+ (funcall sendmail-query-once-function))
;;;###autoload
(defcustom mail-header-separator (purecopy "--text follows this line--")
@@ -468,7 +496,8 @@ by Emacs.)")
(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled
(make-obsolete-variable 'mail-mailer-swallows-blank-line
- "no need to set this on any modern system." "24.1")
+ "no need to set this on any modern system."
+ "24.1" 'set)
(defvar mail-mode-syntax-table
;; define-derived-mode will make it inherit from text-mode-syntax-table.
@@ -803,10 +832,18 @@ Prefix arg means don't delete this window."
(defun mail-bury (&optional arg)
"Bury this mail buffer."
- (let ((newbuf (other-buffer (current-buffer))))
+ (let ((newbuf (other-buffer (current-buffer)))
+ (return-action mail-return-action)
+ some-rmail)
(bury-buffer (current-buffer))
- (if (and (null arg) mail-return-action)
- (apply (car mail-return-action) (cdr mail-return-action))
+ ;; 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 (null arg) return-action)
+ (apply (car return-action) (cdr return-action))
(switch-to-buffer newbuf))))
(defcustom mail-send-hook nil
@@ -862,9 +899,9 @@ the user from the mailer."
(let ((l))
(mapc
;; remove duplicates
- '(lambda (e)
- (unless (member e l)
- (push e l)))
+ (lambda (e)
+ (unless (member e l)
+ (push e l)))
(split-string new-header-values
",[[:space:]]+" t))
(mapconcat 'identity l ", "))
@@ -943,12 +980,14 @@ of outgoing mails regardless of the current language environment.
See also the function `select-message-coding-system'.")
(defun mail-insert-from-field ()
+ "Insert the \"From:\" field of a mail header.
+The style of the field is determined by the variable `mail-from-style'.
+This function does not perform RFC2047 encoding."
(let* ((login user-mail-address)
(fullname (user-full-name))
(quote-fullname nil))
(if (string-match "[^\0-\177]" fullname)
- (setq fullname (rfc2047-encode-string fullname)
- quote-fullname t))
+ (setq quote-fullname t))
(cond ((null mail-from-style)
(insert "From: " login "\n"))
;; This is deprecated.
@@ -1008,6 +1047,21 @@ See also the function `select-message-coding-system'.")
(goto-char fullname-start))))
(insert ")\n")))))
+(defun mail-encode-header (beg end)
+ "Encode the mail header between BEG and END according to RFC2047.
+Return non-nil if and only if some part of the header is encoded."
+ (save-restriction
+ (narrow-to-region beg end)
+ (let* ((selected (select-message-coding-system))
+ (mm-coding-system-priorities
+ (if (and selected (coding-system-get selected :mime-charset))
+ (cons selected mm-coding-system-priorities)
+ mm-coding-system-priorities))
+ (tick (buffer-chars-modified-tick))
+ (rfc2047-encode-encoded-words nil))
+ (rfc2047-encode-message-header)
+ (= tick (buffer-chars-modified-tick)))))
+
;; Normally you will not need to modify these options unless you are
;; using some non-genuine substitute for sendmail which does not
;; implement each and every option that the original supports.
@@ -1037,9 +1091,6 @@ external program defined by `sendmail-program'."
delimline
fcc-was-found
(mailbuf (current-buffer))
- (program (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail"))
;; Examine these variables now, so that
;; local binding in the mail buffer will take effect.
(envelope-from
@@ -1051,6 +1102,7 @@ external program defined by `sendmail-program'."
(unless multibyte
(set-buffer-multibyte nil))
(insert-buffer-substring mailbuf)
+ (set-buffer-file-coding-system selected-coding)
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
@@ -1156,6 +1208,8 @@ external program defined by `sendmail-program'."
(if mail-interactive
(with-current-buffer errbuf
(erase-buffer))))
+ ;; Encode the header according to RFC2047.
+ (mail-encode-header (point-min) delimline)
(goto-char (point-min))
(if (let ((case-fold-search t))
(or resend-to-addresses
@@ -1165,7 +1219,7 @@ external program defined by `sendmail-program'."
(coding-system-for-write selected-coding)
(args
(append (list (point-min) (point-max)
- program
+ sendmail-program
nil errbuf nil "-oi")
(and envelope-from
(list "-f" envelope-from))
@@ -1781,7 +1835,7 @@ The seventh argument ACTIONS is a list of actions to take
;; unbound on exit from the let.
(require 'dired)
(let ((dired-trivial-filenames t))
- (dired-other-window wildcard (concat dired-listing-switches "t")))
+ (dired-other-window wildcard (concat dired-listing-switches " -t")))
(rename-buffer "*Auto-saved Drafts*" t)
(save-excursion
(goto-char (point-min))
@@ -1861,7 +1915,7 @@ you can move to one of them and type C-c C-c to recover that one."
;; `ls' is not a standard program (it will use
;; ls-lisp instead).
(dired-noselect file-name
- (concat dired-listing-switches "t"))))
+ (concat dired-listing-switches " -t"))))
(save-selected-window
(select-window (display-buffer dispbuf t))
(goto-char (point-min))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 427d9d17746..073e2fa4a3c 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -34,16 +34,10 @@
;;
;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
-;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
+;;(setq smtpmail-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-debug-info t) ; only to debug problems
-;;(setq smtpmail-auth-credentials ; or use ~/.authinfo
-;; '(("YOUR SMTP HOST" 25 "username" "password")))
-;;(setq smtpmail-starttls-credentials
-;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
-;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
-;; integer or a string, just as long as they match (eq).
;; To queue mail, set `smtpmail-queue-mail' to t and use
;; `smtpmail-send-queued-mail' to send.
@@ -58,17 +52,9 @@
;; Authentication by the AUTH mechanism.
;; See http://www.ietf.org/rfc/rfc2554.txt
-;; Modified by Simon Josefsson <simon@josefsson.org>, 2000-10-07, to support
-;; STARTTLS. Requires external program
-;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz.
-;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt
-
;;; Code:
(require 'sendmail)
-(autoload 'starttls-any-program-available "starttls")
-(autoload 'starttls-open-stream "starttls")
-(autoload 'starttls-negotiate "starttls")
(autoload 'mail-strip-quoted-names "mail-utils")
(autoload 'message-make-date "message")
(autoload 'message-make-message-id "message")
@@ -110,6 +96,17 @@ don't define this value."
:type '(choice (const nil) string)
: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).."
+ :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)))
+
(defcustom smtpmail-sendto-domain nil
"Local domain name without a host name.
This is appended (with an @-sign) to any specified recipients which do
@@ -117,11 +114,7 @@ not include an @-sign, so that each RCPT TO address is fully qualified.
\(Some configurations of sendmail require this.)
Don't bother to set this unless you have get an error like:
- Sending failed; SMTP protocol error
-when sending mail, and the *trace of SMTP session to <somewhere>*
-buffer includes an exchange like:
- RCPT TO: <someone>
- 501 <someone>: recipient address must contain a domain."
+ Sending failed; 501 <someone>: recipient address must contain a domain."
:type '(choice (const nil) string)
:group 'smtpmail)
@@ -157,39 +150,6 @@ and sent with `smtpmail-send-queued-mail'."
:type 'directory
:group 'smtpmail)
-(defcustom smtpmail-auth-credentials "~/.authinfo"
- "Specify username and password for servers, directly or via .netrc file.
-This variable can either be a filename pointing to a file in netrc(5)
-format, or list of four-element lists that contain, in order,
-`servername' (a string), `port' (an integer), `user' (a string) and
-`password' (a string, or nil to query the user when needed). If you
-need to enter a `realm' too, add it to the user string, so that it
-looks like `user@realm'."
- :type '(choice file
- (repeat (list (string :tag "Server")
- (integer :tag "Port")
- (string :tag "Username")
- (choice (const :tag "Query when needed" nil)
- (string :tag "Password")))))
- :version "22.1"
- :group 'smtpmail)
-
-(defcustom smtpmail-starttls-credentials '(("" 25 "" ""))
- "Specify STARTTLS keys and certificates for servers.
-This is a list of four-element list with `servername' (a string),
-`port' (an integer), `key' (a filename) and `certificate' (a
-filename).
-If you do not have a certificate/key pair, leave the `key' and
-`certificate' fields as `nil'. A key/certificate pair is only
-needed if you want to use X.509 client authenticated
-connections."
- :type '(repeat (list (string :tag "Server")
- (integer :tag "Port")
- (file :tag "Key")
- (file :tag "Certificate")))
- :version "21.1"
- :group 'smtpmail)
-
(defcustom smtpmail-warn-about-unknown-extensions nil
"If set, print warnings about unknown SMTP extensions.
This is mainly useful for development purposes, to learn about
@@ -230,6 +190,7 @@ The list is in preference order.")
(tembuf (generate-new-buffer " smtpmail temp"))
(case-fold-search nil)
delimline
+ result
(mailbuf (current-buffer))
;; Examine this variable now, so that
;; local binding in the mail buffer will take effect.
@@ -361,6 +322,8 @@ The list is in preference order.")
(if mail-interactive
(with-current-buffer errbuf
(erase-buffer))))
+ ;; Encode the header according to RFC2047.
+ (mail-encode-header (point-min) delimline)
;;
(setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
(setq smtpmail-recipient-address-list
@@ -371,9 +334,10 @@ The list is in preference order.")
;; Send or queue
(if (not smtpmail-queue-mail)
(if (not (null smtpmail-recipient-address-list))
- (if (not (smtpmail-via-smtp
- smtpmail-recipient-address-list tembuf))
- (error "Sending failed; SMTP protocol error"))
+ (when (setq result
+ (smtpmail-via-smtp
+ smtpmail-recipient-address-list tembuf))
+ (error "Sending failed: %s" result))
(error "Sending failed; no recipients"))
(let* ((file-data
(expand-file-name
@@ -430,7 +394,8 @@ The list is in preference order.")
;; mail, send it, etc...
(let ((file-msg "")
(qfile (expand-file-name smtpmail-queue-index-file
- smtpmail-queue-dir)))
+ smtpmail-queue-dir))
+ result)
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
@@ -446,17 +411,16 @@ The list is in preference order.")
(or (and mail-specify-envelope-from (mail-envelope-from))
user-mail-address)))
(if (not (null smtpmail-recipient-address-list))
- (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
- (current-buffer)))
- (error "Sending failed; SMTP protocol error"))
+ (when (setq result (smtpmail-via-smtp
+ smtpmail-recipient-address-list
+ (current-buffer)))
+ (error "Sending failed: %s" result))
(error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
(delete-region (point-at-bol) (point-at-bol 2)))
(write-region (point-min) (point-max) qfile))))
-;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
-
(defun smtpmail-fqdn ()
(if smtpmail-local-domain
(concat (system-name) "." smtpmail-local-domain)
@@ -501,146 +465,149 @@ The list is in preference order.")
(push el2 result)))
(nreverse result)))
-(defvar starttls-extra-args)
-(defvar starttls-extra-arguments)
-
-(defun smtpmail-open-stream (process-buffer host port)
- (let ((cred (smtpmail-find-credentials
- smtpmail-starttls-credentials host port)))
- (if (null (and cred (starttls-any-program-available)))
- ;; The normal case.
- (open-network-stream "SMTP" process-buffer host port)
- (let* ((cred-key (smtpmail-cred-key cred))
- (cred-cert (smtpmail-cred-cert cred))
- (starttls-extra-args
- (append
- starttls-extra-args
- (when (and (stringp cred-key) (stringp cred-cert)
- (file-regular-p
- (setq cred-key (expand-file-name cred-key)))
- (file-regular-p
- (setq cred-cert (expand-file-name cred-cert))))
- (list "--key-file" cred-key "--cert-file" cred-cert))))
- (starttls-extra-arguments
- (append
- starttls-extra-arguments
- (when (and (stringp cred-key) (stringp cred-cert)
- (file-regular-p
- (setq cred-key (expand-file-name cred-key)))
- (file-regular-p
- (setq cred-cert (expand-file-name cred-cert))))
- (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
- (starttls-open-stream "SMTP" process-buffer host port)))))
-
;; `password-read' autoloads password-cache.
(declare-function password-cache-add "password-cache" (key password))
-(defun smtpmail-try-auth-methods (process supported-extensions host port)
+(defun smtpmail-command-or-throw (process string &optional code)
+ (let (ret)
+ (smtpmail-send-command process string)
+ (unless (smtpmail-ok-p (setq ret (smtpmail-read-response process))
+ code)
+ (throw 'done (format "%s in response to %s"
+ (smtpmail-response-text ret)
+ string)))
+ ret))
+
+(defun smtpmail-try-auth-methods (process supported-extensions host port
+ &optional ask-for-password)
+ (setq port
+ (if port
+ (format "%s" port)
+ "smtp"))
(let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
(mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
- (auth-info (auth-source-search :max 1
- :host host
- :port (or port "smtp")))
- (auth-user (plist-get (nth 0 auth-info) :user))
- (auth-pass (plist-get (nth 0 auth-info) :secret))
- (auth-pass (if (functionp auth-pass)
- (funcall auth-pass)
- auth-pass))
- (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
- (list host port auth-user auth-pass)
- ;; else, if auth-source didn't return them...
- (if (stringp smtpmail-auth-credentials)
- (let* ((netrc (netrc-parse smtpmail-auth-credentials))
- (port-name (format "%s" (or port "smtp")))
- (hostentry (netrc-machine netrc host port-name
- port-name)))
- (when hostentry
- (list host port
- (netrc-get hostentry "login")
- (netrc-get hostentry "password"))))
- ;; else, try `smtpmail-find-credentials' since
- ;; `smtpmail-auth-credentials' is not a string
- (smtpmail-find-credentials
- smtpmail-auth-credentials host port))))
- (prompt (when cred (format "SMTP password for %s:%s: "
- (smtpmail-cred-server cred)
- (smtpmail-cred-port cred))))
- (passwd (when cred
- (or (smtpmail-cred-passwd cred)
- (password-read prompt prompt))))
+ (auth-source-creation-prompts
+ '((user . "SMTP user at %h: ")
+ (secret . "SMTP password for %u@%h: ")))
+ (auth-info (car
+ (auth-source-search
+ :host host
+ :port port
+ :max 1
+ :require (and ask-for-password
+ '(:user :secret))
+ :create ask-for-password)))
+ (user (plist-get auth-info :user))
+ (password (plist-get auth-info :secret))
+ (save-function (and ask-for-password
+ (plist-get auth-info :save-function)))
ret)
- (when (and cred mech)
- (cond
- ((eq mech 'cram-md5)
- (smtpmail-send-command process (upcase (format "AUTH %s" mech)))
- (if (or (null (car (setq ret (smtpmail-read-response process))))
- (not (integerp (car ret)))
- (>= (car ret) 400))
- (throw 'done nil))
- (when (eq (car ret) 334)
- (let* ((challenge (substring (cadr ret) 4))
- (decoded (base64-decode-string challenge))
- (hash (rfc2104-hash 'md5 64 16 passwd decoded))
- (response (concat (smtpmail-cred-user cred) " " hash))
- ;; Osamu Yamane <yamane@green.ocn.ne.jp>:
- ;; SMTP auth fails because the SMTP server identifies
- ;; only the first part of the string (delimited by
- ;; new line characters) as a response from the
- ;; client, and the rest as distinct commands.
-
- ;; In my case, the response string is 80 characters
- ;; long. Without the no-line-break option for
- ;; `base64-encode-string', only the first 76 characters
- ;; are taken as a response to the server, and the
- ;; authentication fails.
- (encoded (base64-encode-string response t)))
- (smtpmail-send-command process (format "%s" encoded))
- (if (or (null (car (setq ret (smtpmail-read-response process))))
- (not (integerp (car ret)))
- (>= (car ret) 400))
- (throw 'done nil)))))
- ((eq mech 'login)
- (smtpmail-send-command process "AUTH LOGIN")
- (if (or (null (car (setq ret (smtpmail-read-response process))))
- (not (integerp (car ret)))
- (>= (car ret) 400))
- (throw 'done nil))
- (smtpmail-send-command
- process (base64-encode-string (smtpmail-cred-user cred) t))
- (if (or (null (car (setq ret (smtpmail-read-response process))))
- (not (integerp (car ret)))
- (>= (car ret) 400))
- (throw 'done nil))
- (smtpmail-send-command process (base64-encode-string passwd t))
- (if (or (null (car (setq ret (smtpmail-read-response process))))
- (not (integerp (car ret)))
- (>= (car ret) 400))
- (throw 'done nil)))
- ((eq mech 'plain)
- ;; We used to send an empty initial request, and wait for an
- ;; empty response, and then send the password, but this
- ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
- ;; is not sent if the server did not advertise AUTH PLAIN in
- ;; the EHLO response. See RFC 2554 for more info.
- (smtpmail-send-command process
- (concat "AUTH PLAIN "
- (base64-encode-string
- (concat "\0"
- (smtpmail-cred-user cred)
- "\0"
- passwd) t)))
- (if (or (null (car (setq ret (smtpmail-read-response process))))
- (not (integerp (car ret)))
- (not (equal (car ret) 235)))
- (throw 'done nil)))
-
- (t
- (error "Mechanism %s not implemented" mech)))
- ;; Remember the password.
- (when (null (smtpmail-cred-passwd cred))
- (password-cache-add prompt passwd)))))
-
-(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
+ (when (and user
+ (not password))
+ ;; The user has stored the user name, but not the password, so
+ ;; ask for the password, even if we're not forcing that through
+ ;; `ask-for-password'.
+ (setq auth-info
+ (car
+ (auth-source-search
+ :max 1
+ :host host
+ :port port
+ :require '(:user :secret)
+ :create t))
+ password (plist-get auth-info :secret)))
+ (when (functionp password)
+ (setq password (funcall password)))
+ (cond
+ ((or (not mech)
+ (not user)
+ (not password))
+ ;; No mechanism, or no credentials.
+ mech)
+ ((eq mech 'cram-md5)
+ (setq ret (smtpmail-command-or-throw process "AUTH CRAM-MD5"))
+ (when (eq (car ret) 334)
+ (let* ((challenge (substring (cadr ret) 4))
+ (decoded (base64-decode-string challenge))
+ (hash (rfc2104-hash 'md5 64 16 password decoded))
+ (response (concat user " " hash))
+ ;; Osamu Yamane <yamane@green.ocn.ne.jp>:
+ ;; SMTP auth fails because the SMTP server identifies
+ ;; only the first part of the string (delimited by
+ ;; new line characters) as a response from the
+ ;; client, and the rest as distinct commands.
+
+ ;; In my case, the response string is 80 characters
+ ;; long. Without the no-line-break option for
+ ;; `base64-encode-string', only the first 76 characters
+ ;; are taken as a response to the server, and the
+ ;; authentication fails.
+ (encoded (base64-encode-string response t)))
+ (smtpmail-command-or-throw process encoded)
+ (when save-function
+ (funcall save-function)))))
+ ((eq mech 'login)
+ (smtpmail-command-or-throw process "AUTH LOGIN")
+ (smtpmail-command-or-throw
+ process (base64-encode-string user t))
+ (smtpmail-command-or-throw process (base64-encode-string password t))
+ (when save-function
+ (funcall save-function)))
+ ((eq mech 'plain)
+ ;; We used to send an empty initial request, and wait for an
+ ;; empty response, and then send the password, but this
+ ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
+ ;; is not sent if the server did not advertise AUTH PLAIN in
+ ;; the EHLO response. See RFC 2554 for more info.
+ (smtpmail-command-or-throw
+ process
+ (concat "AUTH PLAIN "
+ (base64-encode-string (concat "\0" user "\0" password) t))
+ 235)
+ (when save-function
+ (funcall save-function)))
+ (t
+ (error "Mechanism %s not implemented" mech)))))
+
+(defun smtpmail-response-code (string)
+ (when string
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (and (re-search-forward "^\\([0-9]+\\) " nil t)
+ (string-to-number (match-string 1))))))
+
+(defun smtpmail-ok-p (response &optional code)
+ (and (car response)
+ (integerp (car response))
+ (< (car response) 400)
+ (or (null code)
+ (= code (car response)))))
+
+(defun smtpmail-response-text (response)
+ (mapconcat 'identity (cdr response) "\n"))
+
+(defun smtpmail-query-smtp-server ()
+ (let ((server (read-string "Outgoing SMTP mail server: "))
+ (ports '(587 "smtp"))
+ stream port)
+ (when (and smtpmail-smtp-server
+ (not (member smtpmail-smtp-server ports)))
+ (push smtpmail-smtp-server ports))
+ (while (and (not smtpmail-smtp-server)
+ (setq port (pop ports)))
+ (when (setq stream (ignore-errors
+ (open-network-stream "smtp" nil server port)))
+ (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-via-smtp (recipient smtpmail-text-buffer
+ &optional ask-for-password)
+ (unless smtpmail-smtp-server
+ (smtpmail-query-smtp-server))
(let ((process nil)
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
@@ -651,15 +618,19 @@ The list is in preference order.")
(and mail-specify-envelope-from
(mail-envelope-from))
user-mail-address))
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
response-code
- greeting
process-buffer
+ result
+ auth-mechanisms
(supported-extensions '()))
(unwind-protect
(catch 'done
;; get or create the trace buffer
(setq process-buffer
- (get-buffer-create (format "*trace of SMTP session to %s*" host)))
+ (get-buffer-create
+ (format "*trace of SMTP session to %s*" host)))
;; clear the trace buffer of old output
(with-current-buffer process-buffer
@@ -667,105 +638,91 @@ The list is in preference order.")
(erase-buffer))
;; open the connection to the server
- (setq process (smtpmail-open-stream process-buffer host port))
- (and (null process) (throw 'done nil))
+ (setq result
+ (open-network-stream
+ "smtpmail" process-buffer host port
+ :type smtpmail-stream-type
+ :return-list t
+ :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
+ :end-of-command "^[0-9]+ .*\r\n"
+ :success "^2.*\n"
+ :always-query-capabilities t
+ :starttls-function
+ (lambda (capabilities)
+ (and (string-match "-STARTTLS" capabilities)
+ "STARTTLS\r\n"))
+ :client-certificate t
+ :use-starttls-if-possible t))
+
+ ;; If we couldn't access the server at all, we give up.
+ (unless (setq process (car result))
+ (throw 'done (if (plist-get (cdr result) :error)
+ (plist-get (cdr result) :error)
+ "Unable to contact server")))
;; set the send-filter
(set-process-filter process 'smtpmail-process-filter)
+ (let* ((greeting (plist-get (cdr result) :greeting))
+ (code (smtpmail-response-code greeting)))
+ (unless code
+ (throw 'done (format "No greeting: %s" greeting)))
+ (when (>= code 400)
+ (throw 'done (format "Connection not allowed: %s" greeting))))
+
(with-current-buffer process-buffer
(set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
(make-local-variable 'smtpmail-read-point)
(setq smtpmail-read-point (point-min))
-
- (if (or (null (car (setq greeting (smtpmail-read-response process))))
- (not (integerp (car greeting)))
- (>= (car greeting) 400))
- (throw 'done nil))
-
- (let ((do-ehlo t)
- (do-starttls t))
- (while do-ehlo
- ;; EHLO
- (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
-
- (if (or (null (car (setq response-code
- (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (progn
- ;; HELO
- (smtpmail-send-command
- process (format "HELO %s" (smtpmail-fqdn)))
-
- (if (or (null (car (setq response-code
- (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil)))
- (dolist (line (cdr (cdr response-code)))
- (let ((name
- (with-case-table ascii-case-table
- (mapcar (lambda (s) (intern (downcase s)))
- (split-string (substring line 4) "[ ]")))))
- (and (eq (length name) 1)
- (setq name (car name)))
- (and name
- (cond ((memq (if (consp name) (car name) name)
- '(verb xvrb 8bitmime onex xone
- expn size dsn etrn
- enhancedstatuscodes
- help xusr
- auth=login auth starttls))
- (setq supported-extensions
- (cons name supported-extensions)))
- (smtpmail-warn-about-unknown-extensions
- (message "Unknown extension %s" name)))))))
-
- (if (and do-starttls
- (smtpmail-find-credentials smtpmail-starttls-credentials host port)
- (member 'starttls supported-extensions)
- (numberp (process-id process)))
- (progn
- (smtpmail-send-command process (format "STARTTLS"))
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))
- (starttls-negotiate process)
- (setq do-starttls nil))
- (setq do-ehlo nil))))
-
- (smtpmail-try-auth-methods process supported-extensions host port)
-
- (if (or (member 'onex supported-extensions)
- (member 'xone supported-extensions))
- (progn
- (smtpmail-send-command process (format "ONEX"))
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))))
-
- (if (and smtpmail-debug-verb
- (or (member 'verb supported-extensions)
- (member 'xvrb supported-extensions)))
- (progn
- (smtpmail-send-command process (format "VERB"))
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))))
-
- (if (member 'xusr supported-extensions)
- (progn
- (smtpmail-send-command process (format "XUSR"))
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))))
-
+ (let* ((capabilities (plist-get (cdr result) :capabilities))
+ (code (smtpmail-response-code capabilities)))
+ (if (or (null code)
+ (>= code 400))
+ ;; The server didn't accept EHLO, so we fall back on HELO.
+ (smtpmail-command-or-throw
+ process (format "HELO %s" (smtpmail-fqdn)))
+ ;; EHLO was successful, so we parse the extensions.
+ (dolist (line (delete
+ ""
+ (split-string
+ (plist-get (cdr result) :capabilities)
+ "\r\n")))
+ (let ((name
+ (with-case-table ascii-case-table
+ (mapcar (lambda (s) (intern (downcase s)))
+ (split-string (substring line 4) "[ ]")))))
+ (when (= (length name) 1)
+ (setq name (car name)))
+ (when name
+ (cond ((memq (if (consp name) (car name) name)
+ '(verb xvrb 8bitmime onex xone
+ expn size dsn etrn
+ enhancedstatuscodes
+ help xusr
+ auth=login auth starttls))
+ (setq supported-extensions
+ (cons name supported-extensions)))
+ (smtpmail-warn-about-unknown-extensions
+ (message "Unknown extension %s" name))))))))
+
+ (setq auth-mechanisms
+ (smtpmail-try-auth-methods
+ process supported-extensions host port
+ ask-for-password))
+
+ (when (or (member 'onex supported-extensions)
+ (member 'xone supported-extensions))
+ (smtpmail-command-or-throw process (format "ONEX")))
+
+ (when (and smtpmail-debug-verb
+ (or (member 'verb supported-extensions)
+ (member 'xvrb supported-extensions)))
+ (smtpmail-command-or-throw process (format "VERB")))
+
+ (when (member 'xusr supported-extensions)
+ (smtpmail-command-or-throw process (format "XUSR")))
+
;; MAIL FROM:<sender>
(let ((size-part
(if (or (member 'size supported-extensions)
@@ -795,65 +752,73 @@ The list is in preference order.")
" BODY=8BITMIME"
"")
"")))
- ;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
- (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
- envelope-from
- size-part
- body-part))
-
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil)))
+ (smtpmail-send-command
+ process (format "MAIL FROM:<%s>%s%s"
+ envelope-from size-part body-part))
+ (cond
+ ((smtpmail-ok-p (setq result (smtpmail-read-response process)))
+ ;; Success.
+ )
+ ((and auth-mechanisms
+ (not ask-for-password)
+ (= (car result) 530))
+ ;; We got a "530 auth required", so we close and try
+ ;; again, this time asking the user for a password.
+ (smtpmail-send-command process "QUIT")
+ (smtpmail-read-response process)
+ (delete-process process)
+ (setq process nil)
+ (throw 'done
+ (smtpmail-via-smtp recipient smtpmail-text-buffer t)))
+ (t
+ ;; Return the error code.
+ (throw 'done
+ (smtpmail-response-text result)))))
;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
- (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
- (setq n (1+ n))
-
- (setq response-code (smtpmail-read-response process))
- (if (or (null (car response-code))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))))
-
- ;; DATA
- (smtpmail-send-command process "DATA")
-
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))
-
- ;; Mail contents
+ (smtpmail-send-command
+ process (format "RCPT TO:<%s>"
+ (smtpmail-maybe-append-domain
+ (nth n recipient))))
+ (cond
+ ((smtpmail-ok-p (setq result (smtpmail-read-response process)))
+ ;; Success.
+ nil)
+ ((and auth-mechanisms
+ (not ask-for-password)
+ (= (car result) 550))
+ ;; We got a "550 relay not permitted", and the server
+ ;; accepts credentials, so we try again, but ask for a
+ ;; password first.
+ (smtpmail-send-command process "QUIT")
+ (smtpmail-read-response process)
+ (delete-process process)
+ (setq process nil)
+ (throw 'done
+ (smtpmail-via-smtp recipient smtpmail-text-buffer t)))
+ (t
+ ;; Return the error code.
+ (throw 'done
+ (smtpmail-response-text result))))
+ (setq n (1+ n))))
+
+ ;; Send the contents.
+ (smtpmail-command-or-throw process "DATA")
(smtpmail-send-data process smtpmail-text-buffer)
-
;; DATA end "."
- (smtpmail-send-command process ".")
-
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil))
-
- ;; QUIT
- ;; (smtpmail-send-command process "QUIT")
- ;; (and (null (car (smtpmail-read-response process)))
- ;; (throw 'done nil))
- t))
- (if process
- (with-current-buffer (process-buffer process)
- (smtpmail-send-command process "QUIT")
- (smtpmail-read-response process)
-
- ;; (if (or (null (car (setq response-code (smtpmail-read-response process))))
- ;; (not (integerp (car response-code)))
- ;; (>= (car response-code) 400))
- ;; (throw 'done nil))
- (delete-process process)
- (unless smtpmail-debug-info
- (kill-buffer process-buffer)))))))
+ (smtpmail-command-or-throw process ".")
+ ;; Return success.
+ nil))
+ (when (and process
+ (buffer-live-p process-buffer))
+ (with-current-buffer (process-buffer process)
+ (smtpmail-send-command process "QUIT")
+ (smtpmail-read-response process)
+ (delete-process process)
+ (unless smtpmail-debug-info
+ (kill-buffer process-buffer)))))))
(defun smtpmail-process-filter (process output)
@@ -941,15 +906,20 @@ The list is in preference order.")
(process-send-string process "\r\n"))
(defun smtpmail-send-data (process buffer)
- (let ((data-continue t) sending-data)
+ (let ((data-continue t) sending-data
+ (pr (with-current-buffer buffer
+ (make-progress-reporter "Sending email"
+ (point-min) (point-max)))))
(with-current-buffer buffer
(goto-char (point-min)))
(while data-continue
(with-current-buffer buffer
+ (progress-reporter-update pr (point))
(setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
(end-of-line 2)
(setq data-continue (not (eobp))))
- (smtpmail-send-data-1 process sending-data))))
+ (smtpmail-send-data-1 process sending-data))
+ (progress-reporter-done pr)))
(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
"Get address list suitable for smtp RCPT TO: <address>."
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 084b623080a..3d754c08f83 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -184,7 +184,9 @@ See the variable `sc-cite-frame-alist' for details."
;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
;; case we treat blank lines just like any other line.
("^[ \t]*$" (if sc-cite-blank-lines-p
- (sc-cite-line)
+ (if sc-nested-citation-p
+ (sc-add-citation-level)
+ (sc-cite-line))
(sc-fill-if-different "")))
;; do nothing if looking at a reference tag. make sure that the
;; tag string isn't the empty string since this will match every
diff --git a/lisp/man.el b/lisp/man.el
index 7a9e6e3cca5..b5a70395e59 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -276,7 +276,9 @@ This regexp should not start with a `^' character.")
This regular expression should start with a `^' character.")
(defvar Man-reference-regexp
- (concat "\\(" Man-name-regexp "\\)[ \t]*(\\(" Man-section-regexp "\\))")
+ (concat "\\(" Man-name-regexp
+ "\\(\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\("
+ Man-section-regexp "\\))")
"Regular expression describing a reference to another manpage.")
(defvar Man-apropos-regexp
@@ -597,8 +599,8 @@ and the `Man-section-translations-alist' variables)."
(cond
;; "chmod(2V)" case ?
((string-match (concat "^" Man-reference-regexp "$") ref)
- (setq name (match-string 1 ref)
- section (match-string 2 ref)))
+ (setq name (replace-regexp-in-string "[\n\t ]" "" (match-string 1 ref))
+ section (match-string 3 ref)))
;; "2v chmod" case ?
((string-match (concat "^\\(" Man-section-regexp
"\\) +\\(" Man-name-regexp "\\)$") ref)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 8a33381b618..caae40ed8c5 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1135,17 +1135,18 @@ mail status in mode line"))
(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)))
+ `(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")
@@ -1238,78 +1239,88 @@ mail status in mode line"))
menu-bar-separator)
(define-key menu [blink-cursor-mode]
- (menu-bar-make-mm-toggle blink-cursor-mode
- "Blinking Cursor"
- "Whether the cursor blinks (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]
menu-bar-separator)
(define-key menu [save-place]
- (menu-bar-make-toggle toggle-save-place-globally save-place
- "Save Place in Files between Sessions"
- "Saving place in files %s"
- "Visit files of previous session when restarting Emacs"
- (require 'saveplace)
- ;; Do it by name, to avoid a free-variable
- ;; warning during byte compilation.
- (set-default
- 'save-place (not (symbol-value 'save-place)))))
+ (menu-bar-make-toggle
+ toggle-save-place-globally save-place
+ "Save Place in Files between Sessions"
+ "Saving place in files %s"
+ "Visit files of previous session when restarting Emacs"
+ (require 'saveplace)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'save-place (not (symbol-value 'save-place)))))
(define-key menu [uniquify]
- (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
- "Use Directory Names in Buffer Names"
- "Directory name in buffer names (uniquify) %s"
- "Uniquify buffer names by adding parent directory names"
- (require 'uniquify)
- (setq uniquify-buffer-name-style
- (if (not uniquify-buffer-name-style)
- 'forward))))
+ (menu-bar-make-toggle
+ toggle-uniquify-buffer-names uniquify-buffer-name-style
+ "Use Directory Names in Buffer Names"
+ "Directory name in buffer names (uniquify) %s"
+ "Uniquify buffer names by adding parent directory names"
+ (require 'uniquify)
+ (setq uniquify-buffer-name-style
+ (if (not uniquify-buffer-name-style)
+ 'forward))))
(define-key menu [edit-options-separator]
menu-bar-separator)
(define-key menu [cua-mode]
- (menu-bar-make-mm-toggle cua-mode
- "C-x/C-c/C-v Cut and Paste (CUA)"
- "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
- (:visible (or (not (boundp 'cua-enable-cua-keys))
- cua-enable-cua-keys))))
+ (menu-bar-make-mm-toggle
+ cua-mode
+ "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
+ "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
+ (:visible (or (not (boundp 'cua-enable-cua-keys))
+ cua-enable-cua-keys))))
(define-key menu [cua-emulation-mode]
- (menu-bar-make-mm-toggle cua-mode
- "Shift movement mark region (CUA)"
- "Use shifted movement keys to set and extend the region"
- (:visible (and (boundp 'cua-enable-cua-keys)
- (not cua-enable-cua-keys)))))
+ (menu-bar-make-mm-toggle
+ cua-mode
+ "Shift movement mark region (CUA)"
+ "Use shifted movement keys to set and extend the region"
+ (:visible (and (boundp 'cua-enable-cua-keys)
+ (not cua-enable-cua-keys)))))
(define-key menu [case-fold-search]
- (menu-bar-make-toggle toggle-case-fold-search case-fold-search
- "Case-Insensitive Search"
- "Case-Insensitive Search %s"
- "Ignore letter-case in search commands"))
+ (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")
- menu-bar-text-mode-auto-fill
- :help ,(purecopy "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)))))
+ `(menu-item
+ ,(purecopy "Auto Fill in Text Modes")
+ menu-bar-text-mode-auto-fill
+ :help ,(purecopy "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") ,menu-bar-line-wrapping-menu))
+ `(menu-item ,(purecopy "Line Wrapping in this Buffer")
+ ,menu-bar-line-wrapping-menu))
(define-key menu [highlight-separator]
menu-bar-separator)
(define-key menu [highlight-paren-mode]
- (menu-bar-make-mm-toggle show-paren-mode
- "Paren Match Highlighting"
- "Highlight matching/mismatched parentheses at cursor (Show 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]
- (menu-bar-make-mm-toggle transient-mark-mode
- "Active Region Highlighting"
- "Make text in active region stand out in color (Transient Mark mode)"
- (:enable (not cua-mode))))
+ (menu-bar-make-mm-toggle
+ transient-mark-mode
+ "Highlight Active Region"
+ "Make text in active region stand out in color (Transient Mark mode)"
+ (:enable (not cua-mode))))
menu))
@@ -1823,14 +1834,17 @@ using `abort-recursive-edit'."
(abort-recursive-edit)))
(defun kill-this-buffer-enabled-p ()
- (let ((count 0)
- (buffers (buffer-list)))
- (while buffers
- (or (string-match "^ " (buffer-name (car buffers)))
- (setq count (1+ count)))
- (setq buffers (cdr buffers)))
- (or (not (menu-bar-non-minibuffer-window-p))
- (> count 1))))
+ "Return non-nil if the `kill-this-buffer' menu item should be enabled."
+ (or (not (menu-bar-non-minibuffer-window-p))
+ (let (found-1)
+ ;; Instead of looping over entire buffer list, stop once we've
+ ;; found two "killable" buffers (Bug#8184).
+ (catch 'found-2
+ (dolist (buffer (buffer-list))
+ (unless (string-match-p "^ " (buffer-name buffer))
+ (if (not found-1)
+ (setq found-1 t)
+ (throw 'found-2 t))))))))
(put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p))
@@ -1974,6 +1988,10 @@ Buffers menu is regenerated."
;; Used to cache the menu entries for commands in the Buffers menu
(defvar menu-bar-buffers-menu-command-entries nil)
+(defvar menu-bar-select-buffer-function 'switch-to-buffer
+ "Function to select the buffer chosen from the `Buffers' menu-bar menu.
+It must accept a buffer as its only required argument.")
+
(defun menu-bar-update-buffers (&optional force)
;; If user discards the Buffers item, play along.
(and (lookup-key (current-global-map) [menu-bar buffer])
@@ -2019,7 +2037,7 @@ Buffers menu is regenerated."
(cons nil nil))
`(lambda ()
(interactive)
- (switch-to-buffer ,(cdr pair))))))
+ (funcall menu-bar-select-buffer-function ,(cdr pair))))))
(list buffers-vec))))
;; Make a Frames menu if we have more than one frame.
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 5228dc86fa2..df4edcc75e1 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,92 @@
+2011-07-12 Bill Wohler <wohler@newt.com>
+
+ Release MH-E version 8.2.91.
+
+ * mh-e.el (Version, mh-version): Update for release 8.2.91.
+
+ * mh-compat.el (mh-pop-to-buffer-same-window): Add compatibility
+ function to call switch-to-buffer on systems that lack
+ 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
+ produced the wrong behavior.
+
+2011-07-12 Henrique Martins <henrique@martins.cc> (tiny change)
+
+ * mh-xface.el (mh-picon-get-image): Remove quote from block
+ argument.
+ * mh-mime.el (mh-mh-directive-present-p): Ditto.
+
+2011-07-10 Bill Wohler <wohler@newt.com>
+
+ Release MH-E version 8.2.90.
+
+ * mh-e.el (Version, mh-version): Update for release 8.2.90.
+
+ * mh-utils.el (mh-sub-folders-actual): Remove FIXME question.
+
+ * mh-mime.el (mh-decode-message-subject): Fix case of Subject.
+
+ * 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.
+
+2011-07-09 Bill Wohler <wohler@newt.com>
+
+ * mh-speed.el (mh-speed-toggle,mh-speed-view): Document "ignored"
+ arguments to keep checkdoc happy.
+
+ * mh-search.el (mh-flists-execute): Ditto.
+
+ * mh-funcs.el (mh-undo-folder): Ditto.
+
+ * mh-comp.el (mh-user-agent-compose): Ditto.
+
+ * mh-xface.el (mh-face-to-png, mh-uncompface)
+ (mh-picon-file-contents): Only call set-buffer-multibyte if it
+ exists, which it doesn't in XEmacs.
+
+2011-07-04 Bill Wohler <wohler@newt.com>
+
+ * 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-mime.el, mh-search.el, mh-seq.el: Shush XEmacs compiler in
+ mh-do-in-xemacs block.
+
+ * mh-compat.el (mh-window-full-height-p): Add compatibility
+ function for XEmacs.
+ * mh-show.el (mh-show-msg): Use it, and avoid compiler warning on
+ XEmacs.
+
+ * 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
+ stand to be generalized like completion-at-point.
+ (mh-letter-complete-or-space): Remove unused variable.
+
+2011-07-03 Bill Wohler <wohler@newt.com>
+
+ * mh-compat.el (mh-test-completion): Add compatibility function
+ for XEmacs.
+ * mh-alias.el (mh-alias-letter-expand-alias): Use it, and avoid
+ compiler warning on XEmacs.
+
+ * mh-utils.el:
+ * mh-mime.el: Shush XEmacs compiler in mh-do-in-xemacs block.
+
+ * mh-folder.el: Use boundp instead of fboundp when testing
+ existence of desktop-buffer-mode-handlers.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ Fix doubled-word typos.
+ * mh-alias.el (mh-alias-minibuffer-confirm-address): if if -> if it
+ * mh-scan.el (mh-scan-destination-width): in in -> in
+
2011-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
* mh-utils.el (mh-folder-completion-function): Make it work like
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index c1964d5a4ea..2144eef7308 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -132,9 +132,10 @@ check if variable `transient-mark-mode' is active."
(boundp 'mark-active) mark-active))))
;; Shush compiler.
-(defvar struct) ; XEmacs
-(defvar x) ; XEmacs
-(defvar y) ; XEmacs
+(mh-do-in-xemacs
+ (defvar struct)
+ (defvar x)
+ (defvar y))
;;;###mh-autoload
(defmacro mh-defstruct (name-spec &rest fields)
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 449a8782d0c..d1b3ccebf46 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -286,7 +286,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(the-name (buffer-substring-no-properties beg (point))))
(if (mh-assoc-string the-name mh-alias-alist t)
(message "%s -> %s" the-name (mh-alias-expand the-name))
- ;; Check if if was a single word likely to be an alias
+ ;; Check if it was a single word likely to be an alias
(if (and (equal mh-alias-flash-on-comma 1)
(not (string-match " " the-name)))
(message "No alias for %s" the-name))))))
@@ -316,8 +316,7 @@ Blind aliases or users from /etc/passwd are not expanded."
res)
res)))
((t) (all-completions string mh-alias-alist pred))
- ((lambda) (if (fboundp 'test-completion)
- (test-completion string mh-alias-alist pred))))))))))
+ ((lambda) (mh-test-completion string mh-alias-alist pred)))))))))
;;; Alias File Updating
@@ -638,10 +637,10 @@ filing messages."
(message "Making passwd aliases...")
(setq passwd-matches
(mapconcat
- '(lambda (elem)
- (if (or (string-match regexp (car elem))
- (string-match regexp (cadr elem)))
- (format "%s: %s\n" (car elem) (cadr elem))))
+ (lambda (elem)
+ (if (or (string-match regexp (car elem))
+ (string-match regexp (cadr elem)))
+ (format "%s: %s\n" (car elem) (cadr elem))))
mh-alias-passwd-alist ""))
(message "Making passwd aliases...done")))
(if (and (string-equal "" matches)
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 169679e88ae..882a8771e28 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -213,7 +213,7 @@ Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings.
CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
-RETURN-ACTION are ignored."
+RETURN-ACTION and any additional arguments are IGNORED."
(mh-find-path)
(let ((mh-error-if-no-draft t))
(mh-send to "" subject)
@@ -223,7 +223,8 @@ RETURN-ACTION are ignored."
(setq other-headers (cdr other-headers)))))
;; Shush compiler.
-(defvar sendmail-coding-system) ; XEmacs
+(mh-do-in-xemacs
+ (defvar sendmail-coding-system))
;;;###autoload
(defun mh-send-letter (&optional arg)
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 01a0f26b9e8..16dfe05b094 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -251,6 +251,18 @@ The argument STRING is ignored."
(buffer-substring-no-properties
(match-beginning num) (match-end num)))
+(defun-mh mh-pop-to-buffer-same-window
+ pop-to-buffer-same-window (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME in the selected window.
+Another window will be used only if the buffer can't be shown in
+the selected window, usually because it is dedicated to another
+buffer. Optional arguments BUFFER-OR-NAME, NORECORD and LABEL are
+as for `pop-to-buffer'. This macro is used by Emacs versions that
+lack the `pop-to-buffer-same-window' function, introduced in
+Emacs 24. The function `switch-to-buffer' is used instead and
+LABEL is ignored."
+ (switch-to-buffer buffer-or-name norecord))
+
(defun-mh mh-replace-regexp-in-string replace-regexp-in-string
(regexp rep string &optional fixedcase literal subexp start)
"Replace REGEXP with REP everywhere in STRING and return result.
@@ -260,6 +272,12 @@ The arguments FIXEDCASE, SUBEXP, and START, used by
`replace-in-string' are ignored."
(replace-in-string string regexp rep literal))
+(defun-mh mh-test-completion
+ test-completion (string collection &optional predicate)
+ "Return non-nil if STRING is a valid completion.
+XEmacs does not have `test-completion'. This function returns nil
+on that system." nil)
+
;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
(if (not (boundp 'url-unreserved-chars))
(defconst mh-url-unreserved-chars
@@ -296,6 +314,16 @@ The arguments RETURN-TO and EXIT-ACTION are ignored."
(if exit-action nil)
(view-mode 1))
+(defun-mh mh-window-full-height-p
+ window-full-height-p (&optional WINDOW)
+ "Return non-nil if WINDOW is not the result of a vertical split.
+This function is defined in XEmacs as it lacks
+`window-full-height-p'. The values of the functions
+`window-height' and `frame-height' are compared instead. The
+argument WINDOW is ignored."
+ (= (1+ (window-height))
+ (frame-height)))
+
(defmacro mh-write-file-functions ()
"Return `write-file-functions' if it exists.
Otherwise return `local-write-file-hooks'.
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index ccae063827f..51b41e854b0 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -5,7 +5,7 @@
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 8.2
+;; Version: 8.2.91
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -27,7 +27,7 @@
;; MH-E is an Emacs interface to the MH mail system.
-;; MH-E is supported in GNU Emacs 21 and 22, as well as XEmacs 21
+;; MH-E is supported in GNU Emacs 21 and higher, as well as XEmacs 21
;; (except for versions 21.5.9-21.5.16). It is compatible with MH
;; versions 6.8.4 and higher, all versions of nmh, and GNU mailutils
;; 1.0 and higher. Gnus is also required; version 5.10 or higher is
@@ -90,10 +90,7 @@
;; Provide functions to the rest of MH-E. However, mh-e.el must not
;; use any definitions in files that require mh-e from mh-loaddefs,
;; for if it does it will introduce a require loop.
-(eval-and-compile
- ;; Load it during compilation as well, since it defines the macro
- ;; mh-require-cl.
- (load "mh-loaddefs" nil 'nomessage))
+(require 'mh-loaddefs)
(mh-require-cl)
@@ -130,7 +127,7 @@
;; Try to keep variables local to a single file. Provide accessors if
;; variables are shared. Use this section as a last resort.
-(defconst mh-version "8.2" "Version number of MH-E.")
+(defconst mh-version "8.2.91" "Version number of MH-E.")
;; Variants
@@ -616,7 +613,8 @@ Output is expected to be shown to user, not parsed by MH-E."
(mh-exchange-point-and-mark-preserving-active-mark))
;; Shush compiler.
-(defvar mark-active) ; XEmacs
+(mh-do-in-xemacs
+ (defvar mark-active))
(defun mh-exchange-point-and-mark-preserving-active-mark ()
"Put the mark where point is now, and point where the mark is now.
@@ -933,7 +931,7 @@ finally GNU mailutils MH."
(t
(message "Unknown variant %s; use %s"
variant
- (mapconcat '(lambda (x) (format "%s" (car x)))
+ (mapconcat (lambda (x) (format "%s" (car x)))
(mh-variants) " or "))))))
(defcustom-mh mh-variant 'autodetect
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index aab40c7be13..1d9a79d0deb 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -77,7 +77,7 @@ the MH mail system."
;;; Desktop Integration
;; desktop-buffer-mode-handlers appeared in Emacs 22.
-(if (fboundp 'desktop-buffer-mode-handlers)
+(if (boundp 'desktop-buffer-mode-handlers)
(add-to-list 'desktop-buffer-mode-handlers
'(mh-folder-mode . mh-restore-desktop-buffer)))
@@ -526,7 +526,8 @@ font-lock is done highlighting.")
;; Shush compiler.
(defvar desktop-save-buffer)
(defvar font-lock-auto-fontify)
-(defvar font-lock-defaults) ; XEmacs
+(mh-do-in-xemacs
+ (defvar font-lock-defaults))
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-folder-mode 'mode-class 'special)
@@ -794,7 +795,7 @@ instead."
(setq threading-needed-flag mh-show-threads-flag)
(setq mh-previous-window-config config))
((not (eq (current-buffer) (get-buffer folder)))
- (switch-to-buffer folder)
+ (mh-pop-to-buffer-same-window folder)
(setq mh-previous-window-config config))))
(mh-get-new-mail file)
(when (and threading-needed-flag
@@ -854,7 +855,7 @@ From a program, edit MESSAGE; nil means edit current message."
;; Just show the edit buffer...
(delete-other-windows)
- (switch-to-buffer edit-buffer)))
+ (mh-pop-to-buffer-same-window edit-buffer)))
;;;###mh-autoload
(defun mh-next-button (&optional backward-flag)
@@ -1704,7 +1705,7 @@ DONT-EXEC-PENDING is non-nil."
(unless dont-exec-pending
(mh-process-or-undo-commands folder)
(mh-reset-threads-and-narrowing))
- (switch-to-buffer folder)))
+ (mh-pop-to-buffer-same-window folder)))
(mh-regenerate-headers range)
(if (zerop (buffer-size))
(if (equal range "all")
@@ -1785,7 +1786,7 @@ Also removes all content from the folder buffer."
(defun mh-make-folder (name)
"Create a new mail folder called NAME.
Make it the current folder."
- (switch-to-buffer name)
+ (mh-pop-to-buffer-same-window name)
(setq buffer-read-only nil)
(erase-buffer)
(if mh-adaptive-cmd-note-flag
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index dfac684ed50..46a04c38845 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -349,7 +349,7 @@ See `mh-store-msg' for a description of DIRECTORY."
(error "Error occurred during execution of %s" command)))))
;;;###mh-autoload
-(defun mh-undo-folder (&rest _ignored)
+(defun mh-undo-folder (&rest ignored)
"Undo all refiles and deletes in the current folder.
Arguments are IGNORED (for `revert-buffer')."
(interactive)
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 4f83ed70508..5248d6ab75e 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -39,12 +39,12 @@
"Help text for `mh-inc-spool-map'.")
(define-key mh-inc-spool-map "?"
- '(lambda ()
- (interactive)
- (if mh-inc-spool-map-help
- (mh-help mh-inc-spool-map-help)
- (mh-ephem-message
- "There are no keys defined yet; customize `mh-inc-spool-list'"))))
+ (lambda ()
+ (interactive)
+ (if mh-inc-spool-map-help
+ (mh-help mh-inc-spool-map-help)
+ (mh-ephem-message
+ "There are no keys defined yet; customize `mh-inc-spool-list'"))))
;;;###mh-autoload
(defun mh-inc-spool-make ()
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 2ffc24e26e8..897f7518b1e 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -312,9 +312,9 @@ information can be used so that you can replace multiple
(delete-other-windows)
(pop-to-buffer (get-buffer-create "*MH-E Spammer Frequencies*"))
(erase-buffer)
- (maphash '(lambda (key value) ""
- (if (> value 2)
- (insert (format "%s %s\n" key value))))
+ (maphash (lambda (key value) ""
+ (if (> value 2)
+ (insert (format "%s %s\n" key value))))
domains)
(sort-numeric-fields 2 (point-min) (point-max))
(reverse-region (point-min) (point-max))
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 2ced886c05e..f269faf3a51 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -185,7 +185,7 @@ semi-obsolete and is only used if `mail-citation-hook' is nil.")
"\C-c\C-w" mh-check-whom
"\C-c\C-y" mh-yank-cur-msg
"\C-c\M-d" mh-insert-auto-fields
- "\M-\t" mh-letter-complete ;; FIXME: completion-at-point
+ "\M-\t" mh-letter-complete
"\t" mh-letter-next-header-field-or-indent
[backtab] mh-letter-previous-header-field)
@@ -273,7 +273,8 @@ searching for `mh-mail-header-separator' in the buffer."
;;; MH-Letter Mode
;; Shush compiler.
-(defvar font-lock-defaults) ; XEmacs
+(mh-do-in-xemacs
+ (defvar font-lock-defaults))
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-letter-mode 'mode-class 'special)
@@ -502,10 +503,13 @@ This provides alias and folder completion in header fields according to
(or (funcall func) #'ignore)
mh-letter-complete-function)))
-(defalias 'mh-letter-complete
- (if (fboundp 'completion-at-point) #'completion-at-point
- (lambda ()
- "Perform completion on header field or word preceding point.
+;; TODO Now that completion-at-point performs the task of
+;; mh-letter-complete, perhaps mh-letter-complete along with
+;; mh-complete-word should be rewritten as a more general function for
+;; XEmacs, renamed to mh-completion-at-point, and moved to
+;; mh-compat.el.
+(defun-mh mh-letter-complete completion-at-point ()
+ "Perform completion on header field or word preceding point.
If the field contains addresses (for example, \"To:\" or \"Cc:\")
or folders (for example, \"Fcc:\") then this command will provide
@@ -521,7 +525,7 @@ alias completion. In the body of the message, this command runs
(end (nth 1 data))
(table (nth 2 data)))
(mh-complete-word (buffer-substring-no-properties start end)
- table start end))))))))
+ table start end))))))
(defun mh-letter-complete-or-space (arg)
"Perform completion or insert space.
@@ -531,8 +535,7 @@ this command to perform completion in the header. Otherwise, a
space is inserted; use a prefix argument ARG to specify more than
one space."
(interactive "p")
- (let ((func nil)
- (end-of-prev (save-excursion
+ (let ((end-of-prev (save-excursion
(goto-char (mh-beginning-of-word))
(mh-beginning-of-word -1))))
(cond ((not mh-compose-space-does-completion-flag)
@@ -889,7 +892,6 @@ downcasing the field name."
;;;###mh-autoload
(defun mh-complete-word (word choices begin end)
- ;; FIXME: Only needed when completion-at-point doesn't exist.
"Complete WORD from CHOICES.
Any match found replaces the text from BEGIN to END."
(let ((completion (try-completion word choices))
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index ba994e73a91..0327b64a33f 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -511,7 +511,7 @@ decoding the same message multiple times."
(when mh-decode-mime-flag
(save-excursion
(let ((buffer-read-only nil))
- (rfc2047-decode-region (progn (mh-goto-header-field "subject:") (point))
+ (rfc2047-decode-region (progn (mh-goto-header-field "Subject:") (point))
(progn (mh-header-field-end) (point)))))))
;;;###mh-autoload
@@ -835,7 +835,7 @@ being used to highlight the signature in a MIME part."
;;; Button Display
;; Shush compiler.
-(when (featurep 'xemacs)
+(mh-do-in-xemacs
(defvar dots)
(defvar type)
(defvar ov))
@@ -885,7 +885,8 @@ by commands like \"K v\" which operate on individual MIME parts."
;; Shush compiler.
(defvar mm-verify-function-alist) ; < Emacs 22
(defvar mm-decrypt-function-alist) ; < Emacs 22
-(defvar pressed-details) ; XEmacs
+(mh-do-in-xemacs
+ (defvar pressed-details))
(defun mh-insert-mime-security-button (handle)
"Display buttons for PGP message, HANDLE."
@@ -1637,8 +1638,8 @@ This action can be undone by running \\[undo]."
;; Do an alias lookup on recipients
(message-options-set 'message-recipients
(mapconcat
- '(lambda (ali)
- (mail-strip-quoted-names (mh-alias-expand ali)))
+ (lambda (ali)
+ (mail-strip-quoted-names (mh-alias-expand ali)))
(split-string (message-options-get 'message-recipients) "[, ]+")
", ")))
(let ((saved-text (buffer-string))
@@ -1689,19 +1690,19 @@ buffer, while END defaults to the end of the buffer."
(unless begin (setq begin (point-min)))
(unless end (setq end (point-max)))
(save-excursion
- (block 'search-for-mh-directive
+ (block search-for-mh-directive
(goto-char begin)
(while (re-search-forward "^#" end t)
(let ((s (buffer-substring-no-properties
(point) (mh-line-end-position))))
(cond ((equal s ""))
((string-match "^forw[ \t\n]+" s)
- (return-from 'search-for-mh-directive t))
+ (return-from search-for-mh-directive t))
(t (let ((first-token (car (split-string s "[ \t;@]"))))
(when (and first-token
(string-match mh-media-type-regexp
first-token))
- (return-from 'search-for-mh-directive t)))))))
+ (return-from search-for-mh-directive t)))))))
nil)))
(defun mh-minibuffer-read-type (filename &optional default)
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 656bcb65011..8a3e1632e2e 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -308,7 +308,7 @@ This column will have one of \" \", \"%\", \"-\", \"t\", \"c\", \"b\", or \"n\"
in it.
\" \" blank space is the default character.
- \"%\" indicates that the message in in a named MH sequence.
+ \"%\" indicates that the message in a named MH sequence.
\"-\" indicates that the message has been annotated with a replied field.
\"t\" indicates that the message contains mymbox in the To: field.
\"c\" indicates that the message contains mymbox in the Cc: field.
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index a90a26ab2a4..a547dd8d80a 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -321,7 +321,8 @@ folder containing the index search results."
count (> (hash-table-count msg-hash) 0)))))))
;; Shush compiler.
-(defvar pick-folder) ; XEmacs
+(mh-do-in-xemacs
+ (defvar pick-folder))
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
@@ -401,8 +402,9 @@ or nothing to search all folders."
(mh-index-sequenced-messages folders mh-tick-seq))
;; Shush compiler.
-(defvar mh-mairix-folder) ; XEmacs
-(defvar mh-flists-search-folders) ; XEmacs
+(mh-do-in-xemacs
+ (defvar mh-mairix-folder)
+ (defvar mh-flists-search-folders))
;;;###mh-autoload
(defun mh-index-sequenced-messages (folders sequence)
@@ -452,12 +454,12 @@ search all folders."
(defvar mh-flists-search-folders)
-(defun mh-flists-execute (&rest args)
+(defun mh-flists-execute (&rest ignored)
"Execute flists.
Search for messages belonging to `mh-flists-sequence' in the
folders specified by `mh-flists-search-folders'. If
`mh-recursive-folders-flag' is t, then the folders are searched
-recursively. All parameters ARGS are ignored."
+recursively. All arguments are IGNORED."
(set-buffer (get-buffer-create mh-temp-index-buffer))
(erase-buffer)
(unless (executable-find "sh")
@@ -1442,7 +1444,8 @@ being the list of messages originally from that folder."
mh-index-data)
;; Shush compiler
-(defvar mh-speed-flists-inhibit-flag) ; XEmacs
+(mh-do-in-xemacs
+ (defvar mh-speed-flists-inhibit-flag))
;;;###mh-autoload
(defun mh-index-execute-commands ()
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 145b689c6b9..fc3e5c08143 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -198,7 +198,8 @@ MESSAGE appears."
" "))))
;; Shush compiler.
-(defvar tool-bar-mode) ; XEmacs
+(mh-do-in-xemacs
+ (defvar tool-bar-mode))
(defvar tool-bar-map)
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 5c2f08cefe5..7b5593ba608 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -146,9 +146,7 @@ displayed."
(if (not clean-message-header)
(mh-start-of-uncleaned-message)))
(mh-display-msg msg folder)))
- (unless (if (fboundp 'window-full-height-p)
- (window-full-height-p)
- (= (1+ (window-height)) (frame-height))) ; not vertically split
+ (unless (mh-window-full-height-p) ; not vertically split
(shrink-window (- (window-height) (or mh-summary-height
(mh-summary-height)))))
(mh-recenter nil)
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index b782081c85c..5c3679e8ce6 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -126,9 +126,9 @@ With non-nil FORCE, the update is always carried out."
;; Otherwise on to your regular programming
(t t)))
-(defun mh-speed-toggle (&rest args)
+(defun mh-speed-toggle (&rest ignored)
"Toggle the display of child folders in the speedbar.
-The optional ARGS from speedbar are ignored."
+The optional arguments from speedbar are IGNORED."
(interactive)
(declare (ignore args))
(beginning-of-line)
@@ -165,9 +165,9 @@ The optional ARGS from speedbar are ignored."
(mh-line-beginning-position) (1+ (line-beginning-position))
`(mh-expanded t)))))))
-(defun mh-speed-view (&rest args)
+(defun mh-speed-view (&rest ignored)
"Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder].
-The optional ARGS from speedbar are ignored."
+The optional arguments from speedbar are IGNORED."
(interactive)
(declare (ignore args))
(let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder))
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 4394e1b1b22..6132af17dab 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -596,7 +596,6 @@ Expects FOLDER to have already been normalized with
(setq name (substring name 0 (1- (length name)))))
(push
(cons name
- ;; FIXME: what is this used for? --Stef
(search-forward "(others)" (mh-line-end-position) t))
results))))
(forward-line 1))))
@@ -732,8 +731,9 @@ See Info node `(elisp) Programmed Completion' for details."
(t (file-directory-p path))))))))
;; Shush compiler.
-(defvar completion-root-regexp) ; XEmacs
-(defvar minibuffer-completing-file-name) ; XEmacs
+(mh-do-in-xemacs
+ (defvar completion-root-regexp)
+ (defvar minibuffer-completing-file-name))
(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 027d79a948a..179b552d536 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -125,7 +125,8 @@ in this order is used."
(defun mh-face-to-png (data)
"Convert base64 encoded DATA to png image."
(with-temp-buffer
- (set-buffer-multibyte nil)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
(insert data)
(ignore-errors (base64-decode-region (point-min) (point-max)))
(buffer-string)))
@@ -133,7 +134,8 @@ in this order is used."
(defun mh-uncompface (data)
"Run DATA through `uncompface' to generate bitmap."
(with-temp-buffer
- (set-buffer-multibyte nil)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
(insert data)
(when (and mh-uncompface-executable
(equal (call-process-region (point-min) (point-max)
@@ -205,7 +207,7 @@ The directories are searched for in the order they appear in the list.")
(cond (cached-value (return-from mh-picon-get-image cached-value))
((not host-list) (return-from mh-picon-get-image nil)))
(setq match
- (block 'loop
+ (block loop
;; u@h search
(loop for dir in mh-picon-existing-directory-list
do (loop for type in mh-picon-image-types
@@ -213,15 +215,15 @@ The directories are searched for in the order they appear in the list.")
for file1 = (format "%s/%s.%s"
dir canonical-address type)
when (file-exists-p file1)
- do (return-from 'loop file1)
+ do (return-from loop file1)
;; [path]user
for file2 = (format "%s/%s.%s" dir user type)
when (file-exists-p file2)
- do (return-from 'loop file2)
+ do (return-from loop file2)
;; [path]host
for file3 = (format "%s/%s.%s" dir host type)
when (file-exists-p file3)
- do (return-from 'loop file3)))
+ do (return-from loop file3)))
;; facedb search
;; Search order for user@foo.net:
;; [path]net/foo/user
@@ -239,11 +241,11 @@ The directories are searched for in the order they appear in the list.")
do (loop for type in mh-picon-image-types
for z1 = (format "%s.%s" y type)
when (file-exists-p z1)
- do (return-from 'loop z1)
+ do (return-from loop z1)
for z2 = (format "%s/face.%s"
y type)
when (file-exists-p z2)
- do (return-from 'loop z2)))))))
+ do (return-from loop z2)))))))
(setf (gethash canonical-address mh-picon-cache)
(mh-picon-file-contents match)))))
@@ -271,7 +273,8 @@ file contents as a string is returned. If FILE is nil, then both
elements of the list are nil."
(if (stringp file)
(with-temp-buffer
- (set-buffer-multibyte nil)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
(let ((type (and (string-match ".*\\.\\(...\\)$" file)
(intern (match-string 1 file)))))
(insert-file-contents-literally file)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 41399f3f141..d62b377954d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -26,11 +26,15 @@
;; internal use only.
;; Functional completion tables have an extended calling conventions:
-;; - The `action' can be (additionally to nil, t, and lambda) of the form
-;; (boundaries . SUFFIX) in which case it should return
+;; The `action' can be (additionally to nil, t, and lambda) of the form
+;; - (boundaries . SUFFIX) in which case it should return
;; (boundaries START . END). See `completion-boundaries'.
;; Any other return value should be ignored (so we ignore values returned
;; from completion tables that don't know about this new `action' form).
+;; - `metadata' in which case it should return (metadata . ALIST) where
+;; ALIST is the metadata of this table. See `completion-metadata'.
+;; Any other return value should be ignored (so we ignore values returned
+;; from completion tables that don't know about this new `action' form).
;;; Bugs:
@@ -58,26 +62,16 @@
;;; Todo:
+;; - 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.
-;; - completion-insert-complete-hook (called after inserting a complete
-;; completion), typically used for "complete-abbrev" where it would expand
-;; the abbrev. Tho we'd probably want to provide it from the
-;; completion-table.
-;; - extend `boundaries' to provide various other meta-data about the
-;; output of `all-completions':
-;; - preferred sorting order when displayed in *Completions*.
-;; - annotations/text-properties to add when displayed in *Completions*.
+;; - 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.
-;; - completion hook to run when the completion is
-;; selected/inserted (maybe this should be provided some other
-;; way, e.g. as text-property, so `try-completion can also return it?)
-;; both for when it's inserted via TAB or via choose-completion.
;; - 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
@@ -87,18 +81,6 @@
;; \n into something else, add special boundaries between
;; completions). E.g. when completing from the kill-ring.
-;; - make partial-completion-mode obsolete:
-;; - (?) <foo.h> style completion for file names.
-;; This can't be done identically just by tweaking completion,
-;; because partial-completion-mode's behavior is to expand <string.h>
-;; to /usr/include/string.h only when exiting the minibuffer, at which
-;; point the completion code is actually not involved normally.
-;; Partial-completion-mode does it via a find-file-not-found-function.
-;; - special code for C-x C-f <> to visit the file ref'd at point
-;; via (require 'foo) or #include "foo". ffap seems like a better
-;; place for this feature (supplemented with major-mode-provided
-;; functions to find the file ref'd at point).
-
;; - case-sensitivity currently confuses two issues:
;; - whether or not a particular completion table should be case-sensitive
;; (i.e. whether strings that differ only by case are semantically
@@ -129,12 +111,41 @@ E.g. for simple completion tables, the result is always (0 . (length SUFFIX))
and for file names the result is the positions delimited by
the closest directory separators."
(let ((boundaries (if (functionp table)
- (funcall table string pred (cons 'boundaries suffix)))))
+ (funcall table string pred
+ (cons 'boundaries suffix)))))
(if (not (eq (car-safe boundaries) 'boundaries))
(setq boundaries nil))
(cons (or (cadr boundaries) 0)
(or (cddr boundaries) (length suffix)))))
+(defun completion-metadata (string table pred)
+ "Return the metadata of elements to complete at the end of STRING.
+This metadata is an alist. Currently understood keys are:
+- `category': the kind of objects returned by `all-completions'.
+ Used by `completion-category-overrides'.
+- `annotation-function': function to add annotations in *Completions*.
+ Takes one argument (STRING), which is a possible completion and
+ returns a string to append to STRING.
+- `display-sort-function': function to sort entries in *Completions*.
+ Takes one argument (COMPLETIONS) and should return a new list
+ of completions. Can operate destructively.
+- `cycle-sort-function': function to sort entries when cycling.
+ Works like `display-sort-function'.
+The metadata of a completion table should be constant between two boundaries."
+ (let ((metadata (if (functionp table)
+ (funcall table string pred 'metadata))))
+ (if (eq (car-safe metadata) 'metadata)
+ metadata
+ '(metadata))))
+
+(defun completion--field-metadata (field-start)
+ (completion-metadata (buffer-substring-no-properties field-start (point))
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+
+(defun completion-metadata-get (metadata prop)
+ (cdr (assq prop metadata)))
+
(defun completion--some (fun xs)
"Apply FUN to each element of XS in turn.
Return the first non-nil returned value.
@@ -156,8 +167,8 @@ PRED is a completion predicate.
ACTION can be one of nil, t or `lambda'."
(cond
((functionp table) (funcall table string pred action))
- ((eq (car-safe action) 'boundaries)
- (cons 'boundaries (completion-boundaries string table pred (cdr action))))
+ ((eq (car-safe action) 'boundaries) nil)
+ ((eq action 'metadata) nil)
(t
(funcall
(cond
@@ -178,7 +189,7 @@ The result of the `completion-table-dynamic' form is a function
that can be used as the COLLECTION argument to `try-completion' and
`all-completions'. See Info node `(elisp)Programmed Completion'."
(lambda (string pred action)
- (if (eq (car-safe action) 'boundaries)
+ (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
;; `fun' is not supposed to return another function but a plain old
;; completion table, whose boundaries are always trivial.
nil
@@ -283,18 +294,18 @@ instead of a string, a function that takes the completion and returns the
(funcall terminator comp)
(concat comp terminator))
comp))))
- ((eq action t)
+ ;; completion-table-with-terminator is always used for
+ ;; "sub-completions" so it's only called if the terminator is missing,
+ ;; in which case `test-completion' should return nil.
+ ((eq action 'lambda) nil)
+ (t
;; FIXME: We generally want the `try' and `all' behaviors to be
;; consistent so pcm can merge the `all' output to get the `try' output,
;; but that sometimes clashes with the need for `all' output to look
;; good in *Completions*.
;; (mapcar (lambda (s) (concat s terminator))
;; (all-completions string table pred))))
- (all-completions string table pred))
- ;; completion-table-with-terminator is always used for
- ;; "sub-completions" so it's only called if the terminator is missing,
- ;; in which case `test-completion' should return nil.
- ((eq action 'lambda) nil)))
+ (complete-with-action action table string pred))))
(defun completion-table-with-predicate (table pred1 strict string pred2 action)
"Make a completion table equivalent to TABLE but filtered through PRED1.
@@ -476,7 +487,34 @@ The available styles are listed in `completion-styles-alist'."
:group 'minibuffer
:version "23.1")
-(defun completion-try-completion (string table pred point)
+(defcustom completion-category-overrides
+ '((buffer (styles . (basic substring))))
+ "List of overrides for specific categories.
+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."
+ :type `(alist :key-type (choice (const buffer)
+ (const file)
+ symbol)
+ :value-type
+ (set
+ (cons (const style)
+ (repeat ,@(mapcar (lambda (x) (list 'const (car x)))
+ completion-styles-alist)))
+ (cons (const cycle)
+ (choice (const :tag "No cycling" nil)
+ (const :tag "Always cycle" t)
+ (integer :tag "Threshold"))))))
+
+(defun completion--styles (metadata)
+ (let* ((cat (completion-metadata-get metadata 'category))
+ (over (assq 'styles (cdr (assq cat completion-category-overrides)))))
+ (if over
+ (delete-dups (append (cdr over) (copy-sequence completion-styles)))
+ completion-styles)))
+
+(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.
@@ -487,9 +525,12 @@ a new position for point."
(completion--some (lambda (style)
(funcall (nth 1 (assq style completion-styles-alist))
string table pred point))
- completion-styles))
+ (completion--styles (or metadata
+ (completion-metadata
+ (substring string 0 point)
+ table pred)))))
-(defun completion-all-completions (string table pred point)
+(defun completion-all-completions (string table pred point &optional metadata)
"List the possible completions of STRING in completion table TABLE.
Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING.
@@ -500,7 +541,10 @@ in the last `cdr'."
(completion--some (lambda (style)
(funcall (nth 2 (assq style completion-styles-alist))
string table pred point))
- completion-styles))
+ (completion--styles (or metadata
+ (completion-metadata
+ (substring string 0 point)
+ table pred)))))
(defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0)
@@ -551,6 +595,11 @@ candidates than this number."
(const :tag "Always cycle" t)
(integer :tag "Threshold")))
+(defun completion--cycle-threshold (metadata)
+ (let* ((cat (completion-metadata-get metadata 'category))
+ (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
+ (if over (cdr over) completion-cycle-threshold)))
+
(defvar completion-all-sorted-completions nil)
(make-variable-buffer-local 'completion-all-sorted-completions)
(defvar completion-cycling nil)
@@ -562,7 +611,8 @@ candidates than this number."
(if completion-show-inline-help
(minibuffer-message msg)))
-(defun completion--do-completion (&optional try-completion-function)
+(defun completion--do-completion (&optional try-completion-function
+ expect-exact)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
@@ -576,16 +626,22 @@ E = after completion we now have an Exact match.
100 4 ??? impossible
101 5 ??? impossible
110 6 some completion happened
- 111 7 completed to an exact completion"
+ 111 7 completed to an exact completion
+
+TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
+EXPECT-EXACT, if non-nil, means that there is no need to tell the user
+when the buffer's text is already an exact match."
(let* ((beg (field-beginning))
(end (field-end))
(string (buffer-substring beg end))
+ (md (completion--field-metadata beg))
(comp (funcall (or try-completion-function
'completion-try-completion)
string
minibuffer-completion-table
minibuffer-completion-predicate
- (- (point) beg))))
+ (- (point) beg)
+ md)))
(cond
((null comp)
(minibuffer-hide-completions)
@@ -595,7 +651,9 @@ E = after completion we now have an Exact match.
(minibuffer--bitset nil nil nil))
((eq t comp)
(minibuffer-hide-completions)
- (goto-char (field-end))
+ (goto-char end)
+ (completion--done string 'finished
+ (unless expect-exact "Sole completion"))
(minibuffer--bitset nil nil t)) ;Exact and unique match.
(t
;; `completed' should be t if some completion was done, which doesn't
@@ -619,19 +677,20 @@ E = after completion we now have an Exact match.
;; whether this is a unique completion or not, so try again using
;; the real case (this shouldn't recurse again, because the next
;; time try-completion will return either t or the exact string).
- (completion--do-completion try-completion-function)
+ (completion--do-completion try-completion-function expect-exact)
;; It did find a match. Do we match some possibility exactly now?
- (let ((exact (test-completion completion
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ (let* ((exact (test-completion completion
+ 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.
- (when (and completion-cycle-threshold
+ (when (and threshold
;; Check that the completion didn't make
;; us jump to a different boundary.
(or (not completed)
@@ -648,7 +707,7 @@ E = after completion we now have an Exact match.
(not (ignore-errors
;; This signal an (intended) error if comps is too
;; short or if completion-cycle-threshold is t.
- (consp (nthcdr completion-cycle-threshold comps)))))
+ (consp (nthcdr threshold comps)))))
;; Fewer than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
@@ -658,7 +717,13 @@ E = after completion we now have an Exact match.
;; We could also decide to refresh the completions,
;; if they're displayed (and assuming there are
;; completions left).
- (minibuffer-hide-completions))
+ (minibuffer-hide-completions)
+ (if exact
+ ;; If completion did not put point at end of field,
+ ;; it's a sign that completion is not finished.
+ (completion--done completion
+ (if (< comp-pos (length completion))
+ 'exact 'unknown))))
;; Show the completion table, if requested.
((not exact)
(if (case completion-auto-help
@@ -669,8 +734,12 @@ E = after completion we now have an Exact match.
;; If the last exact completion and this one were the same, it
;; means we've already given a "Complete, but not unique" message
;; and the user's hit TAB again, so now we give him help.
- ((eq this-command last-command)
- (if completion-auto-help (minibuffer-completion-help))))
+ (t
+ (if (and (eq this-command last-command) completion-auto-help)
+ (minibuffer-completion-help))
+ (completion--done completion 'exact
+ (unless expect-exact
+ "Complete, but not unique"))))
(minibuffer--bitset completed t exact))))))))
@@ -705,10 +774,6 @@ scroll the window of possible completions."
t)
(t (case (completion--do-completion)
(#b000 nil)
- (#b001 (completion--message "Sole completion")
- t)
- (#b011 (completion--message "Complete, but not unique")
- t)
(t t)))))
(defun completion--flush-all-sorted-completions (&rest _ignore)
@@ -717,35 +782,45 @@ scroll the window of possible completions."
(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
+ ;; metadata at `base', which tends to trigger pathological behavior for old
+ ;; completion tables which don't understand `metadata'.
+ (let ((bounds (completion-boundaries string table pred "")))
+ (if (eq (car bounds) base) md-at-point
+ (completion-metadata (substring string 0 base) table pred))))
+
(defun completion-all-sorted-completions ()
(or completion-all-sorted-completions
(let* ((start (field-beginning))
(end (field-end))
- (all (completion-all-completions (buffer-substring start end)
- minibuffer-completion-table
- minibuffer-completion-predicate
- (- (point) start)))
+ (string (buffer-substring start end))
+ (md (completion--field-metadata start))
+ (all (completion-all-completions
+ string
+ minibuffer-completion-table
+ minibuffer-completion-predicate
+ (- (point) start)
+ md))
(last (last all))
- (base-size (or (cdr last) 0)))
+ (base-size (or (cdr last) 0))
+ (all-md (completion--metadata (buffer-substring-no-properties
+ start (point))
+ base-size md
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
(when last
(setcdr last nil)
- ;; Prefer shorter completions.
- (setq all (sort all (lambda (c1 c2)
- (let ((s1 (get-text-property
- 0 :completion-cycle-penalty c1))
- (s2 (get-text-property
- 0 :completion-cycle-penalty c2)))
- (if (eq s1 s2)
- (< (length c1) (length c2))
- (< (or s1 (length c1))
- (or s2 (length c2))))))))
+ (setq all (if sort-fun (funcall sort-fun all)
+ ;; Prefer shorter completions, by default.
+ (sort all (lambda (c1 c2) (< (length c1) (length c2))))))
;; Prefer recently used completions.
- ;; FIXME: Additional sorting ideas:
- ;; - for M-x, prefer commands that have no key binding.
- (let ((hist (symbol-value minibuffer-history-variable)))
- (setq all (sort all (lambda (c1 c2)
- (> (length (member c1 hist))
- (length (member c2 hist)))))))
+ (when (minibufferp)
+ (let ((hist (symbol-value minibuffer-history-variable)))
+ (setq all (sort all (lambda (c1 c2)
+ (> (length (member c1 hist))
+ (length (member c2 hist))))))))
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
@@ -763,14 +838,22 @@ Repeated uses step through the possible completions."
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
(let* ((start (field-beginning))
(end (field-end))
- (all (completion-all-sorted-completions)))
- (if (not (consp all))
+ ;; (md (completion--field-metadata start))
+ (all (completion-all-sorted-completions))
+ (base (+ start (or (cdr (last all)) 0))))
+ (cond
+ ((not (consp all))
(completion--message
- (if all "No more completions" "No completions"))
+ (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)))
+ (completion--done (buffer-substring-no-properties start (point))
+ 'finished (unless mod "Sole completion"))))
+ (t
(setq completion-cycling t)
- (goto-char end)
- (insert (car all))
- (delete-region (+ start (cdr (last all))) end)
+ (completion--replace base end (car all))
+ (completion--done (buffer-substring-no-properties start (point)) 'sole)
;; 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,
@@ -778,7 +861,7 @@ 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))))))
+ (setq completion-all-sorted-completions (cdr all)))))))
(defvar minibuffer-confirm-exit-commands
'(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word)
@@ -850,7 +933,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
(t
;; Call do-completion, but ignore errors.
(case (condition-case nil
- (completion--do-completion)
+ (completion--do-completion nil 'expect-exact)
(error 1))
((#b001 #b011) (exit-minibuffer))
(#b111 (if (not minibuffer-completion-confirm)
@@ -859,8 +942,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
nil))
(t nil))))))
-(defun completion--try-word-completion (string table predicate point)
- (let ((comp (completion-try-completion string table predicate point)))
+(defun completion--try-word-completion (string table predicate point md)
+ (let ((comp (completion-try-completion string table predicate point md)))
(if (not (consp comp))
comp
@@ -882,7 +965,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
(while (and exts (not (consp tem)))
(setq tem (completion-try-completion
(concat before (pop exts) after)
- table predicate (1+ point))))
+ table predicate (1+ point) md)))
(if (consp tem) (setq comp tem))))
;; Completing a single word is actually more difficult than completing
@@ -954,10 +1037,6 @@ Return nil if there is no valid completion, else t."
(interactive)
(case (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
- (#b001 (completion--message "Sole completion")
- t)
- (#b011 (completion--message "Complete, but not unique")
- t)
(t t)))
(defface completions-annotations '((t :inherit italic))
@@ -1157,6 +1236,21 @@ the completions buffer."
(run-hooks 'completion-setup-hook)))
nil)
+(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.
+`: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.")
+
(defvar completion-annotate-function
nil
;; Note: there's a lot of scope as for when to add annotations and
@@ -1173,6 +1267,27 @@ 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 table and predicates via `minibuffer-completion-table' and related
variables.")
+(make-obsolete-variable 'completion-annotate-function
+ 'completion-extra-properties "24.1")
+
+(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.
+ (when exit-fun
+ (when (eq finished 'unknown)
+ (setq finished
+ (if (eq (try-completion string
+ minibuffer-completion-table
+ minibuffer-completion-predicate)
+ t)
+ 'finished 'exact)))
+ (funcall exit-fun string finished))
+ (when (and message
+ ;; Don't output any message if the exit-fun already did so.
+ (equal pre-msg (and exit-fun (current-message))))
+ (completion--message message))))
(defun minibuffer-completion-help ()
"Display a list of possible completions of the current minibuffer contents."
@@ -1181,50 +1296,97 @@ variables.")
(let* ((start (field-beginning))
(end (field-end))
(string (field-string))
+ (md (completion--field-metadata start))
(completions (completion-all-completions
string
minibuffer-completion-table
minibuffer-completion-predicate
- (- (point) (field-beginning)))))
+ (- (point) (field-beginning))
+ md)))
(message nil)
- (if (and completions
- (or (consp (cdr completions))
- (not (equal (car completions) string))))
- (let* ((last (last completions))
- (base-size (cdr last))
- ;; If the *Completions* buffer is shown in a new
- ;; window, mark it as softly-dedicated, so bury-buffer in
- ;; minibuffer-hide-completions will know whether to
- ;; delete the window or not.
- (display-buffer-mark-dedicated 'soft))
- (with-output-to-temp-buffer "*Completions*"
- ;; Remove the base-size tail because `sort' requires a properly
- ;; nil-terminated list.
- (when last (setcdr last nil))
- (setq completions (sort completions 'string-lessp))
- (when completion-annotate-function
- (setq completions
- (mapcar (lambda (s)
- (let ((ann
- (funcall completion-annotate-function s)))
- (if ann (list s ann) s)))
- completions)))
- (with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
- (list (+ start base-size)
- ;; FIXME: We should pay attention to completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give us the
- ;; necessary information.
- end)))
- (display-completion-list completions)))
-
- ;; If there are no completions, or if the current input is already the
- ;; only possible completion, then hide (previous&stale) completions.
- (minibuffer-hide-completions)
- (ding)
- (minibuffer-message
- (if completions "Sole completion" "No completions")))
+ (if (or (null completions)
+ (and (not (consp (cdr completions)))
+ (equal (car completions) string)))
+ (progn
+ ;; If there are no completions, or if the current input is already
+ ;; the sole completion, then hide (previous&stale) completions.
+ (minibuffer-hide-completions)
+ (ding)
+ (minibuffer-message
+ (if completions "Sole completion" "No completions")))
+
+ (let* ((last (last completions))
+ (base-size (cdr last))
+ (prefix (unless (zerop base-size) (substring string 0 base-size)))
+ (all-md (completion--metadata (buffer-substring-no-properties
+ start (point))
+ base-size md
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (afun (or (completion-metadata-get all-md 'annotation-function)
+ (plist-get completion-extra-properties
+ :annotation-function)
+ completion-annotate-function))
+ ;; If the *Completions* buffer is shown in a new
+ ;; window, mark it as softly-dedicated, so bury-buffer in
+ ;; minibuffer-hide-completions will know whether to
+ ;; delete the window or not.
+ (display-buffer-mark-dedicated 'soft))
+ (with-output-to-temp-buffer "*Completions*"
+ ;; Remove the base-size tail because `sort' requires a properly
+ ;; nil-terminated list.
+ (when last (setcdr last nil))
+ (setq completions
+ ;; FIXME: This function is for the output of all-completions,
+ ;; not completion-all-completions. Often it's the same, but
+ ;; not always.
+ (let ((sort-fun (completion-metadata-get
+ all-md 'display-sort-function)))
+ (if sort-fun
+ (funcall sort-fun completions)
+ (sort completions 'string-lessp))))
+ (when afun
+ (setq completions
+ (mapcar (lambda (s)
+ (let ((ann (funcall afun s)))
+ (if ann (list s ann) s)))
+ completions)))
+
+ (with-current-buffer standard-output
+ (set (make-local-variable 'completion-base-position)
+ (list (+ start base-size)
+ ;; FIXME: We should pay attention to completion
+ ;; boundaries here, but currently
+ ;; completion-all-completions does not give us the
+ ;; necessary information.
+ end))
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ (let ((ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties))
+ (lambda (start end choice)
+ (unless (or (zerop (length prefix))
+ (equal prefix
+ (buffer-substring-no-properties
+ (max (point-min)
+ (- start (length prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator here.
+ (completion--replace start end choice)
+ (let* ((minibuffer-completion-table ctable)
+ (minibuffer-completion-predicate cpred)
+ (completion-extra-properties cprops)
+ (result (concat prefix choice))
+ (bounds (completion-boundaries
+ result ctable cpred "")))
+ ;; If the completion introduces a new field, then
+ ;; completion is not finished.
+ (completion--done result
+ (if (eq (car bounds) (length result))
+ 'exact 'finished)))))))
+
+ (display-completion-list completions))))
nil))
(defun minibuffer-hide-completions ()
@@ -1280,7 +1442,9 @@ we entered `completion-in-region-mode'.")
(defun completion-in-region (start end collection &optional predicate)
"Complete the text between START and END using COLLECTION.
Return nil if there is no valid completion, else t.
-Point needs to be somewhere between START and END."
+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))
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
@@ -1364,14 +1528,21 @@ or a list of the form (START END COLLECTION &rest 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:
- `:predicate' a predicate that completion candidates need to satisfy.
- `:annotation-function' the value to use for `completion-annotate-function'.")
+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.")
(defvar completion--capf-misbehave-funs nil
- "List of functions found on `completion-at-point-functions' that misbehave.")
+ "List of functions found on `completion-at-point-functions' that misbehave.
+These are functions that neither return completion data nor a completion
+function but instead perform completion right away.")
(defvar completion--capf-safe-funs nil
- "List of well-behaved functions found on `completion-at-point-functions'.")
+ "List of well-behaved functions found on `completion-at-point-functions'.
+These are functions which return proper completion data rather than
+a completion function or god knows what else.")
(defun completion--capf-wrapper (fun which)
;; FIXME: The safe/misbehave handling assumes that a given function will
@@ -1384,9 +1555,23 @@ Currently supported properties are:
(optimist (not (member fun completion--capf-misbehave-funs))))
(let ((res (funcall fun)))
(cond
- ((consp res)
+ ((and (consp res) (not (functionp res)))
(unless (member fun completion--capf-safe-funs)
- (push fun completion--capf-safe-funs)))
+ (push fun completion--capf-safe-funs))
+ (and (eq 'no (plist-get (nthcdr 3 res) :exclusive))
+ ;; FIXME: Here we'd need to decide whether there are
+ ;; valid completions against the current text. But this depends
+ ;; on the actual completion UI (e.g. with the default completion
+ ;; it depends on completion-style) ;-(
+ ;; We approximate this result by checking whether prefix
+ ;; completion might work, which means that non-prefix completion
+ ;; will not work (or not right) for completion functions that
+ ;; are non-exclusive.
+ (null (try-completion (buffer-substring-no-properties
+ (car res) (point))
+ (nth 2 res)
+ (plist-get (nthcdr 3 res) :predicate)))
+ (setq res nil)))
((not (or (listp res) (functionp res)))
(unless (member fun completion--capf-misbehave-funs)
(message
@@ -1403,9 +1588,7 @@ The completion method is determined by `completion-at-point-functions'."
(pcase res
(`(,_ . ,(and (pred functionp) f)) (funcall f))
(`(,hookfun . (,start ,end ,collection . ,plist))
- (let* ((completion-annotate-function
- (or (plist-get plist :annotation-function)
- completion-annotate-function))
+ (let* ((completion-extra-properties plist)
(completion-in-region-mode-predicate
(lambda ()
;; We're still in the same completion field.
@@ -1428,9 +1611,7 @@ The completion method is determined by `completion-at-point-functions'."
(`(,hookfun . (,start ,end ,collection . ,plist))
(let* ((minibuffer-completion-table collection)
(minibuffer-completion-predicate (plist-get plist :predicate))
- (completion-annotate-function
- (or (plist-get plist :annotation-function)
- completion-annotate-function))
+ (completion-extra-properties plist)
(completion-in-region-mode-predicate
(lambda ()
;; We're still in the same completion field.
@@ -1455,36 +1636,77 @@ The completion method is determined by `completion-at-point-functions'."
;;; Key bindings.
-(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
- 'minibuffer-local-filename-must-match-map "23.1")
-
(let ((map minibuffer-local-map))
(define-key map "\C-g" 'abort-recursive-edit)
(define-key map "\r" 'exit-minibuffer)
(define-key map "\n" 'exit-minibuffer))
-(let ((map minibuffer-local-completion-map))
- (define-key map "\t" 'minibuffer-complete)
- ;; M-TAB is already abused for many other purposes, so we should find
- ;; another binding for it.
- ;; (define-key map "\e\t" 'minibuffer-force-complete)
- (define-key map " " 'minibuffer-complete-word)
- (define-key map "?" 'minibuffer-completion-help))
+(defvar minibuffer-local-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" 'minibuffer-complete)
+ ;; M-TAB is already abused for many other purposes, so we should find
+ ;; another binding for it.
+ ;; (define-key map "\e\t" 'minibuffer-force-complete)
+ (define-key map " " 'minibuffer-complete-word)
+ (define-key map "?" 'minibuffer-completion-help)
+ map)
+ "Local keymap for minibuffer input with completion.")
-(let ((map minibuffer-local-must-match-map))
- (define-key map "\r" 'minibuffer-complete-and-exit)
- (define-key map "\n" 'minibuffer-complete-and-exit))
+(defvar minibuffer-local-must-match-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ (define-key map "\r" 'minibuffer-complete-and-exit)
+ (define-key map "\n" 'minibuffer-complete-and-exit)
+ map)
+ "Local keymap for minibuffer input with completion, for exact match.")
-(let ((map minibuffer-local-filename-completion-map))
- (define-key map " " nil))
-(let ((map minibuffer-local-filename-must-match-map))
- (define-key map " " nil))
+(defvar minibuffer-local-filename-completion-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map " " nil)
+ map)
+ "Local keymap for minibuffer input with completion for filenames.
+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")
(let ((map minibuffer-local-ns-map))
(define-key map " " 'exit-minibuffer)
(define-key map "\t" 'exit-minibuffer)
(define-key map "?" 'self-insert-and-exit))
+(defvar minibuffer-inactive-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map "e" 'find-file-other-frame)
+ (define-key map "f" 'find-file-other-frame)
+ (define-key map "b" 'switch-to-buffer-other-frame)
+ (define-key map "i" 'info)
+ (define-key map "m" 'mail)
+ (define-key map "n" 'make-frame)
+ (define-key map [mouse-1] (lambda () (interactive)
+ (with-current-buffer "*Messages*"
+ (goto-char (point-max))
+ (display-buffer (current-buffer)))))
+ ;; So the global down-mouse-1 binding doesn't clutter the execution of the
+ ;; above mouse-1 binding.
+ (define-key map [down-mouse-1] #'ignore)
+ map)
+ "Keymap for use in the minibuffer when it is not active.
+The non-mouse bindings in this keymap can only be used in minibuffer-only
+frames, since the minibuffer can normally not be selected when it is
+not active.")
+
+(define-derived-mode minibuffer-inactive-mode nil "InactiveMinibuffer"
+ :abbrev-table nil ;abbrev.el is not loaded yet during dump.
+ ;; Note: this major mode is called from minibuf.c.
+ "Major mode to use in the minibuffer when it is not active.
+This is only used when the minibuffer area has no active minibuffer.")
+
;;; Completion tables.
(defun minibuffer--double-dollars (str)
@@ -1518,8 +1740,8 @@ same as `substitute-in-file-name'."
;; other table that provides the "main" completion. Let the
;; other table handle the test-completion case.
nil)
- ((eq (car-safe action) 'boundaries)
- ;; Only return boundaries if there's something to complete,
+ ((or (eq (car-safe action) 'boundaries) (eq action 'metadata))
+ ;; Only return boundaries/metadata if there's something to complete,
;; since otherwise when we're used in
;; completion-table-in-turn, we could return boundaries and
;; let some subsequent table return a list of completions.
@@ -1529,11 +1751,13 @@ same as `substitute-in-file-name'."
(when (try-completion (substring string beg) table nil)
;; Compute the boundaries of the subfield to which this
;; completion applies.
- (let ((suffix (cdr action)))
- (list* 'boundaries
- (or (match-beginning 2) (match-beginning 1))
- (when (string-match "[^[:alnum:]_]" suffix)
- (match-beginning 0))))))
+ (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)))))))
(t
(if (eq (aref string (1- beg)) ?{)
(setq table (apply-partially 'completion-table-with-terminator
@@ -1548,6 +1772,7 @@ same as `substitute-in-file-name'."
"Completion table for file names."
(ignore-errors
(cond
+ ((eq action 'metadata) '(metadata (category . file)))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
(end (string-match-p "/" (cdr action))))
@@ -1768,6 +1993,15 @@ and `read-file-name-function'."
(funcall (or read-file-name-function #'read-file-name-default)
prompt dir default-filename mustmatch initial predicate))
+;; 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.
+;; FIXME: Actually, it is also used in rfn-eshadow.el we'd otherwise have to
+;; 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)
+
(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
"Default method for reading file names.
See `read-file-name' for the meaning of the arguments."
@@ -2029,7 +2263,7 @@ from lowercase to uppercase characters).")
(defun completion-pcm--prepare-delim-re (delims)
(setq completion-pcm--delim-wild-regex (concat "[" delims "*]")))
-(defcustom completion-pcm-word-delimiters "-_./: "
+(defcustom completion-pcm-word-delimiters "-_./:| "
"A string of characters treated as word delimiters for completion.
Some arcane rules:
If `]' is in this string, it must come first.
@@ -2138,7 +2372,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
(case-fold-search completion-ignore-case)
(completion-regexp-list (cons regex completion-regexp-list))
(compl (all-completions
- (concat prefix (if (stringp (car pattern)) (car pattern) ""))
+ (concat prefix
+ (if (stringp (car pattern)) (car pattern) ""))
table pred)))
(if (not (functionp table))
;; The internal functions already obeyed completion-regexp-list.
@@ -2236,13 +2471,14 @@ filter out additional entries (because TABLE migth not obey PRED)."
(- (length newbeforepoint)
(car newbounds)))))
(dolist (submatch suball)
- (setq all (nconc (mapcar
- (lambda (s) (concat submatch between s))
- (funcall filter
- (completion-pcm--all-completions
- (concat subprefix submatch between)
- pattern table pred)))
- all)))
+ (setq all (nconc
+ (mapcar
+ (lambda (s) (concat submatch between s))
+ (funcall filter
+ (completion-pcm--all-completions
+ (concat subprefix submatch between)
+ pattern table pred)))
+ all)))
;; FIXME: This can come in handy for try-completion,
;; but isn't right for all-completions, since it lists
;; invalid completions.
@@ -2489,7 +2725,49 @@ filter out additional entries (because TABLE migth not obey PRED)."
(let ((newstr (completion-initials-expand string table pred)))
(when newstr
(completion-pcm-try-completion newstr table pred (length newstr)))))
-
+
+(defvar completing-read-function 'completing-read-default
+ "The function called by `completing-read' to do its work.
+It should accept the same arguments as `completing-read'.")
+
+(defun completing-read-default (prompt collection &optional predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ "Default method for reading from the minibuffer with completion.
+See `completing-read' for the meaning of the arguments."
+
+ (when (consp initial-input)
+ (setq initial-input
+ (cons (car initial-input)
+ ;; `completing-read' uses 0-based index while
+ ;; `read-from-minibuffer' uses 1-based index.
+ (1+ (cdr initial-input)))))
+
+ (let* ((minibuffer-completion-table collection)
+ (minibuffer-completion-predicate predicate)
+ (minibuffer-completion-confirm (unless (eq require-match t)
+ require-match))
+ (base-keymap (if require-match
+ minibuffer-local-must-match-map
+ minibuffer-local-completion-map))
+ (keymap (if (memq minibuffer-completing-file-name '(nil lambda))
+ base-keymap
+ ;; Layer minibuffer-local-filename-completion-map
+ ;; on top of the base map.
+ ;; Use make-composed-keymap so that set-keymap-parent
+ ;; doesn't modify minibuffer-local-filename-completion-map.
+ (let ((map (make-composed-keymap
+ minibuffer-local-filename-completion-map)))
+ ;; Set base-keymap as the parent, so that nil bindings
+ ;; in minibuffer-local-filename-completion-map can
+ ;; override bindings in base-keymap.
+ (set-keymap-parent map base-keymap)
+ map)))
+ (result (read-from-minibuffer prompt initial-input keymap
+ nil hist def inherit-input-method)))
+ (when (and (equal result "") def)
+ (setq result (if (consp def) (car def) def)))
+ result))
;; Miscellaneous
diff --git a/lisp/misc.el b/lisp/misc.el
index e50b5b38c75..8087c7f5259 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -151,6 +151,7 @@ Internal use only."
(vector (list "Library" (1+ max-id-len) t)
(list "Loaded from" (1+ max-name-len) t)
(list "Candidate names" 0 t))))
+ (tabulated-list-init-header)
(setq tabulated-list-entries nil)
(dolist (lib dynamic-library-alist)
(let* ((id (car lib))
@@ -178,7 +179,6 @@ The return value is always nil."
(tabulated-list-mode)
(setq tabulated-list-sort-key (cons "Library" nil))
(add-hook 'tabulated-list-revert-hook 'list-dynamic-libraries--refresh nil t)
- (tabulated-list-init-header)
(setq list-dynamic-libraries--loaded-only-p loaded-only-p)
(list-dynamic-libraries--refresh)
(tabulated-list-print))
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index 1f601377ad4..50d221b6fa0 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -202,14 +202,10 @@ If nil, point will always be placed at the beginning of the region."
With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
Returns the new status of Mouse Sel mode (non-nil means on).
-When Mouse Sel mode is enabled, mouse selection is enhanced in various ways:
+When Mouse Sel mode is enabled, mouse selection is enhanced in
+various ways:
-- Clicking mouse-1 starts (cancels) selection, dragging extends it.
-
-- Clicking or dragging mouse-3 extends the selection as well.
-
-- Double-clicking on word constituents selects words.
-Double-clicking on symbol constituents selects symbols.
+- 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.
@@ -224,14 +220,8 @@ mouse-sel sets the variables `interprogram-cut-function' and
- Clicking mouse-2 inserts the contents of the primary selection at
the mouse position (or point, if `mouse-yank-at-point' is non-nil).
-- Pressing mouse-2 while selecting or extending copies selection
-to the kill ring. Pressing mouse-1 or mouse-3 kills it.
-
-- Double-clicking mouse-3 also kills selection.
-
-- M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
-& mouse-3, but operate on the X secondary selection rather than the
-primary selection and region."
+- mouse-2 while selecting or extending copies selection to the
+kill ring; mouse-1 or mouse-3 kills it."
:global t
:group 'mouse-sel
(if mouse-sel-mode
@@ -286,8 +276,17 @@ primary selection and region."
(setq mouse-secondary-overlay (make-overlay 1 1))
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))
+(defconst mouse-sel-primary-overlay
+ (let ((ol (make-overlay (point-min) (point-min))))
+ (delete-overlay ol)
+ (overlay-put ol 'face 'region)
+ ol)
+ "An overlay which records the current primary selection.
+This is used by Mouse Sel mode only.")
+
(defconst mouse-sel-selection-alist
- '((SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
+ '((PRIMARY mouse-sel-primary-overlay mouse-sel-primary-thing)
+ (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
"Alist associating selections with variables.
Each element is of the form:
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 124f84d7d73..63395619f44 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -278,7 +278,7 @@ The contents are the items that would be in the menu bar whether or
not it is actually displayed."
(interactive "@e \nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu (mouse-menu-bar-map) event prefix))
+ (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)
@@ -687,7 +687,9 @@ This should be bound to a mouse click event type."
(defun mouse-set-region (click)
"Set the region to the text dragged over, and copy to kill ring.
-This should be bound to a mouse drag event."
+This should be bound to a mouse drag event.
+See the `mouse-drag-copy-region' variable to control whether this
+command alters the kill ring or not."
(interactive "e")
(mouse-minibuffer-check click)
(select-window (posn-window (event-start click)))
@@ -790,18 +792,9 @@ remains active. Otherwise, it remains until the next input event.
If the click is in the echo area, display the `*Messages*' buffer."
(interactive "e")
- (let ((w (posn-window (event-start start-event))))
- (if (and (window-minibuffer-p w)
- (not (minibuffer-window-active-p w)))
- (save-excursion
- ;; Swallow the up-event.
- (read-event)
- (set-buffer (get-buffer-create "*Messages*"))
- (goto-char (point-max))
- (display-buffer (current-buffer)))
- ;; Give temporary modes such as isearch a chance to turn off.
- (run-hooks 'mouse-leave-buffer-hook)
- (mouse-drag-track start-event t))))
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (mouse-drag-track start-event t))
(defun mouse-posn-property (pos property)
@@ -2101,17 +2094,19 @@ choose a font."
(global-set-key [double-mouse-1] 'mouse-set-point)
(global-set-key [triple-mouse-1] 'mouse-set-point)
-;; Clicking on the fringes causes hscrolling:
-(global-set-key [left-fringe mouse-1] 'mouse-set-point)
-(global-set-key [right-fringe mouse-1] 'mouse-set-point)
+(defun mouse--strip-first-event (_prompt)
+ (substring (this-single-command-raw-keys) 1))
+
+(define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event)
+(define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event)
(global-set-key [mouse-2] 'mouse-yank-primary)
;; Allow yanking also when the corresponding cursor is "in the fringe".
-(global-set-key [right-fringe mouse-2] 'mouse-yank-at-click)
-(global-set-key [left-fringe mouse-2] 'mouse-yank-at-click)
+(define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event)
(global-set-key [mouse-3] 'mouse-save-then-kill)
-(global-set-key [right-fringe mouse-3] 'mouse-save-then-kill)
-(global-set-key [left-fringe mouse-3] 'mouse-save-then-kill)
+(define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event)
;; By binding these to down-going events, we let the user use the up-going
;; event to make the selection, saving a click.
diff --git a/lisp/mpc.el b/lisp/mpc.el
index b1e4d860cca..5319ea43898 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1318,7 +1318,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(setq count before)
(setq dir -1))
(goto-char start)
- (dotimes (i (1+ (or count 0)))
+ (dotimes (_i (1+ (or count 0)))
(mpc-select-make-overlay)
(forward-line dir))))))
(when mpc-tag
@@ -2114,12 +2114,12 @@ This is used so that they can be compared with `eq', which is needed for
(let ((context-before '())
(context-after '()))
(save-excursion
- (dotimes (i size)
+ (dotimes (_i size)
(when (re-search-backward "^[0-9]+:\\(.*\\)" nil t)
(push (mpc-songs-hashcons (match-string 1)) context-before))))
;; Skip the actual current song.
(forward-line 1)
- (dotimes (i size)
+ (dotimes (_i size)
(when (re-search-forward "^[0-9]+:\\(.*\\)" nil t)
(push (mpc-songs-hashcons (match-string 1)) context-after)))
;; If there isn't `size' context, then return nil.
diff --git a/lisp/msb.el b/lisp/msb.el
index cbc953da98e..12e5a0192fe 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -315,7 +315,7 @@ No buffers at all if less than 1 or nil (or any non-number)."
:set 'msb-custom-set
:group 'msb)
-(defvar msb-horizontal-shift-function '(lambda () 0)
+(defvar msb-horizontal-shift-function (lambda () 0)
"*Function that specifies how many pixels to shift the top menu leftwards.")
(defcustom msb-display-invisible-buffers-p nil
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 53d58a70d29..41716dbdacd 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1723,11 +1723,12 @@ good, skip, fatal, or unknown."
;;; Temporary file location and deletion...
;;; ------------------------------------------------------------
-(defun ange-ftp-make-tmp-name (host)
+(defun ange-ftp-make-tmp-name (host &optional suffix)
"This routine will return the name of a new file."
(make-temp-file (if (ange-ftp-use-gateway-p host)
ange-ftp-gateway-tmp-name-template
- ange-ftp-tmp-name-template)))
+ ange-ftp-tmp-name-template)
+ nil suffix))
(defun ange-ftp-del-tmp-name (filename)
"Force to delete temporary file."
@@ -2806,6 +2807,19 @@ match subdirectories as well.")
(and files (puthash (file-name-as-directory directory)
files ange-ftp-files-hashtable)))
+(defun ange-ftp-switches-ok (switches)
+ "Return SWITCHES (a string) if suitable for our use."
+ (and (stringp switches)
+ ;; We allow the A switch, which lists all files except "." and
+ ;; "..". This is OK because we manually insert these entries
+ ;; in the hash table.
+ (string-match
+ "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" switches)
+ (string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches)
+ (not (string-match
+ "--recursive\\>\\|\\(\\`\\| \\)-[[:alpha:]]*R" switches))
+ switches))
+
(defun ange-ftp-get-files (directory &optional no-error)
"Given a DIRECTORY, return a hashtable of file entries.
This will give an error or return nil, depending on the value of
@@ -2817,30 +2831,12 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
;; This is an efficiency hack. We try to
;; anticipate what sort of listing dired
;; might want, and cache just such a listing.
- (if (and (boundp 'dired-actual-switches)
- (stringp dired-actual-switches)
- ;; We allow the A switch, which lists
- ;; all files except "." and "..".
- ;; This is OK because we manually
- ;; insert these entries
- ;; in the hash table.
- (string-match
- "[aA]" dired-actual-switches)
- (string-match
- "l" dired-actual-switches)
- (not (string-match
- "R" dired-actual-switches)))
- dired-actual-switches
- (if (and (boundp 'dired-listing-switches)
- (stringp dired-listing-switches)
- (string-match
- "[aA]" dired-listing-switches)
- (string-match
- "l" dired-listing-switches)
- (not (string-match
- "R" dired-listing-switches)))
- dired-listing-switches
- "-al"))
+ (or (and (boundp 'dired-actual-switches)
+ (ange-ftp-switches-ok dired-actual-switches))
+ (and (boundp 'dired-listing-switches)
+ (ange-ftp-switches-ok
+ dired-listing-switches))
+ "-al")
t no-error)
(gethash directory ange-ftp-files-hashtable)))))
@@ -3283,6 +3279,7 @@ system TYPE.")
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
(binary (ange-ftp-binary-file filename))
+ (buffer-file-type buffer-file-type)
(abbr (ange-ftp-abbreviate-filename filename))
(coding-system-used last-coding-system-used)
size)
@@ -4143,7 +4140,8 @@ directory, so that Emacs will know its current contents."
(let* ((fn1 (expand-file-name file))
(pa1 (ange-ftp-ftp-name fn1)))
(if pa1
- (let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
+ (let ((tmp1 (ange-ftp-make-tmp-name (car pa1)
+ (file-name-extension file t))))
(ange-ftp-copy-file-internal fn1 tmp1 t nil
(format "Getting %s" fn1))
tmp1))))
@@ -5448,7 +5446,7 @@ Other orders of $ and _ seem to all work just fine.")
;; base-versions
;; (file-name-directory fn)))
;; (versions (mapcar
-;; '(lambda (arg)
+;; (lambda (arg)
;; (if (and (string-match
;; "[0-9]+$" arg bv-length)
;; (= (match-beginning 0) bv-length))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index c1ec3f0ed13..e18b42a275f 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -214,13 +214,7 @@
;;;###autoload
(defcustom browse-url-browser-function
- (cond
- ((memq system-type '(windows-nt ms-dos cygwin))
- 'browse-url-default-windows-browser)
- ((memq system-type '(darwin))
- 'browse-url-default-macosx-browser)
- (t
- 'browse-url-default-browser))
+ 'browse-url-default-browser
"Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
@@ -322,7 +316,7 @@ Defaults to the value of `browse-url-mozilla-arguments' at the time
:group 'browse-url)
(defcustom browse-url-firefox-program
- (let ((candidates '("firefox" "iceweasel")))
+ (let ((candidates '("firefox" "iceweasel" "icecat")))
(while (and candidates (not (executable-find (car candidates))))
(setq candidates (cdr candidates)))
(or (car candidates) "firefox"))
@@ -908,12 +902,13 @@ a random existing one. A non-nil interactive prefix argument reverses
the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-The order attempted is gnome-moz-remote, Mozilla, Firefox,
-Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
+used instead of `browse-url-new-window-flag'."
(apply
(cond
+ ((memq system-type '(windows-nt ms-dos cygwin))
+ 'browse-url-default-windows-browser)
+ ((memq system-type '(darwin))
+ 'browse-url-default-macosx-browser)
((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
@@ -958,7 +953,7 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
;;;###autoload
(defun browse-url-xdg-open (url &optional new-window)
(interactive (browse-url-interactive-arg "URL: "))
- (call-process "nohup" nil nil nil "xdg-open" url))
+ (call-process "xdg-open" nil 0 nil url))
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 05c7af2a8c3..87af3d13591 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -121,7 +121,7 @@ See `dbus-registered-objects-table' for a description of the
hash table."
(let (result)
(maphash
- '(lambda (key value) (add-to-list 'result (cons key value) 'append))
+ (lambda (key value) (add-to-list 'result (cons key value) 'append))
dbus-registered-objects-table)
result))
@@ -271,20 +271,20 @@ usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
;; 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)))))
+ (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
@@ -825,15 +825,15 @@ be \"out\"."
(setq direction nil))
;; Collect the signatures.
(mapconcat
- '(lambda (x)
- (let ((arg (dbus-introspect-get-argument
- bus service path interface name x)))
- (if (or (not (stringp direction))
- (string-equal
- direction
- (dbus-introspect-get-attribute arg "direction")))
- (dbus-introspect-get-attribute arg "type")
- "")))
+ (lambda (x)
+ (let ((arg (dbus-introspect-get-argument
+ bus service path interface name x)))
+ (if (or (not (stringp direction))
+ (string-equal
+ direction
+ (dbus-introspect-get-attribute arg "direction")))
+ (dbus-introspect-get-attribute arg "type")
+ "")))
(dbus-introspect-get-argument-names bus service path interface name)
"")))
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index df3a2e04118..87ff0b4060f 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -44,7 +44,7 @@ If SILENT is non-nil then the created BBDB record is not displayed."
;; This function runs in a special context where lisp symbols corresponding
;; to field names in record are bound to the corresponding values
(eval
- `(let* (,@(mapcar '(lambda (c)
+ `(let* (,@(mapcar (lambda (c)
(list (car c) (if (listp (cdr c))
(list 'quote (cdr c))
(cdr c))))
@@ -108,7 +108,7 @@ If RECURSE is non-nil then SPEC may be a list of atomic specs."
(void-variable nil)))
((and recurse
(listp spec))
- (mapcar '(lambda (spec-elem)
+ (mapcar (lambda (spec-elem)
(eudc-parse-spec spec-elem record nil))
spec))
(t
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index fd0c56ed693..64b2d34af9c 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -89,7 +89,7 @@ These are the special commands of this mode:
"------" gap "--------\n"
"\n")
(setq eudc-hotlist-list-beginning (point))
- (mapc '(lambda (entry)
+ (mapc (lambda (entry)
(insert (car entry))
(indent-to proto-col)
(insert (symbol-name (cdr entry)) "\n"))
@@ -103,7 +103,7 @@ These are the special commands of this mode:
(error "Not in a EUDC hotlist edit buffer"))
(let ((server (read-from-minibuffer "Server: "))
(protocol (completing-read "Protocol: "
- (mapcar '(lambda (elt)
+ (mapcar (lambda (elt)
(cons (symbol-name elt)
elt))
eudc-known-protocols)))
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 8616c805f41..6f4d5b2bbda 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -351,12 +351,12 @@ accordingly. Otherwise it is set to its EUDC default binding"
The translation is done according to
`eudc-protocol-attributes-translation-alist'."
(if eudc-protocol-attributes-translation-alist
- (mapcar '(lambda (attribute)
- (let ((trans (assq (car attribute)
- (symbol-value eudc-protocol-attributes-translation-alist))))
- (if trans
- (cons (cdr trans) (cdr attribute))
- attribute)))
+ (mapcar (lambda (attribute)
+ (let ((trans (assq (car attribute)
+ (symbol-value eudc-protocol-attributes-translation-alist))))
+ (if trans
+ (cons (cdr trans) (cdr attribute))
+ attribute)))
query)
query))
@@ -366,7 +366,7 @@ The translation is done according to
`eudc-protocol-attributes-translation-alist'."
(if eudc-protocol-attributes-translation-alist
(let (trans)
- (mapcar '(lambda (attribute)
+ (mapcar (lambda (attribute)
(setq trans (assq attribute
(symbol-value eudc-protocol-attributes-translation-alist)))
(if trans
@@ -692,7 +692,7 @@ server for future sessions."
(interactive (list
(read-from-minibuffer "Directory Server: ")
(intern (completing-read "Protocol: "
- (mapcar '(lambda (elt)
+ (mapcar (lambda (elt)
(cons (symbol-name elt)
elt))
eudc-known-protocols)))))
@@ -796,7 +796,7 @@ If none try N - 1 and so forth."
(> n 0))
(setq formats
(delq nil
- (mapcar '(lambda (format)
+ (mapcar (lambda (format)
(if (= n
(length format))
format
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 1dd0648f569..5afd255f419 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -73,32 +73,29 @@
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
(catch 'unmatch
(progn
- (mapc
- (function
- (lambda (condition)
- (let ((attr (car condition))
- (val (cdr condition))
- (case-fold-search t)
- bbdb-val)
- (or (and (memq attr '(firstname lastname aka company phones addresses net))
- (progn
- (setq bbdb-val
- (eval (list (intern (concat "bbdb-record-"
- (symbol-name attr)))
- 'record)))
- (if (listp bbdb-val)
- (if eudc-bbdb-enable-substring-matches
- (eval `(or ,@(mapcar '(lambda (subval)
- (string-match val
- subval))
- bbdb-val)))
- (member (downcase val)
- (mapcar 'downcase bbdb-val)))
- (if eudc-bbdb-enable-substring-matches
- (string-match val bbdb-val)
- (string-equal (downcase val) (downcase bbdb-val))))))
- (throw 'unmatch nil)))))
- eudc-bbdb-current-query)
+ (dolist (condition eudc-bbdb-current-query)
+ (let ((attr (car condition))
+ (val (cdr condition))
+ (case-fold-search t)
+ bbdb-val)
+ (or (and (memq attr '(firstname lastname aka company phones
+ addresses net))
+ (progn
+ (setq bbdb-val
+ (eval (list (intern (concat "bbdb-record-"
+ (symbol-name attr)))
+ 'record)))
+ (if (listp bbdb-val)
+ (if eudc-bbdb-enable-substring-matches
+ (eval `(or ,@(mapcar (lambda (subval)
+ (string-match val subval))
+ bbdb-val)))
+ (member (downcase val)
+ (mapcar 'downcase bbdb-val)))
+ (if eudc-bbdb-enable-substring-matches
+ (string-match val bbdb-val)
+ (string-equal (downcase val) (downcase bbdb-val))))))
+ (throw 'unmatch nil))))
record)))
;; External.
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 14594409dfa..fc7519e5b30 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -172,10 +172,10 @@ attribute names are returned. Default to `person'"
"Format the EUDC QUERY list as a RFC1558 LDAP search filter."
(format "(&%s)"
(apply 'concat
- (mapcar '(lambda (item)
- (format "(%s=%s)"
- (car item)
- (eudc-ldap-escape-query-special-chars (cdr item))))
+ (mapcar (lambda (item)
+ (format "(%s=%s)"
+ (car item)
+ (eudc-ldap-escape-query-special-chars (cdr item))))
query))))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 2caf8dec30f..a45cc5500c2 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -498,7 +498,7 @@ but if you have more than one in your netrc file, only the first
matching one will be used. Note the \"port ldap\" part is NOT
required.
- `host' is a string naming one or more (blank-separated) LDAP servers to
+ `host' is a string naming one or more (blank-separated) LDAP servers
to try to connect to. Each host name may optionally be of the form HOST:PORT.
`filter' is a filter string for the search as described in RFC 1558.
`attributes' is a list of strings indicating which attributes to retrieve
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 61e4630906d..bb09d8945c9 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -44,8 +44,10 @@
(require 'tls)
(require 'starttls)
+(require 'auth-source)
-(declare-function gnutls-negotiate "gnutls" t t) ; defun*
+(autoload 'gnutls-negotiate "gnutls")
+(autoload 'open-gnutls-stream "gnutls")
;;;###autoload
(defun open-network-stream (name buffer host service &rest parameters)
@@ -96,6 +98,10 @@ values:
:end-of-command specifies a regexp matching the end of a command.
+:end-of-capability specifies a regexp matching the end of the
+ response to the command specified for :capability-command.
+ It defaults to the regexp specified for :end-of-command.
+
:success specifies a regexp matching a message indicating a
successful STARTTLS negotiation. For instance, the default
should be \"^3\" for an NNTP connection.
@@ -109,8 +115,22 @@ 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
+ capabilities, even if we're doing a `plain' network connection.
+
+:client-certificate should either be a list where the first
+ element is the certificate key file name, and the second
+ element is the certificate file name itself, or `t', which
+ means that `auth-source' will be queried for the key and the
+ 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.
+
:nowait is a boolean that says the connection should be made
-asynchronously, if possible."
+ asynchronously, if possible."
(unless (featurep 'make-network-process)
(error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))
@@ -126,8 +146,11 @@ asynchronously, if possible."
:nowait (plist-get parameters :nowait))
(let ((work-buffer (or buffer
(generate-new-buffer " *stream buffer*")))
- (fun (cond ((eq type 'plain) 'network-stream-open-plain)
- ((memq type '(nil network starttls))
+ (fun (cond ((and (eq type 'plain)
+ (not (plist-get parameters
+ :always-query-capabilities)))
+ 'network-stream-open-plain)
+ ((memq type '(nil network starttls plain))
'network-stream-open-starttls)
((memq type '(tls ssl)) 'network-stream-open-tls)
((eq type 'shell) 'network-stream-open-shell)
@@ -143,9 +166,26 @@ asynchronously, if possible."
(list (car result)
:greeting (nth 1 result)
:capabilities (nth 2 result)
- :type (nth 3 result))
+ :type (nth 3 result)
+ :error (nth 4 result))
(car result))))))
+(defun network-stream-certificate (host service parameters)
+ (let ((spec (plist-get :client-certificate parameters)))
+ (cond
+ ((listp spec)
+ ;; Either nil or a list with a key/certificate pair.
+ spec)
+ ((eq spec t)
+ (let* ((auth-info
+ (car (auth-source-search :max 1
+ :host host
+ :port service)))
+ (key (plist-get auth-info :key))
+ (cert (plist-get auth-info :cert)))
+ (and key cert
+ (list key cert)))))))
+
;;;###autoload
(defalias 'open-protocol-stream 'open-network-stream)
@@ -167,25 +207,34 @@ asynchronously, if possible."
(success-string (plist-get parameters :success))
(capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
+ (eo-capa (or (plist-get parameters :end-of-capability)
+ eoc))
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
(stream (make-network-process :name name :buffer buffer
:host host :service service))
(greeting (network-stream-get-response stream start eoc))
- (capabilities (network-stream-command stream capability-command eoc))
+ (capabilities (network-stream-command stream capability-command
+ eo-capa))
(resulting-type 'plain)
- starttls-command)
-
+ (builtin-starttls (and (fboundp 'gnutls-available-p)
+ (gnutls-available-p)))
+ starttls-command error)
+
+ ;; First check whether the server supports STARTTLS at all.
+ (when (and capabilities success-string starttls-function)
+ (setq starttls-command
+ (funcall starttls-function capabilities)))
;; If we have built-in STARTTLS support, try to upgrade the
;; connection.
- (when (and (or (fboundp 'open-gnutls-stream)
- (and require-tls
+ (when (and starttls-command
+ (or builtin-starttls
+ (and (or require-tls
+ (plist-get parameters :use-starttls-if-possible))
(executable-find "gnutls-cli")))
- capabilities success-string starttls-function
- (setq starttls-command
- (funcall starttls-function capabilities)))
+ (not (eq (plist-get parameters :type) 'plain)))
;; If using external STARTTLS, drop this connection and start
;; anew with `starttls-open-stream'.
- (unless (fboundp 'open-gnutls-stream)
+ (unless builtin-starttls
(delete-process stream)
(setq start (with-current-buffer buffer (point-max)))
(let* ((starttls-use-gnutls t)
@@ -194,14 +243,36 @@ asynchronously, if possible."
starttls-extra-arguments
;; For opportunistic TLS upgrades, we don't really
;; care about the identity of the peer.
- (cons "--insecure" starttls-extra-arguments))))
+ (cons "--insecure" starttls-extra-arguments)))
+ (cert (network-stream-certificate host service parameters)))
+ ;; There are client certificates requested, so add them to
+ ;; the command line.
+ (when cert
+ (setq starttls-extra-arguments
+ (nconc (list "--x509keyfile" (expand-file-name (nth 0 cert))
+ "--x509certfile" (expand-file-name (nth 1 cert)))
+ starttls-extra-arguments)))
(setq stream (starttls-open-stream name buffer host service)))
- (network-stream-get-response stream start eoc))
+ (network-stream-get-response stream start eoc)
+ ;; Requery capabilities for protocols that require it; i.e.,
+ ;; EHLO for SMTP.
+ (when (plist-get parameters :always-query-capabilities)
+ (network-stream-command stream capability-command eo-capa)))
(when (string-match success-string
(network-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations.
- (if (fboundp 'open-gnutls-stream)
- (gnutls-negotiate :process stream :hostname host)
+ (if builtin-starttls
+ (let ((cert (network-stream-certificate host service parameters)))
+ (condition-case nil
+ (gnutls-negotiate :process stream :hostname host
+ :keylist (and cert (list cert)))
+ ;; If we get a gnutls-specific error (for instance if
+ ;; the certificate the server gives us is completely
+ ;; syntactically invalid), then close the connection
+ ;; and possibly (further down) try to create a
+ ;; non-encrypted connection.
+ (gnutls-error
+ (delete-process stream))))
(unless (starttls-negotiate stream)
(delete-process stream)))
(if (memq (process-status stream) '(open run))
@@ -215,14 +286,21 @@ asynchronously, if possible."
(network-stream-get-response stream start eoc)))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (network-stream-command stream capability-command eoc))))
+ (network-stream-command stream capability-command eo-capa))))
;; If TLS is mandatory, close the connection if it's unencrypted.
- (and require-tls
- (eq resulting-type 'plain)
- (delete-process stream))
+ (when (and require-tls
+ ;; ... but Emacs wasn't able to -- either no built-in
+ ;; support, or no gnutls-cli installed.
+ (eq resulting-type 'plain))
+ (setq error
+ (if require-tls
+ "Server does not support TLS"
+ "Server supports STARTTLS, but Emacs does not have support for it"))
+ (delete-process stream)
+ (setq stream nil))
;; Return value:
- (list stream greeting capabilities resulting-type)))
+ (list stream greeting capabilities resulting-type error)))
(defun network-stream-command (stream command eoc)
(when command
@@ -246,7 +324,8 @@ asynchronously, if possible."
(defun network-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
(let* ((start (point-max))
- (use-builtin-gnutls (fboundp 'open-gnutls-stream))
+ (use-builtin-gnutls (and (fboundp 'gnutls-available-p)
+ (gnutls-available-p)))
(stream
(funcall (if use-builtin-gnutls
'open-gnutls-stream
@@ -257,7 +336,8 @@ asynchronously, if possible."
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
- (when (and (null use-builtin-gnutls) eoc)
+ (when (and (null use-builtin-gnutls)
+ eoc)
(network-stream-get-response stream start eoc)
(goto-char (point-min))
(when (re-search-forward eoc nil t)
@@ -284,7 +364,9 @@ asynchronously, if possible."
?p service))))))
(list stream
(network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eoc)
+ (network-stream-command stream capability-command
+ (or (plist-get parameters :end-of-capability)
+ eoc))
'plain)))
(provide 'network-stream)
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index 039d709770e..fca36c70f2d 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -6,7 +6,7 @@
;; Filename: newst-backend.el
;; URL: http://www.nongnu.org/newsticker
;; Keywords: News, RSS, Atom
-;; Time-stamp: "6. Dezember 2009, 19:15:32 (ulf)"
+;; Time-stamp: "13. Mai 2011, 20:47:05 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -2264,23 +2264,30 @@ for an entry that matches FEED and ITEM."
"Actually compare ITEM against the pattern-LIST.
LIST must be an element of `newsticker-auto-mark-filter-list'."
(mapc (lambda (pattern)
- (let ((age (nth 0 pattern))
- (place (nth 1 pattern))
+ (let ((place (nth 1 pattern))
(regexp (nth 2 pattern))
(title (newsticker--title item))
(desc (newsticker--desc item)))
(when (or (eq place 'title) (eq place 'all))
(when (and title (string-match regexp title))
- (newsticker--debug-msg "Auto-marking as %s: `%s'"
- age (newsticker--title item))
- (setcar (nthcdr 4 item) age)))
+ (newsticker--process-auto-mark-filter-match item pattern)))
(when (or (eq place 'description) (eq place 'all))
(when (and desc (string-match regexp desc))
- (newsticker--debug-msg "Auto-marking as %s: `%s'"
- age (newsticker--title item))
- (setcar (nthcdr 4 item) age)))))
+ (newsticker--process-auto-mark-filter-match item pattern)))))
list))
+(defun newsticker--process-auto-mark-filter-match (item pattern)
+ "Process ITEM that matches an auto-mark-filter PATTERN."
+ (let ((age (nth 0 pattern))
+ (place (nth 1 pattern))
+ (regexp (nth 2 pattern)))
+ (newsticker--debug-msg "Auto-mark-filter %s matches `%s'"
+ pattern (newsticker--title item))
+ (setcar (nthcdr 4 item) age)
+ (nconc (newsticker--extra item)
+ (list (list 'newsticker-auto-mark nil
+ (format "age=%s, title/desc=%s, regexp=%s"
+ age place regexp))))))
;; ======================================================================
;;; Hook samples
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index cd662cb1784..d1b042cad66 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -5,7 +5,7 @@
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-plainview.el
;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "6. Dezember 2009, 19:17:02 (ulf)"
+;; Time-stamp: "13. Mai 2011, 19:28:34 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -157,49 +157,49 @@ The following printf-like specifiers can be used:
(defface newsticker-new-item-face
'((((class color) (background dark))
- (:family "helvetica" :bold t))
+ (:family "sans" :bold t))
(((class color) (background light))
- (:family "helvetica" :bold t)))
+ (:family "sans" :bold t)))
"Face for new news items."
:group 'newsticker-faces)
(defface newsticker-old-item-face
'((((class color) (background dark))
- (:family "helvetica" :bold t :foreground "orange3"))
+ (:family "sans" :bold t :foreground "orange3"))
(((class color) (background light))
- (:family "helvetica" :bold t :foreground "red4")))
+ (:family "sans" :bold t :foreground "red4")))
"Face for old news items."
:group 'newsticker-faces)
(defface newsticker-immortal-item-face
'((((class color) (background dark))
- (:family "helvetica" :bold t :italic t :foreground "orange"))
+ (:family "sans" :bold t :italic t :foreground "orange"))
(((class color) (background light))
- (:family "helvetica" :bold t :italic t :foreground "blue")))
+ (:family "sans" :bold t :italic t :foreground "blue")))
"Face for immortal news items."
:group 'newsticker-faces)
(defface newsticker-obsolete-item-face
'((((class color) (background dark))
- (:family "helvetica" :bold t :strike-through t))
+ (:family "sans" :bold t :strike-through t))
(((class color) (background light))
- (:family "helvetica" :bold t :strike-through t)))
+ (:family "sans" :bold t :strike-through t)))
"Face for old news items."
:group 'newsticker-faces)
(defface newsticker-date-face
'((((class color) (background dark))
- (:family "helvetica" :italic t :height 0.8))
+ (:family "sans" :italic t :height 0.8))
(((class color) (background light))
- (:family "helvetica" :italic t :height 0.8)))
+ (:family "sans" :italic t :height 0.8)))
"Face for newsticker dates."
:group 'newsticker-faces)
(defface newsticker-statistics-face
'((((class color) (background dark))
- (:family "helvetica" :italic t :height 0.8))
+ (:family "sans" :italic t :height 0.8))
(((class color) (background light))
- (:family "helvetica" :italic t :height 0.8)))
+ (:family "sans" :italic t :height 0.8)))
"Face for newsticker dates."
:group 'newsticker-faces)
@@ -300,70 +300,56 @@ images."
nil
(if (boundp 'tool-bar-map)
(let ((tool-bar-map (make-sparse-keymap)))
+ (tool-bar-add-item "newsticker/prev-feed"
+ 'newsticker-previous-feed
+ 'newsticker-previous-feed
+ :help "Go to previous feed"
+ :enable '(newsticker-previous-feed-available-p))
+ (tool-bar-add-item "newsticker/prev-item"
+ 'newsticker-previous-item
+ 'newsticker-previous-item
+ :help "Go to previous item"
+ :enable '(newsticker-previous-item-available-p))
+ (tool-bar-add-item "newsticker/next-item"
+ 'newsticker-next-item
+ 'newsticker-next-item
+ :help "Go to next item"
+ :enable '(newsticker-next-item-available-p))
+ (tool-bar-add-item "newsticker/next-feed"
+ 'newsticker-next-feed
+ 'newsticker-next-feed
+ :help "Go to next feed"
+ :enable '(newsticker-next-feed-available-p))
+ (tool-bar-add-item "newsticker/narrow"
+ 'newsticker-toggle-auto-narrow-to-feed
+ 'newsticker-toggle-auto-narrow-to-feed
+ :help "Toggle visibility of other feeds")
+ (tool-bar-add-item "newsticker/mark-immortal"
+ 'newsticker-mark-item-at-point-as-immortal
+ 'newsticker-mark-item-at-point-as-immortal
+ :help "Mark current item as immortal"
+ :enable '(newsticker-item-not-immortal-p))
+ (tool-bar-add-item "newsticker/mark-read"
+ 'newsticker-mark-item-at-point-as-read
+ 'newsticker-mark-item-at-point-as-read
+ :help "Mark current item as read"
+ :enable '(newsticker-item-not-old-p))
+ (tool-bar-add-item "newsticker/get-all-news"
+ 'newsticker-get-all-news
+ 'newsticker-get-all-news
+ :help "Get news for all feeds")
+ (tool-bar-add-item "newsticker/update"
+ 'newsticker-buffer-force-update
+ 'newsticker-buffer-force-update
+ :help "Update newsticker buffer"
+ :enable '(not newsticker--buffer-uptodate-p))
+ (tool-bar-add-item "newsticker/browse-url"
+ 'newsticker-browse-url
+ 'newsticker-browse-url
+ :help "Browse URL for item at point")
+ ;; standard icons / actions
(define-key tool-bar-map [newsticker-sep-1]
(list 'menu-item "--double-line"))
- (define-key tool-bar-map [newsticker-browse-url]
- (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
- :visible t
- :help "Browse URL for item at point"
- :image newsticker--browse-image))
- (define-key tool-bar-map [newsticker-buffer-force-update]
- (list 'menu-item "newsticker-buffer-force-update"
- 'newsticker-buffer-force-update
- :visible t
- :help "Update newsticker buffer"
- :image newsticker--update-image
- :enable '(not newsticker--buffer-uptodate-p)))
- (define-key tool-bar-map [newsticker-get-all-news]
- (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
- :visible t
- :help "Get news for all feeds"
- :image newsticker--get-all-image))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
- (list 'menu-item "newsticker-mark-item-at-point-as-read"
- 'newsticker-mark-item-at-point-as-read
- :visible t
- :image newsticker--mark-read-image
- :help "Mark current item as read"
- :enable '(newsticker-item-not-old-p)))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
- (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
- 'newsticker-mark-item-at-point-as-immortal
- :visible t
- :image newsticker--mark-immortal-image
- :help "Mark current item as immortal"
- :enable '(newsticker-item-not-immortal-p)))
- (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
- (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
- 'newsticker-toggle-auto-narrow-to-feed
- :visible t
- :help "Toggle visibility of other feeds"
- :image newsticker--narrow-image))
- (define-key tool-bar-map [newsticker-next-feed]
- (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
- :visible t
- :help "Go to next feed"
- :image newsticker--next-feed-image
- :enable '(newsticker-next-feed-available-p)))
- (define-key tool-bar-map [newsticker-next-item]
- (list 'menu-item "newsticker-next-item" 'newsticker-next-item
- :visible t
- :help "Go to next item"
- :image newsticker--next-item-image
- :enable '(newsticker-next-item-available-p)))
- (define-key tool-bar-map [newsticker-previous-item]
- (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
- :visible t
- :help "Go to previous item"
- :image newsticker--previous-item-image
- :enable '(newsticker-previous-item-available-p)))
- (define-key tool-bar-map [newsticker-previous-feed]
- (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
- :visible t
- :help "Go to previous feed"
- :image newsticker--previous-feed-image
- :enable '(newsticker-previous-feed-available-p)))
- ;; standard icons / actions
(tool-bar-add-item "close"
'newsticker-close-buffer
'newsticker-close-buffer
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index dd076bcf4f0..1fbba29ec14 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -5,7 +5,7 @@
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-reader.el
;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "6. Dezember 2009, 19:16:38 (ulf)"
+;; Time-stamp: "13. Mai 2011, 20:55:24 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -147,9 +147,9 @@ See `format-time-string' for a list of valid specifiers."
(defface newsticker-feed-face
'((((class color) (background dark))
- (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
+ (:family "sans" :bold t :height 1.2 :foreground "white"))
(((class color) (background light))
- (:family "helvetica" :bold t :height 1.2 :foreground "black")))
+ (:family "sans" :bold t :height 1.2 :foreground "black")))
"Face for news feeds."
:group 'newsticker-faces)
@@ -291,866 +291,6 @@ Return the image."
;; ======================================================================
;;; Toolbar
;; ======================================================================
-(defconst newsticker--next-item-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * next_xpm[] = {
-\"24 24 42 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #7EB6DE\",
-\"@ c #82BBE2\",
-\"# c #85BEE4\",
-\"$ c #88C1E7\",
-\"% c #8AC3E8\",
-\"& c #87C1E6\",
-\"* c #8AC4E9\",
-\"= c #8CC6EA\",
-\"- c #8CC6EB\",
-\"; c #88C2E7\",
-\"> c #8BC5E9\",
-\", c #8DC7EB\",
-\"' c #87C0E6\",
-\") c #8AC4E8\",
-\"! c #8BC5EA\",
-\"~ c #8BC4E9\",
-\"{ c #88C1E6\",
-\"] c #89C3E8\",
-\"^ c #86BFE5\",
-\"/ c #83BBE2\",
-\"( c #82BBE1\",
-\"_ c #86C0E5\",
-\": c #87C0E5\",
-\"< c #83BCE2\",
-\"[ c #81B9E0\",
-\"} c #81BAE1\",
-\"| c #78B0D9\",
-\"1 c #7BB3DB\",
-\"2 c #7DB5DD\",
-\"3 c #7DB6DD\",
-\"4 c #72A9D4\",
-\"5 c #75ACD6\",
-\"6 c #76AED7\",
-\"7 c #77AFD8\",
-\"8 c #6BA1CD\",
-\"9 c #6EA4CF\",
-\"0 c #6FA6D1\",
-\"a c #6298C6\",
-\"b c #659BC8\",
-\"c c #5C91C0\",
-\" \",
-\" \",
-\" . \",
-\" .. \",
-\" .+. \",
-\" .@#. \",
-\" .#$%. \",
-\" .&*=-. \",
-\" .;>,,,. \",
-\" .;>,,,=. \",
-\" .')!==~;. \",
-\" .#{]*%;^/. \",
-\" .(#_':#<. \",
-\" .+[@</}. \",
-\" .|1232. \",
-\" .4567. \",
-\" .890. \",
-\" .ab. \",
-\" .c. \",
-\" .. \",
-\" . \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the next item button.")
-
-(defconst newsticker--previous-item-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * previous_xpm[] = {
-\"24 24 39 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #7BB3DB\",
-\"@ c #83BCE2\",
-\"# c #7FB8DF\",
-\"$ c #89C2E7\",
-\"% c #86BFE5\",
-\"& c #83BBE2\",
-\"* c #8CC6EA\",
-\"= c #8BC4E9\",
-\"- c #88C2E7\",
-\"; c #85BEE4\",
-\"> c #8DC7EB\",
-\", c #89C3E8\",
-\"' c #8AC4E8\",
-\") c #8BC5EA\",
-\"! c #88C1E6\",
-\"~ c #8AC4E9\",
-\"{ c #8AC3E8\",
-\"] c #86C0E5\",
-\"^ c #87C0E6\",
-\"/ c #87C0E5\",
-\"( c #82BBE2\",
-\"_ c #81BAE1\",
-\": c #7FB7DF\",
-\"< c #7DB6DD\",
-\"[ c #7DB5DD\",
-\"} c #7CB4DC\",
-\"| c #79B1DA\",
-\"1 c #76ADD7\",
-\"2 c #77AFD8\",
-\"3 c #73AAD4\",
-\"4 c #70A7D1\",
-\"5 c #6EA5D0\",
-\"6 c #6CA2CE\",
-\"7 c #689ECB\",
-\"8 c #6399C7\",
-\"9 c #6095C4\",
-\"0 c #5C90C0\",
-\" \",
-\" \",
-\" . \",
-\" .. \",
-\" .+. \",
-\" .@#. \",
-\" .$%&. \",
-\" .*=-;. \",
-\" .>>*,%. \",
-\" .>>>*,%. \",
-\" .')**=-;. \",
-\" .;!,~{-%&. \",
-\" .;]^/;@#. \",
-\" .(@&_:+. \",
-\" .<[}|1. \",
-\" .2134. \",
-\" .567. \",
-\" .89. \",
-\" .0. \",
-\" .. \",
-\" . \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the previous item button.")
-
-(defconst newsticker--previous-feed-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * prev_feed_xpm[] = {
-\"24 24 52 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #70A7D2\",
-\"@ c #75ADD6\",
-\"# c #71A8D3\",
-\"$ c #79B1DA\",
-\"% c #7BB3DB\",
-\"& c #7DB5DD\",
-\"* c #83BBE2\",
-\"= c #7EB6DE\",
-\"- c #78B0D9\",
-\"; c #7FB7DE\",
-\"> c #88C2E7\",
-\", c #85BEE4\",
-\"' c #80B9E0\",
-\") c #80B8DF\",
-\"! c #8CC6EA\",
-\"~ c #89C3E8\",
-\"{ c #86BFE5\",
-\"] c #81BAE1\",
-\"^ c #7CB4DC\",
-\"/ c #7FB8DF\",
-\"( c #8DC7EB\",
-\"_ c #7BB3DC\",
-\": c #7EB7DE\",
-\"< c #8BC4E9\",
-\"[ c #8AC4E9\",
-\"} c #8AC3E8\",
-\"| c #87C0E6\",
-\"1 c #87C0E5\",
-\"2 c #83BCE2\",
-\"3 c #75ACD6\",
-\"4 c #7FB7DF\",
-\"5 c #77AED8\",
-\"6 c #71A8D2\",
-\"7 c #70A7D1\",
-\"8 c #76ADD7\",
-\"9 c #6CA2CE\",
-\"0 c #699FCC\",
-\"a c #73AAD4\",
-\"b c #6BA1CD\",
-\"c c #669CC9\",
-\"d c #6298C5\",
-\"e c #689ECB\",
-\"f c #6499C7\",
-\"g c #6095C3\",
-\"h c #5C91C0\",
-\"i c #5E93C2\",
-\"j c #5B90C0\",
-\"k c #588CBC\",
-\"l c #578CBC\",
-\"m c #5589BA\",
-\" \",
-\" \",
-\" ... . \",
-\" .+. .. \",
-\" .@. .#. \",
-\" .$. .%@. \",
-\" .&. .*=-. \",
-\" .;. .>,'%. \",
-\" .). .!~{]^. \",
-\" ./. .(!~{]_. \",
-\" .:. .!!<>,'%. \",
-\" .&. .~[}>{*=-. \",
-\" .$. .|1,2/%@. \",
-\" .3. .*]4%56. \",
-\" .7. .^$8#9. \",
-\" .0. .a7bc. \",
-\" .d. .efg. \",
-\" .h. .ij. \",
-\" .k. .l. \",
-\" .m. .. \",
-\" ... . \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the previous feed button.")
-
-(defconst newsticker--next-feed-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * next_feed_xpm[] = {
-\"24 24 57 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #6CA2CE\",
-\"@ c #75ADD6\",
-\"# c #71A8D3\",
-\"$ c #79B1DA\",
-\"% c #7EB7DE\",
-\"& c #7DB5DD\",
-\"* c #81BAE1\",
-\"= c #85BEE4\",
-\"- c #78B0D9\",
-\"; c #7FB7DE\",
-\"> c #83BCE3\",
-\", c #87C1E6\",
-\"' c #8AC4E9\",
-\") c #7BB3DB\",
-\"! c #80B8DF\",
-\"~ c #88C2E7\",
-\"{ c #8BC5E9\",
-\"] c #8DC7EB\",
-\"^ c #7CB4DC\",
-\"/ c #7FB8DF\",
-\"( c #84BDE3\",
-\"_ c #7BB3DC\",
-\": c #83BCE2\",
-\"< c #87C0E6\",
-\"[ c #8AC4E8\",
-\"} c #8BC5EA\",
-\"| c #8CC6EA\",
-\"1 c #88C1E6\",
-\"2 c #89C3E8\",
-\"3 c #8AC3E8\",
-\"4 c #7EB6DE\",
-\"5 c #82BBE1\",
-\"6 c #86C0E5\",
-\"7 c #87C0E5\",
-\"8 c #75ACD6\",
-\"9 c #7AB2DA\",
-\"0 c #81B9E0\",
-\"a c #82BBE2\",
-\"b c #71A8D2\",
-\"c c #70A7D1\",
-\"d c #74ACD6\",
-\"e c #699FCC\",
-\"f c #6EA5D0\",
-\"g c #72A9D4\",
-\"h c #669CC9\",
-\"i c #6298C5\",
-\"j c #679DCA\",
-\"k c #6BA1CD\",
-\"l c #6095C3\",
-\"m c #5C91C0\",
-\"n c #5F94C2\",
-\"o c #5B90C0\",
-\"p c #588CBC\",
-\"q c #578CBC\",
-\"r c #5589BA\",
-\" \",
-\" \",
-\" . ... \",
-\" .. .+. \",
-\" .@. .#. \",
-\" .$%. .@. \",
-\" .&*=. .-. \",
-\" .;>,'. .). \",
-\" .!=~{]. .^. \",
-\" ./(~{]]. ._. \",
-\" .%:<[}||. .). \",
-\" .&*=12'3~. .-. \",
-\" .$45=6<7. .@. \",
-\" .8940a:. .b. \",
-\" .cd-)&. .+. \",
-\" .efg8. .h. \",
-\" .ijk. .l. \",
-\" .mn. .o. \",
-\" .p. .q. \",
-\" .. .r. \",
-\" . ... \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the next feed button.")
-
-(defconst newsticker--mark-read-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * mark_read_xpm[] = {
-\"24 24 44 1\",
-\" c None\",
-\". c #C20000\",
-\"+ c #BE0000\",
-\"@ c #C70000\",
-\"# c #CE0000\",
-\"$ c #C90000\",
-\"% c #BD0000\",
-\"& c #CB0000\",
-\"* c #D10000\",
-\"= c #D70000\",
-\"- c #D30000\",
-\"; c #CD0000\",
-\"> c #C60000\",
-\", c #D40000\",
-\"' c #DA0000\",
-\") c #DE0000\",
-\"! c #DB0000\",
-\"~ c #D60000\",
-\"{ c #D00000\",
-\"] c #DC0000\",
-\"^ c #E00000\",
-\"/ c #E40000\",
-\"( c #E10000\",
-\"_ c #DD0000\",
-\": c #D80000\",
-\"< c #E50000\",
-\"[ c #E70000\",
-\"} c #E60000\",
-\"| c #E20000\",
-\"1 c #E90000\",
-\"2 c #E80000\",
-\"3 c #E30000\",
-\"4 c #DF0000\",
-\"5 c #D90000\",
-\"6 c #CC0000\",
-\"7 c #C10000\",
-\"8 c #C30000\",
-\"9 c #BF0000\",
-\"0 c #B90000\",
-\"a c #BC0000\",
-\"b c #BB0000\",
-\"c c #B80000\",
-\"d c #B50000\",
-\"e c #B70000\",
-\" \",
-\" \",
-\" \",
-\" . + \",
-\" +@# $.% \",
-\" &*= -;> \",
-\" ,') !~{ \",
-\" ]^/ (_: \",
-\" (<[ }|) \",
-\" <[1 2<| \",
-\" }222[< \",
-\" }}}< \",
-\" 333| \",
-\" _4^4)] \",
-\" ~:' 5=- \",
-\" 6{- *#$ \",
-\" 7>$ @89 \",
-\" 0a+ %bc \",
-\" ddc edd \",
-\" ddd ddd \",
-\" d d \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the mark read button.")
-
-(defconst newsticker--mark-immortal-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * mark_immortal_xpm[] = {
-\"24 24 93 2\",
-\" c None\",
-\". c #171717\",
-\"+ c #030303\",
-\"@ c #000000\",
-\"# c #181818\",
-\"$ c #090909\",
-\"% c #FFC960\",
-\"& c #FFCB61\",
-\"* c #FFCB62\",
-\"= c #FFC961\",
-\"- c #FFC75F\",
-\"; c #FFC65E\",
-\"> c #FFCA61\",
-\", c #FFCD63\",
-\"' c #FFCF65\",
-\") c #FFD065\",
-\"! c #FFCE64\",
-\"~ c #FFC35C\",
-\"{ c #FFC45D\",
-\"] c #FFD166\",
-\"^ c #FFD267\",
-\"/ c #FFD368\",
-\"( c #FFD167\",
-\"_ c #FFC05A\",
-\": c #010101\",
-\"< c #040404\",
-\"[ c #FFCC62\",
-\"} c #FFD569\",
-\"| c #FFD56A\",
-\"1 c #FFC860\",
-\"2 c #FFC25B\",
-\"3 c #FFBB56\",
-\"4 c #020202\",
-\"5 c #060606\",
-\"6 c #FFC15B\",
-\"7 c #FFC85F\",
-\"8 c #FFD469\",
-\"9 c #FFD66A\",
-\"0 c #FFBC57\",
-\"a c #1B1B1B\",
-\"b c #070707\",
-\"c c #FFBA55\",
-\"d c #FFB451\",
-\"e c #FFB954\",
-\"f c #FFB350\",
-\"g c #FFB652\",
-\"h c #FFBE58\",
-\"i c #FFCD64\",
-\"j c #FFD066\",
-\"k c #FFC059\",
-\"l c #FFB14E\",
-\"m c #0B0B0B\",
-\"n c #FFBB55\",
-\"o c #FFC15A\",
-\"p c #FFB552\",
-\"q c #FFAD4B\",
-\"r c #080808\",
-\"s c #FFAF4C\",
-\"t c #FFB853\",
-\"u c #FFA948\",
-\"v c #050505\",
-\"w c #FFB04E\",
-\"x c #FFB753\",
-\"y c #FFBC56\",
-\"z c #FFC55D\",
-\"A c #FFC55E\",
-\"B c #FFC45C\",
-\"C c #FFBD57\",
-\"D c #FFB854\",
-\"E c #FFB34F\",
-\"F c #FFAB4A\",
-\"G c #FFA545\",
-\"H c #FFAA49\",
-\"I c #FFB04D\",
-\"J c #FFB551\",
-\"K c #FFBF58\",
-\"L c #FFB24F\",
-\"M c #FFAC4A\",
-\"N c #FFA646\",
-\"O c #FFA344\",
-\"P c #FFA848\",
-\"Q c #FFB14F\",
-\"R c #FFAF4D\",
-\"S c #FFA546\",
-\"T c #FFA243\",
-\"U c #FFA445\",
-\"V c #FFAE4C\",
-\"W c #FFA444\",
-\"X c #FFA142\",
-\"Y c #FF9F41\",
-\"Z c #0A0A0A\",
-\"` c #FF9E40\",
-\" . c #FF9F40\",
-\" \",
-\" \",
-\" \",
-\" . + @ @ + # \",
-\" $ @ % & * * = - + + \",
-\" @ ; > , ' ) ' ! * - ~ @ \",
-\" @ { > ! ] ^ / / ( ' * ; _ : \",
-\" < _ ; [ ) / } | } / ] , 1 2 3 4 \",
-\" 5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a \",
-\" b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5 \",
-\" : e _ ; * ) / 8 } } / ] , 1 2 3 f 5 \",
-\" : g h { = i j ^ / ^ ] ! * ; k e l m \",
-\" : f n o ; > , ' ) ' ! * - 2 0 p q r \",
-\" : s g 0 6 ; % > * * = - ~ h t l u r \",
-\" v u w x y k ~ z A z B o C D E F G b \",
-\" 5 H I J e 0 h K h C c x L M N . \",
-\" 4 O P q Q d g x g J L R H S T < \",
-\" @ T U P F q V q M H N W X + \",
-\" @ Y T O W G G W O X Y @ \",
-\" 4 Z ` Y Y Y .` 4 4 \",
-\" 5 : : @ @ Z \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the mark immortal button.")
-
-(defconst newsticker--narrow-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * narrow_xpm[] = {
-\"24 24 48 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #969696\",
-\"@ c #9E9E9E\",
-\"# c #A4A4A4\",
-\"$ c #AAAAAA\",
-\"% c #AEAEAE\",
-\"& c #B1B1B1\",
-\"* c #B3B3B3\",
-\"= c #B4B4B4\",
-\"- c #B2B2B2\",
-\"; c #AFAFAF\",
-\"> c #ABABAB\",
-\", c #A6A6A6\",
-\"' c #A0A0A0\",
-\") c #989898\",
-\"! c #909090\",
-\"~ c #73AAD4\",
-\"{ c #7AB2DA\",
-\"] c #7FB8DF\",
-\"^ c #84BDE3\",
-\"/ c #88C2E7\",
-\"( c #8BC5E9\",
-\"_ c #8DC7EB\",
-\": c #8CC6EA\",
-\"< c #89C3E8\",
-\"[ c #86BFE5\",
-\"} c #81BAE1\",
-\"| c #7BB3DC\",
-\"1 c #75ACD6\",
-\"2 c #6DA4CF\",
-\"3 c #979797\",
-\"4 c #A3A3A3\",
-\"5 c #A8A8A8\",
-\"6 c #ADADAD\",
-\"7 c #ACACAC\",
-\"8 c #A9A9A9\",
-\"9 c #A5A5A5\",
-\"0 c #9A9A9A\",
-\"a c #929292\",
-\"b c #8C8C8C\",
-\"c c #808080\",
-\"d c #818181\",
-\"e c #838383\",
-\"f c #848484\",
-\"g c #858585\",
-\"h c #868686\",
-\"i c #828282\",
-\" \",
-\" \",
-\" \",
-\" .................. \",
-\" .+@#$%&*=*-;>,')!. \",
-\" .................. \",
-\" \",
-\" \",
-\" .................. \",
-\" .~{]^/(___:<[}|12. \",
-\" .................. \",
-\" \",
-\" \",
-\" .................. \",
-\" .!3@45>666789'0ab. \",
-\" .................. \",
-\" \",
-\" \",
-\" .................. \",
-\" .cccdefghhgficccc. \",
-\" .................. \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the narrow image button.")
-
-(defconst newsticker--get-all-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * get_all_xpm[] = {
-\"24 24 70 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #F3DA00\",
-\"@ c #F5DF00\",
-\"# c #F7E300\",
-\"$ c #F9E700\",
-\"% c #FAEA00\",
-\"& c #FBEC00\",
-\"* c #FBED00\",
-\"= c #FCEE00\",
-\"- c #FAEB00\",
-\"; c #F9E800\",
-\"> c #F8E500\",
-\", c #F6E000\",
-\"' c #F4DB00\",
-\") c #F1D500\",
-\"! c #EFD000\",
-\"~ c #B7CA00\",
-\"{ c #BFD100\",
-\"] c #C5D700\",
-\"^ c #CBDB00\",
-\"/ c #CFDF00\",
-\"( c #D2E200\",
-\"_ c #D4E400\",
-\": c #D3E300\",
-\"< c #D0E000\",
-\"[ c #CCDD00\",
-\"} c #C7D800\",
-\"| c #C1D300\",
-\"1 c #BACC00\",
-\"2 c #B1C500\",
-\"3 c #A8BC00\",
-\"4 c #20A900\",
-\"5 c #22AF00\",
-\"6 c #24B500\",
-\"7 c #26B900\",
-\"8 c #27BC00\",
-\"9 c #27BE00\",
-\"0 c #28BF00\",
-\"a c #27BD00\",
-\"b c #26BA00\",
-\"c c #25B600\",
-\"d c #23B100\",
-\"e c #21AB00\",
-\"f c #1FA400\",
-\"g c #1C9B00\",
-\"h c #21AA00\",
-\"i c #24B300\",
-\"j c #25B800\",
-\"k c #25B700\",
-\"l c #24B400\",
-\"m c #23B000\",
-\"n c #1FA500\",
-\"o c #1D9E00\",
-\"p c #20A800\",
-\"q c #21AC00\",
-\"r c #23B200\",
-\"s c #22AD00\",
-\"t c #1D9F00\",
-\"u c #20A700\",
-\"v c #1EA100\",
-\"w c #1C9C00\",
-\"x c #1DA000\",
-\"y c #1B9800\",
-\"z c #1A9600\",
-\"A c #1A9700\",
-\"B c #1A9500\",
-\"C c #199200\",
-\"D c #189100\",
-\"E c #178C00\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ................... \",
-\" .+@#$%&*=*&-;>,')!. \",
-\" ................... \",
-\" \",
-\" ................... \",
-\" .~{]^/(___:<[}|123. \",
-\" ................... \",
-\" \",
-\" ................... \",
-\" .45678909abcdefg. \",
-\" .h5icj7jklmeno. \",
-\" .pq5drrmshft. \",
-\" .fu4h4pnvw. \",
-\" .oxvxtwy. \",
-\" .zAAzB. \",
-\" .CCD. \",
-\" .E. \",
-\" . \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the get all image button.")
-
-(defconst newsticker--update-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * update_xpm[] = {
-\"24 24 37 1\",
-\" c None\",
-\". c #076D00\",
-\"+ c #0A8600\",
-\"@ c #0A8800\",
-\"# c #098400\",
-\"$ c #087200\",
-\"% c #087900\",
-\"& c #098500\",
-\"* c #098100\",
-\"= c #087600\",
-\"- c #097E00\",
-\"; c #097F00\",
-\"> c #0A8700\",
-\", c #0A8C00\",
-\"' c #097C00\",
-\") c #098300\",
-\"! c #0A8900\",
-\"~ c #0A8E00\",
-\"{ c #0B9200\",
-\"] c #087700\",
-\"^ c #076E00\",
-\"/ c #076C00\",
-\"( c #076B00\",
-\"_ c #076A00\",
-\": c #076900\",
-\"< c #076800\",
-\"[ c #066700\",
-\"} c #066500\",
-\"| c #066400\",
-\"1 c #066300\",
-\"2 c #066600\",
-\"3 c #066200\",
-\"4 c #076700\",
-\"5 c #065E00\",
-\"6 c #066100\",
-\"7 c #065F00\",
-\"8 c #066000\",
-\" \",
-\" \",
-\" \",
-\" . +@@@+# \",
-\" $% &@ +* \",
-\" =-# ; \",
-\" %*>, ' \",
-\" ')!~{ = \",
-\" ]$ \",
-\" ^ ^ \",
-\" . . \",
-\" / ( \",
-\" _ : \",
-\" < [ \",
-\" } | \",
-\" [[ \",
-\" 1 $.:23 \",
-\" 3 4}35 \",
-\" 6 655 \",
-\" 76 85 55 \",
-\" 5555555 5 \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the update button.")
-
-(defconst newsticker--browse-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * visit_xpm[] = {
-\"24 24 39 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #FFFFFF\",
-\"@ c #00E63D\",
-\"# c #00E83E\",
-\"$ c #00E73D\",
-\"% c #00E93E\",
-\"& c #00E63C\",
-\"* c #00E53C\",
-\"= c #00E23B\",
-\"- c #00E33B\",
-\"; c #00E83D\",
-\"> c #00E13A\",
-\", c #00DD38\",
-\"' c #00DE38\",
-\") c #00E23A\",
-\"! c #00E43C\",
-\"~ c #00DF39\",
-\"{ c #00DB37\",
-\"] c #00D634\",
-\"^ c #00D734\",
-\"/ c #00E039\",
-\"( c #00DC37\",
-\"_ c #00D835\",
-\": c #00D332\",
-\"< c #00CD2F\",
-\"[ c #00DB36\",
-\"} c #00D433\",
-\"| c #00CF30\",
-\"1 c #00DA36\",
-\"2 c #00D936\",
-\"3 c #00D533\",
-\"4 c #00D131\",
-\"5 c #00CE2F\",
-\"6 c #00CC2F\",
-\"7 c #00CA2D\",
-\"8 c #00C62B\",
-\"9 c #00C52A\",
-\"0 c #00BE27\",
-\" \",
-\" \",
-\" . \",
-\" .+. \",
-\" .+++. \",
-\" .++.++. \",
-\" .++.@.++. \",
-\" .++.##$.++. \",
-\" .++.%%%#&.++. \",
-\" .++.$%%%#*=.++. \",
-\" .++.-@;##$*>,.++. \",
-\" .++.')!&@@*=~{].++. \",
-\" .++.^{~>---)/(_:<.++. \",
-\" .++.^[,~/~'(_}|.++. \",
-\" .++.]_1[12^:|.++. \",
-\" .++.:}33:45.++. \",
-\" .++.<5567.++. \",
-\" .++.889.++. \",
-\" .++.0.++. \",
-\" .++.++. \",
-\" .+++. \",
-\" .+. \",
-\" . \",
-\" \"};
-"
- 'xpm t))
- "Image for the browse button.")
(defun newsticker-browse-url-item (feed item)
"Convert FEED ITEM to html and call `browse-url' on result."
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 58d86b23946..37b31130e8b 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -7,7 +7,7 @@
;; URL: http://www.nongnu.org/newsticker
;; Created: 2007
;; Keywords: News, RSS, Atom
-;; Time-stamp: "6. Dezember 2009, 19:17:28 (ulf)"
+;; Time-stamp: "13. Mai 2011, 20:56:49 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -36,7 +36,6 @@
;;; History:
;;
-
;; ======================================================================
;;; Code:
(require 'newst-reader)
@@ -53,9 +52,9 @@
(defface newsticker-treeview-face
'((((class color) (background dark))
- (:family "helvetica" :foreground "misty rose" :bold nil))
+ (:family "sans" :foreground "white" :bold nil))
(((class color) (background light))
- (:family "helvetica" :foreground "black" :bold nil)))
+ (:family "sans" :foreground "black" :bold nil)))
"Face for newsticker tree."
:group 'newsticker-treeview)
@@ -1069,86 +1068,63 @@ Arguments IGNORE are ignored."
;; ======================================================================
;;; Toolbar
;; ======================================================================
-;;(makunbound 'newsticker-treeview-tool-bar-map)
(defvar newsticker-treeview-tool-bar-map
(if (featurep 'xemacs)
nil
(if (boundp 'tool-bar-map)
(let ((tool-bar-map (make-sparse-keymap)))
+ (tool-bar-add-item "newsticker/prev-feed"
+ 'newsticker-treeview-prev-feed
+ 'newsticker-treeview-prev-feed
+ :help "Go to previous feed"
+ ;;:enable '(newsticker-previous-feed-available-p) FIXME
+ )
+ (tool-bar-add-item "newsticker/prev-item"
+ 'newsticker-treeview-prev-item
+ 'newsticker-treeview-prev-item
+ :help "Go to previous item"
+ ;;:enable '(newsticker-previous-item-available-p) FIXME
+ )
+ (tool-bar-add-item "newsticker/next-item"
+ 'newsticker-treeview-next-item
+ 'newsticker-treeview-next-item
+ :visible t
+ :help "Go to next item"
+ ;;:enable '(newsticker-next-item-available-p) FIXME
+ )
+ (tool-bar-add-item "newsticker/next-feed"
+ 'newsticker-treeview-next-feed
+ 'newsticker-treeview-next-feed
+ :help "Go to next feed"
+ ;;:enable '(newsticker-next-feed-available-p) FIXME
+ )
+ (tool-bar-add-item "newsticker/mark-immortal"
+ 'newsticker-treeview-toggle-item-immortal
+ 'newsticker-treeview-toggle-item-immortal
+ :help "Toggle current item as immortal"
+ ;;:enable '(newsticker-item-not-immortal-p) FIXME
+ )
+ (tool-bar-add-item "newsticker/mark-read"
+ 'newsticker-treeview-mark-item-old
+ 'newsticker-treeview-mark-item-old
+ :help "Mark current item as read"
+ ;;:enable '(newsticker-item-not-old-p) FIXME
+ )
+ (tool-bar-add-item "newsticker/get-all"
+ 'newsticker-get-all-news
+ 'newsticker-get-all-news
+ :help "Get news for all feeds")
+ (tool-bar-add-item "newsticker/update"
+ 'newsticker-treeview-update
+ 'newsticker-treeview-update
+ :help "Update newsticker buffer")
+ (tool-bar-add-item "newsticker/browse-url"
+ 'newsticker-browse-url
+ 'newsticker-browse-url
+ :help "Browse URL for item at point")
+ ;; standard icons / actions
(define-key tool-bar-map [newsticker-sep-1]
(list 'menu-item "--double-line"))
- (define-key tool-bar-map [newsticker-browse-url]
- (list 'menu-item "newsticker-browse-url"
- 'newsticker-browse-url
- :visible t
- :help "Browse URL for item at point"
- :image newsticker--browse-image))
- (define-key tool-bar-map [newsticker-buffer-force-update]
- (list 'menu-item "newsticker-treeview-update"
- 'newsticker-treeview-update
- :visible t
- :help "Update newsticker buffer"
- :image newsticker--update-image
- :enable t))
- (define-key tool-bar-map [newsticker-get-all-news]
- (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
- :visible t
- :help "Get news for all feeds"
- :image newsticker--get-all-image))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
- (list 'menu-item "newsticker-treeview-mark-item-old"
- 'newsticker-treeview-mark-item-old
- :visible t
- :image newsticker--mark-read-image
- :help "Mark current item as read"
- ;;:enable '(newsticker-item-not-old-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
- (list 'menu-item "newsticker-treeview-toggle-item-immortal"
- 'newsticker-treeview-toggle-item-immortal
- :visible t
- :image newsticker--mark-immortal-image
- :help "Toggle current item as immortal"
- :enable t
- ;;'(newsticker-item-not-immortal-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-next-feed]
- (list 'menu-item "newsticker-treeview-next-feed"
- 'newsticker-treeview-next-feed
- :visible t
- :help "Go to next feed"
- :image newsticker--next-feed-image
- :enable t
- ;;'(newsticker-next-feed-available-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-treeview-next-item]
- (list 'menu-item "newsticker-treeview-next-item"
- 'newsticker-treeview-next-item
- :visible t
- :help "Go to next item"
- :image newsticker--next-item-image
- :enable t
- ;;'(newsticker-next-item-available-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-treeview-prev-item]
- (list 'menu-item "newsticker-treeview-prev-item"
- 'newsticker-treeview-prev-item
- :visible t
- :help "Go to previous item"
- :image newsticker--previous-item-image
- :enable t
- ;;'(newsticker-previous-item-available-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-treeview-prev-feed]
- (list 'menu-item "newsticker-treeview-prev-feed"
- 'newsticker-treeview-prev-feed
- :visible t
- :help "Go to previous feed"
- :image newsticker--previous-feed-image
- :enable t
- ;;'(newsticker-previous-feed-available-p) FIXME
- ))
- ;; standard icons / actions
(tool-bar-add-item "close"
'newsticker-treeview-quit
'newsticker-treeview-quit
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 148c9b7b297..f7f5f61fafe 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -55,7 +55,10 @@
:group 'applications)
(defcustom rcirc-server-alist
- '(("irc.freenode.net" :channels ("#rcirc")))
+ '(("irc.freenode.net" :channels ("#rcirc")
+ ;; Don't use the TLS port by default, in case gnutls is not available.
+ ;; :port 7000 :encryption tls
+ ))
"An alist of IRC connections to establish when running `rcirc'.
Each element looks like (SERVER-NAME PARAMETERS).
@@ -95,14 +98,22 @@ used.
VALUE must be a list of strings describing which channels to join
when connecting to this server. If absent, no channels will be
-connected to automatically."
+connected to automatically.
+
+`:encryption'
+
+VALUE must be `plain' (the default) for unencrypted connections, or `tls'
+for connections using SSL/TLS."
:type '(alist :key-type string
- :value-type (plist :options ((:nick string)
- (:port integer)
- (:user-name string)
- (:password string)
- (:full-name string)
- (:channels (repeat string)))))
+ :value-type (plist :options
+ ((:nick string)
+ (:port integer)
+ (:user-name string)
+ (:password string)
+ (:full-name string)
+ (:channels (repeat string))
+ (:encryption (choice (const tls)
+ (const plain))))))
:group 'rcirc)
(defcustom rcirc-default-port 6667
@@ -304,7 +315,9 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
:group 'rcirc)
(defcustom rcirc-decode-coding-system 'utf-8
- "Coding system used to decode incoming irc messages."
+ "Coding system used to decode incoming irc messages.
+Set to 'undecided if you want the encoding of the incoming
+messages autodetected."
:type 'coding-system
:group 'rcirc)
@@ -441,10 +454,11 @@ If ARG is non-nil, instead prompt for connection parameters."
(plist-get server-plist
:channels)
" "))
- "[, ]+" t)))
+ "[, ]+" t))
+ (encryption (rcirc-prompt-for-encryption server-plist)))
(rcirc-connect server port nick user-name
rcirc-default-full-name
- channels password))
+ channels password encryption))
;; connect to servers in `rcirc-server-alist'
(let (connected-servers)
(dolist (c rcirc-server-alist)
@@ -456,7 +470,8 @@ If ARG is non-nil, instead prompt for connection parameters."
(full-name (or (plist-get (cdr c) :full-name)
rcirc-default-full-name))
(channels (plist-get (cdr c) :channels))
- (password (plist-get (cdr c) :password)))
+ (password (plist-get (cdr c) :password))
+ (encryption (plist-get (cdr c) :encryption)))
(when server
(let (connected)
(dolist (p (rcirc-process-list))
@@ -465,7 +480,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(if (not connected)
(condition-case e
(rcirc-connect server port nick user-name
- full-name channels password)
+ full-name channels password encryption)
(quit (message "Quit connecting to %s" server)))
(with-current-buffer (process-buffer connected)
(setq connected-servers
@@ -498,7 +513,7 @@ If ARG is non-nil, instead prompt for connection parameters."
;;;###autoload
(defun rcirc-connect (server &optional port nick user-name
- full-name startup-channels password)
+ full-name startup-channels password encryption)
(save-excursion
(message "Connecting to %s..." server)
(let* ((inhibit-eol-conversion)
@@ -511,7 +526,9 @@ If ARG is non-nil, instead prompt for connection parameters."
(user-name (or user-name rcirc-default-user-name))
(full-name (or full-name rcirc-default-full-name))
(startup-channels startup-channels)
- (process (make-network-process :name server :host server :service port-number)))
+ (process (open-network-stream
+ server nil server port-number
+ :type (or encryption 'plain))))
;; set up process
(set-process-coding-system process 'raw-text 'raw-text)
(switch-to-buffer (rcirc-generate-new-buffer-name process nil))
@@ -519,32 +536,23 @@ If ARG is non-nil, instead prompt for connection parameters."
(rcirc-mode process nil)
(set-process-sentinel process 'rcirc-sentinel)
(set-process-filter process 'rcirc-filter)
- (make-local-variable 'rcirc-process)
- (setq rcirc-process process)
- (make-local-variable 'rcirc-server)
- (setq rcirc-server server)
- (make-local-variable 'rcirc-server-name)
- (setq rcirc-server-name server) ; update when we get 001 response
- (make-local-variable 'rcirc-buffer-alist)
- (setq rcirc-buffer-alist nil)
- (make-local-variable 'rcirc-nick-table)
- (setq rcirc-nick-table (make-hash-table :test 'equal))
- (make-local-variable 'rcirc-nick)
- (setq rcirc-nick nick)
- (make-local-variable 'rcirc-process-output)
- (setq rcirc-process-output nil)
- (make-local-variable 'rcirc-startup-channels)
- (setq rcirc-startup-channels startup-channels)
- (make-local-variable 'rcirc-last-server-message-time)
- (setq rcirc-last-server-message-time (current-time))
- (make-local-variable 'rcirc-timeout-timer)
- (setq rcirc-timeout-timer nil)
- (make-local-variable 'rcirc-user-disconnect)
- (setq rcirc-user-disconnect nil)
- (make-local-variable 'rcirc-user-authenticated)
- (setq rcirc-user-authenticated nil)
- (make-local-variable 'rcirc-connecting)
- (setq rcirc-connecting t)
+
+ (set (make-local-variable 'rcirc-process) process)
+ (set (make-local-variable 'rcirc-server) server)
+ (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response.
+ (set (make-local-variable 'rcirc-buffer-alist) nil)
+ (set (make-local-variable 'rcirc-nick-table)
+ (make-hash-table :test 'equal))
+ (set (make-local-variable 'rcirc-nick) nick)
+ (set (make-local-variable 'rcirc-process-output) nil)
+ (set (make-local-variable 'rcirc-startup-channels) startup-channels)
+ (set (make-local-variable 'rcirc-last-server-message-time)
+ (current-time))
+
+ (set (make-local-variable 'rcirc-timeout-timer) nil)
+ (set (make-local-variable 'rcirc-user-disconnect) nil)
+ (set (make-local-variable 'rcirc-user-authenticated) nil)
+ (set (make-local-variable 'rcirc-connecting) t)
(add-hook 'auto-save-hook 'rcirc-log-write)
@@ -580,6 +588,17 @@ If ARG is non-nil, instead prompt for connection parameters."
(time-to-seconds (current-time))
(float-time)))
+(defun rcirc-prompt-for-encryption (server-plist)
+ "Prompt the user for the encryption method to use.
+SERVER-PLIST is the property list for the server."
+ (let ((msg "Encryption (default %s): ")
+ (choices '("plain" "tls"))
+ (default (or (plist-get server-plist :encryption)
+ 'plain)))
+ (intern
+ (completing-read (format msg default)
+ choices nil t nil nil (symbol-name default)))))
+
(defun rcirc-keepalive ()
"Send keep alive pings to active rcirc processes.
Kill processes that have not received a server message since the
@@ -602,7 +621,7 @@ last ping."
(setq header-line-format (format "%f" (- (rcirc-float-time)
(string-to-number message))))))
-(defvar rcirc-debug-buffer " *rcirc debug*")
+(defvar rcirc-debug-buffer "*rcirc debug*")
(defvar rcirc-debug-flag nil
"If non-nil, write information to `rcirc-debug-buffer'.")
(defun rcirc-debug (process text)
@@ -722,11 +741,14 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(mapconcat 'identity (cdr args) " ")
(not (member response rcirc-responses-no-activity))))
+(defun rcirc--connection-open-p (process)
+ (memq (process-status process) '(run open)))
+
(defun rcirc-send-string (process string)
"Send PROCESS a STRING plus a newline."
(let ((string (concat (encode-coding-string string rcirc-encode-coding-system)
"\n")))
- (unless (eq (process-status process) 'open)
+ (unless (rcirc--connection-open-p process)
(error "Network connection to %s is not open"
(process-name process)))
(rcirc-debug process string)
@@ -878,12 +900,12 @@ IRC command completion is performed only if '/' is the first input char."
(defun set-rcirc-decode-coding-system (coding-system)
"Set the decode coding system used in this channel."
(interactive "zCoding system for incoming messages: ")
- (setq rcirc-decode-coding-system coding-system))
+ (set (make-local-variable 'rcirc-decode-coding-system) coding-system))
(defun set-rcirc-encode-coding-system (coding-system)
"Set the encode coding system used in this channel."
(interactive "zCoding system for outgoing messages: ")
- (setq rcirc-encode-coding-system coding-system))
+ (set (make-local-variable 'rcirc-encode-coding-system) coding-system))
(defvar rcirc-mode-map
(let ((map (make-sparse-keymap)))
@@ -948,58 +970,44 @@ This number is independent of the number of lines in the buffer.")
(setq major-mode 'rcirc-mode)
(setq mode-line-process nil)
- (make-local-variable 'rcirc-input-ring)
- (setq rcirc-input-ring (make-ring rcirc-input-ring-size))
- (make-local-variable 'rcirc-server-buffer)
- (setq rcirc-server-buffer (process-buffer process))
- (make-local-variable 'rcirc-target)
- (setq rcirc-target target)
- (make-local-variable 'rcirc-topic)
- (setq rcirc-topic nil)
- (make-local-variable 'rcirc-last-post-time)
- (setq rcirc-last-post-time (current-time))
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'rcirc-fill-paragraph)
- (make-local-variable 'rcirc-recent-quit-alist)
- (setq rcirc-recent-quit-alist nil)
- (make-local-variable 'rcirc-current-line)
- (setq rcirc-current-line 0)
-
- (make-local-variable 'rcirc-short-buffer-name)
- (setq rcirc-short-buffer-name nil)
- (make-local-variable 'rcirc-urls)
- (setq use-hard-newlines t)
+ (set (make-local-variable 'rcirc-input-ring)
+ (make-ring rcirc-input-ring-size))
+ (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
+ (set (make-local-variable 'rcirc-target) target)
+ (set (make-local-variable 'rcirc-topic) nil)
+ (set (make-local-variable 'rcirc-last-post-time) (current-time))
+ (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
+ (set (make-local-variable 'rcirc-recent-quit-alist) nil)
+ (set (make-local-variable 'rcirc-current-line) 0)
+
+ (set (make-local-variable 'rcirc-short-buffer-name) nil)
+ (set (make-local-variable 'rcirc-urls) nil)
;; setup for omitting responses
(setq buffer-invisibility-spec '())
(setq buffer-display-table (make-display-table))
(set-display-table-slot buffer-display-table 4
- (let ((glyph (make-glyph-code
+ (let ((glyph (make-glyph-code
?. 'font-lock-keyword-face)))
(make-vector 3 glyph)))
- (make-local-variable 'rcirc-decode-coding-system)
- (make-local-variable 'rcirc-encode-coding-system)
(dolist (i rcirc-coding-system-alist)
(let ((chan (if (consp (car i)) (caar i) (car i)))
(serv (if (consp (car i)) (cdar i) "")))
(when (and (string-match chan (or target ""))
(string-match serv (rcirc-server-name process)))
- (setq rcirc-decode-coding-system (if (consp (cdr i)) (cadr i) (cdr i))
- rcirc-encode-coding-system (if (consp (cdr i)) (cddr i) (cdr i))))))
+ (set (make-local-variable 'rcirc-decode-coding-system)
+ (if (consp (cdr i)) (cadr i) (cdr i)))
+ (set (make-local-variable 'rcirc-encode-coding-system)
+ (if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
- (make-local-variable 'rcirc-prompt-start-marker)
- (setq rcirc-prompt-start-marker (make-marker))
- (set-marker rcirc-prompt-start-marker (point-max))
- (make-local-variable 'rcirc-prompt-end-marker)
- (setq rcirc-prompt-end-marker (make-marker))
- (set-marker rcirc-prompt-end-marker (point-max))
+ (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
+ (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
(rcirc-update-prompt)
(goto-char rcirc-prompt-end-marker)
- (make-local-variable 'overlay-arrow-position)
- (setq overlay-arrow-position (make-marker))
- (set-marker overlay-arrow-position nil)
+
+ (set (make-local-variable 'overlay-arrow-position) (make-marker))
;; if the user changes the major mode or kills the buffer, there is
;; cleanup work to do
@@ -1095,7 +1103,7 @@ Logfiles are kept in `rcirc-log-directory'."
(let ((buffer (current-buffer)))
(rcirc-clear-activity buffer)
(when (and (rcirc-buffer-process)
- (eq (process-status (rcirc-buffer-process)) 'open))
+ (rcirc--connection-open-p (rcirc-buffer-process)))
(with-rcirc-server-buffer
(setq rcirc-buffer-alist
(rassq-delete-all buffer rcirc-buffer-alist)))
@@ -1143,7 +1151,7 @@ Create the buffer if it doesn't exist."
(rcirc-generate-new-buffer-name process target))))
(with-current-buffer new-buffer
(rcirc-mode process target)
- (rcirc-put-nick-channel process (rcirc-nick process) target
+ (rcirc-put-nick-channel process (rcirc-nick process) target
rcirc-current-line))
new-buffer)))))
@@ -1222,13 +1230,15 @@ Create the buffer if it doesn't exist."
(concat command " :" args)))))))
(defvar rcirc-parent-buffer nil)
+(make-variable-buffer-local 'rcirc-parent-buffer)
+(put 'rcirc-parent-buffer 'permanent-local t)
(defvar rcirc-window-configuration nil)
(defun rcirc-edit-multiline ()
"Move current edit to a dedicated buffer."
(interactive)
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
- (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
+ (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
(point)))
(parent (buffer-name)))
(delete-region rcirc-prompt-end-marker (point))
@@ -1257,8 +1267,6 @@ Create the buffer if it doesn't exist."
:keymap rcirc-multiline-minor-mode-map
:global nil
:group 'rcirc
- (make-local-variable 'rcirc-parent-buffer)
- (put 'rcirc-parent-buffer 'permanent-local t)
(setq fill-column rcirc-max-message-length))
(defun rcirc-multiline-minor-submit ()
@@ -1469,7 +1477,7 @@ record activity."
(match-string 1 text)))
rcirc-ignore-list))
;; do not ignore if we sent the message
- (not (string= sender (rcirc-nick process))))
+ (not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
(inhibit-read-only t))
(with-current-buffer buffer
@@ -1477,9 +1485,8 @@ record activity."
(old-point (point-marker))
(fill-start (marker-position rcirc-prompt-start-marker)))
+ (setq text (decode-coding-string text rcirc-decode-coding-system))
(unless (string= sender (rcirc-nick process))
- ;; only decode text from other senders, not ours
- (setq text (decode-coding-string text rcirc-decode-coding-system))
;; mark the line with overlay arrow
(unless (or (marker-position overlay-arrow-position)
(get-buffer-window (current-buffer))
@@ -1648,8 +1655,8 @@ log-files with absolute names (see `rcirc-log-filename-function')."
(defun rcirc-view-log-file ()
"View logfile corresponding to the current buffer."
(interactive)
- (find-file-other-window
- (expand-file-name (funcall rcirc-log-filename-function
+ (find-file-other-window
+ (expand-file-name (funcall rcirc-log-filename-function
(rcirc-buffer-process) rcirc-target)
rcirc-log-directory)))
@@ -1842,6 +1849,8 @@ Uninteresting lines are those whose responses are listed in
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
(interactive)
+ (unless (buffer-live-p rcirc-server-buffer)
+ (error "No such buffer"))
(switch-to-buffer rcirc-server-buffer))
(defun rcirc-jump-to-first-unread-line ()
@@ -2394,7 +2403,8 @@ keywords when no KEYWORD is given."
(rcirc-record-activity (current-buffer) 'nick)))))
(defun rcirc-markup-urls (sender response)
- (while (re-search-forward rcirc-url-regexp nil t)
+ (while (and rcirc-url-regexp ;; nil means disable URL catching
+ (re-search-forward rcirc-url-regexp nil t))
(let ((start (match-beginning 0))
(end (match-end 0)))
(rcirc-add-face start end 'rcirc-url)
@@ -2436,7 +2446,7 @@ keywords when no KEYWORD is given."
rcirc-fill-column)
(t fill-column))
;; make sure ... doesn't cause line wrapping
- 3)))
+ 3)))
(fill-region (point) (point-max) nil t))))
;;; handlers
@@ -2803,7 +2813,7 @@ Passwords are stored in `rcirc-authinfo' (which see)."
;; quakenet authentication doesn't rely on the user's nickname.
;; the variable `nick' here represents the Q account name.
(when (eq method 'quakenet)
- (rcirc-send-privmsg
+ (rcirc-send-privmsg
process
"Q@CServe.quakenet.org"
(format "AUTH %s %s" nick (car args))))))))))
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 9862332bf3f..42c698876cd 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -729,9 +729,7 @@ traverse an element tree."
(incf nprocessed)
(soap-resolve-references-for-element e wsdl)
(setf (soap-element-namespace-tag e) nstag))))))
- (soap-namespace-elements ns))))
-
- (message "Processed %d" nprocessed))
+ (soap-namespace-elements ns)))))
wsdl)
;;;;; Loading WSDL from XML documents
@@ -1714,10 +1712,6 @@ operations in a WSDL document."
;; error)
(warn "Error in SOAP response: HTTP code %s"
url-http-response-status))
- (when (> (buffer-size) 1000000)
- (soap-warning
- "Received large message: %s bytes"
- (buffer-size)))
(let ((mime-part (mm-dissect-buffer t t)))
(unless mime-part
(error "Failed to decode response from server"))
@@ -1745,7 +1739,7 @@ operations in a WSDL document."
;;; Local Variables:
-;;; eval: (outline-minor-mode)
+;;; eval: (outline-minor-mode 1)
;;; outline-regexp: ";;;;+"
;;; End:
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index f8bc594e959..9397025cb60 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -176,10 +176,10 @@ Remove also properties of all files in subdirectories."
'directory-file-name (list directory))))
(tramp-message vec 8 "%s" directory)
(maphash
- '(lambda (key value)
- (when (and (stringp (tramp-file-name-localname key))
- (string-match directory (tramp-file-name-localname key)))
- (remhash key tramp-cache-data)))
+ (lambda (key value)
+ (when (and (stringp (tramp-file-name-localname key))
+ (string-match directory (tramp-file-name-localname key)))
+ (remhash key tramp-cache-data)))
tramp-cache-data)))
;; Reverting or killing a buffer should also flush file properties.
@@ -199,13 +199,13 @@ Remove also properties of all files in subdirectories."
(add-hook 'eshell-pre-command-hook 'tramp-flush-file-function)
(add-hook 'kill-buffer-hook 'tramp-flush-file-function)
(add-hook 'tramp-cache-unload-hook
- '(lambda ()
- (remove-hook 'before-revert-hook
- 'tramp-flush-file-function)
- (remove-hook 'eshell-pre-command-hook
- 'tramp-flush-file-function)
- (remove-hook 'kill-buffer-hook
- 'tramp-flush-file-function)))
+ (lambda ()
+ (remove-hook 'before-revert-hook
+ 'tramp-flush-file-function)
+ (remove-hook 'eshell-pre-command-hook
+ 'tramp-flush-file-function)
+ (remove-hook 'kill-buffer-hook
+ 'tramp-flush-file-function)))
;;; -- Properties --
@@ -289,18 +289,18 @@ KEY identifies the connection, it is either a process or a vector."
(when (hash-table-p table)
(let (result)
(maphash
- '(lambda (key value)
- (let ((tmp (format
- "(%s %s)"
- (if (processp key)
- (prin1-to-string (prin1-to-string key))
- (prin1-to-string key))
- (if (hash-table-p value)
- (tramp-cache-print value)
- (if (bufferp value)
- (prin1-to-string (prin1-to-string value))
- (prin1-to-string value))))))
- (setq result (if result (concat result " " tmp) tmp))))
+ (lambda (key value)
+ (let ((tmp (format
+ "(%s %s)"
+ (if (processp key)
+ (prin1-to-string (prin1-to-string key))
+ (prin1-to-string key))
+ (if (hash-table-p value)
+ (tramp-cache-print value)
+ (if (bufferp value)
+ (prin1-to-string (prin1-to-string value))
+ (prin1-to-string value))))))
+ (setq result (if result (concat result " " tmp) tmp))))
table)
result)))
@@ -309,9 +309,9 @@ KEY identifies the connection, it is either a process or a vector."
"Return a list of all known connection vectors according to `tramp-cache'."
(let (result)
(maphash
- '(lambda (key value)
- (when (and (vectorp key) (null (aref key 3)))
- (add-to-list 'result key)))
+ (lambda (key value)
+ (when (and (vectorp key) (null (aref key 3)))
+ (add-to-list 'result key)))
tramp-cache-data)
result))
@@ -326,13 +326,13 @@ KEY identifies the connection, it is either a process or a vector."
(let ((cache (copy-hash-table tramp-cache-data)))
;; Remove temporary data.
(maphash
- '(lambda (key value)
- (if (and (vectorp key) (not (tramp-file-name-localname key)))
- (progn
- (remhash "process-name" value)
- (remhash "process-buffer" value)
- (remhash "first-password-request" value))
- (remhash key cache)))
+ (lambda (key value)
+ (if (and (vectorp key) (not (tramp-file-name-localname key)))
+ (progn
+ (remhash "process-name" value)
+ (remhash "process-buffer" value)
+ (remhash "first-password-request" value))
+ (remhash key cache)))
cache)
;; Dump it.
(with-temp-buffer
@@ -356,9 +356,9 @@ KEY identifies the connection, it is either a process or a vector."
(unless noninteractive
(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
(add-hook 'tramp-cache-unload-hook
- '(lambda ()
- (remove-hook 'kill-emacs-hook
- 'tramp-dump-connection-properties)))
+ (lambda ()
+ (remove-hook 'kill-emacs-hook
+ 'tramp-dump-connection-properties)))
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
@@ -367,19 +367,23 @@ This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
(let (res)
(maphash
- '(lambda (key value)
- (if (and (vectorp key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key)))
- (push (list (tramp-file-name-user key)
- (tramp-file-name-host key))
- res)))
+ (lambda (key value)
+ (if (and (vectorp key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key)))
+ (push (list (tramp-file-name-user key)
+ (tramp-file-name-host key))
+ res)))
tramp-cache-data)
res))
;; Read persistent connection history.
(when (and (stringp tramp-persistency-file-name)
- (zerop (hash-table-count tramp-cache-data)))
+ (zerop (hash-table-count tramp-cache-data))
+ ;; When "emacs -Q" has been called, both variables are nil.
+ ;; We do not load the persistency file then, in order to
+ ;; have a clean test environment.
+ (or init-file-user site-run-file))
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 58f1e2c6a9e..fcf523a7068 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -100,6 +100,15 @@ When called interactively, a Tramp connection has to be selected."
(when (bufferp buf) (kill-buffer buf)))))
;;;###tramp-autoload
+(defun tramp-cleanup-this-connection ()
+ "Flush all connection related objects of the current buffer's connection."
+ (interactive)
+ (and (stringp default-directory)
+ (file-remote-p default-directory)
+ (tramp-cleanup-connection
+ (tramp-dissect-file-name default-directory 'noexpand))))
+
+;;;###tramp-autoload
(defun tramp-cleanup-all-connections ()
"Flush all Tramp internal objects.
This includes password cache, file cache, connection cache, buffers."
@@ -258,8 +267,8 @@ buffer in your bug report.
(dolist (buffer
(delq nil
(mapcar
- '(lambda (b)
- (when (string-match "\\*tramp/" (buffer-name b)) b))
+ (lambda (b)
+ (when (string-match "\\*tramp/" (buffer-name b)) b))
(buffer-list))))
(let ((reporter-eval-buffer buffer)
(buffer-name (buffer-name buffer))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 3c0642c3c78..460c9f0e118 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,9 +23,9 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is GNU Emacs 24. This
-;; package provides compatibility functions for GNU Emacs 22, GNU
-;; Emacs 23 and XEmacs 21.4+.
+;; Tramp's main Emacs version for development is Emacs 24. This
+;; package provides compatibility functions for Emacs 22, Emacs 23,
+;; XEmacs 21.4+ and SXEmacs 22.
;;; Code:
@@ -286,9 +286,8 @@ Not actually used. Use `(format \"%o\" i)' instead?"
(tramp-compat-funcall 'file-attributes filename id-format)
(wrong-number-of-arguments (file-attributes filename))))))
-;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
-;; hurt to ignore it for other (X)Emacs versions.
-;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.
+;; PRESERVE-UID-GID does not exist in XEmacs.
+;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.1.
(defun tramp-compat-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-selinux-context)
@@ -484,10 +483,7 @@ exiting if process is running."
(tramp-compat-funcall 'set-process-query-on-exit-flag process flag)
(tramp-compat-funcall 'process-kill-without-query process flag)))
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-compat 'force)))
-
+;; There exist different implementations for this function.
(defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
EOL-TYPE can be one of `dos', `unix', or `mac'."
@@ -506,6 +502,10 @@ EOL-TYPE can be one of `dos', `unix', or `mac'."
"`dos', `unix', or `mac'")))))
(t (error "Can't change EOL conversion -- is MULE missing?"))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-compat 'force)))
+
(provide 'tramp-compat)
;;; TODO:
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index f048208ea41..71b3eacccea 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -113,20 +113,22 @@ present for backward compatibility."
(list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)))
;; Add completion function for FTP method.
-(tramp-set-completion-function
- tramp-ftp-method
- '((tramp-parse-netrc "~/.netrc")))
+;;;###tramp-autoload
+(eval-after-load 'tramp
+ '(tramp-set-completion-function
+ tramp-ftp-method
+ '((tramp-parse-netrc "~/.netrc"))))
;; If there is URL syntax, `substitute-in-file-name' needs special
;; handling.
(put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name)
(add-hook 'tramp-ftp-unload-hook
- '(lambda ()
- (setplist 'substitute-in-file-name
- (delete 'ange-ftp
- (delete 'tramp-handle-substitute-in-file-name
- (symbol-plist
- 'substitute-in-file-name))))))
+ (lambda ()
+ (setplist 'substitute-in-file-name
+ (delete 'ange-ftp
+ (delete 'tramp-handle-substitute-in-file-name
+ (symbol-plist
+ 'substitute-in-file-name))))))
;;;###tramp-autoload
(defun tramp-ftp-file-name-handler (operation &rest args)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index b3278dc312d..269b47be20c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -541,7 +541,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
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(condition-case err
(let ((args
@@ -745,7 +745,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
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(condition-case err
(rename-file
@@ -1203,7 +1203,7 @@ connection if a previous connection has died for some reason."
(tramp-gvfs-object-path
(tramp-make-tramp-file-name method user host ""))))
- (with-progress-reporter
+ (tramp-with-progress-reporter
vec 3
(if (zerop (length user))
(format "Opening connection for %s using %s" host method)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index cc404baef06..1c6f0844be0 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -66,6 +66,9 @@ files conditionalize this setup based on the TERM environment variable."
:group 'tramp
:type 'string)
+(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m"
+ "Escape sequences produced by the \"ls\" command.")
+
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
;; root users. It uses the `$' character for other users. In order
;; to guarantee a proper prompt, we use "#$ " for the prompt.
@@ -400,11 +403,13 @@ detected as prompt when being sent on echoing hosts, therefore.")
"\\'")
nil ,(user-login-name)))
+;;;###tramp-autoload
(defconst tramp-completion-function-alist-rsh
'((tramp-parse-rhosts "/etc/hosts.equiv")
(tramp-parse-rhosts "~/.rhosts"))
"Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
+;;;###tramp-autoload
(defconst tramp-completion-function-alist-ssh
'((tramp-parse-rhosts "/etc/hosts.equiv")
(tramp-parse-rhosts "/etc/shosts.equiv")
@@ -420,47 +425,60 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
"Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
+;;;###tramp-autoload
(defconst tramp-completion-function-alist-telnet
'((tramp-parse-hosts "/etc/hosts"))
"Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
+;;;###tramp-autoload
(defconst tramp-completion-function-alist-su
'((tramp-parse-passwd "/etc/passwd"))
"Default list of (FUNCTION FILE) pairs to be examined for su methods.")
+;;;###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-set-completion-function "rcp" tramp-completion-function-alist-rsh)
-(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
-(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "rsyncc" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
-(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
-(tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "ssh1_old" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "ssh2_old" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet)
-(tramp-set-completion-function "su" tramp-completion-function-alist-su)
-(tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
-(tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
-(tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh)
-(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "plink1" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty)
-(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
-(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)
+;;;###tramp-autoload
+(eval-after-load 'tramp
+ '(progn
+ (tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "rsyncc" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "ssh1_old" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "ssh2_old" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "telnet" tramp-completion-function-alist-telnet)
+ (tramp-set-completion-function "su" tramp-completion-function-alist-su)
+ (tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
+ (tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
+ (tramp-set-completion-function
+ "krlogin" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "plink1" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "plinkx" tramp-completion-function-alist-putty)
+ (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)))
;; "getconf PATH" yields:
;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
@@ -469,7 +487,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
;; IRIX64: /usr/bin
(defcustom tramp-remote-path
- '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
+ '(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.
@@ -1945,7 +1963,7 @@ file names."
(tramp-error
v 'file-already-exists "File %s already exists" newname))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 0 (format "%s %s to %s"
(if (eq op 'copy) "Copying" "Renaming")
filename newname)
@@ -2454,7 +2472,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
nil)
((and suffix (nth 2 suffix))
;; We found an uncompression rule.
- (with-progress-reporter v 0 (format "Uncompressing %s" file)
+ (tramp-with-progress-reporter
+ v 0 (format "Uncompressing %s" file)
(when (tramp-send-command-and-check
v (concat (nth 2 suffix) " "
(tramp-shell-quote-argument localname)))
@@ -2465,7 +2484,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.
- (with-progress-reporter v 0 (format "Compressing %s" file)
+ (tramp-with-progress-reporter v 0 (format "Compressing %s" file)
(when (tramp-send-command-and-check
v (concat "gzip -f "
(tramp-shell-quote-argument localname)))
@@ -2566,6 +2585,12 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(forward-line 1)
(delete-region (match-beginning 0) (point)))
+ ;; Some busyboxes are reluctant to discard colors.
+ (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
+ (goto-char beg)
+ (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
+ (replace-match "")))
+
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
(goto-char (point-max))
@@ -2653,6 +2678,7 @@ the result will be a local, non-Tramp, filename."
(let ((vec (tramp-get-connection-property proc "vector" nil)))
(when vec
(tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event)
+ (tramp-flush-connection-property proc)
(tramp-flush-directory-property vec "")))))
;; We use BUFFER also as connection buffer during setup. Because of
@@ -2664,8 +2690,13 @@ the result will be a local, non-Tramp, filename."
;; When PROGRAM is nil, we just provide a tty.
(let ((command
(when (stringp program)
- (format "cd %s; exec %s"
+ (format "cd %s; exec env PS1=%s %s"
(tramp-shell-quote-argument localname)
+ ;; Use a human-friendly prompt, for example for `shell'.
+ (tramp-shell-quote-argument
+ (format "%s %s"
+ (file-remote-p default-directory)
+ tramp-initial-end-of-output))
(mapconcat 'tramp-shell-quote-argument
(cons program args) " "))))
(tramp-process-connection-type
@@ -2705,9 +2736,7 @@ the result will be a local, non-Tramp, filename."
v 'file-error
"pty association is not supported for `%s'" name)))))
(let ((p (tramp-get-connection-process v)))
- ;; Set sentinel and query flag for this process.
- (tramp-set-connection-property p "vector" v)
- (set-process-sentinel p 'tramp-process-sentinel)
+ ;; Set query flag for this process.
(tramp-compat-set-process-query-on-exit-flag p t)
;; Return process.
p)))
@@ -2948,7 +2977,7 @@ the result will be a local, non-Tramp, filename."
;; Use inline encoding for file transfer.
(rem-enc
(save-excursion
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Encoding remote file %s" filename)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
@@ -2962,7 +2991,7 @@ the result will be a local, non-Tramp, filename."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-buffer-substring (tramp-get-buffer v))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Decoding remote file %s with function %s"
filename loc-dec)
(funcall loc-dec (point-min) (point-max))
@@ -2980,7 +3009,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))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Decoding remote file %s with command %s"
filename loc-dec)
(unwind-protect
@@ -3205,7 +3234,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)
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Encoding region using function `%s'"
loc-enc)
(let ((coding-system-for-read 'binary))
@@ -3223,7 +3252,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))))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Encoding region using command `%s'"
loc-enc)
(unless (zerop (tramp-call-local-coding-command
@@ -3237,7 +3266,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.
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3
(format "Decoding region into remote file %s" filename)
(goto-char (point-max))
@@ -3337,7 +3366,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
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
@@ -3431,7 +3460,7 @@ Only send the definition if it has not already been done."
(let* ((p (tramp-get-connection-process vec))
(scripts (tramp-get-connection-property p "scripts" nil)))
(unless (member name scripts)
- (with-progress-reporter vec 5 (format "Sending script `%s'" name)
+ (tramp-with-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
@@ -3595,7 +3624,8 @@ file exists and nonzero exit status otherwise."
(defun tramp-open-shell (vec shell)
"Opens shell SHELL."
- (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
+ (tramp-with-progress-reporter
+ vec 5 (format "Opening remote shell `%s'" shell)
;; Find arguments for this shell.
(let ((tramp-end-of-output tramp-initial-end-of-output)
(alist tramp-sh-extra-args)
@@ -3624,9 +3654,11 @@ file exists and nonzero exit status otherwise."
(tramp-send-command vec "echo ~root" t)
(cond
((or (string-match "^~root$" (buffer-string))
- ;; The default shell (ksh93) of OpenSolaris is buggy.
- (string-equal (tramp-get-connection-property vec "uname" "")
- "SunOS 5.11"))
+ ;; 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)
@@ -3815,10 +3847,9 @@ process to set up. VEC specifies the connection."
(tramp-send-command vec "stty -oxtabs" t))
;; Set `remote-tty' process property.
- (ignore-errors
- (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"")))
- (unless (zerop (length tty))
- (tramp-compat-process-put proc 'remote-tty tty))))
+ (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
+ (unless (zerop (length tty))
+ (tramp-compat-process-put proc 'remote-tty tty)))
;; Dump stty settings in the traces.
(when (>= tramp-verbose 9)
@@ -4247,7 +4278,7 @@ 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)
- (with-progress-reporter
+ (tramp-with-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(format "Opening connection for %s using %s"
@@ -4272,16 +4303,24 @@ connection if a previous connection has died for some reason."
;; This must be done in order to avoid our file name handler.
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
- (start-process
+ (apply
+ 'start-process
(tramp-get-connection-name vec)
(tramp-get-connection-buffer vec)
- tramp-encoding-shell))))
+ (if tramp-encoding-command-interactive
+ (list tramp-encoding-shell
+ tramp-encoding-command-interactive)
+ (list tramp-encoding-shell))))))
+
+ ;; Set sentinel and query flag.
+ (tramp-set-connection-property p "vector" vec)
+ (set-process-sentinel p 'tramp-process-sentinel)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
;; Check whether process is alive.
- (tramp-compat-set-process-query-on-exit-flag p nil)
(tramp-barf-if-no-shell-prompt
p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
@@ -4469,9 +4508,10 @@ FMT and ARGS which are passed to `error'."
(unless (tramp-send-command-and-check vec command)
(apply 'tramp-error vec 'file-error fmt args)))
-(defun tramp-send-command-and-read (vec command)
+(defun tramp-send-command-and-read (vec command &optional noerror)
"Run COMMAND and return the output, which must be a Lisp expression.
-In case there is no valid Lisp expression, it raises an error"
+In case there is no valid Lisp expression and NOERROR is nil, it
+raises an error."
(tramp-barf-unless-okay vec command "`%s' returns with error" command)
(with-current-buffer (tramp-get-connection-buffer vec)
;; Read the expression.
@@ -4481,16 +4521,21 @@ In case there is no valid Lisp expression, it raises an error"
;; Error handling.
(when (re-search-forward "\\S-" (point-at-eol) t)
(error nil)))
- (error (tramp-error
- vec 'file-error
- "`%s' does not return a valid Lisp expression: `%s'"
- command (buffer-string))))))
+ (error (unless noerror
+ (tramp-error
+ vec 'file-error
+ "`%s' does not return a valid Lisp expression: `%s'"
+ command (buffer-string)))))))
(defun tramp-convert-file-attributes (vec attr)
"Convert file-attributes ATTR generated by perl script, stat or ls.
Convert file mode bits to string and set virtual device number.
Return ATTR."
(when attr
+ ;; Remove color escape sequences from symlink.
+ (when (stringp (car attr))
+ (while (string-match tramp-color-escape-sequence-regexp (car attr))
+ (setcar attr (replace-match "" nil nil (car attr)))))
;; Convert last access time.
(unless (listp (nth 4 attr))
(setcar (nthcdr 4 attr)
@@ -4642,6 +4687,8 @@ This is used internally by `tramp-file-mode-from-int'."
(and
;; It shall be an out-of-band method.
(tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
+ ;; There must be a size, otherwise the file doesn't exist.
+ (numberp size)
;; Either the file size is large enough, or (in rare cases) there
;; does not exist a remote encoding.
(or (null tramp-copy-size-limit)
@@ -4666,8 +4713,7 @@ This is used internally by `tramp-file-mode-from-int'."
(when elt1
(or
(tramp-send-command-and-read
- vec
- "x=`getconf PATH 2>/dev/null` && echo \\\"$x\\\" || echo nil")
+ vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
;; Default if "getconf" is not available.
(progn
(tramp-message
@@ -4829,15 +4875,12 @@ This is used internally by `tramp-file-mode-from-int'."
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
tmp)
- ;; Check whether stat(1) returns usable syntax. %s does not
+ ;; Check whether stat(1) returns usable syntax. "%s" does not
;; work on older AIX systems.
(when result
(setq tmp
- ;; We don't want to display an error message.
- (tramp-compat-with-temp-message (or (current-message) "")
- (ignore-errors
- (tramp-send-command-and-read
- vec (format "%s -c '(\"%%N\" %%s)' /" result)))))
+ (tramp-send-command-and-read
+ vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror))
(unless (and (listp tmp) (stringp (car tmp))
(string-match "^./.$" (car tmp))
(integerp (cadr tmp)))
@@ -4850,11 +4893,8 @@ This is used internally by `tramp-file-mode-from-int'."
(let ((result (tramp-find-executable
vec "readlink" (tramp-get-remote-path vec))))
(when (and result
- ;; We don't want to display an error message.
- (tramp-compat-with-temp-message (or (current-message) "")
- (ignore-errors
- (tramp-send-command-and-check
- vec (format "%s --canonicalize-missing /" result)))))
+ (tramp-send-command-and-check
+ vec (format "%s --canonicalize-missing /" result)))
result))))
(defun tramp-get-remote-trash (vec)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 5a62b71bda1..eb456298c1a 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -53,9 +53,11 @@
`(,(concat "\\`" tramp-smb-method "\\'") nil nil))
;; Add completion function for SMB method.
-(tramp-set-completion-function
- tramp-smb-method
- '((tramp-parse-netrc "~/.netrc")))
+;;;###tramp-autoload
+(eval-after-load 'tramp
+ '(tramp-set-completion-function
+ tramp-smb-method
+ '((tramp-parse-netrc "~/.netrc"))))
(defcustom tramp-smb-program "smbclient"
"*Name of SMB client to run."
@@ -342,7 +344,7 @@ KEEP-DATE is not handled 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))
- (with-progress-reporter
+ (tramp-with-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
@@ -600,7 +602,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)))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(unless (tramp-smb-send-command
v (format "get \"%s\" \"%s\""
@@ -837,7 +839,7 @@ target of the symlink differ."
"Like `rename-file' for Tramp files."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (with-progress-reporter
+ (tramp-with-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
@@ -926,7 +928,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)))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
(unwind-protect
(unless (tramp-smb-send-command
@@ -1289,7 +1291,7 @@ connection if a previous connection has died for some reason."
(setq args (append args (list "-s" tramp-smb-conf))))
;; OK, let's go.
- (with-progress-reporter
+ (tramp-with-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
(if (not (zerop (length user))) (concat user "@") "")
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 693e082ecc8..82d878a6fa8 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -159,6 +159,9 @@ For encoding and deocding, commands like the following are executed:
This variable can be used to change the \"/bin/sh\" part. See the
variable `tramp-encoding-command-switch' for the \"-c\" part.
+If the shell must be forced to be interactive, see
+`tramp-encoding-command-interactive'.
+
Note that this variable is not used for remote commands. There are
mechanisms in tramp.el which automatically determine the right shell to
use for the remote host."
@@ -174,6 +177,13 @@ 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.
+See the variable `tramp-encoding-shell' for more information."
+ :group 'tramp
+ :type '(choice (const nil) string))
+
;;;###tramp-autoload
(defvar tramp-methods nil
"*Alist of methods for remote files.
@@ -1316,7 +1326,8 @@ ARGS to actually emit the message (if applicable)."
"tramp-debug-message"
"tramp-error"
"tramp-error-with-buffer"
- "tramp-message")
+ "tramp-message"
+ "tramp-with-progress-reporter")
t)
"$")
fn)))
@@ -1452,11 +1463,12 @@ 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 with-progress-reporter (vec level message &rest body)
+(defmacro tramp-with-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
progress reporter."
+ (declare (indent 3) (debug t))
`(let (pr tm)
(tramp-message ,vec ,level "%s..." ,message)
;; We start a pulsing progress reporter after 3 seconds. Feature
@@ -1479,10 +1491,8 @@ progress reporter."
(if tm (tramp-compat-funcall 'cancel-timer tm))
(tramp-message ,vec ,level "%s...done" ,message))))
-(put 'with-progress-reporter 'lisp-indent-function 3)
-(put 'with-progress-reporter 'edebug-form-spec t)
(tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
+ 'emacs-lisp-mode '("\\<tramp-with-progress-reporter\\>"))
(eval-and-compile ;; Silence compiler.
(if (memq system-type '(cygwin windows-nt))
@@ -1501,6 +1511,7 @@ letter into the file name. This function removes it."
;;; Config Manipulation Functions:
+;;;###tramp-autoload
(defun tramp-set-completion-function (method function-list)
"Sets the list of completion functions for METHOD.
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
@@ -2367,6 +2378,7 @@ 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)
"Return a list of (user host) tuples allowed to access.
Either user or host may be nil."
@@ -2397,6 +2409,7 @@ Either user or host may be nil."
(forward-line 1)
result))
+;;;###tramp-autoload
(defun tramp-parse-shosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
@@ -2426,6 +2439,7 @@ User is always nil."
(forward-line 1))
result))
+;;;###tramp-autoload
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
@@ -2455,6 +2469,7 @@ User is always nil."
(forward-line 1))
result))
+;;;###tramp-autoload
(defun tramp-parse-shostkeys (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
@@ -2486,6 +2501,7 @@ User is always nil."
(setq files (cdr files)))
result))
+;;;###tramp-autoload
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
@@ -2520,6 +2536,7 @@ User is always nil."
;; as default. Unfortunately, we have no information whether any user name
;; has been typed already. So we use `tramp-current-user' as indication,
;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
+;;;###tramp-autoload
(defun tramp-parse-passwd (filename)
"Return a list of (user host) tuples allowed to access.
Host is always \"localhost\"."
@@ -2549,6 +2566,7 @@ Host is always \"localhost\"."
(forward-line 1)
result))
+;;;###tramp-autoload
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
@@ -2579,6 +2597,7 @@ User may be nil."
(forward-line 1)
result))
+;;;###tramp-autoload
(defun tramp-parse-putty (registry)
"Return a list of (user host) tuples allowed to access.
User is always nil."
@@ -2838,16 +2857,16 @@ User is always nil."
v
(cond
((and beg end)
- (format "tail -c +%d %s | head -c +%d >%s"
- (1+ beg) (tramp-shell-quote-argument localname)
+ (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+ beg (tramp-shell-quote-argument localname)
(- end beg) remote-copy))
(beg
- (format "tail -c +%d %s >%s"
- (1+ beg) (tramp-shell-quote-argument localname)
+ (format "dd bs=1 skip=%d if=%s of=%s"
+ beg (tramp-shell-quote-argument localname)
remote-copy))
(end
- (format "head -c +%d %s >%s"
- (1+ end) (tramp-shell-quote-argument localname)
+ (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
@@ -2881,7 +2900,7 @@ User is always nil."
;; useful for "rsync".
(setq tramp-temp-buffer-file-name local-copy))
- (with-progress-reporter
+ (tramp-with-progress-reporter
v 3 (format "Inserting local temp file `%s'" local-copy)
;; We must ensure that `file-coding-system-alist'
;; matches `local-copy'.
@@ -2932,7 +2951,7 @@ User is always nil."
(if (not (file-exists-p file))
nil
(let ((tramp-message-show-message (not nomessage)))
- (with-progress-reporter v 0 (format "Loading %s" file)
+ (tramp-with-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
@@ -3105,8 +3124,13 @@ 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.
- (tramp-set-connection-property vec "first-password-request" t)
+ ;; 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
+ (tramp-make-tramp-file-name
+ tramp-current-method tramp-current-user tramp-current-host ""))
+ "first-password-request" t)
(save-restriction
(let (exit)
(while (not exit)
@@ -3544,16 +3568,16 @@ Invokes `password-read' if available, `read-passwd' else."
;; Try with Tramp's current method.
(if (fboundp 'auth-source-search)
(setq auth-info
- (tramp-compat-funcall
- 'auth-source-search
- :max 1
- :user (or tramp-current-user t)
- :host tramp-current-host
- :port tramp-current-method)
- auth-passwd (plist-get (nth 0 auth-info) :secret)
- auth-passwd (if (functionp auth-passwd)
- (funcall auth-passwd)
- auth-passwd))
+ (tramp-compat-funcall
+ 'auth-source-search
+ :max 1
+ :user (or tramp-current-user t)
+ :host tramp-current-host
+ :port tramp-current-method)
+ auth-passwd (plist-get (nth 0 auth-info) :secret)
+ auth-passwd (if (functionp auth-passwd)
+ (funcall auth-passwd)
+ auth-passwd))
(tramp-compat-funcall
'auth-source-user-or-password
"password" tramp-current-host tramp-current-method)))
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index be79bc721e2..3a2560b3c61 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -447,11 +447,11 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
(or (null str) (string-match "^[ \t]*$" str)))
(defun webjump-url-encode (str)
- (mapconcat '(lambda (c)
- (let ((s (char-to-string c)))
- (cond ((string= s " ") "+")
- ((string-match "[a-zA-Z_.-/]" s) s)
- (t (upcase (format "%%%02x" c))))))
+ (mapconcat (lambda (c)
+ (let ((s (char-to-string c)))
+ (cond ((string= s " ") "+")
+ ((string-match "[a-zA-Z_.-/]" s) s)
+ (t (upcase (format "%%%02x" c))))))
(encode-coding-string str 'utf-8)
""))
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index d3530b1be3e..a1d77ccc6e0 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -118,7 +118,7 @@ at the place matched by the close of the first pair.")
;;;###autoload
(defvar comment-end-skip nil
- "Regexp to match the end of a comment plus everything up to its body.")
+ "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
@@ -722,7 +722,7 @@ With any other arg, set comment column to indentation of the previous comment
With prefix ARG, kill comments on that many lines starting with this one."
(interactive "P")
(comment-normalize-vars)
- (dotimes (i (prefix-numeric-value arg))
+ (dotimes (_i (prefix-numeric-value arg))
(save-excursion
(beginning-of-line)
(let ((cs (comment-search-forward (line-end-position) t)))
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 993a6f7a2ab..93e5f9d25f4 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -1263,9 +1263,9 @@ on the line, reindent the line."
(nxml-scan-error nil))
(when (and (eq (nxml-token-before) (point))
(eq xmltok-type 'partial-empty-element))
- (insert ">")))
- (when (and end-tag-p at-indentation)
- (nxml-indent-line))))))
+ (insert ">"))))
+ (when (and end-tag-p at-indentation)
+ (nxml-indent-line)))))
(defun nxml-balanced-close-start-tag-block ()
"Close the start-tag before point with `>' and insert a balancing end-tag.
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index d31740f0ca2..bd5b3136d54 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -224,19 +224,13 @@
;;; Timing
-(defun rng-time-to-float (time)
- (+ (* (nth 0 time) 65536.0)
- (nth 1 time)
- (/ (nth 2 time) 1000000.0)))
-
(defun rng-time-function (function &rest args)
(let* ((start (current-time))
(val (apply function args))
(end (current-time)))
(message "%s ran in %g seconds"
function
- (- (rng-time-to-float end)
- (rng-time-to-float start)))
+ (float-time (time-subtract end start)))
val))
(defun rng-time-tokenize-buffer ()
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 266f8daac9e..b481039fdab 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -238,7 +238,7 @@ must be equal."
obj)))
(defun rng-xsd-check-pattern (str regexp convert &rest args)
- (and (string-match regexp str)
+ (and (let ((case-fold-search nil)) (string-match regexp str))
(apply convert (cons str args))))
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
new file mode 100644
index 00000000000..b45003fcecc
--- /dev/null
+++ b/lisp/obsolete/old-emacs-lock.el
@@ -0,0 +1,102 @@
+;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked
+
+;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc
+
+;; Author: Tom Wurgler <twurgler@goodyear.com>
+;; Created: 12/8/94
+;; Keywords: extensions, processes
+;; Obsolete-since: 24.1
+
+;; 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 code sets a buffer-local variable to t if toggle-emacs-lock is run,
+;; then if the user attempts to exit Emacs, the locked buffer name will be
+;; displayed and the exit aborted. This is just a way of protecting
+;; yourself from yourself. For example, if you have a shell running a big
+;; program and exiting Emacs would abort that program, you may want to lock
+;; that buffer, then if you forget about it after a while, you won't
+;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and
+;; run toggle-emacs-lock again.
+
+;;; Code:
+
+(defvar emacs-lock-from-exiting nil
+ "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.")
+(make-variable-buffer-local 'emacs-lock-from-exiting)
+
+(defvar emacs-lock-buffer-locked nil
+ "Whether a shell or telnet buffer was locked when its process was killed.")
+(make-variable-buffer-local 'emacs-lock-buffer-locked)
+(put 'emacs-lock-buffer-locked 'permanent-local t)
+
+(defun check-emacs-lock ()
+ "Check if variable `emacs-lock-from-exiting' is t for any buffer.
+If any locked buffer is found, signal error and display the buffer's name."
+ (save-excursion
+ (dolist (buffer (buffer-list))
+ (set-buffer buffer)
+ (when emacs-lock-from-exiting
+ (error "Emacs is locked from exit due to buffer: %s" (buffer-name))))))
+
+(defun toggle-emacs-lock ()
+ "Toggle `emacs-lock-from-exiting' for the current buffer.
+See `check-emacs-lock'."
+ (interactive)
+ (setq emacs-lock-from-exiting (not emacs-lock-from-exiting))
+ (if emacs-lock-from-exiting
+ (message "Buffer is now locked")
+ (message "Buffer is now unlocked")))
+
+(defun emacs-lock-check-buffer-lock ()
+ "Check if variable `emacs-lock-from-exiting' is t for a buffer.
+If the buffer is locked, signal error and display its name."
+ (when emacs-lock-from-exiting
+ (error "Buffer `%s' is locked, can't delete it" (buffer-name))))
+
+; These next defuns make it so if you exit a shell that is locked, the lock
+; is shut off for that shell so you can exit Emacs. Same for telnet.
+; Also, if a shell or a telnet buffer was locked and the process killed,
+; turn the lock back on again if the process is restarted.
+
+(defun emacs-lock-shell-sentinel ()
+ (set-process-sentinel
+ (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel)))
+
+(defun emacs-lock-clear-sentinel (_proc _str)
+ (if emacs-lock-from-exiting
+ (progn
+ (setq emacs-lock-from-exiting nil)
+ (setq emacs-lock-buffer-locked t)
+ (message "Buffer is now unlocked"))
+ (setq emacs-lock-buffer-locked nil)))
+
+(defun emacs-lock-was-buffer-locked ()
+ (if emacs-lock-buffer-locked
+ (setq emacs-lock-from-exiting t)))
+
+(unless noninteractive
+ (add-hook 'kill-emacs-hook 'check-emacs-lock))
+(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock)
+(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked)
+(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel)
+(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked)
+(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel)
+
+(provide 'emacs-lock)
+
+;;; emacs-lock.el ends here
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index ba05f894d50..d9ca232c9d0 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,11 @@
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ Fix doubled-word typos.
+ * org-agenda.el (org-agenda-entry-types): the the -> the
+ * org-table.el (org-table-get-remote-range): or or -> or
+ * org-wl.el (org-wl-folder-type): the the -> the
+ * org.el (org-goto, org-inside-LaTeX-fragment-p): Likewise.
+
2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
* org-src.el (org-src-switch-to-buffer):
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 9adc180b28e..8aeb4c4e5b2 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -3370,7 +3370,7 @@ By default, all four types are turned on.
Never set this variable globally using `setq', because then it
will apply to all future agenda commands. Instead, bind it with
-`let' to scope it dynamically into the the agenda-constructing
+`let' to scope it dynamically into the agenda-constructing
command. A good way to set it is through options in
`org-agenda-custom-commands'. For a more flexible (though
somewhat less efficient) way of determining what is included in
diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el
index d5964538a9c..fbe0c0a30a3 100644
--- a/lisp/org/org-ascii.el
+++ b/lisp/org/org-ascii.el
@@ -369,55 +369,55 @@ publishing directory."
(push (concat (nth 3 lang-words) "\n") thetoc)
(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)))
+ (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)))
; 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)))
+
+ (if org-export-with-section-numbers
+ (setq txt (concat (org-section-number level)
+ " " txt)))
+ (if (<= level umax-toc)
+ (progn
+ (push
+ (concat
+ (make-string
+ (* (max 0 (- level org-min-level)) 4) ?\ )
+ (format (if todo "%s (*)\n" "%s\n") txt))
+ thetoc)
+ (setq org-last-level level))
+ ))))
lines)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index c9679edc65a..ae97db20f70 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -246,10 +246,10 @@ This checks for the existence of a \".git\" directory in that directory."
(cd dir)
(shell-command "git add .")
(shell-command "git ls-files --deleted" t)
- (mapc '(lambda (file)
- (unless (string= file "")
- (shell-command
- (concat "git rm \"" file "\""))))
+ (mapc (lambda (file)
+ (unless (string= file "")
+ (shell-command
+ (concat "git rm \"" file "\""))))
(split-string (buffer-string) "\n"))
(shell-command "git commit -m 'Synchronized attachments'")))))
diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el
index 002ad025fbe..3278d108b52 100644
--- a/lisp/org/org-exp.el
+++ b/lisp/org/org-exp.el
@@ -2136,7 +2136,7 @@ TYPE must be a string, any of:
markup (org-symname-or-string (pop params))
lang (and (member markup '("src" "SRC"))
(org-symname-or-string (pop params)))
- switches (mapconcat '(lambda (x) (format "%s" x)) params " ")
+ switches (mapconcat (lambda (x) (format "%s" x)) params " ")
start nil end nil)
(delete-region (match-beginning 0) (match-end 0))
(if (or (not file)
diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el
index a6933978710..8ccca0ca987 100644
--- a/lisp/org/org-html.el
+++ b/lisp/org/org-html.el
@@ -1090,74 +1090,74 @@ 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)))
- ;; 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 (save-match-data
- (org-html-expand
- (org-export-cleanup-toc-line
- (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)))
+ (mapcar (lambda (line)
+ (if (and (string-match org-todo-line-regexp line)
+ (not (get-text-property 0 'org-protected 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 (save-match-data
+ (org-html-expand
+ (org-export-cleanup-toc-line
+ (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))))
- (if (string-match
- (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") 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))
- (if org-export-with-section-numbers
- (setq txt (concat snumber " " txt)))
- (if (<= level (max umax umax-toc))
- (setq head-count (+ head-count 1)))
- (if (<= level umax-toc)
- (progn
- (if (> level org-last-level)
- (progn
- (setq cnt (- level org-last-level))
- (while (>= (setq cnt (1- cnt)) 0)
- (push "\n<ul>\n<li>" thetoc))
- (push "\n" thetoc)))
- (if (< level org-last-level)
- (progn
- (setq cnt (- org-last-level level))
- (while (>= (setq cnt (1- cnt)) 0)
- (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 "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
- (setq txt (replace-match "" t t txt)))
- (setq href
- (replace-regexp-in-string
- "\\." "_" (format "sec-%s" snumber)))
- (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
- (push
- (format
- (if todo
- "</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)
+ (and org-export-mark-todo-in-toc
+ (= level umax-toc)
+ (org-search-todo-below
+ 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)))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq snumber (org-section-number level))
+ (if org-export-with-section-numbers
+ (setq txt (concat snumber " " txt)))
+ (if (<= level (max umax umax-toc))
+ (setq head-count (+ head-count 1)))
+ (if (<= level umax-toc)
+ (progn
+ (if (> level org-last-level)
+ (progn
+ (setq cnt (- level org-last-level))
+ (while (>= (setq cnt (1- cnt)) 0)
+ (push "\n<ul>\n<li>" thetoc))
+ (push "\n" thetoc)))
+ (if (< level org-last-level)
+ (progn
+ (setq cnt (- org-last-level level))
+ (while (>= (setq cnt (1- cnt)) 0)
+ (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 "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq href
+ (replace-regexp-in-string
+ "\\." "_" (format "sec-%s" snumber)))
+ (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
+ (push
+ (format
+ (if todo
+ "</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)
lines))
(while (> org-last-level (1- org-min-level))
(setq org-last-level (1- org-last-level))
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index cec19d89de1..ddd476e98b2 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -526,7 +526,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Check Tags"
,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
- '(lambda (tag) (org-tags-sparse-tree nil tag)))
+ (lambda (tag) (org-tags-sparse-tree nil tag)))
"--"
["Custom Tag ..." org-tags-sparse-tree t])
["Check Phrase ..." org-occur]
@@ -537,18 +537,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Display Tags"
,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
- '(lambda (tag) (org-tags-view nil tag)))
+ (lambda (tag) (org-tags-view nil tag)))
"--"
["Custom Tag ..." org-tags-view t])
["Display Calendar" org-goto-calendar t]
"--"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
- '(lambda (key)
+ (lambda (key)
(eval `(flet ((read-char-exclusive () (string-to-char ,key)))
(org-agenda nil))))
nil
- '(lambda (key)
+ (lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
@@ -832,7 +832,7 @@ This means, between the beginning of line and the point."
("Tags and Priorities"
,@(org-mouse-keyword-menu
(org-mouse-priority-list)
- '(lambda (keyword)
+ (lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s")
"--"
@@ -905,7 +905,7 @@ This means, between the beginning of line and the point."
(mouse-drag-region event)))
(add-hook 'org-mode-hook
- '(lambda ()
+ (lambda ()
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
(when (memq 'context-menu org-mouse-features)
@@ -1129,14 +1129,14 @@ This means, between the beginning of line and the point."
; (setq org-agenda-mode-hook nil)
(add-hook 'org-agenda-mode-hook
- '(lambda ()
+ (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")
+ (lambda (event) (interactive "e")
(case (org-mouse-get-gesture event)
(:left (org-agenda-earlier 1))
(:right (org-agenda-later 1)))))))
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index bd1c3802044..5a877963a40 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -674,7 +674,7 @@ the language, a switch telling if the content should be in a single line."
(defun org-src-mode-configure-edit-buffer ()
(when (org-bound-and-true-p org-edit-src-from-org-mode)
(org-add-hook 'kill-buffer-hook
- '(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
+ (lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
(if (org-bound-and-true-p org-edit-src-allow-write-back-p)
(progn
(setq buffer-offer-save t)
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index c99b5bf681a..b56dc6b77c3 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -4341,7 +4341,7 @@ a \"#+TBLNAME:\" directive. The first table following this line
will then be used. Alternatively, it may be an ID referring to
any entry, also in a different file. In this case, the first table
in that entry will be referenced.
-FORM is a field or range descriptor like \"@2$3\" or or \"B3\" or
+FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
\"@I$2..@II$2\". All the references must be absolute, not relative.
The return value is either a single string for a single field, or a
diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el
index 2a16d047b33..f1616f8001d 100644
--- a/lisp/org/org-wl.el
+++ b/lisp/org/org-wl.el
@@ -118,7 +118,7 @@ googlegroups otherwise."
(defun org-wl-folder-type (folder)
"Return symbol that indicates the type of FOLDER.
FOLDER is the wanderlust folder name. The first character of the
-folder name determines the the folder type."
+folder name determines the folder type."
(let* ((indicator (substring folder 0 1))
(type (cdr (assoc indicator org-wl-folder-types))))
;; maybe access or file folder
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 076df5f0d07..a55111ec816 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1576,7 +1576,7 @@ single keystroke rather than having to type \"yes\"."
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- '(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defcustom org-confirm-elisp-link-function 'yes-or-no-p
"Non-nil means ask for confirmation before executing Emacs Lisp links.
@@ -1596,7 +1596,7 @@ single keystroke rather than having to type \"yes\"."
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- '(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defconst org-file-apps-defaults-gnu
'((remote . emacs)
@@ -2519,7 +2519,7 @@ a double prefix argument to a time stamp command like `C-c .' or `C-c !',
and by using a prefix arg to `S-up/down' to specify the exact number
of minutes to shift."
:group 'org-time
- :get '(lambda (var) ; Make sure both elements are there
+ :get (lambda (var) ; Make sure both elements are there
(if (integerp (default-value var))
(list (default-value var) 5)
(default-value var)))
@@ -3021,7 +3021,7 @@ or contain a special line
If the file does not specify a category, then file's base name
is used instead.")
(make-variable-buffer-local 'org-category)
-(put 'org-category 'safe-local-variable '(lambda (x) (or (symbolp x) (stringp x))))
+(put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x))))
(defcustom org-agenda-files nil
"The files to be used for agenda display.
@@ -6496,7 +6496,7 @@ 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
+the location selected in the indirect buffer and expose
the headline hierarchy above."
(interactive "P")
(let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
@@ -15746,7 +15746,7 @@ sequence appearing also before point.
Even though the matchers for math are configurable, this function assumes
that \\begin, \\(, \\[, and $$ are always used. Only the single dollar
delimiters are skipped when they have been removed by customization.
-The return value is nil, or a cons cell with the delimiter and
+The return value is nil, or a cons cell with the delimiter
and the position of this delimiter.
This function does a reasonably good job, but can locally be fooled by
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 8090397627e..d75479fab3e 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -83,6 +83,19 @@
(forward-line)))
(pcomplete-uniqify-list points))))
+(defun pcomplete-pare-list (l r)
+ "Destructively remove from list L all elements matching any in list R.
+Test is done using `equal'."
+ (while (and l (and r (member (car l) r)))
+ (setq l (cdr l)))
+ (let ((m l))
+ (while m
+ (while (and (cdr m)
+ (and r (member (cadr m) r)))
+ (setcdr m (cddr m)))
+ (setq m (cdr m))))
+ l)
+
(defun pcmpl-linux-mountable-directories ()
"Return a list of mountable directory names."
(let (points)
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index 475215b1622..716b0a59555 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -313,9 +313,9 @@
(if (pcomplete-match "^-" 0)
(pcomplete-opt "v")
(pcomplete-here
- (if (eq mode 'test)
- (pcomplete-dirs-or-entries "\\.tar\\'")
- (pcomplete-dirs-or-entries "\\.spec\\'"))))))
+ (pcomplete-dirs-or-entries (if (eq mode 'test)
+ "\\.tar\\'"
+ "\\.spec\\'"))))))
(t
(error "You must select a mode: -q, -i, -U, --verify, etc"))))))
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 2f5dcdfb5e8..46a82e3720d 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,4 +1,4 @@
-;;; pcomplete.el --- programmable completion
+;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
@@ -154,6 +154,7 @@ This mirrors the optional behavior of tcsh."
"A list of characters which constitute a proper suffix."
:type '(repeat character)
:group 'pcomplete)
+(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
(defcustom pcomplete-recexact nil
"If non-nil, use shortest completion if characters cannot be added.
@@ -501,18 +502,16 @@ Same as `pcomplete' but using the standard completion UI."
;; practice it should work just fine (fingers crossed).
(let ((prefixes (pcomplete--common-quoted-suffix
pcomplete-stub buftext)))
- (apply-partially
- 'pcomplete--table-subvert
- completions
- (cdr prefixes) (car prefixes))))
+ (apply-partially #'pcomplete--table-subvert
+ completions
+ (cdr prefixes) (car prefixes))))
(t
- (lexical-let ((completions completions))
- (lambda (string pred action)
- (let ((res (complete-with-action
- action completions string pred)))
- (if (stringp res)
- (pcomplete-quote-argument res)
- res)))))))
+ (lambda (string pred action)
+ (let ((res (complete-with-action
+ action completions string pred)))
+ (if (stringp res)
+ (pcomplete-quote-argument res)
+ res))))))
(pred
;; Pare it down, if applicable.
(when (and pcomplete-use-paring pcomplete-seen)
@@ -521,25 +520,26 @@ Same as `pcomplete' but using the standard completion UI."
(funcall pcomplete-norm-func
(directory-file-name f)))
pcomplete-seen))
- (lambda (f)
- (not (when pcomplete-seen
- (member
- (funcall pcomplete-norm-func
- (directory-file-name f))
- pcomplete-seen)))))))
- (unless (zerop (length pcomplete-termination-string))
- ;; Add a space at the end of completion. Use a terminator-regexp
- ;; that never matches since the terminator cannot appear
- ;; within the completion field anyway.
- (setq table
- (apply-partially #'completion-table-with-terminator
- (cons pcomplete-termination-string
- "\\`a\\`")
- table)))
+ ;; Capture the dynbound values for later use.
+ (let ((norm-func pcomplete-norm-func)
+ (seen pcomplete-seen))
+ (lambda (f)
+ (not (member
+ (funcall norm-func (directory-file-name f))
+ seen)))))))
(when pcomplete-ignore-case
(setq table
(apply-partially #'completion-table-case-fold table)))
- (list beg (point) table :predicate pred))))))
+ (list beg (point) table
+ :predicate pred
+ :exit-function
+ (unless (zerop (length pcomplete-termination-string))
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at
+ (regexp-quote pcomplete-termination-string))
+ (goto-char (match-end 0))
+ (insert pcomplete-termination-string)))))))))))
;; 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.
@@ -780,6 +780,8 @@ dynamic-complete-functions are kept. For comint mode itself,
this is `comint-dynamic-complete-functions'."
(set (make-local-variable 'pcomplete-parse-arguments-function)
'pcomplete-parse-comint-arguments)
+ (add-hook 'completion-at-point-functions
+ 'pcomplete-completions-at-point nil 'local)
(set (make-local-variable completef-sym)
(copy-sequence (symbol-value completef-sym)))
(let* ((funs (symbol-value completef-sym))
@@ -887,15 +889,46 @@ Magic characters are those in `pcomplete-arg-quote-list'."
(defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
"Return either directories, or qualified entries."
- ;; FIXME: pcomplete-entries doesn't return a list any more.
(pcomplete-entries
nil
- (lexical-let ((re regexp)
- (pred predicate))
- (lambda (f)
- (or (file-directory-p f)
- (and (if (not re) t (string-match re f))
- (if (not pred) t (funcall pred f))))))))
+ (lambda (f)
+ (or (file-directory-p f)
+ (and (or (null regexp) (string-match regexp f))
+ (or (null predicate) (funcall predicate f)))))))
+
+(defun pcomplete--entries (&optional regexp predicate)
+ "Like `pcomplete-entries' but without env-var handling."
+ (let* ((ign-pred
+ (when (or pcomplete-file-ignore pcomplete-dir-ignore)
+ ;; Capture the dynbound value for later use.
+ (let ((file-ignore pcomplete-file-ignore)
+ (dir-ignore pcomplete-dir-ignore))
+ (lambda (file)
+ (not
+ (if (eq (aref file (1- (length file))) ?/)
+ (and dir-ignore (string-match dir-ignore file))
+ (and file-ignore (string-match file-ignore file))))))))
+ (reg-pred (if regexp (lambda (file) (string-match regexp file))))
+ (pred (cond
+ ((null (or ign-pred reg-pred)) predicate)
+ ((null (or ign-pred predicate)) reg-pred)
+ ((null (or reg-pred predicate)) ign-pred)
+ (t (lambda (f)
+ (and (or (null reg-pred) (funcall reg-pred f))
+ (or (null ign-pred) (funcall ign-pred f))
+ (or (null predicate) (funcall predicate f))))))))
+ (lambda (s p a)
+ (if (and (eq a 'metadata) pcomplete-compare-entry-function)
+ `(metadata (cycle-sort-function
+ . ,(lambda (comps)
+ (sort comps pcomplete-compare-entry-function)))
+ ,@(cdr (completion-file-name-table s p a)))
+ (let ((completion-ignored-extensions nil))
+ (completion-table-with-predicate
+ 'completion-file-name-table pred 'strict s p a))))))
+
+(defconst pcomplete--env-regexp
+ "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")
(defun pcomplete-entries (&optional regexp predicate)
"Complete against a list of directory candidates.
@@ -905,65 +938,48 @@ If PREDICATE is non-nil, it will also be used to refine the match
\(files for which the PREDICATE returns nil will be excluded).
If no directory information can be extracted from the completed
component, `default-directory' is used as the basis for completion."
- (let* ((name (substitute-env-vars pcomplete-stub))
- (completion-ignore-case pcomplete-ignore-case)
- (default-directory (expand-file-name
- (or (file-name-directory name)
- default-directory)))
- above-cutoff)
- (setq name (file-name-nondirectory name)
- pcomplete-stub name)
- (let ((completions
- (file-name-all-completions name default-directory)))
- (if regexp
- (setq completions
- (pcomplete-pare-list
- completions nil
- (function
- (lambda (file)
- (not (string-match regexp file)))))))
- (if predicate
- (setq completions
- (pcomplete-pare-list
- completions nil
- (function
- (lambda (file)
- (not (funcall predicate file)))))))
- (if (or pcomplete-file-ignore pcomplete-dir-ignore)
- (setq completions
- (pcomplete-pare-list
- completions nil
- (function
- (lambda (file)
- (if (eq (aref file (1- (length file)))
- ?/)
- (and pcomplete-dir-ignore
- (string-match pcomplete-dir-ignore file))
- (and pcomplete-file-ignore
- (string-match pcomplete-file-ignore file))))))))
- (setq above-cutoff (and pcomplete-cycle-cutoff-length
- (> (length completions)
- pcomplete-cycle-cutoff-length)))
- (sort completions
- (function
- (lambda (l r)
- ;; for the purposes of comparison, remove the
- ;; trailing slash from directory names.
- ;; Otherwise, "foo.old/" will come before "foo/",
- ;; since . is earlier in the ASCII alphabet than
- ;; /
- (let ((left (if (eq (aref l (1- (length l)))
- ?/)
- (substring l 0 (1- (length l)))
- l))
- (right (if (eq (aref r (1- (length r)))
- ?/)
- (substring r 0 (1- (length r)))
- r)))
- (if above-cutoff
- (string-lessp left right)
- (funcall pcomplete-compare-entry-function
- left right)))))))))
+ ;; FIXME: The old code did env-var expansion here, so we reproduce this
+ ;; behavior for now, but really env-var handling should be performed globally
+ ;; rather than here since it also applies to non-file arguments.
+ (let ((table (pcomplete--entries regexp predicate)))
+ (lambda (string pred action)
+ (let ((strings nil)
+ (orig-length (length string)))
+ ;; Perform env-var expansion.
+ (while (string-match pcomplete--env-regexp string)
+ (push (substring string 0 (match-beginning 1)) strings)
+ (push (getenv (match-string 2 string)) strings)
+ (setq string (substring string (match-end 1))))
+ (if (not (and strings
+ (or (eq action t)
+ (eq (car-safe action) 'boundaries))))
+ (let ((newstring
+ (mapconcat 'identity (nreverse (cons string strings)) "")))
+ ;; FIXME: We could also try to return unexpanded envvars.
+ (complete-with-action action table newstring pred))
+ (let* ((envpos (apply #'+ (mapcar #' length strings)))
+ (newstring
+ (mapconcat 'identity (nreverse (cons string strings)) ""))
+ (bounds (completion-boundaries newstring table pred
+ (or (cdr-safe action) ""))))
+ (if (>= (car bounds) envpos)
+ ;; 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)))
+ ;; The env-var is in the file bounds.
+ (if (eq action t)
+ (let ((comps (complete-with-action
+ action table newstring pred))
+ (len (- envpos (car bounds))))
+ ;; 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))))))))))
(defsubst pcomplete-all-entries (&optional regexp predicate)
"Like `pcomplete-entries', but doesn't ignore any entries."
@@ -1343,25 +1359,6 @@ If specific documentation can't be given, be generic."
;; general utilities
-(defun pcomplete-pare-list (l r &optional pred)
- "Destructively remove from list L all elements matching any in list R.
-Test is done using `equal'.
-If PRED is non-nil, it is a function used for further removal.
-Returns the resultant list."
- (while (and l (or (and r (member (car l) r))
- (and pred
- (funcall pred (car l)))))
- (setq l (cdr l)))
- (let ((m l))
- (while m
- (while (and (cdr m)
- (or (and r (member (cadr m) r))
- (and pred
- (funcall pred (cadr m)))))
- (setcdr m (cddr m)))
- (setq m (cdr m))))
- l)
-
(defun pcomplete-uniqify-list (l)
"Sort and remove multiples in L."
(setq l (sort l 'string-lessp))
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 46c3c867304..86e6b4abb6c 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,4 +1,4 @@
-;;; 5x5.el --- simple little puzzle game
+;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*-
;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
@@ -24,15 +24,15 @@
;;; Commentary:
-;; The aim of 5x5 is to fill in all the squares. If you need any more of an
+;; The aim of 5x5 is to fill in all the squares. If you need any more of an
;; explanation you probably shouldn't play the game.
;;; TODO:
-;; o The code for updating the grid needs to be re-done. At the moment it
+;; o The code for updating the grid needs to be re-done. At the moment it
;; simply re-draws the grid every time a move is made.
;;
-;; o Look into tarting up the display with color. gamegrid.el looks
+;; o Look into tarting up the display with color. gamegrid.el looks
;; interesting, perhaps that is the way to go?
;;; Thanks:
@@ -41,7 +41,10 @@
;; emacs mode.
;;
;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated
-;; solver.
+;; cracker.
+;;
+;; Vincent Belaïche <vincentb1@users.sourceforge.net> & Jay P. Belanger
+;; <jay.p.belanger@gmail.com> for the math solver.
;;; Code:
@@ -89,19 +92,25 @@
;; Non-customize variables.
-(defvar 5x5-grid nil
+(defmacro 5x5-defvar-local (var value doc)
+ "Define VAR to VALUE with documentation DOC and make it buffer local."
+ `(progn
+ (defvar ,var ,value ,doc)
+ (make-variable-buffer-local (quote ,var))))
+
+(5x5-defvar-local 5x5-grid nil
"5x5 grid contents.")
-(defvar 5x5-x-pos 2
+(5x5-defvar-local 5x5-x-pos 2
"X position of cursor.")
-(defvar 5x5-y-pos 2
+(5x5-defvar-local 5x5-y-pos 2
"Y position of cursor.")
-(defvar 5x5-moves 0
+(5x5-defvar-local 5x5-moves 0
"Moves made.")
-(defvar 5x5-cracking nil
+(5x5-defvar-local 5x5-cracking nil
"Are we in cracking mode?")
(defvar 5x5-buffer-name "*5x5*"
@@ -134,10 +143,30 @@
(define-key map [(control c) (control b)] #'5x5-crack-mutating-best)
(define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
(define-key map "n" #'5x5-new-game)
+ (define-key map "s" #'5x5-solve-suggest)
+ (define-key map "<" #'5x5-solve-rotate-left)
+ (define-key map ">" #'5x5-solve-rotate-right)
(define-key map "q" #'5x5-quit-game)
map)
"Local keymap for the 5x5 game.")
+(5x5-defvar-local 5x5-solver-output nil
+ "List that is is the output of artihmetic solver.
+
+This list L is such that
+
+L = (M S_1 S_2 ... S_N)
+
+M is the move count when the solve output was stored.
+
+S_1 ... S_N are all the solutions ordered from least to greatest
+number of strokes. S_1 is the solution to be displayed.
+
+Each solution S_1, ..., S_N is a a list (STROKE-COUNT GRID) where
+STROKE-COUNT is to number of strokes to achieve the solution and
+GRID is the grid of positions to click.")
+
+
;; Menu definition.
(easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu."
@@ -146,6 +175,10 @@
["Random game" 5x5-randomize t]
["Quit game" 5x5-quit-game t]
"---"
+ ["Use Calc solver" 5x5-solve-suggest t]
+ ["Rotate left list of Calc solutions" 5x5-solve-rotate-left t]
+ ["Rotate right list of Calc solutions" 5x5-solve-rotate-right t]
+ "---"
["Crack randomly" 5x5-crack-randomly t]
["Crack mutating current" 5x5-crack-mutating-current t]
["Crack mutating best" 5x5-crack-mutating-best t]
@@ -158,7 +191,7 @@
(defun 5x5-mode ()
"A mode for playing `5x5'.
-The key bindings for 5x5-mode are:
+The key bindings for `5x5-mode' are:
\\{5x5-mode-map}"
(kill-all-local-variables)
@@ -179,29 +212,32 @@ squares you must fill the grid.
5x5 keyboard bindings are:
\\<5x5-mode-map>
-Flip \\[5x5-flip-current]
-Move up \\[5x5-up]
-Move down \\[5x5-down]
-Move left \\[5x5-left]
-Move right \\[5x5-right]
-Start new game \\[5x5-new-game]
-New game with random grid \\[5x5-randomize]
-Random cracker \\[5x5-crack-randomly]
-Mutate current cracker \\[5x5-crack-mutating-current]
-Mutate best cracker \\[5x5-crack-mutating-best]
-Mutate xor cracker \\[5x5-crack-xor-mutate]
-Quit current game \\[5x5-quit-game]"
+Flip \\[5x5-flip-current]
+Move up \\[5x5-up]
+Move down \\[5x5-down]
+Move left \\[5x5-left]
+Move right \\[5x5-right]
+Start new game \\[5x5-new-game]
+New game with random grid \\[5x5-randomize]
+Random cracker \\[5x5-crack-randomly]
+Mutate current cracker \\[5x5-crack-mutating-current]
+Mutate best cracker \\[5x5-crack-mutating-best]
+Mutate xor cracker \\[5x5-crack-xor-mutate]
+Solve with Calc \\[5x5-solve-suggest]
+Rotate left Calc Solutions \\[5x5-solve-rotate-left]
+Rotate right Calc Solutions \\[5x5-solve-rotate-right]
+Quit current game \\[5x5-quit-game]"
(interactive "P")
(setq 5x5-cracking nil)
- (when size
- (setq 5x5-grid-size size))
(switch-to-buffer 5x5-buffer-name)
+ (5x5-mode)
+ (when (natnump size)
+ (setq 5x5-grid-size size))
(if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0)))))
(5x5-new-game))
(5x5-draw-grid (list 5x5-grid))
- (5x5-position-cursor)
- (5x5-mode))
+ (5x5-position-cursor))
(defun 5x5-new-game ()
"Start a new game of `5x5'."
@@ -211,7 +247,8 @@ Quit current game \\[5x5-quit-game]"
(setq 5x5-x-pos (/ 5x5-grid-size 2)
5x5-y-pos (/ 5x5-grid-size 2)
5x5-moves 0
- 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos))
+ 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)
+ 5x5-solver-output nil)
(5x5-draw-grid (list 5x5-grid))
(5x5-position-cursor)))
@@ -277,10 +314,11 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-draw-grid (grids)
"Draw the grids GRIDS into the current buffer."
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t) grid-org)
(erase-buffer)
(loop for grid in grids do (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
@@ -290,6 +328,28 @@ Quit current game \\[5x5-quit-game]"
(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)
+ (save-excursion
+ (forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
+ (dotimes (x 5x5-grid-size)
+ (when (5x5-cell solution-grid y x)
+ (if (= 0 (mod 5x5-x-scale 2))
+ (progn
+ (insert "()")
+ (delete-region (point) (+ (point) 2))
+ (backward-char 2))
+ (insert-char ?O 1)
+ (delete-char 1)
+ (backward-char)))
+ (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))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
@@ -304,13 +364,14 @@ Quit current game \\[5x5-quit-game]"
"Keep track of how many moves have been made."
(incf 5x5-moves))
-(defun 5x5-make-random-grid ()
+(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))
- (5x5-flip-cell grid y x))))
+ (funcall move grid y x))))
grid))
;; Cracker functions.
@@ -415,6 +476,391 @@ in progress because it is an animated attempt."
(sit-for 5x5-animate-delay))))
5x5-grid)
+;; Arithmetic solver
+;;===========================================================================
+(defun 5x5-grid-to-vec (grid)
+ "Convert GRID to an equivalent Calc matrix of (mod X 2) forms
+where X is 1 for setting a position, and 0 for unsetting a
+position."
+ (cons 'vec
+ (mapcar (lambda (y)
+ (cons 'vec
+ (mapcar (lambda (x)
+ (if x '(mod 1 2) '(mod 0 2)))
+ y)))
+ grid)))
+
+(defun 5x5-vec-to-grid (grid-matrix)
+ "Convert a grid matrix GRID-MATRIX in Calc format to a grid in
+5x5 format. See function `5x5-grid-to-vec'."
+ (apply
+ 'vector
+ (mapcar
+ (lambda (x)
+ (apply
+ 'vector
+ (mapcar
+ (lambda (y) (/= (cadr y) 0))
+ (cdr x))))
+ (cdr grid-matrix))))
+
+(eval-and-compile
+(if nil; set to t to enable solver logging
+ ;; Note these logging facilities were not cleaned out as the arithmetic
+ ;; solver is not yet complete --- it works only for grid size = 5.
+ ;; So they may be useful again to design a more generic solution.
+ (progn
+ (defvar 5x5-log-buffer nil)
+ (defun 5x5-log-init ()
+ (if (buffer-live-p 5x5-log-buffer)
+ (with-current-buffer 5x5-log-buffer (erase-buffer))
+ (setq 5x5-log-buffer (get-buffer-create "*5x5 LOG*"))))
+
+ (defun 5x5-log (name value)
+ "Debug purposes only.
+
+Log a matrix VALUE of (mod B 2) forms, only B is output and
+Scilab matrix notation is used. VALUE is returned so that it is
+easy to log a value with minimal rewrite of code."
+ (when (buffer-live-p 5x5-log-buffer)
+ (let* ((unpacked-value
+ (math-map-vec
+ (lambda (row) (math-map-vec 'cadr row))
+ value))
+ (calc-vector-commas "")
+ (calc-matrix-brackets '(C O))
+ (value-to-log (math-format-value unpacked-value)))
+ (with-current-buffer 5x5-log-buffer
+ (insert name ?= value-to-log ?\n))))
+ value))
+ (defsubst 5x5-log-init ())
+ (defsubst 5x5-log (name value) value)))
+
+(declare-function math-map-vec "calc-vec" (f a))
+(declare-function math-sub "calc" (a b))
+(declare-function math-mul "calc" (a b))
+(declare-function math-make-intv "calc-forms" (mask lo hi))
+(declare-function math-reduce-vec "calc-vec" (a b))
+(declare-function math-format-number "calc" (a &optional prec))
+(declare-function math-pow "calc-misc" (a b))
+(declare-function calcFunc-arrange "calc-vec" (vec cols))
+(declare-function calcFunc-cvec "calc-vec" (obj &rest dims))
+(declare-function calcFunc-diag "calc-vec" (a &optional n))
+(declare-function calcFunc-trn "calc-vec" (mat))
+(declare-function calcFunc-inv "calc-misc" (m))
+(declare-function calcFunc-mrow "calc-vec" (mat n))
+(declare-function calcFunc-mcol "calc-vec" (mat n))
+(declare-function calcFunc-vconcat "calc-vec" (a b))
+(declare-function calcFunc-index "calc-vec" (n &optional start incr))
+
+(defun 5x5-solver (grid)
+ "Return a list of solutions for GRID.
+
+Given some grid GRID, the returned a list of solution LIST is
+sorted from least Hamming weight to greatest one.
+
+ LIST = (SOLUTION-1 ... SOLUTION-N)
+
+Each solution SOLUTION-I is a cons cell (HW . G) where HW is the
+Hamming weight of the solution --- ie the number of strokes to
+achieve it --- and G is the grid of positions to click in order
+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)))
+ (let* (calc-command-flags
+ (grid-size-squared (* 5x5-grid-size 5x5-grid-size))
+
+ ;; targetv is the vector the origine of which is org="current
+ ;; grid" and the end of which is dest="all ones".
+ (targetv
+ (5x5-log
+ "b"
+ (let (
+ ;; org point is the current grid
+ (org (calcFunc-arrange (5x5-grid-to-vec grid)
+ 1))
+
+ ;; end point of game is the all ones matrix
+ (dest (calcFunc-cvec '(mod 1 2) grid-size-squared 1)))
+ (math-sub dest org))))
+
+ ;; transferm is the transfer matrix, ie it is the 25x25
+ ;; matrix applied everytime a flip is carried out where a
+ ;; flip is defined by a 25x1 Dirac vector --- ie all zeros
+ ;; but 1 in the position that is flipped.
+ (transferm
+ (5x5-log
+ "a"
+ ;; transfer-grid is not a play grid, but this is the
+ ;; transfer matrix in the format of a vector of vectors, we
+ ;; do it this way because random access in vectors is
+ ;; faster. The motivation is just speed as we build it
+ ;; element by element, but that could have been created
+ ;; using only Calc primitives. Probably that would be a
+ ;; better idea to use Calc with some vector manipulation
+ ;; rather than going this way...
+ (5x5-grid-to-vec (let ((transfer-grid
+ (let ((5x5-grid-size grid-size-squared))
+ (5x5-make-new-grid))))
+ (dotimes (i 5x5-grid-size)
+ (dotimes (j 5x5-grid-size)
+ ;; k0 = flattened flip position corresponding
+ ;; to (i, j) on the grid.
+ (let* ((k0 (+ (* 5 i) j)))
+ ;; cross center
+ (5x5-set-cell transfer-grid k0 k0 t)
+ ;; Cross top.
+ (and
+ (> i 0)
+ (5x5-set-cell transfer-grid
+ (- k0 5x5-grid-size) k0 t))
+ ;; Cross bottom.
+ (and
+ (< (1+ i) 5x5-grid-size)
+ (5x5-set-cell transfer-grid
+ (+ k0 5x5-grid-size) k0 t))
+ ;; Cross left.
+ (and
+ (> j 0)
+ (5x5-set-cell transfer-grid (1- k0) k0 t))
+ ;; Cross right.
+ (and
+ (< (1+ j) 5x5-grid-size)
+ (5x5-set-cell transfer-grid
+ (1+ k0) k0 t)))))
+ transfer-grid))))
+ ;; TODO: this is hard-coded for grid-size = 5, make it generic.
+ (transferm-kernel-size
+ (if (= 5x5-grid-size 5) 2
+ (error "Transfer matrix rank not known for grid-size != 5")))
+
+ ;; TODO: this is hard-coded for grid-size = 5, make it generic.
+ ;;
+ ;; base-change is a 25x25 matrix, where topleft submatrix
+ ;; 23x25 is a diagonal of 1, and the two last columns are a
+ ;; base of kernel of transferm.
+ ;;
+ ;; base-change must be by construction inversible.
+ (base-change
+ (5x5-log
+ "p"
+ (let ((id (5x5-mat-mode-2 (calcFunc-diag 1 grid-size-squared))))
+ (setcdr (last id (1+ transferm-kernel-size))
+ (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)))))
+ (calcFunc-trn id))))
+
+ (inv-base-change
+ (5x5-log "invp"
+ (calcFunc-inv base-change)))
+
+ ;; B:= targetv
+ ;; A:= transferm
+ ;; P:= base-change
+ ;; P^-1 := inv-base-change
+ ;; X := solution
+
+ ;; B = A * X
+ ;; P^-1 * B = P^-1 * A * P * P^-1 * X
+ ;; CX = P^-1 * X
+ ;; CA = P^-1 * A * P
+ ;; CB = P^-1 * B
+ ;; CB = CA * CX
+ ;; CX = CA^-1 * CB
+ ;; X = P * CX
+ (ctransferm
+ (5x5-log
+ "ca"
+ (math-mul
+ inv-base-change
+ (math-mul transferm base-change)))); CA
+ (ctarget
+ (5x5-log
+ "cb"
+ (math-mul inv-base-change targetv))); CB
+ (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
+ (row-2 (math-make-intv 1 transferm-kernel-size
+ grid-size-squared)); 3..25
+ (col-1 (math-make-intv 3 1 (- grid-size-squared
+ transferm-kernel-size))); 1..23
+ (col-2 (math-make-intv 1 (- grid-size-squared
+ transferm-kernel-size)
+ grid-size-squared)); 24..25
+ (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
+ (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
+
+ ;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
+ ;; and ctransferm-2-2 = 0.
+
+ ;;(ctransferm-1-2 (calcFunc-mcol ctransferm-1-: col-2))
+ (ctransferm-2-: (calcFunc-mrow ctransferm row-2))
+ (ctransferm-2-1
+ (5x5-log
+ "ca_2_1"
+ (calcFunc-mcol ctransferm-2-: col-1)))
+
+ ;; By construction ctransferm-2-2 = 0.
+ ;;
+ ;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
+
+ (ctarget-1 (calcFunc-mrow ctarget row-1))
+ (ctarget-2 (calcFunc-mrow ctarget row-2))
+
+ ;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1)
+ ;; + ctransferm-1-2(2x2) *cx-2(2x1);
+ ;; ctarget-2(23x1) = ctransferm-2-1(23x23)*cx-1(23x1)
+ ;; + ctransferm-2-2(23x2)*cx-2(2x1);
+ ;; By construction:
+ ;;
+ ;; ctransferm-1-2 == zeros(2,2) and ctransferm-2-2 == zeros(23,2)
+ ;;
+ ;; So:
+ ;;
+ ;; ctarget-2 = ctransferm-2-1*cx-1
+ ;;
+ ;; So:
+ ;;
+ ;; cx-1 = inv-ctransferm-2-1 * ctarget-2
+ (cx-1 (math-mul (calcFunc-inv ctransferm-2-1) ctarget-2))
+
+ ;; Any cx-2 can do, so there are 2^{transferm-kernel-size} solutions.
+ (solution-list
+ ;; Within solution-list each element is a cons cell:
+ ;;
+ ;; (HW . SOL)
+ ;;
+ ;; where HW is the Hamming weight of solution, and SOL is
+ ;; the solution in the form of a grid.
+ (sort
+ (cdr
+ (math-map-vec
+ (lambda (cx-2)
+ ;; Compute `solution' in the form of a 25x1 matrix of
+ ;; (mod B 2) forms --- with B = 0 or 1 --- and
+ ;; return (HW . SOL) where HW is the Hamming weight
+ ;; of solution and SOL a grid.
+ (let ((solution (math-mul
+ base-change
+ (calcFunc-vconcat cx-1 cx-2)))); X = P * CX
+ (cons
+ ;; 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)))
+ solution); car
+ (5x5-vec-to-grid
+ (calcFunc-arrange solution 5x5-grid-size));cdr
+ )))
+ ;; A (2^K) x K matrix, where K is the dimension of kernel
+ ;; of transfer matrix --- i.e. K=2 in if the grid is 5x5
+ ;; --- for I from 0 to K-1, each row rI correspond to the
+ ;; binary representation of number I, that is to say row
+ ;; rI is a 1xK vector:
+ ;; [ n{I,0} n{I,1} ... n{I,K-1} ]
+ ;; such that:
+ ;; I = sum for J=0..K-1 of 2^(n{I,J})
+ (let ((calc-number-radix 2)
+ (calc-leading-zeros t)
+ (calc-word-size transferm-kernel-size))
+ (math-map-vec
+ (lambda (x)
+ (cons 'vec
+ (mapcar (lambda (x) `(vec (mod ,(logand x 1) 2)))
+ (substring (math-format-number x)
+ (- transferm-kernel-size)))))
+ (calcFunc-index (math-pow 2 transferm-kernel-size) 0))) ))
+ ;; Sort solutions according to respective Hamming weight.
+ (lambda (x y) (< (car x) (car y)))
+ )))
+ (message "5x5 Solution computation done.")
+ solution-list)))
+
+(defun 5x5-solve-suggest (&optional n)
+ "Suggest to the user where to click.
+
+Argument N is ignored."
+ ;; For the time being n is ignored, the idea was to use some numeric
+ ;; argument to show a limited amount of positions.
+ (interactive "P")
+ (5x5-log-init)
+ (let ((solutions (5x5-solver 5x5-grid)))
+ (setq 5x5-solver-output
+ (cons 5x5-moves solutions)))
+ (5x5-draw-grid (list 5x5-grid))
+ (5x5-position-cursor))
+
+(defun 5x5-solve-rotate-left (&optional n)
+ "Rotate left by N the list of solutions in 5x5-solver-output.
+
+If N is not supplied rotate by 1, that is to say put the last
+element first in the list.
+
+The 5x5 game has in general several solutions. For grid size=5,
+there are 4 possible solutions. When function
+`5x5-solve-suggest' (press `\\[5x5-solve-suggest]') is called the
+solution that is presented is the one that needs least number of
+strokes --- other solutions can be viewed by rotating through the
+list. The list of solution is ordered by number of strokes, so
+rotating left just after calling `5x5-solve-suggest' will show
+the the solution with second least number of strokes, while
+rotating right will show the solution with greatest number of
+strokes."
+ (interactive "P")
+ (let ((len (length 5x5-solver-output)))
+ (when (>= len 3)
+ (setq n (if (integerp n) n 1)
+ n (mod n (1- len)))
+ (unless (eq n 0)
+ (setq n (- len n 1))
+ (let* ((p-tail (last 5x5-solver-output (1+ n)))
+ (tail (cdr p-tail))
+ (l-tail (last tail)))
+ ;;
+ ;; For n = 2:
+ ;;
+ ;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+
+ ;; |M | ---->|S1| ---->|S2| ---->|S3| ---->|S4| ----> nil
+ ;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+
+ ;; ^ ^ ^ ^
+ ;; | | | |
+ ;; + 5x5-solver-output | | + l-tail
+ ;; + p-tail |
+ ;; + tail
+ ;;
+ (setcdr l-tail (cdr 5x5-solver-output))
+ (setcdr 5x5-solver-output tail)
+ (unless (eq p-tail 5x5-solver-output)
+ (setcdr p-tail nil)))
+ (5x5-draw-grid (list 5x5-grid))
+ (5x5-position-cursor)))))
+
+(defun 5x5-solve-rotate-right (&optional n)
+ "Rotate right by N the list of solutions in 5x5-solver-output.
+If N is not supplied, rotate by 1. Similar to function
+`5x5-solve-rotate-left' except that rotation is right instead of
+lest."
+ (interactive "P")
+ (setq n
+ (if (integerp n) (- n)
+ -1))
+ (5x5-solve-rotate-left n))
+
+
+
;; Keyboard response functions.
(defun 5x5-flip-current ()
@@ -490,7 +936,8 @@ in progress because it is an animated attempt."
(setq 5x5-x-pos (/ 5x5-grid-size 2)
5x5-y-pos (/ 5x5-grid-size 2)
5x5-moves 0
- 5x5-grid (5x5-make-random-grid))
+ 5x5-grid (5x5-make-random-grid (symbol-function '5x5-make-move))
+ 5x5-solver-output nil)
(unless 5x5-cracking
(5x5-draw-grid (list 5x5-grid)))
(5x5-position-cursor)))
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index 157a2fe7593..facdfa2f347 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -89,11 +89,15 @@
(insert-char char 1))
(defvar animate-n-steps 10
- "Number of steps to use `animate-string'.")
+"*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.
+When nil animations dipslayed in the buffer named *Animation*.")
;;;###autoload
(defun animate-string (string vpos &optional hpos)
- "Display STRING starting at position VPOS, HPOS, using animation.
+ "Display STRING animations starting at position VPOS, HPOS.
The characters start at randomly chosen places,
and all slide in parallel to their final positions,
passing through `animate-n-steps' positions before the final ones.
@@ -138,14 +142,19 @@ in the current window."
;;;###autoload
(defun animate-sequence (list-of-strings space)
- "Display strings from LIST-OF-STRING with animation in a new buffer.
-Strings will be separated from each other by SPACE lines."
+ "Display animation strings from LIST-OF-STRING with buffer *Animation*.
+Strings will be separated from each other by SPACE lines.
+ When the variable `animation-buffer-name' is non-nil display
+animation in the buffer named by variable's value, creating the
+buffer if one does not exist."
(let ((vpos (/ (- (window-height)
1 ;; For the mode-line
(* (1- (length list-of-strings)) space)
(length list-of-strings))
2)))
- (switch-to-buffer (get-buffer-create "*Animation*"))
+ (switch-to-buffer (get-buffer-create
+ (or animation-buffer-name
+ "*Animation*")))
(erase-buffer)
(sit-for 0)
(while list-of-strings
@@ -155,19 +164,25 @@ Strings will be separated from each other by SPACE lines."
;;;###autoload
(defun animate-birthday-present (&optional name)
- "Display one's birthday present in a new buffer.
-You can specify the one's name by NAME; the default value is \"Sarah\"."
- (interactive (list (read-string "Name (default Sarah): "
- nil nil "Sarah")))
+ "Return a birthday present in the buffer *Birthday-Present*.
+When optional arg NAME is non-nil or called-interactively, prompt for
+NAME of birthday present receiver and return a birthday present in
+the buffer *Birthday-Present-for-Name*."
+ (interactive (list (read-string "Birthday present for: "
+ nil nil)))
;; Make a suitable buffer to display the birthday present in.
- (switch-to-buffer (get-buffer-create (format "*%s*" name)))
+ (switch-to-buffer (get-buffer-create
+ (if name
+ (concat "*A-Present-for-" (capitalize name) "*")
+ "*Birthday-Present*")))
(erase-buffer)
;; Display the empty buffer.
(sit-for 0)
- (animate-string "Happy Birthday," 6)
- (animate-string (format "%s" name) 7)
-
+ (if name
+ (animate-string "Happy Birthday," 6)
+ (animate-string "Happy Birthday" 6))
+ (when name (animate-string (format "%s" (capitalize name)) 7))
(sit-for 1)
(animate-string "You are my sunshine," 10 30)
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index a61b52f4ad1..55b0a564fef 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -49,7 +49,7 @@
;; I have also this in my .gnus:
;;(add-hook 'gnus-article-mode-hook
-;; '(lambda ()
+;; (lambda ()
;; (define-key gnus-article-mode-map "i" 'fortune-from-region)))
;; which allows marking a region and then pressing "i" so that the marked
;; region will be automatically added to my favourite fortune-file.
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index ac78a86757c..31a6d6f425b 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -113,7 +113,7 @@ intermediate positions."
(prefix-numeric-value current-prefix-arg))))
(if (< nrings 0)
(error "Negative number of rings"))
- (hanoi-internal nrings (make-list nrings 0) (hanoi-current-time-float)))
+ (hanoi-internal nrings (make-list nrings 0) (float-time)))
;;;###autoload
(defun hanoi-unix ()
@@ -123,7 +123,7 @@ second since 1970-01-01 00:00:00 GMT.
Repent before ring 31 moves."
(interactive)
- (let* ((start (ftruncate (hanoi-current-time-float)))
+ (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))))
@@ -137,7 +137,7 @@ This is, necessarily (as of Emacs 20.3), a crock. When the
current-time interface is made s2G-compliant, hanoi.el will need
to be updated."
(interactive)
- (let* ((start (ftruncate (hanoi-current-time-float)))
+ (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))))
@@ -283,11 +283,6 @@ BITS must be of length nrings. Start at START-TIME."
(setq buffer-read-only t)
(force-mode-line-update)))
-(defun hanoi-current-time-float ()
- "Return values from current-time combined into a single float."
- (destructuring-bind (high low micros) (current-time)
- (+ (* high 65536.0) low (/ micros 1000000.0))))
-
(defun hanoi-put-face (start end value &optional object)
"If hanoi-use-faces is non-nil, call put-text-property for face property."
(if hanoi-use-faces
@@ -383,7 +378,7 @@ 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 = (- (hanoi-current-time-float) start-time)
+ (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
diff --git a/lisp/printing.el b/lisp/printing.el
index e66cca25933..9f98c2b6e29 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -4611,7 +4611,7 @@ bottom."
;;;###autoload
(defun pr-toggle-region ()
- "Toggle auto region."
+ "Toggle whether the region is automagically detected."
(interactive)
(pr-toggle-region-menu t))
@@ -5346,102 +5346,119 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-toggle-file-duplex-menu (&optional no-menu)
+ "Toggle whether to print PostScript files in duplex mode."
(interactive)
(pr-toggle 'pr-file-duplex "PS file duplex" nil 7 5 nil
'("PostScript Print" "File") no-menu))
(defun pr-toggle-file-tumble-menu (&optional no-menu)
+ "Toggle whether to print PostScript files in tumble mode."
(interactive)
(pr-toggle 'pr-file-tumble "PS file tumble" nil 8 5 nil
'("PostScript Print" "File") no-menu))
(defun pr-toggle-file-landscape-menu (&optional no-menu)
+ "Toggle whether to print PostScript files in landscape orientation."
(interactive)
(pr-toggle 'pr-file-landscape "PS file landscape" nil 6 5 nil
'("PostScript Print" "File") no-menu))
(defun pr-toggle-ghostscript-menu (&optional no-menu)
+ "Toggle whether to print using ghostscript."
(interactive)
(pr-toggle 'pr-print-using-ghostscript "Printing using ghostscript"
'postscript-process 2 12 'toggle nil no-menu))
(defun pr-toggle-faces-menu (&optional no-menu)
+ "Toggle whether to print with face attributes."
(interactive)
(pr-toggle 'pr-faces-p "Printing with faces"
'postscript-process 1 12 'toggle nil no-menu))
(defun pr-toggle-spool-menu (&optional no-menu)
+ "Toggle whether to spool printing in a buffer."
(interactive)
(pr-toggle 'pr-spool-p "Spooling printing"
'postscript-process 0 12 'toggle nil no-menu))
(defun pr-toggle-duplex-menu (&optional no-menu)
+ "Toggle whether to generate PostScript for a two-sided printer."
(interactive)
(pr-toggle 'ps-spool-duplex "Printing duplex"
'postscript-options 5 12 'toggle nil no-menu))
(defun pr-toggle-tumble-menu (&optional no-menu)
+ "Toggle how pages on opposite sides of a sheet are oriented."
(interactive)
(pr-toggle 'ps-spool-tumble "Tumble"
'postscript-options 6 12 'toggle nil no-menu))
(defun pr-toggle-landscape-menu (&optional no-menu)
+ "Toggle whether to print in landscape mode."
(interactive)
(pr-toggle 'ps-landscape-mode "Landscape"
'postscript-options 0 12 'toggle nil no-menu))
(defun pr-toggle-upside-down-menu (&optional no-menu)
+ "Toggle whether to print upside-down (that is, rotated by 180 degrees)."
(interactive)
(pr-toggle 'ps-print-upside-down "Upside-Down"
'postscript-options 7 12 'toggle nil no-menu))
(defun pr-toggle-line-menu (&optional no-menu)
+ "Toggle whether to means print line numbers."
(interactive)
(pr-toggle 'ps-line-number "Line number"
'postscript-options 3 12 'toggle nil no-menu))
(defun pr-toggle-zebra-menu (&optional no-menu)
+ "Toggle whether to print zebra stripes."
(interactive)
(pr-toggle 'ps-zebra-stripes "Zebra stripe"
'postscript-options 4 12 'toggle nil no-menu))
(defun pr-toggle-header-menu (&optional no-menu)
+ "Toggle whether to print a header at the top of each page."
(interactive)
(pr-toggle 'ps-print-header "Print header"
'postscript-options 1 12 'toggle nil no-menu))
(defun pr-toggle-header-frame-menu (&optional no-menu)
+ "Toggle whether to draw a gaudy frame around the header."
(interactive)
(pr-toggle 'ps-print-header-frame "Print header frame"
'postscript-options 2 12 'toggle nil no-menu))
(defun pr-toggle-lock-menu (&optional no-menu)
+ "Toggle whether the menu is locked while selecting toggle options."
(interactive)
(pr-toggle 'pr-menu-lock "Menu lock"
'printing 2 12 'toggle nil no-menu))
(defun pr-toggle-region-menu (&optional no-menu)
+ "Toggle whether the region is automagically detected."
(interactive)
(pr-toggle 'pr-auto-region "Auto region"
'printing 0 12 'toggle nil no-menu))
(defun pr-toggle-mode-menu (&optional no-menu)
+ "Toggle whether major-mode specific printing is prefered over normal printing."
(interactive)
(pr-toggle 'pr-auto-mode "Auto mode"
'printing 1 12 'toggle nil no-menu))
diff --git a/lisp/proced.el b/lisp/proced.el
index ddc4ed1db14..11598d7350f 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1735,8 +1735,9 @@ After sending the signal, this command runs the normal hook
(pnum (if (= 1 (length process-alist))
"1 process"
(format "%d processes" (length process-alist))))
- (completion-annotate-function
- (lambda (s) (cdr (assoc s proced-signal-list)))))
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
(setq signal
(completing-read (concat "Send signal [" pnum
"] (default TERM): ")
@@ -1868,16 +1869,6 @@ buffer. You can use it to recover marks."
(message "Change in Proced buffer undone.
Killed processes cannot be recovered by Emacs."))
-(defun proced-unload-function ()
- "Unload the Proced library."
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (when (eq major-mode 'proced-mode)
- (funcall (or (default-value 'major-mode) 'fundamental-mode)))))
- ;; continue standard unloading
- nil)
-
(provide 'proced)
;;; proced.el ends here
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index ce38cf8850b..a063ce7dab6 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -369,7 +369,7 @@ to it is returned. This function does not modify the point or the mark."
(put 'c-safe 'lisp-indent-function 0)
(defmacro c-int-to-char (integer)
- ;; In GNU Emacs, a character is an integer. In XEmacs, a character is a
+ ;; In Emacs, a character is an integer. In XEmacs, a character is a
;; type distinct from an integer. Sometimes we need to convert integers to
;; characters. `c-int-to-char' makes this conversion, if necessary.
(if (fboundp 'int-to-char)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0eec54fab6f..38f66b4504e 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -8712,6 +8712,35 @@ comment at the start of cc-engine.el for more info."
(c-beginning-of-statement-1 containing-sexp)
(c-add-syntax 'annotation-var-cont (point)))
+ ;; CASE G: a template list continuation?
+ ;; Mostly a duplication of case 5D.3 to fix templates-19:
+ ((and (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (goto-char indent-point)
+ (c-with-syntax-table c++-template-syntax-table
+ (setq placeholder (c-up-list-backward)))
+ (and placeholder
+ (eq (char-after placeholder) ?<)
+ (/= (char-before placeholder) ?<)
+ (progn
+ (goto-char (1+ placeholder))
+ (not (looking-at c-<-op-cont-regexp))))))
+ (c-with-syntax-table c++-template-syntax-table
+ (goto-char placeholder)
+ (c-beginning-of-statement-1 containing-sexp t)
+ (if (save-excursion
+ (c-backward-syntactic-ws containing-sexp)
+ (eq (char-before) ?<))
+ ;; In a nested template arglist.
+ (progn
+ (goto-char placeholder)
+ (c-syntactic-skip-backward "^,;" containing-sexp t)
+ (c-forward-syntactic-ws))
+ (back-to-indentation)))
+ ;; FIXME: Should use c-add-stmt-syntax, but it's not yet
+ ;; template aware.
+ (c-add-syntax 'template-args-cont (point) placeholder))
+
;; CASE D: continued statement.
(t
(c-beginning-of-statement-1 containing-sexp)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index c7bb93f73e7..600bbc76e9a 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1045,12 +1045,6 @@ casts and declarations are fontified. Used on level 2 and higher."
;; The position of the next token after the closing paren of
;; the last detected cast.
last-cast-end
- ;; Start of containing declaration (if any); limit for searching
- ;; backwards for it.
- decl-start decl-search-lim
- ;; Start of containing declaration (if any); limit for searching
- ;; backwards for it.
- decl-start decl-search-lim
;; The result from `c-forward-decl-or-cast-1'.
decl-or-cast
;; The maximum of the end positions of all the checked type
@@ -1188,109 +1182,107 @@ casts and declarations are fontified. Used on level 2 and higher."
(setq decl-or-cast (c-forward-decl-or-cast-1
match-pos context last-cast-end))
- (if (not decl-or-cast)
- ;; Are we at a declarator? Try to go back to the declaration
- ;; to check this. Note that `c-beginning-of-decl-1' is slow,
- ;; so we cache its result between calls.
- (let (paren-state bod-res encl-pos is-typedef)
- (goto-char start-pos)
- (save-excursion
- (unless (and decl-search-lim
- (eq decl-search-lim
- (save-excursion
- (c-syntactic-skip-backward "^;" nil t)
- (point))))
- (setq decl-search-lim
- (and (c-syntactic-skip-backward "^;" nil t) (point)))
- (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim)))
- (if (and (eq bod-res 'same)
- (progn
- (c-backward-syntactic-ws)
- (eq (char-before) ?\})))
- (c-beginning-of-decl-1 decl-search-lim))
- (setq decl-start (point))))
+ (cond
+ ((eq decl-or-cast 'cast)
+ ;; Save the position after the previous cast so we can feed
+ ;; it to `c-forward-decl-or-cast-1' in the next round. That
+ ;; helps it discover cast chains like "(a) (b) c".
+ (setq last-cast-end (point))
+ (c-fontify-recorded-types-and-refs)
+ nil)
+ (decl-or-cast
+ ;; We've found a declaration.
+
+ ;; Set `max-type-decl-end' or `max-type-decl-end-before-token'
+ ;; under the assumption that we're after the first type decl
+ ;; expression in the declaration now. That's not really true;
+ ;; we could also be after a parenthesized initializer
+ ;; expression in C++, but this is only used as a last resort
+ ;; to slant ambiguous expression/declarations, and overall
+ ;; it's worth the risk to occasionally fontify an expression
+ ;; as a declaration in an initializer expression compared to
+ ;; getting ambiguous things in normal function prototypes
+ ;; fontified as expressions.
+ (if inside-macro
+ (when (> (point) max-type-decl-end-before-token)
+ (setq max-type-decl-end-before-token (point)))
+ (when (> (point) max-type-decl-end)
+ (setq max-type-decl-end (point))))
+
+ ;; Back up to the type to fontify the declarator(s).
+ (goto-char (car decl-or-cast))
+
+ (let ((decl-list
+ (if context
+ ;; Should normally not fontify a list of
+ ;; declarators inside an arglist, but the first
+ ;; argument in the ';' separated list of a "for"
+ ;; statement is an exception.
+ (when (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char (1- match-pos))
+ (c-backward-syntactic-ws)
+ (and (c-simple-skip-symbol-backward)
+ (looking-at c-paren-stmt-key))))
+ t)))
+
+ ;; Fix the `c-decl-id-start' or `c-decl-type-start' property
+ ;; before the first declarator if it's a list.
+ ;; `c-font-lock-declarators' handles the rest.
+ (when decl-list
(save-excursion
- (goto-char decl-start)
- ;; We're now putatively at the declaration.
- (setq paren-state (c-parse-state))
- ;; At top level or inside a "{"?
- (if (or (not (setq encl-pos
- (c-most-enclosing-brace paren-state)))
- (eq (char-after encl-pos) ?\{))
- (progn
- (when (looking-at c-typedef-key) ; "typedef"
- (setq is-typedef t)
- (goto-char (match-end 0))
- (c-forward-syntactic-ws))
- ;; At a real declaration?
- (if (memq (c-forward-type t) '(t known found))
- (progn
- (c-font-lock-declarators limit t is-typedef)
- nil)
- ;; False alarm. Return t to go on to the next check.
- (goto-char start-pos)
- t))
- t)))
-
- (if (eq decl-or-cast 'cast)
- ;; Save the position after the previous cast so we can feed
- ;; it to `c-forward-decl-or-cast-1' in the next round. That
- ;; helps it discover cast chains like "(a) (b) c".
- (setq last-cast-end (point))
-
- ;; Set `max-type-decl-end' or `max-type-decl-end-before-token'
- ;; under the assumption that we're after the first type decl
- ;; expression in the declaration now. That's not really true;
- ;; we could also be after a parenthesized initializer
- ;; expression in C++, but this is only used as a last resort
- ;; to slant ambiguous expression/declarations, and overall
- ;; it's worth the risk to occasionally fontify an expression
- ;; as a declaration in an initializer expression compared to
- ;; getting ambiguous things in normal function prototypes
- ;; fontified as expressions.
- (if inside-macro
- (when (> (point) max-type-decl-end-before-token)
- (setq max-type-decl-end-before-token (point)))
- (when (> (point) max-type-decl-end)
- (setq max-type-decl-end (point))))
-
- ;; Back up to the type to fontify the declarator(s).
- (goto-char (car decl-or-cast))
-
- (let ((decl-list
- (if context
- ;; Should normally not fontify a list of
- ;; declarators inside an arglist, but the first
- ;; argument in the ';' separated list of a "for"
- ;; statement is an exception.
- (when (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char (1- match-pos))
- (c-backward-syntactic-ws)
- (and (c-simple-skip-symbol-backward)
- (looking-at c-paren-stmt-key))))
- t)))
-
- ;; Fix the `c-decl-id-start' or `c-decl-type-start' property
- ;; before the first declarator if it's a list.
- ;; `c-font-lock-declarators' handles the rest.
- (when decl-list
- (save-excursion
- (c-backward-syntactic-ws)
- (unless (bobp)
- (c-put-char-property (1- (point)) 'c-type
- (if (cdr decl-or-cast)
- 'c-decl-type-start
- 'c-decl-id-start)))))
-
- (c-font-lock-declarators
- (point-max) decl-list (cdr decl-or-cast))))
-
- ;; A cast or declaration has been successfully identified, so do
- ;; all the fontification of types and refs that's been recorded.
+ (c-backward-syntactic-ws)
+ (unless (bobp)
+ (c-put-char-property (1- (point)) 'c-type
+ (if (cdr decl-or-cast)
+ 'c-decl-type-start
+ 'c-decl-id-start)))))
+
+ (c-font-lock-declarators
+ (point-max) decl-list (cdr decl-or-cast)))
+
+ ;; A declaration has been successfully identified, so do all the
+ ;; fontification of types and refs that've been recorded.
(c-fontify-recorded-types-and-refs)
- nil))
+ 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)))
+ paren-state bod-res encl-pos is-typedef
+ c-recognize-knr-p) ; Strictly speaking, bogus, but it
+ ; speeds up lisp.h tremendously.
+ (save-excursion
+ (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim)))
+ (if (and (eq bod-res 'same)
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\})))
+ (c-beginning-of-decl-1 decl-search-lim))
+
+ ;; We're now putatively at the declaration.
+ (setq paren-state (c-parse-state))
+ ;; At top level or inside a "{"?
+ (if (or (not (setq encl-pos
+ (c-most-enclosing-brace paren-state)))
+ (eq (char-after encl-pos) ?\{))
+ (progn
+ (when (looking-at c-typedef-key) ; "typedef"
+ (setq is-typedef t)
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws))
+ ;; At a real declaration?
+ (if (memq (c-forward-type t) '(t known found))
+ (progn
+ (c-font-lock-declarators limit t is-typedef)
+ nil)
+ ;; False alarm. Return t to go on to the next check.
+ (goto-char start-pos)
+ t))
+ t))))))
;; It was a false alarm. Check if we're in a label (or other
;; construct with `:' except bitfield) instead.
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
new file mode 100644
index 00000000000..6553021e783
--- /dev/null
+++ b/lisp/progmodes/cc-guess.el
@@ -0,0 +1,574 @@
+;;; cc-guess.el --- guess indentation values by scanning existing code
+
+;; Copyright (C) 1985, 1987, 1992-2006, 2011
+;; Free Software Foundation, Inc.
+
+;; Author: 1994-1995 Barry A. Warsaw
+;; 2011- Masatake YAMATO
+;; Maintainer: bug-cc-mode@gnu.org
+;; Created: August 1994, split from cc-mode.el
+;; Version: See cc-mode.el
+;; Keywords: c languages oop
+
+;; 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 routines that help guess the cc-mode style in a
+;; particular region/buffer. Here style means `c-offsets-alist' and
+;; `c-basic-offset'.
+;;
+;; The main entry point of this program is `c-guess' command but there
+;; are some variants.
+;;
+;; Suppose the major mode for the current buffer is one of the modes
+;; provided by cc-mode. `c-guess' guesses the indentation style by
+;; examining the indentation in the region between beginning of buffer
+;; and `c-guess-region-max'.
+
+;; and installs the guessed style. The name for installed style is given
+;; by `c-guess-style-name'.
+;;
+;; `c-guess-buffer' does the same but in the whole buffer.
+;; `c-guess-region' does the same but in the region between the point
+;; and the mark. `c-guess-no-install', `c-guess-buffer-no-install'
+;; and `c-guess-region-no-install' guess the indentation style but
+;; don't install it. You can review a guessed style with `c-guess-view'.
+;; After reviewing, use `c-guess-install' to install the style
+;; if you prefer it.
+;;
+;; If you want to reuse the guessed style in another buffer,
+;; run `c-set-style' command with the name of the guessed style:
+;; "*c-guess*:<name-of-file-which-examined-when-guessing>".
+;; Once the guessed style is installed explicitly with `c-guess-install'
+;; or implicitly with `c-guess', `c-guess-buffer', or `c-guess-region',
+;; a style name is given by `c-guess-style-name' with the above form.
+;;
+;; If you want to reuse the guessed style in future emacs sessions,
+;; you may want to put it to your .emacs. `c-guess-view' is for
+;; you. It emits emacs lisp code which defines the last guessed
+;; style, in a temporary buffer. You can put the emitted code into
+;; your .emacs. This command was suggested by Alan Mackenzie.
+
+;;; Code:
+
+(eval-when-compile
+ (let ((load-path
+ (if (and (boundp 'byte-compile-dest-file)
+ (stringp byte-compile-dest-file))
+ (cons (file-name-directory byte-compile-dest-file) load-path)
+ load-path)))
+ (load "cc-bytecomp" nil t)))
+
+(cc-require 'cc-defs)
+(cc-require 'cc-engine)
+(cc-require 'cc-styles)
+
+
+
+(defcustom c-guess-offset-threshold 10
+ "Threshold of acceptable offsets when examining indent information.
+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'."
+ :type 'integer
+ :group 'c)
+
+(defcustom c-guess-region-max 50000
+ "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."
+ :type 'integer
+ :group 'c)
+
+
+;;;###autoload
+(defvar c-guess-guessed-offsets-alist nil
+ "Currently guessed offsets-alist.")
+;;;###autoload
+(defvar c-guess-guessed-basic-offset nil
+ "Currently guessed basic-offset.")
+
+(defvar c-guess-accumulator nil)
+;; Accumulated examined indent information. Information is represented
+;; in a list. Each element in it has following structure:
+;;
+;; (syntactic-symbol ((indentation-offset1 . number-of-times1)
+;; (indentation-offset2 . number-of-times2)
+;; ...))
+;;
+;; This structure is built by `c-guess-accumulate-offset'.
+;;
+;; Here we call the pair (indentation-offset1 . number-of-times1) a
+;; counter. `c-guess-sort-accumulator' sorts the order of
+;; counters by number-of-times.
+;; Use `c-guess-dump-accumulator' to see the value.
+
+(defconst c-guess-conversions
+ '((c . c-lineup-C-comments)
+ (inher-cont . c-lineup-multi-inher)
+ (string . -1000)
+ (comment-intro . c-lineup-comment)
+ (arglist-cont-nonempty . c-lineup-arglist)
+ (arglist-close . c-lineup-close-paren)
+ (cpp-macro . -1000)))
+
+
+;;;###autoload
+(defun c-guess (&optional accumulate)
+ "Guess the style in the region up to `c-guess-region-max', and install it.
+
+The style is given a name based on the file's absolute file name.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch."
+ (interactive "P")
+ (c-guess-region (point-min)
+ (min (point-max) (or c-guess-region-max
+ (point-max)))
+ accumulate))
+
+;;;###autoload
+(defun c-guess-no-install (&optional accumulate)
+ "Guess the style in the region up to `c-guess-region-max'; don't install it.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch."
+ (interactive "P")
+ (c-guess-region-no-install (point-min)
+ (min (point-max) (or c-guess-region-max
+ (point-max)))
+ accumulate))
+
+;;;###autoload
+(defun c-guess-buffer (&optional accumulate)
+ "Guess the style on the whole current buffer, and install it.
+
+The style is given a name based on the file's absolute file name.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch."
+ (interactive "P")
+ (c-guess-region (point-min)
+ (point-max)
+ accumulate))
+
+;;;###autoload
+(defun c-guess-buffer-no-install (&optional accumulate)
+ "Guess the style on the whole current buffer; don't install it.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch."
+ (interactive "P")
+ (c-guess-region-no-install (point-min)
+ (point-max)
+ accumulate))
+
+;;;###autoload
+(defun c-guess-region (start end &optional accumulate)
+ "Guess the style on the region and install it.
+
+The style is given a name based on the file's absolute file name.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous guess is extended, otherwise a new guess is
+made from scratch."
+ (interactive "r\nP")
+ (c-guess-region-no-install start end accumulate)
+ (c-guess-install))
+
+
+(defsubst c-guess-empty-line-p ()
+ (eq (line-beginning-position)
+ (line-end-position)))
+
+;;;###autoload
+(defun c-guess-region-no-install (start end &optional accumulate)
+ "Guess the style on the region; don't install it.
+
+Every line of code in the region is examined and values for the following two
+variables are guessed:
+
+* `c-basic-offset', and
+* the indentation values of the various syntactic symbols in
+ `c-offsets-alist'.
+
+The guessed values are put into `c-guess-guessed-basic-offset' and
+`c-guess-guessed-offsets-alist'.
+
+Frequencies of use are taken into account when guessing, so minor
+inconsistencies in the indentation style shouldn't produce wrong guesses.
+
+If given a prefix argument (or if the optional argument ACCUMULATE is
+non-nil) then the previous examination is extended, otherwise a new
+guess is made from scratch.
+
+Note that the larger the region to guess in, the slower the guessing.
+So you can limit the region with `c-guess-region-max'."
+ (interactive "r\nP")
+ (let ((accumulator (when accumulate c-guess-accumulator)))
+ (setq c-guess-accumulator (c-guess-examine start end accumulator))
+ (let ((pair (c-guess-guess c-guess-accumulator)))
+ (setq c-guess-guessed-basic-offset (car pair)
+ c-guess-guessed-offsets-alist (cdr pair)))))
+
+
+(defun c-guess-examine (start end accumulator)
+ (let ((reporter (when (fboundp 'make-progress-reporter)
+ (make-progress-reporter "Examining Indentation "
+ start
+ end))))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (unless (c-guess-empty-line-p)
+ (mapc (lambda (s)
+ (setq accumulator (or (c-guess-accumulate accumulator s)
+ accumulator)))
+ (c-save-buffer-state () (c-guess-basic-syntax))))
+ (when reporter (progress-reporter-update reporter (point)))
+ (forward-line 1)))
+ (when reporter (progress-reporter-done reporter)))
+ (c-guess-sort-accumulator accumulator))
+
+(defun c-guess-guess (accumulator)
+ ;; Guess basic-offset and offsets-alist from ACCUMULATOR,
+ ;; then return them as a cons: (basic-offset . offsets-alist).
+ ;; See the comments at `c-guess-accumulator' about the format
+ ;; ACCUMULATOR.
+ (let* ((basic-offset (c-guess-make-basic-offset accumulator))
+ (typical-offsets-alist (c-guess-make-offsets-alist
+ accumulator))
+ (symbolic-offsets-alist (c-guess-symbolize-offsets-alist
+ typical-offsets-alist
+ basic-offset))
+ (merged-offsets-alist (c-guess-merge-offsets-alists
+ (copy-tree c-guess-conversions)
+ symbolic-offsets-alist)))
+ (cons basic-offset merged-offsets-alist)))
+
+(defun c-guess-current-offset (relpos)
+ ;; Calculate relative indentation (point) to RELPOS.
+ (- (progn (back-to-indentation)
+ (current-column))
+ (save-excursion
+ (goto-char relpos)
+ (current-column))))
+
+(defun c-guess-accumulate (accumulator syntax-element)
+ ;; Add SYNTAX-ELEMENT to ACCUMULATOR.
+ (let ((symbol (car syntax-element))
+ (relpos (cadr syntax-element)))
+ (when (numberp relpos)
+ (let ((offset (c-guess-current-offset relpos)))
+ (when (< (abs offset) c-guess-offset-threshold)
+ (c-guess-accumulate-offset accumulator
+ symbol
+ offset))))))
+
+(defun c-guess-accumulate-offset (accumulator symbol offset)
+ ;; Added SYMBOL and OFFSET to ACCUMULATOR. See
+ ;; `c-guess-accumulator' about the structure of ACCUMULATOR.
+ (let* ((entry (assoc symbol accumulator))
+ (counters (cdr entry))
+ counter)
+ (if entry
+ (progn
+ (setq counter (assoc offset counters))
+ (if counter
+ (setcdr counter (1+ (cdr counter)))
+ (setq counters (cons (cons offset 1) counters))
+ (setcdr entry counters))
+ accumulator)
+ (cons (cons symbol (cons (cons offset 1) nil)) accumulator))))
+
+(defun c-guess-sort-accumulator (accumulator)
+ ;; Sort each element of ACCUMULATOR by the number-of-times. See
+ ;; `c-guess-accumulator' for more details.
+ (mapcar
+ (lambda (entry)
+ (let ((symbol (car entry))
+ (counters (cdr entry)))
+ (cons symbol (sort counters
+ (lambda (a b)
+ (if (> (cdr a) (cdr b))
+ t
+ (and
+ (eq (cdr a) (cdr b))
+ (< (car a) (car b)))))))))
+ accumulator))
+
+(defun c-guess-make-offsets-alist (accumulator)
+ ;; Throw away the rare cases in accumulator and make an offsets-alist structure.
+ (mapcar
+ (lambda (entry)
+ (cons (car entry)
+ (car (car (cdr entry)))))
+ accumulator))
+
+(defun c-guess-merge-offsets-alists (strong weak)
+ ;; Merge two offsets-alists into one.
+ ;; When two offsets-alists have the same symbol
+ ;; entry, give STRONG priority over WEAK.
+ (mapc
+ (lambda (weak-elt)
+ (unless (assoc (car weak-elt) strong)
+ (setq strong (cons weak-elt strong))))
+ weak)
+ strong)
+
+(defun c-guess-make-basic-offset (accumulator)
+ ;; As candidate for `c-basic-offset', find the most frequently appearing
+ ;; indentation-offset in ACCUMULATOR.
+ (let* (;; Drop the value related to `c' syntactic-symbol.
+ ;; (`c': Inside a multiline C style block comment.)
+ ;; The impact for values of `c' is too large for guessing
+ ;; `basic-offset' if the target source file is small and its license
+ ;; notice is at top of the file.
+ (accumulator (assq-delete-all 'c (copy-tree accumulator)))
+ ;; Drop syntactic-symbols from ACCUMULATOR.
+ (alist (apply #'append (mapcar (lambda (elts)
+ (mapcar (lambda (elt)
+ (cons (abs (car elt))
+ (cdr elt)))
+ (cdr elts)))
+ accumulator)))
+ ;; Gather all indentation-offsets other than 0.
+ ;; 0 is meaningless as `basic-offset'.
+ (offset-list (delete 0
+ (delete-dups (mapcar
+ (lambda (elt) (car elt))
+ alist))))
+ ;; Sum of number-of-times for offset:
+ ;; (offset . sum)
+ (summed (mapcar (lambda (offset)
+ (cons offset
+ (apply #'+
+ (mapcar (lambda (a)
+ (if (eq (car a) offset)
+ (cdr a)
+ 0))
+ alist))))
+ offset-list)))
+ ;;
+ ;; Find the majority.
+ ;;
+ (let ((majority '(nil . 0)))
+ (while summed
+ (when (< (cdr majority) (cdr (car summed)))
+ (setq majority (car summed)))
+ (setq summed (cdr summed)))
+ (car majority))))
+
+(defun c-guess-symbolize-offsets-alist (offsets-alist basic-offset)
+ ;; Convert the representation of OFFSETS-ALIST to an alist using
+ ;; `+', `-', `++', `--', `*', or `/'. These symbols represent
+ ;; a value relative to BASIC-OFFSET. Their meaning can be found
+ ;; in the CC Mode manual.
+ (mapcar
+ (lambda (elt)
+ (let ((s (car elt))
+ (v (cdr elt)))
+ (cond
+ ((integerp v)
+ (cons s (c-guess-symbolize-integer v
+ basic-offset)))
+ (t elt))))
+ offsets-alist))
+
+(defun c-guess-symbolize-integer (int basic-offset)
+ (let ((aint (abs int)))
+ (cond
+ ((eq int basic-offset) '+)
+ ((eq aint basic-offset) '-)
+ ((eq int (* 2 basic-offset)) '++)
+ ((eq aint (* 2 basic-offset)) '--)
+ ((eq (* 2 int) basic-offset) '*)
+ ((eq (* 2 aint) basic-offset) '-)
+ (t int))))
+
+(defun c-guess-style-name ()
+ ;; Make a style name for the guessed style.
+ (format "*c-guess*:%s" (buffer-file-name)))
+
+(defun c-guess-make-style (basic-offset offsets-alist)
+ (when basic-offset
+ ;; Make a style from guessed values.
+ (let* ((offsets-alist (c-guess-merge-offsets-alists
+ offsets-alist
+ c-offsets-alist)))
+ `((c-basic-offset . ,basic-offset)
+ (c-offsets-alist . ,offsets-alist)))))
+
+;;;###autoload
+(defun c-guess-install (&optional style-name)
+ "Install the latest guessed style into the current buffer.
+\(This guessed style is a combination of `c-guess-guessed-basic-offset',
+`c-guess-guessed-offsets-alist' and `c-offsets-alist'.)
+
+The style is entered into CC Mode's style system by
+`c-add-style'. Its name is either STYLE-NAME, or a name based on
+the absolute file name of the file if STYLE-NAME is nil."
+ (interactive "sNew style name (empty for default name): ")
+ (let* ((style (c-guess-make-style c-guess-guessed-basic-offset
+ c-guess-guessed-offsets-alist)))
+ (if style
+ (let ((style-name (or (if (equal style-name "")
+ nil
+ style-name)
+ (c-guess-style-name))))
+ (c-add-style style-name style t)
+ (message "Style \"%s\" is installed" style-name))
+ (error "Not yet guessed"))))
+
+(defun c-guess-dump-accumulator ()
+ "Show `c-guess-accumulator'."
+ (interactive)
+ (with-output-to-temp-buffer "*Accumulated Examined Indent Information*"
+ (pp c-guess-accumulator)))
+
+(defun c-guess-reset-accumulator ()
+ "Reset `c-guess-accumulator'."
+ (interactive)
+ (setq c-guess-accumulator nil))
+
+(defun c-guess-dump-guessed-values ()
+ "Show `c-guess-guessed-basic-offset' and `c-guess-guessed-offsets-alist'."
+ (interactive)
+ (with-output-to-temp-buffer "*Guessed Values*"
+ (princ "basic-offset: \n\t")
+ (pp c-guess-guessed-basic-offset)
+ (princ "\n\n")
+ (princ "offsets-alist: \n")
+ (pp c-guess-guessed-offsets-alist)
+ ))
+
+(defun c-guess-dump-guessed-style (&optional printer)
+ "Show the guessed style.
+`pp' is used to print the style but if PRINTER is given,
+PRINTER is used instead. If PRINTER is not `nil', it
+is called with one argument, the guessed style."
+ (interactive)
+ (let ((style (c-guess-make-style c-guess-guessed-basic-offset
+ c-guess-guessed-offsets-alist)))
+ (if style
+ (with-output-to-temp-buffer "*Guessed Style*"
+ (funcall (if printer printer 'pp) style))
+ (error "Not yet guessed"))))
+
+(defun c-guess-guessed-syntactic-symbols ()
+ ;; Return syntactic symbols in c-guess-guessed-offsets-alist
+ ;; but not in c-guess-conversions.
+ (let ((alist c-guess-guessed-offsets-alist)
+ elt
+ (symbols nil))
+ (while alist
+ (setq elt (car alist)
+ alist (cdr alist))
+ (unless (assq (car elt) c-guess-conversions)
+ (setq symbols (cons (car elt)
+ symbols))))
+ symbols))
+
+(defun c-guess-view-reorder-offsets-alist-in-style (style guessed-syntactic-symbols)
+ ;; Reorder the `c-offsets-alist' field of STYLE.
+ ;; If an entry in `c-offsets-alist' holds a guessed value, move it to
+ ;; front in the field. In addition alphabetical sort by entry name is done.
+ (setq style (copy-tree style))
+ (let ((offsets-alist-cell (assq 'c-offsets-alist style))
+ (guessed-syntactic-symbols (c-guess-guessed-syntactic-symbols)))
+ (setcdr offsets-alist-cell
+ (sort (cdr offsets-alist-cell)
+ (lambda (a b)
+ (let ((a-guessed? (memq (car a) guessed-syntactic-symbols))
+ (b-guessed? (memq (car b) guessed-syntactic-symbols)))
+ (cond
+ ((or (and a-guessed? b-guessed?)
+ (not (or a-guessed? b-guessed?)))
+ (string-lessp (symbol-name (car a))
+ (symbol-name (car b))))
+ (a-guessed? t)
+ (b-guessed? nil)))))))
+ style)
+
+(defun c-guess-view-mark-guessed-entries (guessed-syntactic-symbols)
+ ;; Put " ; Guess value" markers on all entries which hold
+ ;; guessed values.
+ ;; `c-basic-offset' is always considered as holding a guessed value.
+ (let ((needs-markers (cons 'c-basic-offset
+ guessed-syntactic-symbols)))
+ (while needs-markers
+ (goto-char (point-min))
+ (when (search-forward (concat "("
+ (symbol-name (car needs-markers))
+ " ") nil t)
+ (move-end-of-line 1)
+ (comment-dwim nil)
+ (insert " Guessed value"))
+ (setq needs-markers
+ (cdr needs-markers)))))
+
+(defun c-guess-view (&optional with-name)
+ "Emit emacs lisp code which defines the last guessed style.
+So you can put the code into .emacs if you prefer the
+guessed code.
+\"STYLE NAME HERE\" is used as the name for the style in the
+emitted code. If WITH-NAME is given, it is used instead.
+WITH-NAME is expected as a string but if this function
+called interactively with prefix argument, the value for
+WITH-NAME is asked to the user."
+ (interactive "P")
+ (let* ((temporary-style-name (cond
+ ((stringp with-name) with-name)
+ (with-name (read-from-minibuffer
+ "New style name: "))
+ (t
+ "STYLE NAME HERE")))
+ (guessed-style-name (c-guess-style-name))
+ (current-style-name c-indentation-style)
+ (parent-style-name (if (string-equal guessed-style-name
+ current-style-name)
+ ;; The guessed style is already installed.
+ ;; It cannot be used as the parent style.
+ ;; Use the default style for the current
+ ;; major mode as the parent style.
+ (cc-choose-style-for-mode
+ major-mode
+ c-default-style)
+ ;; The guessed style is not installed yet.
+ current-style-name)))
+ (c-guess-dump-guessed-style
+ (lambda (style)
+ (let ((guessed-syntactic-symbols (c-guess-guessed-syntactic-symbols)))
+ (pp `(c-add-style ,temporary-style-name
+ ',(cons parent-style-name
+ (c-guess-view-reorder-offsets-alist-in-style
+ style
+ guessed-syntactic-symbols))))
+ (with-current-buffer standard-output
+ (lisp-interaction-mode)
+ (c-guess-view-mark-guessed-entries
+ guessed-syntactic-symbols)
+ (buffer-enable-undo)))))))
+
+
+(cc-provide 'cc-guess)
+;;; cc-guess.el ends here
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 86a963bcf55..a6459e1724f 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -295,6 +295,19 @@ the evaluated constant value at compile time."
["Backslashify" c-backslash-region
(c-fn-region-is-active-p)]))
"----"
+ ("Style..."
+ ["Set Style..." c-set-style t]
+ ["Show Current Style Name" (message
+ "Style Name: %s"
+ c-indentation-style) t]
+ ["Guess Style from this Buffer" c-guess-buffer-no-install t]
+ ["Install the Last Guessed Style..." c-guess-install
+ (and c-guess-guessed-offsets-alist
+ c-guess-guessed-basic-offset) ]
+ ["View the Last Guessed Style" c-guess-view
+ (and c-guess-guessed-offsets-alist
+ c-guess-guessed-basic-offset) ])
+ "----"
("Toggle..."
["Syntactic indentation" c-toggle-syntactic-indentation
:style toggle :selected c-syntactic-indentation]
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 1a2e0027ea7..1adc6c2eac0 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -93,6 +93,7 @@
(cc-require 'cc-cmds)
(cc-require 'cc-align)
(cc-require 'cc-menus)
+(cc-require 'cc-guess)
;; Silence the compiler.
(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
@@ -553,11 +554,7 @@ that requires a literal mode spec at compile time."
(c-clear-found-types)
;; now set the mode style based on default-style
- (let ((style (if (stringp default-style)
- default-style
- (or (cdr (assq mode default-style))
- (cdr (assq 'other default-style))
- "gnu"))))
+ (let ((style (cc-choose-style-for-mode mode default-style)))
;; Override style variables if `c-old-style-variable-behavior' is
;; set. Also override if we are using global style variables,
;; have already initialized a style once, and are switching to a
@@ -692,7 +689,8 @@ This function is called from the hook `before-hack-local-variables-hook'."
(c-count-cfss file-local-variables-alist))
(cfs-in-dir-count (c-count-cfss dir-local-variables-alist)))
(c-set-style stile
- (= cfs-in-file-and-dir-count cfs-in-dir-count)))
+ (and (= cfs-in-file-and-dir-count cfs-in-dir-count)
+ 'keep-defaults)))
(c-set-style stile)))
(when offsets
(mapc
@@ -1174,7 +1172,7 @@ This does not load the font-lock package. Use after
;;;###autoload
-(defun c-mode ()
+(define-derived-mode c-mode prog-mode "C"
"Major mode for editing K&R and ANSI C code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c-mode buffer. This automatically sets up a mail buffer with version
@@ -1188,13 +1186,9 @@ initialization, then `c-mode-hook'.
Key bindings:
\\{c-mode-map}"
- (interactive)
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table c-mode-syntax-table)
- (setq major-mode 'c-mode ; FIXME: Use define-derived-mode.
- mode-name "C"
- local-abbrev-table c-mode-abbrev-table
+ (setq local-abbrev-table c-mode-abbrev-table
abbrev-mode t)
(use-local-map c-mode-map)
(c-init-language-vars-for 'c-mode)
@@ -1236,7 +1230,7 @@ Key bindings:
(cons "C++" (c-lang-const c-mode-menu c++)))
;;;###autoload
-(defun c++-mode ()
+(define-derived-mode c++-mode prog-mode "C++"
"Major mode for editing C++ code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c++-mode buffer. This automatically sets up a mail buffer with
@@ -1251,13 +1245,9 @@ initialization, then `c++-mode-hook'.
Key bindings:
\\{c++-mode-map}"
- (interactive)
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table c++-mode-syntax-table)
- (setq major-mode 'c++-mode ; FIXME: Use define-derived-mode.
- mode-name "C++"
- local-abbrev-table c++-mode-abbrev-table
+ (setq local-abbrev-table c++-mode-abbrev-table
abbrev-mode t)
(use-local-map c++-mode-map)
(c-init-language-vars-for 'c++-mode)
@@ -1297,7 +1287,7 @@ Key bindings:
;;;###autoload (add-to-list 'auto-mode-alist '("\\.m\\'" . objc-mode))
;;;###autoload
-(defun objc-mode ()
+(define-derived-mode objc-mode prog-mode "ObjC"
"Major mode for editing Objective C code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
objc-mode buffer. This automatically sets up a mail buffer with
@@ -1312,13 +1302,9 @@ initialization, then `objc-mode-hook'.
Key bindings:
\\{objc-mode-map}"
- (interactive)
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table objc-mode-syntax-table)
- (setq major-mode 'objc-mode ; FIXME: Use define-derived-mode.
- mode-name "ObjC"
- local-abbrev-table objc-mode-abbrev-table
+ (setq local-abbrev-table objc-mode-abbrev-table
abbrev-mode t)
(use-local-map objc-mode-map)
(c-init-language-vars-for 'objc-mode)
@@ -1367,7 +1353,7 @@ Key bindings:
;;;###autoload (add-to-list 'auto-mode-alist '("\\.java\\'" . java-mode))
;;;###autoload
-(defun java-mode ()
+(define-derived-mode java-mode prog-mode "Java"
"Major mode for editing Java code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
java-mode buffer. This automatically sets up a mail buffer with
@@ -1382,13 +1368,9 @@ initialization, then `java-mode-hook'.
Key bindings:
\\{java-mode-map}"
- (interactive)
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table java-mode-syntax-table)
- (setq major-mode 'java-mode ; FIXME: Use define-derived-mode.
- mode-name "Java"
- local-abbrev-table java-mode-abbrev-table
+ (setq local-abbrev-table java-mode-abbrev-table
abbrev-mode t)
(use-local-map java-mode-map)
(c-init-language-vars-for 'java-mode)
@@ -1426,7 +1408,7 @@ Key bindings:
;;;###autoload (add-to-list 'auto-mode-alist '("\\.idl\\'" . idl-mode))
;;;###autoload
-(defun idl-mode ()
+(define-derived-mode idl-mode prog-mode "IDL"
"Major mode for editing CORBA's IDL, PSDL and CIDL code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
idl-mode buffer. This automatically sets up a mail buffer with
@@ -1441,13 +1423,9 @@ initialization, then `idl-mode-hook'.
Key bindings:
\\{idl-mode-map}"
- (interactive)
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table idl-mode-syntax-table)
- (setq major-mode 'idl-mode ; FIXME: Use define-derived-mode.
- mode-name "IDL"
- local-abbrev-table idl-mode-abbrev-table)
+ (setq local-abbrev-table idl-mode-abbrev-table)
(use-local-map idl-mode-map)
(c-init-language-vars-for 'idl-mode)
(c-common-init 'idl-mode)
@@ -1487,7 +1465,7 @@ Key bindings:
;;;###autoload (add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
;;;###autoload
-(defun pike-mode ()
+(define-derived-mode pike-mode prog-mode "Pike"
"Major mode for editing Pike code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
pike-mode buffer. This automatically sets up a mail buffer with
@@ -1502,13 +1480,9 @@ initialization, then `pike-mode-hook'.
Key bindings:
\\{pike-mode-map}"
- (interactive)
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table pike-mode-syntax-table)
- (setq major-mode 'pike-mode ; FIXME: Use define-derived-mode.
- mode-name "Pike"
- local-abbrev-table pike-mode-abbrev-table
+ (setq local-abbrev-table pike-mode-abbrev-table
abbrev-mode t)
(use-local-map pike-mode-map)
(c-init-language-vars-for 'pike-mode)
@@ -1561,7 +1535,8 @@ Key bindings:
(defvar awk-mode-syntax-table)
(declare-function c-awk-unstick-NL-prop "cc-awk" ())
-(defun awk-mode ()
+;;;###autoload
+(define-derived-mode awk-mode prog-mode "AWK"
"Major mode for editing AWK code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
awk-mode buffer. This automatically sets up a mail buffer with version
@@ -1575,14 +1550,10 @@ initialization, then `awk-mode-hook'.
Key bindings:
\\{awk-mode-map}"
- (interactive)
(require 'cc-awk) ; Added 2003/6/10.
- (kill-all-local-variables)
(c-initialize-cc-mode t)
(set-syntax-table awk-mode-syntax-table)
- (setq major-mode 'awk-mode ; FIXME: Use define-derived-mode.
- mode-name "AWK"
- local-abbrev-table awk-mode-abbrev-table
+ (setq local-abbrev-table awk-mode-abbrev-table
abbrev-mode t)
(use-local-map awk-mode-map)
(c-init-language-vars-for 'awk-mode)
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index e161eb6d0f5..96cb15f2a72 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -650,6 +650,15 @@ any reason to call this function directly."
(setq c-style-variables-are-local-p t))
))
+(defun cc-choose-style-for-mode (mode default-style)
+ "Return suitable style for MODE from DEFAULT-STYLE.
+DEFAULT-STYLE has the same format as `c-default-style'."
+ (if (stringp default-style)
+ default-style
+ (or (cdr (assq mode default-style))
+ (cdr (assq 'other default-style))
+ "gnu")))
+
(cc-provide 'cc-styles)
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index d2a5d117635..58dc1737c5a 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1633,8 +1633,7 @@ as designated in the variable `c-file-style'.")
;; It isn't possible to specify a doc-string without specifying an
;; initial value with `defvar', so the following two variables have been
;; given doc-strings by setting the property `variable-documentation'
-;; directly. C-h v will read this documentation only for versions of GNU
-;; Emacs from 22.1. It's really good not to have an initial value for
+;; directly. It's really good not to have an initial value for
;; variables like these that always should be dynamically bound, so it's
;; worth the inconvenience.
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index a475bbd5932..7989c60f80c 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
+;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: languages
;; This file is part of GNU Emacs.
@@ -28,6 +29,13 @@
;; Possible customization for auto-mode selection:
;; (push '(("^cfagent.conf\\'" . cfengine-mode)) auto-mode-alist)
;; (push '(("^cf\\." . cfengine-mode)) auto-mode-alist)
+;; (push '(("\\.cf\\'" . cfengine-mode)) auto-mode-alist)
+
+;; Or, if you want to use the CFEngine 3.x support:
+
+;; (push '(("^cfagent.conf\\'" . cfengine3-mode)) auto-mode-alist)
+;; (push '(("^cf\\." . cfengine3-mode)) auto-mode-alist)
+;; (push '(("\\.cf\\'" . cfengine3-mode)) auto-mode-alist)
;; This is not the same as the mode written by Rolf Ebert
;; <ebert@waporo.muc.de>, distributed with cfengine-2.0.5. It does
@@ -63,7 +71,27 @@
;; cfservd
"admit" "grant" "deny")
"List of the action keywords supported by Cfengine.
-This includes those for cfservd as well as cfagent."))
+This includes those for cfservd as well as cfagent.")
+
+ (defconst cfengine3-defuns
+ (mapcar
+ 'symbol-name
+ '(bundle body))
+ "List of the CFEngine 3.x defun headings.")
+
+ (defconst cfengine3-defuns-regex
+ (regexp-opt cfengine3-defuns t)
+ "Regex to match the CFEngine 3.x defuns.")
+
+ (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::")
+
+ (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
+
+ (defconst cfengine3-vartypes
+ (mapcar
+ 'symbol-name
+ '(string int real slist ilist rlist irange rrange counter))
+ "List of the CFEngine 3.x variable types."))
(defvar cfengine-font-lock-keywords
`(;; Actions.
@@ -82,6 +110,31 @@ This includes those for cfservd as well as cfagent."))
;; File, acl &c in group: { token ... }
("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
+(defvar cfengine3-font-lock-keywords
+ `(
+ (,(concat "^[ \t]*" cfengine3-class-selector-regex)
+ 1 font-lock-keyword-face)
+ (,(concat "^[ \t]*" cfengine3-category-regex)
+ 1 font-lock-builtin-face)
+ ;; Variables, including scope, e.g. module.var
+ ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face)
+ ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face)
+ ;; Variable definitions.
+ ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
+
+ ;; CFEngine 3.x faces
+ ;; defuns
+ (,(concat "\\<" cfengine3-defuns-regex "\\>"
+ "[ \t]+\\<\\([[:alnum:]_]+\\)\\>"
+ "[ \t]+\\<\\([[:alnum:]_]+\\)\\((\\([^)]*\\))\\)?")
+ (1 font-lock-builtin-face)
+ (2 font-lock-constant-name-face)
+ (3 font-lock-function-name-face)
+ (5 font-lock-variable-name-face))
+ ;; variable types
+ (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>")
+ 1 font-lock-type-face)))
+
(defvar cfengine-imenu-expression
`((nil ,(concat "^[ \t]*" (eval-when-compile
(regexp-opt cfengine-actions t))
@@ -197,32 +250,207 @@ Intended as the value of `indent-line-function'."
(fill-paragraph justify))
t))
+(defun cfengine3-beginning-of-defun ()
+ "`beginning-of-defun' function for Cfengine 3 mode.
+Treats body/bundle blocks as defuns."
+ (unless (<= (current-column) (current-indentation))
+ (end-of-line))
+ (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
+ (beginning-of-line)
+ (goto-char (point-min)))
+ t)
+
+(defun cfengine3-end-of-defun ()
+ "`end-of-defun' function for Cfengine 3 mode.
+Treats body/bundle blocks as defuns."
+ (end-of-line)
+ (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ t)
+
+(defun cfengine3-indent-line ()
+ "Indent a line in Cfengine 3 mode.
+Intended as the value of `indent-line-function'."
+ (let ((pos (- (point-max) (point)))
+ parse)
+ (save-restriction
+ (narrow-to-defun)
+ (back-to-indentation)
+ (setq parse (parse-partial-sexp (point-min) (point)))
+ (message "%S" parse)
+ (cond
+ ;; body/bundle blocks start at 0
+ ((looking-at (concat cfengine3-defuns-regex "\\>"))
+ (indent-line-to 0))
+ ;; categories are indented one step
+ ((looking-at (concat cfengine3-category-regex "[ \t]*$"))
+ (indent-line-to cfengine-indent))
+ ;; class selectors are indented two steps
+ ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$"))
+ (indent-line-to (* 2 cfengine-indent)))
+ ;; Outdent leading close brackets one step.
+ ((or (eq ?\} (char-after))
+ (eq ?\) (char-after)))
+ (condition-case ()
+ (indent-line-to (save-excursion
+ (forward-char)
+ (backward-sexp)
+ (current-column)))
+ (error nil)))
+ ;; inside a string and it starts before this line
+ ((and (nth 3 parse)
+ (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
+ (indent-line-to 0))
+ ;; inside a defun, but not a nested list (depth is 1)
+ ((= 1 (nth 0 parse))
+ (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))
+ ;; Inside brackets/parens: indent to start column of non-comment
+ ;; token on line following open bracket or by one step from open
+ ;; bracket's column.
+ ((condition-case ()
+ (progn (indent-line-to (save-excursion
+ (backward-up-list)
+ (forward-char)
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at "[^\n#]")
+ (current-column))
+ ((looking-at "[^\n#]")
+ (current-column))
+ (t
+ (skip-chars-backward " \t")
+ (+ (current-column) -1
+ cfengine-indent)))))
+ t)
+ (error nil)))
+ ;; Else don't indent.
+ (t (indent-line-to 0))))
+ ;; 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)))))
+
+;; CFEngine 3.x grammar
+
+;; specification: blocks
+;; blocks: block | blocks block;
+;; block: bundle typeid blockid bundlebody
+;; | bundle typeid blockid usearglist bundlebody
+;; | body typeid blockid bodybody
+;; | body typeid blockid usearglist bodybody;
+
+;; typeid: id
+;; blockid: id
+;; usearglist: '(' aitems ')';
+;; aitems: aitem | aitem ',' aitems |;
+;; aitem: id
+
+;; bundlebody: '{' statements '}'
+;; statements: statement | statements statement;
+;; statement: category | classpromises;
+
+;; bodybody: '{' bodyattribs '}'
+;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
+;; bodyattrib: class | selections;
+;; selections: selection | selections selection;
+;; selection: id ASSIGN rval ';' ;
+
+;; classpromises: classpromise | classpromises classpromise;
+;; classpromise: class | promises;
+;; promises: promise | promises promise;
+;; category: CATEGORY
+;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
+;; constraints: constraint | constraints ',' constraint |;
+;; constraint: id ASSIGN rval;
+;; class: CLASS
+;; id: ID
+;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
+;; list: '{' litems '}' ;
+;; litems: litem | litem ',' litems |;
+;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
+
+;; functionid: ID | NAKEDVAR
+;; promiser: QSTRING
+;; usefunction: functionid givearglist
+;; givearglist: '(' gaitems ')'
+;; gaitems: gaitem | gaitems ',' gaitem |;
+;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
+
+;; # from lexer:
+
+;; bundle: "bundle"
+;; body: "body"
+;; COMMENT #[^\n]*
+;; NAKEDVAR [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
+;; ID: [a-zA-Z0-9_\200-\377]+
+;; ASSIGN: "=>"
+;; ARROW: "->"
+;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
+;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
+;; CATEGORY: [a-zA-Z_]+:
+
+(defun cfengine-common-settings ()
+ (set (make-local-variable 'syntax-propertize-function)
+ ;; In the main syntax-table, \ is marked as a punctuation, because
+ ;; of its use in DOS-style directory separators. Here we try to
+ ;; recognize the cases where \ is used as an escape inside strings.
+ (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
+ (set (make-local-variable 'parens-require-spaces) nil)
+ (set (make-local-variable 'comment-start) "# ")
+ (set (make-local-variable 'comment-start-skip)
+ "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+ ;; Like Lisp mode. Without this, we lose with, say,
+ ;; `backward-up-list' when there's an unbalanced quote in a
+ ;; preceding comment.
+ (set (make-local-variable 'parse-sexp-ignore-comments) t))
+
+(defun cfengine-common-syntax (table)
+ ;; the syntax defaults seem OK to give reasonable word movement
+ (modify-syntax-entry ?# "<" table)
+ (modify-syntax-entry ?\n ">#" table)
+ (modify-syntax-entry ?\" "\"" table)
+ ;; variable substitution:
+ (modify-syntax-entry ?$ "." table)
+ ;; Doze path separators:
+ (modify-syntax-entry ?\\ "." table))
+
+;;;###autoload
+(define-derived-mode cfengine3-mode prog-mode "CFEngine3"
+ "Major mode for editing cfengine input.
+There are no special keybindings by default.
+
+Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
+to the action header."
+ (cfengine-common-settings)
+ (cfengine-common-syntax cfengine3-mode-syntax-table)
+
+ (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+ (setq font-lock-defaults
+ '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
+
+ ;; use defuns as the essential syntax block
+ (set (make-local-variable 'beginning-of-defun-function)
+ #'cfengine3-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ #'cfengine3-end-of-defun))
+
;;;###autoload
-(define-derived-mode cfengine-mode fundamental-mode "Cfengine"
+(define-derived-mode cfengine-mode prog-mode "Cfengine"
"Major mode for editing cfengine input.
There are no special keybindings by default.
Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
to the action header."
- (modify-syntax-entry ?# "<" cfengine-mode-syntax-table)
- (modify-syntax-entry ?\n ">#" cfengine-mode-syntax-table)
+ (cfengine-common-settings)
+ (cfengine-common-syntax cfengine-mode-syntax-table)
+
;; Shell commands can be quoted by single, double or back quotes.
;; It's debatable whether we should define string syntax, but it
;; should avoid potential confusion in some cases.
- (modify-syntax-entry ?\" "\"" cfengine-mode-syntax-table)
(modify-syntax-entry ?\' "\"" cfengine-mode-syntax-table)
(modify-syntax-entry ?\` "\"" cfengine-mode-syntax-table)
- ;; variable substitution:
- (modify-syntax-entry ?$ "." cfengine-mode-syntax-table)
- ;; Doze path separators:
- (modify-syntax-entry ?\\ "." cfengine-mode-syntax-table)
- ;; Otherwise, syntax defaults seem OK to give reasonable word
- ;; movement.
- (set (make-local-variable 'parens-require-spaces) nil)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
(set (make-local-variable 'indent-line-function) #'cfengine-indent-line)
(set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
(set (make-local-variable 'outline-level) #'cfengine-outline-level)
@@ -233,20 +461,12 @@ to the action header."
'(cfengine-font-lock-keywords nil nil nil beginning-of-line))
;; Fixme: set the args of functions in evaluated classes to string
;; syntax, and then obey syntax properties.
- (set (make-local-variable 'syntax-propertize-function)
- ;; In the main syntax-table, \ is marked as a punctuation, because
- ;; of its use in DOS-style directory separators. Here we try to
- ;; recognize the cases where \ is used as an escape inside strings.
- (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
(setq imenu-generic-expression cfengine-imenu-expression)
(set (make-local-variable 'beginning-of-defun-function)
#'cfengine-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function) #'cfengine-end-of-defun)
- ;; Like Lisp mode. Without this, we lose with, say,
- ;; `backward-up-list' when there's an unbalanced quote in a
- ;; preceding comment.
- (set (make-local-variable 'parse-sexp-ignore-comments) t))
+ (set (make-local-variable 'end-of-defun-function) #'cfengine-end-of-defun))
+(provide 'cfengine3)
(provide 'cfengine)
;;; cfengine.el ends here
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index b8cac2fd331..503698f0f7b 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -155,8 +155,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
\\([a-zA-Z]?:?[^:( \t\n]+\\)\
\\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
- (caml
- "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
+ (python-tracebacks-and-caml
+ "^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
2 (3 . 4) (5 . 6) (7))
@@ -253,7 +253,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
*\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\|[Nn]ote\\)\\|\
-\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
+ *[Ee]rror\\|\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
1 (2 . 4) (3 . 5) (6 . 7))
(lcc
@@ -400,15 +400,16 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
"^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
1 2)
(perl--Test2
- ;; Or when comparing got/want values,
+ ;; Or when comparing got/want values, with a "fail #n" if repeated
;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10)
+ ;; # Test 3 got: "xx" (t-compilation-perl-2.t at line 10 fail #2)
;;
;; And under Test::Harness they're preceded by progress stuff with
;; \r and "NOK",
;; ... NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
;;
"^\\(.*NOK.*\\)?# Test [0-9]+ got:.* (\\([^ \t\r\n]+\\) at line \
-\\([0-9]+\\))"
+\\([0-9]+\\)\\( fail #[0-9]+\\)?)"
2 3)
(perl--Test::Harness
;; perl Test::Harness output, eg.
@@ -2409,9 +2410,7 @@ and overlay is highlighted between MK and END-MK."
;; display the source in another window.
(let ((pop-up-windows t))
(pop-to-buffer (marker-buffer mk) 'other-window))
- (if (window-dedicated-p (selected-window))
- (pop-to-buffer (marker-buffer mk))
- (switch-to-buffer (marker-buffer mk))))
+ (pop-to-buffer-same-window (marker-buffer mk)))
(unless (eq (goto-char mk) (point))
;; If narrowing gets in the way of going to the right place, widen.
(widen)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index f6d497569ba..ad3b777977c 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -613,7 +613,7 @@ One should tune up `cperl-close-paren-offset' as well."
(defcustom cperl-syntaxify-by-font-lock
(and cperl-can-font-lock
(boundp 'parse-sexp-lookup-properties))
- "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."
+ "*Non-nil means that CPerl uses the `font-lock' routines for syntaxification."
:type '(choice (const message) boolean)
:group 'cperl-speed)
@@ -1522,7 +1522,7 @@ the last)."
(defvar compilation-error-regexp-alist)
;;;###autoload
-(defun cperl-mode ()
+(define-derived-mode cperl-mode prog-mode "CPerl"
"Major mode for editing Perl code.
Expression and list commands understand all C brackets.
Tab indents for Perl code.
@@ -1695,9 +1695,6 @@ with no args.
DO NOT FORGET to read micro-docs (available from `Perl' menu)
or as help on variables `cperl-tips', `cperl-problems',
`cperl-praise', `cperl-speed'."
- (interactive)
- (kill-all-local-variables)
- (use-local-map cperl-mode-map)
(if (cperl-val 'cperl-electric-linefeed)
(progn
(local-set-key "\C-J" 'cperl-linefeed)
@@ -1710,8 +1707,6 @@ or as help on variables `cperl-tips', `cperl-problems',
(cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
(cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
[(control c) (control h) f])))
- (setq major-mode cperl-use-major-mode)
- (setq mode-name "CPerl")
(let ((prev-a-c abbrevs-changed))
(define-abbrev-table 'cperl-mode-abbrev-table '(
("if" "if" cperl-electric-keyword 0)
@@ -8594,10 +8589,10 @@ the appropriate statement modifier."
(pargs (cdr (car flist))))
(setq command
(concat command " | " pcom " "
- (mapconcat '(lambda (phrase)
- (if (not (stringp phrase))
- (error "Malformed Man-filter-list"))
- phrase)
+ (mapconcat (lambda (phrase)
+ (if (not (stringp phrase))
+ (error "Malformed Man-filter-list"))
+ phrase)
pargs " ")))
(setq flist (cdr flist))))
command))
@@ -8971,18 +8966,6 @@ do extra unwind via `cperl-unwind-to-safe'."
(substring v (match-beginning 1) (match-end 1)))
"Version of IZ-supported CPerl package this file is based on.")
-(defun cperl-mode-unload-function ()
- "Unload the Cperl mode library."
- (let ((new-mode (if (eq (symbol-function 'perl-mode) 'cperl-mode)
- 'fundamental-mode
- 'perl-mode)))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (eq major-mode 'cperl-mode)
- (funcall new-mode)))))
- ;; continue standard unloading
- nil)
-
(provide 'cperl-mode)
;;; cperl-mode.el ends here
diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el
index c809079381f..e8e2f8ffbf0 100644
--- a/lisp/progmodes/delphi.el
+++ b/lisp/progmodes/delphi.el
@@ -1959,12 +1959,12 @@ comment block. If not in a // comment, just does a normal newline."
kmap)
"Keymap used in Delphi mode.")
-(defconst delphi-mode-syntax-table (make-syntax-table)
+(defvar delphi-mode-syntax-table nil
"Delphi mode's syntax table. It is just a standard syntax table.
This is ok since we do our own keyword/comment/string face coloring.")
;;;###autoload
-(defun delphi-mode (&optional skip-initial-parsing)
+(define-derived-mode delphi-mode prog-mode "Delphi"
"Major mode for editing Delphi code. \\<delphi-mode-map>
\\[delphi-tab]\t- Indents the current line (or region, if Transient Mark mode
\t is enabled and the region is active) of Delphi code.
@@ -2007,14 +2007,6 @@ Coloring:
Turning on Delphi mode calls the value of the variable `delphi-mode-hook'
with no args, if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (use-local-map delphi-mode-map)
- (setq major-mode 'delphi-mode) ;FIXME: Use define-derived-mode.
- (setq mode-name "Delphi")
-
- (setq local-abbrev-table delphi-mode-abbrev-table)
- (set-syntax-table delphi-mode-syntax-table)
;; Buffer locals:
(mapc #'(lambda (var)
@@ -2033,12 +2025,12 @@ with no args, if that value is non-nil."
(add-hook 'after-change-functions 'delphi-after-change nil t)
(widen)
- (unless skip-initial-parsing
- (delphi-save-excursion
- (let ((delphi-verbose t))
- (delphi-progress-start)
- (delphi-parse-region (point-min) (point-max))
- (delphi-progress-done))))
+
+ (delphi-save-excursion
+ (let ((delphi-verbose t))
+ (delphi-progress-start)
+ (delphi-parse-region (point-min) (point-max))
+ (delphi-progress-done)))
(run-mode-hooks 'delphi-mode-hook))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 6bd2de992cb..385adf1af0a 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -812,7 +812,7 @@ If no tags table is loaded, do nothing and return nil."
(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)))))))
+ (list beg (point) (tags-lazy-completion-table) :exclusive 'no))))))
(defun find-tag-tag (string)
"Read a tag name, with defaulting and completion."
@@ -1860,7 +1860,11 @@ nil, we exit; otherwise we scan the next file."
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
-See documentation of variable `tags-file-name'."
+If `file-list-form' is non-nil, it should be a form that, when
+evaluated, will return a list of file names. The search will be
+restricted to these files.
+
+Aleso see the documentation of the `tags-file-name' variable."
(interactive "sTags search (regexp): ")
(if (and (equal regexp "")
(eq (car tags-loop-scan) 're-search-forward)
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 53aa95498da..cdb5f2a715d 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -26,6 +26,7 @@
;; Major mode for editing F90 programs in FREE FORMAT.
;; The minor language revision F95 is also supported (with font-locking).
;; Some/many (?) aspects of F2003 are supported.
+;; Some aspects of F2008 are supported.
;; Knows about continuation lines, named structured statements, and other
;; features in F90 including HPF (High Performance Fortran) structures.
@@ -78,9 +79,9 @@
;; To customize f90-mode for your taste, use, for example:
;; (you don't have to specify values for all the parameters below)
;;
-;;(add-hook 'f90-mode-hook
-;; ;; These are the default values.
-;; '(lambda () (setq f90-do-indent 3
+;; (add-hook 'f90-mode-hook
+;; ;; These are the default values.
+;; (lambda () (setq f90-do-indent 3
;; f90-if-indent 3
;; f90-type-indent 3
;; f90-program-indent 2
@@ -207,6 +208,13 @@
:group 'f90-indent
:version "23.1")
+(defcustom f90-critical-indent 2
+ "Extra indentation applied to BLOCK, CRITICAL blocks."
+ :type 'integer
+ :safe 'integerp
+ :group 'f90-indent
+ :version "24.1")
+
(defcustom f90-continuation-indent 5
"Extra indentation applied to continuation lines."
:type 'integer
@@ -310,6 +318,9 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
"deferred" "enum" "enumerator" "extends" "extends_type_of"
"final" "generic" "import" "non_intrinsic" "non_overridable"
"nopass" "pass" "protected" "same_type_as" "value" "volatile"
+ ;; F2008.
+ "contiguous" "submodule" "concurrent" "codimension"
+ "sync all" "sync memory" "critical" "image_index"
) 'words)
"Regexp used by the function `f90-change-keywords'.")
@@ -327,6 +338,10 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
;; F2003. asynchronous separate.
"abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable"
"nopass" "pass" "protected" "value" "volatile"
+ ;; F2008.
+ ;; "concurrent" is only in the sense of "do [,] concurrent", but given
+ ;; the [,] it's simpler to just do every instance (cf "do while").
+ "contiguous" "concurrent" "codimension" "sync all" "sync memory"
) 'words)
"Keyword-regexp for font-lock level >= 3.")
@@ -365,6 +380,20 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
;; F2003 iso_c_binding intrinsic module.
"c_loc" "c_funloc" "c_associated" "c_f_pointer"
"c_f_procpointer"
+ ;; F2008.
+ "bge" "bgt" "ble" "blt" "dshiftl" "dshiftr" "leadz" "popcnt"
+ "poppar" "trailz" "maskl" "maskr" "shifta" "shiftl" "shiftr"
+ "merge_bits" "iall" "iany" "iparity" "storage_size"
+ "bessel_j0" "bessel_j1" "bessel_jn"
+ "bessel_y0" "bessel_y1" "bessel_yn"
+ "erf" "erfc" "erfc_scaled" "gamma" "hypot" "log_gamma"
+ "norm2" "parity" "findloc" "is_contiguous"
+ "sync images" "lock" "unlock" "image_index"
+ "lcobound" "ucobound" "num_images" "this_image"
+ ;; F2008 iso_fortran_env module.
+ "compiler_options" "compiler_version"
+ ;; F2008 iso_c_binding module.
+ "c_sizeof"
) t)
;; A left parenthesis to avoid highlighting non-procedures.
"[ \t]*(")
@@ -427,6 +456,11 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
"ieee_exceptions"
"ieee_arithmetic"
"ieee_features"
+ ;; F2008 iso_fortran_env constants.
+ "character_kinds" "int8" "int16" "int32" "int64"
+ "integer_kinds" "iostat_inquire_internal_unit"
+ "logical_kinds" "real_kinds" "real32" "real64" "real128"
+ "lock_type" "atomic_int_kind" "atomic_logical_kind"
) 'words)
"Regexp for Fortran intrinsic constants.")
@@ -464,13 +498,18 @@ type-name parts, respectively."
;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face))
'(f90-typedef-matcher
(1 font-lock-keyword-face) (2 font-lock-function-name-face))
- ;; F2003. Prevent operators being highlighted as functions.
- '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\
+ ;; F2003. Prevent operators being highlighted as functions.
+ '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\
read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t))
;; Other functions and declarations. Named interfaces = F2003.
- '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\
-subroutine\\|interface\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
+ ;; F2008: end submodule submodule_name.
+ '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\
+function\\|associate\\|subroutine\\|interface\\)\\|use\\|call\\)\
+\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
+ ;; F2008: submodule (parent_name) submodule_name.
+ '("\\<\\(submodule\\)\\>[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)?"
+ (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
;; F2003.
'("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\
\\(\\sw+\\)"
@@ -557,12 +596,16 @@ logical\\|double[ \t]*precision\\|\
;; enum (F2003; must be followed by ", bind(C)").
'("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face))
;; end do, enum (F2003), if, select, where, and forall constructs.
- '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\
+ ;; block, critical (F2008).
+ ;; Note that "block data" may get somewhat mixed up with F2008 blocks,
+ ;; but since the former is obsolete I'm not going to worry about it.
+ '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\
+block\\|critical\\)\\)\\>\
\\([ \t]+\\(\\sw+\\)\\)?"
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t))
'("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\
do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
-forall\\)\\)\\>"
+forall\\|block\\|critical\\)\\)\\>"
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
;; Implicit declaration.
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
@@ -629,6 +672,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
(modify-syntax-entry ?= "." table)
(modify-syntax-entry ?* "." table)
(modify-syntax-entry ?/ "." table)
+ (modify-syntax-entry ?% "." table) ; bug#8820
;; I think that the f95 standard leaves the behavior of \
;; unspecified, but that f2k will require it to be non-special.
;; Use `f90-backslash-not-special' to change.
@@ -775,12 +819,14 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
(regexp-opt '("do" "if" "interface" "function" "module" "program"
"select" "subroutine" "type" "where" "forall"
;; F2003.
- "enum" "associate"))
+ "enum" "associate"
+ ;; F2008.
+ "submodule" "block" "critical"))
"\\)\\>")
"Regexp potentially indicating a \"block\" of F90 code.")
(defconst f90-program-block-re
- (regexp-opt '("program" "module" "subroutine" "function") 'paren)
+ (regexp-opt '("program" "module" "subroutine" "function" "submodule") 'paren)
"Regexp used to locate the start/end of a \"subprogram\".")
;; "class is" is F2003.
@@ -809,8 +855,10 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
;; type word
;; type :: word
;; type, stuff :: word
+ ;; type, bind(c) :: word
;; NOT "type ("
- "\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
+ "\\<\\(type\\)\\>\\(?:\\(?:[^()\n]*\\|\
+.*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\sw+\\)"
"Regexp matching the definition of a derived type.")
(defconst f90-typeis-re
@@ -836,7 +884,8 @@ allowed. This minor issue currently only affects \"(/\" and \"/)\".")
(concat "^[ \t0-9]*\\<end[ \t]*"
(regexp-opt '("do" "if" "forall" "function" "interface"
"module" "program" "select" "subroutine"
- "type" "where" "enum" "associate") t)
+ "type" "where" "enum" "associate" "submodule"
+ "block" "critical") t)
"\\>")
"Regexp matching the end of an F90 \"block\", from the line start.
Used in the F90 entry in `hs-special-modes-alist'.")
@@ -862,10 +911,10 @@ Used in the F90 entry in `hs-special-modes-alist'.")
"[^i(!\n\"\& \t]\\|" ; not-i(
"i[^s!\n\"\& \t]\\|" ; i not-s
"is\\sw\\)\\|"
- ;; "abstract interface" is F2003.
- "program\\|\\(?:abstract[ \t]*\\)?interface\\|module\\|"
+ ;; "abstract interface" is F2003; "submodule" is F2008.
+ "program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|"
;; "enum", but not "enumerator".
- "function\\|subroutine\\|enum[^e]\\|associate"
+ "function\\|subroutine\\|enum[^e]\\|associate\\|block\\|critical"
"\\)"
"[ \t]*")
"Regexp matching the start of an F90 \"block\", from the line start.
@@ -903,6 +952,8 @@ Set subexpression 1 in the match-data to the name of the type."
)
(list
'(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
+ '("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\
+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
'("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
(list "Types" 'f90-imenu-type-matcher 1)
;; Does not handle: "type[, stuff] :: foo".
@@ -950,11 +1001,13 @@ Set subexpression 1 in the match-data to the name of the type."
("`asy" . "asynchronous" )
("`ba" . "backspace" )
("`bd" . "block data" )
+ ("`bl" . "block" )
("`c" . "character" )
("`cl" . "close" )
("`cm" . "common" )
("`cx" . "complex" )
("`cn" . "contains" )
+ ("`cr" . "critical" )
("`cy" . "cycle" )
("`de" . "deallocate" )
("`df" . "define" )
@@ -1034,6 +1087,10 @@ Variables controlling indentation style and extra features:
`f90-program-indent'
Extra indentation within program/module/subroutine/function blocks
(default 2).
+`f90-associate-indent'
+ Extra indentation within associate blocks (default 2).
+`f90-critical-indent'
+ Extra indentation within critical/block blocks (default 2).
`f90-continuation-indent'
Extra indentation applied to continuation lines (default 5).
`f90-comment-region'
@@ -1204,6 +1261,25 @@ NAME is nil if the statement has no label."
(if (looking-at "\\<\\(associate\\)[ \t]*(")
(list (match-string 1))))
+(defsubst f90-looking-at-critical ()
+ "Return (KIND NAME) if a critical or block block starts after point."
+ (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\>")
+ (let ((struct (match-string 3))
+ (label (match-string 2)))
+ (if (or (not (string-equal "block" struct))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (not (looking-at "data\\>"))))
+ (list struct label)))))
+
+(defsubst f90-looking-at-end-critical ()
+ "Return non-nil if a critical or block block ends after point."
+ (if (looking-at "end[ \t]*\\(critical\\|block\\)\\>")
+ (or (not (string-equal "block" (match-string 1)))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (not (looking-at "data\\>"))))))
+
(defsubst f90-looking-at-where-or-forall ()
"Return (KIND NAME) if a where or forall block starts after point.
NAME is nil if the statement has no label."
@@ -1254,6 +1330,8 @@ write\\)[ \t]*([^)\n]*)")
((and (not (looking-at "module[ \t]*procedure\\>"))
(looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
(list (match-string 1) (match-string 2)))
+ ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)\\>")
+ (list (match-string 1) (match-string 2)))
((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
(looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
\\(\\sw+\\)"))
@@ -1328,8 +1406,9 @@ if all else fails."
(save-excursion
(not (or (looking-at "end")
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
-\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>")
- (looking-at "\\(program\\|module\\|\
+\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\
+block\\|critical\\)\\>")
+ (looking-at "\\(program\\|\\(?:sub\\)?module\\|\
\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>")
(looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
(looking-at f90-type-def-re)
@@ -1372,6 +1451,8 @@ Does not check type and subprogram indentation."
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case))
(setq icol (+ icol f90-if-indent)))
+ ;; FIXME this makes no sense, because this section/function is
+ ;; only for if/do/select/where/forall ?
((f90-looking-at-associate)
(setq icol (+ icol f90-associate-indent))))
(end-of-line))
@@ -1385,12 +1466,16 @@ Does not check type and subprogram indentation."
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case))
(setq icol (+ icol f90-if-indent)))
+ ;; FIXME this makes no sense, because this section/function is
+ ;; only for if/do/select/where/forall ?
((f90-looking-at-associate)
(setq icol (+ icol f90-associate-indent)))
((looking-at f90-end-if-re)
(setq icol (- icol f90-if-indent)))
((looking-at f90-end-associate-re)
(setq icol (- icol f90-associate-indent)))
+ ((f90-looking-at-end-critical)
+ (setq icol (- icol f90-critical-indent)))
((looking-at "end[ \t]*do\\>")
(setq icol (- icol f90-do-indent))))
(end-of-line))
@@ -1438,6 +1523,8 @@ Does not check type and subprogram indentation."
(setq icol (+ icol f90-type-indent)))
((f90-looking-at-associate)
(setq icol (+ icol f90-associate-indent)))
+ ((f90-looking-at-critical)
+ (setq icol (+ icol f90-critical-indent)))
((or (f90-looking-at-program-block-start)
(looking-at "contains[ \t]*\\($\\|!\\)"))
(setq icol (+ icol f90-program-indent)))))
@@ -1457,6 +1544,8 @@ Does not check type and subprogram indentation."
(setq icol (- icol f90-type-indent)))
((looking-at f90-end-associate-re)
(setq icol (- icol f90-associate-indent)))
+ ((f90-looking-at-end-critical)
+ (setq icol (- icol f90-critical-indent)))
((or (looking-at "contains[ \t]*\\(!\\|$\\)")
(f90-looking-at-program-block-end))
(setq icol (- icol f90-program-indent))))))))))
@@ -1563,6 +1652,7 @@ Interactively, pushes mark before moving point."
(f90-looking-at-select-case)
(f90-looking-at-type-like)
(f90-looking-at-associate)
+ (f90-looking-at-critical)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
@@ -1624,6 +1714,7 @@ Interactively, pushes mark before moving point."
(f90-looking-at-select-case)
(f90-looking-at-type-like)
(f90-looking-at-associate)
+ (f90-looking-at-critical)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
@@ -1665,6 +1756,7 @@ A block is a subroutine, if-endif, etc."
(f90-looking-at-select-case)
(f90-looking-at-type-like)
(f90-looking-at-associate)
+ (f90-looking-at-critical)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall))
@@ -1801,6 +1893,8 @@ If run in the middle of a line, the line is not broken."
f90-type-indent)
((setq struct (f90-looking-at-associate))
f90-associate-indent)
+ ((setq struct (f90-looking-at-critical))
+ f90-critical-indent)
((or (setq struct (f90-looking-at-program-block-start))
(looking-at "contains[ \t]*\\($\\|!\\)"))
f90-program-indent)))
@@ -1836,6 +1930,8 @@ If run in the middle of a line, the line is not broken."
f90-type-indent)
((setq struct (f90-looking-at-associate))
f90-associate-indent)
+ ((setq struct (f90-looking-at-critical))
+ f90-critical-indent)
((setq struct (f90-looking-at-program-block-start))
f90-program-indent)))
(setq ind-curr ind-lev)
@@ -1854,6 +1950,7 @@ If run in the middle of a line, the line is not broken."
((looking-at f90-end-type-re) f90-type-indent)
((looking-at f90-end-associate-re)
f90-associate-indent)
+ ((f90-looking-at-end-critical) f90-critical-indent)
((f90-looking-at-program-block-end)
f90-program-indent)))
(if ind-b (setq ind-lev (- ind-lev ind-b)))
@@ -2059,6 +2156,7 @@ Leave point at the end of line."
(f90-looking-at-select-case)
(f90-looking-at-type-like)
(f90-looking-at-associate)
+ (f90-looking-at-critical)
(f90-looking-at-program-block-start)
;; Interpret a single END without a block
;; start to be the END of a program block
@@ -2197,17 +2295,6 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word."
(save-excursion
(nth 1 (f90-beginning-of-subprogram))))
-(defun f90-find-tag-default ()
- "Function to use for `find-tag-default-function' property in F90 mode."
- (let ((tag (find-tag-default)))
- (or (and tag
- ;; See bug#7919. TODO I imagine there are other cases...?
- (string-match "%\\([^%]+\\)\\'" tag)
- (match-string-no-properties 1 tag))
- tag)))
-
-(put 'f90-mode 'find-tag-default-function 'f90-find-tag-default)
-
(defun f90-backslash-not-special (&optional all)
"Make the backslash character (\\) be non-special in the current buffer.
With optional argument ALL, change the default for all present
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 6200591fbbb..1c138f053d3 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -924,8 +924,8 @@ Convert it to flymake internal format."
;; PHP
("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1)
;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1)
- ;; ant/javac
- (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)"
+ ;; ant/javac. Note this also matches gcc warnings!
+ (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\\(?:\:[0-9]+\\)?\:[ \t\n]*\\(.+\\)"
2 4 nil 5))
;; compilation-error-regexp-alist)
(flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
@@ -1118,7 +1118,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(flymake-log 1 "Failed to delete dir %s, error ignored" dir-name))))
(defcustom flymake-compilation-prevents-syntax-check t
- "If non-nil, syntax check won't be started in case compilation is running."
+ "If non-nil, don't start syntax check if compilation is running."
:group 'flymake
:type 'boolean)
@@ -1339,8 +1339,12 @@ With arg, turn Flymake mode on if and only if arg is positive."
;; Turning the mode ON.
(flymake-mode
- (if (not (flymake-can-syntax-check-file buffer-file-name))
- (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))
+ (cond
+ ((not buffer-file-name)
+ (message "Flymake unable to run without a buffer file name"))
+ ((not (flymake-can-syntax-check-file buffer-file-name))
+ (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)))
+ (t
(add-hook 'after-change-functions 'flymake-after-change-function nil t)
(add-hook 'after-save-hook 'flymake-after-save-hook nil t)
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
@@ -1352,7 +1356,7 @@ With arg, turn Flymake mode on if and only if arg is positive."
(run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
(when flymake-start-syntax-check-on-find-file
- (flymake-start-syntax-check))))
+ (flymake-start-syntax-check)))))
;; Turning the mode OFF.
(t
@@ -1406,6 +1410,7 @@ With arg, turn Flymake mode on if and only if arg is positive."
(cancel-timer flymake-timer)
(setq flymake-timer nil)))
+;;;###autoload
(defun flymake-find-file-hook ()
;;+(when flymake-start-syntax-check-on-find-file
;;+ (flymake-log 3 "starting syntax check on file open")
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index f03d2013467..d30b9673d09 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -600,6 +600,7 @@ Used in the Fortran entry in `hs-special-modes-alist'.")
(modify-syntax-entry ?= "." table)
(modify-syntax-entry ?* "." table)
(modify-syntax-entry ?/ "." table)
+ (modify-syntax-entry ?% "." table) ; bug#8820
(modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?\" "\"" table)
;; Consistent with GNU Fortran's default -- see the manual.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index c2ee1a93389..87209a78ffb 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -104,7 +104,8 @@
(require 'bindat)
(eval-when-compile (require 'cl))
-(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default))
+(declare-function speedbar-change-initial-expansion-list
+ "speedbar" (new-default))
(declare-function speedbar-timer-fn "speedbar" ())
(declare-function speedbar-line-text "speedbar" (&optional p))
(declare-function speedbar-change-expand-button-char "speedbar" (char))
@@ -190,7 +191,8 @@ as returned from \"-break-list\" by `gdb-json-partial-output'
(defvar gdb-current-language nil)
(defvar gdb-var-list nil
"List of variables in watch window.
-Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP)
+Each element has the form
+ (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP)
where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame
address for root variables.")
(defvar gdb-main-file nil "Source file from which program execution begins.")
@@ -329,7 +331,7 @@ valid signal handlers.")
"Maximum size of `gdb-debug-log'. If nil, size is unlimited."
:group 'gdb
:type '(choice (integer :tag "Number of elements")
- (const :tag "Unlimited" nil))
+ (const :tag "Unlimited" nil))
:version "22.1")
(defcustom gdb-non-stop-setting t
@@ -367,13 +369,18 @@ Emacs always switches to the thread which caused the stop."
(set :tag "Selection of reasons..."
(const :tag "A breakpoint was reached." "breakpoint-hit")
(const :tag "A watchpoint was triggered." "watchpoint-trigger")
- (const :tag "A read watchpoint was triggered." "read-watchpoint-trigger")
- (const :tag "An access watchpoint was triggered." "access-watchpoint-trigger")
+ (const :tag "A read watchpoint was triggered."
+ "read-watchpoint-trigger")
+ (const :tag "An access watchpoint was triggered."
+ "access-watchpoint-trigger")
(const :tag "Function finished execution." "function-finished")
(const :tag "Location reached." "location-reached")
- (const :tag "Watchpoint has gone out of scope" "watchpoint-scope")
- (const :tag "End of stepping range reached." "end-stepping-range")
- (const :tag "Signal received (like interruption)." "signal-received"))
+ (const :tag "Watchpoint has gone out of scope"
+ "watchpoint-scope")
+ (const :tag "End of stepping range reached."
+ "end-stepping-range")
+ (const :tag "Signal received (like interruption)."
+ "signal-received"))
(const :tag "None" nil))
:group 'gdb-non-stop
:version "23.2"
@@ -488,17 +495,17 @@ predefined macros."
:group 'gdb
:version "22.1")
- (defcustom gdb-create-source-file-list t
- "Non-nil means create a list of files from which the executable was built.
+(defcustom gdb-create-source-file-list t
+ "Non-nil means create a list of files from which the executable was built.
Set this to nil if the GUD buffer displays \"initializing...\" in the mode
line for a long time when starting, possibly because your executable was
built from a large number of files. This allows quicker initialization
but means that these files are not automatically enabled for debugging,
e.g., you won't be able to click in the fringe to set a breakpoint until
execution has already stopped there."
- :type 'boolean
- :group 'gdb
- :version "23.1")
+ :type 'boolean
+ :group 'gdb
+ :version "23.1")
(defcustom gdb-show-main nil
"Non-nil means display source file containing the main routine at startup.
@@ -644,12 +651,12 @@ detailed description of this mode.
(interactive (list (gud-query-cmdline 'gdb)))
(when (and gud-comint-buffer
- (buffer-name gud-comint-buffer)
- (get-buffer-process gud-comint-buffer)
- (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
- (gdb-restore-windows)
- (error
- "Multiple debugging requires restarting in text command mode"))
+ (buffer-name gud-comint-buffer)
+ (get-buffer-process gud-comint-buffer)
+ (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
+ (gdb-restore-windows)
+ (error
+ "Multiple debugging requires restarting in text command mode"))
;;
(gud-common-init command-line nil 'gud-gdbmi-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
@@ -663,7 +670,7 @@ detailed description of this mode.
(hsize (getenv "HISTSIZE")))
(dolist (file (append '("~/.gdbinit")
(unless (string-equal (expand-file-name ".")
- (expand-file-name "~"))
+ (expand-file-name "~"))
'(".gdbinit"))))
(if (file-readable-p (setq file (expand-file-name file)))
(with-temp-buffer
@@ -763,7 +770,7 @@ detailed description of this mode.
'gdb-mouse-set-clear-breakpoint)
(define-key gud-minor-mode-map [left-fringe mouse-1]
'gdb-mouse-set-clear-breakpoint)
- (define-key gud-minor-mode-map [left-margin C-mouse-1]
+ (define-key gud-minor-mode-map [left-margin C-mouse-1]
'gdb-mouse-toggle-breakpoint-margin)
(define-key gud-minor-mode-map [left-fringe C-mouse-1]
'gdb-mouse-toggle-breakpoint-fringe)
@@ -786,7 +793,10 @@ detailed description of this mode.
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
- (local-set-key "\C-i" 'gud-gdb-complete-command)
+ (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
+ nil 'local)
+ (local-set-key "\C-i" 'completion-at-point)
+
(setq gdb-first-prompt t)
(setq gud-running nil)
@@ -846,11 +856,11 @@ detailed description of this mode.
;; find source file and compilation directory here
(gdb-input
- ; Needs GDB 6.2 onwards.
+ ; Needs GDB 6.2 onwards.
(list "-file-list-exec-source-files" 'gdb-get-source-file-list))
(if gdb-create-source-file-list
(gdb-input
- ; Needs GDB 6.0 onwards.
+ ; Needs GDB 6.0 onwards.
(list "-file-list-exec-source-file" 'gdb-get-source-file)))
(gdb-input
(list "-gdb-show prompt" 'gdb-get-prompt)))
@@ -859,7 +869,8 @@ detailed description of this mode.
(goto-char (point-min))
(if (re-search-forward "No symbol" nil t)
(progn
- (message "This version of GDB doesn't support non-stop mode. Turning it off.")
+ (message
+ "This version of GDB doesn't support non-stop mode. Turning it off.")
(setq gdb-non-stop nil)
(setq gdb-version "pre-7.0"))
(setq gdb-version "7.0+")
@@ -882,8 +893,8 @@ detailed description of this mode.
(list t nil) nil "-c"
(concat gdb-cpp-define-alist-program " "
gdb-cpp-define-alist-flags))))))
- (define-list (split-string output "\n" t))
- (name))
+ (define-list (split-string output "\n" t))
+ (name))
(setq gdb-define-alist nil)
(dolist (define define-list)
(setq name (nth 1 (split-string define "[( ]")))
@@ -893,13 +904,13 @@ detailed description of this mode.
(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)))))))
+ (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)))))))
;; 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
@@ -923,13 +934,13 @@ detailed description of this mode.
(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))))))
+ (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))))))
(defun gdb-mouse-until (event)
"Continue running until a source line past the current line.
@@ -1060,7 +1071,7 @@ With arg, enter name of variable to be watched in the minibuffer."
(bindat-get-field result 'value)
nil
(bindat-get-field result 'has_more)
- gdb-frame-address)))
+ gdb-frame-address)))
(push var gdb-var-list)
(speedbar 1)
(unless (string-equal
@@ -1091,20 +1102,20 @@ With arg, enter name of variable to be watched in the minibuffer."
(setcar (nthcdr 4 var) (read (match-string 1)))))
(gdb-speedbar-update))
-; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
+ ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
(defun gdb-var-list-children (varnum)
(gdb-input
(list (concat "-var-update " varnum) 'ignore))
(gdb-input
(list (concat "-var-list-children --all-values "
- varnum)
- `(lambda () (gdb-var-list-children-handler ,varnum)))))
+ varnum)
+ `(lambda () (gdb-var-list-children-handler ,varnum)))))
(defun gdb-var-list-children-handler (varnum)
(let* ((var-list nil)
(output (bindat-get-field (gdb-json-partial-output "child")))
(children (bindat-get-field output 'children)))
- (catch 'child-already-watched
+ (catch 'child-already-watched
(dolist (var gdb-var-list)
(if (string-equal varnum (car var))
(progn
@@ -1147,11 +1158,11 @@ With arg, enter name of variable to be watched in the minibuffer."
(interactive)
(let ((text (speedbar-line-text)))
(string-match "\\(\\S-+\\)" text)
- (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
- (varnum (car var)))
- (if (string-match "\\." (car var))
- (message-box "Can only delete a root expression")
- (gdb-var-delete-1 var varnum)))))
+ (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
+ (varnum (car var)))
+ (if (string-match "\\." (car var))
+ (message-box "Can only delete a root expression")
+ (gdb-var-delete-1 var varnum)))))
(defun gdb-var-delete-children (varnum)
"Delete children of variable object at point from the speedbar."
@@ -1174,7 +1185,7 @@ With arg, enter name of variable to be watched in the minibuffer."
(if (re-search-forward gdb-error-regexp nil t)
(message-box "Invalid number or expression (%s)" value)))
-; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
+ ; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update ()
(if (not (gdb-pending-p 'gdb-var-update))
(gdb-input
@@ -1210,38 +1221,38 @@ With arg, enter name of variable to be watched in the minibuffer."
(gdb-var-delete-1 var varnum)))))
(let ((var-list nil) var1
(children (bindat-get-field change 'new_children)))
- (if new-num
- (progn
- (setq var1 (pop temp-var-list))
- (while var1
- (if (string-equal varnum (car var1))
- (let ((new (string-to-number new-num))
- (previous (string-to-number (nth 2 var1))))
- (setcar (nthcdr 2 var1) new-num)
- (push var1 var-list)
- (cond ((> new previous)
- ;; Add new children to list.
- (dotimes (dummy previous)
- (push (pop temp-var-list) var-list))
- (dolist (child children)
- (let ((varchild
- (list (bindat-get-field child 'name)
- (bindat-get-field child 'exp)
- (bindat-get-field child 'numchild)
- (bindat-get-field child 'type)
- (bindat-get-field child 'value)
- 'changed
- (bindat-get-field child 'has_more))))
- (push varchild var-list))))
- ;; Remove deleted children from list.
- ((< new previous)
- (dotimes (dummy new)
- (push (pop temp-var-list) var-list))
- (dotimes (dummy (- previous new))
- (pop temp-var-list)))))
- (push var1 var-list))
- (setq var1 (pop temp-var-list)))
- (setq gdb-var-list (nreverse var-list)))))))))
+ (when new-num
+ (setq var1 (pop temp-var-list))
+ (while var1
+ (if (string-equal varnum (car var1))
+ (let ((new (string-to-number new-num))
+ (previous (string-to-number (nth 2 var1))))
+ (setcar (nthcdr 2 var1) new-num)
+ (push var1 var-list)
+ (cond
+ ((> new previous)
+ ;; Add new children to list.
+ (dotimes (dummy previous)
+ (push (pop temp-var-list) var-list))
+ (dolist (child children)
+ (let ((varchild
+ (list (bindat-get-field child 'name)
+ (bindat-get-field child 'exp)
+ (bindat-get-field child 'numchild)
+ (bindat-get-field child 'type)
+ (bindat-get-field child 'value)
+ 'changed
+ (bindat-get-field child 'has_more))))
+ (push varchild var-list))))
+ ;; Remove deleted children from list.
+ ((< new previous)
+ (dotimes (dummy new)
+ (push (pop temp-var-list) var-list))
+ (dotimes (dummy (- previous new))
+ (pop temp-var-list)))))
+ (push var1 var-list))
+ (setq var1 (pop temp-var-list)))
+ (setq gdb-var-list (nreverse var-list))))))))
(setq gdb-pending-triggers
(delq 'gdb-var-update gdb-pending-triggers))
(gdb-speedbar-update))
@@ -1369,7 +1380,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
(when trigger
(gdb-add-subscriber gdb-buf-publisher
(cons (current-buffer)
- (gdb-bind-function-to-buffer trigger (current-buffer))))
+ (gdb-bind-function-to-buffer
+ trigger (current-buffer))))
(funcall trigger 'start))
(current-buffer))))))
@@ -1783,8 +1795,8 @@ is running."
;; visited breakpoint is, use that window.
(defun gdb-display-source-buffer (buffer)
(let* ((last-window (if gud-last-last-frame
- (get-buffer-window
- (gud-find-file (car gud-last-last-frame)))))
+ (get-buffer-window
+ (gud-find-file (car gud-last-last-frame)))))
(source-window (or last-window
(if (and gdb-source-window
(window-live-p gdb-source-window))
@@ -1857,7 +1869,7 @@ is running."
;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI
;; error message on internal stream. Don't print to GUD buffer.
(unless (and (eq record-type 'gdb-internals)
- (string-equal (read arg1) "No registers.\n"))
+ (string-equal (read arg1) "No registers.\n"))
(funcall record-type arg1))))))
(setq gdb-output-sink 'user)
@@ -1881,15 +1893,15 @@ is running."
(defun gdb-thread-exited (output-field)
"Handle =thread-exited async record: unset `gdb-thread-number'
if current thread exited and update threads list."
- (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
- (if (string= gdb-thread-number thread-id)
- (gdb-setq-thread-number nil))
- ;; When we continue current thread and it quickly exits,
- ;; gdb-pending-triggers left after gdb-running disallow us to
- ;; properly call -thread-info without --thread option. Thus we
- ;; need to use gdb-wait-for-pending.
- (gdb-wait-for-pending
- (gdb-emit-signal gdb-buf-publisher 'update-threads))))
+ (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
+ (if (string= gdb-thread-number thread-id)
+ (gdb-setq-thread-number nil))
+ ;; When we continue current thread and it quickly exits,
+ ;; gdb-pending-triggers left after gdb-running disallow us to
+ ;; properly call -thread-info without --thread option. Thus we
+ ;; need to use gdb-wait-for-pending.
+ (gdb-wait-for-pending
+ (gdb-emit-signal gdb-buf-publisher 'update-threads))))
(defun gdb-thread-selected (output-field)
"Handler for =thread-selected MI output record.
@@ -1909,7 +1921,8 @@ Sets `gdb-thread-number' to new id."
(gdb-update))))
(defun gdb-running (output-field)
- (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'thread-id)))
+ (let* ((thread-id
+ (bindat-get-field (gdb-json-string output-field) 'thread-id)))
;; We reset gdb-frame-number to nil if current thread has gone
;; running. This can't be done in gdb-thread-list-handler-custom
;; because we need correct gdb-frame-number by the time
@@ -1984,23 +1997,23 @@ current thread and update GDB buffers."
;; reasons
(if (or (eq gdb-switch-reasons t)
(member reason gdb-switch-reasons))
- (when (not (string-equal gdb-thread-number thread-id))
- (message (concat "Switched to thread " thread-id))
- (gdb-setq-thread-number thread-id))
+ (when (not (string-equal gdb-thread-number thread-id))
+ (message (concat "Switched to thread " thread-id))
+ (gdb-setq-thread-number thread-id))
(message (format "Thread %s stopped" thread-id)))))
- ;; Print "(gdb)" to GUD console
- (when gdb-first-done-or-error
- (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
+ ;; Print "(gdb)" to GUD console
+ (when gdb-first-done-or-error
+ (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
- ;; In non-stop, we update information as soon as another thread gets
- ;; stopped
- (when (or gdb-first-done-or-error
- gdb-non-stop)
- ;; 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)))
+ ;; In non-stop, we update information as soon as another thread gets
+ ;; stopped
+ (when (or gdb-first-done-or-error
+ gdb-non-stop)
+ ;; 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)))
;; Remove the trimmings from log stream containing debugging messages
;; being produced by GDB's internals, use warning face and send to GUD
@@ -2020,7 +2033,7 @@ current thread and update GDB buffers."
;; Remove the trimmings from the console stream and send to GUD buffer
;; (frontend MI commands should not print to this stream)
(defun gdb-console (output-field)
- (setq gdb-filter-output
+ (setq gdb-filter-output
(gdb-concat-output
gdb-filter-output
(read output-field))))
@@ -2033,11 +2046,11 @@ current thread and update GDB buffers."
(setq token-number nil)
;; MI error - send to minibuffer
(when (eq type 'error)
- ;; Skip "msg=" from `output-field'
- (message (read (substring output-field 4)))
- ;; Don't send to the console twice. (If it is a console error
- ;; it is also in the console stream.)
- (setq output-field nil)))
+ ;; Skip "msg=" from `output-field'
+ (message (read (substring output-field 4)))
+ ;; Don't send to the console twice. (If it is a console error
+ ;; it is also in the console stream.)
+ (setq output-field nil)))
;; Output from command from frontend.
(setq gdb-output-sink 'emacs))
@@ -2215,11 +2228,11 @@ calling `gdb-table-string'."
(append row-properties (list properties)))
(setf (gdb-table-column-sizes table)
(gdb-mapcar* (lambda (x s)
- (let ((new-x
- (max (abs x) (string-width (or s "")))))
- (if right-align new-x (- new-x))))
- (gdb-table-column-sizes table)
- row))
+ (let ((new-x
+ (max (abs x) (string-width (or s "")))))
+ (if right-align new-x (- new-x))))
+ (gdb-table-column-sizes table)
+ row))
;; Avoid trailing whitespace at eol
(if (not (gdb-table-right-align table))
(setcar (last (gdb-table-column-sizes table)) 0))))
@@ -2308,8 +2321,8 @@ If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
'(set-window-point window p)))))
(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
- handler-name custom-defun
- &optional signal-list)
+ handler-name custom-defun
+ &optional signal-list)
"Define trigger and handler.
TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
@@ -2353,29 +2366,29 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
(pending (bindat-get-field breakpoint 'pending))
(func (bindat-get-field breakpoint 'func))
(type (bindat-get-field breakpoint 'type)))
- (gdb-table-add-row table
- (list
- (bindat-get-field breakpoint 'number)
- type
- (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)
- (bindat-get-field breakpoint 'what)
- (or pending at
- (concat "in "
- (propertize (or func "unknown")
- 'font-lock-face font-lock-function-name-face)
- (gdb-frame-location breakpoint)))))
- ;; Add clickable properties only for breakpoints with file:line
- ;; information
- (append (list 'gdb-breakpoint breakpoint)
- (when func '(help-echo "mouse-2, RET: visit breakpoint"
- mouse-face highlight))))))
+ (gdb-table-add-row table
+ (list
+ (bindat-get-field breakpoint 'number)
+ type
+ (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)
+ (bindat-get-field breakpoint 'what)
+ (or pending at
+ (concat "in "
+ (propertize (or func "unknown")
+ 'font-lock-face font-lock-function-name-face)
+ (gdb-frame-location breakpoint)))))
+ ;; Add clickable properties only for breakpoints with file:line
+ ;; information
+ (append (list 'gdb-breakpoint breakpoint)
+ (when func '(help-echo "mouse-2, RET: visit breakpoint"
+ mouse-face highlight))))))
(insert (gdb-table-string table " "))
(gdb-place-breakpoints)))
@@ -2389,7 +2402,7 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
(gdb-remove-breakpoint-icons (point-min) (point-max)))))
(dolist (breakpoint gdb-breakpoints-list)
(let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is
- ; an associative list
+ ; an associative list
(line (bindat-get-field breakpoint 'line)))
(when line
(let ((file (bindat-get-field breakpoint 'fullname))
@@ -2411,7 +2424,7 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
(gdb-input
(list "-file-list-exec-source-file"
`(lambda () (gdb-get-location
- ,bptno ,line ,flag))))))))))
+ ,bptno ,line ,flag))))))))))
(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
@@ -2422,7 +2435,7 @@ Put in buffer and place breakpoint icon."
(catch 'file-not-found
(if (re-search-forward gdb-source-file-regexp nil t)
(delete (cons bptno "File not found") gdb-location-alist)
- (push (cons bptno (match-string 1)) gdb-location-alist)
+ (push (cons bptno (match-string 1)) gdb-location-alist)
(gdb-resync)
(unless (assoc bptno gdb-location-alist)
(push (cons bptno "File not found") gdb-location-alist)
@@ -2510,20 +2523,20 @@ If not in a source or disassembly buffer just set point."
(if (get-text-property 0 'gdb-enabled obj)
"-break-disable "
"-break-enable ")
- (get-text-property 0 'gdb-bptno obj)))))))))
+ (get-text-property 0 'gdb-bptno obj)))))))))
(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.")
+ gdb-display-breakpoints-buffer
+ 'gdb-breakpoints-buffer
+ "Display status of user-settable breakpoints.")
(def-gdb-frame-for-buffer
- gdb-frame-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints in a new frame.")
+ gdb-frame-breakpoints-buffer
+ 'gdb-breakpoints-buffer
+ "Display status of user-settable breakpoints in a new frame.")
(defvar gdb-breakpoints-mode-map
(let ((map (make-sparse-keymap))
@@ -2539,10 +2552,10 @@ If not in a source or disassembly buffer just set point."
;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons.
(define-key map "q" 'gdb-delete-frame-or-window)
(define-key map "\r" 'gdb-goto-breakpoint)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-threads-buffer) t)))
+ (define-key map "\t" (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-threads-buffer) t)))
(define-key map [mouse-2] 'gdb-goto-breakpoint)
(define-key map [follow-link] 'mouse-face)
map))
@@ -2585,14 +2598,14 @@ corresponding to the mode line clicked."
(concat "*threads of " (gdb-get-target-string) "*"))
(def-gdb-display-buffer
- gdb-display-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads.")
+ gdb-display-threads-buffer
+ 'gdb-threads-buffer
+ "Display GDB threads.")
(def-gdb-frame-for-buffer
- gdb-frame-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads in a new frame.")
+ gdb-frame-threads-buffer
+ 'gdb-threads-buffer
+ "Display GDB threads in a new frame.")
(def-gdb-trigger-and-handler
gdb-invalidate-threads (gdb-current-context-command "-thread-info")
@@ -2626,18 +2639,20 @@ corresponding to the mode line clicked."
(define-key map "i" 'gdb-interrupt-thread)
(define-key map "c" 'gdb-continue-thread)
(define-key map "s" 'gdb-step-thread)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)))
+ (define-key map "\t"
+ (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)))
(define-key map [mouse-2] 'gdb-select-thread)
(define-key map [follow-link] 'mouse-face)
map))
(defvar gdb-threads-header
(list
- (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)
+ (gdb-propertize-header
+ "Breakpoints" gdb-breakpoints-buffer
+ "mouse-1: select" mode-line-highlight mode-line-inactive)
" "
(gdb-propertize-header "Threads" gdb-threads-buffer
nil nil mode-line)))
@@ -2661,44 +2676,45 @@ corresponding to the mode line clicked."
(set-marker gdb-thread-position nil)
(dolist (thread (reverse threads-list))
- (let ((running (string-equal (bindat-get-field thread 'state) "running")))
- (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))
-
- (gdb-table-add-row table
- (list
- (bindat-get-field thread 'id)
- (concat
- (if gdb-thread-buffer-verbose-names
- (concat (bindat-get-field thread 'target-id) " ") "")
- (bindat-get-field thread 'state)
- ;; Include frame information for stopped threads
- (if (not running)
- (concat
- " in " (bindat-get-field thread 'frame 'func)
- (if gdb-thread-buffer-arguments
- (concat
- " ("
- (let ((args (bindat-get-field thread 'frame 'args)))
- (mapconcat
- (lambda (arg)
- (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value))))
- args ","))
- ")")
- "")
- (if gdb-thread-buffer-locations
- (gdb-frame-location (bindat-get-field thread 'frame)) "")
- (if gdb-thread-buffer-addresses
- (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
- "")))
- (list
- 'gdb-thread thread
- 'mouse-face 'highlight
- 'help-echo "mouse-2, RET: select thread")))
+ (let ((running (equal (bindat-get-field thread 'state) "running")))
+ (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))
+
+ (gdb-table-add-row table
+ (list
+ (bindat-get-field thread 'id)
+ (concat
+ (if gdb-thread-buffer-verbose-names
+ (concat (bindat-get-field thread 'target-id) " ") "")
+ (bindat-get-field thread 'state)
+ ;; Include frame information for stopped threads
+ (if (not running)
+ (concat
+ " in " (bindat-get-field thread 'frame 'func)
+ (if gdb-thread-buffer-arguments
+ (concat
+ " ("
+ (let ((args (bindat-get-field thread 'frame 'args)))
+ (mapconcat
+ (lambda (arg)
+ (apply #'format "%s=%s"
+ (gdb-get-many-fields arg 'name 'value)))
+ args ","))
+ ")")
+ "")
+ (if gdb-thread-buffer-locations
+ (gdb-frame-location (bindat-get-field thread 'frame)) "")
+ (if gdb-thread-buffer-addresses
+ (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
+ "")))
+ (list
+ 'gdb-thread thread
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2, RET: select thread")))
(when (string-equal gdb-thread-number
(bindat-get-field thread 'id))
(setq marked-line (length gdb-threads-list))))
@@ -2727,7 +2743,8 @@ be the value of 'gdb-thread property of the current line. If
,custom-defun
(error "Not recognized as thread line"))))))
-(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc)
+(defmacro def-gdb-thread-buffer-simple-command (name buffer-command
+ &optional doc)
"Define a NAME which will call BUFFER-COMMAND with id of thread
on the current line."
`(def-gdb-thread-buffer-command ,name
@@ -2830,19 +2847,19 @@ line."
(defcustom gdb-memory-format "x"
"Display format of data items in memory window."
:type '(choice (const :tag "Hexadecimal" "x")
- (const :tag "Signed decimal" "d")
- (const :tag "Unsigned decimal" "u")
- (const :tag "Octal" "o")
- (const :tag "Binary" "t"))
+ (const :tag "Signed decimal" "d")
+ (const :tag "Unsigned decimal" "u")
+ (const :tag "Octal" "o")
+ (const :tag "Binary" "t"))
:group 'gud
:version "22.1")
(defcustom gdb-memory-unit 4
"Unit size of data items in memory window."
:type '(choice (const :tag "Byte" 1)
- (const :tag "Halfword" 2)
- (const :tag "Word" 4)
- (const :tag "Giant word" 8))
+ (const :tag "Halfword" 2)
+ (const :tag "Word" 4)
+ (const :tag "Giant word" 8))
:group 'gud
:version "23.2")
@@ -2893,14 +2910,14 @@ in `gdb-memory-format'."
(setq gdb-memory-next-page (bindat-get-field res 'next-page))
(setq gdb-memory-prev-page (bindat-get-field res 'prev-page))
(setq gdb-memory-last-address gdb-memory-address)
- (dolist (row memory)
- (insert (concat (bindat-get-field row 'addr) ":"))
- (dolist (column (bindat-get-field row 'data))
- (insert (gdb-pad-string column
- (+ 2 (gdb-memory-column-width
- gdb-memory-unit
- gdb-memory-format)))))
- (newline)))
+ (dolist (row memory)
+ (insert (concat (bindat-get-field row 'addr) ":"))
+ (dolist (column (bindat-get-field row 'data))
+ (insert (gdb-pad-string column
+ (+ 2 (gdb-memory-column-width
+ gdb-memory-unit
+ gdb-memory-format)))))
+ (newline)))
;; Show last page instead of empty buffer when out of bounds
(progn
(let ((gdb-memory-address gdb-memory-last-address))
@@ -2925,7 +2942,7 @@ in `gdb-memory-format'."
(define-key map "g" 'gdb-memory-unit-giant)
(define-key map "R" 'gdb-memory-set-rows)
(define-key map "C" 'gdb-memory-set-columns)
- map))
+ map))
(defun gdb-memory-set-address-event (event)
"Handle a click on address field in memory buffer header."
@@ -3115,8 +3132,8 @@ DOC is an optional documentation string."
(defvar gdb-memory-font-lock-keywords
'(;; <__function.name+n>
- ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
- )
+ ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
+ (1 font-lock-function-name-face)))
"Font lock keywords used in `gdb-memory-mode'.")
(defvar gdb-memory-header
@@ -3124,52 +3141,52 @@ DOC is an optional documentation string."
(concat
"Start address["
(propertize "-"
- 'face font-lock-warning-face
- 'help-echo "mouse-1: decrement address"
- 'mouse-face 'mode-line-highlight
- 'local-map (gdb-make-header-line-mouse-map
- 'mouse-1
- #'gdb-memory-show-previous-page))
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: decrement address"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1
+ #'gdb-memory-show-previous-page))
"|"
(propertize "+"
- 'face font-lock-warning-face
- 'help-echo "mouse-1: increment address"
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: increment address"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-show-next-page))
- "]: "
- (propertize gdb-memory-address
+ "]: "
+ (propertize gdb-memory-address
'face font-lock-warning-face
'help-echo "mouse-1: set start address"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-address-event))
- " Rows: "
- (propertize (number-to-string gdb-memory-rows)
+ " Rows: "
+ (propertize (number-to-string gdb-memory-rows)
'face font-lock-warning-face
'help-echo "mouse-1: set number of columns"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-rows))
- " Columns: "
- (propertize (number-to-string gdb-memory-columns)
+ " Columns: "
+ (propertize (number-to-string gdb-memory-columns)
'face font-lock-warning-face
'help-echo "mouse-1: set number of columns"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-columns))
- " Display Format: "
- (propertize gdb-memory-format
+ " Display Format: "
+ (propertize gdb-memory-format
'face font-lock-warning-face
'help-echo "mouse-3: select display format"
'mouse-face 'mode-line-highlight
'local-map gdb-memory-format-map)
- " Unit Size: "
- (propertize (number-to-string gdb-memory-unit)
+ " Unit Size: "
+ (propertize (number-to-string gdb-memory-unit)
'face font-lock-warning-face
'help-echo "mouse-3: select unit size"
'mouse-face 'mode-line-highlight
@@ -3210,18 +3227,18 @@ DOC is an optional documentation string."
(concat "disassembly of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly for current stack frame.")
+ gdb-display-disassembly-buffer
+ 'gdb-disassembly-buffer
+ "Display disassembly for current stack frame.")
(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.")
+ gdb-frame-disassembly-buffer
+ 'gdb-disassembly-buffer
+ "Display disassembly in a new frame.")
(def-gdb-auto-update-trigger gdb-invalidate-disassembly
(let* ((frame (gdb-current-buffer-frame))
@@ -3266,7 +3283,7 @@ DOC is an optional documentation string."
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
- map))
+ map))
(define-derived-mode gdb-disassembly-mode gdb-parent-mode "Disassembly"
"Major mode for GDB disassembly information."
@@ -3283,12 +3300,13 @@ DOC is an optional documentation string."
(address (bindat-get-field (gdb-current-buffer-frame) 'addr))
(table (make-gdb-table))
(marked-line nil))
- (dolist (instr instructions)
+ (dolist (instr instructions)
(gdb-table-add-row table
- (list
- (bindat-get-field instr 'address)
- (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset)))
- (bindat-get-field instr 'inst)))
+ (list
+ (bindat-get-field instr 'address)
+ (apply #'format "<%s+%s>:"
+ (gdb-get-many-fields instr 'func-name 'offset))
+ (bindat-get-field instr 'inst)))
(when (string-equal (bindat-get-field instr 'address)
address)
(progn
@@ -3297,17 +3315,18 @@ DOC is an optional documentation string."
(if (string-equal gdb-frame-number "0")
nil
'((overlay-arrow . hollow-right-triangle)))))))
- (insert (gdb-table-string table " "))
- (gdb-disassembly-place-breakpoints)
- ;; Mark current position with overlay arrow and scroll window to
- ;; that point
- (when marked-line
- (let ((window (get-buffer-window (current-buffer) 0)))
- (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position))))
- (setq mode-name
- (gdb-current-context-mode-name
- (concat "Disassembly: "
- (bindat-get-field (gdb-current-buffer-frame) 'func))))))
+ (insert (gdb-table-string table " "))
+ (gdb-disassembly-place-breakpoints)
+ ;; Mark current position with overlay arrow and scroll window to
+ ;; that point
+ (when marked-line
+ (let ((window (get-buffer-window (current-buffer) 0)))
+ (set-window-point window (gdb-mark-line marked-line
+ gdb-disassembly-position))))
+ (setq mode-name
+ (gdb-current-context-mode-name
+ (concat "Disassembly: "
+ (bindat-get-field (gdb-current-buffer-frame) 'func))))))
(defun gdb-disassembly-place-breakpoints ()
(gdb-remove-breakpoint-icons (point-min) (point-max))
@@ -3328,7 +3347,8 @@ DOC is an optional documentation string."
nil nil mode-line)
" "
(gdb-propertize-header "Threads" gdb-threads-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)))
+ "mouse-1: select" mode-line-highlight
+ mode-line-inactive)))
;;; Breakpoints view
(define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints"
@@ -3344,7 +3364,7 @@ DOC is an optional documentation string."
(let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
(if breakpoint
(gud-basic-call
- (concat (if (string-equal "y" (bindat-get-field breakpoint 'enabled))
+ (concat (if (equal "y" (bindat-get-field breakpoint 'enabled))
"-break-disable "
"-break-enable ")
(bindat-get-field breakpoint 'number)))
@@ -3354,11 +3374,12 @@ DOC is an optional documentation string."
"Delete the breakpoint at current line of breakpoints buffer."
(interactive)
(save-excursion
- (beginning-of-line)
- (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
- (if breakpoint
- (gud-basic-call (concat "-break-delete " (bindat-get-field breakpoint 'number)))
- (error "Not recognized as break/watchpoint line")))))
+ (beginning-of-line)
+ (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
+ (if breakpoint
+ (gud-basic-call (concat "-break-delete "
+ (bindat-get-field breakpoint 'number)))
+ (error "Not recognized as break/watchpoint line")))))
(defun gdb-goto-breakpoint (&optional event)
"Go to the location of breakpoint at current line of
@@ -3369,24 +3390,24 @@ breakpoints buffer."
(let ((window (get-buffer-window gud-comint-buffer)))
(if window (save-selected-window (select-window window))))
(save-excursion
- (beginning-of-line)
- (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
- (if breakpoint
- (let ((bptno (bindat-get-field breakpoint 'number))
- (file (bindat-get-field breakpoint 'fullname))
- (line (bindat-get-field breakpoint 'line)))
- (save-selected-window
- (let* ((buffer (find-file-noselect
- (if (file-exists-p file) file
- (cdr (assoc bptno gdb-location-alist)))))
- (window (or (gdb-display-source-buffer buffer)
- (display-buffer buffer))))
- (setq gdb-source-window window)
- (with-current-buffer buffer
- (goto-char (point-min))
- (forward-line (1- (string-to-number line)))
- (set-window-point window (point))))))
- (error "Not recognized as break/watchpoint line")))))
+ (beginning-of-line)
+ (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
+ (if breakpoint
+ (let ((bptno (bindat-get-field breakpoint 'number))
+ (file (bindat-get-field breakpoint 'fullname))
+ (line (bindat-get-field breakpoint 'line)))
+ (save-selected-window
+ (let* ((buffer (find-file-noselect
+ (if (file-exists-p file) file
+ (cdr (assoc bptno gdb-location-alist)))))
+ (window (or (gdb-display-source-buffer buffer)
+ (display-buffer buffer))))
+ (setq gdb-source-window window)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line)))
+ (set-window-point window (point))))))
+ (error "Not recognized as break/watchpoint line")))))
;; Frames buffer. This displays a perpetually correct bactrack trace.
@@ -3418,21 +3439,21 @@ member."
(let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack))
(table (make-gdb-table)))
(set-marker gdb-stack-position nil)
- (dolist (frame stack)
- (gdb-table-add-row table
- (list
- (bindat-get-field frame 'level)
- "in"
- (concat
- (bindat-get-field frame 'func)
- (if gdb-stack-buffer-locations
- (gdb-frame-location frame) "")
- (if gdb-stack-buffer-addresses
- (concat " at " (bindat-get-field frame 'addr)) "")))
- `(mouse-face highlight
- help-echo "mouse-2, RET: Select frame"
- gdb-frame ,frame)))
- (insert (gdb-table-string table " ")))
+ (dolist (frame stack)
+ (gdb-table-add-row table
+ (list
+ (bindat-get-field frame 'level)
+ "in"
+ (concat
+ (bindat-get-field frame 'func)
+ (if gdb-stack-buffer-locations
+ (gdb-frame-location frame) "")
+ (if gdb-stack-buffer-addresses
+ (concat " at " (bindat-get-field frame 'addr)) "")))
+ `(mouse-face highlight
+ help-echo "mouse-2, RET: Select frame"
+ gdb-frame ,frame)))
+ (insert (gdb-table-string table " ")))
(when (and gdb-frame-number
(gdb-buffer-shows-main-thread-p))
(gdb-mark-line (1+ (string-to-number gdb-frame-number))
@@ -3445,18 +3466,18 @@ member."
(concat "stack frames of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack.")
+ gdb-display-stack-buffer
+ 'gdb-stack-buffer
+ "Display backtrace of current stack.")
(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.")
+ gdb-frame-stack-buffer
+ 'gdb-stack-buffer
+ "Display backtrace of current stack in a new frame.")
(defvar gdb-frames-mode-map
(let ((map (make-sparse-keymap)))
@@ -3489,7 +3510,8 @@ member."
(if (gdb-buffer-shows-main-thread-p)
(let ((new-level (bindat-get-field frame 'level)))
(setq gdb-frame-number new-level)
- (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore))
+ (gdb-input (list (concat "-stack-select-frame " new-level)
+ 'ignore))
(gdb-update))
(error "Could not select frame for non-current thread"))
(error "Not recognized as frame line"))))
@@ -3499,7 +3521,8 @@ member."
;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
(def-gdb-trigger-and-handler
gdb-invalidate-locals
- (concat (gdb-current-context-command "-stack-list-locals") " --simple-values")
+ (concat (gdb-current-context-command "-stack-list-locals")
+ " --simple-values")
gdb-locals-handler gdb-locals-handler-custom
'(start update))
@@ -3515,7 +3538,7 @@ member."
(define-key map "\r" 'gud-watch)
(define-key map [mouse-2] 'gud-watch)
map)
- "Keymap to create watch expression of a complex data type local variable.")
+ "Keymap to create watch expression of a complex data type local variable.")
(defvar gdb-edit-locals-map-1
(let ((map (make-sparse-keymap)))
@@ -3523,7 +3546,7 @@ member."
(define-key map "\r" 'gdb-edit-locals-value)
(define-key map [mouse-2] 'gdb-edit-locals-value)
map)
- "Keymap to edit value of a simple data type local variable.")
+ "Keymap to edit value of a simple data type local variable.")
(defun gdb-edit-locals-value (&optional event)
"Assign a value to a variable displayed in the locals buffer."
@@ -3549,14 +3572,14 @@ member."
(if (or (not value)
(string-match "\\0x" value))
(add-text-properties 0 (length name)
- `(mouse-face highlight
- help-echo "mouse-2: create watch expression"
- local-map ,gdb-locals-watch-map)
- name)
+ `(mouse-face highlight
+ help-echo "mouse-2: create watch expression"
+ local-map ,gdb-locals-watch-map)
+ name)
(add-text-properties 0 (length value)
`(mouse-face highlight
- help-echo "mouse-2: edit value"
- local-map ,gdb-edit-locals-map-1)
+ help-echo "mouse-2: edit value"
+ local-map ,gdb-edit-locals-map-1)
value))
(gdb-table-add-row
table
@@ -3568,7 +3591,8 @@ member."
(insert (gdb-table-string table " "))
(setq mode-name
(gdb-current-context-mode-name
- (concat "Locals: " (bindat-get-field (gdb-current-buffer-frame) 'func))))))
+ (concat "Locals: "
+ (bindat-get-field (gdb-current-buffer-frame) 'func))))))
(defvar gdb-locals-header
(list
@@ -3576,19 +3600,20 @@ member."
nil nil mode-line)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)))
+ "mouse-1: select" mode-line-highlight
+ mode-line-inactive)))
(defvar gdb-locals-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create
- 'gdb-registers-buffer
- gdb-thread-number) t)))
- map))
+ (define-key map "\t" (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create
+ 'gdb-registers-buffer
+ gdb-thread-number) t)))
+ map))
(define-derived-mode gdb-locals-mode gdb-parent-mode "Locals"
"Major mode for gdb locals."
@@ -3600,18 +3625,18 @@ member."
(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.")
+ gdb-display-locals-buffer
+ 'gdb-locals-buffer
+ "Display local variables of current stack and their values.")
(def-gdb-preempt-display-buffer
- gdb-preemptively-display-locals-buffer
- 'gdb-locals-buffer nil t)
+ 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.")
+ gdb-frame-locals-buffer
+ 'gdb-locals-buffer
+ "Display local variables of current stack and their values in a new frame.")
;; Registers buffer.
@@ -3631,7 +3656,8 @@ member."
(defun gdb-registers-handler-custom ()
(when gdb-register-names
- (let ((register-values (bindat-get-field (gdb-json-partial-output) 'register-values))
+ (let ((register-values
+ (bindat-get-field (gdb-json-partial-output) 'register-values))
(table (make-gdb-table)))
(dolist (register register-values)
(let* ((register-number (bindat-get-field register 'number))
@@ -3641,7 +3667,8 @@ member."
(gdb-table-add-row
table
(list
- (propertize register-name 'font-lock-face font-lock-variable-name-face)
+ (propertize register-name
+ 'font-lock-face font-lock-variable-name-face)
(if (member register-number gdb-changed-registers)
(propertize value 'font-lock-face font-lock-warning-face)
value))
@@ -3670,18 +3697,19 @@ member."
(define-key map "\r" 'gdb-edit-register-value)
(define-key map [mouse-2] 'gdb-edit-register-value)
(define-key map "q" 'kill-this-buffer)
- (define-key map "\t" '(lambda ()
- (interactive)
- (gdb-set-window-buffer
- (gdb-get-buffer-create
- 'gdb-locals-buffer
- gdb-thread-number) t)))
+ (define-key map "\t" (lambda ()
+ (interactive)
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create
+ 'gdb-locals-buffer
+ gdb-thread-number) t)))
map))
(defvar gdb-registers-header
(list
(gdb-propertize-header "Locals" gdb-locals-buffer
- "mouse-1: select" mode-line-highlight mode-line-inactive)
+ "mouse-1: select" mode-line-highlight
+ mode-line-inactive)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
nil nil mode-line)))
@@ -3696,17 +3724,17 @@ member."
(concat "registers of " (gdb-get-target-string))))
(def-gdb-display-buffer
- gdb-display-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents.")
+ gdb-display-registers-buffer
+ 'gdb-registers-buffer
+ "Display integer register contents.")
(def-gdb-preempt-display-buffer
gdb-preemptively-display-registers-buffer
- 'gdb-registers-buffer nil t)
+ 'gdb-registers-buffer nil t)
(def-gdb-frame-for-buffer
- gdb-frame-registers-buffer
- 'gdb-registers-buffer
+ gdb-frame-registers-buffer
+ 'gdb-registers-buffer
"Display integer register contents in a new frame.")
;; Needs GDB 6.4 onwards (used to fail with no stack).
@@ -3723,14 +3751,16 @@ member."
(defun gdb-changed-registers-handler ()
(gdb-delete-pending 'gdb-get-changed-registers)
(setq gdb-changed-registers nil)
- (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers))
+ (dolist (register-number
+ (bindat-get-field (gdb-json-partial-output) 'changed-registers))
(push register-number gdb-changed-registers)))
(defun gdb-register-names-handler ()
;; Don't use gdb-pending-triggers because this handler is called
;; only once (in gdb-init-1)
(setq gdb-register-names nil)
- (dolist (register-name (bindat-get-field (gdb-json-partial-output) 'register-names))
+ (dolist (register-name
+ (bindat-get-field (gdb-json-partial-output) 'register-names))
(push register-name gdb-register-names))
(setq gdb-register-names (reverse gdb-register-names)))
@@ -3755,7 +3785,8 @@ thread. Called from `gdb-update'."
(if (not (gdb-pending-p 'gdb-get-main-selected-frame))
(progn
(gdb-input
- (list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler))
+ (list (gdb-current-context-command "-stack-info-frame")
+ 'gdb-frame-handler))
(gdb-add-pending 'gdb-get-main-selected-frame))))
(defun gdb-frame-handler ()
@@ -3806,10 +3837,10 @@ window and show BUF there, if the window is not used for GDB
already, in which case that window is splitted first."
(let ((answer (get-buffer-window buf (or frame 0))))
(if answer
- (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
+ (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)
+ 'gdbmi)
(let ((largest (get-largest-window)))
(setq answer (split-window largest))
(set-window-buffer answer buf)
@@ -3872,7 +3903,8 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
(define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
- (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer))
+ (define-key menu [disassembly]
+ '("Disassembly" . gdb-frame-disassembly-buffer))
(define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
(define-key menu [inferior]
'("IO" . gdb-frame-io-buffer))
@@ -3883,40 +3915,41 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(let ((menu (make-sparse-keymap "GDB-MI")))
(define-key menu [gdb-customize]
- '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
- :help "Customize Gdb Graphical Mode options."))
+ '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
+ :help "Customize Gdb Graphical Mode options."))
(define-key menu [gdb-many-windows]
- '(menu-item "Display Other Windows" gdb-many-windows
- :help "Toggle display of locals, stack and breakpoint information"
- :button (:toggle . gdb-many-windows)))
+ '(menu-item "Display Other Windows" gdb-many-windows
+ :help "Toggle display of locals, stack and breakpoint information"
+ :button (:toggle . gdb-many-windows)))
(define-key menu [gdb-restore-windows]
- '(menu-item "Restore Window Layout" gdb-restore-windows
- :help "Restore standard layout for debug session."))
+ '(menu-item "Restore Window Layout" gdb-restore-windows
+ :help "Restore standard layout for debug session."))
(define-key menu [sep1]
'(menu-item "--"))
(define-key menu [all-threads]
'(menu-item "GUD controls all threads"
- (lambda ()
- (interactive)
- (setq gdb-gud-control-all-threads t))
- :help "GUD start/stop commands apply to all threads"
- :button (:radio . gdb-gud-control-all-threads)))
+ (lambda ()
+ (interactive)
+ (setq gdb-gud-control-all-threads t))
+ :help "GUD start/stop commands apply to all threads"
+ :button (:radio . gdb-gud-control-all-threads)))
(define-key menu [current-thread]
'(menu-item "GUD controls current thread"
- (lambda ()
- (interactive)
- (setq gdb-gud-control-all-threads nil))
- :help "GUD start/stop commands apply to current thread only"
- :button (:radio . (not gdb-gud-control-all-threads))))
+ (lambda ()
+ (interactive)
+ (setq gdb-gud-control-all-threads nil))
+ :help "GUD start/stop commands apply to current thread only"
+ :button (:radio . (not gdb-gud-control-all-threads))))
(define-key menu [sep2]
'(menu-item "--"))
(define-key menu [gdb-customize-reasons]
'(menu-item "Customize switching..."
- (lambda ()
- (interactive)
- (customize-option 'gdb-switch-reasons))))
+ (lambda ()
+ (interactive)
+ (customize-option 'gdb-switch-reasons))))
(define-key menu [gdb-switch-when-another-stopped]
- (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped gdb-switch-when-another-stopped
+ (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped
+ gdb-switch-when-another-stopped
"Automatically switch to stopped thread"
"GDB thread switching %s"
"Switch to stopped thread"))
@@ -3930,18 +3963,18 @@ SPLIT-HORIZONTAL and show BUF in the new window."
;; show up right before Run button.
(define-key-after gud-tool-bar-map [all-threads]
'(menu-item "Switch to non-stop/A mode" gdb-control-all-threads
- :image (find-image '((:type xpm :file "gud/thread.xpm")))
- :visible (and (eq gud-minor-mode 'gdbmi)
- gdb-non-stop
- (not gdb-gud-control-all-threads)))
+ :image (find-image '((:type xpm :file "gud/thread.xpm")))
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ gdb-non-stop
+ (not gdb-gud-control-all-threads)))
'run)
(define-key-after gud-tool-bar-map [current-thread]
'(menu-item "Switch to non-stop/T mode" gdb-control-current-thread
- :image (find-image '((:type xpm :file "gud/all.xpm")))
- :visible (and (eq gud-minor-mode 'gdbmi)
- gdb-non-stop
- gdb-gud-control-all-threads))
+ :image (find-image '((:type xpm :file "gud/all.xpm")))
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ gdb-non-stop
+ gdb-gud-control-all-threads))
'all-threads)
(defun gdb-frame-gdb-buffer ()
@@ -3960,15 +3993,16 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(let ((same-window-regexps nil))
(select-window (display-buffer gud-comint-buffer nil 0))))
-(defun gdb-set-window-buffer (name &optional ignore-dedicated)
+(defun gdb-set-window-buffer (name &optional ignore-dedicated window)
"Set buffer of selected window to NAME and dedicate window.
When IGNORE-DEDICATED is non-nil, buffer is set even if selected
window is dedicated."
+ (unless window (setq window (selected-window)))
(when ignore-dedicated
- (set-window-dedicated-p (selected-window) nil))
- (set-window-buffer (selected-window) (get-buffer name))
- (set-window-dedicated-p (selected-window) t))
+ (set-window-dedicated-p window nil))
+ (set-window-buffer window (get-buffer name))
+ (set-window-dedicated-p window t))
(defun gdb-setup-windows ()
"Layout the window pattern for `gdb-many-windows'."
@@ -3977,35 +4011,35 @@ window is dedicated."
(delete-other-windows)
(gdb-display-breakpoints-buffer)
(delete-other-windows)
- ; Don't dedicate.
+ ;; Don't dedicate.
(pop-to-buffer gud-comint-buffer)
- (split-window nil ( / ( * (window-height) 3) 4))
- (split-window nil ( / (window-height) 3))
- (split-window-horizontally)
- (other-window 1)
- (gdb-set-window-buffer (gdb-locals-buffer-name))
- (other-window 1)
- (switch-to-buffer
- (if gud-last-last-frame
- (gud-find-file (car gud-last-last-frame))
- (if gdb-main-file
- (gud-find-file gdb-main-file)
- ;; Put buffer list in window if we
- ;; can't find a source file.
- (list-buffers-noselect))))
- (setq gdb-source-window (selected-window))
- (split-window-horizontally)
- (other-window 1)
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-inferior-io))
- (other-window 1)
- (gdb-set-window-buffer (gdb-stack-buffer-name))
- (split-window-horizontally)
- (other-window 1)
- (gdb-set-window-buffer (if gdb-show-threads-by-default
- (gdb-threads-buffer-name)
- (gdb-breakpoints-buffer-name)))
- (other-window 1))
+ (let ((win0 (selected-window))
+ (win1 (split-window nil ( / ( * (window-height) 3) 4)))
+ (win2 (split-window nil ( / (window-height) 3)))
+ (win3 (split-window-horizontally)))
+ (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
+ (select-window win2)
+ (set-window-buffer
+ win2
+ (if gud-last-last-frame
+ (gud-find-file (car gud-last-last-frame))
+ (if gdb-main-file
+ (gud-find-file gdb-main-file)
+ ;; Put buffer list in window if we
+ ;; can't find a source file.
+ (list-buffers-noselect))))
+ (setq gdb-source-window (selected-window))
+ (let ((win4 (split-window-horizontally)))
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-inferior-io) nil win4))
+ (select-window win1)
+ (gdb-set-window-buffer (gdb-stack-buffer-name))
+ (let ((win5 (split-window-horizontally)))
+ (gdb-set-window-buffer (if gdb-show-threads-by-default
+ (gdb-threads-buffer-name)
+ (gdb-breakpoints-buffer-name))
+ nil win5))
+ (select-window win0)))
(defcustom gdb-many-windows nil
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
@@ -4022,34 +4056,33 @@ of the debugged program. Non-nil means display the layout shown for
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)))
+ (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")))
+ (if gdb-many-windows "en" "dis")))
(if (and gud-comint-buffer
- (buffer-name gud-comint-buffer))
+ (buffer-name gud-comint-buffer))
(condition-case nil
- (gdb-restore-windows)
- (error nil))))
+ (gdb-restore-windows)
+ (error nil))))
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
This arrangement depends on the value of `gdb-many-windows'."
(interactive)
- (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
- (delete-other-windows)
+ (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
+ (delete-other-windows)
(if gdb-many-windows
(gdb-setup-windows)
(when (or gud-last-last-frame gdb-show-main)
- (split-window)
- (other-window 1)
- (switch-to-buffer
- (if gud-last-last-frame
- (gud-find-file (car gud-last-last-frame))
- (gud-find-file gdb-main-file)))
- (setq gdb-source-window (selected-window))
- (other-window 1))))
+ (let ((win (split-window)))
+ (set-window-buffer
+ win
+ (if gud-last-last-frame
+ (gud-find-file (car gud-last-last-frame))
+ (gud-find-file gdb-main-file)))
+ (setq gdb-source-window win)))))
(defun gdb-reset ()
"Exit a debugging session cleanly.
@@ -4057,23 +4090,23 @@ Kills the gdb buffers, and resets variables and the source buffers."
(dolist (buffer (buffer-list))
(unless (eq buffer gud-comint-buffer)
(with-current-buffer buffer
- (if (eq gud-minor-mode 'gdbmi)
- (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name))
- (kill-buffer nil)
- (gdb-remove-breakpoint-icons (point-min) (point-max) t)
- (setq gud-minor-mode nil)
- (kill-local-variable 'tool-bar-map)
- (kill-local-variable 'gdb-define-alist))))))
+ (if (eq gud-minor-mode 'gdbmi)
+ (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name))
+ (kill-buffer nil)
+ (gdb-remove-breakpoint-icons (point-min) (point-max) t)
+ (setq gud-minor-mode nil)
+ (kill-local-variable 'tool-bar-map)
+ (kill-local-variable 'gdb-define-alist))))))
(setq gdb-disassembly-position nil)
(setq overlay-arrow-variable-list
- (delq 'gdb-disassembly-position overlay-arrow-variable-list))
+ (delq 'gdb-disassembly-position overlay-arrow-variable-list))
(setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
(setq gdb-stack-position nil)
(setq overlay-arrow-variable-list
- (delq 'gdb-stack-position overlay-arrow-variable-list))
+ (delq 'gdb-stack-position overlay-arrow-variable-list))
(setq gdb-thread-position nil)
(setq overlay-arrow-variable-list
- (delq 'gdb-thread-position overlay-arrow-variable-list))
+ (delq 'gdb-thread-position overlay-arrow-variable-list))
(if (boundp 'speedbar-frame) (speedbar-timer-fn))
(setq gud-running nil)
(setq gdb-active-process nil)
@@ -4085,12 +4118,12 @@ buffers, if required."
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp nil t)
(setq gdb-main-file (match-string 1)))
- (if gdb-many-windows
+ (if gdb-many-windows
(gdb-setup-windows)
- (gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (if gdb-show-main
- (let ((pop-up-windows t))
- (display-buffer (gud-find-file gdb-main-file))))))
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (if gdb-show-main
+ (let ((pop-up-windows t))
+ (display-buffer (gud-find-file gdb-main-file))))))
;;from put-image
(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
@@ -4099,14 +4132,14 @@ PUTSTRING is displayed by putting an overlay into the current buffer with a
`before-string' string that has a `display' property whose value is
PUTSTRING."
(let ((string (make-string 1 ?x))
- (buffer (current-buffer)))
+ (buffer (current-buffer)))
(setq putstring (copy-sequence putstring))
(let ((overlay (make-overlay pos pos buffer))
- (prop (or dprop
- (list (list 'margin 'left-margin) putstring))))
+ (prop (or dprop
+ (list (list 'margin 'left-margin) putstring))))
(put-text-property 0 1 'display prop string)
(if sprops
- (add-text-properties 0 1 sprops string))
+ (add-text-properties 0 1 sprops string))
(overlay-put overlay 'put-break t)
(overlay-put overlay 'before-string string))))
@@ -4119,7 +4152,7 @@ BUFFER nil or omitted means use the current buffer."
(setq buffer (current-buffer)))
(dolist (overlay (overlays-in start end))
(when (overlay-get overlay 'put-break)
- (delete-overlay overlay))))
+ (delete-overlay overlay))))
(defun gdb-put-breakpoint-icon (enabled bptno &optional line)
(let* ((posns (gdb-line-posns (or line (line-number-at-pos))))
@@ -4131,62 +4164,63 @@ BUFFER nil or omitted means use the current buffer."
0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt")
putstring)
(if enabled
- (add-text-properties
- 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
+ (add-text-properties
+ 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
(add-text-properties
0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
(gdb-remove-breakpoint-icons start end)
(if (display-images-p)
- (if (>= (or left-fringe-width
- (if source-window (car (window-fringes source-window)))
- gdb-buffer-fringe-width) 8)
- (gdb-put-string
- nil (1+ start)
- `(left-fringe breakpoint
- ,(if enabled
- 'breakpoint-enabled
- 'breakpoint-disabled))
- 'gdb-bptno bptno
- 'gdb-enabled enabled)
- (when (< left-margin-width 2)
- (save-current-buffer
- (setq left-margin-width 2)
- (if source-window
- (set-window-margins
- source-window
- left-margin-width right-margin-width))))
- (put-image
- (if enabled
- (or breakpoint-enabled-icon
- (setq breakpoint-enabled-icon
- (find-image `((:type xpm :data
- ,breakpoint-xpm-data
- :ascent 100 :pointer hand)
- (:type pbm :data
- ,breakpoint-enabled-pbm-data
- :ascent 100 :pointer hand)))))
- (or breakpoint-disabled-icon
- (setq breakpoint-disabled-icon
- (find-image `((:type xpm :data
- ,breakpoint-xpm-data
- :conversion disabled
- :ascent 100 :pointer hand)
- (:type pbm :data
- ,breakpoint-disabled-pbm-data
- :ascent 100 :pointer hand))))))
- (+ start 1)
- putstring
- 'left-margin))
+ (if (>= (or left-fringe-width
+ (if source-window (car (window-fringes source-window)))
+ gdb-buffer-fringe-width) 8)
+ (gdb-put-string
+ nil (1+ start)
+ `(left-fringe breakpoint
+ ,(if enabled
+ 'breakpoint-enabled
+ 'breakpoint-disabled))
+ 'gdb-bptno bptno
+ 'gdb-enabled enabled)
+ (when (< left-margin-width 2)
+ (save-current-buffer
+ (setq left-margin-width 2)
+ (if source-window
+ (set-window-margins
+ source-window
+ left-margin-width right-margin-width))))
+ (put-image
+ (if enabled
+ (or breakpoint-enabled-icon
+ (setq breakpoint-enabled-icon
+ (find-image `((:type xpm :data
+ ,breakpoint-xpm-data
+ :ascent 100 :pointer hand)
+ (:type pbm :data
+ ,breakpoint-enabled-pbm-data
+ :ascent 100 :pointer hand)))))
+ (or breakpoint-disabled-icon
+ (setq breakpoint-disabled-icon
+ (find-image `((:type xpm :data
+ ,breakpoint-xpm-data
+ :conversion disabled
+ :ascent 100 :pointer hand)
+ (:type pbm :data
+ ,breakpoint-disabled-pbm-data
+ :ascent 100 :pointer hand))))))
+ (+ start 1)
+ putstring
+ 'left-margin))
(when (< left-margin-width 2)
- (save-current-buffer
- (setq left-margin-width 2)
- (let ((window (get-buffer-window (current-buffer) 0)))
- (if window
- (set-window-margins
- window left-margin-width right-margin-width)))))
+ (save-current-buffer
+ (setq left-margin-width 2)
+ (let ((window (get-buffer-window (current-buffer) 0)))
+ (if window
+ (set-window-margins
+ window left-margin-width right-margin-width)))))
(gdb-put-string
(propertize putstring
- 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
+ 'face (if enabled
+ 'breakpoint-enabled 'breakpoint-disabled))
(1+ start)))))
(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
@@ -4197,8 +4231,8 @@ BUFFER nil or omitted means use the current buffer."
(setq left-margin-width 0)
(let ((window (get-buffer-window (current-buffer) 0)))
(if window
- (set-window-margins
- window left-margin-width right-margin-width)))))
+ (set-window-margins
+ window left-margin-width right-margin-width)))))
(provide 'gdb-mi)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 12295efc2d1..5561575ea20 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -476,17 +476,23 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
"Handle match highlighting escape sequences inserted by the grep process.
This function is called from `compilation-filter-hook'."
(save-excursion
- (let ((end (point-marker)))
- ;; Highlight grep matches and delete marking sequences.
+ (forward-line 0)
+ (let ((end (point)))
(goto-char compilation-filter-start)
- (while (re-search-forward "\033\\[01;31m\\(.*?\\)\033\\[[0-9]*m" end 1)
- (replace-match (propertize (match-string 1)
- 'face nil 'font-lock-face grep-match-face)
- t t))
- ;; Delete all remaining escape sequences
- (goto-char compilation-filter-start)
- (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
- (replace-match "" t t)))))
+ (forward-line 0)
+ ;; Only operate on whole lines so we don't get caught with part of an
+ ;; escape sequence in one chunk and the rest in another.
+ (when (< (point) end)
+ (setq end (copy-marker end))
+ ;; Highlight grep matches and delete marking sequences.
+ (while (re-search-forward "\033\\[01;31m\\(.*?\\)\033\\[[0-9]*m" end 1)
+ (replace-match (propertize (match-string 1)
+ 'face nil 'font-lock-face grep-match-face)
+ t t))
+ ;; Delete all remaining escape sequences
+ (goto-char compilation-filter-start)
+ (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
+ (replace-match "" t t))))))
(defun grep-probe (command args &optional func result)
(let (process-file-side-effects)
@@ -692,6 +698,9 @@ This function is called from `compilation-filter-hook'."
grep-hit-face)
(set (make-local-variable 'compilation-error-regexp-alist)
grep-regexp-alist)
+ ;; compilation-directory-matcher can't be nil, so we set it to a regexp that
+ ;; can never match.
+ (set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`"))
(set (make-local-variable 'compilation-process-setup-function)
'grep-process-setup)
(set (make-local-variable 'compilation-disable-input) t)
@@ -1014,7 +1023,8 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]."
(read-from-minibuffer "Confirm: "
command nil nil 'grep-find-history))
(add-to-history 'grep-find-history command))
- (let ((default-directory dir))
+ (let ((default-directory dir)
+ (process-connection-type nil))
(compilation-start command 'grep-mode))
;; Set default-directory if we started rgrep in the *grep* buffer.
(if (eq next-error-last-buffer (current-buffer))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index f45273026b4..a54d1438368 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -116,11 +116,11 @@ Used to grey out relevant toolbar icons.")
(display-buffer-reuse-frames t))
(catch 'info-found
(walk-windows
- '(lambda (window)
- (if (eq (window-buffer window) (get-buffer "*info*"))
- (progn
- (setq same-window-regexps nil)
- (throw 'info-found nil))))
+ (lambda (window)
+ (if (eq (window-buffer window) (get-buffer "*info*"))
+ (progn
+ (setq same-window-regexps nil)
+ (throw 'info-found nil))))
nil 0)
(select-frame (make-frame)))
(if (eq gud-minor-mode 'gdbmi)
@@ -1581,7 +1581,8 @@ and source-file directory for your debugger."
;; Last group is for return value, e.g. "> test.py(2)foo()->None"
;; Either file or function name may be omitted: "> <string>(0)?()"
(defvar gud-pdb-marker-regexp
- "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n]*\\)?\n")
+ "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]")
+
(defvar gud-pdb-marker-regexp-file-group 1)
(defvar gud-pdb-marker-regexp-line-group 2)
(defvar gud-pdb-marker-regexp-fnname-group 3)
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index d07edd5de2f..49202ab6692 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -536,6 +536,11 @@ property of an overlay."
(overlay-put ov 'display nil))))
(overlay-put ov 'invisible (and hide-p 'hs)))
+(defun hs-looking-at-block-start-p ()
+ "Return non-nil if the point is at the block start."
+ (and (looking-at hs-block-start-regexp)
+ (save-match-data (not (nth 4 (syntax-ppss))))))
+
(defun hs-forward-sexp (match-data arg)
"Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG.
Original match data is restored upon return."
@@ -564,7 +569,7 @@ The block beginning is adjusted by `hs-adjust-block-beginning'
and then further adjusted to be at the end of the line."
(if comment-reg
(hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
- (when (looking-at hs-block-start-regexp)
+ (when (hs-looking-at-block-start-p)
(let ((mdata (match-data t))
(header-end (match-end 0))
p q ov)
@@ -684,16 +689,16 @@ Return point, or nil if original point was not in a block."
(let ((done nil)
(here (point)))
;; look if current line is block start
- (if (looking-at hs-block-start-regexp)
+ (if (hs-looking-at-block-start-p)
(point)
;; look backward for the start of a block that contains the cursor
(while (and (re-search-backward hs-block-start-regexp nil t)
- (save-match-data
- (not (nth 4 (syntax-ppss)))) ; not inside comments
- (not (setq done
- (< here (save-excursion
- (hs-forward-sexp (match-data t) 1)
- (point)))))))
+ ;; go again if in a comment
+ (or (save-match-data (nth 4 (syntax-ppss)))
+ (not (setq done
+ (< here (save-excursion
+ (hs-forward-sexp (match-data t) 1)
+ (point))))))))
(if done
(point)
(goto-char here)
@@ -750,7 +755,7 @@ and `case-fold-search' are both t."
(end-of-line)
(when (and (not c-reg)
(hs-find-block-beginning)
- (looking-at hs-block-start-regexp))
+ (hs-looking-at-block-start-p))
;; point is inside a block
(goto-char (match-end 0)))))
(end-of-line)
@@ -835,7 +840,7 @@ Upon completion, point is repositioned and the normal hook
(<= (count-lines (car c-reg) (nth 1 c-reg)) 1)))
(message "(not enough comment lines to hide)"))
((or c-reg
- (looking-at hs-block-start-regexp)
+ (hs-looking-at-block-start-p)
(hs-find-block-beginning))
(hs-hide-block-at-point end c-reg)
(run-hooks 'hs-hide-hook))))))
@@ -867,7 +872,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
q (cadr c-reg))))
((and (hs-find-block-beginning)
;; ugh, fresh match-data
- (looking-at hs-block-start-regexp))
+ (hs-looking-at-block-start-p))
(setq p (point)
q (progn (hs-forward-sexp (match-data t) 1) (point)))))
(when (and p q)
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 7202d95c8db..05fcedde048 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -835,7 +835,7 @@ see if a link is set for it. Try extra help functions if necessary."
((or idlwave-help-browser-is-local
(string-match "w3" (symbol-name idlwave-help-browser-function)))
- (idlwave-help-display-help-window '(lambda () (browse-url full-link))))
+ (idlwave-help-display-help-window (lambda () (browse-url full-link))))
(t (browse-url full-link)))))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 93a3bf1b7f5..b2cd24f0f98 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -2187,7 +2187,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-dynamic-complete-as-filename)))
+ (comint-filename-completion)))
(defun idlwave-shell-executive-command ()
"Return the name of the current executive command, if any."
@@ -4243,15 +4243,15 @@ Otherwise, just expand the file name."
(define-key idlwave-shell-electric-debug-mode-map "_"
'idlwave-shell-stack-down)
(define-key idlwave-shell-electric-debug-mode-map "e"
- '(lambda () (interactive) (idlwave-shell-print '(16))))
+ (lambda () (interactive) (idlwave-shell-print '(16))))
(define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall)
(define-key idlwave-shell-electric-debug-mode-map "t"
- '(lambda () (interactive) (idlwave-shell-send-command "help,/TRACE")))
+ (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE")))
(define-key idlwave-shell-electric-debug-mode-map [(control ??)]
'idlwave-shell-electric-debug-help)
(define-key idlwave-shell-electric-debug-mode-map "x"
- '(lambda (arg) (interactive "P")
- (idlwave-shell-print arg nil nil t)))
+ (lambda (arg) (interactive "P")
+ (idlwave-shell-print arg nil nil t)))
; Enter the prefix map in two places.
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index cd382d4e78d..1bdcb4cfa89 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3306,8 +3306,8 @@ If one hasn't been set, or if it's stale, prompt for a new one."
#'js--which-func-joiner)
;; Comments
- (setq comment-start "// ")
- (setq comment-end "")
+ (set (make-local-variable 'comment-start) "// ")
+ (set (make-local-variable 'comment-end) "")
(set (make-local-variable 'fill-paragraph-function)
'js-c-fill-paragraph)
@@ -3347,7 +3347,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
;; Important to fontify the whole buffer syntactically! If we don't,
;; then we might have regular expression literals that aren't marked
;; as strings, which will screw up parse-partial-sexp, scan-lists,
- ;; etc. and and produce maddening "unbalanced parenthesis" errors.
+ ;; etc. and produce maddening "unbalanced parenthesis" errors.
;; When we attempt to find the error and scroll to the portion of
;; the buffer containing the problem, JIT-lock will apply the
;; correct syntax to the regular expresion literal and the problem
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index 8a8112c9655..c682bfa0280 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -80,9 +80,12 @@
"INCLUDE" "INPUT" "GROUP" "AS_NEEDED" "OUTPUT" "SEARCH_DIR" "STARTUP"
;; 3.4.3 Commands Dealing with Object File Formats
"OUTPUT_FORMAT" "TARGET"
- ;; 3.4.3 Other Linker Script Commands
+ ;; 3.4.4 Assign alias names to memory regions
+ "REGION_ALIAS"
+ ;; 3.4.5 Other Linker Script Commands
"ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION"
- "INHIBIT_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH"
+ "INHIBIT_COMMON_ALLOCATION" "INSERT" "AFTER" "BEFORE"
+ "NOCROSSREFS" "OUTPUT_ARCH" "LD_FEATURE"
;; 3.5.2 PROVIDE
"PROVIDE"
;; 3.5.3 PROVIDE_HIDDEN
@@ -90,7 +93,7 @@
;; 3.6 SECTIONS Command
"SECTIONS"
;; 3.6.4.2 Input Section Wildcard Patterns
- "SORT" "SORT_BY_NAME" "SORT_BY_ALIGNMENT"
+ "SORT" "SORT_BY_NAME" "SORT_BY_ALIGNMENT" "SORT_BY_INIT_PRIORITY"
;; 3.6.4.3 Input Section for Common Symbols
"COMMON"
;; 3.6.4.4 Input Section and Garbage Collection
@@ -108,22 +111,30 @@
"AT"
;; 3.6.8.4 Forced Input Alignment
"SUBALIGN"
- ;; 3.6.8.6 Output Section Phdr
+ ;; 3.6.8.5 Output Section Constraint
+ "ONLY_IF_RO" "ONLY_IF_RW"
+ ;; 3.6.8.7 Output Section Phdr
":PHDR"
;; 3.7 MEMORY Command
"MEMORY"
;; 3.8 PHDRS Command
"PHDRS" "FILEHDR" "FLAGS"
- "PT_NULL" "PT_LOAD" "PT_DYNAMIC" "PT_INTERP" "PT_NONE" "PT_SHLIB" "PT_PHDR"
+ "PT_NULL" "PT_LOAD" "PT_DYNAMIC" "PT_INTERP" "PT_NOTE" "PT_SHLIB" "PT_PHDR"
;; 3.9 VERSION Command
"VERSION")
"Keywords used of GNU ld script.")
-;; 3.10.8 Builtin Functions
+
+;; 3.10.2 Symbolic Constants
+;; 3.10.9 Builtin Functions
(defvar ld-script-builtins
- '("ABSOLUTE"
+ '("CONSTANT"
+ "MAXPAGESIZE"
+ "COMMONPAGESIZE"
+ "ABSOLUTE"
"ADDR"
"ALIGN"
+ "ALIGNOF"
"BLOCK"
"DATA_SEGMENT_ALIGN"
"DATA_SEGMENT_END"
@@ -149,7 +160,7 @@
1 font-lock-builtin-face)
;; 3.6.7 Output Section Discarding
;; 3.6.4.1 Input Section Basics
- ;; 3.6.8.6 Output Section Phdr
+ ;; 3.6.8.7 Output Section Phdr
("/DISCARD/\\|EXCLUDE_FILE\\|:NONE" . font-lock-warning-face)
("\\W\\(\\.\\)\\W" 1 ld-script-location-counter-face)
)
@@ -157,7 +168,7 @@
"Default font-lock-keywords for `ld-script-mode'.")
;;;###autoload
-(define-derived-mode ld-script-mode nil "LD-Script"
+(define-derived-mode ld-script-mode prog-mode "LD-Script"
"A major mode to edit GNU ld script files"
(set (make-local-variable 'comment-start) "/* ")
(set (make-local-variable 'comment-end) " */")
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 22e5d2f7c5c..293ba49d4ae 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,4 +1,4 @@
-;;; make-mode.el --- makefile editing commands for Emacs
+;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1992, 1994, 1999-2011 Free Software Foundation, Inc.
@@ -602,7 +602,7 @@ The function must satisfy this calling convention:
(define-key map "\C-c\C-m\C-p" 'makefile-makepp-mode)
(define-key map "\M-p" 'makefile-previous-dependency)
(define-key map "\M-n" 'makefile-next-dependency)
- (define-key map "\e\t" 'makefile-complete)
+ (define-key map "\e\t" 'completion-at-point)
;; Make menus.
(define-key map [menu-bar makefile-mode]
@@ -653,7 +653,7 @@ The function must satisfy this calling convention:
'(menu-item "Find Targets and Macros" makefile-pickup-everything
:help "Notice names of all macros and targets in Makefile"))
(define-key map [menu-bar makefile-mode complete]
- '(menu-item "Complete Target or Macro" makefile-complete
+ '(menu-item "Complete Target or Macro" completion-at-point
:help "Perform completion on Makefile construct preceding point"))
(define-key map [menu-bar makefile-mode backslash]
'(menu-item "Backslash Region" makefile-backslash-region
@@ -852,6 +852,8 @@ Makefile mode can be configured by modifying the following variables:
List of special targets. You will be offered to complete
on one of those in the minibuffer whenever you enter a `.'.
at the beginning of a line in Makefile mode."
+ (add-hook 'completion-at-point-functions
+ #'makefile-completions-at-point nil t)
(add-hook 'write-file-functions
'makefile-warn-suspicious-lines nil t)
(add-hook 'write-file-functions
@@ -1147,11 +1149,7 @@ and adds all qualifying names to the list of known targets."
;;; Completion.
-(defun makefile-complete ()
- "Perform completion on Makefile construct preceding point.
-Can complete variable and target names.
-The context determines which are considered."
- (interactive)
+(defun makefile-completions-at-point ()
(let* ((beg (save-excursion
(skip-chars-backward "^$(){}:#= \t\n")
(point)))
@@ -1168,22 +1166,26 @@ The context determines which are considered."
;; Preceding "$(" or "${" means macros only.
((and (memq pc '(?\{ ?\())
(progn
- (setq paren (if (eq paren ?\{) ?\} ?\)))
+ (setq paren (if (eq pc ?\{) ?\} ?\)))
(backward-char)
(= (preceding-char) ?$)))
t)))))
-
- (table (apply-partially 'completion-table-with-terminator
- (cond
- (do-macros (or paren ""))
- ((save-excursion (goto-char beg) (bolp)) ":")
- (t " "))
- (append (if do-macros
- '()
- makefile-target-table)
- makefile-macro-table))))
- (completion-in-region beg (point) table)))
-
+ (suffix (cond
+ (do-macros (if paren (string paren)))
+ ((save-excursion (goto-char beg) (bolp)) ":")
+ (t " "))))
+ (list beg (point)
+ (append (if do-macros '() makefile-target-table)
+ makefile-macro-table)
+ :exit-function
+ (if suffix
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at (regexp-quote suffix))
+ (goto-char (match-end 0))
+ (insert suffix))))))))
+
+(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1")
;; Backslashification. Stolen from cc-mode.el.
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index b36104bf49b..ab640c0e270 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -1,4 +1,4 @@
-;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources
+;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*-
;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
@@ -471,16 +471,13 @@ If the list was changed, sort the list and remove duplicates first."
(string-lessp (car a) (car b)))
-(defun meta-complete-symbol ()
- "Perform completion on Metafont or MetaPost symbol preceding point."
- ;; FIXME: Use completion-at-point-functions.
- (interactive "*")
+(defun meta-completions-at-point ()
(let ((list meta-complete-list)
entry)
(while list
(setq entry (car list)
list (cdr list))
- (if (meta-looking-at-backward (car entry) 200)
+ (if (looking-back (car entry) (max (point-min) (- (point) 200)))
(setq list nil)))
(if (numberp (nth 1 entry))
(let* ((sub (nth 1 entry))
@@ -488,31 +485,19 @@ If the list was changed, sort the list and remove duplicates first."
(begin (match-beginning sub))
(end (match-end sub))
(list (funcall (nth 2 entry))))
- (completion-in-region
- begin end
- (if (zerop (length close)) list
- (apply-partially 'completion-table-with-terminator
- close list))))
- (funcall (nth 1 entry)))))
-
-
-(defun meta-looking-at-backward (regexp &optional limit)
- ;; utility function used in `meta-complete-symbol'
- (let ((pos (point)))
- (save-excursion
- (and (re-search-backward
- regexp (if limit (max (point-min) (- (point) limit))) t)
- (eq (match-end 0) pos)))))
-
-(defun meta-match-buffer (n)
- ;; utility function used in `meta-complete-symbol'
- (if (match-beginning n)
- (let ((str (buffer-substring (match-beginning n) (match-end n))))
- (set-text-properties 0 (length str) nil str)
- (copy-sequence str))
- ""))
-
-
+ (list
+ begin end list
+ :exit-function
+ (unless (zerop (length close))
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at (regexp-quote close))
+ (goto-char (match-end 0))
+ (insert close)))))))
+ (nth 1 entry))))
+
+(define-obsolete-function-alias 'meta-complete-symbol
+ 'completion-at-point "24.1")
;;; Indentation.
@@ -906,7 +891,7 @@ The environment marked is the one that contains point or follows point."
(define-key map "\C-c;" 'meta-comment-region)
(define-key map "\C-c:" 'meta-uncomment-region)
;; Symbol Completion:
- (define-key map "\M-\t" 'meta-complete-symbol)
+ (define-key map "\M-\t" 'completion-at-point)
;; Shell Commands:
;; (define-key map "\C-c\C-c" 'meta-command-file)
;; (define-key map "\C-c\C-k" 'meta-kill-job)
@@ -935,7 +920,7 @@ The environment marked is the one that contains point or follows point."
["Uncomment Region" meta-uncomment-region
:active (meta-mark-active)]
"--"
- ["Complete Symbol" meta-complete-symbol t]
+ ["Complete Symbol" completion-at-point t]
; "--"
; ["Command on Buffer" meta-command-file t]
; ["Kill Job" meta-kill-job t]
@@ -994,6 +979,7 @@ The environment marked is the one that contains point or follows point."
(set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (add-hook 'completion-at-point-functions #'meta-completions-at-point nil t)
(set (make-local-variable 'comment-indent-function) #'meta-comment-indent)
(set (make-local-variable 'indent-line-function) #'meta-indent-line)
;; No need to define a mode-specific 'indent-region-function.
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index bf5662cdfa3..103c7be7d3c 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -1059,8 +1059,7 @@ EXECUTION-TIME holds info about the time it takes, number or string.")
(let* ((completion-ignore-case t)
;; we already have a list, but it is not in the right format
;; transform it to a valid table so completition can use it
- (table (mapcar '(lambda (elm)
- (cons (symbol-name (car elm)) nil))
+ (table (mapcar (lambda (elm) (cons (symbol-name (car elm)) nil))
mixal-operation-codes-alist))
;; prompt is different depending on we are close to a valid op-code
(have-default (assq (intern-soft (current-word))
@@ -1104,7 +1103,7 @@ Assumes that file has been compiled with debugging support."
(error "mixvm.el needs to be loaded to run `mixvm'")))
;;;###autoload
-(define-derived-mode mixal-mode fundamental-mode "mixal"
+(define-derived-mode mixal-mode prog-mode "mixal"
"Major mode for the mixal asm language."
(set (make-local-variable 'comment-start) "*")
(set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index 803a542563c..cb64b2436c6 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -267,8 +267,12 @@ startup file, `~/.emacs-octave'."
(save-excursion
(skip-syntax-backward "w_" (comint-line-beginning-position))
(point))))
- (cond (inferior-octave-complete-impossible nil)
- ((eq start end) nil)
+ (cond ((eq start end) nil)
+ (inferior-octave-complete-impossible
+ (message (concat
+ "Your Octave does not have `completion_matches'. "
+ "Please upgrade to version 2.X."))
+ nil)
(t
(list
start end
@@ -279,19 +283,8 @@ startup file, `~/.emacs-octave'."
(sort (delete-dups inferior-octave-output-list)
'string-lessp))))))))
-(defun inferior-octave-complete ()
- "Perform completion on the Octave symbol preceding point.
-This is implemented using the Octave command `completion_matches' which
-is NOT available with versions of Octave prior to 2.0."
- (interactive)
- (if inferior-octave-complete-impossible
- (error (concat
- "Your Octave does not have `completion_matches'. "
- "Please upgrade to version 2.X."))
- (let ((data (inferior-octave-completion-at-point)))
- (if (null data)
- (message "Cannot complete an empty string")
- (apply #'completion-in-region data)))))
+(define-obsolete-function-alias 'inferior-octave-complete
+ 'completion-at-point "24.1")
(defun inferior-octave-dynamic-list-input-ring ()
"List the buffer's input history in a help buffer."
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index 39d997e1d5e..183347cdeca 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -983,12 +983,8 @@ otherwise."
(setq end (point))))
(list beg end octave-completion-alist)))
-(defun octave-complete-symbol ()
- "Perform completion on Octave symbol preceding point.
-Compare that symbol against Octave's reserved words and builtin
-variables."
- (interactive)
- (apply 'completion-in-region (octave-completion-at-point-function)))
+(define-obsolete-function-alias 'octave-complete-symbol
+ 'completion-at-point "24.1")
;;; Electric characters && friends
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index e28bb14bb9a..57ed13969b4 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -40,7 +40,6 @@
;; pascal-tab-always-indent t
;; pascal-auto-endcomments t
;; pascal-auto-lineup '(all)
-;; pascal-toggle-completions nil
;; pascal-type-keywords '("array" "file" "packed" "char"
;; "integer" "real" "string" "record")
;; pascal-start-keywords '("begin" "end" "function" "procedure"
@@ -79,8 +78,8 @@
;; These are user preferences, so not to set by default.
;;(define-key map "\r" 'electric-pascal-terminate-line)
;;(define-key map "\t" 'electric-pascal-tab)
- (define-key map "\M-\t" 'pascal-complete-word)
- (define-key map "\M-?" 'pascal-show-completions)
+ (define-key map "\M-\t" 'completion-at-point)
+ (define-key map "\M-?" 'completion-help-at-point)
(define-key map "\177" 'backward-delete-char-untabify)
(define-key map "\M-\C-h" 'pascal-mark-defun)
(define-key map "\C-c\C-b" 'pascal-insert-block)
@@ -232,13 +231,13 @@ will do all lineups."
(const :tag "Case statements" case))
:group 'pascal)
-(defcustom pascal-toggle-completions nil
- "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one.
-Repeated use of \\[pascal-complete-word] will show you all of them.
+(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."
- :type 'boolean
- :group 'pascal)
+it displays 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")
@@ -303,9 +302,9 @@ are handled in another way, and should not be added to this list."
"Major mode for editing Pascal code. \\<pascal-mode-map>
TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
-\\[pascal-complete-word] completes the word around current point with respect \
+\\[completion-at-point] completes the word around current point with respect \
to position in code
-\\[pascal-show-completions] shows all possible completions at this point.
+\\[completion-help-at-point] shows all possible completions at this point.
Other useful functions are:
@@ -354,6 +353,7 @@ no args, if that value is non-nil."
(set (make-local-variable 'comment-start) "{")
(set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *")
(set (make-local-variable 'comment-end) "}")
+ (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t)
;; Font lock support
(set (make-local-variable 'font-lock-defaults)
'(pascal-font-lock-keywords nil t))
@@ -1287,54 +1287,17 @@ indent of the current line in parameterlist."
(defvar pascal-last-word-shown nil)
(defvar pascal-last-completions nil)
-(defun pascal-complete-word ()
- "Complete word at current point.
-\(See also `pascal-toggle-completions', `pascal-type-keywords',
-`pascal-start-keywords' and `pascal-separator-keywords'.)"
- (interactive)
+(defun pascal-completions-at-point ()
(let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
(e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))))
+ (when (> e b)
+ (list b e #'pascal-completion))))
- ;; Toggle-completions inserts whole labels
- (if pascal-toggle-completions
- (let* ((pascal-str (buffer-substring b e))
- (allcomp (if (and pascal-toggle-completions
- (string= pascal-last-word-shown pascal-str))
- pascal-last-completions
- (all-completions pascal-str 'pascal-completion))))
- ;; Update entry number in list
- (setq pascal-last-completions allcomp
- pascal-last-word-numb
- (if (>= pascal-last-word-numb (1- (length allcomp)))
- 0
- (1+ pascal-last-word-numb)))
- (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
- ;; Display next match or same string if no match was found
- (if allcomp
- (progn
- (goto-char e)
- (insert-before-markers pascal-last-word-shown)
- (delete-region b e))
- (message "(No match)")))
- ;; The other form of completion does not necessarily do that.
- (completion-in-region b e 'pascal-completion))))
-
-(defun pascal-show-completions ()
- "Show all possible completions at current point."
- (interactive)
- (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
- (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
- (pascal-str (buffer-substring b e))
- (allcomp (if (and pascal-toggle-completions
- (string= pascal-last-word-shown pascal-str))
- pascal-last-completions
- (all-completions pascal-str 'pascal-completion))))
- ;; Show possible completions in a temporary buffer.
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list allcomp pascal-str))
- ;; Wait for a keypress. Then delete *Completion* window
- (momentary-string-display "" (point))
- (delete-window (get-buffer-window (get-buffer "*Completions*")))))
+(define-obsolete-function-alias 'pascal-complete-word
+ 'completion-at-point "24.1")
+
+(define-obsolete-function-alias 'pascal-show-completions
+ 'completion-help-at-point "24.1")
(defun pascal-get-default-symbol ()
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index cade56a194c..d60e7513651 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -485,7 +485,7 @@ If nil, use `temporary-file-directory'."
;; PostScript mode.
;;;###autoload
-(define-derived-mode ps-mode fundamental-mode "PostScript"
+(define-derived-mode ps-mode prog-mode "PostScript"
"Major mode for editing PostScript with GNU Emacs.
Entry to this mode calls `ps-mode-hook'.
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index a7851c54356..4d2f15c69d8 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -99,7 +99,9 @@
"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")
+ "self" "True" "False"
+ ;; Python 3
+ "nonlocal")
symbol-end)
(,(rx symbol-start "None" symbol-end) ; see § Keywords in 2.7 manual
. font-lock-constant-face)
@@ -1866,6 +1868,7 @@ instance. Assumes an inferior Python is running."
(declare-function info-lookup-maybe-add-help "info-look" (&rest arg))
+;;;###autoload
(defun python-after-info-look ()
"Set up info-look for Python.
Used with `eval-after-load'."
@@ -2359,6 +2362,7 @@ Interactively, prompt for the name with completion."
(autoload 'pymacs-load "pymacs" nil t)
(autoload 'brm-init "bikemacs")
+(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
@@ -2378,7 +2382,7 @@ without confirmation."
(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)))
+ (lambda () (easy-menu-add brm-menu)))
(easy-menu-define
python-brm-menu python-mode-map
"Bicycle Repair Man"
@@ -2417,7 +2421,7 @@ without confirmation."
(defvar python-mode-running) ;Dynamically scoped var.
;;;###autoload
-(define-derived-mode python-mode fundamental-mode "Python"
+(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.
@@ -2728,6 +2732,16 @@ comint believe the user typed this string so that
(defun python-sentinel (_proc _msg)
(setq overlay-arrow-position nil))
+(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)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index facbba60057..80358e1c651 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -4,10 +4,9 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.8
+;; Version: 3.0
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
;; This file is part of GNU Emacs.
@@ -46,7 +45,7 @@
;; available in early versions of sql.el. This support has been
;; extended and formalized in later versions. Part of the impetus for
;; the improved support of SQL flavors was borne out of the current
-;; maintainer's consulting experience. In the past fifteen years, I
+;; maintainers consulting experience. In the past twenty years, I
;; have used Oracle, Sybase, Informix, MySQL, Postgres, and SQLServer.
;; On some assignments, I have used two or more of these concurrently.
@@ -130,7 +129,7 @@
;; identifier characters.
;; (sql-set-product-feature 'xyz
-;; :syntax-alist ((?# . "w")))
+;; :syntax-alist ((?# . "_")))
;; 4) Define the interactive command interpreter for the database
;; product.
@@ -184,7 +183,7 @@
;; (sql-set-product-feature 'xyz
;; :sqli-comint-func 'my-sql-comint-xyz)
-;; 6) Define a convienence function to invoke the SQL interpreter.
+;; 6) Define a convenience function to invoke the SQL interpreter.
;; (defun my-sql-xyz (&optional buffer)
;; "Run ixyz by XyzDB as an inferior process."
@@ -230,9 +229,18 @@
(eval-when-compile
(require 'regexp-opt))
(require 'custom)
+(require 'thingatpt)
(eval-when-compile ;; needed in Emacs 19, 20
(setq max-specpdl-size (max max-specpdl-size 2000)))
+(defun sql-signum (n)
+ "Return 1, 0, or -1 to identify the sign of N."
+ (cond
+ ((not (numberp n)) nil)
+ ((< n 0) -1)
+ ((> n 0) 1)
+ (t 0)))
+
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
(defvar font-lock-string-face)
@@ -327,7 +335,8 @@ Customizing your password will store it in your ~/.emacs file."
(defvar sql-product-alist
'((ansi
:name "ANSI"
- :font-lock sql-mode-ansi-font-lock-keywords)
+ :font-lock sql-mode-ansi-font-lock-keywords
+ :statement sql-ansi-statement-starters)
(db2
:name "DB2"
@@ -392,7 +401,7 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-ms
:prompt-regexp "^[0-9]*>"
:prompt-length 5
- :syntax-alist ((?@ . "w"))
+ :syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
(mysql
@@ -408,6 +417,7 @@ Customizing your password will store it in your ~/.emacs file."
:prompt-regexp "^mysql> "
:prompt-length 6
:prompt-cont-regexp "^ -> "
+ :syntax-alist ((?# . "< b"))
:input-filter sql-remove-tabs-filter)
(oracle
@@ -417,11 +427,15 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-options sql-oracle-options
:sqli-login sql-oracle-login-params
:sqli-comint-func sql-comint-oracle
+ :list-all sql-oracle-list-all
+ :list-table sql-oracle-list-table
+ :completion-object sql-oracle-completion-object
:prompt-regexp "^SQL> "
:prompt-length 5
- :prompt-cont-regexp "^\\s-*\\d+> "
- :syntax-alist ((?$ . "w") (?# . "w"))
- :terminator ("\\(^/\\|;\\)" . "/")
+ :prompt-cont-regexp "^\\s-*[[:digit:]]+ "
+ :statement sql-oracle-statement-starters
+ :syntax-alist ((?$ . "_") (?# . "_"))
+ :terminator ("\\(^/\\|;\\)$" . "/")
:input-filter sql-placeholders-filter)
(postgres
@@ -434,11 +448,12 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-postgres
:list-all ("\\d+" . "\\dS+")
:list-table ("\\d+ %s" . "\\dS+ %s")
- :prompt-regexp "^.*=[#>] "
+ :completion-object sql-postgres-completion-object
+ :prompt-regexp "^\\w*=[#>] "
:prompt-length 5
- :prompt-cont-regexp "^.*[-(][#>] "
+ :prompt-cont-regexp "^\\w*[-(][#>] "
:input-filter sql-remove-tabs-filter
- :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";"))
+ :terminator ("\\(^\\s-*\\\\g$\\|;\\)" . "\\g"))
(solid
:name "Solid"
@@ -460,9 +475,10 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-sqlite
:list-all ".tables"
:list-table ".schema %s"
+ :completion-object sql-sqlite-completion-object
:prompt-regexp "^sqlite> "
:prompt-length 8
- :prompt-cont-regexp "^ ...> "
+ :prompt-cont-regexp "^ \.\.\.> "
:terminator ";")
(sybase
@@ -474,7 +490,7 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-sybase
:prompt-regexp "^SQL> "
:prompt-length 5
- :syntax-alist ((?@ . "w"))
+ :syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
)
"An alist of product specific configuration settings.
@@ -513,10 +529,11 @@ may be any one of the following:
:sqli-comint-func name of a function which accepts no
parameters that will use the values of
`sql-user', `sql-password',
- `sql-database' and `sql-server' to open a
- comint buffer and connect to the
- database. Do product specific
- configuration of comint in this function.
+ `sql-database', `sql-server' and
+ `sql-port' to open a comint buffer and
+ connect to the database. Do product
+ specific configuration of comint in this
+ function.
:list-all Command string or function which produces
a listing of all objects in the database.
@@ -535,6 +552,20 @@ may be any one of the following:
produces the standard list and the cdr
produces an enhanced list.
+ :completion-object A function that returns a list of
+ objects. Called with a single
+ parameter--if nil then list objects
+ accessible in the current schema, if
+ not-nil it is the name of a schema whose
+ objects should be listed.
+
+ :completion-column A function that returns a list of
+ columns. Called with a single
+ parameter--if nil then list objects
+ accessible in the current schema, if
+ not-nil it is the name of a schema whose
+ objects should be listed.
+
:prompt-regexp regular expression string that matches
the prompt issued by the product
interpreter.
@@ -555,6 +586,9 @@ may be any one of the following:
filtered string. May also be a list of
such functions.
+ :statement name of a variable containing a regexp that
+ matches the beginning of SQL statements.
+
:terminator the terminator to be sent after a
`sql-send-string', `sql-send-region',
`sql-send-paragraph' and
@@ -574,7 +608,7 @@ using `sql-get-product-feature' to lookup the product specific
settings.")
(defvar sql-indirect-features
- '(:font-lock :sqli-program :sqli-options :sqli-login))
+ '(:font-lock :sqli-program :sqli-options :sqli-login :statement))
(defcustom sql-connection-alist nil
"An alist of connection parameters for interacting with a SQL
@@ -683,6 +717,13 @@ it automatically."
:version "22.2"
:group 'SQL)
+(defvar sql-contains-names nil
+ "When non-nil, the current buffer contains database names.
+
+Globally should be set to nil; it will be non-nil in `sql-mode',
+`sql-interactive-mode' and list all buffers.")
+
+
(defcustom sql-pop-to-buffer-after-send-region nil
"When non-nil, pop to the buffer SQL statements are sent to.
@@ -770,6 +811,19 @@ is changed."
:type 'hook
:group 'SQL)
+;; Customization for ANSI
+
+(defcustom sql-ansi-statement-starters (regexp-opt '(
+ "create" "alter" "drop"
+ "select" "insert" "update" "delete" "merge"
+ "grant" "revoke"
+))
+ "Regexp of keywords that start SQL commands
+
+All products share this list; products should define a regexp to
+identify additional keywords in a variable defined by
+the :statement feature.")
+
;; Customization for Oracle
(defcustom sql-oracle-program "sqlplus"
@@ -795,18 +849,22 @@ 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-scan-on t
"Non-nil if placeholders should be replaced in Oracle SQLi.
When non-nil, Emacs will scan text sent to sqlplus and prompt
for replacement text for & placeholders as sqlplus does. This
-is needed on Windows where sqlplus output is buffered and the
+is needed on Windows where SQL*Plus output is buffered and the
prompts are not shown until after the text is entered.
-You will probably want to issue the following command in sqlplus
-to be safe:
+You need to issue the following command in SQL*Plus to be safe:
+
+ SET DEFINE OFF
- SET SCAN OFF"
+In older versions of SQL*Plus, this was the SET SCAN OFF command."
:type 'boolean
:group 'SQL)
@@ -833,7 +891,7 @@ Starts `sql-interactive-mode' after doing some setup."
:version "24.1"
:group 'SQL)
-;; Customization for MySql
+;; Customization for MySQL
(defcustom sql-mysql-program "mysql"
"Command to start mysql by TcX.
@@ -851,7 +909,7 @@ on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
:group 'SQL)
(defcustom sql-mysql-login-params '(user password database server)
- "List of login parameters needed to connect to MySql."
+ "List of login parameters needed to connect to MySQL."
:type 'sql-login-params
:version "24.1"
:group 'SQL)
@@ -1085,13 +1143,13 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
Used by `sql-rename-buffer'.")
-(defun sql-buffer-live-p (buffer &optional product)
+(defun sql-buffer-live-p (buffer &optional product connection)
"Returns non-nil if the process associated with buffer is live.
BUFFER can be a buffer object or a buffer name. The buffer must
be a live buffer, have an running process attached to it, be in
-`sql-interactive-mode', and, if PRODUCT is specified, it's
-`sql-product' must match."
+`sql-interactive-mode', and, if PRODUCT or CONNECTION are
+specified, it's `sql-product' or `sql-connection' must match."
(when buffer
(setq buffer (get-buffer buffer))
@@ -1102,7 +1160,9 @@ be a live buffer, have an running process attached to it, be in
(with-current-buffer buffer
(and (derived-mode-p 'sql-interactive-mode)
(or (not product)
- (eq product sql-product)))))))
+ (eq product sql-product))
+ (or (not connection)
+ (eq connection sql-connection)))))))
;; Keymap for sql-interactive-mode.
@@ -1136,6 +1196,8 @@ Based on `comint-mode-map'.")
(define-key map (kbd "C-c C-i") 'sql-product-interactive)
(define-key map (kbd "C-c C-l a") 'sql-list-all)
(define-key map (kbd "C-c C-l t") 'sql-list-table)
+ (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement)
+ (define-key map [remap end-of-defun] 'sql-end-of-statement)
map)
"Mode map used for `sql-mode'.")
@@ -1151,8 +1213,10 @@ Based on `comint-mode-map'.")
["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)]
["Send String" sql-send-string (sql-buffer-live-p sql-buffer)]
"--"
- ["List all objects" sql-list-all (sql-buffer-live-p sql-buffer)]
- ["List table details" sql-list-table (sql-buffer-live-p sql-buffer)]
+ ["List all objects" sql-list-all (and (sql-buffer-live-p sql-buffer)
+ (sql-get-product-feature sql-product :list-all))]
+ ["List table details" sql-list-table (and (sql-buffer-live-p sql-buffer)
+ (sql-get-product-feature sql-product :list-table))]
"--"
["Start SQLi session" sql-product-interactive
:visible (not sql-connection-alist)
@@ -1194,8 +1258,8 @@ Based on `comint-mode-map'.")
["Rename Buffer" sql-rename-buffer t]
["Save Connection" sql-save-connection (not sql-connection)]
"--"
- ["List all objects" sql-list-all t]
- ["List table details" sql-list-table t]))
+ ["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.
@@ -1207,13 +1271,13 @@ Based on `comint-mode-map'.")
(mapc
;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev.
- '(lambda (abbrev)
- (let ((name (car abbrev))
- (expansion (cdr abbrev)))
- (condition-case nil
- (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)
- (error
- (define-abbrev sql-mode-abbrev-table name expansion)))))
+ (lambda (abbrev)
+ (let ((name (car abbrev))
+ (expansion (cdr abbrev)))
+ (condition-case nil
+ (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)
+ (error
+ (define-abbrev sql-mode-abbrev-table name expansion)))))
'(("ins" . "insert")
("upd" . "update")
("del" . "delete")
@@ -1238,8 +1302,9 @@ Based on `comint-mode-map'.")
(modify-syntax-entry ?' "\"" table)
;; double quotes (") don't delimit strings
(modify-syntax-entry ?\" "." table)
- ;; backslash is no escape character
- (modify-syntax-entry ?\\ "." table)
+ ;; Make these all punctuation
+ (mapc (lambda (c) (modify-syntax-entry c "." table))
+ (string-to-list "!#$%&+,.:;<=>?@\\|"))
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
@@ -1298,20 +1363,45 @@ statement. The format of variable should be a valid
;; Remove keywords that are defined in ANSI
(setq kwd keywords)
- (dolist (k keywords)
- (catch 'next
- (dolist (a sql-mode-ansi-font-lock-keywords)
- (when (and (eq face (cdr a))
- (eq (string-match (car a) k 0) 0)
- (eq (match-end 0) (length k)))
- (setq kwd (delq k kwd))
- (throw 'next nil)))))
+ ;; (dolist (k keywords)
+ ;; (catch 'next
+ ;; (dolist (a sql-mode-ansi-font-lock-keywords)
+ ;; (when (and (eq face (cdr a))
+ ;; (eq (string-match (car a) k 0) 0)
+ ;; (eq (match-end 0) (length k)))
+ ;; (setq kwd (delq k kwd))
+ ;; (throw 'next nil)))))
;; Create a properly formed font-lock-keywords item
(cons (concat (car bdy)
(regexp-opt kwd t)
(cdr bdy))
- face))))
+ face)))
+
+ (defun sql-regexp-abbrev (keyword)
+ (let ((brk (string-match "[~]" keyword))
+ (len (length keyword))
+ (sep "\\(?:")
+ re i)
+ (if (not brk)
+ keyword
+ (setq re (substring keyword 0 brk)
+ i (+ 2 brk)
+ brk (1+ brk))
+ (while (<= i len)
+ (setq re (concat re sep (substring keyword brk i))
+ sep "\\|"
+ i (1+ i)))
+ (concat re "\\)?"))))
+
+ (defun sql-regexp-abbrev-list (&rest keyw-list)
+ (let ((re nil)
+ (sep "\\<\\(?:"))
+ (while keyw-list
+ (setq re (concat re sep (sql-regexp-abbrev (car keyw-list)))
+ sep "\\|"
+ keyw-list (cdr keyw-list)))
+ (concat re "\\)\\>"))))
(eval-when-compile
(setq sql-mode-ansi-font-lock-keywords
@@ -1346,6 +1436,7 @@ statement. The format of variable should be a valid
"user_defined_type_catalog" "user_defined_type_name"
"user_defined_type_schema"
)
+
;; ANSI Reserved keywords
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
"absolute" "action" "add" "admin" "after" "aggregate" "alias" "all"
@@ -1395,6 +1486,7 @@ statement. The format of variable should be a valid
"substring" "sum" "system_user" "translate" "treat" "trim" "upper"
"user"
)
+
;; ANSI Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
"array" "binary" "bit" "blob" "boolean" "char" "character" "clob"
@@ -1414,86 +1506,142 @@ function `regexp-opt'. Therefore, take a look at the source before
you define your own `sql-mode-ansi-font-lock-keywords'. You may want
to add functions and PL/SQL keywords.")
+(defun sql-oracle-show-reserved-words ()
+ ;; This function is for use by the maintainer of SQL.EL only.
+ (interactive)
+ (if (or (and (not (derived-mode-p 'sql-mode))
+ (not (derived-mode-p 'sql-interactive-mode)))
+ (not sql-buffer)
+ (not (eq sql-product 'oracle)))
+ (error "Not an Oracle buffer")
+
+ (let ((b "*RESERVED WORDS*"))
+ (sql-execute sql-buffer b
+ (concat "SELECT "
+ " keyword "
+ ", reserved AS \"Res\" "
+ ", res_type AS \"Type\" "
+ ", res_attr AS \"Attr\" "
+ ", res_semi AS \"Semi\" "
+ ", duplicate AS \"Dup\" "
+ "FROM V$RESERVED_WORDS "
+ "WHERE length > 1 "
+ "AND SUBSTR(keyword, 1, 1) BETWEEN 'A' AND 'Z' "
+ "ORDER BY 2 DESC, 3 DESC, 4 DESC, 5 DESC, 6 DESC, 1;")
+ nil nil)
+ (with-current-buffer b
+ (set (make-local-variable 'sql-product) 'oracle)
+ (sql-product-font-lock t nil)
+ (font-lock-mode +1)))))
+
(defvar sql-mode-oracle-font-lock-keywords
(eval-when-compile
(list
;; Oracle SQL*Plus Commands
- (cons
- (concat
- "^\\s-*\\(?:\\(?:" (regexp-opt '(
-"@" "@@" "accept" "append" "archive" "attribute" "break"
-"btitle" "change" "clear" "column" "connect" "copy" "define"
-"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
-"host" "input" "list" "password" "pause" "print" "prompt" "recover"
-"remark" "repfooter" "repheader" "run" "save" "show" "shutdown"
-"spool" "start" "startup" "store" "timing" "ttitle" "undefine"
-"variable" "whenever"
-) t)
+ ;; Only recognized in they start in column 1 and the
+ ;; abbreviation is followed by a space or the end of line.
- "\\)\\|"
- "\\(?:compute\\s-+\\(?:avg\\|cou\\|min\\|max\\|num\\|sum\\|std\\|var\\)\\)\\|"
- "\\(?:set\\s-+\\("
-
- (regexp-opt
- '("appi" "appinfo" "array" "arraysize" "auto" "autocommit"
- "autop" "autoprint" "autorecovery" "autot" "autotrace" "blo"
- "blockterminator" "buffer" "closecursor" "cmds" "cmdsep"
- "colsep" "com" "compatibility" "con" "concat" "constraint"
- "constraints" "copyc" "copycommit" "copytypecheck" "database"
- "def" "define" "document" "echo" "editf" "editfile" "emb"
- "embedded" "esc" "escape" "feed" "feedback" "flagger" "flu"
- "flush" "hea" "heading" "heads" "headsep" "instance" "lin"
- "linesize" "lobof" "loboffset" "logsource" "long" "longc"
- "longchunksize" "maxdata" "newp" "newpage" "null" "num"
- "numf" "numformat" "numwidth" "pages" "pagesize" "pau"
- "pause" "recsep" "recsepchar" "role" "scan" "serveroutput"
- "shift" "shiftinout" "show" "showmode" "space" "sqlbl"
- "sqlblanklines" "sqlc" "sqlcase" "sqlco" "sqlcontinue" "sqln"
- "sqlnumber" "sqlp" "sqlpluscompat" "sqlpluscompatibility"
- "sqlpre" "sqlprefix" "sqlprompt" "sqlt" "sqlterminator"
- "statement_id" "suf" "suffix" "tab" "term" "termout" "ti"
- "time" "timi" "timing" "transaction" "trim" "trimout" "trims"
- "trimspool" "truncate" "und" "underline" "ver" "verify" "wra"
- "wrap")) "\\)\\)"
-
- "\\)\\b.*"
- )
- 'font-lock-doc-face)
- '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face)
+ "\\|"
+ (list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$")
+ 0 'font-lock-comment-face t)
+
+ (list
+ (concat
+ "^\\(?:"
+ (sql-regexp-abbrev-list
+ "[@]\\{1,2\\}" "acc~ept" "a~ppend" "archive" "attribute"
+ "bre~ak" "bti~tle" "c~hange" "cl~ear" "col~umn" "conn~ect"
+ "copy" "def~ine" "del" "desc~ribe" "disc~onnect" "ed~it"
+ "exec~ute" "exit" "get" "help" "ho~st" "[$]" "i~nput" "l~ist"
+ "passw~ord" "pau~se" "pri~nt" "pro~mpt" "quit" "recover"
+ "repf~ooter" "reph~eader" "r~un" "sav~e" "sho~w" "shutdown"
+ "spo~ol" "sta~rt" "startup" "store" "tim~ing" "tti~tle"
+ "undef~ine" "var~iable" "whenever")
+ "\\|"
+ (concat "\\(?:"
+ (sql-regexp-abbrev "comp~ute")
+ "\\s-+"
+ (sql-regexp-abbrev-list
+ "avg" "cou~nt" "min~imum" "max~imum" "num~ber" "sum"
+ "std" "var~iance")
+ "\\)")
+ "\\|"
+ (concat "\\(?:set\\s-+"
+ (sql-regexp-abbrev-list
+ "appi~nfo" "array~size" "auto~commit" "autop~rint"
+ "autorecovery" "autot~race" "blo~ckterminator"
+ "cmds~ep" "colsep" "com~patibility" "con~cat"
+ "copyc~ommit" "copytypecheck" "def~ine" "describe"
+ "echo" "editf~ile" "emb~edded" "esc~ape" "feed~back"
+ "flagger" "flu~sh" "hea~ding" "heads~ep" "instance"
+ "lin~esize" "lobof~fset" "long" "longc~hunksize"
+ "mark~up" "newp~age" "null" "numf~ormat" "num~width"
+ "pages~ize" "pau~se" "recsep" "recsepchar"
+ "scan" "serverout~put" "shift~inout" "show~mode"
+ "sqlbl~anklines" "sqlc~ase" "sqlco~ntinue"
+ "sqln~umber" "sqlpluscompat~ibility" "sqlpre~fix"
+ "sqlp~rompt" "sqlt~erminator" "suf~fix" "tab"
+ "term~out" "ti~me" "timi~ng" "trim~out" "trims~pool"
+ "und~erline" "ver~ify" "wra~p")
+ "\\)")
+
+ "\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$")
+ 0 'font-lock-doc-face t)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
-"abs" "acos" "add_months" "ascii" "asciistr" "asin" "atan" "atan2"
-"avg" "bfilename" "bin_to_num" "bitand" "cast" "ceil" "chartorowid"
-"chr" "coalesce" "compose" "concat" "convert" "corr" "cos" "cosh"
-"count" "covar_pop" "covar_samp" "cume_dist" "current_date"
-"current_timestamp" "current_user" "dbtimezone" "decode" "decompose"
-"dense_rank" "depth" "deref" "dump" "empty_clob" "existsnode" "exp"
-"extract" "extractvalue" "first" "first_value" "floor" "following"
-"from_tz" "greatest" "group_id" "grouping_id" "hextoraw" "initcap"
-"instr" "lag" "last" "last_day" "last_value" "lead" "least" "length"
-"ln" "localtimestamp" "lower" "lpad" "ltrim" "make_ref" "max" "min"
-"mod" "months_between" "new_time" "next_day" "nls_charset_decl_len"
+"abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin"
+"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"
+"corr_k" "corr_s" "cos" "cosh" "count" "covar_pop" "covar_samp"
+"cube_table" "cume_dist" "currrent_date" "currrent_timestamp" "cv"
+"dataobj_to_partition" "dbtimezone" "decode" "decompose" "deletexml"
+"dense_rank" "depth" "deref" "dump" "empty_blob" "empty_clob"
+"existsnode" "exp" "extract" "extractvalue" "feature_id" "feature_set"
+"feature_value" "first" "first_value" "floor" "from_tz" "greatest"
+"grouping" "grouping_id" "group_id" "hextoraw" "initcap"
+"insertchildxml" "insertchildxmlafter" "insertchildxmlbefore"
+"insertxmlafter" "insertxmlbefore" "instr" "instr2" "instr4" "instrb"
+"instrc" "iteration_number" "lag" "last" "last_day" "last_value"
+"lead" "least" "length" "length2" "length4" "lengthb" "lengthc"
+"listagg" "ln" "lnnvl" "localtimestamp" "log" "lower" "lpad" "ltrim"
+"make_ref" "max" "median" "min" "mod" "months_between" "nanvl" "nchr"
+"new_time" "next_day" "nlssort" "nls_charset_decl_len"
"nls_charset_id" "nls_charset_name" "nls_initcap" "nls_lower"
-"nls_upper" "nlssort" "ntile" "nullif" "numtodsinterval"
-"numtoyminterval" "nvl" "nvl2" "over" "path" "percent_rank"
-"percentile_cont" "percentile_disc" "power" "preceding" "rank"
-"ratio_to_report" "rawtohex" "rawtonhex" "reftohex" "regr_"
-"regr_avgx" "regr_avgy" "regr_count" "regr_intercept" "regr_r2"
-"regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "replace" "round"
-"row_number" "rowidtochar" "rowidtonchar" "rpad" "rtrim"
-"sessiontimezone" "sign" "sin" "sinh" "soundex" "sqrt" "stddev"
-"stddev_pop" "stddev_samp" "substr" "sum" "sys_connect_by_path"
-"sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid"
-"sys_xmlagg" "sys_xmlgen" "sysdate" "systimestamp" "tan" "tanh"
+"nls_upper" "nth_value" "ntile" "nullif" "numtodsinterval"
+"numtoyminterval" "nvl" "nvl2" "ora_dst_affected" "ora_dst_convert"
+"ora_dst_error" "ora_hash" "path" "percentile_cont" "percentile_disc"
+"percent_rank" "power" "powermultiset" "powermultiset_by_cardinality"
+"prediction" "prediction_bounds" "prediction_cost"
+"prediction_details" "prediction_probability" "prediction_set"
+"presentnnv" "presentv" "previous" "rank" "ratio_to_report" "rawtohex"
+"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr"
+"regexp_replace" "regexp_substr" "regr_avgx" "regr_avgy" "regr_count"
+"regr_intercept" "regr_r2" "regr_slope" "regr_sxx" "regr_sxy"
+"regr_syy" "remainder" "replace" "round" "rowidtochar" "rowidtonchar"
+"row_number" "rpad" "rtrim" "scn_to_timestamp" "sessiontimezone" "set"
+"sign" "sin" "sinh" "soundex" "sqrt" "stats_binomial_test"
+"stats_crosstab" "stats_f_test" "stats_ks_test" "stats_mode"
+"stats_mw_test" "stats_one_way_anova" "stats_t_test_indep"
+"stats_t_test_indepu" "stats_t_test_one" "stats_t_test_paired"
+"stats_wsr_test" "stddev" "stddev_pop" "stddev_samp" "substr"
+"substr2" "substr4" "substrb" "substrc" "sum" "sysdate" "systimestamp"
+"sys_connect_by_path" "sys_context" "sys_dburigen" "sys_extract_utc"
+"sys_guid" "sys_typeid" "sys_xmlagg" "sys_xmlgen" "tan" "tanh"
+"timestamp_to_scn" "to_binary_double" "to_binary_float" "to_blob"
"to_char" "to_clob" "to_date" "to_dsinterval" "to_lob" "to_multi_byte"
"to_nchar" "to_nclob" "to_number" "to_single_byte" "to_timestamp"
"to_timestamp_tz" "to_yminterval" "translate" "treat" "trim" "trunc"
-"tz_offset" "uid" "unbounded" "unistr" "updatexml" "upper" "user"
-"userenv" "var_pop" "var_samp" "variance" "vsize" "width_bucket" "xml"
-"xmlagg" "xmlattribute" "xmlcolattval" "xmlconcat" "xmlelement"
-"xmlforest" "xmlsequence" "xmltransform"
+"tz_offset" "uid" "unistr" "updatexml" "upper" "user" "userenv"
+"value" "variance" "var_pop" "var_samp" "vsize" "width_bucket"
+"xmlagg" "xmlcast" "xmlcdata" "xmlcolattval" "xmlcomment" "xmlconcat"
+"xmldiff" "xmlelement" "xmlexists" "xmlforest" "xmlisvalid" "xmlparse"
+"xmlpatch" "xmlpi" "xmlquery" "xmlroot" "xmlsequence" "xmlserialize"
+"xmltable" "xmltransform"
)
+
+ ;; See the table V$RESERVED_WORDS
;; Oracle Keywords
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
"abort" "access" "accessed" "account" "activate" "add" "admin"
@@ -1582,52 +1730,120 @@ to add functions and PL/SQL keywords.")
"varray" "version" "view" "wait" "when" "whenever" "where" "with"
"without" "wnds" "wnps" "work" "write" "xmldata" "xmlschema" "xmltype"
)
+
;; Oracle Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
-"bfile" "blob" "byte" "char" "character" "clob" "date" "dec" "decimal"
-"double" "float" "int" "integer" "interval" "long" "national" "nchar"
-"nclob" "number" "numeric" "nvarchar2" "precision" "raw" "real"
-"rowid" "second" "smallint" "time" "timestamp" "urowid" "varchar"
-"varchar2" "varying" "year" "zone"
+"bfile" "binary_double" "binary_float" "blob" "byte" "char" "charbyte"
+"clob" "date" "day" "float" "interval" "local" "long" "longraw"
+"minute" "month" "nchar" "nclob" "number" "nvarchar2" "raw" "rowid" "second"
+"time" "timestamp" "urowid" "varchar2" "with" "year" "zone"
)
;; Oracle PL/SQL Attributes
- (sql-font-lock-keywords-builder 'font-lock-builtin-face '("" . "\\b")
-"%bulk_rowcount" "%found" "%isopen" "%notfound" "%rowcount" "%rowtype"
-"%type"
+ (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
+"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
+"rowcount" "rowtype" "type"
)
;; Oracle PL/SQL Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
-"extend" "prior"
+"delete" "trim" "extend" "exists" "first" "last" "count" "limit"
+"prior" "next"
+)
+
+ ;; Oracle PL/SQL Reserved words
+ (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
+"all" "alter" "and" "any" "as" "asc" "at" "begin" "between" "by"
+"case" "check" "clusters" "cluster" "colauth" "columns" "compress"
+"connect" "crash" "create" "cursor" "declare" "default" "desc"
+"distinct" "drop" "else" "end" "exception" "exclusive" "fetch" "for"
+"from" "function" "goto" "grant" "group" "having" "identified" "if"
+"in" "index" "indexes" "insert" "intersect" "into" "is" "like" "lock"
+"minus" "mode" "nocompress" "not" "nowait" "null" "of" "on" "option"
+"or" "order" "overlaps" "procedure" "public" "resource" "revoke"
+"select" "share" "size" "sql" "start" "subtype" "tabauth" "table"
+"then" "to" "type" "union" "unique" "update" "values" "view" "views"
+"when" "where" "with"
+
+"true" "false"
+"raise_application_error"
)
;; Oracle PL/SQL Keywords
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"autonomous_transaction" "bulk" "char_base" "collect" "constant"
-"cursor" "declare" "do" "elsif" "exception_init" "execute" "exit"
-"extends" "false" "fetch" "forall" "goto" "hour" "if" "interface"
-"loop" "minute" "number_base" "ocirowid" "opaque" "others" "rowtype"
-"separate" "serially_reusable" "sql" "sqlcode" "sqlerrm" "subtype"
-"the" "timezone_abbr" "timezone_hour" "timezone_minute"
-"timezone_region" "true" "varrying" "while"
+"a" "add" "agent" "aggregate" "array" "attribute" "authid" "avg"
+"bfile_base" "binary" "blob_base" "block" "body" "both" "bound" "bulk"
+"byte" "c" "call" "calling" "cascade" "char" "char_base" "character"
+"charset" "charsetform" "charsetid" "clob_base" "close" "collect"
+"comment" "commit" "committed" "compiled" "constant" "constructor"
+"context" "continue" "convert" "count" "current" "customdatum"
+"dangling" "data" "date" "date_base" "day" "define" "delete"
+"deterministic" "double" "duration" "element" "elsif" "empty" "escape"
+"except" "exceptions" "execute" "exists" "exit" "external" "final"
+"fixed" "float" "forall" "force" "general" "hash" "heap" "hidden"
+"hour" "immediate" "including" "indicator" "indices" "infinite"
+"instantiable" "int" "interface" "interval" "invalidate" "isolation"
+"java" "language" "large" "leading" "length" "level" "library" "like2"
+"like4" "likec" "limit" "limited" "local" "long" "loop" "map" "max"
+"maxlen" "member" "merge" "min" "minute" "mod" "modify" "month"
+"multiset" "name" "nan" "national" "native" "nchar" "new" "nocopy"
+"number_base" "object" "ocicoll" "ocidate" "ocidatetime" "ociduration"
+"ociinterval" "ociloblocator" "ocinumber" "ociraw" "ociref"
+"ocirefcursor" "ocirowid" "ocistring" "ocitype" "old" "only" "opaque"
+"open" "operator" "oracle" "oradata" "organization" "orlany" "orlvary"
+"others" "out" "overriding" "package" "parallel_enable" "parameter"
+"parameters" "parent" "partition" "pascal" "pipe" "pipelined" "pragma"
+"precision" "prior" "private" "raise" "range" "raw" "read" "record"
+"ref" "reference" "relies_on" "rem" "remainder" "rename" "result"
+"result_cache" "return" "returning" "reverse" "rollback" "row"
+"sample" "save" "savepoint" "sb1" "sb2" "sb4" "second" "segment"
+"self" "separate" "sequence" "serializable" "set" "short" "size_t"
+"some" "sparse" "sqlcode" "sqldata" "sqlname" "sqlstate" "standard"
+"static" "stddev" "stored" "string" "struct" "style" "submultiset"
+"subpartition" "substitutable" "sum" "synonym" "tdo" "the" "time"
+"timestamp" "timezone_abbr" "timezone_hour" "timezone_minute"
+"timezone_region" "trailing" "transaction" "transactional" "trusted"
+"ub1" "ub2" "ub4" "under" "unsigned" "untrusted" "use" "using"
+"valist" "value" "variable" "variance" "varray" "varying" "void"
+"while" "work" "wrapped" "write" "year" "zone"
+;; Pragma
+"autonomous_transaction" "exception_init" "inline"
+"restrict_references" "serially_reusable"
)
;; Oracle PL/SQL Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
-"binary_integer" "boolean" "naturaln" "pls_integer" "positive"
-"positiven" "record" "signtype" "string"
+"\"BINARY LARGE OBJECT\"" "\"CHAR LARGE OBJECT\"" "\"CHAR VARYING\""
+"\"CHARACTER LARGE OBJECT\"" "\"CHARACTER VARYING\""
+"\"DOUBLE PRECISION\"" "\"INTERVAL DAY TO SECOND\""
+"\"INTERVAL YEAR TO MONTH\"" "\"LONG RAW\"" "\"NATIONAL CHAR\""
+"\"NATIONAL CHARACTER LARGE OBJECT\"" "\"NATIONAL CHARACTER\""
+"\"NCHAR LARGE OBJECT\"" "\"NCHAR\"" "\"NCLOB\"" "\"NVARCHAR2\""
+"\"TIME WITH TIME ZONE\"" "\"TIMESTAMP WITH LOCAL TIME ZONE\""
+"\"TIMESTAMP WITH TIME ZONE\""
+"bfile" "bfile_base" "binary_double" "binary_float" "binary_integer"
+"blob" "blob_base" "boolean" "char" "character" "char_base" "clob"
+"clob_base" "cursor" "date" "day" "dec" "decimal"
+"dsinterval_unconstrained" "float" "int" "integer" "interval" "local"
+"long" "mlslabel" "month" "natural" "naturaln" "nchar_cs" "number"
+"number_base" "numeric" "pls_integer" "positive" "positiven" "raw"
+"real" "ref" "rowid" "second" "signtype" "simple_double"
+"simple_float" "simple_integer" "smallint" "string" "time" "timestamp"
+"timestamp_ltz_unconstrained" "timestamp_tz_unconstrained"
+"timestamp_unconstrained" "time_tz_unconstrained" "time_unconstrained"
+"to" "urowid" "varchar" "varchar2" "with" "year"
+"yminterval_unconstrained" "zone"
)
;; Oracle PL/SQL Exceptions
(sql-font-lock-keywords-builder 'font-lock-warning-face nil
"access_into_null" "case_not_found" "collection_is_null"
"cursor_already_open" "dup_val_on_index" "invalid_cursor"
-"invalid_number" "login_denied" "no_data_found" "not_logged_on"
-"program_error" "rowtype_mismatch" "self_is_null" "storage_error"
-"subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid"
-"timeout_on_resource" "too_many_rows" "value_error" "zero_divide"
-"exception" "notfound"
+"invalid_number" "login_denied" "no_data_found" "no_data_needed"
+"not_logged_on" "program_error" "rowtype_mismatch" "self_is_null"
+"storage_error" "subscript_beyond_count" "subscript_outside_limit"
+"sys_invalid_rowid" "timeout_on_resource" "too_many_rows"
+"value_error" "zero_divide"
)))
"Oracle SQL keywords used by font-lock.
@@ -2296,10 +2512,7 @@ also be configured."
(let
;; Get the product-specific syntax-alist.
- ((syntax-alist
- (append
- (sql-get-product-feature sql-product :syntax-alist)
- '((?_ . "w") (?. . "w")))))
+ ((syntax-alist (sql-product-font-lock-syntax-alist)))
;; Get the product-specific keywords.
(set (make-local-variable 'sql-mode-font-lock-keywords)
@@ -2388,9 +2601,30 @@ adds a fontification pattern to fontify identifiers ending in
;;; Functions to switch highlighting
+(defun sql-product-syntax-table ()
+ (let ((table (copy-syntax-table sql-mode-syntax-table)))
+ (mapc (lambda (entry)
+ (modify-syntax-entry (car entry) (cdr entry) table))
+ (sql-get-product-feature sql-product :syntax-alist))
+ table))
+
+(defun sql-product-font-lock-syntax-alist ()
+ (append
+ ;; Change all symbol character to word characters
+ (mapcar
+ (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
+ (cons (car entry)
+ (concat "w" (substring (cdr entry) 1)))
+ entry))
+ (sql-get-product-feature sql-product :syntax-alist))
+ '((?_ . "w"))))
+
(defun sql-highlight-product ()
"Turn on the font highlighting for the SQL product selected."
(when (derived-mode-p 'sql-mode)
+ ;; Enhance the syntax table for the product
+ (set-syntax-table (sql-product-syntax-table))
+
;; Setup font-lock
(sql-product-font-lock nil t)
@@ -2418,11 +2652,77 @@ adds a fontification pattern to fontify identifiers ending in
;; comint-line-beginning-position is defined in Emacs 21
(defun comint-line-beginning-position ()
"Return the buffer position of the beginning of the line, after any prompt.
-The prompt is assumed to be any text at the beginning of the line matching
-the regular expression `comint-prompt-regexp', a buffer local variable."
+The prompt is assumed to be any text at the beginning of the line
+matching the regular expression `comint-prompt-regexp', a buffer
+local variable."
(save-excursion (comint-bol nil) (point))))
-
+;;; Motion Functions
+
+(defun sql-statement-regexp (prod)
+ (let* ((ansi-stmt (sql-get-product-feature 'ansi :statement))
+ (prod-stmt (sql-get-product-feature prod :statement)))
+ (concat "^\\<"
+ (if prod-stmt
+ ansi-stmt
+ (concat "\\(" ansi-stmt "\\|" prod-stmt "\\)"))
+ "\\>")))
+
+(defun sql-beginning-of-statement (arg)
+ "Moves the cursor to the beginning of the current SQL statement."
+ (interactive "p")
+
+ (let ((here (point))
+ (regexp (sql-statement-regexp sql-product))
+ last next)
+
+ ;; Go to the end of the statement before the start we desire
+ (setq last (or (sql-end-of-statement (- arg))
+ (point-min)))
+ ;; And find the end after that
+ (setq next (or (sql-end-of-statement 1)
+ (point-max)))
+
+ ;; Our start must be between them
+ (goto-char last)
+ ;; Find an beginning-of-stmt that's not in a comment
+ (while (and (re-search-forward regexp next t 1)
+ (nth 7 (syntax-ppss)))
+ (goto-char (match-end 0)))
+ (goto-char
+ (if (match-data)
+ (match-beginning 0)
+ last))
+ (beginning-of-line)
+ ;; If we didn't move, try again
+ (when (= here (point))
+ (sql-beginning-of-statement (* 2 (sql-signum arg))))))
+
+(defun sql-end-of-statement (arg)
+ "Moves the cursor to the end of the current SQL statement."
+ (interactive "p")
+ (let ((term (sql-get-product-feature sql-product :terminator))
+ (re-search (if (> 0 arg) 're-search-backward 're-search-forward))
+ (here (point))
+ (n 0))
+ (when (consp term)
+ (setq term (car term)))
+ ;; Iterate until we've moved the desired number of stmt ends
+ (while (not (= (sql-signum arg) 0))
+ ;; if we're looking at the terminator, jump by 2
+ (if (or (and (> 0 arg) (looking-back term))
+ (and (< 0 arg) (looking-at term)))
+ (setq n 2)
+ (setq n 1))
+ ;; If we found another end-of-stmt
+ (if (not (apply re-search term nil t n nil))
+ (setq arg 0)
+ ;; count it if we're not in a comment
+ (unless (nth 7 (syntax-ppss))
+ (setq arg (- arg (sql-signum arg))))))
+ (goto-char (if (match-data)
+ (match-end 0)
+ here))))
;;; Small functions
@@ -2456,7 +2756,7 @@ the regular expression `comint-prompt-regexp', a buffer local variable."
(defun sql-help-list-products (indent freep)
"Generate listing of products available for use under SQLi.
-List products with :free-softare attribute set to FREEP. Indent
+List products with :free-software attribute set to FREEP. Indent
each line with INDENT."
(let (sqli-func doc)
@@ -2649,7 +2949,7 @@ function like this: (sql-get-login 'user 'password 'database)."
nil (append '(:number t) plist)))))))
what))
-(defun sql-find-sqli-buffer (&optional product)
+(defun sql-find-sqli-buffer (&optional product connection)
"Returns the name of the current default SQLi buffer or nil.
In order to qualify, the SQLi buffer must be alive, be in
`sql-interactive-mode' and have a process."
@@ -2657,16 +2957,16 @@ In order to qualify, the SQLi buffer must be alive, be in
(prod (or product sql-product)))
(or
;; Current sql-buffer, if there is one.
- (and (sql-buffer-live-p buf prod)
+ (and (sql-buffer-live-p buf prod connection)
buf)
;; Global sql-buffer
(and (setq buf (default-value 'sql-buffer))
- (sql-buffer-live-p buf prod)
+ (sql-buffer-live-p buf prod connection)
buf)
;; Look thru each buffer
(car (apply 'append
(mapcar (lambda (b)
- (and (sql-buffer-live-p b prod)
+ (and (sql-buffer-live-p b prod connection)
(list (buffer-name b))))
(buffer-list)))))))
@@ -2722,7 +3022,8 @@ If you call it from anywhere else, it sets the global copy of
This is the buffer SQL strings are sent to. It is stored in the
variable `sql-buffer'. See `sql-help' on how to create such a buffer."
(interactive)
- (if (null (buffer-live-p (get-buffer sql-buffer)))
+ (if (or (null sql-buffer)
+ (null (buffer-live-p (get-buffer sql-buffer))))
(message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
(if (null (get-buffer-process sql-buffer))
(message "Buffer %s has no process." sql-buffer)
@@ -2932,37 +3233,58 @@ Allows the suppression of continuation prompts.")
;;; Strip out continuation prompts
+(defvar sql-preoutput-hold nil)
+
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
Added to the `comint-preoutput-filter-functions' hook in a SQL
-interactive buffer. If `sql-outut-newline-count' is greater than
+interactive buffer. If `sql-output-newline-count' is greater than
zero, then an output line matching the continuation prompt is filtered
-out. If the count is one, then the prompt is replaced with a newline
-to force the output from the query to appear on a new line."
- (if (and sql-prompt-cont-regexp
- sql-output-newline-count
- (numberp sql-output-newline-count)
- (>= sql-output-newline-count 1))
- (progn
- (while (and oline
- sql-output-newline-count
- (> sql-output-newline-count 0)
- (string-match sql-prompt-cont-regexp oline))
-
- (setq oline
- (replace-match (if (and
- (= 1 sql-output-newline-count)
- sql-output-by-send)
- "\n" "")
- nil nil oline)
- sql-output-newline-count
- (1- sql-output-newline-count)))
- (if (= sql-output-newline-count 0)
- (setq sql-output-newline-count nil))
- (setq sql-output-by-send nil))
- (setq sql-output-newline-count nil))
- oline)
+out. If the count is zero, then a newline is inserted into the output
+to force the output from the query to appear on a new line.
+
+The complication to this filter is that the continuation prompts
+may arrive in multiple chunks. If they do, then the function
+saves any unfiltered output in a buffer and prepends that buffer
+to the next chunk to properly match the broken-up prompt.
+
+If the filter gets confused, it should reset and stop filtering
+to avoid deleting non-prompt output."
+
+ (let (did-filter)
+ (setq oline (concat (or sql-preoutput-hold "") oline)
+ sql-preoutput-hold nil)
+
+ (if (and comint-prompt-regexp
+ (integerp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ (progn
+ (while (and (not (string= oline ""))
+ (> sql-output-newline-count 0)
+ (string-match comint-prompt-regexp oline)
+ (= (match-beginning 0) 0))
+
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)
+ did-filter t))
+
+ (if (= sql-output-newline-count 0)
+ (setq sql-output-newline-count nil
+ oline (concat "\n" oline)
+ sql-output-by-send nil)
+
+ (setq sql-preoutput-hold oline
+ oline ""))
+
+ (unless did-filter
+ (setq oline (or sql-preoutput-hold "")
+ sql-preoutput-hold nil
+ sql-output-newline-count nil)))
+
+ (setq sql-output-newline-count nil))
+
+ oline))
;;; Sending the region to the SQLi buffer.
@@ -3066,16 +3388,35 @@ If given the optional parameter VALUE, sets
;;; Redirect output functions
-(defun sql-redirect (command combuf &optional outbuf save-prior)
+(defvar sql-debug-redirect nil
+ "If non-nil, display messages related to the use of redirection.")
+
+(defun sql-str-literal (s)
+ (concat "'" (replace-regexp-in-string "[']" "''" s) "'"))
+
+(defun sql-redirect (sqlbuf command &optional outbuf save-prior)
"Execute the SQL command and send output to OUTBUF.
-COMBUF must be an active SQL interactive buffer. OUTBUF may be
+SQLBUF must be an active SQL interactive buffer. OUTBUF may be
an existing buffer, or the name of a non-existing buffer. If
omitted the output is sent to a temporary buffer which will be
killed after the command completes. COMMAND should be a string
-of commands accepted by the SQLi program."
-
- (with-current-buffer combuf
+of commands accepted by the SQLi program. COMMAND may also be a
+list of SQLi command strings."
+
+ (let* ((visible (and outbuf
+ (not (string= " " (substring outbuf 0 1))))))
+ (when visible
+ (message "Executing SQL command..."))
+ (if (consp command)
+ (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
+ command)
+ (sql-redirect-one sqlbuf command outbuf save-prior))
+ (when visible
+ (message "Executing SQL command...done"))))
+
+(defun sql-redirect-one (sqlbuf command outbuf save-prior)
+ (with-current-buffer sqlbuf
(let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*")))
(proc (get-buffer-process (current-buffer)))
(comint-prompt-regexp (sql-get-product-feature sql-product
@@ -3090,12 +3431,13 @@ of commands accepted by the SQLi program."
(insert "\n"))
(setq start (point)))
+ (when sql-debug-redirect
+ (message ">>SQL> %S" command))
+
;; Run the command
- (message "Executing SQL command...")
(comint-redirect-send-command-to-process command buf proc nil t)
(while (null comint-redirect-completed)
(accept-process-output nil 1))
- (message "Executing SQL command...done")
;; Clean up the output results
(with-current-buffer buf
@@ -3107,12 +3449,16 @@ of commands accepted by the SQLi program."
(goto-char start)
(when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
(delete-region (match-beginning 0) (match-end 0)))
+ ;; Remove Ctrl-Ms
+ (goto-char start)
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
(goto-char start)))))
-(defun sql-redirect-value (command combuf regexp &optional regexp-groups)
+(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups)
"Execute the SQL command and return part of result.
-COMBUF must be an active SQL interactive buffer. COMMAND should
+SQLBUF must be an active SQL interactive buffer. COMMAND should
be a string of commands accepted by the SQLi program. From the
output, the REGEXP is repeatedly matched and the list of
REGEXP-GROUPS submatches is returned. This behaves much like
@@ -3122,18 +3468,19 @@ for each match."
(let ((outbuf " *SQL-Redirect-values*")
(results nil))
- (sql-redirect command combuf outbuf nil)
+ (sql-redirect sqlbuf command outbuf nil)
(with-current-buffer outbuf
(while (re-search-forward regexp nil t)
(push
(cond
;; no groups-return all of them
((null regexp-groups)
- (let ((i 1)
+ (let ((i (/ (length (match-data)) 2))
(r nil))
- (while (match-beginning i)
+ (while (> i 0)
+ (setq i (1- i))
(push (match-string i) r))
- (nreverse r)))
+ r))
;; one group specified
((numberp regexp-groups)
(match-string regexp-groups))
@@ -3152,10 +3499,14 @@ for each match."
(error "sql-redirect-value: unknown REGEXP-GROUPS value - %s"
regexp-groups)))
results)))
- (nreverse results)))
-(defun sql-execute (sqlbuf outbuf command arg)
- "Executes a command in a SQL interacive buffer and captures the output.
+ (when sql-debug-redirect
+ (message ">>SQL> = %S" (reverse results)))
+
+ (nreverse results)))
+
+(defun sql-execute (sqlbuf outbuf command enhanced arg)
+ "Executes a command in a SQL interactive buffer and captures the output.
The commands are run in SQLBUF and the output saved in OUTBUF.
COMMAND must be a string, a function or a list of such elements.
@@ -3168,9 +3519,9 @@ buffer is popped into a view window. "
(lambda (c)
(cond
((stringp c)
- (sql-redirect (if arg (format c arg) c) sqlbuf outbuf) t)
+ (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t)
((functionp c)
- (apply c sqlbuf outbuf arg))
+ (apply c sqlbuf outbuf enhanced arg nil))
(t (error "Unknown sql-execute item %s" c))))
(if (consp command) command (cons command nil)))
@@ -3197,14 +3548,92 @@ buffer is popped into a view window. "
(setq command (if enhanced
(cdr command)
(car command))))
- (sql-execute sqlbuf outbuf command arg)))
+ (sql-execute sqlbuf outbuf command enhanced arg)))
+
+(defvar sql-completion-object nil
+ "A list of database objects used for completion.
+
+The list is maintained in SQL interactive buffers.")
+
+(defvar sql-completion-column nil
+ "A list of column names used for completion.
+
+The list is maintained in SQL interactive buffers.")
+
+(defun sql-build-completions-1 (schema completion-list feature)
+ "Generate a list of objects in the database for use as completions."
+ (let ((f (sql-get-product-feature sql-product feature)))
+ (when f
+ (set completion-list
+ (let (cl)
+ (dolist (e (append (symbol-value completion-list)
+ (apply f (current-buffer) (cons schema nil)))
+ cl)
+ (unless (member e cl) (setq cl (cons e cl))))
+ (sort cl (function string<)))))))
+
+(defun sql-build-completions (schema)
+ "Generate a list of names in the database for use as completions."
+ (sql-build-completions-1 schema 'sql-completion-object :completion-object)
+ (sql-build-completions-1 schema 'sql-completion-column :completion-column))
+
+(defvar sql-completion-sqlbuf nil)
+
+(defun sql-try-completion (string collection &optional predicate)
+ (when sql-completion-sqlbuf
+ (with-current-buffer sql-completion-sqlbuf
+ (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string)
+ (downcase (match-string 1 string)))))
+
+ ;; If we haven't loaded any object name yet, load local schema
+ (unless sql-completion-object
+ (sql-build-completions nil))
+
+ ;; If they want another schema, load it if we haven't yet
+ (when schema
+ (let ((schema-dot (concat schema "."))
+ (schema-len (1+ (length schema)))
+ (names sql-completion-object)
+ has-schema)
+
+ (while (and (not has-schema) names)
+ (setq has-schema (and
+ (>= (length (car names)) schema-len)
+ (string= schema-dot
+ (downcase (substring (car names)
+ 0 schema-len))))
+ names (cdr names)))
+ (unless has-schema
+ (sql-build-completions schema)))))
+
+ ;; Try to find the completion
+ (cond
+ ((not predicate)
+ (try-completion string sql-completion-object))
+ ((eq predicate t)
+ (all-completions string sql-completion-object))
+ ((eq predicate 'lambda)
+ (test-completion string sql-completion-object))
+ ((eq (car predicate) 'boundaries)
+ (completion-boundaries string sql-completion-object nil (cdr predicate)))))))
(defun sql-read-table-name (prompt)
"Read the name of a database table."
- ;; TODO: Fetch table/view names from database and provide completion.
- ;; Also implement thing-at-point if the buffer has valid names in it
- ;; (i.e. sql-mode, sql-interactive-mode, or sql-list-all buffers)
- (read-from-minibuffer prompt))
+ (let* ((tname
+ (and (buffer-local-value 'sql-contains-names (current-buffer))
+ (thing-at-point-looking-at
+ (concat "\\_<\\sw\\(:?\\sw\\|\\s_\\)*"
+ "\\(?:[.]+\\sw\\(?:\\sw\\|\\s_\\)*\\)*\\_>"))
+ (buffer-substring-no-properties (match-beginning 0)
+ (match-end 0))))
+ (sql-completion-sqlbuf (sql-find-sqli-buffer))
+ (product (with-current-buffer sql-completion-sqlbuf sql-product))
+ (completion-ignore-case t))
+
+ (if (sql-get-product-feature product :completion-object)
+ (completing-read prompt (function sql-try-completion)
+ nil nil tname)
+ (read-from-minibuffer prompt tname))))
(defun sql-list-all (&optional enhanced)
"List all database objects."
@@ -3212,7 +3641,11 @@ buffer is popped into a view window. "
(let ((sqlbuf (sql-find-sqli-buffer)))
(unless sqlbuf
(error "No SQL interactive buffer found"))
- (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)))
+ (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
+ (with-current-buffer sqlbuf
+ ;; Contains the name of database objects
+ (set (make-local-variable 'sql-contains-names) t)
+ (set (make-local-variable 'sql-buffer) sqlbuf))))
(defun sql-list-table (name &optional enhanced)
"List the details of a database table. "
@@ -3226,7 +3659,6 @@ buffer is popped into a view window. "
(error "No table name specified"))
(sql-execute-feature sqlbuf (format "*List %s*" name)
:list-table enhanced name)))
-
;;; SQL mode -- uses SQL interactive mode
@@ -3277,6 +3709,8 @@ you must tell Emacs. Here's how to do that in your `~/.emacs' file:
(set (make-local-variable 'paragraph-start) "[\n\f]")
;; Abbrevs
(setq abbrev-all-caps 1)
+ ;; Contains the name of database objects
+ (set (make-local-variable 'sql-contains-names) t)
;; Catch changes to sql-product and highlight accordingly
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
@@ -3362,7 +3796,7 @@ you entered, right above the output it created.
sql-product))
;; Setup the mode.
- (setq major-mode 'sql-interactive-mode) ;FIXME: Use define-derived-mode.
+ (setq major-mode 'sql-interactive-mode)
(setq mode-name
(concat "SQLi[" (or (sql-get-product-feature sql-product :name)
(symbol-name sql-product)) "]"))
@@ -3385,9 +3819,18 @@ you entered, right above the output it created.
(setq abbrev-all-caps 1)
;; Exiting the process will call sql-stop.
(set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
- ;; Save the connection name
- (make-local-variable 'sql-connection)
- ;; Create a usefull name for renaming this buffer later.
+ ;; Save the connection and login params
+ (set (make-local-variable 'sql-user) sql-user)
+ (set (make-local-variable 'sql-database) sql-database)
+ (set (make-local-variable 'sql-server) sql-server)
+ (set (make-local-variable 'sql-port) sql-port)
+ (set (make-local-variable 'sql-connection) sql-connection)
+ ;; Contains the name of database objects
+ (set (make-local-variable 'sql-contains-names) t)
+ ;; Keep track of existing object names
+ (set (make-local-variable 'sql-completion-object) nil)
+ (set (make-local-variable 'sql-completion-column) nil)
+ ;; Create a useful name for renaming this buffer later.
(set (make-local-variable 'sql-alternate-buffer-name)
(sql-make-alternate-buffer-name))
;; User stuff. Initialize before the hook.
@@ -3398,6 +3841,7 @@ you entered, right above the output it created.
(set (make-local-variable 'sql-prompt-cont-regexp)
(sql-get-product-feature sql-product :prompt-cont-regexp))
(make-local-variable 'sql-output-newline-count)
+ (make-local-variable 'sql-preoutput-hold)
(make-local-variable 'sql-output-by-send)
(add-hook 'comint-preoutput-filter-functions
'sql-interactive-remove-continuation-prompt nil t)
@@ -3450,7 +3894,7 @@ Sentinels will always get the two parameters PROCESS and EVENT."
nil t initial 'sql-connection-history default)))
;;;###autoload
-(defun sql-connect (connection)
+(defun sql-connect (connection &optional new-name)
"Connect to an interactive session using CONNECTION settings.
See `sql-connection-alist' to see how to define connections and
@@ -3462,7 +3906,8 @@ is specified in the connection settings."
;; Prompt for the connection from those defined in the alist
(interactive
(if sql-connection-alist
- (list (sql-read-connection "Connection: " nil '(nil)))
+ (list (sql-read-connection "Connection: " nil '(nil))
+ current-prefix-arg)
nil))
;; Are there connections defined
@@ -3500,14 +3945,15 @@ is specified in the connection settings."
(unless (member token set-params)
(if plist
(cons token plist)
- token)))))
- ;; Remember the connection
- (sql-connection connection))
+ token))))))
;; Set the remaining parameters and start the
;; interactive session
- (eval `(let ((,param-var ',rem-params))
- (sql-product-interactive sql-product)))))
+ (eval `(let ((sql-connection ,connection)
+ (,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")
@@ -3521,39 +3967,51 @@ optionally is saved to the user's init file."
(interactive "sNew connection name: ")
- (if sql-connection
- (message "This session was started by a connection; it's already been saved.")
-
- (let ((login (sql-get-product-feature sql-product :sqli-login))
- (alist sql-connection-alist)
- connect)
-
- ;; Remove the existing connection if the user says so
- (when (and (assoc name alist)
- (yes-or-no-p (format "Replace connection definition <%s>? " name)))
- (setq alist (assq-delete-all name alist)))
-
- ;; Add the new connection if it doesn't exist
- (if (assoc name alist)
- (message "Connection <%s> already exists" name)
- (setq connect
- (append (list name)
- (sql-for-each-login
- `(product ,@login)
- (lambda (token _plist)
- (cond
- ((eq token 'product) `(sql-product ',sql-product))
- ((eq token 'user) `(sql-user ,sql-user))
- ((eq token 'database) `(sql-database ,sql-database))
- ((eq token 'server) `(sql-server ,sql-server))
- ((eq token 'port) `(sql-port ,sql-port)))))))
-
- (setq alist (append alist (list connect)))
-
- ;; confirm whether we want to save the connections
- (if (yes-or-no-p "Save the connections for future sessions? ")
- (customize-save-variable 'sql-connection-alist alist)
- (customize-set-variable 'sql-connection-alist alist))))))
+ (unless (derived-mode-p 'sql-interactive-mode)
+ (error "Not in a SQL interactive mode!"))
+
+ ;; Capture the buffer local settings
+ (let* ((buf (current-buffer))
+ (connection (buffer-local-value 'sql-connection buf))
+ (product (buffer-local-value 'sql-product buf))
+ (user (buffer-local-value 'sql-user buf))
+ (database (buffer-local-value 'sql-database buf))
+ (server (buffer-local-value 'sql-server buf))
+ (port (buffer-local-value 'sql-port buf)))
+
+ (if connection
+ (message "This session was started by a connection; it's already been saved.")
+
+ (let ((login (sql-get-product-feature product :sqli-login))
+ (alist sql-connection-alist)
+ connect)
+
+ ;; Remove the existing connection if the user says so
+ (when (and (assoc name alist)
+ (yes-or-no-p (format "Replace connection definition <%s>? " name)))
+ (setq alist (assq-delete-all name alist)))
+
+ ;; Add the new connection if it doesn't exist
+ (if (assoc name alist)
+ (message "Connection <%s> already exists" name)
+ (setq connect
+ (append (list name)
+ (sql-for-each-login
+ `(product ,@login)
+ (lambda (token _plist)
+ (cond
+ ((eq token 'product) `(sql-product ',product))
+ ((eq token 'user) `(sql-user ,user))
+ ((eq token 'database) `(sql-database ,database))
+ ((eq token 'server) `(sql-server ,server))
+ ((eq token 'port) `(sql-port ,port)))))))
+
+ (setq alist (append alist (list connect)))
+
+ ;; confirm whether we want to save the connections
+ (if (yes-or-no-p "Save the connections for future sessions? ")
+ (customize-save-variable 'sql-connection-alist alist)
+ (customize-set-variable 'sql-connection-alist alist)))))))
(defun sql-connection-menu-filter (tail)
"Generates menu entries for using each connection."
@@ -3561,7 +4019,10 @@ optionally is saved to the user's init file."
(mapcar
(lambda (conn)
(vector
- (format "Connection <%s>" (car conn))
+ (format "Connection <%s>\t%s" (car conn)
+ (let ((sql-user "") (sql-database "")
+ (sql-server "") (sql-port 0))
+ (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
(list 'sql-connect (car conn))
t))
sql-connection-alist)
@@ -3599,10 +4060,10 @@ the call to \\[sql-product-interactive] with
;; Get the value of product that we need
(setq product
(cond
- ((and product ; Product specified
- (symbolp product)) product)
((= (prefix-numeric-value product) 4) ; C-u, prompt for product
(sql-read-product "SQL product: " sql-product))
+ ((and product ; Product specified
+ (symbolp product)) product)
(t sql-product))) ; Default to sql-product
;; If we have a product and it has a interactive mode
@@ -3610,7 +4071,7 @@ the call to \\[sql-product-interactive] with
(when (sql-get-product-feature product :sqli-comint-func)
;; If no new name specified, try to pop to an active SQL
;; interactive for the same product
- (let ((buf (sql-find-sqli-buffer product)))
+ (let ((buf (sql-find-sqli-buffer product sql-connection)))
(if (and (not new-name) buf)
(pop-to-buffer buf)
@@ -3629,23 +4090,24 @@ the call to \\[sql-product-interactive] with
(sql-get-product-feature product :sqli-options))
;; Set SQLi mode.
- (setq new-sqli-buffer (current-buffer))
(let ((sql-interactive-product product))
(sql-interactive-mode))
;; Set the new buffer name
+ (setq new-sqli-buffer (current-buffer))
(when new-name
(sql-rename-buffer new-name))
-
- ;; Set `sql-buffer' in the new buffer and the start buffer
(setq sql-buffer (buffer-name new-sqli-buffer))
+
+ ;; Set `sql-buffer' in the start buffer
(with-current-buffer start-buffer
- (setq sql-buffer (buffer-name new-sqli-buffer))
- (run-hooks 'sql-set-sqli-hook))
+ (when (derived-mode-p 'sql-mode)
+ (setq sql-buffer (buffer-name new-sqli-buffer))
+ (run-hooks 'sql-set-sqli-hook)))
;; All done.
(message "Login...done")
- (pop-to-buffer sql-buffer)))))
+ (pop-to-buffer new-sqli-buffer)))))
(message "No default SQL product defined. Set `sql-product'.")))
(defun sql-comint (product params)
@@ -3720,6 +4182,157 @@ The default comes from `process-coding-system-alist' and
(setq parameter options))
(sql-comint product parameter)))
+(defun sql-oracle-save-settings (sqlbuf)
+ "Saves most SQL*Plus settings so they may be reset by \\[sql-redirect]."
+ ;; Note: does not capture the following settings:
+ ;;
+ ;; APPINFO
+ ;; BTITLE
+ ;; COMPATIBILITY
+ ;; COPYTYPECHECK
+ ;; MARKUP
+ ;; RELEASE
+ ;; REPFOOTER
+ ;; REPHEADER
+ ;; SQLPLUSCOMPATIBILITY
+ ;; TTITLE
+ ;; USER
+ ;;
+
+ (append
+ ;; (apply 'concat (append
+ ;; '("SET")
+
+ ;; option value...
+ (sql-redirect-value
+ sqlbuf
+ (concat "SHOW ARRAYSIZE AUTOCOMMIT AUTOPRINT AUTORECOVERY AUTOTRACE"
+ " CMDSEP COLSEP COPYCOMMIT DESCRIBE ECHO EDITFILE EMBEDDED"
+ " ESCAPE FLAGGER FLUSH HEADING INSTANCE LINESIZE LNO LOBOFFSET"
+ " LOGSOURCE LONG LONGCHUNKSIZE NEWPAGE NULL NUMFORMAT NUMWIDTH"
+ " PAGESIZE PAUSE PNO RECSEP SERVEROUTPUT SHIFTINOUT SHOWMODE"
+ " SPOOL SQLBLANKLINES SQLCASE SQLCODE SQLCONTINUE SQLNUMBER"
+ " SQLPROMPT SUFFIX TAB TERMOUT TIMING TRIMOUT TRIMSPOOL VERIFY")
+ "^.+$"
+ "SET \\&")
+
+ ;; option "c" (hex xx)
+ (sql-redirect-value
+ sqlbuf
+ (concat "SHOW BLOCKTERMINATOR CONCAT DEFINE SQLPREFIX SQLTERMINATOR"
+ " UNDERLINE HEADSEP RECSEPCHAR")
+ "^\\(.+\\) (hex ..)$"
+ "SET \\1")
+
+ ;; FEDDBACK ON for 99 or more rows
+ ;; feedback OFF
+ (sql-redirect-value
+ sqlbuf
+ "SHOW FEEDBACK"
+ "^\\(?:FEEDBACK ON for \\([[:digit:]]+\\) or more rows\\|feedback \\(OFF\\)\\)"
+ "SET FEEDBACK \\1\\2")
+
+ ;; wrap : lines will be wrapped
+ ;; wrap : lines will be truncated
+ (list (concat "SET WRAP "
+ (if (string=
+ (car (sql-redirect-value
+ sqlbuf
+ "SHOW WRAP"
+ "^wrap : lines will be \\(wrapped\\|truncated\\)" 1))
+ "wrapped")
+ "ON" "OFF")))))
+
+(defun sql-oracle-restore-settings (sqlbuf saved-settings)
+ "Restore the SQL*Plus settings in SAVED-SETTINGS."
+
+ ;; Remove any settings that haven't changed
+ (mapc
+ (lambda (one-cur-setting)
+ (setq saved-settings (delete one-cur-setting saved-settings)))
+ (sql-oracle-save-settings sqlbuf))
+
+ ;; Restore the changed settings
+ (sql-redirect sqlbuf saved-settings))
+
+(defun sql-oracle-list-all (sqlbuf outbuf enhanced table-name)
+ ;; Query from USER_OBJECTS or ALL_OBJECTS
+ (let ((settings (sql-oracle-save-settings sqlbuf))
+ (simple-sql
+ (concat
+ "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
+ ", x.object_name AS SQL_EL_NAME "
+ "FROM user_objects x "
+ "WHERE x.object_type NOT LIKE '%% BODY' "
+ "ORDER BY 2, 1;"))
+ (enhanced-sql
+ (concat
+ "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
+ ", x.owner ||'.'|| x.object_name AS SQL_EL_NAME "
+ "FROM all_objects x "
+ "WHERE x.object_type NOT LIKE '%% BODY' "
+ "AND x.owner <> 'SYS' "
+ "ORDER BY 2, 1;")))
+
+ (sql-redirect sqlbuf
+ (concat "SET LINESIZE 80 PAGESIZE 50000 TRIMOUT ON"
+ " TAB OFF TIMING OFF FEEDBACK OFF"))
+
+ (sql-redirect sqlbuf
+ (list "COLUMN SQL_EL_TYPE HEADING \"Type\" FORMAT A19"
+ "COLUMN SQL_EL_NAME HEADING \"Name\""
+ (format "COLUMN SQL_EL_NAME FORMAT A%d"
+ (if enhanced 60 35))))
+
+ (sql-redirect sqlbuf
+ (if enhanced enhanced-sql simple-sql)
+ outbuf)
+
+ (sql-redirect sqlbuf
+ '("COLUMN SQL_EL_NAME CLEAR"
+ "COLUMN SQL_EL_TYPE CLEAR"))
+
+ (sql-oracle-restore-settings sqlbuf settings)))
+
+(defun sql-oracle-list-table (sqlbuf outbuf enhanced table-name)
+ "Implements :list-table under Oracle."
+ (let ((settings (sql-oracle-save-settings sqlbuf)))
+
+ (sql-redirect sqlbuf
+ (format
+ (concat "SET LINESIZE %d PAGESIZE 50000"
+ " DESCRIBE DEPTH 1 LINENUM OFF INDENT ON")
+ (max 65 (min 120 (window-width)))))
+
+ (sql-redirect sqlbuf (format "DESCRIBE %s" table-name)
+ outbuf)
+
+ (sql-oracle-restore-settings sqlbuf settings)))
+
+(defcustom sql-oracle-completion-types '("FUNCTION" "PACKAGE" "PROCEDURE"
+ "SEQUENCE" "SYNONYM" "TABLE" "TRIGGER"
+ "TYPE" "VIEW")
+ "List of object types to include for completion under Oracle.
+
+See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values."
+ :version "24.1"
+ :type '(repeat string)
+ :group 'SQL)
+
+(defun sql-oracle-completion-object (sqlbuf schema)
+ (sql-redirect-value
+ sqlbuf
+ (concat
+ "SELECT CHR(1)||"
+ (if schema
+ (format "owner||'.'||object_name AS o FROM all_objects WHERE owner = %s AND "
+ (sql-str-literal (upcase schema)))
+ "object_name AS o FROM user_objects WHERE ")
+ "temporary = 'N' AND generated = 'N' AND secondary = 'N' AND "
+ "object_type IN ("
+ (mapconcat (function sql-str-literal) sql-oracle-completion-types ",")
+ ");")
+ "^[\001]\\(.+\\)$" 1))
;;;###autoload
@@ -3858,6 +4471,9 @@ The default comes from `process-coding-system-alist' and
(setq params (append options params))
(sql-comint product params)))
+(defun sql-sqlite-completion-object (sqlbuf schema)
+ (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0))
+
;;;###autoload
@@ -4112,6 +4728,33 @@ Try to set `comint-output-filter-functions' like this:
(setq params (append (list "-p" sql-port) params)))
(sql-comint product params)))
+(defun sql-postgres-completion-object (sqlbuf schema)
+ (let (cl re fs a r)
+ (sql-redirect sqlbuf "\\t on")
+ (setq a (car (sql-redirect-value sqlbuf "\\a" "Output format is \\(.*\\)[.]$" 1)))
+ (when (string= a "aligned")
+ (sql-redirect sqlbuf "\\a"))
+ (setq fs (or (car (sql-redirect-value sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) "|"))
+
+ (setq re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" fs "[^" fs "]*" fs "[^" fs "]*$"))
+ (setq cl (if (not schema)
+ (sql-redirect-value sqlbuf "\\d" re '(1 2))
+ (append (sql-redirect-value sqlbuf (format "\\dt %s.*" schema) re '(1 2))
+ (sql-redirect-value sqlbuf (format "\\dv %s.*" schema) re '(1 2))
+ (sql-redirect-value sqlbuf (format "\\ds %s.*" schema) re '(1 2)))))
+
+ ;; Restore tuples and alignment to what they were
+ (sql-redirect sqlbuf "\\t off")
+ (when (not (string= a "aligned"))
+ (sql-redirect sqlbuf "\\a"))
+
+ ;; Return the list of table names (public schema name can be omitted)
+ (mapcar (lambda (tbl)
+ (if (string= (car tbl) "public")
+ (cadr tbl)
+ (format "%s.%s" (car tbl) (cadr tbl))))
+ cl)))
+
;;;###autoload
@@ -4199,8 +4842,7 @@ The default comes from `process-coding-system-alist' and
"Create comint buffer and connect to DB2."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (sql-comint product options)
-)
+ (sql-comint product options))
;;;###autoload
(defun sql-linter (&optional buffer)
@@ -4257,3 +4899,6 @@ buffer.
(provide 'sql)
;;; sql.el ends here
+
+; LocalWords: sql SQL SQLite sqlite Sybase Informix MySQL
+; LocalWords: Postgres SQLServer SQLi
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 8bb9256078a..f7cb1318dc0 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -3110,7 +3110,7 @@ Key bindings specific to `verilog-mode-map' are:
#'verilog-indent-line-relative)
(setq comment-indent-function 'verilog-comment-indent)
(set (make-local-variable 'parse-sexp-ignore-comments) nil)
-
+
(set (make-local-variable 'comment-start) "// ")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *")
@@ -3157,7 +3157,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-function-modes)
+ (when (boundp 'which-func-modes)
(add-to-list 'which-func-modes 'verilog-mode))
;; hideshow support
(when (boundp 'hs-special-modes-alist)
@@ -4586,7 +4586,7 @@ This lets programs calling batch mode to easily extract error messages."
(verilog-mode))))
(buffer-list))
;; Process the files
- (mapcar '(lambda (buf)
+ (mapcar (lambda (buf)
(when (buffer-file-name buf)
(save-excursion
(if (not (file-exists-p (buffer-file-name buf)))
@@ -6373,7 +6373,7 @@ for matches of `str' and adding the occurrence tp `all' through point END."
(defun verilog-keyword-completion (keyword-list)
"Give list of all possible completions of keywords in KEYWORD-LIST."
- (mapcar '(lambda (s)
+ (mapcar (lambda (s)
(if (string-match (concat "\\<" verilog-str) s)
(if (or (null verilog-pred)
(funcall verilog-pred s))
@@ -6493,7 +6493,7 @@ and `verilog-separator-keywords'.)"
(all-completions verilog-str 'verilog-completion)))
(match (if verilog-toggle-completions
"" (try-completion
- verilog-str (mapcar '(lambda (elm)
+ verilog-str (mapcar (lambda (elm)
(cons elm 0)) allcomp)))))
;; Delete old string
(delete-region b e)
@@ -11447,13 +11447,13 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp)
;; next in/outs which need previous sucked inputs first
(verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/"
- '(lambda () (verilog-auto-output t)))
+ (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)))
+ (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)))
+ (lambda () (verilog-auto-inout t)))
(verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout)
;; Then tie off those in/outs
(verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 75b706b74ec..9aaf3059b78 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1937,7 +1937,7 @@ Here is the current list of valid syntactic element symbols:
comment -- a line containing only a comment
arglist-intro -- the first line in an argument list
arglist-cont -- subsequent argument list lines when no
- arguments follow on the same line as the
+ arguments follow on the same line as
the arglist opening paren
arglist-cont-nonempty -- subsequent argument list lines when at
least one argument follows on the same
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index ae18486c43b..97e188139e9 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -206,7 +206,8 @@ It creates the Imenu index for the buffer, if necessary."
(setq imenu--index-alist
(save-excursion (funcall imenu-create-index-function))))
(error
- (message "which-func-ff-hook error: %S" err)
+ (unless (equal err '(error "This buffer cannot use `imenu-default-create-index-function'"))
+ (message "which-func-ff-hook error: %S" err))
(setq which-func-mode nil))))
(defun which-func-update ()
@@ -270,7 +271,7 @@ It calls them sequentially, and if any returns non-nil,
(defun which-function ()
"Return current function name based on point.
Uses `which-func-functions', `imenu--index-alist'
-or `add-log-current-defun-function'.
+or `add-log-current-defun'.
If no function name is found, return nil."
(let ((name
;; Try the `which-func-functions' functions first.
@@ -320,9 +321,8 @@ If no function name is found, return nil."
(reverse (cons (car pair) namestack))))))))))))
;; Try using add-log support.
- (when (and (null name) (boundp 'add-log-current-defun-function)
- add-log-current-defun-function)
- (setq name (funcall add-log-current-defun-function)))
+ (when (null name)
+ (setq name (add-log-current-defun)))
;; Filter the name if requested.
(when name
(if which-func-cleanup-function
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 3d1dbfb406a..a6d6a5676c1 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -975,7 +975,7 @@ Please send all bug fixes and enhancements to
;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
;; or, use `ps-print-hook' (see section Hooks):
;; (add-hook 'ps-print-hook
-;; '(lambda ()
+;; (lambda ()
;; (or (assq 'Helvetica ps-font-info-database)
;; (setq ps-font-info-database (append ...)))))
;;
diff --git a/lisp/rect.el b/lisp/rect.el
index ad914cab7d2..0756ec3bc0a 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -93,8 +93,9 @@ Point is at the end of the segment of this line within the rectangle."
"Call FUNCTION for each line of rectangle with corners at START, END.
FUNCTION is called with two arguments: the start and end columns of the
rectangle, plus ARGS extra arguments. Point is at the beginning of line when
-the function is called."
- (let (startcol startpt endcol endpt)
+the function is called.
+The final point after the last operation will be returned."
+ (let (startcol startpt endcol endpt final-point)
(save-excursion
(goto-char start)
(setq startcol (current-column))
@@ -112,8 +113,9 @@ the function is called."
(goto-char startpt)
(while (< (point) endpt)
(apply function startcol endcol args)
+ (setq final-point (point))
(forward-line 1)))
- ))
+ final-point))
(defun delete-rectangle-line (startcol endcol fill)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
@@ -323,7 +325,8 @@ Called from a program, takes three args; START, END and STRING."
(or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)))))
- (apply-on-rectangle 'string-rectangle-line start end string t))
+ (goto-char
+ (apply-on-rectangle 'string-rectangle-line start end string t)))
;;;###autoload
(defalias 'replace-rectangle 'string-rectangle)
diff --git a/lisp/register.el b/lisp/register.el
index af1a421a0a2..89a725f28c5 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -28,6 +28,8 @@
;; pieces of buffer state to named variables. The entry points are
;; documented in the Emacs user's manual.
+(eval-when-compile (require 'cl))
+
(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))
@@ -50,9 +52,36 @@
;;; Code:
+(defstruct
+ (registerv (:constructor nil)
+ (:constructor registerv--make (&optional data print-func
+ jump-func insert-func))
+ (:copier nil)
+ (:type vector)
+ :named)
+ (data nil :read-only t)
+ (print-func nil :read-only t)
+ (jump-func nil :read-only t)
+ (insert-func nil :read-only t))
+
+(defun* registerv-make (data &key print-func jump-func insert-func)
+ "Create a register value object.
+
+DATA can be any value.
+PRINT-FUNC if provided controls how `list-registers' and
+`view-register' print the register. It should be a function
+receiving one argument DATA and print text that completes
+this sentence:
+ Register X contains [TEXT PRINTED BY PRINT-FUNC]
+JUMP-FUNC if provided, controls how `jump-to-register' jumps to the register.
+INSERT-FUNC if provided, controls how `insert-register' insert the register.
+They both receive DATA as argument."
+ (registerv--make data print-func jump-func insert-func))
+
(defvar register-alist nil
"Alist of elements (NAME . CONTENTS), one for each Emacs register.
-NAME is a character (a number). CONTENTS is a string, number, marker or list.
+NAME is a character (a number). CONTENTS is a string, number, marker, list
+or a struct returned by `registerv-make'.
A list of strings represents a rectangle.
A list of the form (file . FILE-NAME) represents the file named FILE-NAME.
A list of the form (file-query FILE-NAME POSITION) represents
@@ -120,6 +149,11 @@ delete any existing frames that the frame configuration doesn't mention.
(interactive "cJump to register: \nP")
(let ((val (get-register register)))
(cond
+ ((registerv-p val)
+ (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)))
((and (consp val) (frame-configuration-p (car val)))
(set-frame-configuration (car val) (not delete))
(goto-char (cadr val)))
@@ -209,6 +243,11 @@ The Lisp value REGISTER is a character."
(princ " contains ")
(let ((val (get-register register)))
(cond
+ ((registerv-p val)
+ (if (registerv-print-func val)
+ (funcall (registerv-print-func val) (registerv-data val))
+ (princ "[UNPRINTABLE CONTENTS].")))
+
((numberp val)
(princ val))
@@ -285,6 +324,11 @@ Interactively, second arg is non-nil if prefix arg is supplied."
(push-mark)
(let ((val (get-register register)))
(cond
+ ((registerv-p val)
+ (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)))
((consp val)
(insert-rectangle val))
((stringp val)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index b33039b609b..8bab8691b4f 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -123,7 +123,9 @@ if `repeat' is bound to C-x z, typing C-x z z z repeats the previous command
only occurs if the final character by which `repeat' was invoked is a
member of that sequence. If this variable is nil, no re-execution occurs."
:group 'convenience
- :type 'boolean)
+ :type '(choice (const :tag "Repeat for all keys" t)
+ (const :tag "Don't repeat" nil)
+ (sexp :tag "Repeat for specific keys")))
;;;;; ****************** HACKS TO THE REST OF EMACS ******************* ;;;;;
diff --git a/lisp/replace.el b/lisp/replace.el
index 31a48d48960..fb98a714dff 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -761,22 +761,8 @@ a previously found match."
count)))
-(defvar occur-mode-map
+(defvar occur-menu-map
(let ((map (make-sparse-keymap)))
- ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
- (define-key map [mouse-2] 'occur-mode-mouse-goto)
- (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
- (define-key map "\C-m" 'occur-mode-goto-occurrence)
- (define-key map "o" 'occur-mode-goto-occurrence-other-window)
- (define-key map "\C-o" 'occur-mode-display-occurrence)
- (define-key map "\M-n" 'occur-next)
- (define-key map "\M-p" 'occur-prev)
- (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] (make-sparse-keymap))
- (define-key map [menu-bar occur]
- (cons (purecopy "Occur") map))
(define-key map [next-error-follow-minor-mode]
`(menu-item ,(purecopy "Auto Occurrence Display")
next-error-follow-minor-mode
@@ -817,6 +803,24 @@ a previously found match."
`(menu-item ,(purecopy "Move to Previous Match") occur-prev
:help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
map)
+ "Menu keymap for `occur-mode'.")
+
+(defvar occur-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
+ (define-key map [mouse-2] 'occur-mode-mouse-goto)
+ (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
+ (define-key map "\C-x\C-q" 'occur-edit-mode)
+ (define-key map "\C-m" 'occur-mode-goto-occurrence)
+ (define-key map "o" 'occur-mode-goto-occurrence-other-window)
+ (define-key map "\C-o" 'occur-mode-display-occurrence)
+ (define-key map "\M-n" 'occur-next)
+ (define-key map "\M-p" 'occur-prev)
+ (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))
+ map)
"Keymap for `occur-mode'.")
(defvar occur-revert-arguments nil
@@ -853,6 +857,63 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(setq next-error-function 'occur-next-error))
+
+;;; Occur Edit mode
+
+(defvar occur-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map text-mode-map)
+ (define-key map [mouse-2] 'occur-mode-mouse-goto)
+ (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
+ (define-key map "\C-x\C-q" 'occur-mode)
+ (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
+ (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ map)
+ "Keymap for `occur-edit-mode'.")
+
+(define-derived-mode occur-edit-mode occur-mode "Occur-Edit"
+ "Major mode for editing *Occur* buffers.
+In this mode, changes to the *Occur* buffer are also applied to
+the originating buffer.
+
+To return to ordinary Occur mode, use \\[occur-mode]."
+ (setq buffer-read-only nil)
+ (add-hook 'after-change-functions 'occur-after-change-function nil t))
+
+(defun occur-after-change-function (beg end length)
+ (save-excursion
+ (goto-char beg)
+ (let* ((m (get-text-property (line-beginning-position) 'occur-target))
+ (buf (marker-buffer m))
+ (col (current-column)))
+ (when (= length 0)
+ ;; Apply occur-target property to inserted (e.g. yanked) text.
+ (put-text-property beg end 'occur-target m)
+ ;; Did we insert a newline? Occur Edit mode can't create new
+ ;; Occur entries; just discard everything after the newline.
+ (save-excursion
+ (and (search-forward "\n" end t)
+ (delete-region (1- (point)) end))))
+ (let ((line (- (line-number-at-pos)
+ (line-number-at-pos (window-start))))
+ (readonly (with-current-buffer buf buffer-read-only))
+ (win (or (get-buffer-window buf)
+ (display-buffer buf t)))
+ (text (save-excursion
+ (forward-line 0)
+ (search-forward ":" nil t)
+ (setq col (- col (current-column)))
+ (buffer-substring-no-properties (point) (line-end-position)))))
+ (with-selected-window win
+ (goto-char m)
+ (recenter line)
+ (if readonly
+ (message "Buffer `%s' is read only." buf)
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert text))
+ (move-to-column col))))))
+
+
(defun occur-revert-function (_ignore1 _ignore2)
"Handle `revert-buffer' for Occur mode buffers."
(apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
@@ -1079,7 +1140,8 @@ are not modified."
"Show all lines in buffers BUFS containing a match for REGEXP.
This function acts on multiple buffers; otherwise, it is exactly like
`occur'. When you invoke this command interactively, you must specify
-the buffer names that you want, one by one."
+the buffer names that you want, one by one.
+See also `multi-occur-in-matching-buffers'."
(interactive
(cons
(let* ((bufs (list (read-buffer "First buffer to search: "
@@ -1280,6 +1342,7 @@ See also `multi-occur'."
`(font-lock-face prefix-face))
`(occur-prefix t mouse-face (highlight)
occur-target ,marker follow-link t
+ read-only t
help-echo "mouse-2: go to this occurrence"))))
(match-str
;; We don't put `mouse-face' on the newline,
@@ -1339,13 +1402,15 @@ See also `multi-occur'."
(goto-char headerpt)
(let ((beg (point))
end)
- (insert (format "%d match%s%s in buffer: %s\n"
- matches (if (= matches 1) "" "es")
- ;; Don't display regexp for multi-buffer.
- (if (> (length buffers) 1)
- "" (format " for \"%s\""
- (query-replace-descr regexp)))
- (buffer-name buf)))
+ (insert (propertize
+ (format "%d match%s%s in buffer: %s\n"
+ matches (if (= matches 1) "" "es")
+ ;; Don't display regexp for multi-buffer.
+ (if (> (length buffers) 1)
+ "" (format " for \"%s\""
+ (query-replace-descr regexp)))
+ (buffer-name buf))
+ 'read-only t))
(setq end (point))
(add-text-properties beg end
(append
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 54f2ba765b5..0c68bca4d2e 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -81,7 +81,8 @@ SIDE must be the symbol `left' or `right'."
This is nil while loading `scroll-bar.el', and t afterward.")
(defun set-scroll-bar-mode (value)
- "Set `scroll-bar-mode' to VALUE and put the new value into effect."
+ "Set the scroll bar mode to VALUE and put the new value into effect.
+See the `scroll-bar-mode' variable for possible values to use."
(if scroll-bar-mode
(setq previous-scroll-bar-mode scroll-bar-mode))
diff --git a/lisp/select.el b/lisp/select.el
index 1f5191e86c1..10c8f0b1efd 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -289,7 +289,9 @@ two markers or an overlay. Otherwise, it is nil."
(defun xselect-convert-to-targets (_selection _type _value)
;; return a vector of atoms, but remove duplicates first.
- (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
+ (let* ((all (cons 'TIMESTAMP
+ (cons 'MULTIPLE
+ (mapcar 'car selection-converter-alist))))
(rest all))
(while rest
(cond ((memq (car rest) (cdr rest))
@@ -365,6 +367,12 @@ This function returns the string \"emacs\"."
(defun xselect-convert-to-identity (_selection _type value) ; used internally
(vector value))
+;; Null target that tells clipboard managers we support SAVE_TARGETS
+;; (see freedesktop.org Clipboard Manager spec).
+(defun xselect-convert-to-save-targets (selection _type _value)
+ (when (eq selection 'CLIPBOARD)
+ 'NULL))
+
(setq selection-converter-alist
'((TEXT . xselect-convert-to-string)
(COMPOUND_TEXT . xselect-convert-to-string)
@@ -384,6 +392,7 @@ This function returns the string \"emacs\"."
(NAME . xselect-convert-to-name)
(ATOM . xselect-convert-to-atom)
(INTEGER . xselect-convert-to-integer)
+ (SAVE_TARGETS . xselect-convert-to-save-targets)
(_EMACS_INTERNAL . xselect-convert-to-identity)))
(provide 'select)
diff --git a/lisp/server.el b/lisp/server.el
index c421ee09812..c91f10b6584 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -235,9 +235,10 @@ If local sockets are not supported, this is nil.")
(defun server-clients-with (property value)
"Return a list of clients with PROPERTY set to VALUE."
(let (result)
- (dolist (proc server-clients result)
+ (dolist (proc server-clients)
(when (equal value (process-get proc property))
- (push proc result)))))
+ (push proc result)))
+ result))
(defun server-add-client (proc)
"Create a client for process PROC, if it doesn't already have one.
@@ -678,7 +679,7 @@ Server mode runs a process that accepts commands from the
(defun server-eval-and-print (expr proc)
"Eval EXPR and send the result back to client PROC."
(let ((v (eval (car (read-from-string expr)))))
- (when (and v proc)
+ (when proc
(with-temp-buffer
(let ((standard-output (current-buffer)))
(pp v)
@@ -735,7 +736,8 @@ Server mode runs a process that accepts commands from the
frame))
-(defun server-create-window-system-frame (display nowait proc parent-id)
+(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
@@ -750,7 +752,8 @@ Server mode runs a process that accepts commands from the
;; killing emacs on that frame.
(let* ((params `((client . ,(if nowait 'nowait proc))
;; This is a leftover, see above.
- (environment . ,(process-get proc 'env))))
+ (environment . ,(process-get proc 'env))
+ ,@parameters))
(display (or display
(frame-parameter nil 'display)
(getenv "DISPLAY")
@@ -831,6 +834,9 @@ The following commands are accepted by the server:
`-current-frame'
Forbid the creation of new frames.
+`-frame-parameters ALIST'
+ Set the parameters of the created frame.
+
`-nowait'
Request that the next frame created should not be
associated with this client.
@@ -939,6 +945,7 @@ The following commands are accepted by the client:
commands
dir
use-current-frame
+ frame-parameters ;parameters for newly created frame
tty-name ; nil, `window-system', or the tty name.
tty-type ; string.
files
@@ -959,6 +966,13 @@ The following commands are accepted by the client:
;; -current-frame: Don't create frames.
(`"-current-frame" (setq use-current-frame t))
+ ;; -frame-parameters: Set frame parameters
+ (`"-frame-parameters"
+ (let ((alist (pop args-left)))
+ (if coding-system
+ (setq alist (decode-coding-string alist coding-system)))
+ (setq frame-parameters (car (read-from-string alist)))))
+
;; -display DISPLAY:
;; Open X frames on the given display instead of the default.
(`"-display"
@@ -1074,7 +1088,8 @@ The following commands are accepted by the client:
(if display (server-select-display display)))
((eq tty-name 'window-system)
(server-create-window-system-frame display nowait proc
- parent-id))
+ parent-id
+ frame-parameters))
;; When resuming on a tty, tty-name is nil.
(tty-name
(server-create-tty-frame tty-name tty-type proc))))
@@ -1138,7 +1153,10 @@ The following commands are accepted by the client:
"When done with a buffer, type \\[server-edit]")))))
(when (and frame (null tty-name))
(server-unselect-display frame)))
- (error (server-return-error proc err)))))
+ ((quit error)
+ (when (eq (car err) 'quit)
+ (message "Quit emacsclient request"))
+ (server-return-error proc err)))))
(defun server-return-error (proc err)
(ignore-errors
@@ -1185,12 +1203,12 @@ so don't mark these buffers specially, just visit them normally."
(add-to-history 'file-name-history filen)
(if (null obuf)
(progn
- (run-hooks 'pre-command-hook)
+ (run-hooks 'pre-command-hook)
(set-buffer (find-file-noselect filen)))
(set-buffer obuf)
;; separately for each file, in sync with post-command hooks,
;; with the new buffer current:
- (run-hooks 'pre-command-hook)
+ (run-hooks 'pre-command-hook)
(cond ((file-exists-p filen)
(when (not (verify-visited-file-modtime obuf))
(revert-buffer t nil)))
@@ -1204,7 +1222,7 @@ so don't mark these buffers specially, just visit them normally."
(server-goto-line-column (cdr file))
(run-hooks 'server-visit-hook)
;; hooks may be specific to current buffer:
- (run-hooks 'post-command-hook))
+ (run-hooks 'post-command-hook))
(unless nowait
;; When the buffer is killed, inform the clients.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
@@ -1322,10 +1340,11 @@ specifically for the clients and did not exist before their request for it."
"Ask before killing a server buffer."
(or (not server-buffer-clients)
(let ((res t))
- (dolist (proc server-buffer-clients res)
+ (dolist (proc server-buffer-clients)
(when (and (memq proc server-clients)
(eq (process-status proc) 'open))
- (setq res nil))))
+ (setq res nil)))
+ res)
(yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
(buffer-name (current-buffer))))))
@@ -1333,10 +1352,11 @@ specifically for the clients and did not exist before their request for it."
"Ask before exiting Emacs if it has live clients."
(or (not server-clients)
(let (live-client)
- (dolist (proc server-clients live-client)
+ (dolist (proc server-clients)
(when (memq t (mapcar 'buffer-live-p (process-get
proc 'buffers)))
- (setq live-client t))))
+ (setq live-client t)))
+ live-client)
(yes-or-no-p "This Emacs session has clients; exit anyway? ")))
(defun server-kill-buffer ()
diff --git a/lisp/ses.el b/lisp/ses.el
index 2fc85d27df9..9b2048eae83 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -3,8 +3,8 @@
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
-;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
-;; Keywords: spreadsheet
+;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
+;; Keywords: spreadsheet Dijkstra
;; This file is part of GNU Emacs.
@@ -25,6 +25,7 @@
;;; To-do list:
+;; * split (catch 'cycle ...) call back into one or more functions
;; * Use $ or … for truncated fields
;; * Add command to make a range of columns be temporarily invisible.
;; * Allow paste of one cell to a range of cells -- copy formula to each.
@@ -36,10 +37,26 @@
;; * Left-margin column for row number.
;; * Move a row by dragging its number in the left-margin.
+;;; Cycle detection
+
+;; Cycles used to be detected by stationarity of ses--deferred-recalc. This was
+;; working fine in most cases, however failed in some cases of several path
+;; racing together.
+;;
+;; The current algorithm is based on Dijksta algorithm. The ``cycle length'' is
+;; stored in some cell property. In order not to reset in all cells such
+;; property at each update, the cycle length is stored in this property along
+;; with some update attempt id that is incremented at each update. The current
+;; update id is ses--Dijkstra-attempt-nb. In case there is a cycle the cycle
+;; length diverge to infinite so it will exceed ses--Dijkstra-weight-bound at
+;; some point of time that allows detection. Otherwise it converges to the
+;; longest path length in the update tree.
+
;;; Code:
(require 'unsafep)
+(eval-when-compile (require 'cl))
;;----------------------------------------------------------------------------
@@ -154,7 +171,7 @@ Each function is called with ARG=1."
(defalias 'ses-mode-print-map
(let ((keys '([backtab] backward-char
[tab] ses-forward-or-insert
- "\C-i" ses-forward-or-insert ;Needed for ses-coverage.el?
+ "\C-i" ses-forward-or-insert ; Needed for ses-coverage.el?
"\M-o" ses-insert-column
"\C-o" ses-insert-row
"\C-m" ses-edit-cell
@@ -225,10 +242,10 @@ Each function is called with ARG=1."
"Initial contents for the file-trailer area at the bottom of the file.")
(defconst ses-initial-file-contents
- (concat " \n" ;One blank cell in print area
+ (concat " \n" ; One blank cell in print area.
ses-print-data-boundary
- "(ses-cell A1 nil nil nil nil)\n" ;One blank cell in data area
- "\n" ;End-of-row terminator for the one row in data area
+ "(ses-cell A1 nil nil nil nil)\n" ; One blank cell in data area.
+ "\n" ; End-of-row terminator for the one row in data area.
"(ses-column-widths [7])\n"
"(ses-column-printers [nil])\n"
"(ses-default-printer \"%.7g\")\n"
@@ -255,23 +272,34 @@ default printer and then modify its output.")
(eval-and-compile
(defconst ses-localvars
- '(ses--blank-line ses--cells ses--col-printers ses--col-widths ses--curcell
- ses--curcell-overlay ses--default-printer ses--deferred-narrow
- ses--deferred-recalc ses--deferred-write ses--file-format
- ses--header-hscroll ses--header-row ses--header-string ses--linewidth
- ses--numcols ses--numrows ses--symbolic-formulas ses--data-marker
- ses--params-marker
- ;;Global variables that we override
+ '(ses--blank-line ses--cells ses--col-printers
+ ses--col-widths ses--curcell ses--curcell-overlay
+ ses--default-printer
+ ses--deferred-narrow ses--deferred-recalc
+ ses--deferred-write ses--file-format
+ (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
+ ;; Global variables that we override
mode-line-process next-line-add-newlines transient-mark-mode)
- "Buffer-local variables used by SES."))
+ "Buffer-local variables used by SES.")
-;;When compiling, create all the buffer locals and give them values
-(eval-when-compile
+(defun ses-set-localvars ()
+ "Set buffer-local and initialize some SES variables."
(dolist (x ses-localvars)
- (make-local-variable x)
- (set x nil)))
+ (cond
+ ((symbolp x)
+ (set (make-local-variable x) nil))
+ ((consp x)
+ (set (make-local-variable (car x)) (cdr x)))
+ (t (error "Unexpected elements `%S' in list `ses-localvars'" x))))))
+
+(eval-when-compile ; silence compiler
+ (ses-set-localvars))
-;;;This variable is documented as being permitted in file-locals:
+;;; This variable is documented as being permitted in file-locals:
(put 'ses--symbolic-formulas 'safe-local-variable 'consp)
(defconst ses-paramlines-plist
@@ -317,12 +345,14 @@ when to emit a progress message.")
;; We might want to use defstruct here, but cells are explicitly used as
;; arrays in ses-set-cell, so we'd need to fix this first. --Stef
-(defsubst ses-make-cell (&optional symbol formula printer references)
- (vector symbol formula printer references))
+(defsubst ses-make-cell (&optional symbol formula printer references
+ property-list)
+ (vector symbol formula printer references property-list))
(defmacro ses-cell-symbol (row &optional col)
"From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 0))
+(put 'ses-cell-symbol 'safe-function t)
(defmacro ses-cell-formula (row &optional col)
"From a CELL or a pair (ROW,COL), get the function that computes its value."
@@ -337,6 +367,116 @@ when to emit a progress message.")
functions refer to its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 3))
+(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
+ ;; list needs to be scanned only when the property does not exist for that
+ ;; cell.
+ (let* ((plist (aref cell 4))
+ (ret (plist-member plist property-name)))
+ (if ret
+ ;; Property was found.
+ (let ((val (cadr ret)))
+ (if (eq ret plist)
+ ;; Property found is already in the first position, so just return
+ ;; its value.
+ val
+ ;; Property is not in the first position, the following will move it
+ ;; there before returning its value.
+ (let ((next (cddr ret)))
+ (if next
+ (progn
+ (setcdr ret (cdr next))
+ (setcar ret (car next)))
+ (setcdr (last plist 1) nil)))
+ (aset cell 4
+ `(,property-name ,val ,@plist))
+ val)))))
+
+(defmacro ses-cell-property-get (property-name row &optional col)
+ "Get property named PROPERTY-NAME From a CELL or a pair (ROW,COL).
+
+When COL is omitted, CELL=ROW is a cell object. When COL is
+present ROW and COL are the integer coordinates of the cell of
+interest."
+ (declare (debug t))
+ `(ses-cell-property-get-fun
+ ,property-name
+ ,(if col `(ses-get-cell ,row ,col) row)))
+
+(defun ses-cell-property-delq-fun (property-name cell)
+ (let ((ret (plist-get (aref cell 4) property-name)))
+ (if ret
+ (setcdr ret (cddr ret)))))
+
+(defun ses-cell-property-set-fun (property-name property-val cell)
+ (let* ((plist (aref cell 4))
+ (ret (plist-member plist property-name)))
+ (if ret
+ (setcar (cdr ret) property-val)
+ (aset cell 4 `(,property-name ,property-val ,@plist)))))
+
+(defmacro ses-cell-property-set (property-name property-value row &optional col)
+ "From a CELL or a pair (ROW,COL), set the property value of
+the corresponding cell with name PROPERTY-NAME to PROPERTY-VALUE."
+ (if property-value
+ `(ses-cell-property-set-fun ,property-name ,property-value
+ ,(if col `(ses-get-cell ,row ,col) row))
+ `(ses-cell-property-delq-fun ,property-name
+ ,(if col `(ses-get-cell ,row ,col) row))))
+
+(defun ses-cell-property-pop-fun (property-name cell)
+ (let* ((plist (aref cell 4))
+ (ret (plist-member plist property-name)))
+ (if ret
+ (prog1 (cadr ret)
+ (let ((next (cddr ret)))
+ (if next
+ (progn
+ (setcdr ret (cdr next))
+ (setcar ret (car next)))
+ (if (eq plist ret)
+ (aset cell 4 nil)
+ (setcdr (last plist 2) nil))))))))
+
+
+(defmacro ses-cell-property-pop (property-name row &optional col)
+ "From a CELL or a pair (ROW,COL), get and remove the property value of
+the corresponding cell with name PROPERTY-NAME."
+ `(ses-cell-property-pop-fun ,property-name
+ ,(if col `(ses-get-cell ,row ,col) row)))
+
+(defun ses-cell-property-get-handle-fun (property-name cell)
+ (let* ((plist (aref cell 4))
+ (ret (plist-member plist property-name)))
+ (if ret
+ (if (eq ret plist)
+ (cdr ret)
+ (let ((val (cadr ret))
+ (next (cddr ret)))
+ (if next
+ (progn
+ (setcdr ret (cdr next))
+ (setcar ret (car next)))
+ (setcdr (last plist 2) nil))
+ (setq ret (cons val plist))
+ (aset cell 4 (cons property-name ret))
+ ret))
+ (setq ret (cons nil plist))
+ (aset cell 4 (cons property-name ret))
+ ret)))
+
+(defmacro ses-cell-property-get-handle (property-name row &optional col)
+ "From a CELL or a pair (ROW,COL), get a cons cell whose car is
+the property value of the corresponding cell property with name
+PROPERTY-NAME."
+ `(ses-cell-property-get-handle-fun ,property-name
+ ,(if col `(ses-get-cell ,row ,col) row)))
+
+
+(defalias 'ses-cell-property-handle-car 'car)
+(defalias 'ses-cell-property-handle-setcar 'setcar)
+
(defmacro ses-cell-value (row &optional col)
"From a CELL or a pair (ROW,COL), get the current value for that cell."
`(symbol-value (ses-cell-symbol ,row ,col)))
@@ -514,7 +654,7 @@ for this spreadsheet."
0-25 become A-Z; 26-701 become AA-ZZ, and so on."
(let ((units (char-to-string (+ ?A (% col 26)))))
(if (< col 26)
- units
+ units
(concat (ses-column-letter (1- (/ col 26))) units))))
(defun ses-create-cell-symbol (row col)
@@ -534,9 +674,9 @@ for this spreadsheet."
(put sym 'ses-cell (cons xrow xcol))
(make-local-variable sym)))))
-;;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.
+;; 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.
(defun ses-destroy-cell-variable-range (minrow maxrow mincol maxcol)
"Destroy buffer-local variables for cells. This is undoable."
(let (sym)
@@ -584,7 +724,7 @@ cell (ROW,COL). This is undoable. The cell's data will be updated through
(ses-aset-with-undo cell elt val)))
(if change
(add-to-list 'ses--deferred-write (cons row col))))
- nil) ;Make coverage-tester happy
+ nil) ; Make coverage-tester happy.
(defun ses-cell-set-formula (row col formula)
"Store a new formula for (ROW . COL) and enqueues the cell for
@@ -620,6 +760,75 @@ means Emacs will crash if FORMULA contains a circular list."
(ses-formula-record formula)
(ses-set-cell row col 'formula formula))))
+
+(defun ses-repair-cell-reference-all ()
+ "Repair cell reference and warn if there was some reference corruption."
+ (interactive "*")
+ (let (errors)
+ ;; Step 1, reset :ses-repair-reference cell property in the whole sheet.
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let ((references (ses-cell-property-pop :ses-repair-reference
+ row col)))
+ (when references
+ (push (list
+ (ses-cell-symbol row col)
+ :corrupt-property
+ references) errors)))))
+
+ ;; Step 2, build new.
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let* ((cell (ses-get-cell row col))
+ (sym (ses-cell-symbol cell))
+ (formula (ses-cell-formula cell))
+ (new-ref (ses-formula-references formula)))
+ (dolist (ref new-ref)
+ (let* ((rowcol (ses-sym-rowcol ref))
+ (h (ses-cell-property-get-handle :ses-repair-reference
+ (car rowcol) (cdr rowcol))))
+ (unless (memq ref (ses-cell-property-handle-car h))
+ (ses-cell-property-handle-setcar
+ h
+ (cons sym
+ (ses-cell-property-handle-car h)))))))))
+
+ ;; Step 3, overwrite with check.
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let* ((cell (ses-get-cell row col))
+ (irrelevant (ses-cell-references cell))
+ (new-ref (ses-cell-property-pop :ses-repair-reference cell))
+ missing)
+ (dolist (ref new-ref)
+ (if (memq ref irrelevant)
+ (setq irrelevant (delq ref irrelevant))
+ (push ref missing)))
+ (ses-set-cell row col 'references new-ref)
+ (when (or missing irrelevant)
+ (push `( ,(ses-cell-symbol cell)
+ ,@(and missing (list :missing missing))
+ ,@(and irrelevant (list :irrelevant irrelevant)))
+ errors)))))
+ (if errors
+ (warn "----------------------------------------------------------------
+Some reference where corrupted.
+
+The following is a list of where each element ELT is such
+that (car ELT) is the reference of cell CELL with corruption,
+and (cdr ELT) is a property list where
+
+* property `:corrupt-property' means that
+ property `:ses-repair-reference' of cell CELL was initially non
+ nil,
+
+* property `:missing' is a list of missing references
+
+* property `:irrelevant' is a list of non needed references
+
+%S" errors)
+ (message "No reference corruption found"))))
+
(defun ses-calculate-cell (row col force)
"Calculate and print the value for cell (ROW,COL) using the cell's formula
function and print functions, if any. Result is nil for normal operation, or
@@ -629,34 +838,95 @@ left unchanged if it was *skip* and the new value is nil.
processing for the current keystroke, unless the new value is the same as
the old and FORCE is nil."
(let ((cell (ses-get-cell row col))
- formula-error printer-error)
+ cycle-error formula-error printer-error)
(let ((oldval (ses-cell-value cell))
(formula (ses-cell-formula cell))
- newval)
+ newval
+ this-cell-Dijkstra-attempt-h
+ this-cell-Dijkstra-attempt
+ this-cell-Dijkstra-attempt+1
+ ref-cell-Dijkstra-attempt-h
+ ref-cell-Dijkstra-attempt
+ ref-rowcol)
(when (eq (car-safe formula) 'ses-safe-formula)
(setq formula (ses-safe-formula (cadr formula)))
(ses-set-cell row col 'formula formula))
(condition-case sig
(setq newval (eval formula))
(error
+ ;; Variable `sig' can't be nil.
+ (nconc sig (list (ses-cell-symbol cell)))
(setq formula-error sig
newval '*error*)))
(if (and (not newval) (eq oldval '*skip*))
- ;;Don't lose the *skip* - previous field spans this one
+ ;; Don't lose the *skip* --- previous field spans this one.
(setq newval '*skip*))
- (when (or force (not (eq newval oldval)))
- (add-to-list 'ses--deferred-write (cons row col)) ;In case force=t
- (ses-set-cell row col 'value newval)
- (dolist (ref (ses-cell-references cell))
- (add-to-list 'ses--deferred-recalc ref))))
+ (catch 'cycle
+ (when (or force (not (eq newval oldval)))
+ (add-to-list 'ses--deferred-write (cons row col)) ; In case force=t.
+ (setq this-cell-Dijkstra-attempt-h
+ (ses-cell-property-get-handle :ses-Dijkstra-attempt cell);
+ this-cell-Dijkstra-attempt
+ (ses-cell-property-handle-car this-cell-Dijkstra-attempt-h))
+ (if (null this-cell-Dijkstra-attempt)
+ (ses-cell-property-handle-setcar
+ this-cell-Dijkstra-attempt-h
+ (setq this-cell-Dijkstra-attempt
+ (cons ses--Dijkstra-attempt-nb 0)))
+ (unless (= ses--Dijkstra-attempt-nb
+ (car this-cell-Dijkstra-attempt))
+ (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb)
+ (setcdr this-cell-Dijkstra-attempt 0)))
+ (setq this-cell-Dijkstra-attempt+1
+ (1+ (cdr this-cell-Dijkstra-attempt)))
+ (ses-set-cell row col 'value newval)
+ (dolist (ref (ses-cell-references cell))
+ (add-to-list 'ses--deferred-recalc ref)
+ (setq ref-rowcol (ses-sym-rowcol ref)
+ ref-cell-Dijkstra-attempt-h
+ (ses-cell-property-get-handle
+ :ses-Dijkstra-attempt
+ (car ref-rowcol) (cdr ref-rowcol))
+ ref-cell-Dijkstra-attempt
+ (ses-cell-property-handle-car ref-cell-Dijkstra-attempt-h))
+
+ (if (null ref-cell-Dijkstra-attempt)
+ (ses-cell-property-handle-setcar
+ ref-cell-Dijkstra-attempt-h
+ (setq ref-cell-Dijkstra-attempt
+ (cons ses--Dijkstra-attempt-nb
+ this-cell-Dijkstra-attempt+1)))
+ (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb)
+ (setcdr ref-cell-Dijkstra-attempt
+ (max (cdr ref-cell-Dijkstra-attempt)
+ this-cell-Dijkstra-attempt+1))
+ (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb)
+ (setcdr ref-cell-Dijkstra-attempt
+ this-cell-Dijkstra-attempt+1)))
+
+ (when (> this-cell-Dijkstra-attempt+1 ses--Dijkstra-weight-bound)
+ ;; Update print of this cell.
+ (throw 'cycle (setq formula-error
+ `(error ,(format "Found cycle on cells %S"
+ (ses-cell-symbol cell)))
+ cycle-error formula-error)))))))
(setq printer-error (ses-print-cell row col))
- (or formula-error printer-error)))
+ (or
+ (and cycle-error
+ (error (error-message-string cycle-error)))
+ formula-error printer-error)))
(defun ses-clear-cell (row col)
"Delete formula and printer for cell (ROW,COL)."
(ses-set-cell row col 'printer nil)
(ses-cell-set-formula row col nil))
+(defcustom ses-self-reference-early-detection nil
+ "True if cycle detection is early for cells that refer to
+themselves."
+ :type 'boolean
+ :group 'ses)
+
(defun ses-update-cells (list &optional force)
"Recalculate cells in LIST, checking for dependency loops. Prints
progress messages every second. Dependent cells are not recalculated
@@ -664,13 +934,13 @@ if the cell's value is unchanged and FORCE is nil."
(let ((ses--deferred-recalc list)
(nextlist list)
(pos (point))
- curlist prevlist rowcol formula)
+ curlist prevlist this-sym this-rowcol formula)
(with-temp-message " "
- (while (and ses--deferred-recalc (not (equal nextlist prevlist)))
- ;;In each loop, recalculate cells that refer only to other cells that
- ;;have already been recalculated or aren't in the recalculation
- ;;region. Repeat until all cells have been processed or until the
- ;;set of cells being worked on stops changing.
+ (while ses--deferred-recalc
+ ;; In each loop, recalculate cells that refer only to other cells that
+ ;; have already been recalculated or aren't in the recalculation region.
+ ;; Repeat until all cells have been processed or until the set of cells
+ ;; being worked on stops changing.
(if prevlist
(message "Recalculating... (%d cells left)"
(length ses--deferred-recalc)))
@@ -678,38 +948,39 @@ if the cell's value is unchanged and FORCE is nil."
ses--deferred-recalc nil
prevlist nextlist)
(while curlist
- (setq rowcol (ses-sym-rowcol (car curlist))
- formula (ses-cell-formula (car rowcol) (cdr rowcol)))
+ ;; this-sym has to be popped from curlist *BEFORE* the check, and not
+ ;; after because of the case of cells referring to themselves.
+ (setq this-sym (pop curlist)
+ this-rowcol (ses-sym-rowcol this-sym)
+ formula (ses-cell-formula (car this-rowcol)
+ (cdr this-rowcol)))
(or (catch 'ref
(dolist (ref (ses-formula-references formula))
- (when (or (memq ref curlist)
- (memq ref ses--deferred-recalc))
- ;;This cell refers to another that isn't done yet
- (add-to-list 'ses--deferred-recalc (car curlist))
- (throw 'ref t))))
- ;;ses-update-cells is called from post-command-hook, so
- ;;inhibit-quit is implicitly bound to t.
+ (if (and ses-self-reference-early-detection (eq ref this-sym))
+ (error "Cycle found: cell %S is self-referring" this-sym)
+ (when (or (memq ref curlist)
+ (memq ref ses--deferred-recalc))
+ ;; This cell refers to another that isn't done yet
+ (add-to-list 'ses--deferred-recalc this-sym)
+ (throw 'ref t)))))
+ ;; ses-update-cells is called from post-command-hook, so
+ ;; inhibit-quit is implicitly bound to t.
(when quit-flag
- ;;Abort the recalculation. User will probably undo now.
+ ;; Abort the recalculation. User will probably undo now.
(error "Quit"))
- (ses-calculate-cell (car rowcol) (cdr rowcol) force))
- (setq curlist (cdr curlist)))
+ (ses-calculate-cell (car this-rowcol) (cdr this-rowcol) force)))
(dolist (ref ses--deferred-recalc)
- (add-to-list 'nextlist ref))
- (setq nextlist (sort (copy-sequence nextlist) 'string<))
- (if (equal nextlist prevlist)
- ;;We'll go around the loop one more time.
- (add-to-list 'nextlist t)))
+ (add-to-list 'nextlist ref)))
(when ses--deferred-recalc
- ;;Just couldn't finish these
+ ;; Just couldn't finish these.
(dolist (x ses--deferred-recalc)
- (let ((rowcol (ses-sym-rowcol x)))
- (ses-set-cell (car rowcol) (cdr rowcol) 'value '*error*)
- (1value (ses-print-cell (car rowcol) (cdr rowcol)))))
+ (let ((this-rowcol (ses-sym-rowcol x)))
+ (ses-set-cell (car this-rowcol) (cdr this-rowcol) 'value '*error*)
+ (1value (ses-print-cell (car this-rowcol) (cdr this-rowcol)))))
(error "Circular references: %s" ses--deferred-recalc))
(message " "))
- ;;Can't use save-excursion here: if the cell under point is
- ;;updated, save-excusion's marker will move past the cell.
+ ;; Can't use save-excursion here: if the cell under point is updated,
+ ;; save-excusion's marker will move past the cell.
(goto-char pos)))
@@ -721,22 +992,22 @@ if the cell's value is unchanged and FORCE is nil."
"Returns t if point is in print area of spreadsheet."
(<= (point) ses--data-marker))
-;;We turn off point-motion-hooks and explicitly position the cursor, in case
-;;the intangible properties have gotten screwed up (e.g., when
-;;ses-goto-print is called during a recursive ses-print-cell).
+;; We turn off point-motion-hooks and explicitly position the cursor, in case
+;; the intangible properties have gotten screwed up (e.g., when ses-goto-print
+;; is called during a recursive ses-print-cell).
(defun ses-goto-print (row col)
"Move point to print area for cell (ROW,COL)."
(let ((inhibit-point-motion-hooks t)
(n 0))
(goto-char (point-min))
(forward-line row)
- ;; calculate column position
+ ;; Calculate column position.
(dotimes (c col)
(setq n (+ n (ses-col-width c) 1)))
- ;; move to the position
+ ;; Move to the position.
(and (> n (move-to-column n))
(eolp)
- ;; move point to the bol of next line (for TAB at the last cell)
+ ;; Move point to the bol of next line (for TAB at the last cell).
(forward-char))))
(defun ses-set-curcell ()
@@ -745,13 +1016,13 @@ region, or nil if cursor is not at a cell."
(if (or (not mark-active)
deactivate-mark
(= (region-beginning) (region-end)))
- ;;Single cell
+ ;; Single cell.
(setq ses--curcell (get-text-property (point) 'intangible))
- ;;Range
+ ;; Range.
(let ((bcell (get-text-property (region-beginning) 'intangible))
(ecell (get-text-property (1- (region-end)) 'intangible)))
(when (= (region-end) ses--data-marker)
- ;;Correct for overflow
+ ;; Correct for overflow.
(setq ecell (get-text-property (- (region-end) 2) 'intangible)))
(setq ses--curcell (if (and bcell ecell)
(cons bcell ecell)
@@ -764,7 +1035,7 @@ appropriate if some argument is 'end. A range is appropriate if some
argument is 'range. A single cell is appropriate unless some argument is
'needrange."
(if (eq ses--curcell t)
- ;;curcell recalculation was postponed, but user typed ahead
+ ;; curcell recalculation was postponed, but user typed ahead.
(ses-set-curcell))
(cond
((not ses--curcell)
@@ -791,53 +1062,53 @@ preceding cell has spilled over."
(printer (ses-cell-printer cell))
(maxcol (1+ col))
text sig startpos x)
- ;;Create the string to print
+ ;; Create the string to print.
(cond
((eq value '*skip*)
- ;;Don't print anything
+ ;; Don't print anything.
(throw 'ses-print-cell nil))
((eq value '*error*)
(setq text (make-string (ses-col-width col) ?#)))
(t
- ;;Deferred safety-check on printer
+ ;; Deferred safety-check on printer.
(if (eq (car-safe printer) 'ses-safe-printer)
(ses-set-cell row col 'printer
(setq printer (ses-safe-printer (cadr printer)))))
- ;;Print the value
+ ;; Print the value.
(setq text (ses-call-printer (or printer
(ses-col-printer col)
ses--default-printer)
value))
(if (consp ses-call-printer-return)
- ;;Printer returned an error
+ ;; Printer returned an error.
(setq sig ses-call-printer-return))))
- ;;Adjust print width to match column width
+ ;; Adjust print width to match column width.
(let ((width (ses-col-width col))
(len (string-width text)))
(cond
((< len width)
- ;;Fill field to length with spaces
+ ;; Fill field to length with spaces.
(setq len (make-string (- width len) ?\s)
text (if (eq ses-call-printer-return t)
(concat text len)
(concat len text))))
((> len width)
- ;;Spill over into following cells, if possible
+ ;; Spill over into following cells, if possible.
(let ((maxwidth width))
(while (and (> len maxwidth)
(< maxcol ses--numcols)
(or (not (setq x (ses-cell-value row maxcol)))
(eq x '*skip*)))
(unless x
- ;;Set this cell to '*skip* so it won't overwrite our spillover
+ ;; Set this cell to '*skip* so it won't overwrite our spillover.
(ses-set-cell row maxcol 'value '*skip*))
(setq maxwidth (+ maxwidth (ses-col-width maxcol) 1)
maxcol (1+ maxcol)))
(if (<= len maxwidth)
- ;;Fill to complete width of all the fields spanned
+ ;; Fill to complete width of all the fields spanned.
(setq text (concat text (make-string (- maxwidth len) ?\s)))
- ;;Not enough room to end of line or next non-nil field. Truncate
- ;;if string or decimal; otherwise fill with error indicator
+ ;; Not enough room to end of line or next non-nil field. Truncate
+ ;; if string or decimal; otherwise fill with error indicator.
(setq sig `(error "Too wide" ,text))
(cond
((stringp value)
@@ -854,12 +1125,12 @@ preceding cell has spilled over."
(substring text (match-end 0)))))
(t
(setq text (make-string maxwidth ?#)))))))))
- ;;Substitute question marks for tabs and newlines. Newlines are
- ;;used as row-separators; tabs could confuse the reimport logic.
+ ;; Substitute question marks for tabs and newlines. Newlines are used as
+ ;; row-separators; tabs could confuse the reimport logic.
(setq text (replace-regexp-in-string "[\t\n]" "?" text))
(ses-goto-print row col)
(setq startpos (point))
- ;;Install the printed result. This is not interruptible.
+ ;; Install the printed result. This is not interruptible.
(let ((inhibit-read-only t)
(inhibit-quit t))
(let ((inhibit-point-motion-hooks t))
@@ -867,32 +1138,32 @@ preceding cell has spilled over."
(move-to-column (+ (current-column)
(string-width text)))
(1+ (point)))))
- ;;We use concat instead of inserting separate strings in order to
- ;;reduce the number of cells in the undo list.
+ ;; We use concat instead of inserting separate strings in order to
+ ;; reduce the number of cells in the undo list.
(setq x (concat text (if (< maxcol ses--numcols) " " "\n")))
- ;;We use set-text-properties to prevent a wacky print function
- ;;from inserting rogue properties, and to ensure that the keymap
- ;;property is inherited (is it a bug that only unpropertied strings
- ;;actually inherit from surrounding text?)
+ ;; We use set-text-properties to prevent a wacky print function from
+ ;; inserting rogue properties, and to ensure that the keymap property is
+ ;; inherited (is it a bug that only unpropertied strings actually
+ ;; inherit from surrounding text?)
(set-text-properties 0 (length x) nil x)
(insert-and-inherit x)
(put-text-property startpos (point) 'intangible
(ses-cell-symbol cell))
(when (and (zerop row) (zerop col))
- ;;Reconstruct special beginning-of-buffer attributes
+ ;; Reconstruct special beginning-of-buffer attributes.
(put-text-property (point-min) (point) 'keymap 'ses-mode-print-map)
(put-text-property (point-min) (point) 'read-only 'ses)
(put-text-property (point-min) (1+ (point-min)) 'front-sticky t)))
(if (= row (1- ses--header-row))
- ;;This line is part of the header - force recalc
+ ;; This line is part of the header --- force recalc.
(ses-reset-header-string))
- ;;If this cell (or a preceding one on the line) previously spilled over
- ;;and has gotten shorter, redraw following cells on line recursively.
+ ;; If this cell (or a preceding one on the line) previously spilled over
+ ;; and has gotten shorter, redraw following cells on line recursively.
(when (and (< maxcol ses--numcols)
(eq (ses-cell-value row maxcol) '*skip*))
(ses-set-cell row maxcol 'value nil)
(ses-print-cell row maxcol))
- ;;Return to start of cell
+ ;; Return to start of cell.
(goto-char startpos)
sig)))
@@ -903,17 +1174,19 @@ The variable `ses-call-printer-return' is set to t if the printer used
parenthesis to request left-justification, or the error-signal if the
printer signaled one (and \"%s\" is used as the default printer), else nil."
(setq ses-call-printer-return nil)
- (unless value
- (setq value ""))
(condition-case signal
(cond
((stringp printer)
- (format printer value))
+ (if value
+ (format printer value)
+ ""))
((stringp (car-safe printer))
(setq ses-call-printer-return t)
- (format (car printer) value))
+ (if value
+ (format (car printer) value)
+ ""))
(t
- (setq value (funcall printer value))
+ (setq value (funcall printer (or value "")))
(if (stringp value)
value
(or (stringp (car-safe value))
@@ -932,13 +1205,13 @@ inhibit-quit to t."
(blank (if (> change 0) (make-string change ?\s)))
(at-end (= col ses--numcols)))
(ses-set-with-undo 'ses--linewidth (+ ses--linewidth change))
- ;;ses-set-with-undo always returns t for strings.
+ ;; ses-set-with-undo always returns t for strings.
(1value (ses-set-with-undo 'ses--blank-line
(concat (make-string ses--linewidth ?\s) "\n")))
(dotimes (row ses--numrows)
(ses-goto-print row col)
(when at-end
- ;;Insert new columns before newline
+ ;; Insert new columns before newline.
(let ((inhibit-point-motion-hooks t))
(backward-char 1)))
(if blank
@@ -976,13 +1249,13 @@ number, COL is the column number for a data cell -- otherwise DEF
is one of the symbols ses--col-widths, ses--col-printers,
ses--default-printer, ses--numrows, or ses--numcols."
(ses-widen)
- (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong
+ (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong.
(if col
- ;;It's a cell
+ ;; It's a cell.
(progn
(goto-char ses--data-marker)
(forward-line (+ 1 (* def (1+ ses--numcols)) col)))
- ;;Convert def-symbol to offset
+ ;; Convert def-symbol to offset.
(setq def (plist-get ses-paramlines-plist def))
(or def (signal 'args-out-of-range nil))
(goto-char ses--params-marker)
@@ -993,8 +1266,8 @@ ses--default-printer, ses--numrows, or ses--numcols."
See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped.
If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
(save-excursion
- ;;We call ses-goto-data early, using the old values of numrows and
- ;;numcols in case one of them is being changed.
+ ;; We call ses-goto-data early, using the old values of numrows and numcols
+ ;; in case one of them is being changed.
(ses-goto-data def)
(let ((inhibit-read-only t)
(fmt (plist-get '(ses--col-widths "(ses-column-widths %S)"
@@ -1012,7 +1285,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
(aset (symbol-value def) elem value))
(setq oldval (symbol-value def))
(set def value))
- ;;Special undo since it's outside the narrowed buffer
+ ;; Special undo since it's outside the narrowed buffer.
(let (buffer-undo-list)
(delete-region (point) (line-end-position))
(insert (format fmt (symbol-value def))))
@@ -1042,7 +1315,7 @@ Newlines in the data are escaped."
(setq formula (cadr formula)))
(if (eq (car-safe printer) 'ses-safe-printer)
(setq printer (cadr printer)))
- ;;This is noticably faster than (format "%S %S %S %S %S")
+ ;; This is noticably faster than (format "%S %S %S %S %S")
(setq text (concat "(ses-cell "
(symbol-name sym)
" "
@@ -1072,29 +1345,30 @@ Newlines in the data are escaped."
(defun ses-formula-references (formula &optional result-so-far)
"Produce a list of symbols for cells that this formula's value
-refers to. For recursive calls, RESULT-SO-FAR is the list being constructed,
-or t to get a wrong-type-argument error when the first reference is found."
- (if (atom formula)
- (if (ses-sym-rowcol formula)
- ;;Entire formula is one symbol
- (add-to-list 'result-so-far formula)
- ) ;;Ignore other atoms
- (dolist (cur formula)
- (cond
- ((ses-sym-rowcol cur)
- ;;Save this reference
- (add-to-list 'result-so-far cur))
- ((eq (car-safe cur) 'ses-range)
- ;;All symbols in range are referenced
- (dolist (x (cdr (macroexpand cur)))
- (add-to-list 'result-so-far x)))
- ((and (consp cur) (not (eq (car cur) 'quote)))
- ;;Recursive call for subformulas
- (setq result-so-far (ses-formula-references cur result-so-far)))
- (t
- ;;Ignore other stuff
- ))))
- result-so-far)
+refers to. For recursive calls, RESULT-SO-FAR is the list being
+constructed, or t to get a wrong-type-argument error when the
+first reference is found."
+ (if (ses-sym-rowcol formula)
+ ;;Entire formula is one symbol
+ (add-to-list 'result-so-far formula)
+ (if (consp formula)
+ (cond
+ ((eq (car formula) 'ses-range)
+ (dolist (cur
+ (cdr (funcall 'macroexpand
+ (list 'ses-range (nth 1 formula)
+ (nth 2 formula)))))
+ (add-to-list 'result-so-far cur)))
+ ((null (eq (car formula) 'quote))
+ ;;Recursive call for subformulas
+ (dolist (cur formula)
+ (setq result-so-far (ses-formula-references cur result-so-far))))
+ (t
+ ;;Ignore other stuff
+ ))
+ ;; other type of atom are ignored
+ ))
+ result-so-far)
(defsubst ses-relocate-symbol (sym rowcol startrow startcol rowincr colincr)
"Relocate one symbol SYM, whichs corresponds to ROWCOL (a cons of ROW and
@@ -1129,7 +1403,7 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed."
(if (setq rowcol (ses-sym-rowcol formula))
(ses-relocate-symbol formula rowcol
startrow startcol rowincr colincr)
- formula) ;Pass through as-is
+ formula) ; Pass through as-is.
(dolist (cur formula)
(setq rowcol (ses-sym-rowcol cur))
(cond
@@ -1138,9 +1412,9 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed."
startrow startcol rowincr colincr))
(if cur
(push cur result)
- ;;Reference to a deleted cell. Set a flag in ses-relocate-return.
- ;;don't change the flag if it's already 'range, since range
- ;;implies 'delete.
+ ;; Reference to a deleted cell. Set a flag in ses-relocate-return.
+ ;; don't change the flag if it's already 'range, since range implies
+ ;; 'delete.
(unless ses-relocate-return
(setq ses-relocate-return 'delete))))
((eq (car-safe cur) 'ses-range)
@@ -1148,10 +1422,10 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed."
(if cur
(push cur result)))
((or (atom cur) (eq (car cur) 'quote))
- ;;Constants pass through unchanged
+ ;; Constants pass through unchanged.
(push cur result))
(t
- ;;Recursively copy and alter subformulas
+ ;; Recursively copy and alter subformulas.
(push (ses-relocate-formula cur startrow startcol
rowincr colincr)
result))))
@@ -1177,47 +1451,47 @@ if the range was altered."
field)
(cond
((and (not min) (not max))
- (setq range nil)) ;;The entire range is deleted
+ (setq range nil)) ; The entire range is deleted.
((zerop colincr)
- ;;Inserting or deleting rows
+ ;; Inserting or deleting rows.
(setq field 'car)
(if (not min)
- ;;Chopped off beginning of range
+ ;; Chopped off beginning of range.
(setq min (ses-create-cell-symbol startrow (cdr minrowcol))
ses-relocate-return 'range))
(if (not max)
(if (> rowincr 0)
- ;;Trying to insert a nonexistent row
+ ;; Trying to insert a nonexistent row.
(setq max (ses-create-cell-symbol (1- ses--numrows)
(cdr minrowcol)))
- ;;End of range is being deleted
+ ;; End of range is being deleted.
(setq max (ses-create-cell-symbol (1- startrow) (cdr minrowcol))
ses-relocate-return 'range))
(and (> rowincr 0)
(= (car maxrowcol) (1- startrow))
(= (cdr minrowcol) (cdr maxrowcol))
- ;;Insert after ending row of vertical range - include it
+ ;; Insert after ending row of vertical range --- include it.
(setq max (ses-create-cell-symbol (+ startrow rowincr -1)
(cdr maxrowcol))))))
(t
- ;;Inserting or deleting columns
+ ;; Inserting or deleting columns.
(setq field 'cdr)
(if (not min)
- ;;Chopped off beginning of range
+ ;; Chopped off beginning of range.
(setq min (ses-create-cell-symbol (car minrowcol) startcol)
ses-relocate-return 'range))
(if (not max)
(if (> colincr 0)
- ;;Trying to insert a nonexistent column
+ ;; Trying to insert a nonexistent column.
(setq max (ses-create-cell-symbol (car maxrowcol)
(1- ses--numcols)))
- ;;End of range is being deleted
+ ;; End of range is being deleted.
(setq max (ses-create-cell-symbol (car maxrowcol) (1- startcol))
ses-relocate-return 'range))
(and (> colincr 0)
(= (cdr maxrowcol) (1- startcol))
(= (car minrowcol) (car maxrowcol))
- ;;Insert after ending column of horizontal range - include it
+ ;; Insert after ending column of horizontal range --- include it.
(setq max (ses-create-cell-symbol (car maxrowcol)
(+ startcol colincr -1)))))))
(when range
@@ -1225,9 +1499,9 @@ if the range was altered."
(funcall field minrowcol))
(- (funcall field (ses-sym-rowcol max))
(funcall field (ses-sym-rowcol min))))
- ;;This range has changed size
+ ;; This range has changed size.
(setq ses-relocate-return 'range))
- (list 'ses-range min max))))
+ `(ses-range ,min ,max ,@(cdddr range)))))
(defun ses-relocate-all (minrow mincol rowincr colincr)
"Alter all cell values, symbols, formulas, and reference-lists to relocate
@@ -1236,7 +1510,7 @@ to each symbol."
(let (reform)
(let (mycell newval)
(dotimes-with-progress-reporter
- (row ses--numrows) "Relocating formulas..."
+ (row ses--numrows) "Relocating formulas..."
(dotimes (col ses--numcols)
(setq ses-relocate-return nil
mycell (ses-get-cell row col)
@@ -1244,13 +1518,13 @@ to each symbol."
minrow mincol rowincr colincr))
(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
- ;;inserted or deleted in the middle of the range.
+ ;; This cell contains a (ses-range X Y) where a cell has been
+ ;; inserted or deleted in the middle of the range.
(push (cons row col) reform))
(if ses-relocate-return
- ;;This cell referred to a cell that's been deleted or is no
- ;;longer part of the range. We can't fix that now because
- ;;reference lists cells have been partially updated.
+ ;; This cell referred to a cell that's been deleted or is no
+ ;; longer part of the range. We can't fix that now because
+ ;; reference lists cells have been partially updated.
(add-to-list 'ses--deferred-recalc
(ses-create-cell-symbol row col)))
(setq newval (ses-relocate-formula (ses-cell-references mycell)
@@ -1259,13 +1533,13 @@ to each symbol."
(and (>= row minrow) (>= col mincol)
(ses-set-cell row col 'symbol
(ses-create-cell-symbol row col))))))
- ;;Relocate the cell values
+ ;; Relocate the cell values.
(let (oldval myrow mycol xrow xcol)
(cond
((and (<= rowincr 0) (<= colincr 0))
- ;;Deletion of rows and/or columns
+ ;; Deletion of rows and/or columns.
(dotimes-with-progress-reporter
- (row (- ses--numrows minrow)) "Relocating variables..."
+ (row (- ses--numrows minrow)) "Relocating variables..."
(setq myrow (+ row minrow))
(dotimes (col (- ses--numcols mincol))
(setq mycol (+ col mincol)
@@ -1273,11 +1547,11 @@ to each symbol."
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
+ ;; 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))))
((and (wholenump rowincr) (wholenump colincr))
- ;;Insertion of rows and/or columns. Run the loop backwards.
+ ;; Insertion of rows and/or columns. Run the loop backwards.
(let ((disty (1- ses--numrows))
(distx (1- ses--numcols))
myrow mycol)
@@ -1289,16 +1563,16 @@ to each symbol."
xrow (- myrow rowincr)
xcol (- mycol colincr))
(if (or (< xrow minrow) (< xcol mincol))
- ;;Newly-inserted value
+ ;; Newly-inserted value.
(setq oldval nil)
- ;;Transfer old value
+ ;; Transfer old value.
(setq oldval (ses-cell-value xrow xcol)))
(ses-set-cell myrow mycol 'value oldval)))
- t)) ;Make testcover happy by returning non-nil here
+ t)) ; Make testcover happy by returning non-nil here.
(t
(error "ROWINCR and COLINCR must have the same sign"))))
- ;;Reconstruct reference lists for cells that contain ses-ranges that
- ;;have changed size.
+ ;; Reconstruct reference lists for cells that contain ses-ranges that have
+ ;; changed size.
(when reform
(message "Fixing ses-ranges...")
(let (row col)
@@ -1324,9 +1598,9 @@ to each symbol."
(defun ses-set-with-undo (sym newval)
"Like set, but undoable. Result is t if value has changed."
- ;;We try to avoid adding redundant entries to the undo list, but this is
- ;;unavoidable for strings because equal ignores text properties and there's
- ;;no easy way to get the whole property list to see if it's different!
+ ;; We try to avoid adding redundant entries to the undo list, but this is
+ ;; unavoidable for strings because equal ignores text properties and there's
+ ;; no easy way to get the whole property list to see if it's different!
(unless (and (boundp sym)
(equal (symbol-value sym) newval)
(not (stringp newval)))
@@ -1339,14 +1613,15 @@ to each symbol."
(defun ses-unset-with-undo (sym)
"Set SYM to be unbound. This is undoable."
- (when (1value (boundp sym)) ;;Always bound, except after a programming error
+ (when (1value (boundp sym)) ; Always bound, except after a programming error.
(push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
(makunbound sym)))
(defun ses-aset-with-undo (array idx newval)
"Like aset, but undoable. Result is t if element has changed"
(unless (equal (aref array idx) newval)
- (push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list)
+ (push `(apply ses-aset-with-undo ,array ,idx
+ ,(aref array idx)) buffer-undo-list)
(aset array idx newval)
t))
@@ -1359,7 +1634,7 @@ to each symbol."
"Parse the current buffer and sets up buffer-local variables. Does not
execute cell formulas or print functions."
(widen)
- ;;Read our global parameters, which should be a 3-element list
+ ;; Read our global parameters, which should be a 3-element list.
(goto-char (point-max))
(search-backward ";; Local Variables:\n" nil t)
(backward-list 1)
@@ -1376,7 +1651,7 @@ execute cell formulas or print functions."
ses--numrows (cadr params)
ses--numcols (nth 2 params))
(when (= ses--file-format 1)
- (let (buffer-undo-list) ;This is not undoable
+ (let (buffer-undo-list) ; This is not undoable.
(ses-goto-data 'ses--header-row)
(insert "(ses-header-row 0)\n")
(ses-set-parameter 'ses--file-format 2)
@@ -1384,11 +1659,11 @@ execute cell formulas or print functions."
(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
+ ;; Initialize cell array.
(setq ses--cells (make-vector ses--numrows nil))
(dotimes (row ses--numrows)
(aset ses--cells row (make-vector ses--numcols nil))))
- ;;Skip over print area, which we assume is correct
+ ;; Skip over print area, which we assume is correct.
(goto-char (point-min))
(forward-line ses--numrows)
(or (looking-at ses-print-data-boundary)
@@ -1396,10 +1671,10 @@ execute cell formulas or print functions."
(forward-char 1)
(setq ses--data-marker (point-marker))
(forward-char (1- (length ses-print-data-boundary)))
- ;;Initialize printer and symbol lists
+ ;; Initialize printer and symbol lists.
(mapc 'ses-printer-record ses-standard-printer-functions)
(setq ses--symbolic-formulas nil)
- ;;Load cell definitions
+ ;; Load cell definitions.
(dotimes (row ses--numrows)
(dotimes (col ses--numcols)
(let* ((x (read (current-buffer)))
@@ -1412,7 +1687,7 @@ execute cell formulas or print functions."
(eval x)))
(or (looking-at "\n\n")
(error "Missing blank line between rows")))
- ;;Load global parameters
+ ;; Load global parameters.
(let ((widths (read (current-buffer)))
(n1 (char-after (point)))
(printers (read (current-buffer)))
@@ -1434,12 +1709,12 @@ execute cell formulas or print functions."
(1value (eval def-printer))
(1value (eval printers))
(1value (eval head-row)))
- ;;Should be back at global-params
+ ;; Should be back at global-params.
(forward-char 1)
(or (looking-at (replace-regexp-in-string "1" "[0-9]+"
ses-initial-global-parameters))
(error "Problem with column-defs or global-params"))
- ;;Check for overall newline count in definitions area
+ ;; Check for overall newline count in definitions area.
(forward-line 3)
(let ((start (point)))
(ses-goto-data 'ses--numrows)
@@ -1457,23 +1732,23 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
(inhibit-point-motion-hooks t)
(was-modified (buffer-modified-p))
pos sym)
- (ses-goto-data 0 0) ;;Include marker between print-area and data-area
- (set-text-properties (point) (point-max) nil) ;Delete garbage props
+ (ses-goto-data 0 0) ; Include marker between print-area and data-area.
+ (set-text-properties (point) (point-max) nil) ; Delete garbage props.
(mapc 'delete-overlay (overlays-in (point-min) (point-max)))
- ;;The print area is read-only (except for our special commands) and uses a
- ;;special keymap.
+ ;; The print area is read-only (except for our special commands) and uses a
+ ;; special keymap.
(put-text-property (point-min) (1- (point)) 'read-only 'ses)
(put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map)
- ;;For the beginning of the buffer, we want the read-only and keymap
- ;;attributes to be inherited from the first character
+ ;; For the beginning of the buffer, we want the read-only and keymap
+ ;; attributes to be inherited from the first character.
(put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
- ;;Create intangible properties, which also indicate which cell the text
- ;;came from.
+ ;; Create intangible properties, which also indicate which cell the text
+ ;; came from.
(dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
(dotimes (col ses--numcols)
(setq pos end
sym (ses-cell-symbol row col))
- ;;Include skipped cells following this one
+ ;; Include skipped cells following this one.
(while (and (< col (1- ses--numcols))
(eq (ses-cell-value row (1+ col)) '*skip*))
(setq end (+ end (ses-col-width col) 1)
@@ -1487,13 +1762,13 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
(forward-char)
(point))))
(put-text-property pos end 'intangible sym)))
- ;;Adding these properties did not actually alter the text
+ ;; Adding these properties did not actually alter the text.
(unless was-modified
(restore-buffer-modified-p nil)
(buffer-disable-undo)
(buffer-enable-undo)))
- ;;Create the underlining overlay. It's impossible for (point) to be 2,
- ;;because column A must be at least 1 column wide.
+ ;; Create the underlining overlay. It's impossible for (point) to be 2,
+ ;; because column A must be at least 1 column wide.
(setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min))))
(overlay-put ses--curcell-overlay 'face 'underline))
@@ -1502,15 +1777,15 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
Delete overlays, remove special text properties."
(widen)
(let ((inhibit-read-only t)
- ;; When reverting, hide the buffer name, otherwise Emacs will ask
- ;; the user "the file is modified, do you really want to make
- ;; modifications to this buffer", where the "modifications" refer to
- ;; the irrelevant set-text-properties below.
- (buffer-file-name nil)
+ ;; When reverting, hide the buffer name, otherwise Emacs will ask the
+ ;; user "the file is modified, do you really want to make modifications
+ ;; to this buffer", where the "modifications" refer to the irrelevant
+ ;; set-text-properties below.
+ (buffer-file-name nil)
(was-modified (buffer-modified-p)))
- ;;Delete read-only, keymap, and intangible properties
+ ;; Delete read-only, keymap, and intangible properties.
(set-text-properties (point-min) (point-max) nil)
- ;;Delete overlay
+ ;; Delete overlay.
(mapc 'delete-overlay (overlays-in (point-min) (point-max)))
(unless was-modified
(restore-buffer-modified-p nil))))
@@ -1530,30 +1805,26 @@ These are active only in the minibuffer, when entering or editing a formula:
(unless (and (boundp 'ses--deferred-narrow)
(eq ses--deferred-narrow 'ses-mode))
(kill-all-local-variables)
- (mapc 'make-local-variable ses-localvars)
+ (ses-set-localvars)
(setq major-mode 'ses-mode
mode-name "SES"
next-line-add-newlines nil
truncate-lines t
- ;;SES deliberately puts lots of trailing whitespace in its buffer
+ ;; SES deliberately puts lots of trailing whitespace in its buffer.
show-trailing-whitespace nil
- ;;Cell ranges do not work reasonably without this
+ ;; Cell ranges do not work reasonably without this.
transient-mark-mode t
- ;;not to use tab characters for safe
- ;;(tabs may do bad for column calculation)
+ ;; Not to use tab characters for safe (tabs may do bad for column
+ ;; calculation).
indent-tabs-mode nil)
(1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t))
(1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
- (setq ses--curcell nil
- ses--deferred-recalc nil
- ses--deferred-write nil
- ses--header-hscroll -1 ;Flag for "initial recalc needed"
- header-line-format '(:eval (progn
+ (setq header-line-format '(:eval (progn
(when (/= (window-hscroll)
ses--header-hscroll)
- ;;Reset ses--header-hscroll first, to
- ;;avoid recursion problems when
- ;;debugging ses-create-header-string
+ ;; Reset ses--header-hscroll first,
+ ;; to avoid recursion problems when
+ ;; debugging ses-create-header-string
(setq ses--header-hscroll
(window-hscroll))
(ses-create-header-string))
@@ -1562,12 +1833,13 @@ These are active only in the minibuffer, when entering or editing a formula:
(was-modified (buffer-modified-p)))
(save-excursion
(if was-empty
- ;;Initialize buffer to contain one cell, for now
+ ;; Initialize buffer to contain one cell, for now.
(insert ses-initial-file-contents))
(ses-load)
(ses-setup))
(when was-empty
- (unless (equal ses-initial-default-printer (1value ses--default-printer))
+ (unless (equal ses-initial-default-printer
+ (1value ses--default-printer))
(1value (ses-read-default-printer ses-initial-default-printer)))
(unless (= ses-initial-column-width (1value (ses-col-width 0)))
(1value (ses-set-column-width 0 ses-initial-column-width)))
@@ -1582,12 +1854,12 @@ These are active only in the minibuffer, when entering or editing a formula:
(buffer-enable-undo)
(goto-char (point-min))))
(use-local-map ses-mode-map)
- ;;Set the deferred narrowing flag (we can't narrow until after
- ;;after-find-file completes). If .ses is on the auto-load alist and the
- ;;file has "mode: ses", our ses-mode function will be called twice! Use
- ;;a special flag to detect this (will be reset by ses-command-hook).
- ;;For find-alternate-file, post-command-hook doesn't get run for some
- ;;reason, so use an idle timer to make sure.
+ ;; Set the deferred narrowing flag (we can't narrow until after
+ ;; after-find-file completes). If .ses is on the auto-load alist and the
+ ;; file has "mode: ses", our ses-mode function will be called twice! Use a
+ ;; special flag to detect this (will be reset by ses-command-hook). For
+ ;; find-alternate-file, post-command-hook doesn't get run for some reason,
+ ;; so use an idle timer to make sure.
(setq ses--deferred-narrow 'ses-mode)
(1value (add-hook 'post-command-hook 'ses-command-hook nil t))
(run-with-idle-timer 0.01 nil 'ses-command-hook)
@@ -1601,26 +1873,28 @@ moves the underlining overlay. Performs any recalculations or cell-data
writes that have been deferred. If buffer-narrowing has been deferred,
narrows the buffer now."
(condition-case err
- (when (eq major-mode 'ses-mode) ;Otherwise, not our buffer anymore
+ (when (eq major-mode 'ses-mode) ; Otherwise, not our buffer anymore.
(when ses--deferred-recalc
- ;;We reset the deferred list before starting on the recalc -- in case
- ;;of error, we don't want to retry the recalc after every keystroke!
+ ;; We reset the deferred list before starting on the recalc --- in
+ ;; case of error, we don't want to retry the recalc after every
+ ;; keystroke!
+ (ses-initialize-Dijkstra-attempt)
(let ((old ses--deferred-recalc))
(setq ses--deferred-recalc nil)
(ses-update-cells old)))
(when ses--deferred-write
- ;;We don't reset the deferred list before starting -- the most
- ;;likely error is keyboard-quit, and we do want to keep trying
- ;;these writes after a quit.
+ ;; We don't reset the deferred list before starting --- the most
+ ;; likely error is keyboard-quit, and we do want to keep trying these
+ ;; writes after a quit.
(ses-write-cells)
(push '(apply ses-widen) buffer-undo-list))
(when ses--deferred-narrow
- ;;We're not allowed to narrow the buffer until after-find-file has
- ;;read the local variables at the end of the file. Now it's safe to
- ;;do the narrowing.
+ ;; We're not allowed to narrow the buffer until after-find-file has
+ ;; read the local variables at the end of the file. Now it's safe to
+ ;; do the narrowing.
(narrow-to-region (point-min) ses--data-marker)
(setq ses--deferred-narrow nil))
- ;;Update the modeline
+ ;; Update the modeline.
(let ((oldcell ses--curcell))
(ses-set-curcell)
(unless (eq ses--curcell oldcell)
@@ -1636,34 +1910,34 @@ narrows the buffer now."
"-"
(symbol-name (cdr ses--curcell))))))
(force-mode-line-update)))
- ;;Use underline overlay for single-cells only, turn off otherwise
+ ;; Use underline overlay for single-cells only, turn off otherwise.
(if (listp ses--curcell)
(move-overlay ses--curcell-overlay 2 2)
(let ((next (next-single-property-change (point) 'intangible)))
(move-overlay ses--curcell-overlay (point) (1- next))))
(when (not (pos-visible-in-window-p))
- ;;Scrolling will happen later
+ ;; Scrolling will happen later.
(run-with-idle-timer 0.01 nil 'ses-command-hook)
(setq ses--curcell t)))
- ;;Prevent errors in this post-command-hook from silently erasing the hook!
+ ;; Prevent errors in this post-command-hook from silently erasing the hook!
(error
(unless executing-kbd-macro
(ding))
(message "%s" (error-message-string err))))
- nil) ;Make coverage-tester happy
+ nil) ; Make coverage-tester happy.
(defun ses-create-header-string ()
"Set up `ses--header-string' as the buffer's header line.
Based on the current set of columns and `window-hscroll' position."
(let ((totwidth (- (window-hscroll)))
result width x)
- ;;Leave room for the left-side fringe and scrollbar
+ ;; Leave room for the left-side fringe and scrollbar.
(push (propertize " " 'display '((space :align-to 0))) result)
(dotimes (col ses--numcols)
(setq width (ses-col-width col)
totwidth (+ totwidth width 1))
(if (= totwidth 1)
- ;;Scrolled so intercolumn space is leftmost
+ ;; Scrolled so intercolumn space is leftmost.
(push " " result))
(when (> totwidth 1)
(if (> ses--header-row 0)
@@ -1683,8 +1957,8 @@ Based on the current set of columns and `window-hscroll' position."
'display `((space :align-to ,(1- totwidth)))
'face ses-box-prop)
result)
- ;;Allow the following space to be squished to make room for the 3-D box
- ;;Coverage test ignores properties, thinks this is always a space!
+ ;; Allow the following space to be squished to make room for the 3-D box
+ ;; Coverage test ignores properties, thinks this is always a space!
(push (1value (propertize " " 'display `((space :align-to ,totwidth))))
result)))
(if (> ses--header-row 0)
@@ -1727,19 +2001,23 @@ print area if NONARROW is nil."
(search-forward ses-print-data-boundary)
(backward-char (length ses-print-data-boundary))
(delete-region (point-min) (point))
- ;;Insert all blank lines before printing anything, so ses-print-cell can
- ;;find the data area when inserting or deleting *skip* values for cells
+ ;; Insert all blank lines before printing anything, so ses-print-cell can
+ ;; find the data area when inserting or deleting *skip* values for cells.
(dotimes (row ses--numrows)
(insert-and-inherit ses--blank-line))
(dotimes-with-progress-reporter (row ses--numrows) "Reprinting..."
(if (eq (ses-cell-value row 0) '*skip*)
- ;;Column deletion left a dangling skip
+ ;; Column deletion left a dangling skip.
(ses-set-cell row 0 'value nil))
(dotimes (col ses--numcols)
(ses-print-cell row col))
(beginning-of-line 2))
(ses-jump-safe startcell)))
+(defun ses-initialize-Dijkstra-attempt ()
+ (setq ses--Dijkstra-attempt-nb (1+ ses--Dijkstra-attempt-nb)
+ ses--Dijkstra-weight-bound (* ses--numrows ses--numcols)))
+
(defun ses-recalculate-cell ()
"Recalculate and reprint the current cell or range.
@@ -1750,25 +2028,37 @@ to are recalculated first."
(interactive "*")
(ses-check-curcell 'range)
(ses-begin-change)
- (let (sig)
+ (ses-initialize-Dijkstra-attempt)
+ (let (sig cur-rowcol)
(setq ses-start-time (float-time))
(if (atom ses--curcell)
- (setq sig (ses-sym-rowcol ses--curcell)
- sig (ses-calculate-cell (car sig) (cdr sig) t))
- ;;First, recalculate all cells that don't refer to other cells and
- ;;produce a list of cells with references.
+ (when
+ (setq cur-rowcol (ses-sym-rowcol ses--curcell)
+ sig (progn
+ (ses-cell-property-set :ses-Dijkstra-attempt
+ (cons ses--Dijkstra-attempt-nb 0)
+ (car cur-rowcol) (cdr cur-rowcol) )
+ (ses-calculate-cell (car cur-rowcol) (cdr cur-rowcol) t)))
+ (nconc sig (list (ses-cell-symbol (car cur-rowcol)
+ (cdr cur-rowcol)))))
+ ;; First, recalculate all cells that don't refer to other cells and
+ ;; produce a list of cells with references.
(ses-dorange ses--curcell
(ses-time-check "Recalculating... %s" '(ses-cell-symbol row col))
(condition-case nil
(progn
- ;;The t causes an error if the cell has references.
- ;;If no references, the t will be the result value.
+ ;; The t causes an error if the cell has references. If no
+ ;; references, the t will be the result value.
(1value (ses-formula-references (ses-cell-formula row col) t))
- (setq sig (ses-calculate-cell row col t)))
+ (ses-cell-property-set :ses-Dijkstra-attempt
+ (cons ses--Dijkstra-attempt-nb 0)
+ row col)
+ (when (setq sig (ses-calculate-cell row col t))
+ (nconc sig (list (ses-cell-symbol row col)))))
(wrong-type-argument
- ;;The formula contains a reference
+ ;; The formula contains a reference.
(add-to-list 'ses--deferred-recalc (ses-cell-symbol row col))))))
- ;;Do the update now, so we can force recalculation
+ ;; Do the update now, so we can force recalculation.
(let ((x ses--deferred-recalc))
(setq ses--deferred-recalc nil)
(condition-case hold
@@ -1801,11 +2091,11 @@ cells."
(col (cdr rowcol)))
(when (and (< col (1- ses--numcols)) ;;Last column can't spill over, anyway
(eq (ses-cell-value row (1+ col)) '*skip*))
- ;;This cell has spill-over. We'll momentarily pretend the following
- ;;cell has a `t' in it.
+ ;; This cell has spill-over. We'll momentarily pretend the following cell
+ ;; has a `t' in it.
(eval `(let ((,(ses-cell-symbol row (1+ col)) t))
(ses-print-cell row col)))
- ;;Now remove the *skip*. ses-print-cell is always nil here
+ ;; Now remove the *skip*. ses-print-cell is always nil here.
(ses-set-cell row (1+ col) 'value nil)
(1value (ses-print-cell row (1+ col))))))
@@ -1817,12 +2107,12 @@ cells."
(let (x yrow ycol)
;;Delete old reference lists
(dotimes-with-progress-reporter
- (row ses--numrows) "Deleting references..."
+ (row ses--numrows) "Deleting references..."
(dotimes (col ses--numcols)
(ses-set-cell row col 'references nil)))
;;Create new reference lists
(dotimes-with-progress-reporter
- (row ses--numrows) "Computing references..."
+ (row ses--numrows) "Computing references..."
(dotimes (col ses--numcols)
(dolist (ref (ses-formula-references (ses-cell-formula row col)))
(setq x (ses-sym-rowcol ref)
@@ -1831,26 +2121,27 @@ cells."
(ses-set-cell yrow ycol 'references
(cons (ses-cell-symbol row col)
(ses-cell-references yrow ycol)))))))
- ;;Delete everything and reconstruct basic data area
+ ;; Delete everything and reconstruct basic data area.
(ses-widen)
(let ((inhibit-read-only t))
(goto-char (point-max))
(if (search-backward ";; Local Variables:\n" nil t)
(delete-region (point-min) (point))
- ;;Buffer is quite screwed up - can't even save the user-specified locals
+ ;; Buffer is quite screwed up --- can't even save the user-specified
+ ;; locals.
(delete-region (point-min) (point-max))
(insert ses-initial-file-trailer)
(goto-char (point-min)))
- ;;Create a blank display area
+ ;; Create a blank display area.
(dotimes (row ses--numrows)
(insert ses--blank-line))
(insert ses-print-data-boundary)
(backward-char (1- (length ses-print-data-boundary)))
(setq ses--data-marker (point-marker))
(forward-char (1- (length ses-print-data-boundary)))
- ;;Placeholders for cell data
+ ;; Placeholders for cell data.
(insert (make-string (* ses--numrows (1+ ses--numcols)) ?\n))
- ;;Placeholders for col-widths, col-printers, default-printer, header-row
+ ;; Placeholders for col-widths, col-printers, default-printer, header-row.
(insert "\n\n\n\n")
(insert ses-initial-global-parameters)
(backward-char (1- (length ses-initial-global-parameters)))
@@ -1890,13 +2181,13 @@ cell formula was unsafe and user declined confirmation."
(setq initial (format "'%S" (cadr formula)))
(setq initial (prin1-to-string formula)))
(if (stringp formula)
- ;;Position cursor inside close-quote
+ ;; Position cursor inside close-quote.
(setq initial (cons initial (length initial))))
(list row col
(read-from-minibuffer (format "Cell %s: " ses--curcell)
initial
ses-mode-edit-map
- t ;Convert to Lisp object
+ t ; Convert to Lisp object.
'ses-read-cell-history)))))
(when (ses-warn-unsafe newval 'unsafep)
(ses-begin-change)
@@ -1917,13 +2208,13 @@ cell formula was unsafe and user declined confirmation."
(cons (if (equal initial "\"") "\"\""
(if (equal initial "(") "()" initial)) 2)
ses-mode-edit-map
- t ;Convert to Lisp object
+ t ; Convert to Lisp object.
'ses-read-cell-history
(prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
(cadr curval)
curval))))))
(when (ses-edit-cell row col newval)
- (ses-command-hook) ;Update cell widths before movement
+ (ses-command-hook) ; Update cell widths before movement.
(dolist (x ses-after-entry-functions)
(funcall x 1))))
@@ -1939,10 +2230,10 @@ have been used as formulas in this spreadsheet is available for completions."
(list (car rowcol)
(cdr rowcol)
(if (string= newval "")
- nil ;Don't create zero-length symbols!
+ nil ; Don't create zero-length symbols!
(list 'quote (intern newval))))))
(when (ses-edit-cell row col symb)
- (ses-command-hook) ;Update cell widths before movement
+ (ses-command-hook) ; Update cell widths before movement.
(dolist (x ses-after-entry-functions)
(funcall x 1))))
@@ -1970,7 +2261,7 @@ cells."
(ses-check-curcell 'end)
(ses-begin-change)
(dotimes (x count)
- (backward-char 1) ;Will signal 'beginning-of-buffer if appropriate
+ (backward-char 1) ; Will signal 'beginning-of-buffer if appropriate.
(ses-set-curcell)
(let ((rowcol (ses-sym-rowcol ses--curcell)))
(ses-clear-cell (car rowcol) (cdr rowcol))))))
@@ -1990,13 +2281,13 @@ PROMPT should end with \": \". Result is t if operation was cancelled."
(substring prompt 0 -2)
default)))
(let ((new (read-from-minibuffer prompt
- nil ;Initial contents
+ nil ; Initial contents.
ses-mode-edit-map
- t ;Evaluate the result
+ t ; Evaluate the result.
'ses-read-printer-history
(prin1-to-string default))))
(if (equal new default)
- ;;User changed mind, decided not to change printer
+ ;; User changed mind, decided not to change printer.
(setq new t)
(ses-printer-validate new)
(or (not new)
@@ -2197,7 +2488,7 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER
;;ses-relocate-all)
(ses-goto-data row col)
(insert ?\n))
- ;;Insert column width and printer
+ ;; Insert column width and printer.
(setq widths (ses-vector-insert widths col width)
printers (ses-vector-insert printers col printer)))
(ses-set-parameter 'ses--col-widths widths)
@@ -2208,11 +2499,11 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER
(ses-reprint-all t)
(when (or (> (length (ses-call-printer printer)) 0)
(> (length (ses-call-printer ses--default-printer)) 0))
- ;;Either column printer or global printer inserts some constant text
- ;;Reprint the new columns to insert that text.
+ ;; Either column printer or global printer inserts some constant text.
+ ;; Reprint the new columns to insert that text.
(dotimes (x ses--numrows)
(dotimes (y count)
- ;Always nil here - this is a blank column
+ ;; Always nil here --- this is a blank column.
(1value (ses-print-cell-new-width x (+ y col))))))
(ses-setup)))
(ses-jump-safe ses--curcell))
@@ -2272,19 +2563,19 @@ from the current one."
inserts a new row if at bottom of print area. Repeat COUNT times."
(interactive "p")
(ses-check-curcell 'end)
- (setq deactivate-mark t) ;Doesn't combine well with ranges
+ (setq deactivate-mark t) ; Doesn't combine well with ranges.
(dotimes (x count)
(ses-set-curcell)
(if (not ses--curcell)
- (progn ;At bottom of print area
+ (progn ; At bottom of print area.
(barf-if-buffer-read-only)
(ses-insert-row 1))
(let ((col (cdr (ses-sym-rowcol ses--curcell))))
(when (/= 32
(char-before (next-single-property-change (point)
'intangible)))
- ;;We're already in last nonskipped cell on line. Need to create a
- ;;new column.
+ ;; We're already in last nonskipped cell on line. Need to create a
+ ;; new column.
(barf-if-buffer-read-only)
(ses-insert-column (- count x)
ses--numcols
@@ -2312,12 +2603,12 @@ inserts a new row if at bottom of print area. Repeat COUNT times."
(read-from-minibuffer (format "Column %s width [currently %d]: "
(ses-column-letter col)
(ses-col-width col))
- nil ;No initial contents
- nil ;No override keymap
- t ;Convert to Lisp object
- nil ;No history
+ nil ; No initial contents.
+ nil ; No override keymap.
+ t ; Convert to Lisp object.
+ nil ; No history.
(number-to-string
- (ses-col-width col))))))) ;Default value
+ (ses-col-width col))))))) ; Default value.
(if (< newwidth 1)
(error "Invalid column width"))
(ses-begin-change)
@@ -2349,7 +2640,7 @@ hard to override how mouse-1 works."
(if (not (and (eq major-mode 'ses-mode)
(eq (get-text-property beg 'read-only) 'ses)
(eq (get-text-property (1- end) 'read-only) 'ses)))
- ad-do-it ;Normal copy-region-as-kill
+ ad-do-it ; Normal copy-region-as-kill.
(kill-new (ses-copy-region beg end))
(if transient-mark-mode
(setq deactivate-mark t))
@@ -2400,17 +2691,17 @@ the corresponding data cell."
cells instead of deleting them."
(interactive "r")
(ses-check-curcell 'needrange)
- ;;For some reason, the text-read-only error is not caught by
- ;;`delete-region', so we have to use subterfuge.
+ ;; For some reason, the text-read-only error is not caught by `delete-region',
+ ;; so we have to use subterfuge.
(let ((buffer-read-only t))
(1value (condition-case x
(noreturn (funcall (lookup-key (current-global-map)
(this-command-keys))
beg end))
- (buffer-read-only nil)))) ;The expected error
- ;;Because the buffer was marked read-only, the kill command turned itself
- ;;into a copy. Now we clear the cells or signal the error. First we
- ;;check whether the buffer really is read-only.
+ (buffer-read-only nil)))) ; The expected error.
+ ;; Because the buffer was marked read-only, the kill command turned itself
+ ;; into a copy. Now we clear the cells or signal the error. First we check
+ ;; whether the buffer really is read-only.
(barf-if-buffer-read-only)
(ses-begin-change)
(ses-dorange ses--curcell
@@ -2437,7 +2728,7 @@ explicitly insert a symbol, or use the C-u prefix to treat all unmarked words
as symbols."
(if (not (and (eq major-mode 'ses-mode)
(eq (get-text-property (point) 'keymap) 'ses-mode-print-map)))
- ad-do-it ;Normal non-SES yank
+ ad-do-it ; Normal non-SES yank.
(ses-check-curcell 'end)
(push-mark (point))
(let ((text (current-kill (cond
@@ -2450,7 +2741,7 @@ as symbols."
text
0
(if (memq (aref text (1- (length text))) '(?\t ?\n))
- ;;Just one cell - delete final tab or newline
+ ;; Just one cell --- delete final tab or newline.
(1- (length text)))
arg)))
(if (consp arg)
@@ -2499,21 +2790,21 @@ formulas are to be inserted without relocation."
pos (next-single-property-change pos 'ses text)
x (ses-sym-rowcol (car last)))
(if (not last)
- ;;Newline - all remaining cells on row are skipped
+ ;; Newline --- all remaining cells on row are skipped.
(setq x (cons (- myrow rowincr) (+ needcols colincr -1))
last (list nil nil nil)
pos (1- pos)))
(if (/= (car x) (- myrow rowincr))
(error "Cell row error"))
(if (< (- mycol colincr) (cdr x))
- ;;Some columns were skipped
+ ;; Some columns were skipped.
(let ((oldcol mycol))
(while (< (- mycol colincr) (cdr x))
(ses-clear-cell myrow mycol)
(setq col (1+ col)
mycol (1+ mycol)))
- (ses-print-cell myrow (1- oldcol)))) ;;This inserts *skip*
- (when (car last) ;Skip this for *skip* cells
+ (ses-print-cell myrow (1- oldcol)))) ;; This inserts *skip*.
+ (when (car last) ; Skip this for *skip* cells.
(setq x (nth 2 last))
(unless (equal x (ses-cell-printer myrow mycol))
(or (not x)
@@ -2542,12 +2833,12 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list."
(error (cons nil from)))))
(cond
((< (cdr val) (or to (length text)))
- ;;Invalid sexp - leave it as a string
+ ;; Invalid sexp --- leave it as a string.
(setq val (substring text from to)))
((and (car val) (symbolp (car val)))
(if (consp arg)
- (setq val (list 'quote (car val))) ;Keep symbol
- (setq val (substring text from to)))) ;Treat symbol as text
+ (setq val (list 'quote (car val))) ; Keep symbol.
+ (setq val (substring text from to)))) ; Treat symbol as text.
(t
(setq val (car val))))
(let ((row (car rowcol))
@@ -2729,27 +3020,28 @@ The top row is row 1. Selecting row 0 displays the default header row."
"Move point to last cell on line."
(interactive)
(ses-check-curcell 'end 'range)
- (when ses--curcell ;Otherwise we're at the bottom row, which is empty anyway
+ (when ses--curcell ; Otherwise we're at the bottom row, which is empty
+ ; anyway.
(let ((col (1- ses--numcols))
row rowcol)
(if (symbolp ses--curcell)
- ;;Single cell
+ ;; Single cell.
(setq row (car (ses-sym-rowcol ses--curcell)))
- ;;Range - use whichever end of the range the point is at
+ ;; Range --- use whichever end of the range the point is at.
(setq rowcol (ses-sym-rowcol (if (< (point) (mark))
(car ses--curcell)
(cdr ses--curcell))))
- ;;If range already includes the last cell in a row, point is actually
- ;;in the following row
+ ;; If range already includes the last cell in a row, point is actually
+ ;; in the following row.
(if (<= (cdr rowcol) (1- col))
(setq row (car rowcol))
(setq row (1+ (car rowcol)))
(if (= row ses--numrows)
;;Already at end - can't go anywhere
(setq col 0))))
- (when (< row ses--numrows) ;Otherwise it's a range that includes last cell
+ (when (< row ses--numrows) ; Otherwise it's a range that includes last cell.
(while (eq (ses-cell-value row col) '*skip*)
- ;;Back to beginning of multi-column cell
+ ;; Back to beginning of multi-column cell.
(setq col (1- col)))
(ses-goto-print row col)))))
@@ -2801,7 +3093,7 @@ REVERSE order."
(interactive "*e\nP")
(setq event (event-end event))
(select-window (posn-window event))
- (setq event (car (posn-col-row event))) ;Click column
+ (setq event (car (posn-col-row event))) ; Click column.
(let ((col 0))
(while (and (< col ses--numcols) (> event (ses-col-width col)))
(setq event (- event (ses-col-width col) 1)
@@ -2816,7 +3108,7 @@ spreadsheet."
(interactive "*")
(let (x)
(with-current-buffer (window-buffer minibuffer-scroll-window)
- (ses-command-hook) ;For ses-coverage
+ (ses-command-hook) ; For ses-coverage.
(ses-check-curcell 'needrange)
(setq x (cdr (macroexpand `(ses-range ,(car ses--curcell)
,(cdr ses--curcell))))))
@@ -2828,7 +3120,7 @@ highlighted range in the spreadsheet."
(interactive "*")
(let (x)
(with-current-buffer (window-buffer minibuffer-scroll-window)
- (ses-command-hook) ;For ses-coverage
+ (ses-command-hook) ; For ses-coverage.
(ses-check-curcell 'needrange)
(setq x (format "(ses-range %S %S)"
(car ses--curcell)
@@ -2885,15 +3177,128 @@ is safe or user allows execution anyway. Always returns t if
;; Standard formulas
;;----------------------------------------------------------------------------
-(defmacro ses-range (from to)
- "Expands to a list of cell-symbols for the range. The range automatically
-expands to include any new row or column inserted into its middle. The SES
-library code specifically looks for the symbol `ses-range', so don't create an
-alias for this macro!"
- (let (result)
+(defun ses--clean-! (&rest x)
+ "Clean by delq list X from any occurrence of `nil' or `*skip*'."
+ (delq nil (delq '*skip* x)))
+
+(defun ses--clean-_ (x y)
+ "Clean list X by replacing by Y any occurrence of `nil' or `*skip*'.
+
+This will change X by making setcar on its cons cells."
+ (let ((ret x) ret-elt)
+ (while ret
+ (setq ret-elt (car ret))
+ (when (memq ret-elt '(nil *skip*))
+ (setcar ret y))
+ (setq ret (cdr ret))))
+ x)
+
+(defmacro ses-range (from to &rest rest)
+ "Expands to a list of cell-symbols for the range going from
+FROM up to TO. The range automatically expands to include any
+new row or column inserted into its middle. The SES library code
+specifically looks for the symbol `ses-range', so don't create an
+alias for this macro!
+
+By passing in REST some flags one can configure the way the range
+is read and how it is formatted.
+
+In the sequel we assume that cells A1, B1, A2 B2 have respective values
+1 2 3 and 4 for examplication.
+
+Readout direction is specified by a `>v', '`>^', `<v', `<^',
+`v>', `v<', `^>', `^<' flag. For historical reasons, in absence
+of such a flag, a default direction of `^<' is assumed. This
+way `(ses-range A1 B2 ^>)' will evaluate to `(1 3 2 4)',
+while `(ses-range A1 B2 >^)' will evaluate to (3 4 1 2).
+
+If the range is one row, then `>' can be used as a shorthand to
+`>v' or `>^', and `<' to `<v' or `<^'.
+
+If the range is one column, then `v' can be used as a shorthand to
+`v>' or `v<', and `^' to `^>' or `v<'.
+
+A `!' flag will remove all cells whose value is nil or `*skip*'.
+
+A `_' flag will replace nil or `*skip*' by the value following
+the `_' flag. If the `_' flag is the last argument, then they are
+replaced by integer 0.
+
+A `*', `*1' or `*2' flag will vectorize the range in the sense of
+Calc. See info node `(Calc) Top'. Flag `*' will output either a
+vector or a matrix depending on the number of rows, `*1' will
+flatten the result to a one row vector, and `*2' will make a
+matrix whatever the number of rows.
+
+Warning: interaction with Calc is expermimental and may produce
+confusing results if you are not aware of Calc data format. Use
+`math-format-value' as a printer for Calc objects."
+ (let (result-row
+ result
+ (prev-row -1)
+ (reorient-x nil)
+ (reorient-y nil)
+ transpose vectorize
+ (clean 'list))
(ses-dorange (cons from to)
- (push (ses-cell-symbol row col) result))
- (cons 'list result)))
+ (when (/= prev-row row)
+ (push result-row result)
+ (setq result-row nil))
+ (push (ses-cell-symbol row col) result-row)
+ (setq prev-row row))
+ (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
+ (cond
+ ; shorthands one row
+ ((and (null (cddr result)) (memq x '(> <)))
+ (push (intern (concat (symbol-name x) "v")) rest))
+ ; shorthands one col
+ ((and (null (cdar result)) (memq x '(v ^)))
+ (push (intern (concat (symbol-name x) ">")) rest))
+ (t (error "Unexpected flag `%S' in ses-range" x)))))))
+ (if reorient-y
+ (setcdr (last result 2) nil)
+ (setq result (cdr (nreverse result))))
+ (unless reorient-x
+ (setq result (mapcar 'nreverse result)))
+ (when transpose
+ (let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter)
+ (while result
+ (setq iter ret)
+ (dolist (elt (pop result))
+ (setcar iter (cons elt (car iter)))
+ (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)))))))
(defun ses-delete-blanks (&rest args)
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
@@ -2940,13 +3345,11 @@ TEST is evaluated."
;; Standard print functions
;;----------------------------------------------------------------------------
-;;These functions use the variables 'row' and 'col' that are
-;;dynamically bound by ses-print-cell. We define these variables at
-;;compile-time to make the compiler happy.
-(eval-when-compile
- (dolist (x '(row col))
- (make-local-variable x)
- (set x nil)))
+;; These functions use the variables 'row' and 'col' that are dynamically bound
+;; by ses-print-cell. We define these variables at compile-time to make the
+;; compiler happy.
+(defvar row)
+(defvar col)
(defun ses-center (value &optional span fill)
"Print VALUE, centered within column. FILL is the fill character for
@@ -2960,10 +3363,10 @@ columns to include in width (default = 0)."
(setq value (ses-call-printer printer value))
(dotimes (x span)
(setq width (+ width 1 (ses-col-width (+ col span (- x))))))
- ;; set column width
+ ;; Set column width.
(setq width (- width (string-width value)))
(if (<= width 0)
- value ;Too large for field, anyway
+ value ; Too large for field, anyway.
(setq half (make-string (/ width 2) fill))
(concat half value half
(if (> (% width 2) 0) (char-to-string fill))))))
@@ -3006,11 +3409,6 @@ current column and continues until the next nonblank column."
(dolist (fun '(copy-region-as-kill yank))
(ad-remove-advice fun 'around (intern (concat "ses-" (symbol-name fun))))
(ad-update fun))
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (when (eq major-mode 'ses-mode)
- (funcall (or (default-value 'major-mode) 'fundamental-mode)))))
;; continue standard unloading
nil)
diff --git a/lisp/sha1.el b/lisp/sha1.el
deleted file mode 100644
index 3f2e8f2a69b..00000000000
--- a/lisp/sha1.el
+++ /dev/null
@@ -1,441 +0,0 @@
-;;; sha1.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp
-
-;; Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;; Keywords: SHA1, FIPS 180-1
-
-;; 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 program is implemented from the definition of SHA-1 in FIPS PUB
-;; 180-1 (Federal Information Processing Standards Publication 180-1),
-;; "Announcing the Standard for SECURE HASH STANDARD".
-;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
-;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
-;;
-;; Test cases from FIPS PUB 180-1.
-;;
-;; (sha1 "abc")
-;; => a9993e364706816aba3e25717850c26c9cd0d89d
-;;
-;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
-;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
-;;
-;; (sha1 (make-string 1000000 ?a))
-;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
-;;
-;; BUGS:
-;; * It is assumed that length of input string is less than 2^29 bytes.
-;; * It is caller's responsibility to make string (or region) unibyte.
-;;
-;; TODO:
-;; * Rewrite from scratch!
-;; This version is much faster than Keiichi Suzuki's another sha1.el,
-;; but it is too dirty.
-
-;;; Code:
-
-(require 'hex-util)
-
-;;;
-;;; external SHA1 function.
-;;;
-
-(defgroup sha1 nil
- "Elisp interface for SHA1 hash computation."
- :version "22.1"
- :group 'extensions)
-
-(defcustom sha1-maximum-internal-length 500
- "Maximum length of message to use Lisp version of SHA1 function.
-If message is longer than this, `sha1-program' is used instead.
-
-If this variable is set to 0, use external program only.
-If this variable is set to nil, use internal function only."
- :type 'integer
- :group 'sha1)
-
-(defcustom 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 'sha1)
-
-(defcustom sha1-use-external (condition-case ()
- (executable-find (car sha1-program))
- (error))
- "Use external SHA1 program.
-If this variable is set to nil, use internal function only."
- :type 'boolean
- :group 'sha1)
-
-(defun sha1-string-external (string &optional binary)
- (let ((default-directory "/") ;; in case otherwise non-existent
- (process-connection-type nil) ;; pipe
- prog args digest)
- (if (consp sha1-program)
- (setq prog (car sha1-program)
- args (cdr sha1-program))
- (setq prog sha1-program
- args nil))
- (with-temp-buffer
- (unless (featurep 'xemacs) (set-buffer-multibyte nil))
- (insert string)
- (apply (function call-process-region)
- (point-min) (point-max)
- prog t t nil args)
- ;; SHA1 is 40 bytes long in hexadecimal form.
- (setq digest (buffer-substring (point-min)(+ (point-min) 40))))
- (if binary
- (decode-hex-string digest)
- digest)))
-
-(defun sha1-region-external (beg end &optional binary)
- (sha1-string-external (buffer-substring-no-properties beg end) binary))
-
-;;;
-;;; internal SHA1 function.
-;;;
-
-(eval-when-compile
- ;; optional second arg of string-to-number is new in v20.
- (defconst sha1-K0-high 23170) ; (string-to-number "5A82" 16)
- (defconst sha1-K0-low 31129) ; (string-to-number "7999" 16)
- (defconst sha1-K1-high 28377) ; (string-to-number "6ED9" 16)
- (defconst sha1-K1-low 60321) ; (string-to-number "EBA1" 16)
- (defconst sha1-K2-high 36635) ; (string-to-number "8F1B" 16)
- (defconst sha1-K2-low 48348) ; (string-to-number "BCDC" 16)
- (defconst sha1-K3-high 51810) ; (string-to-number "CA62" 16)
- (defconst sha1-K3-low 49622) ; (string-to-number "C1D6" 16)
-
- ;; original definition of sha1-F0.
- ;; (defmacro sha1-F0 (B C D)
- ;; (` (logior (logand (, B) (, C))
- ;; (logand (lognot (, B)) (, D)))))
- ;; a little optimization from GnuPG/cipher/sha1.c.
- (defmacro sha1-F0 (B C D)
- `(logxor ,D (logand ,B (logxor ,C ,D))))
- (defmacro sha1-F1 (B C D)
- `(logxor ,B ,C ,D))
- ;; original definition of sha1-F2.
- ;; (defmacro sha1-F2 (B C D)
- ;; (` (logior (logand (, B) (, C))
- ;; (logand (, B) (, D))
- ;; (logand (, C) (, D)))))
- ;; a little optimization from GnuPG/cipher/sha1.c.
- (defmacro sha1-F2 (B C D)
- `(logior (logand ,B ,C)
- (logand ,D (logior ,B ,C))))
- (defmacro sha1-F3 (B C D)
- `(logxor ,B ,C ,D))
-
- (defmacro sha1-S1 (W-high W-low)
- `(let ((W-high ,W-high)
- (W-low ,W-low))
- (setq S1W-high (+ (% (* W-high 2) 65536)
- (/ W-low ,(/ 65536 2))))
- (setq S1W-low (+ (/ W-high ,(/ 65536 2))
- (% (* W-low 2) 65536)))))
- (defmacro sha1-S5 (A-high A-low)
- `(progn
- (setq S5A-high (+ (% (* ,A-high 32) 65536)
- (/ ,A-low ,(/ 65536 32))))
- (setq S5A-low (+ (/ ,A-high ,(/ 65536 32))
- (% (* ,A-low 32) 65536)))))
- (defmacro sha1-S30 (B-high B-low)
- `(progn
- (setq S30B-high (+ (/ ,B-high 4)
- (* (% ,B-low 4) ,(/ 65536 4))))
- (setq S30B-low (+ (/ ,B-low 4)
- (* (% ,B-high 4) ,(/ 65536 4))))))
-
- (defmacro sha1-OP (round)
- `(progn
- (sha1-S5 sha1-A-high sha1-A-low)
- (sha1-S30 sha1-B-high sha1-B-low)
- (setq sha1-A-low (+ (,(intern (format "sha1-F%d" round))
- sha1-B-low sha1-C-low sha1-D-low)
- sha1-E-low
- ,(symbol-value
- (intern (format "sha1-K%d-low" round)))
- (aref block-low idx)
- (progn
- (setq sha1-E-low sha1-D-low)
- (setq sha1-D-low sha1-C-low)
- (setq sha1-C-low S30B-low)
- (setq sha1-B-low sha1-A-low)
- S5A-low)))
- (setq carry (/ sha1-A-low 65536))
- (setq sha1-A-low (% sha1-A-low 65536))
- (setq sha1-A-high (% (+ (,(intern (format "sha1-F%d" round))
- sha1-B-high sha1-C-high sha1-D-high)
- sha1-E-high
- ,(symbol-value
- (intern (format "sha1-K%d-high" round)))
- (aref block-high idx)
- (progn
- (setq sha1-E-high sha1-D-high)
- (setq sha1-D-high sha1-C-high)
- (setq sha1-C-high S30B-high)
- (setq sha1-B-high sha1-A-high)
- S5A-high)
- carry)
- 65536))))
-
- (defmacro sha1-add-to-H (H X)
- `(progn
- (setq ,(intern (format "sha1-%s-low" H))
- (+ ,(intern (format "sha1-%s-low" H))
- ,(intern (format "sha1-%s-low" X))))
- (setq carry (/ ,(intern (format "sha1-%s-low" H)) 65536))
- (setq ,(intern (format "sha1-%s-low" H))
- (% ,(intern (format "sha1-%s-low" H)) 65536))
- (setq ,(intern (format "sha1-%s-high" H))
- (% (+ ,(intern (format "sha1-%s-high" H))
- ,(intern (format "sha1-%s-high" X))
- carry)
- 65536))))
- )
-
-;;; buffers (H0 H1 H2 H3 H4).
-(defvar sha1-H0-high)
-(defvar sha1-H0-low)
-(defvar sha1-H1-high)
-(defvar sha1-H1-low)
-(defvar sha1-H2-high)
-(defvar sha1-H2-low)
-(defvar sha1-H3-high)
-(defvar sha1-H3-low)
-(defvar sha1-H4-high)
-(defvar sha1-H4-low)
-
-(defun sha1-block (block-high block-low)
- (let (;; step (c) --- initialize buffers (A B C D E).
- (sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low)
- (sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low)
- (sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low)
- (sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low)
- (sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low)
- (idx 16))
- ;; step (b).
- (let (;; temporary variables used in sha1-S1 macro.
- S1W-high S1W-low)
- (while (< idx 80)
- (sha1-S1 (logxor (aref block-high (- idx 3))
- (aref block-high (- idx 8))
- (aref block-high (- idx 14))
- (aref block-high (- idx 16)))
- (logxor (aref block-low (- idx 3))
- (aref block-low (- idx 8))
- (aref block-low (- idx 14))
- (aref block-low (- idx 16))))
- (aset block-high idx S1W-high)
- (aset block-low idx S1W-low)
- (setq idx (1+ idx))))
- ;; step (d).
- (setq idx 0)
- (let (;; temporary variables used in sha1-OP macro.
- S5A-high S5A-low S30B-high S30B-low carry)
- (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx)))
- (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx)))
- (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx)))
- (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx))))
- ;; step (e).
- (let (;; temporary variables used in sha1-add-to-H macro.
- carry)
- (sha1-add-to-H H0 A)
- (sha1-add-to-H H1 B)
- (sha1-add-to-H H2 C)
- (sha1-add-to-H H3 D)
- (sha1-add-to-H H4 E))))
-
-(defun sha1-binary (string)
- "Return the SHA1 of STRING in binary form."
- (let (;; prepare buffers for a block. byte-length of block is 64.
- ;; input block is split into two vectors.
- ;;
- ;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ...
- ;; block-high: +-0-+ +-1-+ +-2-+ +-3-+
- ;; block-low: +-0-+ +-1-+ +-2-+ +-3-+
- ;;
- ;; length of each vector is 80, and elements of each vector are
- ;; 16bit integers. elements 0x10-0x4F of each vector are
- ;; assigned later in `sha1-block'.
- (block-high (eval-when-compile (make-vector 80 nil)))
- (block-low (eval-when-compile (make-vector 80 nil))))
- (unwind-protect
- (let* (;; byte-length of input string.
- (len (length string))
- (lim (* (/ len 64) 64))
- (rem (% len 4))
- (idx 0)(pos 0))
- ;; initialize buffers (H0 H1 H2 H3 H4).
- (setq sha1-H0-high 26437 ; (string-to-number "6745" 16)
- sha1-H0-low 8961 ; (string-to-number "2301" 16)
- sha1-H1-high 61389 ; (string-to-number "EFCD" 16)
- sha1-H1-low 43913 ; (string-to-number "AB89" 16)
- sha1-H2-high 39098 ; (string-to-number "98BA" 16)
- sha1-H2-low 56574 ; (string-to-number "DCFE" 16)
- sha1-H3-high 4146 ; (string-to-number "1032" 16)
- sha1-H3-low 21622 ; (string-to-number "5476" 16)
- sha1-H4-high 50130 ; (string-to-number "C3D2" 16)
- sha1-H4-low 57840) ; (string-to-number "E1F0" 16)
- ;; loop for each 64 bytes block.
- (while (< pos lim)
- ;; step (a).
- (setq idx 0)
- (while (< idx 16)
- (aset block-high idx (+ (* (aref string pos) 256)
- (aref string (1+ pos))))
- (setq pos (+ pos 2))
- (aset block-low idx (+ (* (aref string pos) 256)
- (aref string (1+ pos))))
- (setq pos (+ pos 2))
- (setq idx (1+ idx)))
- (sha1-block block-high block-low))
- ;; last block.
- (if (prog1
- (< (- len lim) 56)
- (setq lim (- len rem))
- (setq idx 0)
- (while (< pos lim)
- (aset block-high idx (+ (* (aref string pos) 256)
- (aref string (1+ pos))))
- (setq pos (+ pos 2))
- (aset block-low idx (+ (* (aref string pos) 256)
- (aref string (1+ pos))))
- (setq pos (+ pos 2))
- (setq idx (1+ idx)))
- ;; this is the last (at most) 32bit word.
- (cond
- ((= rem 3)
- (aset block-high idx (+ (* (aref string pos) 256)
- (aref string (1+ pos))))
- (setq pos (+ pos 2))
- (aset block-low idx (+ (* (aref string pos) 256)
- 128)))
- ((= rem 2)
- (aset block-high idx (+ (* (aref string pos) 256)
- (aref string (1+ pos))))
- (aset block-low idx 32768))
- ((= rem 1)
- (aset block-high idx (+ (* (aref string pos) 256)
- 128))
- (aset block-low idx 0))
- (t ;; (= rem 0)
- (aset block-high idx 32768)
- (aset block-low idx 0)))
- (setq idx (1+ idx))
- (while (< idx 16)
- (aset block-high idx 0)
- (aset block-low idx 0)
- (setq idx (1+ idx))))
- ;; last block has enough room to write the length of string.
- (progn
- ;; write bit length of string to last 4 bytes of the block.
- (aset block-low 15 (* (% len 8192) 8))
- (setq len (/ len 8192))
- (aset block-high 15 (% len 65536))
- ;; XXX: It is not practical to compute SHA1 of
- ;; such a huge message on emacs.
- ;; (setq len (/ len 65536)) ; for 64bit emacs.
- ;; (aset block-low 14 (% len 65536))
- ;; (aset block-high 14 (/ len 65536))
- (sha1-block block-high block-low))
- ;; need one more block.
- (sha1-block block-high block-low)
- (fillarray block-high 0)
- (fillarray block-low 0)
- ;; write bit length of string to last 4 bytes of the block.
- (aset block-low 15 (* (% len 8192) 8))
- (setq len (/ len 8192))
- (aset block-high 15 (% len 65536))
- ;; XXX: It is not practical to compute SHA1 of
- ;; such a huge message on emacs.
- ;; (setq len (/ len 65536)) ; for 64bit emacs.
- ;; (aset block-low 14 (% len 65536))
- ;; (aset block-high 14 (/ len 65536))
- (sha1-block block-high block-low))
- ;; make output string (in binary form).
- (let ((result (make-string 20 0)))
- (aset result 0 (/ sha1-H0-high 256))
- (aset result 1 (% sha1-H0-high 256))
- (aset result 2 (/ sha1-H0-low 256))
- (aset result 3 (% sha1-H0-low 256))
- (aset result 4 (/ sha1-H1-high 256))
- (aset result 5 (% sha1-H1-high 256))
- (aset result 6 (/ sha1-H1-low 256))
- (aset result 7 (% sha1-H1-low 256))
- (aset result 8 (/ sha1-H2-high 256))
- (aset result 9 (% sha1-H2-high 256))
- (aset result 10 (/ sha1-H2-low 256))
- (aset result 11 (% sha1-H2-low 256))
- (aset result 12 (/ sha1-H3-high 256))
- (aset result 13 (% sha1-H3-high 256))
- (aset result 14 (/ sha1-H3-low 256))
- (aset result 15 (% sha1-H3-low 256))
- (aset result 16 (/ sha1-H4-high 256))
- (aset result 17 (% sha1-H4-high 256))
- (aset result 18 (/ sha1-H4-low 256))
- (aset result 19 (% sha1-H4-low 256))
- result))
- ;; do not leave a copy of input string.
- (fillarray block-high nil)
- (fillarray block-low nil))))
-
-(defun sha1-string-internal (string &optional binary)
- (if binary
- (sha1-binary string)
- (encode-hex-string (sha1-binary string))))
-
-(defun sha1-region-internal (beg end &optional binary)
- (sha1-string-internal (buffer-substring-no-properties beg end) binary))
-
-;;;
-;;; application interface.
-;;;
-
-(defun sha1-region (beg end &optional binary)
- (if (and sha1-use-external
- sha1-maximum-internal-length
- (> (abs (- end beg)) sha1-maximum-internal-length))
- (sha1-region-external beg end binary)
- (sha1-region-internal beg end binary)))
-
-(defun sha1-string (string &optional binary)
- (if (and sha1-use-external
- sha1-maximum-internal-length
- (> (length string) sha1-maximum-internal-length))
- (sha1-string-external string binary)
- (sha1-string-internal string binary)))
-
-;;;###autoload
-(defun sha1 (object &optional beg end binary)
- "Return the SHA1 (Secure Hash Algorithm) of an object.
-OBJECT is either a string or a buffer.
-Optional arguments BEG and END denote buffer positions for computing the
-hash of a portion of OBJECT.
-If BINARY is non-nil, return a string in binary form."
- (if (stringp object)
- (sha1-string object binary)
- (with-current-buffer object
- (sha1-region (or beg (point-min)) (or end (point-max)) binary))))
-
-(provide 'sha1)
-
-;;; sha1.el ends here
diff --git a/lisp/shell.el b/lisp/shell.el
index d6bc685618c..de811543ba0 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -98,6 +98,7 @@
(eval-when-compile (require 'cl))
(require 'comint)
+(require 'pcomplete)
;;; Customization and Buffer Variables
@@ -186,7 +187,9 @@ This is a fine thing to set in your `.emacs' file.")
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
@@ -380,6 +383,35 @@ to `dirtrack-mode'."
:group 'shell
:type '(choice (const nil) regexp))
+
+(defun shell-completion-vars ()
+ "Setup completion vars for `shell-mode' and `read-shell-command'."
+ (set (make-local-variable 'comint-completion-fignore)
+ shell-completion-fignore)
+ (set (make-local-variable 'comint-delimiter-argument-list)
+ shell-delimiter-argument-list)
+ (set (make-local-variable 'comint-file-name-chars) shell-file-name-chars)
+ (set (make-local-variable 'comint-file-name-quote-list)
+ shell-file-name-quote-list)
+ (set (make-local-variable 'comint-dynamic-complete-functions)
+ shell-dynamic-complete-functions)
+ (set (make-local-variable 'pcomplete-parse-arguments-function)
+ ;; FIXME: This function should be moved to shell.el.
+ #'pcomplete-parse-comint-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))))
+ ;; Don't use pcomplete's defaulting mechanism, rely on
+ ;; shell-dynamic-complete-functions instead.
+ (set (make-local-variable 'pcomplete-default-completion-function) #'ignore)
+ (setq comint-input-autoexpand shell-input-autoexpand)
+ ;; Not needed in shell-mode because it's inherited from comint-mode, but
+ ;; placed here for read-shell-command.
+ (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t))
+
(put 'shell-mode 'mode-class 'special)
(define-derived-mode shell-mode comint-mode "Shell"
@@ -437,22 +469,12 @@ Variables `comint-output-filter-functions', a hook, and
control whether input and output cause the window to scroll to the end of the
buffer."
(setq comint-prompt-regexp shell-prompt-pattern)
- (setq comint-completion-fignore shell-completion-fignore)
- (setq comint-delimiter-argument-list shell-delimiter-argument-list)
- (setq comint-file-name-chars shell-file-name-chars)
- (setq comint-file-name-quote-list shell-file-name-quote-list)
- (set (make-local-variable 'comint-dynamic-complete-functions)
- shell-dynamic-complete-functions)
+ (shell-completion-vars)
(set (make-local-variable 'paragraph-separate) "\\'")
- (make-local-variable 'paragraph-start)
- (setq paragraph-start comint-prompt-regexp)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(shell-font-lock-keywords t))
- (make-local-variable 'shell-dirstack)
- (setq shell-dirstack nil)
- (make-local-variable 'shell-last-dir)
- (setq shell-last-dir nil)
- (setq comint-input-autoexpand shell-input-autoexpand)
+ (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
+ (set (make-local-variable 'font-lock-defaults) '(shell-font-lock-keywords t))
+ (set (make-local-variable 'shell-dirstack) nil)
+ (set (make-local-variable 'shell-last-dir) nil)
(shell-dirtrack-mode 1)
;; 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.
@@ -693,6 +715,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
(concat "^" shell-command-separator-regexp)
str) ; skip whitespace
(match-end 0)))
+ (case-fold-search)
end cmd arg1)
(while (string-match shell-command-regexp str start)
(setq end (match-end 0)
@@ -1063,12 +1086,15 @@ Returns t if successful."
(list
start end
(lambda (string pred action)
- (completion-table-with-terminator
- " " (lambda (string pred action)
- (if (string-match "/" string)
- (completion-file-name-table string pred action)
- (complete-with-action action completions string pred)))
- string pred action)))))
+ (if (string-match "/" string)
+ (completion-file-name-table string pred action)
+ (complete-with-action action completions string pred)))
+ :exit-function
+ (lambda (_string finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at " ")
+ (goto-char (match-end 0))
+ (insert " ")))))))
;; (defun shell-dynamic-complete-as-command ()
;; "Dynamically complete at point as a command.
@@ -1139,18 +1165,17 @@ Returns non-nil if successful."
(substring x 0 (string-match "=" x)))
process-environment))
(suffix (case (char-before start) (?\{ "}") (?\( ")") (t ""))))
- (list
- start end
- (apply-partially
- #'completion-table-with-terminator
- (cons (lambda (comp)
- (concat comp
- suffix
- (if (file-directory-p
- (comint-directory (getenv comp)))
- "/")))
- "\\`a\\`")
- variables))))))
+ (list start end variables
+ :exit-function
+ (lambda (s finished)
+ (when (memq finished '(sole finished))
+ (let ((suf (concat suffix
+ (if (file-directory-p
+ (comint-directory (getenv s)))
+ "/"))))
+ (if (looking-at (regexp-quote suf))
+ (goto-char (match-end 0))
+ (insert suf))))))))))
(defun shell-c-a-p-replace-by-expanded-directory ()
diff --git a/lisp/simple.el b/lisp/simple.el
index 5efb6769e17..64333402924 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -36,10 +36,6 @@
;;; From compile.el
(defvar compilation-current-error)
(defvar compilation-context-lines)
-;;; From comint.el
-(defvar comint-file-name-quote-list)
-(defvar comint-file-name-chars)
-(defvar comint-delimiter-argument-list)
(defcustom idle-update-delay 0.5
"Idle time delay before updating various things on the screen.
@@ -56,60 +52,6 @@ wait this many seconds after Emacs becomes idle before doing an update."
(defgroup paren-matching nil
"Highlight (un)matching of parens and expressions."
:group 'matching)
-
-(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
- "Search LIST for a valid buffer to display in FRAME.
-Return nil when all buffers in LIST are undesirable for display,
-otherwise return the first suitable buffer in LIST.
-
-Buffers not visible in windows are preferred to visible buffers,
-unless VISIBLE-OK is non-nil.
-If the optional argument FRAME is nil, it defaults to the selected frame.
-If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
- ;; This logic is more or less copied from other-buffer.
- (setq frame (or frame (selected-frame)))
- (let ((pred (frame-parameter frame 'buffer-predicate))
- found buf)
- (while (and (not found) list)
- (setq buf (car list))
- (if (and (not (eq buffer buf))
- (buffer-live-p buf)
- (or (null pred) (funcall pred buf))
- (not (eq (aref (buffer-name buf) 0) ?\s))
- (or visible-ok (null (get-buffer-window buf 'visible))))
- (setq found buf)
- (setq list (cdr list))))
- (car list)))
-
-(defun last-buffer (&optional buffer visible-ok frame)
- "Return the last buffer in FRAME's buffer list.
-If BUFFER is the last buffer, return the preceding buffer instead.
-Buffers not visible in windows are preferred to visible buffers,
-unless optional argument VISIBLE-OK is non-nil.
-Optional third argument FRAME nil or omitted means use the
-selected frame's buffer list.
-If no such buffer exists, return the buffer `*scratch*', creating
-it if necessary."
- (setq frame (or frame (selected-frame)))
- (or (get-next-valid-buffer (nreverse (buffer-list frame))
- buffer visible-ok frame)
- (get-buffer "*scratch*")
- (let ((scratch (get-buffer-create "*scratch*")))
- (set-buffer-major-mode scratch)
- scratch)))
-
-(defun next-buffer ()
- "Switch to the next buffer in cyclic order."
- (interactive)
- (let ((buffer (current-buffer)))
- (switch-to-buffer (other-buffer buffer t))
- (bury-buffer buffer)))
-
-(defun previous-buffer ()
- "Switch to the previous buffer in cyclic order."
- (interactive)
- (switch-to-buffer (last-buffer (current-buffer) t)))
-
;;; next-error support framework
@@ -971,13 +913,11 @@ rather than line counts."
(concat " in " (buffer-name buffer))
"")))
;; Read the argument, offering that number (if any) as default.
- (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
- "Goto line%s: ")
- buffer-prompt
- default)
- nil nil t
- 'minibuffer-history
- default)
+ (list (read-number (format (if default "Goto line%s (%s): "
+ "Goto line%s: ")
+ buffer-prompt
+ default)
+ default)
buffer))))
;; Switch to the desired buffer, one way or another.
(if buffer
@@ -1162,6 +1102,7 @@ in *Help* buffer. See also the command `describe-char'."
(defvar minibuffer-completing-symbol nil
"Non-nil means completing a Lisp symbol in the minibuffer.")
+(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get)
(defvar minibuffer-default nil
"The current default value or list of default values in the minibuffer.
@@ -1211,6 +1152,8 @@ display the result of expression evaluation."
(defun eval-expression (eval-expression-arg
&optional eval-expression-insert-value)
"Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
+When called interactively, read an Emacs Lisp expression and
+evaluate it.
Value is also consed on to front of the variable `values'.
Optional argument EVAL-EXPRESSION-INSERT-VALUE non-nil (interactively,
with prefix argument) means insert the result into the current buffer
@@ -2167,12 +2110,7 @@ to the end of the list of defaults just after the default value."
(append minibuffer-default commands)
(cons minibuffer-default commands))))
-(defvar shell-delimiter-argument-list)
-(defvar shell-file-name-chars)
-(defvar shell-file-name-quote-list)
-(defvar shell-dynamic-complete-functions)
-;; shell requires comint.
-(defvar comint-dynamic-complete-functions)
+(declare-function shell-completion-vars "shell" ())
(defvar minibuffer-local-shell-command-map
(let ((map (make-sparse-keymap)))
@@ -2189,15 +2127,7 @@ to `shell-command-history'."
(require 'shell)
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'comint-delimiter-argument-list)
- shell-delimiter-argument-list)
- (set (make-local-variable 'comint-file-name-chars) shell-file-name-chars)
- (set (make-local-variable 'comint-file-name-quote-list)
- shell-file-name-quote-list)
- (set (make-local-variable 'comint-dynamic-complete-functions)
- shell-dynamic-complete-functions)
- (add-hook 'completion-at-point-functions
- 'comint-completion-at-point nil 'local)
+ (shell-completion-vars)
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-shell-commands))
(apply 'read-from-minibuffer prompt initial-contents
@@ -2603,7 +2533,11 @@ specifies the value of ERROR-BUFFER."
(let ((output
(if (and error-file
(< 0 (nth 7 (file-attributes error-file))))
- "some error output"
+ (format "some error output%s"
+ (if shell-command-default-error-buffer
+ (format " to the \"%s\" buffer"
+ shell-command-default-error-buffer)
+ ""))
"no output")))
(cond ((null exit-status)
(message "(Shell command failed with error)"))
@@ -2831,25 +2765,21 @@ The return value is always nil."
`universal-argument-other-key' uses this to discard those events
from (this-command-keys), and reread only the final command.")
-(defvar overriding-map-is-bound nil
- "Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.")
-
-(defvar saved-overriding-map nil
+(defvar saved-overriding-map t
"The saved value of `overriding-terminal-local-map'.
That variable gets restored to this value on exiting \"universal
argument mode\".")
-(defun ensure-overriding-map-is-bound ()
- "Check `overriding-terminal-local-map' is `universal-argument-map'."
- (unless overriding-map-is-bound
+(defun save&set-overriding-map (map)
+ "Set `overriding-terminal-local-map' to MAP."
+ (when (eq saved-overriding-map t)
(setq saved-overriding-map overriding-terminal-local-map)
- (setq overriding-terminal-local-map universal-argument-map)
- (setq overriding-map-is-bound t)))
+ (setq overriding-terminal-local-map map)))
(defun restore-overriding-map ()
"Restore `overriding-terminal-local-map' to its saved value."
(setq overriding-terminal-local-map saved-overriding-map)
- (setq overriding-map-is-bound nil))
+ (setq saved-overriding-map t))
(defun universal-argument ()
"Begin a numeric argument for the following command.
@@ -2864,7 +2794,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
(setq universal-argument-num-events (length (this-command-keys)))
- (ensure-overriding-map-is-bound))
+ (save&set-overriding-map universal-argument-map))
;; A subsequent C-u means to multiply the factor by 4 if we've typed
;; nothing but C-u's; otherwise it means to terminate the prefix arg.
@@ -2889,7 +2819,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(t
(setq prefix-arg '-)))
(setq universal-argument-num-events (length (this-command-keys)))
- (ensure-overriding-map-is-bound))
+ (save&set-overriding-map universal-argument-map))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
@@ -2908,7 +2838,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(t
(setq prefix-arg digit))))
(setq universal-argument-num-events (length (this-command-keys)))
- (ensure-overriding-map-is-bound))
+ (save&set-overriding-map universal-argument-map))
;; For backward compatibility, minus with no modifiers is an ordinary
;; command if digits have already been entered.
@@ -5193,8 +5123,8 @@ Returns t if it really did any work."
(or (null fill-prefix) (string= fill-prefix "")))
(let ((prefix
(fill-context-prefix
- (save-excursion (backward-paragraph 1) (point))
- (save-excursion (forward-paragraph 1) (point)))))
+ (save-excursion (fill-forward-paragraph -1) (point))
+ (save-excursion (fill-forward-paragraph 1) (point)))))
(and prefix (not (equal prefix ""))
;; Use auto-indentation rather than a guessed empty prefix.
(not (and fill-indent-according-to-mode
@@ -5375,11 +5305,12 @@ The variable `selective-display' has a separate value for each buffer."
(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
(defun toggle-truncate-lines (&optional arg)
- "Toggle whether to fold or truncate long lines for the current buffer.
+ "Toggle truncating of long lines for the current buffer.
+When truncating is off, long lines are folded.
With prefix argument ARG, truncate long lines if ARG is positive,
-otherwise don't truncate them. Note that in side-by-side windows,
-this command has no effect if `truncate-partial-width-windows'
-is non-nil."
+otherwise fold them. Note that in side-by-side windows, this
+command has no effect if `truncate-partial-width-windows' is
+non-nil."
(interactive "P")
(setq truncate-lines
(if (null arg)
@@ -5589,11 +5520,11 @@ The function should return non-nil if the two tokens do not match.")
(mismatch
(if blinkpos
(if (minibufferp)
- (minibuffer-message " [Mismatched parentheses]")
+ (minibuffer-message "Mismatched parentheses")
(message "Mismatched parentheses"))
(if (minibufferp)
- (minibuffer-message " [Unmatched parenthesis]")
- (message "Unmatched parenthesis"))))
+ (minibuffer-message "No matching parenthesis found")
+ (message "No matching parenthesis found"))))
((not blinkpos) nil)
((pos-visible-in-window-p blinkpos)
;; Matching open within window, temporarily move to blinkpos but only
@@ -5676,7 +5607,8 @@ At top-level, as an editor command, this simply beeps."
(if (fboundp 'kmacro-keyboard-quit)
(kmacro-keyboard-quit))
(setq defining-kbd-macro nil)
- (signal 'quit nil))
+ (let ((debug-on-quit nil))
+ (signal 'quit nil)))
(defvar buffer-quit-function nil
"Function to call to \"quit\" the current buffer, or nil if none.
@@ -5985,6 +5917,12 @@ Its value is a list of the form (START END) where START is the place
where the completion should be inserted and END (if non-nil) is the end
of the text to replace. If END is nil, point is used instead.")
+(defvar completion-list-insert-choice-function #'completion--replace
+ "Function to use to insert the text chosen in *Completions*.
+Called with 3 arguments (BEG END TEXT), it should replace the text
+between BEG and END with TEXT. Expected to be set buffer-locally
+in the *Completions* buffer.")
+
(defvar completion-base-size nil
"Number of chars before point not involved in completion.
This is a local variable in the completion list buffer.
@@ -6048,26 +5986,30 @@ With prefix argument N, move N items (negative N means move backward)."
;; In case this is run via the mouse, give temporary modes such as
;; isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
- (let (buffer base-size base-position choice)
- (with-current-buffer (window-buffer (posn-window (event-start event)))
- (setq buffer completion-reference-buffer)
- (setq base-size completion-base-size)
- (setq base-position completion-base-position)
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (let (beg end)
- (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
- (setq end (point) beg (1+ (point))))
- (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg (point)))
- (if (null beg)
- (error "No completion here"))
- (setq beg (previous-single-property-change beg 'mouse-face))
- (setq end (or (next-single-property-change end 'mouse-face)
- (point-max)))
- (setq choice (buffer-substring-no-properties beg end)))))
-
- (let ((owindow (selected-window)))
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
+ (let ((buffer completion-reference-buffer)
+ (base-size completion-base-size)
+ (base-position completion-base-position)
+ (insert-function completion-list-insert-choice-function)
+ (choice
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let (beg end)
+ (cond
+ ((and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ ((and (not (bobp))
+ (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg (point)))
+ (t (error "No completion here")))
+ (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)))
+
+ (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)))
@@ -6076,20 +6018,20 @@ With prefix argument N, move N items (negative N means move backward)."
(or (window-dedicated-p (selected-window))
(bury-buffer)))
(select-window
- (or (and (buffer-live-p buffer)
- (get-buffer-window buffer 0))
- owindow)))
-
- (choose-completion-string
- choice buffer
- (or base-position
- (when base-size
- ;; Someone's using old completion code that doesn't know
- ;; about base-position yet.
- (list (+ base-size (with-current-buffer buffer (field-beginning)))))
- ;; If all else fails, just guess.
- (with-current-buffer buffer
- (list (choose-completion-guess-base-position choice)))))))
+ (or (get-buffer-window buffer 0)
+ owindow))
+
+ (with-current-buffer buffer
+ (choose-completion-string
+ choice buffer
+ (or base-position
+ (when base-size
+ ;; Someone's using old completion code that doesn't know
+ ;; about base-position yet.
+ (list (+ base-size (field-beginning))))
+ ;; If all else fails, just guess.
+ (list (choose-completion-guess-base-position choice)))
+ insert-function)))))
;; Delete the longest partial match for STRING
;; that can be found before POINT.
@@ -6135,7 +6077,8 @@ the minibuffer; no further functions will be called.
If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")
-(defun choose-completion-string (choice &optional buffer base-position)
+(defun choose-completion-string (choice &optional
+ buffer base-position insert-function)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-POSITION, says where to insert the completion."
@@ -6155,8 +6098,8 @@ BASE-POSITION, says where to insert the completion."
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
(if (and mini-p
- (or (not (active-minibuffer-window))
- (not (equal buffer
+ (not (and (active-minibuffer-window)
+ (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
;; Set buffer so buffer-local choose-completion-string-functions works.
@@ -6168,13 +6111,15 @@ BASE-POSITION, says where to insert the completion."
;; and indeed unused. The last used to be `base-size', so we
;; keep it to try and avoid breaking old code.
choice buffer base-position nil)
+ ;; This remove-text-properties should be unnecessary since `choice'
+ ;; comes from buffer-substring-no-properties.
+ ;;(remove-text-properties 0 (lenth choice) '(mouse-face nil) choice)
;; Insert the completion into the buffer where it was requested.
- (delete-region (or (car base-position) (point))
- (or (cadr base-position) (point)))
- (insert choice)
- (remove-text-properties (- (point) (length choice)) (point)
- '(mouse-face nil))
- ;; Update point in the window that BUFFER is showing in.
+ (funcall (or insert-function completion-list-insert-choice-function)
+ (or (car base-position) (point))
+ (or (cadr base-position) (point))
+ choice)
+ ;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer t)))
(set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice.
@@ -6240,10 +6185,13 @@ Called from `temp-buffer-show-hook'."
0 (or completion-base-size 0)))))))
(with-current-buffer standard-output
(let ((base-size completion-base-size) ;Read before killing localvars.
- (base-position completion-base-position))
+ (base-position completion-base-position)
+ (insert-fun completion-list-insert-choice-function))
(completion-list-mode)
(set (make-local-variable 'completion-base-size) base-size)
- (set (make-local-variable 'completion-base-position) base-position))
+ (set (make-local-variable 'completion-base-position) base-position)
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ insert-fun))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
(if base-dir (setq default-directory base-dir))
;; Maybe insert help string.
diff --git a/lisp/startup.el b/lisp/startup.el
index 14f4c7829d1..6953ed25ed4 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -41,8 +41,9 @@
(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 or
-directory using `find-file'. If t, open the `*scratch*' buffer."
+startup screen. If the value is string, visit the specified file
+or directory using `find-file'. If t, open the `*scratch*'
+buffer."
:type '(choice
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
@@ -1293,7 +1294,7 @@ If this is nil, no message will be displayed."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst fancy-startup-text
- `((:face (variable-pitch (:foreground "red"))
+ `((:face (variable-pitch font-lock-comment-face)
"Welcome to "
:link ("GNU Emacs"
,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1350,7 +1351,7 @@ Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")
(defconst fancy-about-text
- `((:face (variable-pitch (:foreground "red"))
+ `((:face (variable-pitch font-lock-comment-face)
"This is "
:link ("GNU Emacs"
,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1366,11 +1367,7 @@ Each element in the list should be a list of strings or pairs
`("GNU" ,(lambda (_button) (describe-gnu-project))
"Display info on the GNU project.")))
" operating system.\n"
- :face ,(lambda ()
- (list 'variable-pitch
- (list :foreground
- (if (eq (frame-parameter nil 'background-mode) 'dark)
- "cyan" "darkblue"))))
+ :face (variable-pitch font-lock-builtin-face)
"\n"
,(lambda () (emacs-version))
"\n"
@@ -1426,8 +1423,7 @@ Each element in the list should be a list of strings or pairs
,(lambda (_button)
(browse-url "http://www.gnu.org/software/emacs/tour/"))
"Browse http://www.gnu.org/software/emacs/tour/")
- "\tSee an overview of Emacs features at gnu.org"
- ))
+ "\tSee an overview of Emacs features at gnu.org"))
"A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")
@@ -1537,93 +1533,91 @@ a face or button specification."
(defun fancy-startup-tail (&optional concise)
"Insert the tail part of the splash screen into the current buffer."
- (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
- "cyan" "darkblue")))
- (unless concise
- (fancy-splash-insert
- :face 'variable-pitch
- "\nTo start... "
- :link `("Open a File"
- ,(lambda (_button) (call-interactively 'find-file))
- "Specify a new file's name, to edit the file")
- " "
- :link `("Open Home Directory"
- ,(lambda (_button) (dired "~"))
- "Open your home directory, to operate on its files")
- " "
- :link `("Customize Startup"
- ,(lambda (_button) (customize-group 'initialization))
- "Change initialization settings including this screen")
- "\n"))
+ (unless concise
(fancy-splash-insert
- :face 'variable-pitch "To quit a partially entered command, type "
- :face 'default "Control-g"
- :face 'variable-pitch ".\n")
- (fancy-splash-insert :face `(variable-pitch (:foreground ,fg))
- "\nThis is "
- (emacs-version)
- "\n"
- :face '(variable-pitch (:height 0.8))
- emacs-copyright
- "\n")
- (and auto-save-list-file-prefix
- ;; Don't signal an error if the
- ;; directory for auto-save-list files
- ;; does not yet exist.
- (file-directory-p (file-name-directory
- auto-save-list-file-prefix))
- (directory-files
- (file-name-directory auto-save-list-file-prefix)
- nil
- (concat "\\`"
- (regexp-quote (file-name-nondirectory
- auto-save-list-file-prefix)))
- t)
- (fancy-splash-insert :face '(variable-pitch (:foreground "red"))
- "\nIf an Emacs session crashed recently, "
- "type "
- :face '(fixed-pitch :foreground "red")
- "Meta-x recover-session RET"
- :face '(variable-pitch (:foreground "red"))
- "\nto recover"
- " the files you were editing."))
-
- (when concise
- (fancy-splash-insert
- :face 'variable-pitch "\n"
- :link `("Dismiss this startup screen"
- ,(lambda (_button)
- (when startup-screen-inhibit-startup-screen
- (customize-set-variable 'inhibit-startup-screen t)
- (customize-mark-to-save 'inhibit-startup-screen)
- (custom-save-all))
- (let ((w (get-buffer-window "*GNU Emacs*")))
- (and w (not (one-window-p)) (delete-window w)))
- (kill-buffer "*GNU Emacs*")))
- " ")
- (when (or user-init-file custom-file)
- (let ((checked (create-image "checked.xpm"
- nil nil :ascent 'center))
- (unchecked (create-image "unchecked.xpm"
- nil nil :ascent 'center)))
- (insert-button
- " "
- :on-glyph checked
- :off-glyph unchecked
- 'checked nil 'display unchecked 'follow-link t
- 'action (lambda (button)
- (if (overlay-get button 'checked)
- (progn (overlay-put button 'checked nil)
- (overlay-put button 'display
- (overlay-get button :off-glyph))
- (setq startup-screen-inhibit-startup-screen
- nil))
- (overlay-put button 'checked t)
- (overlay-put button 'display
- (overlay-get button :on-glyph))
- (setq startup-screen-inhibit-startup-screen t)))))
- (fancy-splash-insert :face '(variable-pitch (:height 0.9))
- " Never show it again.")))))
+ :face 'variable-pitch
+ "\nTo start... "
+ :link `("Open a File"
+ ,(lambda (_button) (call-interactively 'find-file))
+ "Specify a new file's name, to edit the file")
+ " "
+ :link `("Open Home Directory"
+ ,(lambda (_button) (dired "~"))
+ "Open your home directory, to operate on its files")
+ " "
+ :link `("Customize Startup"
+ ,(lambda (_button) (customize-group 'initialization))
+ "Change initialization settings including this screen")
+ "\n"))
+ (fancy-splash-insert
+ :face 'variable-pitch "To quit a partially entered command, type "
+ :face 'default "Control-g"
+ :face 'variable-pitch ".\n")
+ (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face)
+ "\nThis is "
+ (emacs-version)
+ "\n"
+ :face '(variable-pitch (:height 0.8))
+ emacs-copyright
+ "\n")
+ (and auto-save-list-file-prefix
+ ;; Don't signal an error if the
+ ;; directory for auto-save-list files
+ ;; does not yet exist.
+ (file-directory-p (file-name-directory
+ auto-save-list-file-prefix))
+ (directory-files
+ (file-name-directory auto-save-list-file-prefix)
+ nil
+ (concat "\\`"
+ (regexp-quote (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
+ "\nIf an Emacs session crashed recently, "
+ "type "
+ :face '(fixed-pitch font-lock-comment-face)
+ "Meta-x recover-session RET"
+ :face '(variable-pitch font-lock-comment-face)
+ "\nto recover"
+ " the files you were editing."))
+
+ (when concise
+ (fancy-splash-insert
+ :face 'variable-pitch "\n"
+ :link `("Dismiss this startup screen"
+ ,(lambda (_button)
+ (when startup-screen-inhibit-startup-screen
+ (customize-set-variable 'inhibit-startup-screen t)
+ (customize-mark-to-save 'inhibit-startup-screen)
+ (custom-save-all))
+ (let ((w (get-buffer-window "*GNU Emacs*")))
+ (and w (not (one-window-p)) (delete-window w)))
+ (kill-buffer "*GNU Emacs*")))
+ " ")
+ (when (or user-init-file custom-file)
+ (let ((checked (create-image "checked.xpm"
+ nil nil :ascent 'center))
+ (unchecked (create-image "unchecked.xpm"
+ nil nil :ascent 'center)))
+ (insert-button
+ " "
+ :on-glyph checked
+ :off-glyph unchecked
+ 'checked nil 'display unchecked 'follow-link t
+ 'action (lambda (button)
+ (if (overlay-get button 'checked)
+ (progn (overlay-put button 'checked nil)
+ (overlay-put button 'display
+ (overlay-get button :off-glyph))
+ (setq startup-screen-inhibit-startup-screen
+ nil))
+ (overlay-put button 'checked t)
+ (overlay-put button 'display
+ (overlay-get button :on-glyph))
+ (setq startup-screen-inhibit-startup-screen t)))))
+ (fancy-splash-insert :face '(variable-pitch (:height 0.9))
+ " Never show it again."))))
(defun exit-splash-screen ()
"Stop displaying the splash screen buffer."
@@ -1676,11 +1670,7 @@ splash screen in another window."
(save-selected-window
(select-frame frame)
(switch-to-buffer "*About GNU Emacs*")
- (setq buffer-undo-list t
- mode-line-format
- (concat "----"
- (propertize "%b" 'face 'mode-line-buffer-id)
- "%-"))
+ (setq buffer-undo-list t)
(let ((inhibit-read-only t))
(erase-buffer)
(if pure-space-overflow
@@ -1743,9 +1733,6 @@ splash screen in another window."
(erase-buffer)
(setq default-directory command-line-default-directory)
(set (make-local-variable 'tab-width) 8)
- (if (not startup)
- (set (make-local-variable 'mode-line-format)
- (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
(if pure-space-overflow
(insert pure-space-overflow-message))
diff --git a/lisp/subr.el b/lisp/subr.el
index 7f0066548a4..94b28c007d1 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -92,7 +92,7 @@ Both SYMBOL and SPEC are unevaluated. The SPEC can be:
0 (instrument no arguments); t (instrument all arguments);
a symbol (naming a function with an Edebug specification); or a list.
The elements of the list describe the argument types; see
-\(info \"(elisp)Specification List\") for details."
+Info node `(elisp)Specification List' for details."
`(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
(defmacro lambda (&rest cdr)
@@ -490,6 +490,7 @@ SEQ must be a list, vector, or string. The comparison is done with `equal'."
"Return LIST with all occurrences of ELT removed.
The comparison is done with `eq'. Contrary to `delq', this does not use
side-effects, and the argument LIST is not modified."
+ (while (and (eq elt (car list)) (setq list (cdr list))))
(if (memq elt list)
(delq elt (copy-sequence list))
list))
@@ -591,31 +592,88 @@ Don't call this function; it is for internal use only."
(dolist (p list)
(funcall function (car p) (cdr p)))))
+(defun keymap--menu-item-binding (val)
+ "Return the binding part of a menu-item."
+ (cond
+ ((not (consp val)) val) ;Not a menu-item.
+ ((eq 'menu-item (car val))
+ (let* ((binding (nth 2 val))
+ (plist (nthcdr 3 val))
+ (filter (plist-get plist :filter)))
+ (if filter (funcall filter binding)
+ binding)))
+ ((and (consp (cdr val)) (stringp (cadr val)))
+ (cddr val))
+ ((stringp (car val))
+ (cdr val))
+ (t val))) ;Not a menu-item either.
+
+(defun keymap--menu-item-with-binding (item binding)
+ "Build a menu-item like ITEM but with its binding changed to BINDING."
+ (cond
+ ((eq 'menu-item (car item))
+ (setq item (copy-sequence item))
+ (let ((tail (nthcdr 2 item)))
+ (setcar tail binding)
+ ;; Remove any potential filter.
+ (if (plist-get (cdr tail) :filter)
+ (setcdr tail (plist-put (cdr tail) :filter nil))))
+ item)
+ ((and (consp (cdr item)) (stringp (cadr item)))
+ (cons (car item) (cons (cadr item) binding)))
+ (t (cons (car item) binding))))
+
+(defun keymap--merge-bindings (val1 val2)
+ "Merge bindings VAL1 and VAL2."
+ (let ((map1 (keymap--menu-item-binding val1))
+ (map2 (keymap--menu-item-binding val2)))
+ (if (not (and (keymapp map1) (keymapp map2)))
+ ;; There's nothing to merge: val1 takes precedence.
+ val1
+ (let ((map (list 'keymap map1 map2))
+ (item (if (keymapp val1) (if (keymapp val2) nil val2) val1)))
+ (keymap--menu-item-with-binding item map)))))
+
(defun keymap-canonicalize (map)
- "Return an equivalent keymap, without inheritance."
+ "Return a simpler equivalent keymap.
+This resolves inheritance and redefinitions. The returned keymap
+should behave identically to a copy of KEYMAP w.r.t `lookup-key'
+and use in active keymaps and menus.
+Subkeymaps may be modified but are not canonicalized."
+ ;; FIXME: Problem with the difference between a nil binding
+ ;; that hides a binding in an inherited map and a nil binding that's ignored
+ ;; to let some further binding visible. Currently a nil binding hides all.
+ ;; FIXME: we may want to carefully (re)order elements in case they're
+ ;; menu-entries.
(let ((bindings ())
(ranges ())
(prompt (keymap-prompt map)))
(while (keymapp map)
- (setq map (map-keymap-internal
+ (setq map (map-keymap ;; -internal
(lambda (key item)
(if (consp key)
;; Treat char-ranges specially.
(push (cons key item) ranges)
(push (cons key item) bindings)))
map)))
+ ;; Create the new map.
(setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
(dolist (binding ranges)
- ;; Treat char-ranges specially.
+ ;; Treat char-ranges specially. FIXME: need to merge as well.
(define-key map (vector (car binding)) (cdr binding)))
+ ;; Process the bindings starting from the end.
(dolist (binding (prog1 bindings (setq bindings ())))
(let* ((key (car binding))
(item (cdr binding))
(oldbind (assq key bindings)))
- ;; Newer bindings override older.
- (if oldbind (setq bindings (delq oldbind bindings)))
- (when item ;nil bindings just hide older ones.
- (push binding bindings))))
+ (push (if (not oldbind)
+ ;; The normal case: no duplicate bindings.
+ binding
+ ;; This is the second binding for this key.
+ (setq bindings (delq oldbind bindings))
+ (cons key (keymap--merge-bindings (cdr binding)
+ (cdr oldbind))))
+ bindings)))
(nconc map bindings)))
(put 'keyboard-translate-table 'char-table-extra-slots 0)
@@ -1204,10 +1262,10 @@ unless the optional argument APPEND is non-nil, in which case
FUNCTION is added at the end.
The optional fourth argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value.
-This makes the hook buffer-local if needed, and it makes t a member
-of the buffer-local value. That acts as a flag to run the hook
-functions in the default value as well as in the local value.
+the hook's buffer-local value rather than its global value.
+This makes the hook buffer-local, and it makes t a member of the
+buffer-local value. That acts as a flag to run the hook
+functions of the global value as well as in the local value.
HOOK should be a symbol, and FUNCTION may be any valid function. If
HOOK is void, it is first set to nil. If HOOK's value is a single
@@ -1805,6 +1863,13 @@ Signal an error if the program returns with a non-zero exit status."
(forward-line 1))
(nreverse lines)))))
+(defun 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)))
+
;; compatibility
(make-obsolete
@@ -2593,6 +2658,14 @@ Otherwise, return nil."
(get-char-property (1- (field-end pos)) 'field)
raw-field)))
+(defun sha1 (object &optional start end binary)
+ "Return the SHA1 (Secure Hash Algorithm) of an OBJECT.
+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."
+ (secure-hash 'sha1 object start end binary))
+
;;;; Support for yanking and text properties.
@@ -2919,6 +2992,7 @@ with the buffer BUFNAME temporarily current. It runs the hook
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'."
+ (declare (debug t))
(let ((old-dir (make-symbol "old-dir"))
(buf (make-symbol "buf")))
`(let* ((,old-dir default-directory)
@@ -2998,8 +3072,15 @@ See also `with-temp-file' and `with-output-to-string'."
"Execute BODY, pretending it does not modify the buffer.
If BODY performs real modifications to the buffer's text, other
than cosmetic ones, undo data may become corrupted.
-Typically used around modifications of text-properties which do not really
-affect the buffer's content."
+
+This macro will run BODY normally, but doesn't count its buffer
+modifications as being buffer modifications. This affects things
+like buffer-modified-p, checking whether the file is locked by
+someone else, running buffer modification hooks, and other things
+of that nature.
+
+Typically used around modifications of text-properties which do
+not really affect the buffer's content."
(declare (debug t) (indent 0))
(let ((modified (make-symbol "modified")))
`(let* ((,modified (buffer-modified-p))
@@ -3694,6 +3775,8 @@ echo area updates (default is 0.2 seconds.) If the function
`float-time' is not present, time is not tracked at all. If the
OS is not capable of measuring fractions of seconds, this
parameter is effectively rounded up."
+ (when (string-match "[[:alnum:]]\\'" message)
+ (setq message (concat message "...")))
(unless min-time
(setq min-time 0.2))
(let ((reporter
@@ -4004,7 +4087,8 @@ If all LST elements are zeros or LST is nil, return zero."
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\"."
+which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
+as alpha versions."
(version-list-< (version-to-list v1) (version-to-list v2)))
@@ -4014,7 +4098,8 @@ which is higher than \"1alpha\"."
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\"."
+which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
+as alpha versions."
(version-list-<= (version-to-list v1) (version-to-list v2)))
(defun version= (v1 v2)
@@ -4023,7 +4108,8 @@ which is higher than \"1alpha\"."
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\"."
+which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
+as alpha versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
diff --git a/lisp/tabify.el b/lisp/tabify.el
index da1038a2164..0b2411d0316 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -34,19 +34,21 @@ Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
The variable `tab-width' controls the spacing of tab stops."
(interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region (point-min) end)
- (goto-char start)
- (while (search-forward "\t" nil t) ; faster than re-search
- (forward-char -1)
- (let ((tab-beg (point))
- (indent-tabs-mode nil)
- column)
- (skip-chars-forward "\t")
- (setq column (current-column))
- (delete-region tab-beg (point))
- (indent-to column))))))
+ (let ((c (current-column)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (goto-char start)
+ (while (search-forward "\t" nil t) ; faster than re-search
+ (forward-char -1)
+ (let ((tab-beg (point))
+ (indent-tabs-mode nil)
+ column)
+ (skip-chars-forward "\t")
+ (setq column (current-column))
+ (delete-region tab-beg (point))
+ (indent-to column)))))
+ (move-to-column c)))
(defvar tabify-regexp " [ \t]+"
"Regexp matching whitespace that tabify should consider.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 39855a1c8cc..62171328979 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -474,7 +474,8 @@ MODE should be an integer which is a file mode value."
(if (and dir (not (file-exists-p dir)))
(make-directory dir t))
(unless (file-directory-p name)
- (write-region start end name))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region start end name)))
(set-file-modes name (tar-header-mode descriptor))))))))
(defun tar-summarize-buffer ()
diff --git a/lisp/term.el b/lisp/term.el
index df95ca830ab..6d7f6f5c535 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -4254,8 +4254,8 @@ special identifiers such as COM1."
(setq x
(sort
(copy-sequence serial-speed-history)
- '(lambda (a b) (when (and (stringp a) (stringp b))
- (> (string-to-number a) (string-to-number b))))))
+ (lambda (a b) (when (and (stringp a) (stringp b))
+ (> (string-to-number a) (string-to-number b))))))
(dolist (i x) (when (not (equal i (car y))) (push i y)))
y))
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 712929ecec0..447d7fd2533 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -892,6 +892,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function ns-list-services "nsfns.m" ())
(declare-function x-open-connection "nsfns.m"
(display &optional xrm-string must-succeed))
+(declare-function ns-set-resource "nsfns.m" (owner name value))
;; Do the actual Nextstep Windows setup here; the above code just
;; defines functions and variables that we use now.
@@ -916,6 +917,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
(menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
+ ;; OS X Lion introduces PressAndHold, which is unsupported by this port.
+ ;; See this thread for more details:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
+ (ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
+
(setq ns-initialized t))
(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 8bfde0bae10..cd5aed31982 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -46,6 +46,7 @@
"A list of VGA console colors, their indices and 16-bit RGB values.")
(declare-function x-setup-function-keys "term/common-win" (frame))
+(declare-function get-screen-color "w32console.c" ())
(defun terminal-init-w32console ()
"Terminal initialization function for w32 console."
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 0db33b5a4de..47da0bf4de5 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -24,6 +24,23 @@
;;; Code:
+(defgroup xterm nil
+ "XTerm support."
+ :version "24.1"
+ :group 'emacs)
+
+(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."
+ :group 'xterm
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Check" check)
+ ;; NOTE: If you add entries here, make sure to update
+ ;; `tocheck-capabilities' in `terminal-init-xterm' as well.
+ (set (const :tag "modifyOtherKeys support" modifyOtherKeys)
+ (const :tag "report background" reportBackground))))
+
(defvar xterm-function-map
(let ((map (make-sparse-keymap)))
@@ -460,19 +477,34 @@
(set-keymap-parent map (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map map)))
- (xterm-register-default-colors)
- (tty-set-up-initial-frame-faces)
+ (xterm-register-default-colors)
+ (tty-set-up-initial-frame-faces)
- ;; Try to turn on the modifyOtherKeys feature on modern xterms.
- ;; When it is turned on many more key bindings work: things like
- ;; C-. C-, etc.
- ;; To do that we need to find out if the current terminal supports
- ;; modifyOtherKeys. At this time only xterm does.
+ ;; Try to turn on the modifyOtherKeys feature on modern xterms.
+ ;; When it is turned on many more key bindings work: things like
+ ;; C-. C-, etc.
+ ;; To do that we need to find out if the current terminal supports
+ ;; modifyOtherKeys. At this time only xterm does.
+ (when xterm-extra-capabilities
(let ((coding-system-for-read 'binary)
- (chr nil)
- (str nil)
- (recompute-faces nil)
- version)
+ (chr nil)
+ (str "")
+ (recompute-faces nil)
+ ;; If `xterm-extra-capabilities' is 'check, we don't know
+ ;; the capabilities. We need to check for those defined
+ ;; as `xterm-extra-capabilities' set options. Otherwise,
+ ;; we don't need to check for any capabilities because
+ ;; they are given by setting `xterm-extra-capabilities' to
+ ;; a list (which could be empty).
+ (tocheck-capabilities (if (eq 'check xterm-extra-capabilities)
+ '(modifyOtherKeys reportBackground)))
+ ;; The given capabilities are either the contents of
+ ;; `xterm-extra-capabilities', if it's a list, or an empty list.
+ (given-capabilities (if (consp xterm-extra-capabilities)
+ xterm-extra-capabilities))
+ version)
+ ;; 1. Set `version'
+
;; Pending input can be mistakenly returned by the calls to
;; read-event below. Discard it.
(discard-input)
@@ -480,61 +512,74 @@
;; Device Attributes (DA)" query.
(send-string-to-terminal "\e[>0c")
- ;; The reply should be of the form: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c
+ ;; The reply should be: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c
;; If the timeout is completely removed for read-event, this
;; might hang for terminals that pretend to be xterm, but don't
;; respond to this escape sequence. RMS' opinion was to remove
;; it completely. That might be right, but let's first try to
;; see if by using a longer timeout we get rid of most issues.
- (when (equal (read-event nil nil 2) ?\e)
- (when (equal (read-event nil nil 2) ?\[)
- (while (not (equal (setq chr (read-event nil nil 2)) ?c))
- (setq str (concat str (string chr))))
- (when (string-match ">0;\\([0-9]+\\);0" str)
- (setq version (string-to-number
- (substring str (match-beginning 1) (match-end 1))))
- ;; xterm version 242 supports reporting the background
- ;; color, maybe earlier versions do too...
- (when (>= version 242)
- (send-string-to-terminal "\e]11;?\e\\")
- (when (equal (read-event nil nil 2) ?\e)
- (when (equal (read-event nil nil 2) ?\])
- (setq str "")
- (while (not (equal (setq chr (read-event nil nil 2)) ?\\))
- (setq str (concat str (string chr))))
- (when (string-match "11;rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str)
- (setq recompute-faces
- (xterm-maybe-set-dark-background-mode
- (string-to-number (match-string 1 str) 16)
- (string-to-number (match-string 2 str) 16)
- (string-to-number (match-string 3 str) 16)))))))
- ;; NUMBER2 is the xterm version number, look for something
- ;; greater than 216, the version when modifyOtherKeys was
- ;; introduced.
- (when (>= version 216)
- ;; Make sure that the modifyOtherKeys state is restored when
- ;; suspending, resuming and exiting.
- (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys)
- (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys)
- (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys)
- (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys)
- ;; Add the selected frame to the list of frames that
- ;; need to deal with modify-other-keys.
- (push (frame-terminal (selected-frame))
- xterm-modify-other-keys-terminal-list)
- (xterm-turn-on-modify-other-keys))
-
- ;; Recompute faces here in case the background mode was
- ;; set to dark. We used to call
- ;; `tty-set-up-initial-frame-faces' only once, but that
- ;; caused the light background faces to be computed
- ;; incorrectly. See:
- ;; http://permalink.gmane.org/gmane.emacs.devel/119627
- (when recompute-faces
- (tty-set-up-initial-frame-faces))))))
+ (when (and (equal (read-event nil nil 2) ?\e)
+ (equal (read-event nil nil 2) ?\[))
+ (while (not (equal (setq chr (read-event nil nil 2)) ?c))
+ (setq str (concat str (string chr))))
+ (if (string-match ">0;\\([0-9]+\\);0" str)
+ (setq version (string-to-number (match-string 1 str)))))
+ ;; 2. If reportBackground is known to be supported, or the
+ ;; version is 242 or higher, assume the xterm supports
+ ;; reporting the background color (TODO: maybe earlier
+ ;; versions do too...)
+ (when (or (memq 'reportBackground given-capabilities)
+ (and (memq 'reportBackground tocheck-capabilities)
+ version
+ (>= version 242)))
+ (send-string-to-terminal "\e]11;?\e\\")
+ (when (and (equal (read-event nil nil 2) ?\e)
+ (equal (read-event nil nil 2) ?\]))
+ (setq str "")
+ (while (not (equal (setq chr (read-event nil nil 2)) ?\\))
+ (setq str (concat str (string chr))))
+ (if (string-match
+ "11;rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str)
+ (setq recompute-faces
+ (xterm-maybe-set-dark-background-mode
+ (string-to-number (match-string 1 str) 16)
+ (string-to-number (match-string 2 str) 16)
+ (string-to-number (match-string 3 str) 16))))))
+
+ ;; 3. If modifyOtherKeys is known to be supported or the
+ ;; version is 216 (the version when modifyOtherKeys was
+ ;; introduced) or higher, initialize the modifyOtherKeys support.
+ (if (or (memq 'modifyOtherKeys given-capabilities)
+ (and (memq 'modifyOtherKeys tocheck-capabilities)
+ version
+ (>= version 216)))
+ (terminal-init-xterm-modify-other-keys))
+
+ ;; Recompute faces here in case the background mode was
+ ;; set to dark. We used to call
+ ;; `tty-set-up-initial-frame-faces' only once, but that
+ ;; caused the light background faces to be computed
+ ;; incorrectly. See:
+ ;; http://permalink.gmane.org/gmane.emacs.devel/119627
+ (when recompute-faces
+ (tty-set-up-initial-frame-faces))))
(run-hooks 'terminal-init-xterm-hook))
+(defun terminal-init-xterm-modify-other-keys ()
+ "Terminal initialization for xterm's modifyOtherKeys support."
+ ;; Make sure that the modifyOtherKeys state is restored when
+ ;; suspending, resuming and exiting.
+ (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys)
+ (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys)
+ (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys)
+ (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys)
+ ;; Add the selected frame to the list of frames that
+ ;; need to deal with modify-other-keys.
+ (push (frame-terminal (selected-frame))
+ xterm-modify-other-keys-terminal-list)
+ (xterm-turn-on-modify-other-keys))
+
;; Set up colors, for those versions of xterm that support it.
(defvar xterm-standard-colors
;; The names in the comments taken from XTerm-col.ad in the xterm
diff --git a/lisp/terminal.el b/lisp/terminal.el
index 0bde04eb2ec..6fdaecf9c9c 100644
--- a/lisp/terminal.el
+++ b/lisp/terminal.el
@@ -105,8 +105,8 @@ performance."
(define-key map [t] 'te-pass-through)
(define-key map [switch-frame] 'handle-switch-frame)
(define-key map "\e" terminal-meta-map)
- ;(define-key map "\C-l"
- ; '(lambda () (interactive) (te-pass-through) (redraw-display)))
+ ;;(define-key map "\C-l"
+ ;; (lambda () (interactive) (te-pass-through) (redraw-display)))
(setq terminal-map map)))
(defvar terminal-escape-map nil)
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 5fbc8a643d8..2325d7b26ff 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1942,7 +1942,7 @@ Return a list (RETURN-CODE STDOUT STDERR)."
;;
;; Example: In the figure below, the `X' is the very last
;; character in the buffer ("a non-empty line at the
- ;; end"). Suppose point is at at P. Then (forward-line 1)
+ ;; end"). Suppose point is at P. Then (forward-line 1)
;; returns 0 and puts point after the `X'.
;;
;; --------top of buffer--------
@@ -4030,7 +4030,7 @@ The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2."
(defun artist-draw-region-trim-line-endings (min-y max-y)
"Trim lines in current draw-region from MIN-Y to MAX-Y.
Trimming here means removing white space at end of a line."
- ;; Safetyc check: switch min-y and max-y if if max-y is smaller
+ ;; Safety check: switch min-y and max-y if max-y is smaller
(if (< max-y min-y)
(let ((tmp min-y))
(setq min-y max-y)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index e49d7549776..a660bdb6488 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,4 +1,4 @@
-;;; bibtex.el --- BibTeX mode for GNU Emacs
+;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1992, 1994-1999, 2001-2011 Free Software Foundation, Inc.
@@ -90,8 +90,8 @@ If this is a function, call it to generate the initial field text."
(defcustom bibtex-user-optional-fields
'(("annote" "Personal annotation (ignored)"))
"List of optional fields the user wants to have always present.
-Entries should be of the same form as the OPTIONAL and
-CROSSREF-OPTIONAL lists in `bibtex-entry-field-alist' (which see)."
+Entries should be of the same form as the OPTIONAL list
+in `bibtex-BibTeX-entry-alist' (which see)."
:group 'bibtex
:type '(repeat (group (string :tag "Field")
(string :tag "Comment")
@@ -126,6 +126,8 @@ braces Enclose parts of field entries by braces according to
`bibtex-field-braces-alist'.
strings Replace parts of field entries by string constants
according to `bibtex-field-strings-alist'.
+sort-fields Sort fields to match the field order in
+ `bibtex-BibTeX-entry-alist'.
The value t means do all of the above formatting actions.
The value nil means do no formatting at all."
@@ -144,7 +146,8 @@ The value nil means do no formatting at all."
(const delimiters)
(const unify-case)
(const braces)
- (const strings))))
+ (const strings)
+ (const sort-fields))))
(put 'bibtex-entry-format 'safe-local-variable
(lambda (x)
(or (eq x t)
@@ -153,7 +156,8 @@ The value nil means do no formatting at all."
(unless (memq (pop x)
'(opts-or-alts required-fields numerical-fields
page-dashes whitespace inherit-booktitle realign
- last-comma delimiters unify-case braces strings))
+ last-comma delimiters unify-case braces strings
+ sort-fields))
(setq OK nil)))
(unless (null x) (setq OK nil))
OK))))
@@ -204,7 +208,7 @@ See also `bibtex-sort-ignore-string-entries'."
(const entry-class)
(const t)))
(put 'bibtex-maintain-sorted-entries 'safe-local-variable
- '(lambda (a) (memq a '(nil t plain crossref entry-class))))
+ (lambda (a) (memq a '(nil t plain crossref entry-class))))
(defcustom bibtex-sort-entry-class
'(("String")
@@ -260,265 +264,584 @@ If parsing fails, try to set this variable to nil."
:group 'bibtex
:type 'boolean)
-(defcustom bibtex-entry-field-alist
- '(("Article"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the article (BibTeX converts it to lowercase)")
- ("journal" "Name of the journal (use string, remove braces)")
- ("year" "Year of publication"))
- (("volume" "Volume of the journal")
- ("number" "Number of the journal (only allowed if entry contains volume)")
- ("pages" "Pages in the journal")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem")))
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the article (BibTeX converts it to lowercase)"))
- (("pages" "Pages in the journal")
- ("journal" "Name of the journal (use string, remove braces)")
- ("year" "Year of publication")
- ("volume" "Volume of the journal")
- ("number" "Number of the journal")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("Book"
- ((("author" "Author1 [and Author2 ...] [and others]" nil t)
- ("editor" "Editor1 [and Editor2 ...] [and others]" nil t)
- ("title" "Title of the book")
- ("publisher" "Publishing company")
- ("year" "Year of publication"))
- (("volume" "Volume of the book in the series")
- ("number" "Number of the book in a small series (overwritten by volume)")
- ("series" "Series in which the book appeared")
- ("address" "Address of the publisher")
- ("edition" "Edition of the book as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem")))
- ((("author" "Author1 [and Author2 ...] [and others]" nil t)
- ("editor" "Editor1 [and Editor2 ...] [and others]" nil t)
- ("title" "Title of the book"))
- (("publisher" "Publishing company")
- ("year" "Year of publication")
- ("volume" "Volume of the book in the series")
- ("number" "Number of the book in a small series (overwritten by volume)")
- ("series" "Series in which the book appeared")
- ("address" "Address of the publisher")
- ("edition" "Edition of the book as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("Booklet"
- ((("title" "Title of the booklet (BibTeX converts it to lowercase)"))
- (("author" "Author1 [and Author2 ...] [and others]")
- ("howpublished" "The way in which the booklet was published")
- ("address" "Address of the publisher")
- ("month" "Month of the publication as a string (remove braces)")
- ("year" "Year of publication")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("InBook"
- ((("author" "Author1 [and Author2 ...] [and others]" nil t)
- ("editor" "Editor1 [and Editor2 ...] [and others]" nil t)
- ("title" "Title of the book")
- ("chapter" "Chapter in the book")
- ("publisher" "Publishing company")
- ("year" "Year of publication"))
- (("volume" "Volume of the book in the series")
- ("number" "Number of the book in a small series (overwritten by volume)")
- ("series" "Series in which the book appeared")
- ("type" "Word to use instead of \"chapter\"")
- ("address" "Address of the publisher")
- ("edition" "Edition of the book as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("pages" "Pages in the book")
- ("note" "Remarks to be put at the end of the \\bibitem")))
- ((("author" "Author1 [and Author2 ...] [and others]" nil t)
- ("editor" "Editor1 [and Editor2 ...] [and others]" nil t)
- ("title" "Title of the book")
- ("chapter" "Chapter in the book"))
- (("pages" "Pages in the book")
- ("publisher" "Publishing company")
- ("year" "Year of publication")
- ("volume" "Volume of the book in the series")
- ("number" "Number of the book in a small series (overwritten by volume)")
- ("series" "Series in which the book appeared")
- ("type" "Word to use instead of \"chapter\"")
- ("address" "Address of the publisher")
- ("edition" "Edition of the book as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("InCollection"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the article in book (BibTeX converts it to lowercase)")
- ("booktitle" "Name of the book")
- ("publisher" "Publishing company")
- ("year" "Year of publication"))
- (("editor" "Editor1 [and Editor2 ...] [and others]")
- ("volume" "Volume of the book in the series")
- ("number" "Number of the book in a small series (overwritten by volume)")
- ("series" "Series in which the book appeared")
- ("type" "Word to use instead of \"chapter\"")
- ("chapter" "Chapter in the book")
- ("pages" "Pages in the book")
- ("address" "Address of the publisher")
- ("edition" "Edition of the book as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem")))
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the article in book (BibTeX converts it to lowercase)")
- ("booktitle" "Name of the book"))
- (("pages" "Pages in the book")
- ("publisher" "Publishing company")
- ("year" "Year of publication")
- ("editor" "Editor1 [and Editor2 ...] [and others]")
- ("volume" "Volume of the book in the series")
- ("number" "Number of the book in a small series (overwritten by volume)")
- ("series" "Series in which the book appeared")
- ("type" "Word to use instead of \"chapter\"")
- ("chapter" "Chapter in the book")
- ("address" "Address of the publisher")
- ("edition" "Edition of the book as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("InProceedings"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)")
- ("booktitle" "Name of the conference proceedings")
- ("year" "Year of publication"))
- (("editor" "Editor1 [and Editor2 ...] [and others]")
- ("volume" "Volume of the conference proceedings in the series")
- ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
- ("series" "Series in which the conference proceedings appeared")
- ("pages" "Pages in the conference proceedings")
- ("address" "Location of the Proceedings")
- ("month" "Month of the publication as a string (remove braces)")
- ("organization" "Sponsoring organization of the conference")
- ("publisher" "Publishing company, its location")
- ("note" "Remarks to be put at the end of the \\bibitem")))
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)"))
- (("booktitle" "Name of the conference proceedings")
- ("pages" "Pages in the conference proceedings")
- ("year" "Year of publication")
- ("editor" "Editor1 [and Editor2 ...] [and others]")
- ("volume" "Volume of the conference proceedings in the series")
- ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
- ("series" "Series in which the conference proceedings appeared")
- ("address" "Location of the Proceedings")
- ("month" "Month of the publication as a string (remove braces)")
- ("organization" "Sponsoring organization of the conference")
- ("publisher" "Publishing company, its location")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("Manual"
- ((("title" "Title of the manual"))
- (("author" "Author1 [and Author2 ...] [and others]")
- ("organization" "Publishing organization of the manual")
- ("address" "Address of the organization")
- ("edition" "Edition of the manual as a capitalized English word")
- ("month" "Month of the publication as a string (remove braces)")
- ("year" "Year of publication")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("MastersThesis"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the master\'s thesis (BibTeX converts it to lowercase)")
- ("school" "School where the master\'s thesis was written")
- ("year" "Year of publication"))
- (("type" "Type of the master\'s thesis (if other than \"Master\'s thesis\")")
- ("address" "Address of the school (if not part of field \"school\") or country")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("Misc"
- (()
- (("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the work (BibTeX converts it to lowercase)")
- ("howpublished" "The way in which the work was published")
- ("month" "Month of the publication as a string (remove braces)")
- ("year" "Year of publication")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("PhdThesis"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the PhD. thesis")
- ("school" "School where the PhD. thesis was written")
- ("year" "Year of publication"))
- (("type" "Type of the PhD. thesis")
- ("address" "Address of the school (if not part of field \"school\") or country")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("Proceedings"
- ((("title" "Title of the conference proceedings")
- ("year" "Year of publication"))
- (("booktitle" "Title of the proceedings for cross references")
- ("editor" "Editor1 [and Editor2 ...] [and others]")
- ("volume" "Volume of the conference proceedings in the series")
- ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
- ("series" "Series in which the conference proceedings appeared")
- ("address" "Location of the Proceedings")
- ("month" "Month of the publication as a string (remove braces)")
- ("organization" "Sponsoring organization of the conference")
- ("publisher" "Publishing company, its location")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("TechReport"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the technical report (BibTeX converts it to lowercase)")
- ("institution" "Sponsoring institution of the report")
- ("year" "Year of publication"))
- (("type" "Type of the report (if other than \"technical report\")")
- ("number" "Number of the technical report")
- ("address" "Address of the institution (if not part of field \"institution\") or country")
- ("month" "Month of the publication as a string (remove braces)")
- ("note" "Remarks to be put at the end of the \\bibitem"))))
- ("Unpublished"
- ((("author" "Author1 [and Author2 ...] [and others]")
- ("title" "Title of the unpublished work (BibTeX converts it to lowercase)")
- ("note" "Remarks to be put at the end of the \\bibitem"))
- (("month" "Month of the publication as a string (remove braces)")
- ("year" "Year of publication")))))
-
- "List of BibTeX entry types and their associated fields.
-List elements are triples
-\(ENTRY-TYPE (REQUIRED OPTIONAL) (CROSSREF-REQUIRED CROSSREF-OPTIONAL)).
-ENTRY-TYPE is the type of a BibTeX entry. The remaining pairs contain
-the required and optional fields of the BibTeX entry.
-The second pair is used if a crossref field is present
-and the first pair is used if a crossref field is absent.
-If the second pair is nil, the first pair is always used.
-REQUIRED, OPTIONAL, CROSSREF-REQUIRED and CROSSREF-OPTIONAL are lists.
+(define-widget 'bibtex-entry-alist 'lazy
+ "Format of `bibtex-BibTeX-entry-alist' and friends."
+ :type '(repeat (group (string :tag "Entry type")
+ (string :tag "Documentation")
+ (repeat :tag "Required fields"
+ (group (string :tag "Field")
+ (option (choice :tag "Comment" :value nil
+ (const nil) string))
+ (option (choice :tag "Init" :value nil
+ (const nil) string function))
+ (option (choice :tag "Alternative" :value nil
+ (const nil) integer))))
+ (repeat :tag "Crossref fields"
+ (group (string :tag "Field")
+ (option (choice :tag "Comment" :value nil
+ (const nil) string))
+ (option (choice :tag "Init" :value nil
+ (const nil) string function))
+ (option (choice :tag "Alternative" :value nil
+ (const nil) integer))))
+ (repeat :tag "Optional fields"
+ (group (string :tag "Field")
+ (option (choice :tag "Comment" :value nil
+ (const nil) string))
+ (option (choice :tag "Init" :value nil
+ (const nil) string function)))))))
+
+(define-obsolete-variable-alias 'bibtex-entry-field-alist
+ 'bibtex-BibTeX-entry-alist "24.1")
+(defcustom bibtex-BibTeX-entry-alist
+ '(("Article" "Article in Journal"
+ (("author")
+ ("title" "Title of the article (BibTeX converts it to lowercase)"))
+ (("journal") ("year"))
+ (("volume" "Volume of the journal")
+ ("number" "Number of the journal (only allowed if entry contains volume)")
+ ("pages" "Pages in the journal")
+ ("month") ("note")))
+ ("InProceedings" "Article in Conference Proceedings"
+ (("author")
+ ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)"))
+ (("booktitle" "Name of the conference proceedings")
+ ("year"))
+ (("editor")
+ ("volume" "Volume of the conference proceedings in the series")
+ ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
+ ("series" "Series in which the conference proceedings appeared")
+ ("pages" "Pages in the conference proceedings")
+ ("month") ("address")
+ ("organization" "Sponsoring organization of the conference")
+ ("publisher" "Publishing company, its location")
+ ("note")))
+ ("InCollection" "Article in a Collection"
+ (("author")
+ ("title" "Title of the article in book (BibTeX converts it to lowercase)")
+ ("booktitle" "Name of the book"))
+ (("publisher") ("year"))
+ (("editor")
+ ("volume" "Volume of the book in the series")
+ ("number" "Number of the book in a small series (overwritten by volume)")
+ ("series" "Series in which the book appeared")
+ ("type" "Word to use instead of \"chapter\"")
+ ("chapter" "Chapter in the book")
+ ("pages" "Pages in the book")
+ ("edition" "Edition of the book as a capitalized English word")
+ ("month") ("address") ("note")))
+ ("InBook" "Chapter or Pages in a Book"
+ (("author" nil nil 0)
+ ("editor" nil nil 0)
+ ("title" "Title of the book")
+ ("chapter" "Chapter in the book"))
+ (("publisher") ("year"))
+ (("volume" "Volume of the book in the series")
+ ("number" "Number of the book in a small series (overwritten by volume)")
+ ("series" "Series in which the book appeared")
+ ("type" "Word to use instead of \"chapter\"")
+ ("address")
+ ("edition" "Edition of the book as a capitalized English word")
+ ("month")
+ ("pages" "Pages in the book")
+ ("note")))
+ ("Proceedings" "Conference Proceedings"
+ (("title" "Title of the conference proceedings")
+ ("year"))
+ nil
+ (("booktitle" "Title of the proceedings for cross references")
+ ("editor")
+ ("volume" "Volume of the conference proceedings in the series")
+ ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
+ ("series" "Series in which the conference proceedings appeared")
+ ("address")
+ ("month")
+ ("organization" "Sponsoring organization of the conference")
+ ("publisher" "Publishing company, its location")
+ ("note")))
+ ("Book" "Book"
+ (("author" nil nil 0)
+ ("editor" nil nil 0)
+ ("title" "Title of the book"))
+ (("publisher") ("year"))
+ (("volume" "Volume of the book in the series")
+ ("number" "Number of the book in a small series (overwritten by volume)")
+ ("series" "Series in which the book appeared")
+ ("address")
+ ("edition" "Edition of the book as a capitalized English word")
+ ("month") ("note")))
+ ("Booklet" "Booklet (Bound, but no Publisher)"
+ (("title" "Title of the booklet (BibTeX converts it to lowercase)"))
+ nil
+ (("author")
+ ("howpublished" "The way in which the booklet was published")
+ ("address") ("month") ("year") ("note")))
+ ("PhdThesis" "PhD. Thesis"
+ (("author")
+ ("title" "Title of the PhD. thesis")
+ ("school" "School where the PhD. thesis was written")
+ ("year"))
+ nil
+ (("type" "Type of the PhD. thesis")
+ ("address" "Address of the school (if not part of field \"school\") or country")
+ ("month") ("note")))
+ ("MastersThesis" "Master's Thesis"
+ (("author")
+ ("title" "Title of the master's thesis (BibTeX converts it to lowercase)")
+ ("school" "School where the master's thesis was written")
+ ("year"))
+ nil
+ (("type" "Type of the master's thesis (if other than \"Master's thesis\")")
+ ("address" "Address of the school (if not part of field \"school\") or country")
+ ("month") ("note")))
+ ("TechReport" "Technical Report"
+ (("author")
+ ("title" "Title of the technical report (BibTeX converts it to lowercase)")
+ ("institution" "Sponsoring institution of the report")
+ ("year"))
+ nil
+ (("type" "Type of the report (if other than \"technical report\")")
+ ("number" "Number of the technical report")
+ ("address") ("month") ("note")))
+ ("Manual" "Technical Manual"
+ (("title" "Title of the manual"))
+ nil
+ (("author")
+ ("organization" "Publishing organization of the manual")
+ ("address")
+ ("edition" "Edition of the manual as a capitalized English word")
+ ("month") ("year") ("note")))
+ ("Unpublished" "Unpublished"
+ (("author")
+ ("title" "Title of the unpublished work (BibTeX converts it to lowercase)")
+ ("note"))
+ nil
+ (("month") ("year")))
+ ("Misc" "Miscellaneous" nil nil
+ (("author")
+ ("title" "Title of the work (BibTeX converts it to lowercase)")
+ ("howpublished" "The way in which the work was published")
+ ("month") ("year") ("note"))))
+ "Alist of BibTeX entry types and their associated fields.
+Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL).
+ENTRY-TYPE is the type of a BibTeX entry.
+DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
+REQUIRED is a list of required fields.
+CROSSREF is a list of fields that are optional if a crossref field
+is present; but these fields are required otherwise.
+OPTIONAL is a list of optional fields.
+
Each element of these lists is a list of the form
-\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG).
-COMMENT-STRING, INIT, and ALTERNATIVE-FLAG are optional.
-FIELD-NAME is the name of the field, COMMENT-STRING is the comment that
-appears in the echo area, INIT is either the initial content of the
-field or a function, which is called to determine the initial content
-of the field, and ALTERNATIVE-FLAG (either nil or t) marks if the
-field is an alternative. ALTERNATIVE-FLAG may be t only in the
-REQUIRED or CROSSREF-REQUIRED lists."
+ \(FIELD COMMENT INIT ALTERNATIVE).
+COMMENT, INIT, and ALTERNATIVE are optional.
+
+FIELD is the name of the field.
+COMMENT is the comment string that appears in the echo area.
+If COMMENT is nil use `bibtex-BibTeX-field-alist' if possible.
+INIT is either the initial content of the field or a function,
+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
+ :type 'bibtex-entry-alist)
+(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t)
+
+(defcustom bibtex-biblatex-entry-alist
+ ;; Compare in biblatex documentation:
+ ;; Sec. 2.1.1 Regular types (required and optional fields)
+ ;; Appendix A Default Crossref setup
+ '(("Article" "Article in Journal"
+ (("author") ("title") ("journaltitle")
+ ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon")
+ ("editor") ("editora") ("editorb") ("editorc")
+ ("journalsubtitle") ("issuetitle") ("issuesubtitle")
+ ("language") ("origlanguage") ("series") ("volume") ("number") ("eid")
+ ("issue") ("month") ("pages") ("version") ("note") ("issn")
+ ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("eprinttype") ("url") ("urldate")))
+ ("Book" "Single-Volume Book"
+ (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editor") ("editora") ("editorb") ("editorc")
+ ("translator") ("annotator") ("commentator")
+ ("introduction") ("foreword") ("afterword") ("titleaddon")
+ ("maintitle") ("mainsubtitle") ("maintitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("MVBook" "Multi-Volume Book"
+ (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editor") ("editora") ("editorb") ("editorc")
+ ("translator") ("annotator") ("commentator")
+ ("introduction") ("foreword") ("afterword") ("subtitle")
+ ("titleaddon") ("language") ("origlanguage") ("edition") ("volumes")
+ ("series") ("number") ("note") ("publisher")
+ ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("InBook" "Chapter or Pages in a Book"
+ (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("booktitle"))
+ (("bookauthor") ("editor") ("editora") ("editorb") ("editorc")
+ ("translator") ("annotator") ("commentator") ("introduction") ("foreword")
+ ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("chapter") ("pages") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("BookInBook" "Book in Collection" ; same as @inbook
+ (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("booktitle"))
+ (("bookauthor") ("editor") ("editora") ("editorb") ("editorc")
+ ("translator") ("annotator") ("commentator") ("introduction") ("foreword")
+ ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("chapter") ("pages") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("SuppBook" "Supplemental Material in a Book" ; same as @inbook
+ (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("booktitle"))
+ (("bookauthor") ("editor") ("editora") ("editorb") ("editorc")
+ ("translator") ("annotator") ("commentator") ("introduction") ("foreword")
+ ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("chapter") ("pages") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Booklet" "Booklet (Bound, but no Publisher)"
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("year" nil nil 1) ("date" nil nil 1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
+ ("note") ("location") ("chapter") ("pages") ("pagetotal") ("addendum")
+ ("pubstate") ("doi") ("eprint") ("eprintclass") ("eprinttype")
+ ("url") ("urldate")))
+ ("Collection" "Single-Volume Collection"
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("language") ("origlanguage") ("volume")
+ ("part") ("edition") ("volumes") ("series") ("number") ("note")
+ ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("eprinttype") ("url") ("urldate")))
+ ("MVCollection" "Multi-Volume Collection"
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("language") ("origlanguage") ("edition")
+ ("volumes") ("series") ("number") ("note") ("publisher")
+ ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("InCollection" "Article in a Collection"
+ (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("booktitle"))
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition")
+ ("volumes") ("series") ("number") ("note") ("publisher") ("location")
+ ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("SuppCollection" "Supplemental Material in a Collection" ; same as @incollection
+ (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("booktitle"))
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition")
+ ("volumes") ("series") ("number") ("note") ("publisher") ("location")
+ ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Manual" "Technical Manual"
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("year" nil nil 1) ("date" nil nil 1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("edition")
+ ("type") ("series") ("number") ("version") ("note")
+ ("organization") ("publisher") ("location") ("isbn") ("chapter")
+ ("pages") ("pagetotal") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Misc" "Miscellaneous"
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("year" nil nil 1) ("date" nil nil 1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
+ ("version") ("note") ("organization") ("location")
+ ("date") ("month") ("year") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Online" "Online Resource"
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("year" nil nil 1) ("date" nil nil 1) ("url"))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("version") ("note")
+ ("organization") ("date") ("month") ("year") ("addendum")
+ ("pubstate") ("urldate")))
+ ("Patent" "Patent"
+ (("author") ("title") ("number") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("holder") ("subtitle") ("titleaddon") ("type") ("version") ("location")
+ ("note") ("date") ("month") ("year") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Periodical" "Complete Issue of a Periodical"
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editora") ("editorb") ("editorc") ("subtitle") ("issuetitle")
+ ("issuesubtitle") ("language") ("series") ("volume") ("number") ("issue")
+ ("date") ("month") ("year") ("note") ("issn") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("SuppPeriodical" "Supplemental Material in a Periodical" ; same as @article
+ (("author") ("title") ("journaltitle")
+ ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon")
+ ("editor") ("editora") ("editorb") ("editorc")
+ ("journalsubtitle") ("issuetitle") ("issuesubtitle")
+ ("language") ("origlanguage") ("series") ("volume") ("number") ("eid")
+ ("issue") ("month") ("pages") ("version") ("note") ("issn")
+ ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("eprinttype") ("url") ("urldate")))
+ ("Proceedings" "Single-Volume Conference Proceedings"
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("eventtitle") ("eventdate") ("venue") ("language")
+ ("volume") ("part") ("volumes") ("series") ("number") ("note")
+ ("organization") ("publisher") ("location") ("month")
+ ("isbn") ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("MVProceedings" "Multi-Volume Conference Proceedings"
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("subtitle") ("titleaddon") ("eventtitle") ("eventdate") ("venue")
+ ("language") ("volumes") ("series") ("number") ("note")
+ ("organization") ("publisher") ("location") ("month")
+ ("isbn") ("pagetotal") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("InProceedings" "Article in Conference Proceedings"
+ (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("booktitle"))
+ (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("eventtitle") ("eventdate") ("venue") ("language")
+ ("volume") ("part") ("volumes") ("series") ("number") ("note")
+ ("organization") ("publisher") ("location") ("month") ("isbn")
+ ("chapter") ("pages") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Reference" "Single-Volume Work of Reference" ; same as @collection
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("language") ("origlanguage") ("volume")
+ ("part") ("edition") ("volumes") ("series") ("number") ("note")
+ ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("eprinttype") ("url") ("urldate")))
+ ("MVReference" "Multi-Volume Work of Reference" ; same as @mvcollection
+ (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("language") ("origlanguage") ("edition")
+ ("volumes") ("series") ("number") ("note") ("publisher")
+ ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("InReference" "Article in a Work of Reference" ; same as @incollection
+ (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("booktitle"))
+ (("editora") ("editorb") ("editorc") ("translator") ("annotator")
+ ("commentator") ("introduction") ("foreword") ("afterword")
+ ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("booksubtitle") ("booktitleaddon")
+ ("language") ("origlanguage") ("volume") ("part") ("edition")
+ ("volumes") ("series") ("number") ("note") ("publisher") ("location")
+ ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Report" "Technical or Research Report"
+ (("author") ("title") ("type") ("institution")
+ ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("number") ("version") ("note")
+ ("location") ("month") ("isrn") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Thesis" "PhD. or Master's Thesis"
+ (("author") ("title") ("type") ("institution")
+ ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("note") ("location")
+ ("month") ("isbn") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Unpublished" "Unpublished"
+ (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("howpublished")
+ ("note") ("location") ("isbn") ("date") ("month") ("year")
+ ("addendum") ("pubstate") ("url") ("urldate"))))
+ "Alist of biblatex entry types and their associated fields.
+It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
- :type '(repeat (group (string :tag "Entry type")
- (group (repeat :tag "Required fields"
- (group (string :tag "Field")
- (string :tag "Comment")
- (option (choice :tag "Init" :value nil
- (const nil) string function))
- (option (choice :tag "Alternative"
- (const :tag "No" nil)
- (const :tag "Yes" t)))))
- (repeat :tag "Optional fields"
- (group (string :tag "Field")
- (string :tag "Comment")
- (option (choice :tag "Init" :value nil
- (const nil) string function)))))
- (option :extra-offset -4
- (group (repeat :tag "Crossref: required fields"
- (group (string :tag "Field")
- (string :tag "Comment")
- (option (choice :tag "Init" :value nil
- (const nil) string function))
- (option (choice :tag "Alternative"
- (const :tag "No" nil)
- (const :tag "Yes" t)))))
- (repeat :tag "Crossref: optional fields"
- (group (string :tag "Field")
- (string :tag "Comment")
- (option (choice :tag "Init" :value nil
- (const nil) string function)))))))))
-(put 'bibtex-entry-field-alist 'risky-local-variable t)
+ :type 'bibtex-entry-alist)
+(put 'bibtex-biblatex-entry-alist 'risky-local-variable t)
+
+(define-widget 'bibtex-field-alist 'lazy
+ "Format of `bibtex-BibTeX-entry-alist' and friends."
+ :type '(repeat (group (string :tag "Field type")
+ (string :tag "Comment"))))
+
+(defcustom bibtex-BibTeX-field-alist
+ '(("author" "Author1 [and Author2 ...] [and others]")
+ ("editor" "Editor1 [and Editor2 ...] [and others]")
+ ("journal" "Name of the journal (use string, remove braces)")
+ ("year" "Year of publication")
+ ("month" "Month of the publication as a string (remove braces)")
+ ("note" "Remarks to be put at the end of the \\bibitem")
+ ("publisher" "Publishing company")
+ ("address" "Address of the publisher"))
+ "Alist of BibTeX fields.
+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
+ :type 'bibtex-field-alist)
+
+(defcustom bibtex-biblatex-field-alist
+ ;; See 2.2.2 Data Fields
+ '(("abstract" "Abstract of the work")
+ ("addendum" "Miscellaneous bibliographic data")
+ ("afterword" "Author(s) of an afterword to the work")
+ ("annotation" "Annotation")
+ ("annotator" "Author(s) of annotations to the work")
+ ("author" "Author(s) of the title")
+ ("bookauthor" "Author(s) of the booktitle.")
+ ("bookpagination" "Pagination scheme of the enclosing work")
+ ("booksubtitle" "Subtitle related to the booktitle")
+ ("booktitle" "Title of the book")
+ ("booktitleaddon" "Annex to the booktitle")
+ ("chapter" "Chapter, section, or any other unit of a work")
+ ("commentator" "Author(s) of a commentary to the work")
+ ("date" "Publication date")
+ ("doi" "Digital Object Identifier")
+ ("edition" "Edition of a printed publication")
+ ("editor" "Editor(s) of the title, booktitle, or maintitle")
+ ("editora" "Secondary editor")
+ ("editorb" "Secondary editor")
+ ("editorc" "Secondary editor")
+ ("editortype" "Type of editorial role performed by the editor")
+ ("editoratype" "Type of editorial role performed by editora")
+ ("editorbtype" "Type of editorial role performed by editorb")
+ ("editorctype" "Type of editorial role performed by editorc")
+ ("eid" "Electronic identifier of an article")
+ ("eprint" "Electronic identifier of an online publication")
+ ("eprintclass" "Additional information related to the eprinttype")
+ ("eprinttype" "Type of eprint identifier")
+ ("eventdate" "Date of a conference or some other event")
+ ("eventtitle" "Title of a conference or some other event")
+ ("file" "Local link to an electronic version of the work")
+ ("foreword" "Author(s) of a foreword to the work")
+ ("holder" "Holder(s) of a patent")
+ ("howpublished" "Publication notice for unusual publications")
+ ("indextitle" "Title to use for indexing instead of the regular title")
+ ("institution" "Name of a university or some other institution")
+ ("introduction" "Author(s) of an introduction to the work")
+ ("isan" "International Standard Audiovisual Number of an audiovisual work")
+ ("isbn" "International Standard Book Number of a book.")
+ ("ismn" "International Standard Music Number for printed music")
+ ("isrn" "International Standard Technical Report Number")
+ ("issn" "International Standard Serial Number of a periodical.")
+ ("issue" "Issue of a journal")
+ ("issuesubtitle" "Subtitle of a specific issue of a journal or other periodical.")
+ ("issuetitle" "Title of a specific issue of a journal or other periodical.")
+ ("iswc" "International Standard Work Code of a musical work")
+ ("journalsubtitle" "Subtitle of a journal, a newspaper, or some other periodical.")
+ ("journaltitle" "Name of a journal, a newspaper, or some other periodical.")
+ ("label" "Substitute for the regular label to be used by the citation style")
+ ("language" "Language(s) of the work")
+ ("library" "Library name and a call number")
+ ("location" "Place(s) of publication")
+ ("mainsubtitle" "Subtitle related to the maintitle")
+ ("maintitle" "Main title of a multi-volume book, such as Collected Works")
+ ("maintitleaddon" "Annex to the maintitle")
+ ("month" "Publication month")
+ ("nameaddon" "Addon to be printed immediately after the author name")
+ ("note" "Miscellaneous bibliographic data")
+ ("number" "Number of a journal or the volume/number of a book in a series")
+ ("organization" "Organization(s) that published a work")
+ ("origdate" "Publication date of the original edition")
+ ("origlanguage" "Original publication language of a translated edition")
+ ("origlocation" "Location of the original edition")
+ ("origpublisher" "Publisher of the original edition")
+ ("origtitle" "Title of the original work")
+ ("pages" "Page number(s) or page range(s)")
+ ("pagetotal" "Total number of pages of the work.")
+ ("pagination" "Pagination of the work")
+ ("part" "Number of a partial volume")
+ ("publisher" "Name(s) of the publisher(s)")
+ ("pubstate" "Publication state of the work, e. g.,'in press'")
+ ("reprinttitle" "Title of a reprint of the work")
+ ("series" "Name of a publication series")
+ ("shortauthor" "Author(s) of the work, given in an abbreviated form")
+ ("shorteditor" "Editor(s) of the work, given in an abbreviated form")
+ ("shortjournal" "Short version or an acronym of the journal title")
+ ("shortseries" "Short version or an acronym of the series field")
+ ("shorttitle" "Title in an abridged form")
+ ("subtitle" "Subtitle of the work")
+ ("title" "Title of the work")
+ ("titleaddon" "Annex to the title")
+ ("translator" "Translator(s) of the work")
+ ("type" "Type of a manual, patent, report, or thesis")
+ ("url" " URL of an online publication.")
+ ("urldate" "Access date of the address specified in the url field")
+ ("venue" "Location of a conference, a symposium, or some other event")
+ ("version" "Revision number of a piece of software, a manual, etc.")
+ ("volume" "Volume of a multi-volume book or a periodical")
+ ("volumes" "Total number of volumes of a multi-volume work")
+ ("year" "Year of publication"))
+ "Alist of biblatex fields.
+It has the same format as `bibtex-BibTeX-entry-alist'."
+ :group 'bibtex
+ :type 'bibtex-field-alist)
+
+(defcustom bibtex-dialect-list '(BibTeX biblatex)
+ "List of BibTeX dialects known to BibTeX mode.
+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
+ :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'."
+ :group 'bibtex
+ :set '(lambda (symbol value)
+ (set-default symbol value)
+ ;; `bibtex-set-dialect' is undefined during loading (no problem)
+ (if (fboundp 'bibtex-set-dialect)
+ (bibtex-set-dialect value)))
+ :type '(choice (const BibTeX)
+ (const biblatex)
+ (symbol :tag "Custom")))
+
+(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
+ :type '(choice (regexp) (const nil)))
(defcustom bibtex-comment-start "@Comment"
"String starting a BibTeX comment."
@@ -593,7 +916,8 @@ to the directories specified in `bibtex-string-file-path'."
List elements can be absolute file names or file names relative to the
directories specified in `bibtex-file-path'. If an element is a directory,
check all BibTeX files in this directory. If an element is the symbol
-`bibtex-file-path', check all BibTeX files in `bibtex-file-path'."
+`bibtex-file-path', check all BibTeX files in `bibtex-file-path'.
+See also `bibtex-search-entry-globally'."
:group 'bibtex
:type '(repeat (choice (const :tag "bibtex-file-path" bibtex-file-path)
directory file)))
@@ -601,6 +925,12 @@ check all BibTeX files in this directory. If an element is the symbol
(defvar bibtex-file-path (getenv "BIBINPUTS")
"*Colon separated list of paths to search for `bibtex-files'.")
+(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
+ :type 'boolean)
+
(defcustom bibtex-help-message t
"If non-nil print help messages in the echo area on entering a new field."
:group 'bibtex
@@ -912,7 +1242,7 @@ The following is a complex example, see URL `http://link.aps.org/'.
(((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\")
\"http://link.aps.org/abstract/%s/v%s/p%s\"
- (\"journal\" \".*\" downcase)
+ (\"journal\" \".*\" upcase)
(\"volume\" \".*\" 0)
(\"pages\" \"\\`[A-Z]?[0-9]+\" 0)))"
:group 'bibtex
@@ -957,6 +1287,11 @@ Set this variable before loading BibTeX mode."
:group 'bibtex
:type 'boolean)
+(defcustom bibtex-search-buffer "*BibTeX Search*"
+ "Buffer for BibTeX search results."
+ :group 'bibtex
+ :type 'string)
+
;; `bibtex-font-lock-keywords' is a user option, too. But since the
;; patterns used to define this variable are defined in a later
;; section of this file, it is defined later.
@@ -968,7 +1303,7 @@ Set this variable before loading BibTeX mode."
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?$ "$$ " st)
(modify-syntax-entry ?% "< " st)
- (modify-syntax-entry ?' "w " st)
+ (modify-syntax-entry ?' "w " st) ;FIXME: Not allowed in @string keys.
(modify-syntax-entry ?@ "w " st)
(modify-syntax-entry ?\\ "\\" st)
(modify-syntax-entry ?\f "> " st)
@@ -984,7 +1319,7 @@ Set this variable before loading BibTeX mode."
;; The Key `C-c&' is reserved for reftex.el
(define-key km "\t" 'bibtex-find-text)
(define-key km "\n" 'bibtex-next-field)
- (define-key km "\M-\t" 'bibtex-complete)
+ (define-key km "\M-\t" 'completion-at-point)
(define-key km "\C-c\"" 'bibtex-remove-delimiters)
(define-key km "\C-c{" 'bibtex-remove-delimiters)
(define-key km "\C-c}" 'bibtex-remove-delimiters)
@@ -1014,6 +1349,7 @@ Set this variable before loading BibTeX mode."
(define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry)
(define-key km "\C-c\C-rw" 'widen)
(define-key km "\C-c\C-l" 'bibtex-url)
+ (define-key km "\C-c\C-a" 'bibtex-search-entries)
(define-key km "\C-c\C-o" 'bibtex-remove-OPT-or-ALT)
(define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings)
(define-key km "\C-c\C-ei" 'bibtex-InCollection)
@@ -1091,6 +1427,8 @@ Set this variable before loading BibTeX mode."
["View Cite Locations (RefTeX)" reftex-view-crossref-from-bibtex
(fboundp 'reftex-view-crossref-from-bibtex)])
("Operating on Buffer or Region"
+ ["Search Entries" bibtex-search-entries t]
+ "--"
["Validate Entries" bibtex-validate t]
["Sort Entries" bibtex-sort-buffer t]
["Reformat Entries" bibtex-reformat t]
@@ -1101,29 +1439,15 @@ Set this variable before loading BibTeX mode."
["(Re)Initialize BibTeX Buffers" bibtex-initialize t]
["Validate Entries" bibtex-validate-globally t])))
-(easy-menu-define
- bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode"
- (list "Entry-Types"
- ["Article in Journal" bibtex-Article t]
- ["Article in Conference Proceedings" bibtex-InProceedings t]
- ["Article in a Collection" bibtex-InCollection t]
- ["Chapter or Pages in a Book" bibtex-InBook t]
- ["Conference Proceedings" bibtex-Proceedings t]
- ["Book" bibtex-Book t]
- ["Booklet (Bound, but no Publisher/Institution)" bibtex-Booklet t]
- ["PhD. Thesis" bibtex-PhdThesis t]
- ["Master's Thesis" bibtex-MastersThesis t]
- ["Technical Report" bibtex-TechReport t]
- ["Technical Manual" bibtex-Manual t]
- ["Unpublished" bibtex-Unpublished t]
- ["Miscellaneous" bibtex-Misc t]
- "--"
- ["String" bibtex-String t]
- ["Preamble" bibtex-Preamble t]))
-
;; Internal Variables
+(defvar bibtex-entry-alist bibtex-BibTeX-entry-alist
+ "Alist of currently active entry types.")
+
+(defvar bibtex-field-alist bibtex-BibTeX-field-alist
+ "Alist of currently active field types.")
+
(defvar bibtex-field-braces-opt nil
"Optimized value of `bibtex-field-braces-alist'.
Created by `bibtex-field-re-init'.
@@ -1218,33 +1542,26 @@ The CDRs of the elements are t for header keys and nil for crossref keys.")
(defconst bibtex-field-const "[][[:alnum:].:;?!`'/*@+=|<>&_^$-]+"
"Regexp matching a BibTeX field constant.")
-(defvar bibtex-entry-type
- (concat "@[ \t]*\\(?:"
- (regexp-opt (mapcar 'car bibtex-entry-field-alist)) "\\)")
- "Regexp matching the type of a BibTeX entry.")
+(defvar bibtex-entry-type nil
+ "Regexp matching the type of a BibTeX entry.
+Initialized by `bibtex-set-dialect'.")
-(defvar bibtex-entry-head
- (concat "^[ \t]*\\("
- bibtex-entry-type
- "\\)[ \t]*[({][ \t\n]*\\("
- bibtex-reference-key
- "\\)")
- "Regexp matching the header line of a BibTeX entry (including key).")
+(defvar bibtex-entry-head nil
+ "Regexp matching the header line of a BibTeX entry (including key).
+Initialized by `bibtex-set-dialect'.")
-(defvar bibtex-entry-maybe-empty-head
- (concat bibtex-entry-head "?")
- "Regexp matching the header line of a BibTeX entry (possibly without key).")
+(defvar bibtex-entry-maybe-empty-head nil
+ "Regexp matching the header line of a BibTeX entry (possibly without key).
+Initialized by `bibtex-set-dialect'.")
(defconst bibtex-any-entry-maybe-empty-head
(concat "^[ \t]*\\(@[ \t]*" bibtex-field-name "\\)[ \t]*[({][ \t\n]*\\("
bibtex-reference-key "\\)?")
"Regexp matching the header line of any BibTeX entry (possibly without key).")
-(defvar bibtex-any-valid-entry-type
- (concat "^[ \t]*@[ \t]*\\(?:"
- (regexp-opt (append '("String" "Preamble")
- (mapcar 'car bibtex-entry-field-alist))) "\\)")
- "Regexp matching any valid BibTeX entry (including String and Preamble).")
+(defvar bibtex-any-valid-entry-type nil
+ "Regexp matching any valid BibTeX entry (including String and Preamble).
+Initialized by `bibtex-set-dialect'.")
(defconst bibtex-type-in-head 1
"Regexp subexpression number of the type part in `bibtex-entry-head'.")
@@ -1501,7 +1818,9 @@ If optional arg REMOVE-OPT-ALT is non-nil remove \"OPT\" and \"ALT\"."
(bibtex-start-of-name-in-field bounds)
(bibtex-end-of-name-in-field bounds))))
(if (and remove-opt-alt
- (string-match "\\`\\(OPT\\|ALT\\)" name))
+ (string-match "\\`\\(OPT\\|ALT\\)" name)
+ (not (and bibtex-no-opt-remove-re
+ (string-match bibtex-no-opt-remove-re name))))
(substring name 3)
name)))
@@ -1667,7 +1986,7 @@ Point must be at beginning of preamble. Do not move point."
(defun bibtex-valid-entry (&optional empty-key)
"Parse a valid BibTeX entry (maybe without key if EMPTY-KEY is t).
A valid entry is a syntactical correct one with type contained in
-`bibtex-entry-field-alist'. Ignore @String and @Preamble entries.
+`bibtex-BibTeX-entry-alist'. Ignore @String and @Preamble entries.
Return a cons pair with buffer positions of beginning and end of entry
if a valid entry is found, nil otherwise. Do not move point.
After a call to this function `match-data' corresponds to the header
@@ -1698,7 +2017,7 @@ of the entry, see regexp `bibtex-entry-head'."
Do not move if we are already at beginning of a valid BibTeX entry.
With optional argument BACKWARD non-nil, move backward to
beginning of previous valid one. A valid entry is a syntactical correct one
-with type contained in `bibtex-entry-field-alist' or, if
+with type contained in `bibtex-BibTeX-entry-alist' or, if
`bibtex-sort-ignore-string-entries' is nil, a syntactical correct string
entry. Return buffer position of beginning and end of entry if a valid
entry is found, nil otherwise."
@@ -1881,6 +2200,9 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(push-mark)
(insert (funcall fun 'bibtex-entry-kill-ring-yank-pointer
bibtex-entry-kill-ring))
+ ;; If we copied an entry from a buffer containing only this one entry,
+ ;; it can be missing the second "\n".
+ (unless (looking-back "\n\n") (insert "\n"))
(unless (functionp bibtex-reference-keys)
;; update `bibtex-reference-keys'
(save-excursion
@@ -1889,6 +2211,14 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(let ((key (bibtex-key-in-head)))
(if key (push (cons key t) bibtex-reference-keys))))))))
+(defsubst bibtex-vec-push (vec idx newelt)
+ "Add NEWELT to the list stored in VEC at index IDX."
+ (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."
+ (aset vec idx (1+ (aref vec idx))))
+
(defun bibtex-format-entry ()
"Helper function for `bibtex-clean-entry'.
Formats current entry according to variable `bibtex-entry-format'."
@@ -1906,11 +2236,11 @@ Formats current entry according to variable `bibtex-entry-format'."
'(realign opts-or-alts required-fields numerical-fields
page-dashes whitespace inherit-booktitle
last-comma delimiters unify-case braces
- strings)
+ strings sort-fields)
bibtex-entry-format))
(left-delim-re (regexp-quote (bibtex-field-left-delimiter)))
bounds crossref-key req-field-list default-field-list field-list
- alt-fields error-field-name)
+ num-alt alt-fields idx error-field-name)
(unwind-protect
;; formatting (undone if error occurs)
(atomic-change-group
@@ -1932,7 +2262,7 @@ Formats current entry according to variable `bibtex-entry-format'."
(end-type (match-end 0))
(entry-list (assoc-string (buffer-substring-no-properties
beg-type end-type)
- bibtex-entry-field-alist t)))
+ bibtex-entry-alist t)))
;; unify case of entry type
(when (memq 'unify-case format)
@@ -1956,13 +2286,32 @@ Formats current entry according to variable `bibtex-entry-format'."
;; list of required fields appropriate for an entry with
;; or without crossref key.
- (setq req-field-list (if (and crossref-key (nth 2 entry-list))
- (car (nth 2 entry-list))
- (car (nth 1 entry-list)))
+ (setq req-field-list (if crossref-key (nth 2 entry-list)
+ (append (nth 2 entry-list) (nth 3 entry-list)))
;; default list of fields that may appear in this entry
- default-field-list (append (nth 0 (nth 1 entry-list))
- (nth 1 (nth 1 entry-list))
- bibtex-user-optional-fields)))
+ default-field-list (append (nth 2 entry-list) (nth 3 entry-list)
+ (nth 4 entry-list)
+ bibtex-user-optional-fields)
+ ;; number of ALT fields we expect to find
+ num-alt (length (delq nil (delete-dups
+ (mapcar (lambda (x) (nth 3 x))
+ req-field-list))))
+ ;; ALT fields of respective groups
+ alt-fields (make-vector num-alt nil))
+
+ (when (memq 'sort-fields format)
+ (goto-char (point-min))
+ (let ((beg-fields (save-excursion (bibtex-beginning-first-field)))
+ (fields-alist (bibtex-parse-entry))
+ bibtex-help-message elt)
+ (delete-region beg-fields (point))
+ (dolist (field default-field-list)
+ (when (setq elt (assoc-string (car field) fields-alist t))
+ (setq fields-alist (delete elt fields-alist))
+ (bibtex-make-field (list (car elt) nil (cdr elt)) nil nil t)))
+ (dolist (field fields-alist)
+ (unless (member (car field) '("=key=" "=type="))
+ (bibtex-make-field (list (car field) nil (cdr field)) nil nil t))))))
;; process all fields
(bibtex-beginning-first-field (point-min))
@@ -1973,17 +2322,18 @@ Formats current entry according to variable `bibtex-entry-format'."
(end-name (copy-marker (bibtex-end-of-name-in-field bounds)))
(beg-text (copy-marker (bibtex-start-of-text-in-field bounds)))
(end-text (copy-marker (bibtex-end-of-text-in-field bounds) t))
- (opt-alt (string-match "OPT\\|ALT"
- (buffer-substring-no-properties
- beg-name (+ beg-name 3))))
- (field-name (buffer-substring-no-properties
- (if opt-alt (+ beg-name 3) beg-name) end-name))
(empty-field (equal "" (bibtex-text-in-field-bounds bounds t)))
+ (field-name (buffer-substring-no-properties beg-name end-name))
+ (opt-alt (and (string-match "\\`\\(OPT\\|ALT\\)" field-name)
+ (not (and bibtex-no-opt-remove-re
+ (string-match bibtex-no-opt-remove-re
+ field-name)))))
deleted)
+ (if opt-alt (setq field-name (substring field-name 3)))
;; keep track of alternatives
- (if (nth 3 (assoc-string field-name req-field-list t))
- (push field-name alt-fields))
+ (if (setq idx (nth 3 (assoc-string field-name req-field-list t)))
+ (bibtex-vec-push alt-fields idx field-name))
(if (memq 'opts-or-alts format)
;; delete empty optional and alternative fields
@@ -2018,7 +2368,7 @@ Formats current entry according to variable `bibtex-entry-format'."
;; remove delimiters from purely numerical fields
(when (and (memq 'numerical-fields format)
(progn (goto-char beg-text)
- (looking-at "\\(\"[0-9]+\"\\)\\|\\({[0-9]+}\\)")))
+ (looking-at "\"[0-9]+\"\\|{[0-9]+}")))
(goto-char end-text)
(delete-char -1)
(goto-char beg-text)
@@ -2134,12 +2484,14 @@ Formats current entry according to variable `bibtex-entry-format'."
;; check whether all required fields are present
(if (memq 'required-fields format)
- (let ((found 0) alt-list)
+ (let ((alt-expect (make-vector num-alt nil))
+ (alt-found (make-vector num-alt 0)))
(dolist (fname req-field-list)
- (cond ((nth 3 fname) ; t if field has alternative flag
- (push (car fname) alt-list)
+ (cond ((setq idx (nth 3 fname))
+ ;; t if field has alternative flag
+ (bibtex-vec-push alt-expect idx (car fname))
(if (member-ignore-case (car fname) field-list)
- (setq found (1+ found))))
+ (bibtex-vec-incr alt-found idx)))
((not (member-ignore-case (car fname) field-list))
;; If we use the crossref field, a required field
;; can have the OPT prefix. So if it was empty,
@@ -2147,17 +2499,16 @@ Formats current entry according to variable `bibtex-entry-format'."
;; move point on this empty field.
(setq error-field-name (car fname))
(error "Mandatory field `%s' is missing" (car fname)))))
- (if alt-list
- (cond ((= found 0)
- (if alt-fields
- (setq error-field-name (car (last alt-fields))))
- (error "Alternative mandatory field `%s' is missing"
- alt-list))
- ((> found 1)
- (if alt-fields
- (setq error-field-name (car (last alt-fields))))
- (error "Alternative fields `%s' are defined %s times"
- alt-list found))))))
+ (dotimes (idx num-alt)
+ (cond ((= 0 (aref alt-found idx))
+ (setq error-field-name (car (last (aref alt-fields idx))))
+ (error "Alternative mandatory field `%s' is missing"
+ (aref alt-expect idx)))
+ ((< 1 (aref alt-found idx))
+ (setq error-field-name (car (last (aref alt-fields idx))))
+ (error "Alternative fields `%s' are defined %s times"
+ (aref alt-expect idx)
+ (length (aref alt-fields idx))))))))
;; update comma after last field
(if (memq 'last-comma format)
@@ -2247,10 +2598,11 @@ applied to the content of FIELD. It is an alist with pairs
(content (bibtex-text-in-field field bibtex-autokey-use-crossref))
case-fold-search)
(unless content (setq content ""))
- (dolist (pattern change-list content)
+ (dolist (pattern change-list)
(setq content (replace-regexp-in-string (car pattern)
(cdr pattern)
- content t)))))
+ content t)))
+ content))
(defun bibtex-autokey-get-names ()
"Get contents of the name field of the current entry.
@@ -2510,7 +2862,7 @@ for parsing BibTeX keys. If parsing fails, try to set this variable to nil."
(push (list key) crossref-keys))))
;; only keys of known entries
((assoc-string (bibtex-type-in-head)
- bibtex-entry-field-alist t)
+ bibtex-entry-alist t)
;; This is an entry.
(let ((key (bibtex-key-in-head)))
(unless (assoc key ref-keys)
@@ -2521,7 +2873,7 @@ for parsing BibTeX keys. If parsing fails, try to set this variable to nil."
(bibtex-sort-ignore-string-entries t)
bounds)
(bibtex-map-entries
- (lambda (key beg end)
+ (lambda (key _beg end)
(if (and abortable
(input-pending-p))
;; user has aborted by typing a key: return `aborted'
@@ -2697,16 +3049,18 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses
((and (not current) (memq (current-buffer) buffer-list))
(setq buffer-list (delq (current-buffer) buffer-list))))
;; parse keys
- (dolist (buffer buffer-list)
- (with-current-buffer buffer
- (if (or force (functionp bibtex-reference-keys))
- (bibtex-parse-keys))
- (unless (functionp bibtex-strings)
- (bibtex-parse-strings (bibtex-string-files-init)))))
+ (let (string-init)
+ (dolist (buffer buffer-list)
+ (with-current-buffer buffer
+ (if (or force (functionp bibtex-reference-keys))
+ (bibtex-parse-keys))
+ (when (or force (functionp bibtex-strings))
+ (unless string-init (setq string-init (bibtex-string-files-init)))
+ (bibtex-parse-strings string-init)))))
;; select BibTeX buffer
(if select
(if buffer-list
- (switch-to-buffer
+ (pop-to-buffer-same-window
(completing-read "Switch to BibTeX buffer: "
(mapcar 'buffer-name buffer-list)
nil t
@@ -2714,20 +3068,6 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses
(message "No BibTeX buffers defined")))
buffer-list))
-(defun bibtex-complete-internal (completions)
- "Complete word fragment before point to longest prefix of COMPLETIONS.
-COMPLETIONS is an alist of strings. If point is not after the part
-of a word, all strings are listed. Return completion."
- ;; Return value is used by cleanup functions.
- ;; Code inspired by `lisp-complete-symbol'.
- (let ((beg (save-excursion
- (re-search-backward "[ \t{\"]")
- (forward-char)
- (point)))
- (end (point)))
- (when (completion-in-region beg end completions)
- (buffer-substring beg (point)))))
-
(defun bibtex-complete-string-cleanup (str compl)
"Cleanup after inserting string STR.
Remove enclosing field delimiters for STR. Display message with
@@ -2941,7 +3281,7 @@ BOUND limits the search."
;; Interactive Functions:
;;;###autoload
-(defun bibtex-mode ()
+(define-derived-mode bibtex-mode nil "BibTeX"
"Major mode for editing BibTeX files.
General information on working with BibTeX mode:
@@ -2953,7 +3293,7 @@ new entry with the command \\[bibtex-clean-entry].
Some features of BibTeX mode are available only by setting the variable
`bibtex-maintain-sorted-entries' to non-nil. However, then BibTeX mode
-works only with buffers containing valid (syntactical correct) and sorted
+works only with buffers containing valid (syntactically correct) and sorted
entries. This is usually the case, if you have created a buffer completely
with BibTeX mode and finished every new entry with \\[bibtex-clean-entry].
@@ -2975,7 +3315,7 @@ the name of a field with \\[bibtex-remove-OPT-or-ALT].
\\[bibtex-remove-delimiters] removes the double-quotes or braces around the text of the current field.
\\[bibtex-empty-field] replaces the text of the current field with the default \"\" or {}.
\\[bibtex-find-text] moves point to the end of the current field.
-\\[bibtex-complete] completes word fragment before point according to context.
+\\[completion-at-point] completes word fragment before point according to context.
The command \\[bibtex-clean-entry] cleans the current entry, i.e. it removes OPT/ALT
from the names of all non-empty optional or alternative fields, checks that
@@ -2993,12 +3333,8 @@ Entry to BibTeX mode calls the value of `bibtex-mode-hook'
if that value is non-nil.
\\{bibtex-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map bibtex-mode-map)
- (setq major-mode 'bibtex-mode)
- (setq mode-name "BibTeX")
- (set-syntax-table bibtex-mode-syntax-table)
+ (add-hook 'completion-at-point-functions
+ 'bibtex-completion-at-point-function nil 'local)
(make-local-variable 'bibtex-buffer-last-parsed-tick)
;; Install stealthy parse function if not already installed
(unless bibtex-parse-idle-timer
@@ -3013,9 +3349,8 @@ if that value is non-nil.
(set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
(set (make-local-variable 'outline-regexp) "[ \t]*@")
(set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
- (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset
- bibtex-contline-indentation)
- ?\s))
+ (set (make-local-variable 'fill-prefix)
+ (make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
(set (make-local-variable 'font-lock-defaults)
'(bibtex-font-lock-keywords
nil t ((?$ . "\"")
@@ -3037,29 +3372,121 @@ 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)
- (make-local-variable 'choose-completion-string-functions)
- ;; XEmacs needs `easy-menu-add', Emacs does not care
- (easy-menu-add bibtex-edit-menu)
- (easy-menu-add bibtex-entry-menu)
- (run-mode-hooks 'bibtex-mode-hook))
+ (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'."
+ (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))))))))
(defun bibtex-field-list (entry-type)
"Return list of allowed fields for entry ENTRY-TYPE.
More specifically, the return value is a cons pair (REQUIRED . OPTIONAL),
where REQUIRED and OPTIONAL are lists of the required and optional field
-names for ENTRY-TYPE according to `bibtex-entry-field-alist',
+names for ENTRY-TYPE according to `bibtex-BibTeX-entry-alist' and friends,
`bibtex-include-OPTkey', `bibtex-include-OPTcrossref',
and `bibtex-user-optional-fields'."
- (let ((e (assoc-string entry-type bibtex-entry-field-alist t))
+ (let ((e-list (assoc-string entry-type bibtex-entry-alist t))
required optional)
- (unless e
+ (unless e-list
(error "Fields for BibTeX entry type %s not defined" entry-type))
- (if (and (member-ignore-case entry-type bibtex-include-OPTcrossref)
- (nth 2 e))
- (setq required (nth 0 (nth 2 e))
- optional (nth 1 (nth 2 e)))
- (setq required (nth 0 (nth 1 e))
- optional (nth 1 (nth 1 e))))
+ (if (member-ignore-case entry-type bibtex-include-OPTcrossref)
+ (setq required (nth 2 e-list)
+ optional (append (nth 3 e-list) (nth 4 e-list)))
+ (setq required (append (nth 2 e-list) (nth 3 e-list))
+ optional (nth 4 e-list)))
(if bibtex-include-OPTkey
(push (list "key"
"Used for reference key creation if author and editor fields are missing"
@@ -3079,7 +3506,7 @@ After insertion call the value of `bibtex-add-entry-hook' if that value
is non-nil."
(interactive
(let ((completion-ignore-case t))
- (list (completing-read "Entry Type: " bibtex-entry-field-alist
+ (list (completing-read "Entry Type: " bibtex-entry-alist
nil t nil 'bibtex-entry-type-history))))
(let ((key (if bibtex-maintain-sorted-entries
(bibtex-read-key (format "%s key: " entry-type))))
@@ -3112,7 +3539,7 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE."
(interactive
(list (if current-prefix-arg
(let ((completion-ignore-case t))
- (completing-read "New entry type: " bibtex-entry-field-alist
+ (completing-read "New entry type: " bibtex-entry-alist
nil t nil 'bibtex-entry-type-history)))))
(save-excursion
(bibtex-beginning-of-entry)
@@ -3139,8 +3566,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE."
(insert (bibtex-field-left-delimiter)))
(goto-char end)))
(skip-chars-backward " \t\n")
- (dolist (field required) (bibtex-make-field field))
- (dolist (field optional) (bibtex-make-optional-field field))))))
+ (mapc 'bibtex-make-field required)
+ (mapc 'bibtex-make-optional-field optional)))))
(defun bibtex-parse-entry (&optional content)
"Parse entry at point, return an alist.
@@ -3159,7 +3586,7 @@ If optional arg CONTENT is non-nil extract content of text fields."
(bibtex-text-in-field-bounds bounds content))
alist)
(goto-char (bibtex-end-of-field bounds))))
- alist))
+ (nreverse alist)))
(defun bibtex-autofill-entry ()
"Try to fill fields of current BibTeX entry based on neighboring entries.
@@ -3249,14 +3676,16 @@ interactive calls."
(field-list (bibtex-field-list type))
(comment (assoc-string field (append (car field-list)
(cdr field-list)) t)))
- (if comment (message "%s" (nth 1 comment))
- (message "No comment available")))))
+ (message "%s" (cond ((nth 1 comment) (nth 1 comment))
+ ((setq comment (assoc-string field bibtex-field-alist t))
+ (nth 1 comment))
+ (t "No comment available"))))))
(defun bibtex-make-field (field &optional move interactive nodelim)
"Make a field named FIELD in current BibTeX entry.
FIELD is either a string or a list of the form
\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in
-`bibtex-entry-field-alist'.
+`bibtex-BibTeX-entry-alist' and friends.
If MOVE is non-nil, move point past the present field before making
the new field. If INTERACTIVE is non-nil, move point to the end of
the new field. Otherwise move point past the new field.
@@ -3281,6 +3710,8 @@ INIT is surrounded by field delimiters, unless NODELIM is non-nil."
(forward-char)))
(insert ",\n")
(indent-to-column (+ bibtex-entry-offset bibtex-field-indentation))
+ ;; If there are multiple sets of alternatives, we could use
+ ;; the numeric value of (nth 3 field) to number these sets. Useful??
(if (nth 3 field) (insert "ALT"))
(insert (car field) " ")
(if bibtex-align-at-equal-sign
@@ -3383,7 +3814,7 @@ If mark is active count entries in region, if not in whole buffer."
(bibtex-sort-ignore-string-entries (not count-string-entries)))
(save-restriction
(if mark-active (narrow-to-region (region-beginning) (region-end)))
- (bibtex-map-entries (lambda (key beg end) (setq number (1+ number)))))
+ (bibtex-map-entries (lambda (_key _beg _end) (setq number (1+ number)))))
(message "%s contains %d entries."
(if mark-active "Region" "Buffer")
number)))
@@ -3438,12 +3869,13 @@ of the head of the entry found. Return nil if no entry found."
(unless (local-variable-p 'bibtex-sort-entry-class-alist)
(set (make-local-variable 'bibtex-sort-entry-class-alist)
(let ((i -1) alist)
- (dolist (class bibtex-sort-entry-class alist)
+ (dolist (class bibtex-sort-entry-class)
(setq i (1+ i))
(dolist (entry class)
;; All entry types should be downcase (for ease of comparison).
(push (cons (if (stringp entry) (downcase entry) entry) i)
- alist)))))))
+ alist)))
+ alist))))
(defun bibtex-lessp (index1 index2)
"Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
@@ -3586,10 +4018,15 @@ is limited to the current buffer. Optional arg START is buffer position
where the search starts. If it is nil, start search at beginning of buffer.
If DISPLAY is non-nil, display the buffer containing KEY.
Otherwise, use `set-buffer'.
-When called interactively, GLOBAL is t if there is a prefix arg or the current
-mode is not `bibtex-mode', START is nil, and DISPLAY is t."
+When called interactively, START is nil, DISPLAY is t.
+Also, GLOBAL is t if the current mode is not `bibtex-mode'
+or `bibtex-search-entry-globally' is non-nil.
+A prefix arg negates the value of `bibtex-search-entry-globally'."
(interactive
- (let ((global (or current-prefix-arg (not (eq major-mode 'bibtex-mode)))))
+ (let ((global (or (not (eq major-mode 'bibtex-mode))
+ (if bibtex-search-entry-globally
+ (not current-prefix-arg)
+ current-prefix-arg))))
(list (bibtex-read-key "Find key: " nil global) global nil t)))
(if (and global bibtex-files)
(let ((buffer-list (bibtex-initialize t))
@@ -3735,7 +4172,7 @@ Return t if test was successful, nil otherwise."
(let (previous current key-list)
(bibtex-progress-message "Checking for duplicate keys")
(bibtex-map-entries
- (lambda (key beg end)
+ (lambda (key _beg _end)
(bibtex-progress-message)
(setq current (bibtex-entry-index))
(cond ((not previous))
@@ -3773,14 +4210,22 @@ Return t if test was successful, nil otherwise."
"Checking required fields and month fields")
(let ((bibtex-sort-ignore-string-entries t))
(bibtex-map-entries
- (lambda (key beg end)
+ (lambda (_key beg end)
(bibtex-progress-message)
- (let* ((entry-list (assoc-string (bibtex-type-in-head)
- bibtex-entry-field-alist t))
- (req (copy-sequence (elt (elt entry-list 1) 0)))
- (creq (copy-sequence (elt (elt entry-list 2) 0)))
- crossref-there bounds alt-there field)
- (bibtex-beginning-first-field beg)
+ (bibtex-beginning-first-field beg)
+ (let* ((beg-line (save-excursion (goto-char beg)
+ (bibtex-current-line)))
+ (entry-list (assoc-string (bibtex-type-in-head)
+ bibtex-entry-alist t))
+ (crossref (bibtex-search-forward-field "crossref" end))
+ (req (if crossref (copy-sequence (nth 2 entry-list))
+ (append (nth 2 entry-list)
+ (copy-sequence (nth 3 entry-list)))))
+ (num-alt (length (delq nil (delete-dups
+ (mapcar (lambda (x) (nth 3 x))
+ req)))))
+ (alt-fields (make-vector num-alt nil))
+ bounds field idx)
(while (setq bounds (bibtex-parse-field))
(let ((field-name (bibtex-name-in-field bounds)))
(if (and (bibtex-string= field-name "month")
@@ -3794,36 +4239,28 @@ Return t if test was successful, nil otherwise."
"Questionable month field")
error-list))
(setq field (assoc-string field-name req t)
- req (delete field req)
- creq (delete (assoc-string field-name creq t) creq))
- (if (nth 3 field)
- (if alt-there
+ req (delete field req))
+ (if (setq idx (nth 3 field))
+ (if (aref alt-fields idx)
(push (cons (bibtex-current-line)
"More than one non-empty alternative")
error-list)
- (setq alt-there t)))
- (if (bibtex-string= field-name "crossref")
- (setq crossref-there t)))
+ (aset alt-fields idx t))))
(goto-char (bibtex-end-of-field bounds)))
- (if crossref-there (setq req creq))
- (let (alt)
- (dolist (field req)
- (if (nth 3 field)
- (push (car field) alt)
- (push (cons (save-excursion (goto-char beg)
- (bibtex-current-line))
+ (let ((alt-expect (make-vector num-alt nil)))
+ (dolist (field req) ; absent required fields
+ (if (setq idx (nth 3 field))
+ (bibtex-vec-push alt-expect idx (car field))
+ (push (cons beg-line
(format "Required field `%s' missing"
(car field)))
error-list)))
- ;; The following fails if there are more than two
- ;; alternatives in a BibTeX entry, which isn't
- ;; the case momentarily.
- (if (cdr alt)
- (push (cons (save-excursion (goto-char beg)
- (bibtex-current-line))
- (format "Alternative fields `%s'/`%s' missing"
- (car alt) (cadr alt)))
- error-list)))))))
+ (dotimes (idx num-alt)
+ (unless (aref alt-fields idx)
+ (push (cons beg-line
+ (format "Alternative fields `%s' missing"
+ (aref alt-expect idx)))
+ error-list))))))))
(bibtex-progress-message 'done)))))
(if error-list
@@ -3862,20 +4299,21 @@ Return t if test was successful, nil otherwise."
;; Check for duplicate keys within BibTeX buffer
(dolist (buffer buffer-list)
(with-current-buffer buffer
- (let (entry-type key key-list)
- (goto-char (point-min))
- (while (re-search-forward bibtex-entry-head nil t)
- (setq entry-type (bibtex-type-in-head)
- key (bibtex-key-in-head))
- (if (or (and strings (bibtex-string= entry-type "string"))
- (assoc-string entry-type bibtex-entry-field-alist t))
- (if (member key key-list)
- (push (format "%s:%d: Duplicate key `%s'\n"
- (buffer-file-name)
- (bibtex-current-line) key)
- error-list)
- (push key key-list))))
- (push (cons buffer key-list) buffer-key-list))))
+ (save-excursion
+ (let (entry-type key key-list)
+ (goto-char (point-min))
+ (while (re-search-forward bibtex-entry-head nil t)
+ (setq entry-type (bibtex-type-in-head)
+ key (bibtex-key-in-head))
+ (if (or (and strings (bibtex-string= entry-type "string"))
+ (assoc-string entry-type bibtex-entry-alist t))
+ (if (member key key-list)
+ (push (format "%s:%d: Duplicate key `%s'\n"
+ (buffer-file-name)
+ (bibtex-current-line) key)
+ error-list)
+ (push key key-list))))
+ (push (cons buffer key-list) buffer-key-list)))))
;; Check for duplicate keys among BibTeX buffers
(while (setq current-buf (pop buffer-list))
@@ -4035,7 +4473,13 @@ is as in `bibtex-enclosing-field'. It is t for interactive calls."
(bounds (bibtex-enclosing-field comma)))
(save-excursion
(goto-char (bibtex-start-of-name-in-field bounds))
- (when (looking-at "OPT\\|ALT")
+ (when (and (looking-at "OPT\\|ALT")
+ (not (and bibtex-no-opt-remove-re
+ (string-match
+ bibtex-no-opt-remove-re
+ (buffer-substring-no-properties
+ (bibtex-start-of-name-in-field bounds)
+ (bibtex-end-of-name-in-field bounds))))))
(delete-region (match-beginning 0) (match-end 0))
;; make field non-OPT
(search-forward "=")
@@ -4137,6 +4581,7 @@ More precisely, reinsert the field or entry killed or yanked most recently.
With argument N, reinsert the Nth most recently killed BibTeX item.
See also the command \\[bibtex-yank-pop]."
(interactive "*p")
+ (unless n (setq n 1))
(bibtex-insert-kill (1- n) t)
(setq this-command 'bibtex-yank))
@@ -4224,21 +4669,24 @@ At end of the cleaning process, the functions in
;; (bibtex-format-string)
(t (bibtex-format-entry)))
;; set key
- (when (or new-key (not key))
- (setq key (bibtex-generate-autokey))
- ;; Sometimes `bibtex-generate-autokey' returns an empty string
- (if (or bibtex-autokey-edit-before-use (string= "" key))
- (setq key (if (eq entry-type 'string)
- (bibtex-read-string-key key)
- (bibtex-read-key "Key to use: " key))))
- (save-excursion
- (re-search-forward (if (eq entry-type 'string)
- bibtex-string-maybe-empty-head
- bibtex-entry-maybe-empty-head))
- (if (match-beginning bibtex-key-in-head)
- (delete-region (match-beginning bibtex-key-in-head)
- (match-end bibtex-key-in-head)))
- (insert key)))
+ (if (or new-key (not key))
+ (save-excursion
+ ;; First delete the old key so that a customized algorithm
+ ;; for generating the new key does not get confused by the
+ ;; old key.
+ (re-search-forward (if (eq entry-type 'string)
+ bibtex-string-maybe-empty-head
+ bibtex-entry-maybe-empty-head))
+ (if (match-beginning bibtex-key-in-head)
+ (delete-region (match-beginning bibtex-key-in-head)
+ (match-end bibtex-key-in-head)))
+ (setq key (bibtex-generate-autokey))
+ ;; Sometimes `bibtex-generate-autokey' returns an empty string
+ (if (or bibtex-autokey-edit-before-use (string= "" key))
+ (setq key (if (eq entry-type 'string)
+ (bibtex-read-string-key key)
+ (bibtex-read-key "Key to use: " key))))
+ (insert key)))
(unless called-by-reformat
(let* ((end (save-excursion
@@ -4416,14 +4864,15 @@ If mark is active reformat entries in region, if not in whole buffer."
("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))))))
+ ("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.
((eq t bibtex-entry-format)
'(realign opts-or-alts numerical-fields delimiters
last-comma page-dashes unify-case inherit-booktitle
- whitespace braces strings))
+ whitespace braces strings sort-fields))
(t
(cons 'realign (remove 'required-fields bibtex-entry-format)))))
(reformat-reference-keys
@@ -4440,7 +4889,7 @@ If mark is active reformat entries in region, if not in whole buffer."
(if (memq 'realign bibtex-entry-format)
(bibtex-realign))
(bibtex-progress-message "Formatting" 1)
- (bibtex-map-entries (lambda (key beg end)
+ (bibtex-map-entries (lambda (_key _beg _end)
(bibtex-progress-message)
(bibtex-clean-entry reformat-reference-keys t)))
(bibtex-progress-message 'done))
@@ -4473,17 +4922,15 @@ entries from minibuffer."
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
-(defun bibtex-complete ()
- "Complete word fragment before point according to context.
-If point is inside key or crossref field perform key completion based on
-`bibtex-reference-keys'. Inside a month field perform key completion
-based on `bibtex-predefined-month-strings'. Inside any other field
-\(including a String or Preamble definition) perform string completion
-based on `bibtex-strings'.
-An error is signaled if point is outside key or BibTeX field."
- (interactive)
+(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
+(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
+ (beg (save-excursion
+ (re-search-backward "[ \t{\"]")
+ (forward-char)
+ (point)))
+ (end (point))
bounds name compl)
(save-excursion
(if (and (setq bounds (bibtex-enclosing-field nil t))
@@ -4524,114 +4971,56 @@ An error is signaled if point is outside key or BibTeX field."
(setq compl 'key)))))
(cond ((eq compl 'key)
- ;; key completion: no cleanup needed
- (setq choose-completion-string-functions nil)
- (let (completion-ignore-case)
- (bibtex-complete-internal (bibtex-global-key-alist))))
+ ;; Key completion: no cleanup needed.
+ (list beg end
+ (lambda (s p a)
+ (let (completion-ignore-case)
+ (complete-with-action a (bibtex-global-key-alist) s p)))))
((eq compl 'crossref-key)
- ;; crossref key completion
- ;;
- ;; If we quit the *Completions* buffer without requesting
- ;; a completion, `choose-completion-string-functions' is still
- ;; non-nil. Therefore, `choose-completion-string-functions' is
- ;; always set (either to non-nil or nil) when a new completion
- ;; is requested.
- (let (completion-ignore-case)
- (setq choose-completion-string-functions
- (lambda (choice buffer base-position &rest ignored)
- (setq choose-completion-string-functions nil)
- (choose-completion-string choice buffer base-position)
- (bibtex-complete-crossref-cleanup choice)
- t)) ; needed by choose-completion-string-functions
- (bibtex-complete-crossref-cleanup
- (bibtex-complete-internal (bibtex-global-key-alist)))))
+ ;; Crossref key completion.
+ (let* ((buf (current-buffer)))
+ (list beg end
+ (lambda (s p a)
+ (cond
+ ((eq a 'metadata) `(metadata (category . bibtex-key)))
+ (t (let ((completion-ignore-case nil))
+ (complete-with-action
+ a (bibtex-global-key-alist) s p)))))
+ :exit-function
+ (lambda (string status)
+ (when (memq status '(exact sole finished))
+ (let ((summary
+ (with-current-buffer buf
+ (save-excursion
+ (if (bibtex-search-entry string)
+ (funcall bibtex-summary-function))))))
+ (when summary
+ (message "%s %s" string summary))))))))
((eq compl 'string)
- ;; string key completion: no cleanup needed
- (setq choose-completion-string-functions nil)
- (let ((completion-ignore-case t))
- (bibtex-complete-internal bibtex-strings)))
+ ;; String key completion: no cleanup needed.
+ (list beg end
+ (lambda (s p a)
+ (let ((completion-ignore-case t))
+ (complete-with-action a bibtex-strings s p)))))
(compl
- ;; string completion
- (let ((completion-ignore-case t))
- (setq choose-completion-string-functions
- `(lambda (choice buffer base-position &rest ignored)
- (setq choose-completion-string-functions nil)
- (choose-completion-string choice buffer base-position)
- (bibtex-complete-string-cleanup choice ',compl)
- t)) ; needed by `choose-completion-string-functions'
- (bibtex-complete-string-cleanup (bibtex-complete-internal compl)
- compl)))
-
- (t (setq choose-completion-string-functions nil)
- (error "Point outside key or BibTeX field")))))
-
-(defun bibtex-Article ()
- "Insert a new BibTeX @Article entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Article"))
-
-(defun bibtex-Book ()
- "Insert a new BibTeX @Book entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Book"))
-
-(defun bibtex-Booklet ()
- "Insert a new BibTeX @Booklet entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Booklet"))
-
-(defun bibtex-InBook ()
- "Insert a new BibTeX @InBook entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "InBook"))
-
-(defun bibtex-InCollection ()
- "Insert a new BibTeX @InCollection entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "InCollection"))
-
-(defun bibtex-InProceedings ()
- "Insert a new BibTeX @InProceedings entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "InProceedings"))
-
-(defun bibtex-Manual ()
- "Insert a new BibTeX @Manual entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Manual"))
-
-(defun bibtex-MastersThesis ()
- "Insert a new BibTeX @MastersThesis entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "MastersThesis"))
-
-(defun bibtex-Misc ()
- "Insert a new BibTeX @Misc entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Misc"))
-
-(defun bibtex-PhdThesis ()
- "Insert a new BibTeX @PhdThesis entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "PhdThesis"))
-
-(defun bibtex-Proceedings ()
- "Insert a new BibTeX @Proceedings entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Proceedings"))
-
-(defun bibtex-TechReport ()
- "Insert a new BibTeX @TechReport entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "TechReport"))
-
-(defun bibtex-Unpublished ()
- "Insert a new BibTeX @Unpublished entry; see also `bibtex-entry'."
- (interactive "*")
- (bibtex-entry "Unpublished"))
+ ;; String completion.
+ (list beg end
+ (lambda (s p a)
+ (cond
+ ((eq a 'metadata) `(metadata (category . bibtex-string)))
+ (t (let ((completion-ignore-case t))
+ (complete-with-action a compl s p)))))
+ :exit-function
+ (lambda (string status)
+ (when (memq status '(exact finished sole))
+ (let ((abbr (cdr (assoc-string string compl t))))
+ (when abbr
+ (message "%s = abbreviation for `%s'" string abbr))))
+ (when (eq status 'finished)
+ (save-excursion (bibtex-remove-delimiters)))))))))
(defun bibtex-String (&optional key)
"Insert a new BibTeX @String entry with key KEY."
@@ -4689,7 +5078,7 @@ Return the URL or nil if none can be generated."
(fields-alist (save-excursion (bibtex-parse-entry t)))
;; Always ignore case,
(case-fold-search t)
- text url scheme obj fmt fl-match step)
+ text url scheme obj fmt fl-match)
;; The return value of `bibtex-parse-entry' (i.e., FIELDS-ALIST)
;; is always used to generate the URL. However, if the BibTeX
;; entry contains more than one URL, we have multiple matches
@@ -4744,11 +5133,8 @@ Return the URL or nil if none can be generated."
(setq url (if (null scheme) (match-string 0 text)
(if (stringp (car scheme))
(setq fmt (pop scheme)))
- (dotimes (i (length scheme))
- (setq step (nth i scheme))
- ;; The first step shall use TEXT as obtained earlier.
- (unless (= i 0)
- (setq text (cdr (assoc-string (car step) fields-alist t))))
+ (dolist (step scheme)
+ (setq text (cdr (assoc-string (car step) fields-alist t)))
(if (string-match (nth 1 step) text)
(push (cond ((functionp (nth 2 step))
(funcall (nth 2 step) text))
@@ -4768,9 +5154,118 @@ Return the URL or nil if none can be generated."
(message "No URL known."))
url)))
+;; We could combine multiple seach 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...".
+(defun bibtex-search-entries (field regexp &optional global display)
+ "Search BibTeX entries for FIELD matching REGEXP.
+REGEXP may be a regexp to search for.
+If REGEXP is a function, it is called for each entry with two args,
+the buffer positions of beginning and end of entry. Then an entry
+is accepted if this function returns non-nil.
+If FIELD is an empty string perform search for REGEXP in whole entry.
+With GLOBAL non-nil, search in `bibtex-files'. Otherwise the search
+is limited to the current buffer.
+If DISPLAY is non-nil, display search results in `bibtex-search-buffer'.
+When called interactively, DISPLAY is t.
+Also, GLOBAL is t if `bibtex-search-entry-globally' is non-nil.
+A prefix arg negates the value of `bibtex-search-entry-globally'.
+Return alist with elements (KEY FILE ENTRY),
+where FILE is the BibTeX file of ENTRY."
+ (interactive
+ (list (completing-read
+ "Field: "
+ (delete-dups
+ (apply 'append
+ bibtex-user-optional-fields
+ (mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2 x))))
+ bibtex-entry-alist))) nil t)
+ (read-string "Regexp: ")
+ (if bibtex-search-entry-globally
+ (not current-prefix-arg)
+ current-prefix-arg)
+ t))
+ (let ((funp (functionp regexp))
+ entries text file)
+ ;; If REGEXP is a function, the value of FIELD is ignored anyway.
+ ;; Yet to ensure the code below does not fail, we make FIELD
+ ;; a non-empty string.
+ (if (and funp (string= "" field)) (setq field "unrestricted"))
+ (dolist (buffer (if (and global bibtex-files)
+ (bibtex-initialize t)
+ (list (current-buffer))))
+ (with-current-buffer buffer
+ (setq file (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ (buffer-name buffer)))
+ (save-excursion
+ (goto-char (point-min))
+ (if (string= "" field)
+ ;; Unrestricted search.
+ (while (re-search-forward regexp nil t)
+ (let ((beg (bibtex-beginning-of-entry))
+ (end (bibtex-end-of-entry))
+ key)
+ (if (and (<= beg (match-beginning 0))
+ (<= (match-end 0) end)
+ (save-excursion
+ (goto-char beg)
+ (and (looking-at bibtex-entry-head)
+ (setq key (bibtex-key-in-head))))
+ (not (assoc key entries)))
+ (push (list key file
+ (buffer-substring-no-properties beg end))
+ entries))))
+ ;; The following is slow. But it works reliably even in more
+ ;; complicated cases with BibTeX string constants and crossrefed
+ ;; entries. If you prefer speed over reliability, perform an
+ ;; unrestricted search.
+ (bibtex-map-entries
+ (lambda (key beg end)
+ (if (and (cond (funp (funcall regexp beg end))
+ ((and (setq text (bibtex-text-in-field field t))
+ (string-match regexp text))))
+ (not (assoc key entries)))
+ (push (list key file
+ (buffer-substring-no-properties beg end))
+ entries))))))))
+ (if display
+ (if entries
+ (bibtex-display-entries entries)
+ (message "No BibTeX entries %smatching `%s'"
+ (if (string= "" field) ""
+ (format "with field `%s' " field))
+ regexp)))
+ entries))
+
+(defun bibtex-display-entries (entries &optional append)
+ "Display BibTeX ENTRIES in `bibtex-search-buffer'.
+ENTRIES is an alist with elements (KEY FILE ENTRY),
+where FILE is the BibTeX file of ENTRY.
+If APPEND is non-nil, append ENTRIES to those already displayed."
+ (pop-to-buffer (get-buffer-create bibtex-search-buffer))
+ ;; It would be nice if this buffer was editable, though editing
+ ;; can be meaningful only for individual existing entries
+ ;; (unlike reordering or creating new entries).
+ ;; Fancy workaround: Editing commands in the virtual buffer could
+ ;; jump to the real entry in the real buffer.
+ (let (buffer-read-only)
+ (if append (goto-char (point-max)) (erase-buffer))
+ (dolist (entry (sort entries (lambda (x y) (string< (car x) (car y)))))
+ (insert "% " (nth 1 entry) "\n" (nth 2 entry) "\n\n")))
+ ;; `bibtex-sort-buffer' fails with the file names associated with
+ ;; each entry. Prior to sorting we could make the file name
+ ;; a BibTeX field of each entry (using `bibtex-make-field').
+ ;; Or we could make it a text property that we unfold afterwards.
+ ;; (bibtex-sort-buffer)
+ (bibtex-mode)
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (goto-char (point-min)))
+
;; Make BibTeX a Feature
(provide 'bibtex)
-
;;; bibtex.el ends here
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index ef51fb25035..d98aa183f21 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -213,7 +213,7 @@
(defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)"))
(defconst css-ident-re (concat css-nmstart-re css-nmchar-re "*"))
(defconst css-proprietary-nmstart-re ;; Vendor-specific properties.
- "[-_]\\(?:ms\\|moz\\|o\\|webkit\\|khtml\\)-")
+ (concat "[-_]" (regexp-opt '("ms" "moz" "o" "khtml" "webkit")) "-"))
(defconst css-name-re (concat css-nmchar-re "+"))
(defface css-selector '((t :inherit font-lock-function-name-face))
@@ -240,7 +240,7 @@
;; thus prevent this highlighting from being applied (actually now that
;; I use `append' this should work better). But really the part of hte
;; selector between [...] should simply not be highlighted.
- (,(concat "^\\([ \t]*[^@:{\n][^:{\n]+\\(?::" (regexp-opt css-pseudo-ids t)
+ (,(concat "^\\([ \t]*[^@:{}\n][^:{}]+\\(?::" (regexp-opt css-pseudo-ids t)
"\\(?:([^)]+)\\)?[^:{\n]*\\)*\\)\\(?:\n[ \t]*\\)*{")
(1 'css-selector append))
;; In the above rule, we allow the open-brace to be on some subsequent
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 2b7e9a19baa..b264cc30850 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -988,7 +988,7 @@ can take care of filling. JUSTIFY is used as in `fill-paragraph'."
(defun fill-region (from to &optional justify nosqueeze to-eop)
"Fill each of the paragraphs in the region.
A prefix arg means justify as well.
-Ordinarily the variable `fill-column' controls the width.
+The `fill-column' variable controls the width.
Noninteractively, the third argument JUSTIFY specifies which
kind of justification to do: `full', `left', `right', `center',
@@ -1054,6 +1054,7 @@ The `justification' text-property can locally override this variable."
(const full)
(const center)
(const none))
+ :safe 'symbolp
:group 'fill)
(make-variable-buffer-local 'default-justification)
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 99c9a83e4fb..e6837d0abde 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -296,7 +296,7 @@ If this variable is nil, all regions are treated as small."
;;* using flyspell with mail-mode add the following expression */
;;* in your .emacs 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
@@ -993,14 +993,17 @@ Mostly we check word delimiters."
;;*---------------------------------------------------------------------*/
;;* flyspell-word-search-backward ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-word-search-backward (word bound)
+(defun flyspell-word-search-backward (word bound &optional ignore-case)
(save-excursion
(let ((r '())
(inhibit-point-motion-hooks t)
p)
(while (and (not r) (setq p (search-backward word bound t)))
(let ((lw (flyspell-get-word)))
- (if (and (consp lw) (string-equal (car lw) word))
+ (if (and (consp lw)
+ (if ignore-case
+ (string-equal (downcase (car lw)) (downcase word))
+ (string-equal (car lw) word)))
(setq r p)
(goto-char p))))
r)))
@@ -1069,7 +1072,7 @@ misspelling and skips redundant spell-checking step."
(- end start)
(- (skip-chars-backward " \t\n\f"))))
(p (when (>= bound (point-min))
- (flyspell-word-search-backward word bound))))
+ (flyspell-word-search-backward word bound t))))
(and p (/= p start)))))
;; yes, this is a doublon
(flyspell-highlight-incorrect-region start end 'doublon)
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index 68202440e1d..9b924ba7ad9 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -34,7 +34,7 @@
(defun reftex-view-crossref (&optional arg auto-how fail-quietly)
"View cross reference of macro at point. Point must be on the KEY
-argument. When at at `\\ref' macro, show corresponding `\\label'
+argument. When at a `\\ref' macro, show corresponding `\\label'
definition, also in external documents (`xr'). When on a label, show
a locations where KEY is referenced. Subsequent calls find additional
locations. When on a `\\cite', show the associated `\\bibitem' macro or
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 6ffbf7a4621..b0f22085064 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -146,7 +146,7 @@
(unless (assq 'xr docstruct)
(let* ((allxr (reftex-all-assq 'xr-doc docstruct))
(alist (mapcar
- (lambda (x)
+ (lambda (x)
(if (setq tmp (reftex-locate-file (nth 2 x) "tex"
master-dir))
(cons (nth 1 x) tmp)
@@ -157,7 +157,7 @@
(alist (delq nil alist))
(allprefix (delq nil (mapcar 'car alist)))
(regexp (if allprefix
- (concat "\\`\\("
+ (concat "\\`\\("
(mapconcat 'identity allprefix "\\|")
"\\)")
"\\\\\\\\\\\\"))) ; this will never match
@@ -189,6 +189,9 @@ of master file."
(push file file-list))
(nreverse file-list)))
+;; Bound in the caller, reftex-do-parse.
+(defvar index-tags)
+
(defun reftex-parse-from-file (file docstruct master-dir)
;; Scan the buffer for labels and save them in a list.
(let ((regexp (reftex-everything-regexp))
@@ -259,7 +262,7 @@ of master file."
;; It's an include or input
(setq include-file (reftex-match-string 7))
;; Test if this file should be ignored
- (unless (delq nil (mapcar
+ (unless (delq nil (mapcar
(lambda (x) (string-match x include-file))
reftex-no-include-regexps))
;; Parse it
@@ -308,10 +311,10 @@ of master file."
(push (cons 'bib tmp) docstruct))
(goto-char 1)
- (when (re-search-forward
+ (when (re-search-forward
"\\(\\`\\|[\n\r]\\)[ \t]*\\\\begin{thebibliography}" nil t)
(push (cons 'thebib file) docstruct))
-
+
;; Find external document specifications
(goto-char 1)
(while (re-search-forward "[\n\r][ \t]*\\\\externaldocument\\(\\[\\([^]]*\\)\\]\\)?{\\([^}]+\\)}" nil t)
@@ -330,7 +333,7 @@ of master file."
(defun reftex-locate-bibliography-files (master-dir &optional files)
;; Scan buffer for bibliography macro and return file list.
-
+
(unless files
(save-excursion
(goto-char (point-min))
@@ -340,11 +343,11 @@ of master file."
"\\(^\\)[^%\n\r]*\\\\\\("
(mapconcat 'identity reftex-bibliography-commands "\\|")
"\\){[ \t]*\\([^}]+\\)") nil t)
- (setq files
+ (setq files
(split-string (reftex-match-string 3)
"[ \t\n\r]*,[ \t\n\r]*")))))
(when files
- (setq files
+ (setq files
(mapcar
(lambda (x)
(if (or (member x reftex-bibfile-ignore-list)
@@ -398,13 +401,13 @@ of master file."
(unnumbered (or star (< level 0)))
(level (abs level))
(section-number (reftex-section-number level unnumbered))
- (text1 (save-match-data
+ (text1 (save-match-data
(save-excursion
(reftex-context-substring prefix))))
(literal (buffer-substring-no-properties
(1- (match-beginning 3))
(min (point-max) (+ (match-end 0) (length text1) 1))))
- ;; Literal can be too short since text1 too short. No big problem.
+ ;; Literal can be too short since text1 too short. No big problem.
(text (reftex-nicify-text text1)))
;; Add section number and indentation
@@ -454,7 +457,7 @@ of master file."
(throw 'exit nil)))
(itag (nth 1 entry))
(prefix (nth 2 entry))
- (index-tag
+ (index-tag
(cond ((stringp itag) itag)
((integerp itag)
(progn (goto-char boa)
@@ -476,16 +479,16 @@ of master file."
(key-end (if (string-match reftex-index-key-end-re arg)
(1+ (match-beginning 0))))
(rawkey (substring arg 0 key-end))
-
+
(key (if prefix (concat prefix rawkey) rawkey))
(sortkey (downcase key))
- (showkey (mapconcat 'identity
+ (showkey (mapconcat 'identity
(split-string key reftex-index-level-re)
" ! ")))
(goto-char end-of-args)
;; 0 1 2 3 4 5 6 7 8 9
(list 'index index-tag context file bom arg key showkey sortkey key-end))))
-
+
(defun reftex-short-context (env parse &optional bound derive)
;; Get about one line of useful context for the label definition at point.
@@ -608,7 +611,7 @@ of master file."
((match-end 10)
;; Index entry
(when reftex-support-index
- (let* ((index-info (save-excursion
+ (let* ((index-info (save-excursion
(reftex-index-info-safe nil)))
(list (member (list 'bof (buffer-file-name))
docstruct))
@@ -618,7 +621,7 @@ of master file."
;; Check all index entries with equal text
(while (and list (not (eq endelt (car list))))
(when (and (eq (car (car list)) 'index)
- (string= (nth 2 index-info)
+ (string= (nth 2 index-info)
(nth 2 (car list))))
(incf n)
(setq dist (abs (- (point) (nth 4 (car list)))))
@@ -691,7 +694,7 @@ of master file."
level (nth 5 entry))
;; Insert the section info
(push entry (cdr tail))
-
+
;; We are done unless we use section numbers
(unless (nth 1 reftex-label-menu-flags) (throw 'exit nil))
@@ -722,7 +725,7 @@ of master file."
(setq entry (reftex-index-info-safe buffer-file-name))
;; FIXME: (add-to-list 'index-tags (nth 1 index-entry))
(push entry (cdr tail))))))))))
-
+
(error nil))
)
@@ -875,7 +878,7 @@ of master file."
reftex-special-env-parsers))
specials rtn)
;; Call all functions
- (setq specials (mapcar
+ (setq specials (mapcar
(lambda (fun)
(save-excursion
(setq rtn (and fun (funcall fun bound)))
@@ -885,7 +888,7 @@ of master file."
(setq specials (delq nil specials))
;; Sort
(setq specials (sort specials (lambda (a b) (> (cdr a) (cdr b)))))
- (if (eq which t)
+ (if (eq which t)
specials
(car specials))))))
@@ -923,9 +926,9 @@ of master file."
;; Do the real thing.
(let ((cnt 1))
-
+
(when (reftex-move-to-next-arg)
-
+
(while (< cnt n)
(while (and (member cnt opt-args)
(eq (following-char) ?\{))
@@ -950,7 +953,7 @@ of master file."
(condition-case nil
(while (memq (following-char) '(?\[ ?\{))
(forward-list 1))
- (error nil)))
+ (error nil)))
(defun reftex-context-substring (&optional to-end)
;; Return up to 150 chars from point
@@ -979,7 +982,7 @@ of master file."
(error (point-max))))))
(t
;; no list - just grab 150 characters
- (buffer-substring-no-properties (point)
+ (buffer-substring-no-properties (point)
(min (+ (point) 150) (point-max))))))
;; Variable holding the vector with section numbers
@@ -1016,7 +1019,7 @@ of master file."
;; not included in the numbering of other sectioning levels.
(when level
(when (and (> level -1) (not star))
- (aset reftex-section-numbers
+ (aset reftex-section-numbers
level (1+ (aref reftex-section-numbers level))))
(setq idx (1+ level))
(when (not star)
@@ -1042,7 +1045,7 @@ of master file."
(setq string (replace-match "" nil nil string)))
(if (and appendix
(string-match "\\`[0-9]+" string))
- (setq string
+ (setq string
(concat
(char-to-string
(1- (+ ?A (string-to-number (match-string 0 string)))))
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index b55146c2ff9..c1ce950522c 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -2800,11 +2800,12 @@ details check the Rst Faces Defaults group."
rst-level-face-base-color
(+ (* (1- i) rst-level-face-step-light)
rst-level-face-base-light))))
- (make-empty-face sym)
- (set-face-doc-string sym doc)
- (set-face-background sym col)
- (set sym sym)
- (setq i (1+ i))))))
+ (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)
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index 12a3e2a620b..047bba72ccd 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -687,7 +687,7 @@ is the menu entry name, and the cdr of P is the node name."
(insert (format "%s: %s." (car node-part) (cdr node-part)))))
;; Insert the description, if present.
- (when (cdr menu)
+ (when (> (length (cdr menu)) 0)
;; Move to right place.
(indent-to texinfo-column-for-description 2)
;; Insert description.
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index a56c3e4d501..ff63ca34035 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -55,7 +55,11 @@
;;;###autoload
(defun forward-thing (thing &optional n)
- "Move forward to the end of the Nth next THING."
+ "Move forward to the end of the Nth next THING.
+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'."
(let ((forward-op (or (get thing 'forward-op)
(intern-soft (format "forward-%s" thing)))))
(if (functionp forward-op)
@@ -67,15 +71,16 @@
;;;###autoload
(defun bounds-of-thing-at-point (thing)
"Determine the start and end buffer locations for the THING at point.
-THING is a symbol which specifies the kind of syntactic entity you want.
-Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
-`email', `word', `sentence', `whitespace', `line', `page' and others.
+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'.
-See the file `thingatpt.el' for documentation on how to define
-a symbol as a valid THING.
+See the file `thingatpt.el' for documentation on how to define a
+valid THING.
-The value is a cons cell (START . END) giving the start and end positions
-of the textual entity that was found."
+Return a cons cell (START . END) giving the start and end
+positions of the thing found."
(if (get thing 'bounds-of-thing-at-point)
(funcall (get thing 'bounds-of-thing-at-point))
(let ((orig (point)))
@@ -89,18 +94,19 @@ of the textual entity that was found."
(or (get thing 'beginning-op)
(lambda () (forward-thing thing -1))))
(let ((beg (point)))
- (if (not (and beg (> beg orig)))
+ (if (<= beg orig)
;; If that brings us all the way back to ORIG,
;; it worked. But END may not be the real end.
;; So find the real end that corresponds to BEG.
+ ;; FIXME: in which cases can `real-end' differ from `end'?
(let ((real-end
(progn
(funcall
(or (get thing 'end-op)
(lambda () (forward-thing thing 1))))
(point))))
- (if (and beg real-end (<= beg orig) (<= orig real-end))
- (cons beg real-end)))
+ (when (and (<= orig real-end) (< beg real-end))
+ (cons beg real-end)))
(goto-char orig)
;; Try a second time, moving backward first and then forward,
;; so that we can find a thing that ends at ORIG.
@@ -117,16 +123,17 @@ of the textual entity that was found."
(or (get thing 'beginning-op)
(lambda () (forward-thing thing -1))))
(point))))
- (if (and real-beg end (<= real-beg orig) (<= orig end))
+ (if (and (<= real-beg orig) (<= orig end) (< real-beg end))
(cons real-beg end))))))
(error nil)))))
;;;###autoload
(defun thing-at-point (thing)
"Return the THING at point.
-THING is a symbol which specifies the kind of syntactic entity you want.
-Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
-`email', `word', `sentence', `whitespace', `line', `page' and others.
+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'.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
@@ -139,11 +146,15 @@ a symbol as a valid THING."
;; Go to beginning/end
(defun beginning-of-thing (thing)
+ "Move point to the beginning of THING.
+The bounds of THING are determined by `bounds-of-thing-at-point'."
(let ((bounds (bounds-of-thing-at-point thing)))
(or bounds (error "No %s here" thing))
(goto-char (car bounds))))
(defun end-of-thing (thing)
+ "Move point to the end of THING.
+The bounds of THING are determined by `bounds-of-thing-at-point'."
(let ((bounds (bounds-of-thing-at-point thing)))
(or bounds (error "No %s here" thing))
(goto-char (cdr bounds))))
@@ -161,12 +172,16 @@ a symbol as a valid THING."
;; Sexps
(defun in-string-p ()
+ "Return non-nil if point is in a string.
+\[This is an internal function.]"
(let ((orig (point)))
(save-excursion
(beginning-of-defun)
(nth 3 (parse-partial-sexp (point) orig)))))
(defun end-of-sexp ()
+ "Move point to the end of the current sexp.
+\[This is an internal function.]"
(let ((char-syntax (char-syntax (char-after))))
(if (or (eq char-syntax ?\))
(and (eq char-syntax ?\") (in-string-p)))
@@ -176,6 +191,8 @@ a symbol as a valid THING."
(put 'sexp 'end-op 'end-of-sexp)
(defun beginning-of-sexp ()
+ "Move point to the beginning of the current sexp.
+\[This is an internal function.]"
(let ((char-syntax (char-syntax (char-before))))
(if (or (eq char-syntax ?\()
(and (eq char-syntax ?\") (in-string-p)))
@@ -189,6 +206,8 @@ a symbol as a valid THING."
(put 'list 'bounds-of-thing-at-point 'thing-at-point-bounds-of-list-at-point)
(defun thing-at-point-bounds-of-list-at-point ()
+ "Return the bounds of the list at point.
+\[Internal function used by `bounds-of-thing-at-point'.]"
(save-excursion
(let ((opoint (point))
(beg (condition-case nil
@@ -234,7 +253,7 @@ a symbol as a valid THING."
"A regular expression probably matching the host and filename or e-mail part of a URL.")
(defvar thing-at-point-short-url-regexp
- (concat "[-A-Za-z0-9.]+" thing-at-point-url-path-regexp)
+ (concat "[-A-Za-z0-9]+\\.[-A-Za-z0-9.]+" thing-at-point-url-path-regexp)
"A regular expression probably matching a URL without an access scheme.
Hostname matching is stricter in this case than for
``thing-at-point-url-regexp''.")
@@ -396,12 +415,17 @@ with angle brackets.")
;; Whitespace
(defun forward-whitespace (arg)
+ "Move point to the end of the next sequence of whitespace chars.
+Each such sequence may be a single newline, or a sequence of
+consecutive space and/or tab characters.
+With prefix argument ARG, do it ARG times if positive, or move
+backwards ARG times if negative."
(interactive "p")
(if (natnump arg)
(re-search-forward "[ \t]+\\|\n" nil 'move arg)
(while (< arg 0)
(if (re-search-backward "[ \t]+\\|\n" nil 'move)
- (or (eq (char-after (match-beginning 0)) 10)
+ (or (eq (char-after (match-beginning 0)) ?\n)
(skip-chars-backward " \t")))
(setq arg (1+ arg)))))
@@ -413,6 +437,11 @@ with angle brackets.")
;; Symbols
(defun forward-symbol (arg)
+ "Move point to the next position that is the end of a symbol.
+A symbol is any sequence of characters that are in either the
+word constituent or symbol constituent syntax class.
+With prefix argument ARG, do it ARG times if positive, or move
+backwards ARG times if negative."
(interactive "p")
(if (natnump arg)
(re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
@@ -424,6 +453,9 @@ with angle brackets.")
;; Syntax blocks
(defun forward-same-syntax (&optional arg)
+ "Move point past all characters with the same syntax class.
+With prefix argument ARG, do it ARG times if positive, or move
+backwards ARG times if negative."
(interactive "p")
(while (< arg 0)
(skip-syntax-backward
@@ -435,8 +467,13 @@ with angle brackets.")
;; Aliases
-(defun word-at-point () (thing-at-point 'word))
-(defun sentence-at-point () (thing-at-point 'sentence))
+(defun word-at-point ()
+ "Return the word at point. See `thing-at-point'."
+ (thing-at-point 'word))
+
+(defun sentence-at-point ()
+ "Return the sentence at point. See `thing-at-point'."
+ (thing-at-point 'sentence))
(defun read-from-whole-string (str)
"Read a Lisp expression from STR.
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index b251ca60246..7a505758408 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -226,7 +226,7 @@ reached."
(let ((fattribs-list (file-attributes f)))
`(,(nth 4 fattribs-list) ,(nth 7 fattribs-list) ,f)))
(directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
- '(lambda (l1 l2) (time-less-p (car l1) (car l2)))))
+ (lambda (l1 l2) (time-less-p (car l1) (car l2)))))
(dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list))))
(while (> dirsize thumbs-thumbsdir-max-size)
(progn
diff --git a/lisp/time.el b/lisp/time.el
index 7d752c85d4d..b158ef64691 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -423,30 +423,31 @@ update which can wait for the next redisplay."
(getenv "MAIL")
(concat rmail-spool-directory
(user-login-name))))
- (mail (or (and display-time-mail-function
- (funcall display-time-mail-function))
- (and display-time-mail-directory
- (display-time-mail-check-directory))
- (and (stringp mail-spool-file)
- (or (null display-time-server-down-time)
- ;; If have been down for 20 min, try again.
- (> (- (nth 1 now) display-time-server-down-time)
- 1200)
- (and (< (nth 1 now) display-time-server-down-time)
- (> (- (nth 1 now)
- display-time-server-down-time)
- -64336)))
- (let ((start-time (current-time)))
- (prog1
- (display-time-file-nonempty-p mail-spool-file)
- (if (> (- (nth 1 (current-time))
- (nth 1 start-time))
- 20)
- ;; Record that mail file is not accessible.
- (setq display-time-server-down-time
- (nth 1 (current-time)))
- ;; Record that mail file is accessible.
- (setq display-time-server-down-time nil)))))))
+ (mail (cond
+ (display-time-mail-function
+ (funcall display-time-mail-function))
+ (display-time-mail-directory
+ (display-time-mail-check-directory))
+ ((and (stringp mail-spool-file)
+ (or (null display-time-server-down-time)
+ ;; If have been down for 20 min, try again.
+ (> (- (nth 1 now) display-time-server-down-time)
+ 1200)
+ (and (< (nth 1 now) display-time-server-down-time)
+ (> (- (nth 1 now)
+ display-time-server-down-time)
+ -64336))))
+ (let ((start-time (current-time)))
+ (prog1
+ (display-time-file-nonempty-p mail-spool-file)
+ (if (> (- (nth 1 (current-time))
+ (nth 1 start-time))
+ 20)
+ ;; Record that mail file is not accessible.
+ (setq display-time-server-down-time
+ (nth 1 (current-time)))
+ ;; Record that mail file is accessible.
+ (setq display-time-server-down-time nil)))))))
(24-hours (substring time 11 13))
(hour (string-to-number 24-hours))
(12-hours (int-to-string (1+ (% (+ hour 11) 12))))
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 8fdce17df86..05208abb720 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -44,7 +44,8 @@
;; when you are on a tty. I hope that won't cause too much trouble -- rms.
(define-minor-mode tool-bar-mode
"Toggle use of the tool bar.
-With numeric ARG, display the tool bar if and only if ARG is positive.
+With a numeric argument, if the argument is positive, turn on the
+tool bar; otherwise, turn off the tool bar.
See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
conveniently adding tool bar items."
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 62a44724d40..d276e64f6db 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -5,7 +5,6 @@
;; Author: Noah Friedman
;; Maintainer: Noah Friedman <friedman@splode.com>
;; Keywords: extensions, timers
-;; Status: Works in GNU Emacs 19.25 or later, some versions of XEmacs
;; Created: 1994-07-13
;; This file is part of GNU Emacs.
@@ -48,7 +47,7 @@
;; or set the variable of the same name to `t'.
;; This program can truly cons up a storm because of all the calls to
-;; `current-time' (which always returns 3 fresh conses). I'm dismayed by
+;; `current-time' (which always returns fresh conses). I'm dismayed by
;; this, but I think the health of my hands is far more important than a
;; few pages of virtual memory.
@@ -502,12 +501,9 @@ variable of the same name."
(defun timep (time)
"If TIME is in the format returned by `current-time' then
return TIME, else return nil."
- (and (listp time)
- (eq (length time) 3)
- (integerp (car time))
- (integerp (nth 1 time))
- (integerp (nth 2 time))
- time))
+ (condition-case nil
+ (and (float-time time) time)
+ (error nil)))
(defun type-break-choose-file ()
"Return file to read from."
@@ -994,12 +990,8 @@ FRAC should be the inverse of the fractional value; for example, a value of
;; Compute the difference, in seconds, between a and b, two structures
;; similar to those returned by `current-time'.
-;; Use addition rather than logand since that is more robust; the low 16
-;; bits of the seconds might have been incremented, making it more than 16
-;; bits wide.
(defun type-break-time-difference (a b)
- (+ (lsh (- (car b) (car a)) 16)
- (- (car (cdr b)) (car (cdr a)))))
+ (round (float-time (time-subtract b a))))
;; Return (in a new list the same in structure to that returned by
;; `current-time') the sum of the arguments. Each argument may be a time
@@ -1009,34 +1001,11 @@ FRAC should be the inverse of the fractional value; for example, a value of
;; the result is passed to `current-time-string' it will toss some of the
;; "low" bits and format the time incorrectly.
(defun type-break-time-sum (&rest tmlist)
- (let ((high 0)
- (low 0)
- (micro 0)
- tem)
- (while tmlist
- (setq tem (car tmlist))
- (setq tmlist (cdr tmlist))
- (cond
- ((numberp tem)
- (setq low (+ low tem)))
- (t
- (setq high (+ high (or (car tem) 0)))
- (setq low (+ low (or (car (cdr tem)) 0)))
- (setq micro (+ micro (or (car (cdr (cdr tem))) 0))))))
-
- (and (>= micro 1000000)
- (progn
- (setq tem (/ micro 1000000))
- (setq low (+ low tem))
- (setq micro (- micro (* tem 1000000)))))
-
- (setq tem (lsh low -16))
- (and (> tem 0)
- (progn
- (setq low (logand low 65535))
- (setq high (+ high tem))))
-
- (list high low micro)))
+ (let ((sum '(0 0 0)))
+ (dolist (tem tmlist sum)
+ (setq sum (time-add sum (if (integerp tem)
+ (list (floor tem 65536) (mod tem 65536))
+ tem))))))
(defun type-break-time-stamp (&optional when)
(if (fboundp 'format-time-string)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 1049d09d6db..6a3638c4232 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,47 @@
+2011-07-13 Chris Newton <redshodan@gmail.com> (tiny change)
+
+ * url-http.el (url-http): Copy over `url-show-status' to the async
+ buffer so that `url-display-percentage' does the right thing
+ (bug#4680).
+
+2011-07-06 Nick Dokos <nicholas.dokos@hp.com> (tiny change)
+
+ * url-cache.el (url-cache-extract): Set buffer multibyte flag to
+ nil (bug#8827).
+
+2011-07-03 Nicolas Avrutin <nicolasavru@gmail.com> (tiny change)
+
+ * url-http.el (url-http-create-request): Remove double carriage
+ return and newline (bug#8931).
+
+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).
+
+2011-06-04 Andreas Schwab <schwab@linux-m68k.org>
+
+ * url-future.el (url-future-test): Fix scope of `saver'.
+
+2011-06-01 Glenn Morris <rgm@gnu.org>
+
+ * url-queue.el (url-queue-parallel-processes, url-queue-timeout):
+ Add :version tag for options that will be new in 24.1.
+
+2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-queue.el (url-queue-parallel-processes): Increase the
+ default to 6, since 2 seems too conservative for normal usage.
+
+2011-05-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * url-future.el: Add general futures facility.
+
+2011-05-29 Leo Liu <sdl.web@gmail.com>
+
+ * url-cookie.el (url-cookie): Add option :named so that
+ url-cookie-p is defined. (Bug#8747)
+
2011-05-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-queue.el: New file.
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 1615920e64c..80d77020456 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -192,6 +192,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
(defun url-cache-extract (fnam)
"Extract FNAM from the local disk cache."
(erase-buffer)
+ (set-buffer-multibyte nil)
(insert-file-contents-literally fnam))
(defun url-cache-expired (url &optional expire-time)
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 7fdd8b174c1..78afa1633b6 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -35,17 +35,13 @@
:group 'url)
;; A cookie is stored internally as a vector of 7 slots
-;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
+;; [ url-cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
(defstruct (url-cookie
(:constructor url-cookie-create)
(:copier nil)
- ;; For compatibility with a previous version which did not use
- ;; defstruct, and also in order to make sure that the printed
- ;; representation does not depend on CL internals, we use an
- ;; explicitly managed tag.
- (:type vector))
- (tag 'cookie :read-only t)
+ (:type vector)
+ :named)
name value expires localpart domain secure)
(defvar url-cookie-storage nil "Where cookies are stored.")
@@ -77,8 +73,6 @@ telling Microsoft that."
;; It's completely normal for the cookies file not to exist yet.
(load (or fname url-cookie-file) t t))
-(declare-function url-cookie-p "url-cookie" t t) ; defstruct
-
(defun url-cookie-clean-up (&optional secure)
(let ((var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
new new-cookies)
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
new file mode 100644
index 00000000000..ac85a3cec47
--- /dev/null
+++ b/lisp/url/url-future.el
@@ -0,0 +1,126 @@
+;;; url-future.el --- general futures facility for url.el
+
+;; Copyright (C) 2011 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/>.
+
+;;; Commentary:
+
+;; Make a url-future (basically a defstruct):
+;; (make-url-future :value (lambda () (calculation goes here))
+;; :callback (lambda (future) (use future on success))
+;; :errorback (lambda (future &rest error) (error handler)))
+
+;; Then either call it with `url-future-call' or cancel it with
+;; `url-future-cancel'. Generally the functions will return the
+;; future itself, not the value it holds. Also the functions will
+;; throw a url-future-already-done error if you try to call or cancel
+;; a future more than once.
+
+;; So, to get the value:
+;; (when (url-future-completed-p future) (url-future-value future))
+
+;; See the ERT tests and the code for futher details.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ert))
+
+(defstruct url-future callback errorback status value)
+
+(defmacro url-future-done-p (url-future)
+ `(url-future-status ,url-future))
+
+(defmacro url-future-completed-p (url-future)
+ `(eq (url-future-status ,url-future) t))
+
+(defmacro url-future-errored-p (url-future)
+ `(eq (url-future-status ,url-future) 'error))
+
+(defmacro url-future-cancelled-p (url-future)
+ `(eq (url-future-status ,url-future) 'cancel))
+
+(defun url-future-finish (url-future &optional status)
+ (if (url-future-done-p url-future)
+ (signal 'error 'url-future-already-done)
+ (setf (url-future-status url-future) (or status t))
+ ;; the status must be such that the future was completed
+ ;; to run the callback
+ (when (url-future-completed-p url-future)
+ (funcall (or (url-future-callback url-future) 'ignore)
+ url-future))
+ url-future))
+
+(defun url-future-errored (url-future errorcons)
+ (if (url-future-done-p url-future)
+ (signal 'error 'url-future-already-done)
+ (setf (url-future-status url-future) 'error)
+ (setf (url-future-value url-future) errorcons)
+ (funcall (or (url-future-errorback url-future) 'ignore)
+ url-future errorcons)))
+
+(defun url-future-call (url-future)
+ (if (url-future-done-p url-future)
+ (signal 'error 'url-future-already-done)
+ (let ((ff (url-future-value url-future)))
+ (when (functionp ff)
+ (condition-case catcher
+ (setf (url-future-value url-future)
+ (funcall ff))
+ (error (url-future-errored url-future catcher)))
+ (url-future-value url-future)))
+ (if (url-future-errored-p url-future)
+ url-future
+ (url-future-finish url-future))))
+
+(defun url-future-cancel (url-future)
+ (if (url-future-done-p url-future)
+ (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-http.el b/lisp/url/url-http.el
index 28071e7165a..def35449397 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -338,7 +338,7 @@ request.")
;; End request
"\r\n"
;; Any data
- url-http-data "\r\n"))
+ url-http-data))
""))
(url-http-debug "Request is: \n%s" request)
request))
@@ -1059,19 +1059,16 @@ the end of the document."
;; Haven't seen the end of the headers yet, need to wait
;; for more data to arrive.
nil
- (if old-http
- (message "HTTP/0.9 How I hate thee!")
- (progn
- (url-http-parse-response)
- (mail-narrow-to-head)
- ;;(narrow-to-region (point-min) url-http-end-of-headers)
- (setq url-http-transfer-encoding (mail-fetch-field
- "transfer-encoding")
- url-http-content-type (mail-fetch-field "content-type"))
- (if (mail-fetch-field "content-length")
- (setq url-http-content-length
- (string-to-number (mail-fetch-field "content-length"))))
- (widen)))
+ (unless old-http
+ (url-http-parse-response)
+ (mail-narrow-to-head)
+ (setq url-http-transfer-encoding (mail-fetch-field
+ "transfer-encoding")
+ url-http-content-type (mail-fetch-field "content-type"))
+ (if (mail-fetch-field "content-length")
+ (setq url-http-content-length
+ (string-to-number (mail-fetch-field "content-length"))))
+ (widen))
(when url-http-transfer-encoding
(setq url-http-transfer-encoding
(downcase url-http-transfer-encoding)))
@@ -1175,6 +1172,7 @@ CBARGS as the arguments."
url-http-after-change-function
url-callback-function
url-callback-arguments
+ url-show-status
url-http-method
url-http-extra-headers
url-http-data
@@ -1209,6 +1207,7 @@ CBARGS as the arguments."
url-http-chunked-start
url-callback-function
url-callback-arguments
+ url-show-status
url-http-process
url-http-method
url-http-extra-headers
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 08496ad5afb..c5150a93561 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -31,13 +31,15 @@
(eval-when-compile (require 'cl))
(require 'browse-url)
-(defcustom url-queue-parallel-processes 2
+(defcustom url-queue-parallel-processes 6
"The number of concurrent processes."
+ :version "24.1"
:type 'integer
:group 'url)
(defcustom url-queue-timeout 5
"How long to let a job live once it's started (in seconds)."
+ :version "24.1"
:type 'integer
:group 'url)
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 73e83414e99..e5aead2309f 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -237,11 +237,11 @@ Note: The search is conducted only within 10%, at the beginning of the file."
(defvar change-log-font-lock-keywords
`(;;
;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles.
- ;; Fixme: this regepx is just an approximate one and may match
+ ;; Fixme: this regexp is just an approximate one and may match
;; wrongly with a non-date line existing as a random note. In
;; addition, using any kind of fixed setting like this doesn't
;; work if a user customizes add-log-time-format.
- ("^[0-9-]+ +\\|^ \\{11,\\}\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-z][a-z][a-z] [0-9:+ ]+"
+ ("^[0-9-]+ +\\|^ \\{11,\\}\\|^\t \\{3,\\}\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-z][a-z][a-z] [0-9:+ ]+"
(0 'change-log-date-face)
;; Name and e-mail; some people put e-mail in parens, not angles.
("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
@@ -578,7 +578,7 @@ It takes the same format as the TZ argument of `set-time-zone-rule'.
If nil, use local time.
If t, use universal time.")
(put 'add-log-time-zone-rule 'safe-local-variable
- '(lambda (x) (or (booleanp x) (stringp x))))
+ (lambda (x) (or (booleanp x) (stringp x))))
(defun add-log-iso8601-time-zone (&optional time)
(let* ((utc-offset (or (car (current-time-zone time)) 0))
@@ -865,8 +865,12 @@ non-nil, otherwise in local time."
(if (and (not add-log-always-start-new-record)
(let ((hit nil))
(dolist (entry new-entries hit)
- (when (looking-at (regexp-quote entry))
- (setq hit t)))))
+ (and (looking-at (regexp-quote entry))
+ ;; Reject multiple author entries. (Bug#8645)
+ (save-excursion
+ (forward-line 1)
+ (not (looking-at "[ \t]+.*<.*>$")))
+ (setq hit t)))))
(forward-line 1)
(insert (nth (random (length new-entries))
new-entries)
@@ -1047,8 +1051,8 @@ Runs `change-log-mode-hook'.
(set (make-local-variable 'fill-indent-according-to-mode) t)
;; Avoid that filling leaves behind a single "*" on a line.
(add-hook 'fill-nobreak-predicate
- '(lambda ()
- (looking-back "^\\s *\\*\\s *" (line-beginning-position)))
+ (lambda ()
+ (looking-back "^\\s *\\*\\s *" (line-beginning-position)))
nil t)
(set (make-local-variable 'indent-line-function) 'change-log-indent)
(set (make-local-variable 'tab-always-indent) nil)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 22dac00e7e4..392973e08fe 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -295,9 +295,14 @@ try to refine the current hunk, as well."
(defvar diff-added-face 'diff-added)
(defface diff-changed
- '((((type tty pc) (class color) (background light))
+ ;; We normally apply a `shadow'-based face on the `diff-context'
+ ;; face, and keep `diff-changed' the default.
+ '((((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)
- (((type tty pc) (class color) (background dark))
+ (((class color) (background dark))
:foreground "yellow" :weight bold :slant italic))
"`diff-mode' face used to highlight changed lines."
:group 'diff-mode)
@@ -1136,12 +1141,14 @@ else cover the whole buffer."
(old2 (match-string 4))
(new1 (number-to-string (+ space minus)))
(new2 (number-to-string (+ space plus))))
- (if old2
- (unless (string= new2 old2) (replace-match new2 t t nil 4))
- (goto-char (match-end 4)) (insert "," new2))
- (if old1
- (unless (string= new1 old1) (replace-match new1 t t nil 2))
- (goto-char (match-end 2)) (insert "," new1))))
+ (if old2
+ (unless (string= new2 old2) (replace-match new2 t t nil 4))
+ (goto-char (match-end 3))
+ (insert "," new2))
+ (if old1
+ (unless (string= new1 old1) (replace-match new1 t t nil 2))
+ (goto-char (match-end 1))
+ (insert "," new1))))
((looking-at diff-context-mid-hunk-header-re)
(when (> (+ space bang plus) 0)
(let* ((old1 (match-string 1))
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 9655ce64a99..fd24558da6a 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -76,10 +76,10 @@ delete the temporary files so named."
;;;###autoload
(defun diff (old new &optional switches no-async)
"Find and display the differences between OLD and NEW files.
-When called interactively, read OLD and NEW using the minibuffer;
-the default for NEW is the current buffer's file name, and the
-default for OLD is a backup file for NEW, if one exists.
-If NO-ASYNC is non-nil, call diff synchronously.
+When called interactively, read NEW, then OLD, using the
+minibuffer. The default for NEW is the current buffer's file
+name, and the default for OLD is a backup file for NEW, if one
+exists. If NO-ASYNC is non-nil, call diff synchronously.
When called interactively with a prefix argument, prompt
interactively for diff switches. Otherwise, the switches
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index 078947e8501..20c83429ced 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -50,7 +50,7 @@ Must produce output compatible with Unix's diff3 program."
;; The following functions must precede all defcustom-defined variables.
-(fset 'ediff-set-actual-diff-options '(lambda () nil))
+(fset 'ediff-set-actual-diff-options (lambda () nil))
(defcustom ediff-shell
(cond ((memq system-type '(ms-dos windows-nt))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 92f52157cb2..df6a7e938af 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1682,7 +1682,7 @@ the width of the A/B/C windows."
'ediff-get-lines-to-region-start)
((eq op 'scroll-up)
'ediff-get-lines-to-region-end)
- (t '(lambda (a b c) 0))))
+ (t (lambda (a b c) 0))))
(max-lines (max (funcall func 'A n ctl-buf)
(funcall func 'B n ctl-buf)
(if (ediff-buffer-live-p ediff-buffer-C)
@@ -4144,15 +4144,9 @@ Mail anyway? (y or n) ")
;; calculate time used by command
(defun ediff-calc-command-time ()
- (let ((end (current-time))
- micro sec)
- (setq micro
- (if (>= (nth 2 end) (nth 2 ediff-command-begin-time))
- (- (nth 2 end) (nth 2 ediff-command-begin-time))
- (+ (nth 2 end) (- 1000000 (nth 2 ediff-command-begin-time)))))
- (setq sec (- (nth 1 end) (nth 1 ediff-command-begin-time)))
- (or (equal ediff-command-begin-time '(0 0 0))
- (message "Elapsed time: %d second(s) + %d microsecond(s)" sec micro))))
+ (or (equal ediff-command-begin-time '(0 0 0))
+ (message "Elapsed time: %g second(s)"
+ (float-time (time-since ediff-command-begin-time)))))
(defsubst ediff-save-time ()
(setq ediff-command-begin-time (current-time)))
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 5e352493dc9..464fdc0a589 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -1348,7 +1348,7 @@ buffer."
;;;###autoload
(defun ediff-patch-file (&optional arg patch-buf)
- "Run Ediff by patching SOURCE-FILENAME.
+ "Query for a file name, and then run Ediff by patching that file.
If optional PATCH-BUF is given, use the patch in that buffer
and don't ask the user.
If prefix argument, then: if even argument, assume that the patch is in a
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 9f6ad19fdb1..d8c6384934e 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -419,10 +419,10 @@ It assumes that a log entry starts with a line matching
(if (or (null arg) (zerop arg))
(setq arg 1))
(if (< arg 0)
- (dotimes (n (- arg))
+ (dotimes (_n (- arg))
(log-view-end-of-defun))
(catch 'beginning-of-buffer
- (dotimes (n arg)
+ (dotimes (_n arg)
(or (log-view-current-entry nil t)
(throw 'beginning-of-buffer nil)))
(point))))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 75e3b514531..64c4b04fb65 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -443,7 +443,7 @@ BUF contains a plain diff between match-1 and match-3."
(setq othertext
(if (null otherlines) ""
(let ((pos (point)))
- (dotimes (i otherlines) (delete-char 2) (forward-line 1))
+ (dotimes (_i otherlines) (delete-char 2) (forward-line 1))
(buffer-substring pos (point)))))
(with-current-buffer textbuf
(forward-line (- startline line))
@@ -566,7 +566,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(with-current-buffer buf
(zerop (call-process-region
(point-min) (point-max) "patch" t nil nil
- "-r" "/dev/null" "--no-backup-if-mismatch"
+ "-r" null-device "--no-backup-if-mismatch"
"-fl" o))))
(save-restriction
(narrow-to-region m0b m0e)
@@ -582,7 +582,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(with-current-buffer buf
(zerop (call-process-region
(point-min) (point-max) "patch" t nil nil
- "-r" "/dev/null" "--no-backup-if-mismatch"
+ "-r" null-device "--no-backup-if-mismatch"
"-fl" m))))
(save-restriction
(narrow-to-region m0b m0e)
@@ -910,7 +910,7 @@ It has the following disadvantages:
;; whitespace changes, it'll report added/removed lines :-(
(not smerge-refine-weight-hack))
(setq re (concat "[ \t]*\\(?:" re "\\)")))
- (dotimes (i n)
+ (dotimes (_i n)
(unless (looking-at re) (error "Smerge refine internal error"))
(goto-char (match-end 0)))))
@@ -948,7 +948,7 @@ chars to try and eliminate some spurious differences."
(unless (eq (char-before) ?\n) (insert ?\n))
;; HACK ALERT!!
(if smerge-refine-weight-hack
- (dotimes (i (1- (length s))) (insert s "\n")))))
+ (dotimes (_i (1- (length s))) (insert s "\n")))))
(unless (bolp) (error "Smerge refine internal error"))
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) file nil 'nomessage)))))
@@ -991,6 +991,7 @@ 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."
(let* ((buf (current-buffer))
(pos (point))
+ deactivate-mark ; The code does not modify any visible buffer.
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2")))
;; Chop up regions into smaller elements and save into files.
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index abd3806d02f..b6ecc4c1d75 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -120,6 +120,7 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
(let ((m (make-sparse-keymap)))
(define-key m "a" 'vc-annotate-revision-previous-to-line)
(define-key m "d" 'vc-annotate-show-diff-revision-at-line)
+ (define-key m "=" 'vc-annotate-show-diff-revision-at-line)
(define-key m "D" 'vc-annotate-show-changeset-diff-revision-at-line)
(define-key m "f" 'vc-annotate-find-revision-at-line)
(define-key m "j" 'vc-annotate-revision-at-line)
diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el
index 59cefe047b6..eeac55ac0f8 100644
--- a/lisp/vc/vc-arch.el
+++ b/lisp/vc/vc-arch.el
@@ -39,7 +39,7 @@
;; Bugs:
-;; - *VC-log*'s initial content lacks the `Summary:' lines.
+;; - *vc-log*'s initial content lacks the `Summary:' lines.
;; - All files under the tree are considered as "under Arch's control"
;; without regards to =tagging-method and such.
;; - Files are always considered as `edited'.
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 21cb86a9840..4eff3244cdc 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -65,6 +65,14 @@
: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."
@@ -156,12 +164,10 @@ in the repository root directory of FILE."
(push (cons (match-string 1) (match-string 2)) settings)))
settings))
-(require 'sha1) ;For sha1-program
-
(defun vc-bzr-sha1 (file)
(with-temp-buffer
(set-buffer-multibyte nil)
- (let ((prog sha1-program)
+ (let ((prog vc-bzr-sha1-program)
(args nil)
process-file-side-effects)
(when (consp prog)
@@ -1166,8 +1172,9 @@ stream. Standard error output is discarded."
(eval-and-compile
(defconst vc-bzr-revision-keywords
- '("revno" "revid" "last" "before"
- "tag" "date" "ancestor" "branch" "submit")))
+ ;; bzr help revisionspec | sed -ne 's/^\([a-z]*\):$/"\1"/p' | sort -u
+ '("ancestor" "annotate" "before" "branch" "date" "last" "mainline" "revid"
+ "revno" "submit" "tag")))
(defun vc-bzr-revision-completion-table (files)
(lexical-let ((files files))
@@ -1205,6 +1212,19 @@ stream. Standard error output is discarded."
(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))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 01b6f2fc26e..5f3a9a21b59 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1238,6 +1238,7 @@ These are the commands available for use in the file status buffer:
(format "%-20s" state)
'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
((memq state '(missing conflict)) 'font-lock-warning-face)
+ ((eq state 'edited) 'font-lock-constant-face)
(t 'font-lock-variable-name-face))
'mouse-face 'highlight)
" "
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 3809b5b4293..6704a43e59b 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -620,7 +620,7 @@
;; buffer, if one is present, instead of adding to the ChangeLog.
;;
;; - When vc-next-action calls vc-checkin it could pre-fill the
-;; *VC-log* buffer with some obvious items: the list of files that
+;; *vc-log* buffer with some obvious items: the list of files that
;; were added, the list of files that were removed. If the diff is
;; available, maybe it could even call something like
;; `diff-add-change-log-entries-other-window' to create a detailed
@@ -775,6 +775,12 @@ See `run-hooks'."
:type 'hook
:group 'vc)
+(defcustom vc-revert-show-diff t
+ "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying."
+ :type 'boolean
+ :group 'vc
+ :version "24.1")
+
;; Header-insertion hair
(defcustom vc-static-header-alist
@@ -1408,7 +1414,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(vc-start-logentry
files comment initial-contents
"Enter a change comment."
- "*VC-log*"
+ "*vc-log*"
(lambda ()
(vc-call-backend backend 'log-edit-mode))
(lexical-let ((rev rev))
@@ -1534,10 +1540,13 @@ to override the value of `vc-diff-switches' and `diff-switches'."
(defvar vc-diff-added-files nil
"If non-nil, diff added files by comparing them to /dev/null.")
-(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose)
+(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer)
"Report diffs between two revisions of a fileset.
-Diff output goes to the *vc-diff* buffer. The function
-returns t if the buffer had changes, nil otherwise."
+Output goes to the buffer BUFFER, which defaults to *vc-diff*.
+BUFFER, if non-nil, should be a buffer or a buffer name.
+Return t if the buffer had changes, nil otherwise."
+ (unless buffer
+ (setq buffer "*vc-diff*"))
(let* ((files (cadr vc-fileset))
(messages (cons (format "Finding changes in %s..."
(vc-delistify files))
@@ -1549,7 +1558,7 @@ returns t if the buffer had changes, nil otherwise."
;; be to call the back end separately for each file.
(coding-system-for-read
(if files (vc-coding-system-for-diff (car files)) 'undecided)))
- (vc-setup-buffer "*vc-diff*")
+ (vc-setup-buffer buffer)
(message "%s" (car messages))
;; Many backends don't handle well the case of a file that has been
;; added but not yet committed to the repo (notably CVS and Subversion).
@@ -1574,13 +1583,13 @@ returns t if the buffer had changes, nil otherwise."
(error "No revisions of %s exist" file)
;; We regard this as "changed".
;; Diff it against /dev/null.
- (apply 'vc-do-command "*vc-diff*"
+ (apply 'vc-do-command buffer
1 "diff" file
(append (vc-switches nil 'diff) '("/dev/null"))))))
(setq files (nreverse filtered))))
(let ((vc-disable-async-diff (not async)))
- (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*"))
- (set-buffer "*vc-diff*")
+ (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
+ (set-buffer buffer)
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
;; Treat this case specially so as not to pop the buffer.
@@ -1596,10 +1605,13 @@ returns t if the buffer had changes, nil otherwise."
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
(setq buffer-read-only t)
- (vc-exec-after `(vc-diff-finish ,(current-buffer) ',(when verbose
- messages)))
;; 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'
+ ;; after `pop-to-buffer'; the former assumes the diff buffer is
+ ;; shown in some window.
+ (vc-exec-after `(vc-diff-finish ,(current-buffer)
+ ',(when verbose messages)))
;; In the async case, we return t even if there are no differences
;; because we don't know that yet.
t)))
@@ -1867,7 +1879,7 @@ The headers are reset to their non-expanded form."
(vc-start-logentry
files oldcomment t
"Enter a replacement change comment."
- "*VC-log*"
+ "*vc-log*"
(lambda () (vc-call-backend backend 'log-edit-mode))
(lexical-let ((rev rev))
(lambda (files comment)
@@ -2256,11 +2268,12 @@ This asks for confirmation if the buffer contents are not identical
to the working revision (except for keyword expansion)."
(interactive)
(let* ((vc-fileset (vc-deduce-fileset))
- (files (cadr vc-fileset)))
- ;; If any of the files is visited by the current buffer, make
- ;; sure buffer is saved. If the user says `no', abort since
- ;; we cannot show the changes and ask for confirmation to
- ;; discard them.
+ (files (cadr vc-fileset))
+ (queried nil)
+ diff-buffer)
+ ;; If any of the files is visited by the current buffer, make sure
+ ;; buffer is saved. If the user says `no', abort since we cannot
+ ;; show the changes and ask for confirmation to discard them.
(when (or (not files) (memq (buffer-file-name) files))
(vc-buffer-sync nil))
(dolist (file files)
@@ -2268,20 +2281,29 @@ to the working revision (except for keyword expansion)."
(when (and buf (buffer-modified-p buf))
(error "Please kill or save all modified buffers before reverting")))
(when (vc-up-to-date-p file)
- (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
+ (if (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
+ (setq queried t)
(error "Revert canceled"))))
- (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil)
- (unless (yes-or-no-p
- (format "Discard changes in %s? "
- (let ((str (vc-delistify files))
- (nfiles (length files)))
- (if (< (length str) 50)
- str
- (format "%d file%s" nfiles
- (if (= nfiles 1) "" "s"))))))
- (error "Revert canceled"))
- (delete-windows-on "*vc-diff*")
- (kill-buffer "*vc-diff*"))
+ (unwind-protect
+ (when (if vc-revert-show-diff
+ (progn
+ (setq diff-buffer (generate-new-buffer-name "*vc-diff*"))
+ (vc-diff-internal vc-allow-async-revert vc-fileset
+ nil nil nil diff-buffer))
+ ;; Avoid querying the user again.
+ (null queried))
+ (unless (yes-or-no-p
+ (format "Discard changes in %s? "
+ (let ((str (vc-delistify files))
+ (nfiles (length files)))
+ (if (< (length str) 50)
+ str
+ (format "%d file%s" nfiles
+ (if (= nfiles 1) "" "s"))))))
+ (error "Revert canceled")))
+ (when diff-buffer
+ (delete-windows-on diff-buffer)
+ (kill-buffer diff-buffer)))
(dolist (file files)
(message "Reverting %s..." (vc-delistify files))
(vc-revert-file file)
@@ -2406,7 +2428,7 @@ its name; otherwise return nil."
(list file)
(let ((backup-file (vc-version-backup-file file)))
(when backup-file
- (copy-file backup-file file 'ok-if-already-exists 'keep-date)
+ (copy-file backup-file file 'ok-if-already-exists)
(vc-delete-automatic-version-backups file))
(vc-call revert file backup-file))
`((vc-state . up-to-date)
diff --git a/lisp/view.el b/lisp/view.el
index e91c4dd175c..ee85b4e7823 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -55,10 +55,6 @@
:type 'face
:group 'view)
-;; `view-mode-auto-exit' is replaced by the following option variable which
-;; only says if scrolling past buffer end should leave view mode or not, it
-;; doesn't say if leaving view mode should restore windows or not. The latter
-;; is now controlled by the presence of a value in `view-return-to-alist'.
(defcustom view-scroll-auto-exit nil
"Non-nil means scrolling past the end of buffer exits View mode.
A value of nil means attempting to scroll past the end of the buffer,
@@ -80,17 +76,14 @@ for all scroll commands in view mode."
If nil, make an icon of the frame. If non-nil, delete the frame."
:type 'boolean
:group 'view
- ;; Changed the default of this to t for Emacs 23. Users consider
- ;; frame iconification annoying.
:version "23.1")
(defcustom view-exits-all-viewing-windows nil
"Non-nil means restore all windows used to view buffer.
-Commands that restore windows when finished viewing a buffer, apply to all
-windows that display the buffer and have restore information in
-`view-return-to-alist'.
-If `view-exits-all-viewing-windows' is nil, only the selected window is
-considered for restoring."
+Commands that restore windows when finished viewing a buffer,
+apply to all windows that display the buffer and have restore
+information. If `view-exits-all-viewing-windows' is nil, only
+the selected window is considered for restoring."
:type 'boolean
:group 'view)
@@ -140,6 +133,8 @@ subtracted from by `view-mode-exit' when finished viewing the buffer.
See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of
`view-return-to-alist'.")
+(make-obsolete-variable
+ 'view-return-to-alist "this variable is no more used." "24.1")
(make-variable-buffer-local 'view-return-to-alist)
(put 'view-return-to-alist 'permanent-local t)
@@ -322,63 +317,48 @@ EXIT-ACTION to `kill-buffer-if-not-modified' avoids this."
(progn
(switch-to-buffer buffer)
(message "Not using View mode because the major mode is special"))
- (let ((undo-window (list (window-buffer) (window-start) (window-point))))
- (switch-to-buffer buffer)
- (view-mode-enter (cons (selected-window) (cons nil undo-window))
- exit-action))))
+ (pop-to-buffer-same-window buffer)
+ (view-mode-enter nil exit-action)))
;;;###autoload
(defun view-buffer-other-window (buffer &optional not-return exit-action)
"View BUFFER in View mode in another window.
-Return to previous buffer when done, unless optional NOT-RETURN is
-non-nil. Emacs commands editing the buffer contents are not available;
-instead, a special set of commands (mostly letters and punctuation) are
-defined for moving around in the buffer.
+Emacs commands editing the buffer contents are not available;
+instead, a special set of commands (mostly letters and
+punctuation) are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
+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'."
(interactive "bIn other window view buffer:\nP")
- (let* ((win ; This window will be selected by
- (get-lru-window)) ; switch-to-buffer-other-window below.
- (return-to
- (and (not not-return)
- (cons (selected-window)
- (if (eq win (selected-window))
- t ; Has to make new window.
- (list
- (window-buffer win) ; Other windows old buffer.
- (window-start win)
- (window-point win)))))))
- (switch-to-buffer-other-window buffer)
- (view-mode-enter (and return-to (cons (selected-window) return-to))
- exit-action)))
+ (pop-to-buffer-other-window buffer)
+ (view-mode-enter nil exit-action))
;;;###autoload
(defun view-buffer-other-frame (buffer &optional not-return exit-action)
"View BUFFER in View mode in another frame.
-Return to previous buffer when done, unless optional NOT-RETURN is
-non-nil. Emacs commands editing the buffer contents are not available;
-instead, a special set of commands (mostly letters and punctuation) are
-defined for moving around in the buffer.
+Emacs commands editing the buffer contents are not available;
+instead, a special set of commands (mostly letters and
+punctuation) are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
+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'."
(interactive "bView buffer in other frame: \nP")
- (let ((return-to
- (and (not not-return) (cons (selected-window) t)))) ; Old window.
- (switch-to-buffer-other-frame buffer)
- (view-mode-enter (and return-to (cons (selected-window) return-to))
- exit-action)))
+ (pop-to-buffer-other-frame buffer)
+ (view-mode-enter nil exit-action))
;;;###autoload
(define-minor-mode view-mode
@@ -536,38 +516,27 @@ 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 return-to exit-action)
+(defun view-mode-enter (&optional quit-restore exit-action)
"Enter View mode and set up exit from view mode depending on optional arguments.
-RETURN-TO non-nil means add RETURN-TO as an element to the buffer
-local alist `view-return-to-alist'. Save EXIT-ACTION in buffer
-local variable `view-exit-action'. It should be either nil or a
+Optional argument QUIT-RESTORE if non-nil must specify a valid
+entry for quitting and restoring any window showing the current
+buffer. This entry replaces any parameter installed by
+`display-buffer' and is used by `view-mode-exit'.
+
+Optional argument EXIT-ACTION, if non-nil, must specify a
function that takes a buffer as argument. This function will be
called by `view-mode-exit'.
-RETURN-TO is either nil, meaning do nothing when exiting view
-mode, or must have the format (WINDOW OLD-WINDOW . OLD-BUF-INFO).
-WINDOW is the window used for viewing. OLD-WINDOW is nil or the
-window to select after viewing. OLD-BUF-INFO tells what to do
-with WINDOW when exiting. It is one of:
-1) nil Do nothing.
-2) t Delete WINDOW or, if it is the only window and
- `view-remove-frame-by-deleting' is non-nil, its
- frame.
-3) (OLD-BUFF START POINT) Display buffer OLD-BUFF with displayed text
- starting at START and point at POINT in WINDOW.
-4) quit-window Do `quit-window' in WINDOW.
-5) keep-frame Like case 2) but do not delete the frame.
-
For a list of all View commands, type H or h while viewing.
This function runs the normal hook `view-mode-hook'."
- (when return-to
- (let ((entry (assq (car return-to) view-return-to-alist)))
- (if entry
- (setcdr entry (cdr return-to))
- (setq view-return-to-alist (cons return-to view-return-to-alist)))))
+ (when quit-restore
+ (dolist (window (get-buffer-window-list nil nil t))
+ (set-window-parameter window 'quit-restore quit-restore)))
+
(when exit-action
(setq view-exit-action exit-action))
@@ -579,115 +548,45 @@ This function runs the normal hook `view-mode-hook'."
(substitute-command-keys "\
View mode: type \\[help-command] for help, \\[describe-mode] for commands, \\[View-quit] to quit.")))))
-(defun view-mode-exit (&optional return-to-alist exit-action all-win)
- "Exit View mode in various ways, depending on optional arguments.
-RETURN-TO-ALIST, EXIT-ACTION and ALL-WIN determine what to do
-after exit. EXIT-ACTION is nil or a function that is called with
-current buffer as argument.
-
-RETURN-TO-ALIST is an alist that, for some of the windows
-displaying the current buffer, maintains information on what to
-do when exiting those windows. If ALL-WIN is non-nil or the
-variable `view-exits-all-viewing-windows' is non-nil,
-view-mode-exit attempts to restore all windows showing the
-current buffer to their old state. Otherwise, only the selected
-window is affected (provided it is on RETURN-TO-ALIST).
-
-Elements of RETURN-TO-ALIST must have the format
- (WINDOW OLD-WINDOW . OLD-BUF-INFO) where
-
-WINDOW is a window displaying the current buffer and OLD-WINDOW
-is either nil or a window to select after viewing. OLD-BUF-INFO
-provides information on what to do with WINDOW and may be one of:
-1) nil Do nothing.
-2) t Delete WINDOW and, if it is the only window and
- `view-remove-frame-by-deleting' is non-nil, its
- frame.
-3) (OLD-BUF START POINT) Display buffer OLD-BUF with displayed text
- starting at START and point at POINT in WINDOW.
-4) quit-window Do `quit-window' in WINDOW.
-5) keep-frame Like case 2) but do not delete the frame.
-
-If one of the WINDOW in RETURN-TO-ALIST is the selected window
-and the corresponding OLD-WINDOW is a live window, then select
-OLD-WINDOW."
- (when view-mode ; Only do something if in view mode.
- (setq all-win
- (and return-to-alist
- (or all-win view-exits-all-viewing-windows)))
- (let* ((buffer (current-buffer))
- window notlost
- (sel-old (assq (selected-window) return-to-alist))
- (alist (cond
- (all-win ; Try to restore all windows.
- (append return-to-alist nil)) ; Copy.
- (sel-old ; Only selected window.
- (list sel-old))))
- (old-window (if sel-old (car (cdr sel-old)))))
- (if all-win ; Follow chains of old-windows.
- (let ((c (length alist)) a)
- (while (and (> c 0) ; Safety if mutually refering windows.
- (or (not (window-live-p old-window))
- (eq buffer (window-buffer old-window)))
- (setq a (assq old-window alist)))
- (setq c (1- c))
- (setq old-window (car (cdr a))))
- (if (or (zerop c) (not (window-live-p old-window)))
- (setq old-window (selected-window)))))
+;; This is awful because it assumes that the selected window shows the
+;; current buffer when this is called.
+(defun view-mode-exit (&optional exit-only exit-action all-windows)
+ "Exit View mode in various ways.
+If all arguments are nil, remove the current buffer from the
+selected window using the `quit-restore' information associated
+with the selected window. If optional argument ALL-WINDOWS or
+`view-exits-all-viewing-windows' are non-nil, remove the current
+buffer from all windows showing it.
+
+Optional argument EXIT-ONLY non-nil means just exit `view-mode'
+\(unless `view-no-disable-on-exit' is non-nil) but do not change
+the associations of any windows with the current buffer.
+
+EXIT-ACTION, if non-nil, must specify a function that is called
+with the current buffer as argument and is called after disabling
+`view-mode' and removing any associations of windows with the
+current buffer. "
+ (when view-mode
+ (let ((buffer (window-buffer)))
(unless view-no-disable-on-exit
(view-mode-disable))
- (while alist ; Restore windows with info.
- (setq notlost nil)
- (when (and (window-live-p (setq window (car (car alist))))
- (eq buffer (window-buffer window)))
- (let ((frame (window-frame window))
- (old-buf-info (cdr (cdr (car alist)))))
- (if all-win (select-window window))
- (cond
- ((consp old-buf-info) ; Case 3.
- (if (buffer-live-p (car old-buf-info))
- (progn
- (set-window-buffer window (car old-buf-info)) ; old-buf
- (set-window-start window (car (cdr old-buf-info)))
- (set-window-point window (car (cdr (cdr old-buf-info)))))
- (bury-buffer)))
- ((eq old-buf-info 'quit-window)
- (quit-window)) ; Case 4.
- (old-buf-info ; Case 2 or 5.
- (cond
- ((not (one-window-p t)) ; Not only window.
- (delete-window))
- ((eq old-buf-info 'keep-frame) ; Case 5.
- (bury-buffer))
- ((not (eq frame (next-frame))) ; Case 2 and only window.
- ;; Not the only frame, so can safely be removed.
- (if view-remove-frame-by-deleting
- (delete-frame frame)
- (setq notlost t) ; Keep the window. See below.
- (iconify-frame frame))))))))
- ;; If a frame is removed by iconifying it, the window is not
- ;; really lost. In this case we keep the entry in
- ;; `view-return-to-alist' so that if the user deiconifies the
- ;; frame and then hits q, the frame is iconified again.
- (unless notlost
- (with-current-buffer buffer
- (setq view-return-to-alist
- (delete (car alist) view-return-to-alist))))
- (setq alist (cdr alist)))
- (when (window-live-p old-window)
- ;; old-window is still alive => select it.
- (select-window old-window))
- (when exit-action
- ;; Don't do that: If the user wants to quit the *Help* buffer a
- ;; second time it won't have any effect.
- ;;(setq view-exit-action nil)
- (funcall exit-action buffer))
- (force-mode-line-update))))
+
+ (unless exit-only
+ (cond
+ ((or all-windows view-exits-all-viewing-windows)
+ (dolist (window (get-buffer-window-list))
+ (quit-restore-window window)))
+ ((eq (window-buffer) (current-buffer))
+ (quit-restore-window)))
+
+ (when exit-action
+ (funcall exit-action buffer))
+ (force-mode-line-update)))))
(defun View-exit ()
"Exit View mode but stay in current buffer."
(interactive)
- (view-mode-exit))
+ (view-mode-exit t))
;;;###autoload
(defun View-exit-and-edit ()
@@ -695,31 +594,31 @@ OLD-WINDOW."
(interactive)
(let ((view-old-buffer-read-only nil)
(view-no-disable-on-exit nil))
- (view-mode-exit)))
+ (view-mode-exit t)))
(defun View-leave ()
"Quit View mode and maybe switch buffers, but don't kill this buffer."
(interactive)
- (view-mode-exit view-return-to-alist))
+ (view-mode-exit))
(defun View-quit ()
"Quit View mode, trying to restore window and buffer to previous state.
Maybe kill this buffer. Try to restore selected window to previous state
and go to previous buffer or window."
(interactive)
- (view-mode-exit view-return-to-alist view-exit-action))
+ (view-mode-exit nil view-exit-action))
(defun View-quit-all ()
"Quit View mode, trying to restore windows and buffers to previous state.
Maybe kill current buffer. Try to restore all windows viewing buffer to
previous state and go to previous buffer or window."
(interactive)
- (view-mode-exit view-return-to-alist view-exit-action t))
+ (view-mode-exit nil view-exit-action t))
(defun View-kill-and-leave ()
"Quit View mode, kill current buffer and return to previous buffer."
(interactive)
- (view-mode-exit view-return-to-alist (or view-exit-action 'kill-buffer) t))
+ (view-mode-exit nil (or view-exit-action 'kill-buffer) t))
;;; Some help routines.
@@ -863,7 +762,7 @@ invocations return to earlier marks."
(defun view-end-message ()
;; Tell that we are at end of buffer.
(goto-char (point-max))
- (if view-return-to-alist
+ (if (window-parameter nil 'quit-restore)
(message "End of buffer. Type %s to quit viewing."
(substitute-command-keys
(if view-scroll-auto-exit "\\[View-scroll-page-forward]"
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index a002a63e3f8..cb21d4b08c0 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -335,6 +335,8 @@ This function is provided for backward compatibility, since
(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'.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 31cc8ad9ca9..b0d00242f2a 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,4 +1,4 @@
-;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
+;;; 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.
;;
@@ -1161,10 +1161,29 @@ the field."
"Complete content of editable field from point.
When not inside a field, signal an error."
(interactive)
+ (let ((data (widget-completions-at-point)))
+ (cond
+ ((functionp data) (funcall data))
+ ((consp data)
+ (let ((completion-extra-properties (nth 3 data)))
+ (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
+;; hasn't added widget-completions-at-point to completion-at-point-functions,
+;; so it's not really obsolete (yet).
+;; (make-obsolete 'widget-complete 'completion-at-point "24.1")
+
+(defun widget-completions-at-point ()
(let ((field (widget-field-find (point))))
- (if field
- (widget-apply field :complete)
- (error "Not in an editable field"))))
+ (when field
+ (widget-apply field :completions-function))))
;;; Setting up the buffer.
@@ -1435,7 +1454,7 @@ The value of the :type attribute should be an unconverted widget type."
:value-to-external (lambda (_widget value) value)
:button-prefix 'widget-button-prefix
:button-suffix 'widget-button-suffix
- :complete 'widget-default-complete
+ :completions-function #'widget-default-completions
:create 'widget-default-create
:indent nil
:offset 0
@@ -1461,13 +1480,20 @@ The value of the :type attribute should be an unconverted widget type."
(defvar widget--completing-widget)
-(defun widget-default-complete (widget)
- "Call the value of the :complete-function property of WIDGET.
-If that does not exist, call the value of `widget-complete-field'.
-During this call, `widget--completing-widget' is bound to WIDGET."
- (let ((widget--completing-widget widget))
- (call-interactively (or (widget-get widget :complete-function)
- widget-complete-field))))
+(defun widget-default-completions (widget)
+ "Return completion data, like `completion-at-point-functions' would."
+ (let ((completions (widget-get widget :completions)))
+ (if completions
+ (list (widget-field-start widget)
+ (max (point) (widget-field-text-end widget))
+ completions)
+ (if (widget-get widget :complete)
+ (lambda () (widget-apply widget :complete))
+ (if (widget-get widget :complete-function)
+ (lambda ()
+ (let ((widget--completing-widget widget))
+ (call-interactively
+ (widget-get widget :complete-function)))))))))
(defun widget-default-create (widget)
"Create WIDGET at point in the current buffer."
@@ -2283,9 +2309,9 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
(while vals
(let ((answer (widget-checklist-match-up args vals)))
(cond (answer
- (let ((vals (widget-match-inline answer vals)))
- (setq found (append found (car vals))
- vals (cdr vals)
+ (let ((vals2 (widget-match-inline answer vals)))
+ (setq found (append found (car vals2))
+ vals (cdr vals2)
args (delq answer args))))
(greedy
(setq rest (append rest (list (car vals)))
@@ -3018,20 +3044,6 @@ as the value."
:complete-function 'ispell-complete-word
:prompt-history 'widget-string-prompt-value-history)
-(defun widget-string-complete ()
- "Complete contents of string field.
-Completions are taken from the :completion-alist property of the
-widget. If that isn't a list, it's evalled and expected to yield a list."
- (interactive)
- (let* ((widget widget--completing-widget)
- (completion-ignore-case (widget-get widget :completion-ignore-case))
- (alist (widget-get widget :completion-alist))
- (_ (unless (listp alist)
- (setq alist (eval alist)))))
- (completion-in-region (widget-field-start widget)
- (max (point) (widget-field-text-end widget))
- alist)))
-
(define-widget 'regexp 'string
"A regular expression."
:match 'widget-regexp-match
@@ -3059,21 +3071,13 @@ widget. If that isn't a list, it's evalled and expected to yield a list."
(define-widget 'file 'string
"A file widget.
It reads a file name from an editable text field."
- :complete-function 'widget-file-complete
+ :completions #'completion-file-name-table
:prompt-value 'widget-file-prompt-value
:format "%{%t%}: %v"
;; Doesn't work well with terminating newline.
;; :value-face 'widget-single-line-field
:tag "File")
-(defun widget-file-complete ()
- "Perform completion on file name preceding point."
- (interactive)
- (let ((widget widget--completing-widget))
- (completion-in-region (widget-field-start widget)
- (max (point) (widget-field-text-end widget))
- 'completion-file-name-table)))
-
(defun widget-file-prompt-value (widget prompt value unbound)
;; Read file from minibuffer.
(abbreviate-file-name
@@ -3113,7 +3117,7 @@ It reads a directory name from an editable text field."
:tag "Symbol"
:format "%{%t%}: %v"
:match (lambda (_widget value) (symbolp value))
- :complete-function 'lisp-complete-symbol
+ :completions obarray
:prompt-internal 'widget-symbol-prompt-internal
:prompt-match 'symbolp
:prompt-history 'widget-symbol-prompt-value-history
@@ -3141,9 +3145,8 @@ It reads a directory name from an editable text field."
(define-widget 'function 'restricted-sexp
"A Lisp function."
- :complete-function (lambda ()
- (interactive)
- (lisp-complete-symbol 'fboundp))
+ :completions (apply-partially #'completion-table-with-predicate
+ obarray #'fboundp 'strict)
:prompt-value 'widget-field-prompt-value
:prompt-internal 'widget-symbol-prompt-internal
:prompt-match 'fboundp
@@ -3165,9 +3168,8 @@ It reads a directory name from an editable text field."
"A Lisp variable."
:prompt-match 'boundp
:prompt-history 'widget-variable-prompt-value-history
- :complete-function (lambda ()
- (interactive)
- (lisp-complete-symbol 'boundp))
+ :completions (apply-partially #'completion-table-with-predicate
+ obarray #'boundp 'strict)
:tag "Variable")
(define-widget 'coding-system 'symbol
@@ -3178,9 +3180,8 @@ It reads a directory name from an editable text field."
:prompt-history 'coding-system-value-history
:prompt-value 'widget-coding-system-prompt-value
:action 'widget-coding-system-action
- :complete-function (lambda ()
- (interactive)
- (lisp-complete-symbol 'coding-system-p))
+ :completions (apply-partially #'completion-table-with-predicate
+ obarray #'coding-system-p 'strict)
:validate (lambda (widget)
(unless (coding-system-p (widget-value widget))
(widget-put widget :error (format "Invalid coding system: %S"
@@ -3317,7 +3318,7 @@ It reads a directory name from an editable text field."
(insert (widget-apply widget :value-get))
(goto-char (point-min))
(let (err)
- (condition-case data
+ (condition-case data ;Note: We get a spurious byte-compile warning here.
(progn
;; Avoid a confusing end-of-file error.
(skip-syntax-forward "\\s-")
@@ -3685,7 +3686,7 @@ example:
:size 10
:tag "Color"
:value "black"
- :complete 'widget-color-complete
+ :completions (or facemenu-color-alist (defined-colors))
:sample-face-get 'widget-color-sample-face-get
:notify 'widget-color-notify
:action 'widget-color-action)
@@ -3711,14 +3712,6 @@ example:
(delete-window win)))
(pop-to-buffer ,(current-buffer))))))
-(defun widget-color-complete (widget)
- "Complete the color in WIDGET."
- (require 'facemenu) ; for facemenu-color-alist
- (completion-in-region (widget-field-start widget)
- (max (point) (widget-field-text-end widget))
- (or facemenu-color-alist
- (sort (defined-colors) 'string-lessp))))
-
(defun widget-color-sample-face-get (widget)
(let* ((value (condition-case nil
(widget-value widget)
diff --git a/lisp/window.el b/lisp/window.el
index 9ea00442628..0302a672521 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -30,15 +30,6 @@
(eval-when-compile (require 'cl))
-(defvar window-size-fixed nil
- "*Non-nil in a buffer means windows displaying the buffer are fixed-size.
-If the value is `height', then only the window's height is fixed.
-If the value is `width', then only the window's width is fixed.
-Any other non-nil value fixes both the width and the height.
-Emacs won't change the size of any window displaying that buffer,
-unless you explicitly change the size, or Emacs has no other choice.")
-(make-variable-buffer-local 'window-size-fixed)
-
(defmacro save-selected-window (&rest body)
"Execute BODY, then select the previously selected window.
The value returned is the value of the last form in BODY.
@@ -72,55 +63,934 @@ are not altered by this macro (unless they are altered in BODY)."
(when (window-live-p save-selected-window-window)
(select-window save-selected-window-window 'norecord))))))
-(defun window-body-height (&optional window)
- "Return number of lines in WINDOW available for actual buffer text.
-WINDOW defaults to the selected window.
+;; The following two functions are like `window-next-sibling' and
+;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
+;; they don't substitute the selected window for nil), and they return
+;; nil when WINDOW doesn't have a parent (like a frame's root window or
+;; a minibuffer window).
+(defsubst window-right (window)
+ "Return WINDOW's right sibling.
+Return nil if WINDOW is the root window of its frame. WINDOW can
+be any window."
+ (and window (window-parent window) (window-next-sibling window)))
+
+(defsubst window-left (window)
+ "Return WINDOW's left sibling.
+Return nil if WINDOW is the root window of its frame. WINDOW can
+be any window."
+ (and window (window-parent window) (window-prev-sibling window)))
+
+(defsubst window-child (window)
+ "Return WINDOW's first child window."
+ (or (window-top-child window) (window-left-child window)))
+
+(defun window-child-count (window)
+ "Return number of WINDOW's child windows."
+ (let ((count 0))
+ (when (and (windowp window) (setq window (window-child window)))
+ (while window
+ (setq count (1+ count))
+ (setq window (window-next-sibling window))))
+ count))
+
+(defun window-last-child (window)
+ "Return last child window of WINDOW."
+ (when (and (windowp window) (setq window (window-child window)))
+ (while (window-next-sibling window)
+ (setq window (window-next-sibling window))))
+ window)
+
+(defsubst window-any-p (object)
+ "Return t if OBJECT denotes a live or internal window."
+ (and (windowp object)
+ (or (window-buffer object) (window-child object))
+ t))
+
+(defsubst 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
+buffer and defaults to the current buffer."
+ (cond
+ ((not buffer-or-name)
+ (current-buffer))
+ ((bufferp buffer-or-name)
+ (if (buffer-live-p buffer-or-name)
+ buffer-or-name
+ (error "Buffer %s is not a live buffer" buffer-or-name)))
+ ((get-buffer buffer-or-name))
+ (t
+ (error "No such buffer %s" buffer-or-name))))
+
+(defsubst window-normalize-frame (frame)
+ "Return frame specified by FRAME.
+FRAME must be a live frame and defaults to the selected frame."
+ (if frame
+ (if (frame-live-p frame)
+ frame
+ (error "%s is not a live frame" frame))
+ (selected-frame)))
+
+(defsubst window-normalize-any-window (window)
+ "Return window specified by WINDOW.
+WINDOW must be a window that has not been deleted and defaults to
+the selected window."
+ (if window
+ (if (window-any-p window)
+ window
+ (error "%s is not a window" window))
+ (selected-window)))
+
+(defsubst window-normalize-live-window (window)
+ "Return live window specified by WINDOW.
+WINDOW must be a live window and defaults to the selected one."
+ (if window
+ (if (and (windowp window) (window-buffer window))
+ window
+ (error "%s is not a live window" window))
+ (selected-window)))
+
+(defvar ignore-window-parameters nil
+ "If non-nil, standard functions ignore window parameters.
+The functions currently affected by this are `split-window',
+`delete-window', `delete-other-windows' and `other-window'.
+
+An application may bind this to a non-nil value around calls to
+these functions to inhibit processing of window parameters.")
+
+(defconst window-safe-min-height 1
+ "The absolut minimum number of lines of a window.
+Anything less might crash Emacs.")
+
+(defcustom window-min-height 4
+ "The minimum number of lines of any window.
+The value has to accommodate a mode- or header-line if present.
+A value less than `window-safe-min-height' is ignored. The value
+of this variable is honored when windows are resized or split.
+
+Applications should never rebind this variable. To resize a
+window to a height less than the one specified here, an
+application should instead call `window-resize' with a non-nil
+IGNORE argument. In order to have `split-window' make a window
+shorter, explictly specify the SIZE argument of that function."
+ :type 'integer
+ :version "24.1"
+ :group 'windows)
-The return value does not include the mode line or the header
-line, if any. If a line at the bottom of the window is only
-partially visible, that line is included in the return value.
-If you do not want to include a partially visible bottom line
-in the return value, use `window-text-height' instead."
- (or window (setq window (selected-window)))
- (if (window-minibuffer-p window)
- (window-height window)
- (with-current-buffer (window-buffer window)
- (max 1 (- (window-height window)
- (if mode-line-format 1 0)
- (if header-line-format 1 0))))))
+(defconst window-safe-min-width 2
+ "The absolut minimum number of columns of a window.
+Anything less might crash Emacs.")
+
+(defcustom window-min-width 10
+ "The minimum number of columns of any window.
+The value has to accomodate margins, fringes, or scrollbars if
+present. A value less than `window-safe-min-width' is ignored.
+The value of this variable is honored when windows are resized or
+split.
+
+Applications should never rebind this variable. To resize a
+window to a width less than the one specified here, an
+application should instead call `window-resize' with a non-nil
+IGNORE argument. In order to have `split-window' make a window
+narrower, explictly specify the SIZE argument of that function."
+ :type 'integer
+ :version "24.1"
+ :group 'windows)
+
+(defun window-iso-combination-p (&optional window horizontal)
+ "If WINDOW is a vertical combination return WINDOW's first child.
+WINDOW can be any window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return WINDOW's first
+child if WINDOW is a horizontal combination."
+ (setq window (window-normalize-any-window window))
+ (if horizontal
+ (window-left-child window)
+ (window-top-child window)))
+
+(defsubst window-iso-combined-p (&optional window horizontal)
+ "Return non-nil if and only if WINDOW is vertically combined.
+WINDOW can be any window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return non-nil if and
+only if WINDOW is horizontally combined."
+ (setq window (window-normalize-any-window window))
+ (let ((parent (window-parent window)))
+ (and parent (window-iso-combination-p parent horizontal))))
+
+(defun window-iso-combinations (&optional window horizontal)
+ "Return largest number of vertically arranged subwindows of WINDOW.
+WINDOW can be any window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means to return the largest
+number of horizontally arranged subwindows of WINDOW."
+ (setq window (window-normalize-any-window window))
+ (cond
+ ((window-live-p window)
+ ;; If WINDOW is live, return 1.
+ 1)
+ ((window-iso-combination-p window horizontal)
+ ;; If WINDOW is iso-combined, return the sum of the values for all
+ ;; subwindows of WINDOW.
+ (let ((child (window-child window))
+ (count 0))
+ (while child
+ (setq count
+ (+ (window-iso-combinations child horizontal)
+ count))
+ (setq child (window-right child)))
+ count))
+ (t
+ ;; If WINDOW is not iso-combined, return the maximum value of any
+ ;; subwindow of WINDOW.
+ (let ((child (window-child window))
+ (count 1))
+ (while child
+ (setq count
+ (max (window-iso-combinations child horizontal)
+ count))
+ (setq child (window-right child)))
+ count))))
+
+(defun walk-window-tree-1 (proc walk-window-tree-window any &optional sub-only)
+ "Helper function for `walk-window-tree' and `walk-window-subtree'."
+ (let (walk-window-tree-buffer)
+ (while walk-window-tree-window
+ (setq walk-window-tree-buffer
+ (window-buffer walk-window-tree-window))
+ (when (or walk-window-tree-buffer any)
+ (funcall proc walk-window-tree-window))
+ (unless walk-window-tree-buffer
+ (walk-window-tree-1
+ proc (window-left-child walk-window-tree-window) any)
+ (walk-window-tree-1
+ proc (window-top-child walk-window-tree-window) any))
+ (if sub-only
+ (setq walk-window-tree-window nil)
+ (setq walk-window-tree-window
+ (window-right walk-window-tree-window))))))
+
+(defun walk-window-tree (proc &optional frame any)
+ "Run function PROC on each live window of FRAME.
+PROC 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 PROC on all live and internal windows of
+FRAME.
+
+This function performs a pre-order, depth-first traversal of the
+window tree. If PROC changes the window tree, the result is
+unpredictable."
+ (let ((walk-window-tree-frame (window-normalize-frame frame)))
+ (walk-window-tree-1
+ proc (frame-root-window walk-window-tree-frame) any)))
+
+(defun walk-window-subtree (proc &optional window any)
+ "Run function PROC on each live subwindow of WINDOW.
+WINDOW defaults to the selected window. PROC must be a function
+with one argument - a window. ANY, if non-nil means to run PROC
+on all live and internal subwindows of WINDOW.
+
+This function performs a pre-order, depth-first traversal of the
+window tree rooted at WINDOW. If PROC changes that window tree,
+the result is unpredictable."
+ (setq window (window-normalize-any-window window))
+ (walk-window-tree-1 proc window any t))
+
+(defun windows-with-parameter (parameter &optional value frame any values)
+ "Return a list of all windows on FRAME with PARAMETER non-nil.
+FRAME defaults to the selected frame. Optional argument VALUE
+non-nil means only return windows whose window-parameter value of
+PARAMETER equals VALUE \(comparison is done using `equal').
+Optional argument ANY non-nil means consider internal windows
+too. Optional argument VALUES non-nil means return a list of cons
+cells whose car is the value of the parameter and whose cdr is
+the window."
+ (let (this-value windows)
+ (walk-window-tree
+ (lambda (window)
+ (when (and (setq this-value (window-parameter window parameter))
+ (or (not value) (or (equal value this-value))))
+ (setq windows
+ (if values
+ (cons (cons this-value window) windows)
+ (cons window windows)))))
+ frame any)
+
+ (nreverse windows)))
+
+(defun window-with-parameter (parameter &optional value frame any)
+ "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)
+ (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))))
+
+;;; 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.
+Return nil if WINDOW is not part of a atomic window."
+ (setq window (window-normalize-any-window window))
+ (let (root)
+ (while (and window (window-parameter window 'window-atom))
+ (setq root window)
+ (setq window (window-parent window)))
+ root))
+
+(defun window-make-atom (window)
+ "Make WINDOW an atomic window.
+WINDOW must be an internal window. Return WINDOW."
+ (if (not (window-child window))
+ (error "Window %s is not an internal window" window)
+ (walk-window-subtree
+ (lambda (window)
+ (set-window-parameter window 'window-atom t))
+ window t)
+ window))
+
+(defun window-atom-check-1 (window)
+ "Subroutine of `window-atom-check'."
+ (when window
+ (if (window-parameter window 'window-atom)
+ (let ((count 0))
+ (when (or (catch 'reset
+ (walk-window-subtree
+ (lambda (window)
+ (if (window-parameter window 'window-atom)
+ (setq count (1+ count))
+ (throw 'reset t)))
+ window t))
+ ;; count >= 1 must hold here. If there's no other
+ ;; window around dissolve this atomic window.
+ (= count 1))
+ ;; Dissolve atomic window.
+ (walk-window-subtree
+ (lambda (window)
+ (set-window-parameter window 'window-atom nil))
+ window t)))
+ ;; Check children.
+ (unless (window-buffer window)
+ (window-atom-check-1 (window-left-child window))
+ (window-atom-check-1 (window-top-child window))))
+ ;; Check right sibling
+ (window-atom-check-1 (window-right window))))
+
+(defun window-atom-check (&optional frame)
+ "Check atomicity of all windows on FRAME.
+FRAME defaults to the selected frame. If an atomic window is
+wrongly configured, reset the atomicity of all its subwindows to
+nil. An atomic window is wrongly configured if it has no
+subwindows or one of its subwindows is not atomic."
+ (window-atom-check-1 (frame-root-window frame)))
+
+;; Side windows.
+(defvar window-sides '(left top right bottom)
+ "Window sides.")
+
+(defcustom window-sides-vertical nil
+ "If non-nil, left and right side windows are full height.
+Otherwise, top and bottom side windows are full width."
+ :type 'boolean
+ :group 'windows
+ :version "24.1")
+
+(defcustom window-sides-slots '(nil nil nil nil)
+ "Maximum number of side window slots.
+The value is a list of four elements specifying the number of
+side window slots on \(in this order) the left, top, right and
+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."
+ :risky t
+ :type
+ '(list
+ :value (nil nil nil nil)
+ (choice
+ :tag "Left"
+ :help-echo "Maximum slots of left side window."
+ :value nil
+ :format "%[Left%] %v\n"
+ (const :tag "Unlimited" :format "%t" nil)
+ (integer :tag "Number" :value 2 :size 5))
+ (choice
+ :tag "Top"
+ :help-echo "Maximum slots of top side window."
+ :value nil
+ :format "%[Top%] %v\n"
+ (const :tag "Unlimited" :format "%t" nil)
+ (integer :tag "Number" :value 3 :size 5))
+ (choice
+ :tag "Right"
+ :help-echo "Maximum slots of right side window."
+ :value nil
+ :format "%[Right%] %v\n"
+ (const :tag "Unlimited" :format "%t" nil)
+ (integer :tag "Number" :value 2 :size 5))
+ (choice
+ :tag "Bottom"
+ :help-echo "Maximum slots of bottom side window."
+ :value nil
+ :format "%[Bottom%] %v\n"
+ (const :tag "Unlimited" :format "%t" nil)
+ (integer :tag "Number" :value 3 :size 5)))
+ :group 'windows)
+
+(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)
+ (when (or (catch 'reset
+ (walk-window-tree
+ (lambda (window)
+ (setq side (window-parameter window 'window-side))
+ (setq parent (window-parent window))
+ (setq parent-side
+ (and parent (window-parameter parent 'window-side)))
+ ;; The following `cond' seems a bit tedious, but I'd
+ ;; rather stick to using just the stack.
+ (cond
+ (parent-side
+ (when (not (eq parent-side side))
+ ;; 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)
+ (setq none t)))
+ ((eq side 'left)
+ (if left
+ (throw 'reset t)
+ (setq left t)))
+ ((eq side 'top)
+ (if top
+ (throw 'reset t)
+ (setq top t)))
+ ((eq side 'right)
+ (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))))
+ 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)))
+ (walk-window-tree
+ (lambda (window)
+ (set-window-parameter window 'window-side nil))
+ frame t))))
+
+(defun window-check (&optional frame)
+ "Check atomic and side windows on FRAME.
+FRAME defaults to the selected frame."
+ (window-side-check frame)
+ (window-atom-check frame))
+
+;;; Window sizes.
+(defvar window-size-fixed nil
+ "Non-nil in a buffer means windows displaying the buffer are fixed-size.
+If the value is `height', then only the window's height is fixed.
+If the value is `width', then only the window's width is fixed.
+Any other non-nil value fixes both the width and the height.
+
+Emacs won't change the size of any window displaying that buffer,
+unless it has no other choice \(like when deleting a neighboring
+window).")
+(make-variable-buffer-local 'window-size-fixed)
+
+(defsubst window-size-ignore (window ignore)
+ "Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
+ (if (window-any-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.
+
+Optional argument IGNORE non-nil means ignore any restrictions
+imposed by fixed size windows, `window-min-height' or
+`window-min-width' settings. IGNORE equal `safe' means 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-min-size-1
+ (window-normalize-any-window window) horizontal ignore))
+
+(defun window-min-size-1 (window horizontal ignore)
+ "Internal function of `window-min-size'."
+ (let ((sub (window-child window)))
+ (if sub
+ (let ((value 0))
+ ;; WINDOW is an internal window.
+ (if (window-iso-combined-p sub horizontal)
+ ;; The minimum size of an iso-combination is the sum of
+ ;; the minimum sizes of its subwindows.
+ (while sub
+ (setq value (+ value
+ (window-min-size-1 sub horizontal ignore)))
+ (setq sub (window-right sub)))
+ ;; The minimum size of an ortho-combination is the maximum of
+ ;; the minimum sizes of its subwindows.
+ (while sub
+ (setq value (max value
+ (window-min-size-1 sub horizontal ignore)))
+ (setq sub (window-right sub))))
+ value)
+ (with-current-buffer (window-buffer window)
+ (cond
+ ((and (not (window-size-ignore window ignore))
+ (window-size-fixed-p window horizontal))
+ ;; The minimum size of a fixed size window is its size.
+ (window-total-size window horizontal))
+ ((or (eq ignore 'safe) (eq ignore window))
+ ;; If IGNORE equals `safe' or WINDOW return the safe values.
+ (if horizontal window-safe-min-width window-safe-min-height))
+ (horizontal
+ ;; For the minimum width of a window take fringes and
+ ;; scroll-bars into account. This is questionable and should
+ ;; be removed as soon as we are able to split (and resize)
+ ;; windows such that the new (or resized) windows can get a
+ ;; size less than the user-specified `window-min-height' and
+ ;; `window-min-width'.
+ (let ((frame (window-frame window))
+ (fringes (window-fringes window))
+ (scroll-bars (window-scroll-bars window)))
+ (max
+ (+ window-safe-min-width
+ (ceiling (car fringes) (frame-char-width frame))
+ (ceiling (cadr fringes) (frame-char-width frame))
+ (cond
+ ((memq (nth 2 scroll-bars) '(left right))
+ (nth 1 scroll-bars))
+ ((memq (frame-parameter frame 'vertical-scroll-bars)
+ '(left right))
+ (ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
+ (frame-char-width)))
+ (t 0)))
+ (if (and (not (window-size-ignore window ignore))
+ (numberp window-min-width))
+ window-min-width
+ 0))))
+ (t
+ ;; For the minimum height of a window take any mode- or
+ ;; header-line into account.
+ (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))
+ (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.
+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.
+
+This function looks only at WINDOW and its subwindows. The
+function `window-resizable' looks at other windows as well.
+
+DELTA positive means WINDOW shall be enlarged by DELTA lines or
+columns. If WINDOW cannot be enlarged by DELTA lines or columns
+return the maximum value in the range 0..DELTA by which WINDOW
+can be enlarged.
+
+DELTA negative means WINDOW shall be shrunk by -DELTA lines or
+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
+imposed by fixed size windows, `window-min-height' or
+`window-min-width' settings. IGNORE equal `safe' means 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."
+ (setq window (window-normalize-any-window window))
+ (cond
+ ((< delta 0)
+ (max (- (window-min-size window horizontal ignore)
+ (window-total-size window horizontal))
+ delta))
+ ((window-size-ignore window ignore)
+ delta)
+ ((> delta 0)
+ (if (window-size-fixed-p window horizontal)
+ 0
+ delta))
+ (t 0)))
+
+(defsubst window-sizable-p (window delta &optional horizontal ignore)
+ "Return t if WINDOW can be resized by DELTA lines.
+For the meaning of the arguments of this function see the
+doc-string of `window-sizable'."
+ (setq window (window-normalize-any-window window))
+ (if (> delta 0)
+ (>= (window-sizable window delta horizontal ignore) delta)
+ (<= (window-sizable window delta horizontal ignore) delta)))
+
+(defun window-size-fixed-1 (window horizontal)
+ "Internal function for `window-size-fixed-p'."
+ (let ((sub (window-child window)))
+ (catch 'fixed
+ (if sub
+ ;; WINDOW is an internal window.
+ (if (window-iso-combined-p sub horizontal)
+ ;; An iso-combination is fixed size if all its subwindows
+ ;; are fixed-size.
+ (progn
+ (while sub
+ (unless (window-size-fixed-1 sub horizontal)
+ ;; We found a non-fixed-size subwindow, so WINDOW's
+ ;; size is not fixed.
+ (throw 'fixed nil))
+ (setq sub (window-right sub)))
+ ;; All subwindows are fixed-size, so WINDOW's size is
+ ;; fixed.
+ (throw 'fixed t))
+ ;; An ortho-combination is fixed-size if at least one of its
+ ;; subwindows is fixed-size.
+ (while sub
+ (when (window-size-fixed-1 sub horizontal)
+ ;; We found a fixed-size subwindow, so WINDOW's size is
+ ;; fixed.
+ (throw 'fixed t))
+ (setq sub (window-right sub))))
+ ;; WINDOW is a live window.
+ (with-current-buffer (window-buffer window)
+ (if horizontal
+ (memq window-size-fixed '(width t))
+ (memq window-size-fixed '(height t))))))))
+
+(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.
+
+If this function returns nil, this does not necessarily mean that
+WINDOW can be resized in the desired direction. The functions
+`window-resizable' and `window-resizable-p' will tell that."
+ (window-size-fixed-1
+ (window-normalize-any-window window) horizontal))
+
+(defun window-min-delta-1 (window delta &optional horizontal ignore trail noup)
+ "Internal function for `window-min-delta'."
+ (if (not (window-parent window))
+ ;; If we can't go up, return zero.
+ 0
+ ;; Else try to find a non-fixed-size sibling of WINDOW.
+ (let* ((parent (window-parent window))
+ (sub (window-child parent)))
+ (catch 'done
+ (if (window-iso-combined-p sub horizontal)
+ ;; In an iso-combination throw DELTA if we find at least one
+ ;; subwindow and that subwindow is either not of fixed-size
+ ;; or we can ignore fixed-sizeness.
+ (let ((skip (eq trail 'after)))
+ (while sub
+ (cond
+ ((eq sub window)
+ (setq skip (eq trail 'before)))
+ (skip)
+ ((and (not (window-size-ignore window ignore))
+ (window-size-fixed-p sub horizontal)))
+ (t
+ ;; We found a non-fixed-size subwindow.
+ (throw 'done delta)))
+ (setq sub (window-right sub))))
+ ;; In an ortho-combination set DELTA to the minimum value by
+ ;; which other subwindows can shrink.
+ (while sub
+ (unless (eq sub window)
+ (setq delta
+ (min delta
+ (- (window-total-size sub horizontal)
+ (window-min-size sub horizontal ignore)))))
+ (setq sub (window-right sub))))
+ (if noup
+ delta
+ (window-min-delta-1 parent delta horizontal ignore trail))))))
+
+(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.
+
+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
+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
+live windows may get as small as `window-safe-min-height' lines
+and `window-safe-min-width' columns.
+
+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 NOUP non-nil means don't go up in the window
+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 subwindows) can be shrunk; check only whether at
+least one other windows can be enlarged appropriately."
+ (setq window (window-normalize-any-window window))
+ (let ((size (window-total-size window horizontal))
+ (minimum (window-min-size window horizontal ignore)))
+ (cond
+ (nodown
+ ;; If NODOWN is t, try to recover the entire size of WINDOW.
+ (window-min-delta-1 window size horizontal ignore trail noup))
+ ((= size minimum)
+ ;; If NODOWN is nil and WINDOW's size is already at its minimum,
+ ;; there's nothing to recover.
+ 0)
+ (t
+ ;; Otherwise, try to recover whatever WINDOW is larger than its
+ ;; minimum size.
+ (window-min-delta-1
+ window (- size minimum) horizontal ignore trail noup)))))
+
+(defun window-max-delta-1 (window delta &optional horizontal ignore trail noup)
+ "Internal function of `window-max-delta'."
+ (if (not (window-parent window))
+ ;; Can't go up. Return DELTA.
+ delta
+ (let* ((parent (window-parent window))
+ (sub (window-child parent)))
+ (catch 'fixed
+ (if (window-iso-combined-p sub horizontal)
+ ;; For an iso-combination calculate how much we can get from
+ ;; other subwindows.
+ (let ((skip (eq trail 'after)))
+ (while sub
+ (cond
+ ((eq sub window)
+ (setq skip (eq trail 'before)))
+ (skip)
+ (t
+ (setq delta
+ (+ delta
+ (- (window-total-size sub horizontal)
+ (window-min-size sub horizontal ignore))))))
+ (setq sub (window-right sub))))
+ ;; For an ortho-combination throw DELTA when at least one
+ ;; subwindow is fixed-size.
+ (while sub
+ (when (and (not (eq sub window))
+ (not (window-size-ignore sub ignore))
+ (window-size-fixed-p sub horizontal))
+ (throw 'fixed delta))
+ (setq sub (window-right sub))))
+ (if noup
+ ;; When NOUP is nil, DELTA is all we can get.
+ delta
+ ;; Else try with parent of WINDOW, passing the DELTA we
+ ;; recovered so far.
+ (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.
+
+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
+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
+live windows may get as small as `window-safe-min-height' lines
+and `window-safe-min-width' columns.
+
+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 NOUP non-nil means don't go up in the window
+tree but try to obtain the entire space from windows within
+WINDOW's combination.
+
+Optional argument NODOWN non-nil means do not check whether
+WINDOW itself \(and its subwindows) can be enlarged; check only
+whether other windows can be shrunk appropriately."
+ (setq window (window-normalize-any-window window))
+ (if (and (not (window-size-ignore window ignore))
+ (not nodown) (window-size-fixed-p window horizontal))
+ ;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
+ ;; size.
+ 0
+ ;; WINDOW has no fixed size.
+ (window-max-delta-1 window 0 horizontal ignore trail noup)))
+
+;; 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.
+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.
+
+DELTA positive means WINDOW shall be enlarged by DELTA lines or
+columns. If WINDOW cannot be enlarged by DELTA lines or columns
+return the maximum value in the range 0..DELTA by which WINDOW
+can be enlarged.
+
+DELTA negative means WINDOW shall be shrunk by -DELTA lines or
+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
+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
+live windows may get as small as `window-safe-min-height' lines
+and `window-safe-min-width' columns.
+
+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 NOUP non-nil means don't go up in the window
+tree but try to distribute the space among the other windows
+within WINDOW's combination.
+
+Optional argument NODOWN non-nil means don't check whether WINDOW
+and its subwindows can be resized."
+ (setq window (window-normalize-any-window window))
+ (cond
+ ((< delta 0)
+ (max (- (window-min-delta window horizontal ignore trail noup nodown))
+ delta))
+ ((> delta 0)
+ (min (window-max-delta window horizontal ignore trail noup nodown)
+ delta))
+ (t 0)))
+
+(defun window-resizable-p (window delta &optional horizontal ignore trail noup nodown)
+ "Return t if WINDOW can be resized vertically by DELTA lines.
+For the meaning of the arguments of this function see the
+doc-string of `window-resizable'."
+ (setq window (window-normalize-any-window window))
+ (if (> delta 0)
+ (>= (window-resizable window delta horizontal ignore trail noup nodown)
+ delta)
+ (<= (window-resizable window delta horizontal ignore trail noup nodown)
+ delta)))
+
+(defsubst window-total-height (&optional window)
+ "Return the total number of lines of WINDOW.
+WINDOW can be any window and defaults to the selected one. The
+return value includes WINDOW's mode line and header line, if any.
+If WINDOW is internal the return value is the sum of the total
+number of lines of WINDOW's child windows if these are vertically
+combined and the height of WINDOW's first child otherwise.
+
+Note: This function does not take into account the value of
+`line-spacing' when calculating the number of lines in WINDOW."
+ (window-total-size window))
+
+;; Eventually we should make `window-height' obsolete.
+(defalias 'window-height 'window-total-height)
;; See discussion in bug#4543.
-(defun window-full-height-p (&optional window)
- "Return non-nil if WINDOW is not the result of a vertical split.
-WINDOW defaults to the selected window. (This function is not
-appropriate for minibuffers.)"
- (unless window
- (setq window (selected-window)))
- (= (window-height window)
- (window-height (frame-root-window (window-frame window)))))
+(defsubst window-full-height-p (&optional window)
+ "Return t if WINDOW is as high as the 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."
+ (setq window (window-normalize-any-window window))
+ (= (window-total-size window)
+ (window-total-size (frame-root-window window))))
+
+(defsubst window-total-width (&optional window)
+ "Return the total number of columns of WINDOW.
+WINDOW can be any window and defaults to the selected one. The
+return value includes any vertical dividers or scrollbars of
+WINDOW. If WINDOW is internal, the return value is the sum of
+the total number of columns of WINDOW's child windows if these
+are horizontally combined and the width of WINDOW's first child
+otherwise."
+ (window-total-size window t))
+
+(defsubst window-full-width-p (&optional window)
+ "Return t if WINDOW is as wide as the 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."
+ (setq window (window-normalize-any-window window))
+ (= (window-total-size window t)
+ (window-total-size (frame-root-window window) t)))
+
+(defsubst window-body-height (&optional window)
+ "Return the number of lines of WINDOW's body.
+WINDOW must be a live window and defaults to the selected one.
+
+The return value does not include WINDOW's mode line and header
+line, if any. If a line at the bottom of the window is only
+partially visible, that line is included in the return value. If
+you do not want to include a partially visible bottom line in the
+return value, use `window-text-height' instead."
+ (window-body-size window))
-(defun one-window-p (&optional nomini all-frames)
- "Return non-nil if the selected window is the only window.
-Optional arg NOMINI non-nil means don't count the minibuffer
-even if it is active. Otherwise, the minibuffer is counted
-when it is active.
+(defsubst window-body-width (&optional window)
+ "Return the number of columns of WINDOW's body.
+WINDOW must be a live window and defaults to the selected one.
-The optional arg ALL-FRAMES t means count windows on all frames.
-If it is `visible', count windows on all visible frames on the
-current terminal. ALL-FRAMES nil or omitted means count only the
-selected frame, plus the minibuffer it uses (which may be on
-another frame). ALL-FRAMES 0 means count all windows in all
-visible or iconified frames on the current terminal. If
-ALL-FRAMES is anything else, count only the selected frame."
- (let ((base-window (selected-window)))
- (if (and nomini (eq base-window (minibuffer-window)))
- (setq base-window (next-window base-window)))
- (eq base-window
- (next-window base-window (if nomini 'arg) all-frames))))
+The return value does not include any vertical dividers or scroll
+bars owned by WINDOW. On a window-system the return value does
+not include the number of columns used for WINDOW's fringes or
+display margins either."
+ (window-body-size window t))
+
+;; Eventually we should make `window-height' obsolete.
+(defalias 'window-width 'window-body-width)
(defun window-current-scroll-bars (&optional window)
"Return the current scroll bar settings for WINDOW.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
The return value is a cons cell (VERTICAL . HORIZONTAL) where
VERTICAL specifies the current location of the vertical scroll
@@ -131,11 +1001,11 @@ or nil).
Unlike `window-scroll-bars', this function reports the scroll bar
type actually used, once frame defaults and `scroll-bar-mode' are
taken into account."
+ (setq window (window-normalize-live-window window))
(let ((vert (nth 2 (window-scroll-bars window)))
(hor nil))
(when (or (eq vert t) (eq hor t))
- (let ((fcsb (frame-current-scroll-bars
- (window-frame (or window (selected-window))))))
+ (let ((fcsb (frame-current-scroll-bars (window-frame window))))
(if (eq vert t)
(setq vert (car fcsb)))
(if (eq hor t)
@@ -143,10 +1013,10 @@ taken into account."
(cons vert hor)))
(defun walk-windows (proc &optional minibuf all-frames)
- "Cycle through all windows, calling PROC for each one.
+ "Cycle through all live windows, calling PROC for each one.
PROC must specify a function with a window as its sole argument.
The optional arguments MINIBUF and ALL-FRAMES specify the set of
-windows to include in the walk, see also `next-window'.
+windows to include in the walk.
MINIBUF t means include the minibuffer window even if the
minibuffer is not active. MINIBUF nil or omitted means include
@@ -154,29 +1024,24 @@ the minibuffer window only if the minibuffer is active. Any
other value means do not include the minibuffer window even if
the minibuffer is active.
-Several frames may share a single minibuffer; if the minibuffer
-is active, all windows on all frames that share that minibuffer
-are included too. Therefore, if you are using a separate
-minibuffer frame and the minibuffer is active and MINIBUF says it
-counts, `walk-windows' includes the windows in the frame from
-which you entered the minibuffer, as well as the minibuffer
-window.
+ALL-FRAMES nil or omitted means consider all windows on the
+selected frame, plus the minibuffer window if specified by the
+MINIBUF argument. If the minibuffer counts, consider all windows
+on all frames that share that minibuffer too. The following
+non-nil values of ALL-FRAMES have special meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
-ALL-FRAMES nil or omitted means cycle through all windows on the
- selected frame, plus the minibuffer window if specified by the
- MINIBUF argument, see above. If the minibuffer counts, cycle
- through all windows on all frames that share that minibuffer
- too.
-ALL-FRAMES t means cycle through all windows on all existing
- frames.
-ALL-FRAMES `visible' means cycle through all windows on all
- visible frames on the current terminal.
-ALL-FRAMES 0 means cycle through all windows on all visible and
- iconified frames on the current terminal.
-ALL-FRAMES a frame means cycle through all windows on that frame
- only.
-Anything else means cycle through all windows on the selected
- frame and no others.
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Anything else means consider all windows on the selected frame
+and no others.
This function changes neither the order of recently selected
windows nor the buffer list."
@@ -190,266 +1055,2366 @@ windows nor the buffer list."
(save-selected-window
(when (framep all-frames)
(select-window (frame-first-window all-frames) 'norecord))
- (let* (walk-windows-already-seen
- (walk-windows-current (selected-window)))
- (while (progn
- (setq walk-windows-current
- (next-window walk-windows-current minibuf all-frames))
- (not (memq walk-windows-current walk-windows-already-seen)))
- (setq walk-windows-already-seen
- (cons walk-windows-current walk-windows-already-seen))
- (funcall proc walk-windows-current)))))
-
-(defun get-window-with-predicate (predicate &optional minibuf
- all-frames default)
- "Return a window satisfying PREDICATE.
-More precisely, cycle through all windows using `walk-windows',
-calling the function PREDICATE on each one of them with the
-window as its sole argument. Return the first window for which
-PREDICATE returns non-nil. If no window satisfies PREDICATE,
-return DEFAULT.
+ (dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
+ (funcall proc walk-windows-window))))
+
+(defun window-in-direction-2 (window posn &optional horizontal)
+ "Support function for `window-in-direction'."
+ (if horizontal
+ (let ((top (window-top-line window)))
+ (if (> top posn)
+ (- top posn)
+ (- posn top (window-total-height window))))
+ (let ((left (window-left-column window)))
+ (if (> left posn)
+ (- left posn)
+ (- posn left (window-total-width window))))))
+
+(defun window-in-direction (direction &optional window ignore)
+ "Return window in DIRECTION as seen from 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."
+ (setq window (window-normalize-live-window window))
+ (unless (memq direction '(above below left right))
+ (error "Wrong direction %s" direction))
+ (let* ((frame (window-frame window))
+ (hor (memq direction '(left right)))
+ (first (if hor
+ (window-left-column window)
+ (window-top-line window)))
+ (last (+ first (if hor
+ (window-total-width window)
+ (window-total-height 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
+ (+ (or (cdr posn-cons) 1) (window-top-line window))
+ (+ (or (car posn-cons) 1) (window-left-column window))))
+ (best-edge
+ (cond
+ ((eq direction 'below) (frame-height frame))
+ ((eq direction 'right) (frame-width frame))
+ (t -1)))
+ (best-edge-2 best-edge)
+ (best-diff-2 (if hor (frame-height frame) (frame-width frame)))
+ best best-2 best-diff-2-new)
+ (walk-window-tree
+ (lambda (w)
+ (let* ((w-top (window-top-line w))
+ (w-left (window-left-column w)))
+ (cond
+ ((or (eq window w)
+ ;; Ignore ourselves.
+ (and (window-parameter w 'no-other-window)
+ ;; Ignore W unless IGNORE is non-nil.
+ (not ignore))))
+ (hor
+ (cond
+ ((and (<= w-top posn)
+ (< posn (+ w-top (window-total-height w))))
+ ;; W is to the left or right of WINDOW and covers POSN.
+ (when (or (and (eq direction 'left)
+ (<= w-left first) (> w-left best-edge))
+ (and (eq direction 'right)
+ (>= w-left last) (< w-left best-edge)))
+ (setq best-edge w-left)
+ (setq best w)))
+ ((and (or (and (eq direction 'left)
+ (<= (+ w-left (window-total-width w)) first))
+ (and (eq direction 'right) (<= last w-left)))
+ ;; W is to the left or right of WINDOW but does not
+ ;; cover POSN.
+ (setq best-diff-2-new
+ (window-in-direction-2 w posn hor))
+ (or (< best-diff-2-new best-diff-2)
+ (and (= best-diff-2-new best-diff-2)
+ (if (eq direction 'left)
+ (> w-left best-edge-2)
+ (< w-left best-edge-2)))))
+ (setq best-edge-2 w-left)
+ (setq best-diff-2 best-diff-2-new)
+ (setq best-2 w))))
+ (t
+ (cond
+ ((and (<= w-left posn)
+ (< posn (+ w-left (window-total-width w))))
+ ;; W is above or below WINDOW and covers POSN.
+ (when (or (and (eq direction 'above)
+ (<= w-top first) (> w-top best-edge))
+ (and (eq direction 'below)
+ (>= w-top first) (< w-top best-edge)))
+ (setq best-edge w-top)
+ (setq best w)))
+ ((and (or (and (eq direction 'above)
+ (<= (+ w-top (window-total-height w)) first))
+ (and (eq direction 'below) (<= last w-top)))
+ ;; W is above or below WINDOW but does not cover POSN.
+ (setq best-diff-2-new
+ (window-in-direction-2 w posn hor))
+ (or (< best-diff-2-new best-diff-2)
+ (and (= best-diff-2-new best-diff-2)
+ (if (eq direction 'above)
+ (> w-top best-edge-2)
+ (< w-top best-edge-2)))))
+ (setq best-edge-2 w-top)
+ (setq best-diff-2 best-diff-2-new)
+ (setq best-2 w)))))))
+ (window-frame window))
+ (or best best-2)))
+
+(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
+ "Return a live window satisfying PREDICATE.
+More precisely, cycle through all windows calling the function
+PREDICATE on each one of them with the window as its sole
+argument. Return the first window for which PREDICATE returns
+non-nil. Windows are scanned starting with the window following
+the selcted window. If no window satisfies PREDICATE, return
+DEFAULT.
-The optional arguments MINIBUF and ALL-FRAMES specify the set of
-windows to include. See `walk-windows' for the meaning of these
-arguments."
+MINIBUF t means include the minibuffer window even if the
+minibuffer is not active. MINIBUF nil or omitted means include
+the minibuffer window only if the minibuffer is active. Any
+other value means do not include the minibuffer window even if
+the minibuffer is active.
+
+ALL-FRAMES nil or omitted means consider all windows on the selected
+frame, plus the minibuffer window if specified by the MINIBUF
+argument. If the minibuffer counts, consider all windows on all
+frames that share that minibuffer too. The following non-nil
+values of ALL-FRAMES have special meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Anything else means consider all windows on the selected frame
+and no others."
(catch 'found
- (walk-windows #'(lambda (window)
- (when (funcall predicate window)
- (throw 'found window)))
- minibuf all-frames)
+ (dolist (window (window-list-1
+ (next-window nil minibuf all-frames)
+ minibuf all-frames))
+ (when (funcall predicate window)
+ (throw 'found window)))
default))
(defalias 'some-window 'get-window-with-predicate)
-;; This should probably be written in C (i.e., without using `walk-windows').
+(defun get-lru-window (&optional all-frames dedicated)
+ "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.
+
+The following non-nil values of the optional argument ALL-FRAMES
+have special meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+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)))
+ (setq time (window-use-time window))
+ (if (or (eq window (selected-window))
+ (not (window-full-width-p window)))
+ (when (or (not second-best-time) (< time second-best-time))
+ (setq second-best-time time)
+ (setq second-best-window window))
+ (when (or (not best-time) (< time best-time))
+ (setq best-time time)
+ (setq best-window window)))))
+ (or best-window second-best-window)))
+
+(defun get-mru-window (&optional all-frames)
+ "Return the most recently used window on frames specified by ALL-FRAMES.
+Do not return a minibuffer window.
+
+The following non-nil values of the optional argument ALL-FRAMES
+have special meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Any other value of ALL-FRAMES means consider all windows on the
+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))
+ (setq best-time time)
+ (setq best-window window)))
+ best-window))
+
+(defun get-largest-window (&optional all-frames dedicated)
+ "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.
+
+The following non-nil values of the optional argument ALL-FRAMES
+have special meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Any other value of ALL-FRAMES means consider all windows on the
+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)))
+ (setq size (* (window-total-size window)
+ (window-total-size window t)))
+ (when (> size best-size)
+ (setq best-size size)
+ (setq best-window window))))
+ best-window))
+
(defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
"Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
-and defaults to the current buffer.
+and defaults to the current buffer. Windows are scanned starting
+with the selected window.
-The optional arguments MINIBUF and ALL-FRAMES specify the set of
-windows to consider. See `walk-windows' for the precise meaning
-of these arguments."
- (let ((buffer (cond
- ((not buffer-or-name) (current-buffer))
- ((bufferp buffer-or-name) buffer-or-name)
- (t (get-buffer buffer-or-name))))
+MINIBUF t means include the minibuffer window even if the
+minibuffer is not active. MINIBUF nil or omitted means include
+the minibuffer window only if the minibuffer is active. Any
+other value means do not include the minibuffer window even if
+the minibuffer is active.
+
+ALL-FRAMES nil or omitted means consider all windows on the
+selected frame, plus the minibuffer window if specified by the
+MINIBUF argument. If the minibuffer counts, consider all windows
+on all frames that share that minibuffer too. The following
+non-nil values of ALL-FRAMES have special meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Anything else means consider all windows on the selected frame
+and no others."
+ (let ((buffer (window-normalize-buffer buffer-or-name))
windows)
- (walk-windows (function (lambda (window)
- (if (eq (window-buffer window) buffer)
- (setq windows (cons window windows)))))
- minibuf all-frames)
- windows))
+ (dolist (window (window-list-1 (selected-window) minibuf all-frames))
+ (when (eq (window-buffer window) buffer)
+ (setq windows (cons window windows))))
+ (nreverse windows)))
(defun minibuffer-window-active-p (window)
"Return t if WINDOW is the currently active minibuffer window."
(eq window (active-minibuffer-window)))
-
+
(defun count-windows (&optional minibuf)
- "Return the number of visible windows.
+ "Return the number of live windows on the selected frame.
The optional argument MINIBUF specifies whether the minibuffer
window shall be counted. See `walk-windows' for the precise
meaning of this argument."
- (let ((count 0))
- (walk-windows (lambda (_w) (setq count (+ count 1)))
- minibuf)
- count))
+ (length (window-list-1 nil minibuf)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; `balance-windows' subroutines using `window-tree'
-
-;;; Translate from internal window tree format
-
-(defun bw-get-tree (&optional window-or-frame)
- "Get a window split tree in our format.
-
-WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
-then the whole window split tree for `selected-frame' is returned.
-If it is a frame, then this is used instead. If it is a window,
-then the smallest tree containing that window is returned."
- (when window-or-frame
- (unless (or (framep window-or-frame)
- (windowp window-or-frame))
- (error "Not a frame or window: %s" window-or-frame)))
- (let ((subtree (bw-find-tree-sub window-or-frame)))
- (when subtree
- (if (integerp subtree)
- nil
- (bw-get-tree-1 subtree)))))
-
-(defun bw-get-tree-1 (split)
- (if (windowp split)
- split
- (let ((dir (car split))
- (edges (car (cdr split)))
- (childs (cdr (cdr split))))
- (list
- (cons 'dir (if dir 'ver 'hor))
- (cons 'b (nth 3 edges))
- (cons 'r (nth 2 edges))
- (cons 't (nth 1 edges))
- (cons 'l (nth 0 edges))
- (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
-
-(defun bw-find-tree-sub (window-or-frame &optional get-parent)
- (let* ((window (when (windowp window-or-frame) window-or-frame))
- (frame (when (windowp window) (window-frame window)))
- (wt (car (window-tree frame))))
- (when (< 1 (length (window-list frame 0)))
- (if window
- (bw-find-tree-sub-1 wt window get-parent)
- wt))))
-
-(defun bw-find-tree-sub-1 (tree win &optional get-parent)
- (unless (windowp win) (error "Not a window: %s" win))
- (if (memq win tree)
- (if get-parent
- get-parent
- tree)
- (let ((childs (cdr (cdr tree)))
- child
- subtree)
- (while (and childs (not subtree))
- (setq child (car childs))
- (setq childs (cdr childs))
- (when (and child (listp child))
- (setq subtree (bw-find-tree-sub-1 child win get-parent))))
- (if (integerp subtree)
- (progn
- (if (= 1 subtree)
- tree
- (1- subtree)))
- subtree
- ))))
-
-;;; Window or object edges
-
-(defun bw-l (obj)
- "Left edge of OBJ."
- (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
-(defun bw-t (obj)
- "Top edge of OBJ."
- (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
-(defun bw-r (obj)
- "Right edge of OBJ."
- (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
-(defun bw-b (obj)
- "Bottom edge of OBJ."
- (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
-
-;;; Split directions
-
-(defun bw-dir (obj)
- "Return window split tree direction if OBJ.
-If OBJ is a window return 'both. If it is a window split tree
-then return its direction."
- (if (symbolp obj)
- obj
- (if (windowp obj)
- 'both
- (let ((dir (cdr (assq 'dir obj))))
- (unless (memq dir '(hor ver both))
- (error "Can't find dir in %s" obj))
- dir))))
-
-(defun bw-eqdir (obj1 obj2)
- "Return t if window split tree directions are equal.
-OBJ1 and OBJ2 should be either windows or window split trees in
-our format. The directions returned by `bw-dir' are compared and
-t is returned if they are `eq' or one of them is 'both."
- (let ((dir1 (bw-dir obj1))
- (dir2 (bw-dir obj2)))
- (or (eq dir1 dir2)
- (eq dir1 'both)
- (eq dir2 'both))))
-
-;;; Building split tree
-
-(defun bw-refresh-edges (obj)
- "Refresh the edge information of OBJ and return OBJ."
- (unless (windowp obj)
- (let ((childs (cdr (assq 'childs obj)))
- (ol 1000)
- (ot 1000)
- (or -1)
- (ob -1))
- (dolist (o childs)
- (when (> ol (bw-l o)) (setq ol (bw-l o)))
- (when (> ot (bw-t o)) (setq ot (bw-t o)))
- (when (< or (bw-r o)) (setq or (bw-r o)))
- (when (< ob (bw-b o)) (setq ob (bw-b o))))
- (setq obj (delq 'l obj))
- (setq obj (delq 't obj))
- (setq obj (delq 'r obj))
- (setq obj (delq 'b obj))
- (add-to-list 'obj (cons 'l ol))
- (add-to-list 'obj (cons 't ot))
- (add-to-list 'obj (cons 'r or))
- (add-to-list 'obj (cons 'b ob))
- ))
- obj)
-
-;;; Balance windows
+;;; Resizing windows.
+(defun window--resize-reset (&optional frame horizontal)
+ "Reset resize values for all windows on FRAME.
+FRAME defaults to the selected frame.
+
+This function stores the current value of `window-total-size' applied
+with argument HORIZONTAL in the new total size of all windows on
+FRAME. It also resets the new normal size of each of these
+windows."
+ (window--resize-reset-1
+ (frame-root-window (window-normalize-frame frame)) horizontal))
+
+(defun window--resize-reset-1 (window horizontal)
+ "Internal function of `window--resize-reset'."
+ ;; Register old size in the new total size.
+ (set-window-new-total window (window-total-size window horizontal))
+ ;; Reset new normal size.
+ (set-window-new-normal window)
+ (when (window-child window)
+ (window--resize-reset-1 (window-child window) horizontal))
+ (when (window-right window)
+ (window--resize-reset-1 (window-right window) horizontal)))
+
+;; The following routine is used to manually resize the minibuffer
+;; window and is currently used, for example, by ispell.el.
+(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."
+ (when (window-minibuffer-p window)
+ (let* ((frame (window-frame window))
+ (root (frame-root-window frame))
+ (height (window-total-size window))
+ (min-delta
+ (- (window-total-size root)
+ (window-min-size root))))
+ ;; Sanitize DELTA.
+ (cond
+ ((<= (+ height delta) 0)
+ (setq delta (- (- height 1))))
+ ((> delta min-delta)
+ (setq delta min-delta)))
+
+ ;; Resize now.
+ (window--resize-reset frame)
+ ;; Ideally we should be able to resize just the last subwindow of
+ ;; root here. See the comment in `resize-root-window-vertically'
+ ;; for why we do not do that.
+ (window--resize-this-window root (- delta) nil nil t)
+ (set-window-new-total window (+ height delta))
+ ;; The following routine catches the case where we want to resize
+ ;; a minibuffer-only frame.
+ (resize-mini-window-internal window))))
+
+(defun window-resize (window delta &optional horizontal ignore)
+ "Resize WINDOW vertically by DELTA lines.
+WINDOW can be an arbitrary window and defaults to the selected
+one. An attempt to resize the root window of a frame will raise
+an error though.
+
+DELTA a positive number means WINDOW shall be enlarged by DELTA
+lines. DELTA negative means WINDOW shall be shrunk by -DELTA
+lines.
+
+Optional argument HORIZONTAL non-nil means resize WINDOW
+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
+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
+live windows may get as small as `window-safe-min-height' lines
+and `window-safe-min-width' columns.
+
+This function resizes other windows proportionally and never
+deletes any windows. If you want to move only the low (right)
+edge of WINDOW consider using `adjust-window-trailing-edge'
+instead."
+ (setq window (window-normalize-any-window window))
+ (let* ((frame (window-frame window))
+ 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))
+ ((window-resizable-p window delta horizontal ignore)
+ (window--resize-reset frame horizontal)
+ (window--resize-this-window window delta horizontal ignore t)
+ (if (and (not (window-splits window))
+ (window-iso-combined-p window horizontal)
+ (setq sibling (or (window-right window) (window-left window)))
+ (window-sizable-p sibling (- delta) horizontal ignore))
+ ;; If window-splits returns nil for WINDOW, WINDOW is part of
+ ;; an iso-combination, and WINDOW's neighboring right or left
+ ;; sibling can be resized as requested, resize that sibling.
+ (let ((normal-delta
+ (/ (float delta)
+ (window-total-size (window-parent window) horizontal))))
+ (window--resize-this-window sibling (- delta) horizontal nil t)
+ (set-window-new-normal
+ window (+ (window-normal-size window horizontal)
+ normal-delta))
+ (set-window-new-normal
+ sibling (- (window-normal-size sibling horizontal)
+ normal-delta)))
+ ;; Otherwise, resize all other windows in the same combination.
+ (window--resize-siblings window delta horizontal ignore))
+ (window-resize-apply frame horizontal))
+ (t
+ (error "Cannot resize window %s" window)))))
+
+(defsubst window--resize-subwindows-skip-p (window)
+ "Return non-nil if WINDOW shall be skipped by resizing routines."
+ (memq (window-new-normal window) '(ignore stuck skip)))
+
+(defun window--resize-subwindows-normal (parent horizontal window this-delta &optional trail other-delta)
+ "Set the new normal height of subwindows of window PARENT.
+HORIZONTAL non-nil means set the new normal width of these
+windows. WINDOW specifies a subwindow 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)
+have been obtained from \(or returned to) an ancestor window of
+PARENT in order to resize WINDOW."
+ (let* ((delta-normal
+ (if (and (= (- this-delta) (window-total-size window horizontal))
+ (zerop other-delta))
+ ;; When WINDOW gets deleted and we can return its entire
+ ;; space to its siblings, use WINDOW's normal size as the
+ ;; normal delta.
+ (- (window-normal-size window horizontal))
+ ;; In any other case calculate the normal delta from the
+ ;; relation of THIS-DELTA to the total size of PARENT.
+ (/ (float this-delta) (window-total-size parent horizontal))))
+ (sub (window-child parent))
+ (parent-normal 0.0)
+ (skip (eq trail 'after)))
+
+ ;; Set parent-normal to the sum of the normal sizes of all
+ ;; subwindows of PARENT that shall be resized, excluding only WINDOW
+ ;; and any windows specified by the optional TRAIL argument.
+ (while sub
+ (cond
+ ((eq sub window)
+ (setq skip (eq trail 'before)))
+ (skip)
+ (t
+ (setq parent-normal
+ (+ parent-normal (window-normal-size sub horizontal)))))
+ (setq sub (window-right sub)))
+
+ ;; Set the new normal size of all subwindows of PARENT from what
+ ;; they should have contributed for recovering THIS-DELTA lines
+ ;; (columns).
+ (setq sub (window-child parent))
+ (setq skip (eq trail 'after))
+ (while sub
+ (cond
+ ((eq sub window)
+ (setq skip (eq trail 'before)))
+ (skip)
+ (t
+ (let ((old-normal (window-normal-size sub horizontal)))
+ (set-window-new-normal
+ sub (min 1.0 ; Don't get larger than 1.
+ (max (- old-normal
+ (* (/ old-normal parent-normal)
+ delta-normal))
+ ;; Don't drop below 0.
+ 0.0))))))
+ (setq sub (window-right sub)))
+
+ (when (numberp other-delta)
+ ;; Set the new normal size of windows from what they should have
+ ;; contributed for recovering OTHER-DELTA lines (columns).
+ (setq delta-normal (/ (float (window-total-size parent horizontal))
+ (+ (window-total-size parent horizontal)
+ other-delta)))
+ (setq sub (window-child parent))
+ (setq skip (eq trail 'after))
+ (while sub
+ (cond
+ ((eq sub window)
+ (setq skip (eq trail 'before)))
+ (skip)
+ (t
+ (set-window-new-normal
+ sub (min 1.0 ; Don't get larger than 1.
+ (max (* (window-new-normal sub) delta-normal)
+ ;; Don't drop below 0.
+ 0.0)))))
+ (setq sub (window-right sub))))
+
+ ;; Set the new normal size of WINDOW to what is left by the sum of
+ ;; the normal sizes of its siblings.
+ (set-window-new-normal
+ window
+ (let ((sum 0))
+ (setq sub (window-child parent))
+ (while sub
+ (cond
+ ((eq sub window))
+ ((not (numberp (window-new-normal sub)))
+ (setq sum (+ sum (window-normal-size sub horizontal))))
+ (t
+ (setq sum (+ sum (window-new-normal sub)))))
+ (setq sub (window-right sub)))
+ ;; Don't get larger than 1 or smaller than 0.
+ (min 1.0 (max (- 1.0 sum) 0.0))))))
+
+(defun window--resize-subwindows (parent delta &optional horizontal window ignore trail edge)
+ "Resize subwindows of window PARENT vertically by DELTA lines.
+PARENT must be a vertically combined internal window.
+
+Optional argument HORIZONTAL non-nil means resize subwindows of
+PARENT horizontally by DELTA columns. In this case PARENT must
+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
+imposed by fixed size windows, `window-min-height' or
+`window-min-width' settings. IGNORE equal `safe' means 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.
+
+Optional arguments TRAIL and EDGE, when non-nil, restrict the set
+of windows that shall be resized. If TRAIL equals `before',
+resize only windows on the left or above EDGE. If TRAIL equals
+`after', resize only windows on the right or below EDGE. Also,
+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)
+ (parent-total (+ (window-total-size parent horizontal) delta))
+ best-window best-value)
+
+ (if (and edge (memq trail '(before after))
+ (progn
+ (setq sub first)
+ (while (and (window-right sub)
+ (or (and (eq trail 'before)
+ (not (window--resize-subwindows-skip-p
+ (window-right sub))))
+ (and (eq trail 'after)
+ (window--resize-subwindows-skip-p sub))))
+ (setq sub (window-right sub)))
+ sub)
+ (if horizontal
+ (if (eq trail 'before)
+ (= (+ (window-left-column sub)
+ (window-total-size sub t))
+ edge)
+ (= (window-left-column sub) edge))
+ (if (eq trail 'before)
+ (= (+ (window-top-line sub)
+ (window-total-size sub))
+ edge)
+ (= (window-top-line sub) edge)))
+ (window-sizable-p sub delta horizontal ignore))
+ ;; Resize only windows adjacent to EDGE.
+ (progn
+ (window--resize-this-window
+ sub delta horizontal ignore t trail edge)
+ (if (and window (eq (window-parent sub) parent))
+ (progn
+ ;; Assign new normal sizes.
+ (set-window-new-normal
+ sub (/ (float (window-new-total sub)) parent-total))
+ (set-window-new-normal
+ window (- (window-normal-size window horizontal)
+ (- (window-new-normal sub)
+ (window-normal-size sub horizontal)))))
+ (window--resize-subwindows-normal
+ parent horizontal sub 0 trail delta))
+ ;; Return 'normalized to notify `window--resize-siblings' that
+ ;; normal sizes have been already set.
+ 'normalized)
+ ;; Resize all windows proportionally.
+ (setq sub first)
+ (while sub
+ (cond
+ ((or (window--resize-subwindows-skip-p sub)
+ ;; Ignore windows to skip and fixed-size subwindows - in
+ ;; the latter case make it a window to skip.
+ (and (not ignore)
+ (window-size-fixed-p sub horizontal)
+ (set-window-new-normal sub 'ignore))))
+ ((< delta 0)
+ ;; When shrinking store the number of lines/cols we can get
+ ;; from this window here together with the total/normal size
+ ;; factor.
+ (set-window-new-normal
+ sub
+ (cons
+ ;; We used to call this with NODOWN t, "fixed" 2011-05-11.
+ (window-min-delta sub horizontal ignore trail t) ; t)
+ (- (/ (float (window-total-size sub horizontal))
+ parent-total)
+ (window-normal-size sub horizontal)))))
+ ((> delta 0)
+ ;; When enlarging store the total/normal size factor only
+ (set-window-new-normal
+ sub
+ (- (/ (float (window-total-size sub horizontal))
+ parent-total)
+ (window-normal-size sub horizontal)))))
+
+ (setq sub (window-right sub)))
+
+ (cond
+ ((< delta 0)
+ ;; Shrink windows by delta.
+ (setq best-window t)
+ (while (and best-window (not (zerop delta)))
+ (setq sub first)
+ (setq best-window nil)
+ (setq best-value most-negative-fixnum)
+ (while sub
+ (when (and (consp (window-new-normal sub))
+ (not (zerop (car (window-new-normal sub))))
+ (> (cdr (window-new-normal sub)) best-value))
+ (setq best-window sub)
+ (setq best-value (cdr (window-new-normal sub))))
+
+ (setq sub (window-right sub)))
+
+ (when best-window
+ (setq delta (1+ delta)))
+ (set-window-new-total best-window -1 t)
+ (set-window-new-normal
+ best-window
+ (if (= (car (window-new-normal best-window)) 1)
+ 'skip ; We can't shrink best-window any further.
+ (cons (1- (car (window-new-normal best-window)))
+ (- (/ (float (window-new-total best-window))
+ parent-total)
+ (window-normal-size best-window horizontal)))))))
+ ((> delta 0)
+ ;; Enlarge windows by delta.
+ (setq best-window t)
+ (while (and best-window (not (zerop delta)))
+ (setq sub first)
+ (setq best-window nil)
+ (setq best-value most-positive-fixnum)
+ (while sub
+ (when (and (numberp (window-new-normal sub))
+ (< (window-new-normal sub) best-value))
+ (setq best-window sub)
+ (setq best-value (window-new-normal sub)))
+
+ (setq sub (window-right sub)))
+
+ (when best-window
+ (setq delta (1- delta)))
+ (set-window-new-total best-window 1 t)
+ (set-window-new-normal
+ best-window
+ (- (/ (float (window-new-total best-window))
+ parent-total)
+ (window-normal-size best-window horizontal))))))
+
+ (when best-window
+ (setq sub first)
+ (while sub
+ (when (or (consp (window-new-normal sub))
+ (numberp (window-new-normal sub)))
+ ;; Reset new normal size fields so `window-resize-apply'
+ ;; won't use them to apply new sizes.
+ (set-window-new-normal sub))
+
+ (unless (eq (window-new-normal sub) 'ignore)
+ ;; Resize this subwindow's subwindows (back-engineering
+ ;; delta from sub's old and new total sizes).
+ (let ((delta (- (window-new-total sub)
+ (window-total-size sub horizontal))))
+ (unless (and (zerop delta) (not trail))
+ ;; For the TRAIL non-nil case we have to resize SUB
+ ;; 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)))))))
+
+(defun window--resize-siblings (window delta &optional horizontal ignore trail edge)
+ "Resize other windows when WINDOW is resized vertically by DELTA lines.
+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
+imposed by fixed size windows, `window-min-height' or
+`window-min-width' settings. IGNORE equal `safe' means 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.
+
+Optional arguments TRAIL and EDGE, when non-nil, refine the set
+of windows that shall be resized. If TRAIL equals `before',
+resize only windows on the left or above EDGE. If TRAIL equals
+`after', resize only windows on the right or below EDGE. Also,
+preferably only resize windows adjacent to EDGE."
+ (when (window-parent window)
+ (let* ((parent (window-parent window))
+ (sub (window-child parent)))
+ (if (window-iso-combined-p sub horizontal)
+ ;; In an iso-combination try to extract DELTA from WINDOW's
+ ;; siblings.
+ (let ((first sub)
+ (skip (eq trail 'after))
+ this-delta other-delta)
+ ;; Decide which windows shall be left alone.
+ (while sub
+ (cond
+ ((eq sub window)
+ ;; Make sure WINDOW is left alone when
+ ;; resizing its siblings.
+ (set-window-new-normal sub 'ignore)
+ (setq skip (eq trail 'before)))
+ (skip
+ ;; Make sure this sibling is left alone when
+ ;; resizing its siblings.
+ (set-window-new-normal sub 'ignore))
+ ((or (window-size-ignore 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.
+ (setq this-delta t)))
+
+ (setq sub (window-right sub)))
+
+ ;; Set this-delta to what we can get from WINDOW's siblings.
+ (if (= (- delta) (window-total-size window horizontal))
+ ;; A deletion, presumably. We must handle this case
+ ;; specially since `window-resizable' can't be used.
+ (if this-delta
+ ;; There's at least one resizable sibling we can
+ ;; give WINDOW's size to.
+ (setq this-delta delta)
+ ;; No resizable sibling exists.
+ (setq this-delta 0))
+ ;; Any other form of resizing.
+ (setq this-delta
+ (window-resizable window delta horizontal ignore trail t)))
+
+ ;; Set other-delta to what we still have to get from
+ ;; ancestor windows of parent.
+ (setq other-delta (- delta this-delta))
+ (unless (zerop other-delta)
+ ;; Unless we got everything from WINDOW's siblings, PARENT
+ ;; must be resized by other-delta lines or columns.
+ (set-window-new-total parent other-delta 'add))
+
+ (if (zerop this-delta)
+ ;; We haven't got anything from WINDOW's siblings but we
+ ;; must update the normal sizes to respect other-delta.
+ (window--resize-subwindows-normal
+ parent horizontal window this-delta trail other-delta)
+ ;; We did get something from WINDOW's siblings which means
+ ;; we have to resize their subwindows.
+ (unless (eq (window--resize-subwindows
+ parent (- this-delta) horizontal
+ window ignore trail edge)
+ ;; If `window--resize-subwindows' returns
+ ;; 'normalized, this means it has set the
+ ;; normal sizes already.
+ 'normalized)
+ ;; Set the normal sizes.
+ (window--resize-subwindows-normal
+ parent horizontal window this-delta trail other-delta))
+ ;; Set DELTA to what we still have to get from ancestor
+ ;; windows.
+ (setq delta other-delta)))
+
+ ;; In an ortho-combination all siblings of WINDOW must be
+ ;; resized by DELTA.
+ (set-window-new-total parent delta 'add)
+ (while sub
+ (unless (eq sub window)
+ (window--resize-this-window sub delta horizontal ignore t))
+ (setq sub (window-right sub))))
+
+ (unless (zerop delta)
+ ;; "Go up."
+ (window--resize-siblings
+ parent delta horizontal ignore trail edge)))))
+
+(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge)
+ "Resize WINDOW vertically by DELTA lines.
+Optional argument HORIZONTAL non-nil means resize WINDOW
+horizontally by DELTA columns.
+
+Optional argument IGNORE non-nil means ignore any restrictions
+imposed by fixed size windows, `window-min-height' or
+`window-min-width' settings. IGNORE equal `safe' means 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.
+
+Optional argument ADD non-nil means add DELTA to the new total
+size of WINDOW.
+
+Optional arguments TRAIL and EDGE, when non-nil, refine the set
+of windows that shall be resized. If TRAIL equals `before',
+resize only windows on the left or above EDGE. If TRAIL equals
+`after', resize only windows on the right or below EDGE. Also,
+preferably only resize windows adjacent to EDGE.
+
+This function recursively resizes WINDOW's subwindows to fit the
+new size. Make sure that WINDOW is `window-resizable' before
+calling this function. Note that this function does not resize
+siblings of WINDOW or WINDOW's parent window. You have to
+eventually call `window-resize-apply' in order to make resizing
+actually take effect."
+ (when add
+ ;; Add DELTA to the new total size of WINDOW.
+ (set-window-new-total window delta t))
+
+ (let ((sub (window-child window)))
+ (cond
+ ((not sub))
+ ((window-iso-combined-p sub horizontal)
+ ;; In an iso-combination resize subwindows according to their
+ ;; normal sizes.
+ (window--resize-subwindows
+ window delta horizontal nil ignore trail edge))
+ ;; In an ortho-combination resize each subwindow by DELTA.
+ (t
+ (while sub
+ (window--resize-this-window
+ sub delta horizontal ignore t trail edge)
+ (setq sub (window-right sub)))))))
+
+(defun window--resize-root-window (window delta horizontal ignore)
+ "Resize root window WINDOW vertically by DELTA lines.
+HORIZONTAL non-nil means resize root window WINDOW horizontally
+by DELTA columns.
+
+IGNORE non-nil means ignore any restrictions imposed by fixed
+size windows, `window-min-height' or `window-min-width' settings.
+
+This function is only called by the frame resizing routines. It
+resizes windows proportionally and never deletes any windows."
+ (when (and (windowp window) (numberp delta)
+ (window-sizable-p window delta horizontal ignore))
+ (window--resize-reset (window-frame window) horizontal)
+ (window--resize-this-window window delta horizontal ignore t)))
+
+(defun window--resize-root-window-vertically (window delta)
+ "Resize root window WINDOW vertically by DELTA lines.
+If DELTA is less than zero and we can't shrink WINDOW by DELTA
+lines, shrink it as much as possible. If DELTA is greater than
+zero, this function can resize fixed-size subwindows in order to
+recover the necessary lines.
+
+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)))
+
+(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.
+
+If DELTA is greater zero, then 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-any-window window))
+ (let ((frame (window-frame window))
+ (right window)
+ left this-delta min-delta max-delta failed)
+ ;; Find the edge we want to move.
+ (while (and (or (not (window-iso-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)))
+ ((or (not (setq left right)) (not (setq right (window-right right))))
+ (if horizontal
+ (error "No window on the right of this one")
+ (error "No window below this one")))
+ (t
+ ;; Set LEFT to the first resizable window on the left. This step is
+ ;; needed to handle fixed-size windows.
+ (while (and left (window-size-fixed-p left horizontal))
+ (setq left
+ (or (window-left left)
+ (progn
+ (while (and (setq left (window-parent left))
+ (not (window-iso-combined-p left horizontal))))
+ (window-left left)))))
+ (unless left
+ (if horizontal
+ (error "No resizable window on the left of this one")
+ (error "No resizable window above this one")))
+
+ ;; Set RIGHT to the first resizable window on the right. This step
+ ;; is needed to handle fixed-size windows.
+ (while (and right (window-size-fixed-p right horizontal))
+ (setq right
+ (or (window-right right)
+ (progn
+ (while (and (setq right (window-parent right))
+ (not (window-iso-combined-p right horizontal))))
+ (window-right right)))))
+ (unless right
+ (if horizontal
+ (error "No resizable window on the right of this one")
+ (error "No resizable window below this one")))
+
+ ;; LEFT and RIGHT (which might be both internal windows) are now the
+ ;; two windows we want to resize.
+ (cond
+ ((> delta 0)
+ (setq max-delta (window-max-delta-1 left 0 horizontal nil 'after))
+ (setq min-delta (window-min-delta-1 right (- delta) horizontal nil 'before))
+ (when (or (< max-delta delta) (> min-delta (- delta)))
+ ;; We can't get the whole DELTA - move as far as possible.
+ (setq delta (min max-delta (- min-delta))))
+ (unless (zerop delta)
+ ;; Start resizing.
+ (window--resize-reset frame horizontal)
+ ;; Try to enlarge LEFT first.
+ (setq this-delta (window-resizable left delta horizontal))
+ (unless (zerop this-delta)
+ (window--resize-this-window
+ left this-delta horizontal nil t 'before
+ (if horizontal
+ (+ (window-left-column left) (window-total-size left t))
+ (+ (window-top-line left) (window-total-size left)))))
+ ;; Shrink windows on right of LEFT.
+ (window--resize-siblings
+ left delta horizontal nil 'after
+ (if horizontal
+ (window-left-column right)
+ (window-top-line right)))))
+ ((< delta 0)
+ (setq max-delta (window-max-delta-1 right 0 horizontal nil 'before))
+ (setq min-delta (window-min-delta-1 left delta horizontal nil 'after))
+ (when (or (< max-delta (- delta)) (> min-delta delta))
+ ;; We can't get the whole DELTA - move as far as possible.
+ (setq delta (max (- max-delta) min-delta)))
+ (unless (zerop delta)
+ ;; Start resizing.
+ (window--resize-reset frame horizontal)
+ ;; Try to enlarge RIGHT.
+ (setq this-delta (window-resizable right (- delta) horizontal))
+ (unless (zerop this-delta)
+ (window--resize-this-window
+ right this-delta horizontal nil t 'after
+ (if horizontal
+ (window-left-column right)
+ (window-top-line right))))
+ ;; Shrink windows on left of RIGHT.
+ (window--resize-siblings
+ right (- delta) horizontal nil 'before
+ (if horizontal
+ (+ (window-left-column left) (window-total-size left t))
+ (+ (window-top-line left) (window-total-size left)))))))
+ (unless (zerop delta)
+ ;; Don't report an error in the standard case.
+ (unless (window-resize-apply frame horizontal)
+ ;; But do report an error if applying the changes fails.
+ (error "Failed adjusting window %s" window)))))))
+
+(defun enlarge-window (delta &optional horizontal)
+ "Make 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."
+ (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))))
+
+(defun shrink-window (delta &optional horizontal)
+ "Make 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."
+ (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))))
+
+(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."
+ (interactive)
+ (setq window (window-normalize-any-window window))
+ (window-resize window (window-max-delta window))
+ (window-resize window (window-max-delta window t) t))
+
+(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."
+ (interactive)
+ (setq window (window-normalize-any-window window))
+ (window-resize window (- (window-min-delta window)))
+ (window-resize window (- (window-min-delta window t)) t))
+
+(defsubst frame-root-window-p (window)
+ "Return non-nil if WINDOW is the root window of its frame."
+ (eq window (frame-root-window window)))
+
+(defun window-tree-1 (window &optional next)
+ "Return window tree rooted at WINDOW.
+Optional argument NEXT non-nil means include windows right
+siblings in the return value.
+
+See the documentation of `window-tree' for a description of the
+return value."
+ (let (list)
+ (while window
+ (setq list
+ (cons
+ (cond
+ ((window-top-child window)
+ (cons t (cons (window-edges window)
+ (window-tree-1 (window-top-child window) t))))
+ ((window-left-child window)
+ (cons nil (cons (window-edges window)
+ (window-tree-1 (window-left-child window) t))))
+ (t window))
+ list))
+ (setq window (when next (window-next-sibling window))))
+ (nreverse list)))
+
+(defun window-tree (&optional frame)
+ "Return the window tree of frame FRAME.
+FRAME must be a live frame and defaults to the selected frame.
+The return value is a list of the form (ROOT MINI), where ROOT
+represents the window tree of the frame's root window, and MINI
+is the frame's minibuffer window.
+
+If the root window is not split, ROOT is the root window itself.
+Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil
+for a horizontal split, and t for a vertical split. EDGES gives
+the combined size and position of the subwindows in the split,
+and the rest of the elements are the subwindows in the split.
+Each of the subwindows may again be a window or a list
+representing a window split, and so on. EDGES is a list \(LEFT
+TOP RIGHT BOTTOM) as returned by `window-edges'."
+ (setq frame (window-normalize-frame frame))
+ (window-tree-1 (frame-root-window frame) t))
+
+(defun other-window (count &optional all-frames)
+ "Select another window in cyclic ordering of windows.
+COUNT specifies the number of windows to skip, starting with the
+selected window, before making the selection. If COUNT is
+positive, skip COUNT windows forwards. If COUNT is negative,
+skip -COUNT windows backwards. COUNT zero means do not skip any
+window, so select the selected window. In an interactive call,
+COUNT is the numeric prefix argument. Return nil.
+
+If the `other-window' parameter of WINDOW is a function and
+`ignore-window-parameters' is nil, call that function with the
+arguments COUNT and ALL-FRAMES.
+
+This function does not select a window whose `no-other-window'
+window parameter is non-nil.
+
+This function uses `next-window' for finding the window to
+select. The argument ALL-FRAMES has the same meaning as in
+`next-window', but the MINIBUF argument of `next-window' is
+always effectively nil."
+ (interactive "p")
+ (let* ((window (selected-window))
+ (function (and (not ignore-window-parameters)
+ (window-parameter window 'other-window)))
+ old-window old-count)
+ (if (functionp function)
+ (funcall function count all-frames)
+ ;; `next-window' and `previous-window' may return a window we are
+ ;; not allowed to select. Hence we need an exit strategy in case
+ ;; all windows are non-selectable.
+ (catch 'exit
+ (while (> count 0)
+ (setq window (next-window window nil all-frames))
+ (cond
+ ((eq window old-window)
+ (when (= count old-count)
+ ;; Keep out of infinite loops. When COUNT has not changed
+ ;; since we last looked at `window' we're probably in one.
+ (throw 'exit nil)))
+ ((window-parameter window 'no-other-window)
+ (unless old-window
+ ;; The first non-selectable window `next-window' got us:
+ ;; Remember it and the current value of COUNT.
+ (setq old-window window)
+ (setq old-count count)))
+ (t
+ (setq count (1- count)))))
+ (while (< count 0)
+ (setq window (previous-window window nil all-frames))
+ (cond
+ ((eq window old-window)
+ (when (= count old-count)
+ ;; Keep out of infinite loops. When COUNT has not changed
+ ;; since we last looked at `window' we're probably in one.
+ (throw 'exit nil)))
+ ((window-parameter window 'no-other-window)
+ (unless old-window
+ ;; The first non-selectable window `previous-window' got
+ ;; us: Remember it and the current value of COUNT.
+ (setq old-window window)
+ (setq old-count count)))
+ (t
+ (setq count (1+ count)))))
+
+ (select-window window)
+ ;; Always return nil.
+ nil))))
+
+;; This should probably return non-nil when the selected window is part
+;; of an atomic window whose root is the frame's root window.
+(defun one-window-p (&optional nomini all-frames)
+ "Return non-nil if the selected window is the only window.
+Optional arg NOMINI non-nil means don't count the minibuffer
+even if it is active. Otherwise, the minibuffer is counted
+when it is active.
-(defun balance-windows (&optional window-or-frame)
- "Make windows the same heights or widths in window split subtrees.
+Optional argument ALL-FRAMES specifies the set of frames to
+consider, see also `next-window'. ALL-FRAMES nil or omitted
+means consider windows on the selected frame only, plus the
+minibuffer window if specified by the NOMINI argument. If the
+minibuffer counts, consider all windows on all frames that share
+that minibuffer too. The remaining non-nil values of ALL-FRAMES
+with a special meaning are:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Anything else means consider all windows on the selected frame
+and no others."
+ (let ((base-window (selected-window)))
+ (if (and nomini (eq base-window (minibuffer-window)))
+ (setq base-window (next-window base-window)))
+ (eq base-window
+ (next-window base-window (if nomini 'arg) all-frames))))
+
+;;; Deleting windows.
+(defcustom frame-auto-delete 'automatic
+ "If non-nil, quitting a window can delete it's frame.
+If this variable is nil, functions that quit a window never
+delete the associated frame. If this variable equals the symbol
+`automatic', a frame is deleted only if it the window is
+dedicated or was created by `display-buffer'. If this variable
+is t, a frame can be always deleted, even if it was created by
+`make-frame-command'. Other values should not be used.
+
+Note that a frame will be effectively deleted if and only if
+another frame still exists.
+
+Functions quitting a window and consequently affected by this
+variable are `switch-to-prev-buffer', `delete-windows-on',
+`replace-buffer-in-windows' and `quit-restore-window'."
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Automatic" automatic)
+ (const :tag "Always" t))
+ :group 'windows
+ :group 'frames)
-When called non-interactively WINDOW-OR-FRAME may be either a
-window or a frame. It then balances the windows on the implied
-frame. If the parameter is a window only the corresponding window
-subtree is balanced."
+(defun window-deletable-p (&optional window)
+ "Return t if WINDOW can be safely deleted from its frame.
+Return `frame' if deleting WINDOW should delete its frame
+instead."
+ (setq window (window-normalize-any-window window))
+ (unless ignore-window-parameters
+ ;; Handle atomicity.
+ (when (window-parameter window 'window-atom)
+ (setq window (window-atom-root window))))
+ (let ((parent (window-parent window))
+ (frame (window-frame window))
+ (dedicated (and (window-buffer window) (window-dedicated-p window)))
+ (quit-restore (window-parameter window 'quit-restore)))
+ (cond
+ ((frame-root-window-p window)
+ (when (and (or (eq frame-auto-delete t)
+ (and (eq frame-auto-delete 'automatic)
+ (or dedicated
+ (and (eq (car-safe quit-restore) 'new-frame)
+ (eq (nth 1 quit-restore)
+ (window-buffer window))))))
+ (other-visible-frames-p frame))
+ ;; WINDOW is the root window of its frame. Return `frame' but
+ ;; only if WINDOW is (1) either dedicated or quit-restore's car
+ ;; is new-frame and the window still displays the same buffer
+ ;; and (2) there are other frames left.
+ 'frame))
+ ((and (not ignore-window-parameters)
+ (eq (window-parameter window 'window-side) 'none)
+ (or (not parent)
+ (not (eq (window-parameter parent 'window-side) 'none))))
+ ;; Can't delete last main window.
+ nil)
+ (t))))
+
+(defun window-or-subwindow-p (subwindow window)
+ "Return t if SUBWINDOW is either WINDOW or a subwindow of WINDOW."
+ (or (eq subwindow window)
+ (let ((parent (window-parent subwindow)))
+ (catch 'done
+ (while parent
+ (if (eq parent window)
+ (throw 'done t)
+ (setq parent (window-parent parent))))))))
+
+(defun delete-window (&optional window)
+ "Delete WINDOW.
+WINDOW can be an arbitrary 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
+parameters of WINDOW. Otherwise, if the `delete-window'
+parameter of WINDOW specifies a function, call that function with
+WINDOW as its sole argument and return the value returned by that
+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."
(interactive)
- (let (
- (wt (bw-get-tree window-or-frame))
- (w)
- (h)
- (tried-sizes)
- (last-sizes)
- (windows (window-list nil 0)))
- (when wt
- (while (not (member last-sizes tried-sizes))
- (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
- (setq last-sizes (mapcar (lambda (w)
- (window-edges w))
- windows))
- (when (eq 'hor (bw-dir wt))
- (setq w (- (bw-r wt) (bw-l wt))))
- (when (eq 'ver (bw-dir wt))
- (setq h (- (bw-b wt) (bw-t wt))))
- (bw-balance-sub wt w h)))))
-
-(defun bw-adjust-window (window delta horizontal)
- "Wrapper around `adjust-window-trailing-edge' with error checking.
-Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
- ;; `adjust-window-trailing-edge' may fail if delta is too large.
- (while (>= (abs delta) 1)
- (condition-case nil
- (progn
- (adjust-window-trailing-edge window delta horizontal)
- (setq delta 0))
- (error
- ;;(message "adjust: %s" (error-message-string err))
- (setq delta (/ delta 2))))))
+ (setq window (window-normalize-any-window window))
+ (let* ((frame (window-frame window))
+ (function (window-parameter window 'delete-window))
+ (parent (window-parent window))
+ atom-root)
+ (window-check frame)
+ (catch 'done
+ ;; Handle window parameters.
+ (cond
+ ;; Ignore window parameters if `ignore-window-parameters' tells
+ ;; us so or `delete-window' equals t.
+ ((or ignore-window-parameters (eq function t)))
+ ((functionp function)
+ ;; The `delete-window' parameter specifies the function to call.
+ ;; If that function is `ignore' nothing is done. It's up to the
+ ;; function called here to avoid infinite recursion.
+ (throw 'done (funcall function window)))
+ ((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"))
+ ((not parent)
+ (error "Attempt to delete minibuffer or sole ordinary window")))
+
+ (let* ((horizontal (window-left-child parent))
+ (size (window-total-size window horizontal))
+ (frame-selected
+ (window-or-subwindow-p (frame-selected-window frame) window))
+ ;; Emacs 23 preferably gives WINDOW's space to its left
+ ;; sibling.
+ (sibling (or (window-left window) (window-right window))))
+ (window--resize-reset frame horizontal)
+ (cond
+ ((and (not (window-splits window))
+ sibling (window-sizable-p sibling size))
+ ;; Resize WINDOW's sibling.
+ (window--resize-this-window sibling size horizontal nil t)
+ (set-window-new-normal
+ sibling (+ (window-normal-size sibling horizontal)
+ (window-normal-size window horizontal))))
+ ((window-resizable-p window (- size) horizontal nil nil nil t)
+ ;; Can do without resizing fixed-size windows.
+ (window--resize-siblings window (- size) horizontal))
+ (t
+ ;; Can't do without resizing fixed-size windows.
+ (window--resize-siblings window (- size) horizontal t)))
+ ;; Actually delete WINDOW.
+ (delete-window-internal window)
+ (when (and frame-selected
+ (window-parameter
+ (frame-selected-window frame) 'no-other-window))
+ ;; `delete-window-internal' has selected a window that should
+ ;; not be selected, fix this here.
+ (other-window -1 frame))
+ (run-window-configuration-change-hook frame)
+ (window-check frame)
+ ;; Always return nil.
+ nil))))
+
+(defun delete-other-windows (&optional window)
+ "Make WINDOW fill its frame.
+WINDOW may be any window and defaults to the selected one.
+Return nil.
+
+If the variable `ignore-window-parameters' is non-nil or the
+`delete-other-windows' parameter of WINDOW equals t, do not
+process any parameters of WINDOW. Otherwise, if the
+`delete-other-windows' parameter of WINDOW specifies a function,
+call that function with WINDOW as its sole argument and return
+the value returned by that function.
+
+Otherwise, if WINDOW is part of an atomic window, call this
+function with the root of the atomic window as its argument. If
+WINDOW is a non-side window, make WINDOW the only non-side window
+on the frame. Side windows are not deleted. If WINDOW is a side
+window signal an error."
+ (interactive)
+ (setq window (window-normalize-any-window window))
+ (let* ((frame (window-frame window))
+ (function (window-parameter window 'delete-other-windows))
+ (window-side (window-parameter window 'window-side))
+ atom-root side-main)
+ (window-check frame)
+ (catch 'done
+ (cond
+ ;; Ignore window parameters if `ignore-window-parameters' is t or
+ ;; `delete-other-windows' is t.
+ ((or ignore-window-parameters (eq function t)))
+ ((functionp function)
+ ;; The `delete-other-windows' parameter specifies the function
+ ;; to call. If the function is `ignore' no windows are deleted.
+ ;; It's up to the function called to avoid infinite recursion.
+ (throw 'done (funcall function window)))
+ ((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 nil t)))
+ ((memq window-side window-sides)
+ (error "Cannot make side window the only window")))
+ ;; If WINDOW is the main non-side window, do nothing.
+ (unless (eq window side-main)
+ (delete-other-windows-internal window side-main)
+ (run-window-configuration-change-hook frame)
+ (window-check frame))
+ ;; Always return nil.
+ nil)))
+
+(defun delete-other-windows-vertically (&optional window)
+ "Delete the windows in the same column with WINDOW, but not WINDOW itself.
+This may be a useful alternative binding for \\[delete-other-windows]
+ if you often split windows horizontally."
+ (interactive)
+ (let* ((window (or window (selected-window)))
+ (edges (window-edges window))
+ (w window) delenda)
+ (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)))
+ (push w delenda))))
+ (mapc 'delete-window delenda)))
+
+;;; Windows and buffers.
+
+;; `prev-buffers' and `next-buffers' are two reserved window slots used
+;; for (1) determining which buffer to show in the window when its
+;; buffer shall be buried or killed and (2) which buffer to show for
+;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
+
+;; `prev-buffers' consists of <buffer, window-start, window-point>
+;; triples. The entries on this list are ordered by the time their
+;; buffer has been removed from the window, the most recently removed
+;; buffer's entry being first. The window-start and window-point
+;; components are `window-start' and `window-point' at the time the
+;; buffer was removed from the window which implies that the entry must
+;; be added when `set-window-buffer' removes the buffer from the window.
+
+;; `next-buffers' is the list of buffers that have been replaced
+;; recently by `switch-to-prev-buffer'. These buffers are the least
+;; preferred candidates of `switch-to-prev-buffer' and the preferred
+;; candidates of `switch-to-next-buffer' to switch to. This list is
+;; reset to nil by any action changing the window's buffer with the
+;; exception of `switch-to-prev-buffer' and `switch-to-next-buffer'.
+;; `switch-to-prev-buffer' pushes the buffer it just replaced on it,
+;; `switch-to-next-buffer' pops the last pushed buffer from it.
+
+;; Both `prev-buffers' and `next-buffers' may reference killed buffers
+;; if such a buffer was killed while the window was hidden within a
+;; window configuration. Such killed buffers get removed whenever
+;; `switch-to-prev-buffer' or `switch-to-next-buffer' encounter them.
+
+;; The following function is called by `set-window-buffer' _before_ it
+;; replaces the buffer of the argument window with the new buffer.
+(defun record-window-buffer (&optional window)
+ "Record WINDOW's buffer.
+WINDOW must be a live window and defaults to the selected one."
+ (let* ((window (window-normalize-live-window window))
+ (buffer (window-buffer window))
+ (entry (assq buffer (window-prev-buffers window))))
+ ;; Reset WINDOW's next buffers. If needed, they are resurrected by
+ ;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
+ (set-window-next-buffers window nil)
+
+ (when entry
+ ;; Remove all entries for BUFFER from WINDOW's previous buffers.
+ (set-window-prev-buffers
+ window (assq-delete-all buffer (window-prev-buffers window))))
+
+ ;; Don't record insignificant buffers.
+ (unless (eq (aref (buffer-name buffer) 0) ?\s)
+ ;; Add an entry for buffer to WINDOW's previous buffers.
+ (with-current-buffer buffer
+ (let ((start (window-start window))
+ (point (window-point window)))
+ (setq entry
+ (cons buffer
+ (if entry
+ ;; We have an entry, update marker positions.
+ (list (set-marker (nth 1 entry) start)
+ (set-marker (nth 2 entry) point))
+ ;; Make new markers.
+ (list (copy-marker start)
+ (copy-marker point)))))
+
+ (set-window-prev-buffers
+ window (cons entry (window-prev-buffers window))))))))
+
+(defun unrecord-window-buffer (&optional window buffer)
+ "Unrecord BUFFER in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+BUFFER must be a live buffer and defaults to the buffer of
+WINDOW."
+ (let* ((window (window-normalize-live-window window))
+ (buffer (or buffer (window-buffer window))))
+ (set-window-prev-buffers
+ window (assq-delete-all buffer (window-prev-buffers window)))
+ (set-window-next-buffers
+ window (delq buffer (window-next-buffers window)))))
+
+(defun set-window-buffer-start-and-point (window buffer &optional start point)
+ "Set WINDOW's buffer to BUFFER.
+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."
+ (let ((selected (eq window (selected-window)))
+ (current (eq (window-buffer window) (current-buffer))))
+ (set-window-buffer window buffer)
+ (when (and selected current)
+ (set-buffer buffer))
+ (when start
+ (set-window-start window start))
+ (when point
+ (if selected
+ (with-current-buffer buffer
+ (goto-char point))
+ (set-window-point window point)))))
+
+(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.
+
+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."
+ (interactive)
+ (let* ((window (window-normalize-live-window window))
+ (old-buffer (window-buffer window))
+ ;; Save this since it's destroyed by `set-window-buffer'.
+ (next-buffers (window-next-buffers window))
+ entry new-buffer killed-buffers deletable visible)
+ (cond
+ ;; When BURY-OR-KILL is non-nil, there's no previous buffer for
+ ;; this window, and we can delete the window (or the frame) do
+ ;; that.
+ ((and bury-or-kill
+ (or (not (window-prev-buffers window))
+ (and (eq (caar (window-prev-buffers window)) old-buffer)
+ (not (cdr (car (window-prev-buffers window))))))
+ (setq deletable (window-deletable-p window)))
+ (if (eq deletable 'frame)
+ (delete-frame (window-frame window))
+ (delete-window window)))
+ ((window-dedicated-p window)
+ (error "Window %s is dedicated to buffer %s" window old-buffer)))
+
+ (unless deletable
+ (catch 'found
+ ;; Scan WINDOW's previous buffers first, skipping entries of next
+ ;; buffers.
+ (dolist (entry (window-prev-buffers window))
+ (when (and (setq new-buffer (car entry))
+ (or (buffer-live-p new-buffer)
+ (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)))
+ ;; 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
+ ;; a buried buffer instead. Otherwise, we must reverse the global
+ ;; 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)))))
+ (when (and (buffer-live-p buffer)
+ (not (eq buffer old-buffer))
+ (not (eq (aref (buffer-name buffer) 0) ?\s))
+ (or bury-or-kill (not (memq buffer next-buffers))))
+ (if (get-buffer-window buffer)
+ ;; Try to avoid showing a buffer visible in some other window.
+ (setq visible buffer)
+ (setq new-buffer buffer)
+ (set-window-buffer-start-and-point window new-buffer)
+ (throw 'found t))))
+ (unless bury-or-kill
+ ;; Scan reverted next buffers last (must not use nreverse
+ ;; here!).
+ (dolist (buffer (reverse next-buffers))
+ ;; Actually, buffer _must_ be live here since otherwise it
+ ;; would have been caught in the scan of previous buffers.
+ (when (and (or (buffer-live-p buffer)
+ (not (setq killed-buffers
+ (cons buffer killed-buffers))))
+ (not (eq buffer old-buffer))
+ (setq entry (assq buffer (window-prev-buffers window))))
+ (setq new-buffer 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
+ (setq new-buffer visible)
+ (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
+ (set-window-prev-buffers
+ window (assq-delete-all old-buffer (window-prev-buffers window)))
+ (set-window-next-buffers window (delq old-buffer next-buffers)))
+ ;; Move `old-buffer' to head of WINDOW's restored list of next
+ ;; buffers.
+ (set-window-next-buffers
+ window (cons old-buffer (delq old-buffer next-buffers)))))
+
+ ;; Remove killed buffers from WINDOW's previous and next buffers.
+ (when killed-buffers
+ (dolist (buffer killed-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)))))
+
+ ;; Return new-buffer.
+ new-buffer))
+
+(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."
+ (interactive)
+ (let* ((window (window-normalize-live-window window))
+ (old-buffer (window-buffer window))
+ (next-buffers (window-next-buffers window))
+ new-buffer entry killed-buffers visible)
+ (when (window-dedicated-p window)
+ (error "Window %s is dedicated to buffer %s" window old-buffer))
+
+ (catch 'found
+ ;; Scan WINDOW's next buffers first.
+ (dolist (buffer next-buffers)
+ (when (and (or (buffer-live-p buffer)
+ (not (setq killed-buffers
+ (cons buffer killed-buffers))))
+ (not (eq buffer old-buffer))
+ (setq entry (assq buffer (window-prev-buffers window))))
+ (setq new-buffer buffer)
+ (set-window-buffer-start-and-point
+ window new-buffer (nth 1 entry) (nth 2 entry))
+ (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))
+ (not (eq (aref (buffer-name buffer) 0) ?\s))
+ (not (assq buffer (window-prev-buffers window))))
+ (if (get-buffer-window buffer)
+ ;; Try to avoid showing a buffer visible in some other window.
+ (setq visible buffer)
+ (setq new-buffer buffer)
+ (set-window-buffer-start-and-point window new-buffer)
+ (throw 'found t))))
+ ;; Scan WINDOW's reverted previous buffers last (must not use
+ ;; nreverse here!)
+ (dolist (entry (reverse (window-prev-buffers window)))
+ (when (and (setq new-buffer (car entry))
+ (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)))
+
+ ;; Show a buffer visible in another window.
+ (when visible
+ (setq new-buffer visible)
+ (set-window-buffer-start-and-point window new-buffer)))
+
+ ;; Remove `new-buffer' from and restore WINDOW's next buffers.
+ (set-window-next-buffers window (delq new-buffer next-buffers))
+
+ ;; Remove killed buffers from WINDOW's previous and next buffers.
+ (when killed-buffers
+ (dolist (buffer killed-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)))))
+
+ ;; Return new-buffer.
+ new-buffer))
+
+(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
+ "Search LIST for a valid buffer to display in FRAME.
+Return nil when all buffers in LIST are undesirable for display,
+otherwise return the first suitable buffer in LIST.
+
+Buffers not visible in windows are preferred to visible buffers,
+unless VISIBLE-OK is non-nil.
+If the optional argument FRAME is nil, it defaults to the selected frame.
+If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
+ ;; This logic is more or less copied from other-buffer.
+ (setq frame (or frame (selected-frame)))
+ (let ((pred (frame-parameter frame 'buffer-predicate))
+ found buf)
+ (while (and (not found) list)
+ (setq buf (car list))
+ (if (and (not (eq buffer buf))
+ (buffer-live-p buf)
+ (or (null pred) (funcall pred buf))
+ (not (eq (aref (buffer-name buf) 0) ?\s))
+ (or visible-ok (null (get-buffer-window buf 'visible))))
+ (setq found buf)
+ (setq list (cdr list))))
+ (car list)))
+
+(defun last-buffer (&optional buffer visible-ok frame)
+ "Return the last buffer in FRAME's buffer list.
+If BUFFER is the last buffer, return the preceding buffer
+instead. Buffers not visible in windows are preferred to visible
+buffers, unless optional argument VISIBLE-OK is non-nil.
+Optional third argument FRAME nil or omitted means use the
+selected frame's buffer list. If no such buffer exists, return
+the buffer `*scratch*', creating it if necessary."
+ (setq frame (or frame (selected-frame)))
+ (or (get-next-valid-buffer (nreverse (buffer-list frame))
+ buffer visible-ok frame)
+ (get-buffer "*scratch*")
+ (let ((scratch (get-buffer-create "*scratch*")))
+ (set-buffer-major-mode scratch)
+ scratch)))
+
+(defun bury-buffer (&optional buffer-or-name)
+ "Put BUFFER-OR-NAME at the end of the list of all buffers.
+There it is the least likely candidate for `other-buffer' to
+return; thus, the least likely buffer for \\[switch-to-buffer] to
+select by default.
+
+You can specify a buffer name as BUFFER-OR-NAME, or an actual
+buffer object. If BUFFER-OR-NAME is nil or omitted, bury the
+current buffer. Also, if BUFFER-OR-NAME is nil or omitted,
+remove the current buffer from the selected window if it is
+displayed there."
+ (interactive)
+ (let* ((buffer (window-normalize-buffer buffer-or-name)))
+ ;; If `buffer-or-name' is not on the selected frame we unrecord it
+ ;; although it's not "here" (call it a feature).
+ (unrecord-buffer buffer)
+ ;; Handle case where `buffer-or-name' is nil and the current buffer
+ ;; is shown in the selected window.
+ (cond
+ ((or buffer-or-name (not (eq buffer (window-buffer)))))
+ ((not (window-dedicated-p))
+ (switch-to-prev-buffer nil 'bury))
+ ((and (frame-root-window-p (selected-window))
+ ;; Don't iconify if it's the only frame.
+ (not (eq (next-frame nil 0) (selected-frame))))
+ (iconify-frame (window-frame (selected-window))))
+ ((window-deletable-p)
+ (delete-window)))
+ ;; Always return nil.
+ nil))
+
+(defun unbury-buffer ()
+ "Switch to the last buffer in the buffer list."
+ (interactive)
+ (switch-to-buffer (last-buffer)))
+
+(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))
+
+(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))
+
+(defun delete-windows-on (&optional buffer-or-name frame)
+ "Delete all windows showing BUFFER-OR-NAME.
+BUFFER-OR-NAME may be a buffer or the name of an existing buffer
+and defaults to the current buffer.
+
+The following non-nil values of the optional argument FRAME
+have special meanings:
+
+- t means consider all windows on the selected frame only.
+
+- `visible' means consider all windows on all visible frames on
+ the current terminal.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames on the current terminal.
+
+- A frame means consider all windows on that frame only.
+
+Any other value of FRAME means consider all windows on all
+frames.
+
+When a window showing BUFFER-OR-NAME is dedicated and the only
+window of its frame, that frame is deleted when there are other
+frames left."
+ (interactive "BDelete windows on (buffer):\nP")
+ (let ((buffer (window-normalize-buffer buffer-or-name))
+ ;; Handle the "inverted" meaning of the FRAME argument wrt other
+ ;; `window-list-1' based function.
+ (all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
+ (dolist (window (window-list-1 nil nil all-frames))
+ (if (eq (window-buffer window) buffer)
+ (let ((deletable (window-deletable-p window)))
+ (cond
+ ((eq deletable 'frame)
+ ;; Delete frame.
+ (delete-frame (window-frame window)))
+ (deletable
+ ;; Delete window only.
+ (delete-window window))
+ (t
+ ;; In window switch to previous buffer.
+ (set-window-dedicated-p window nil)
+ (switch-to-prev-buffer window 'bury))))
+ ;; If a window doesn't show BUFFER, unrecord BUFFER in it.
+ (unrecord-window-buffer window buffer)))))
+
+(defun replace-buffer-in-windows (&optional buffer-or-name)
+ "Replace BUFFER-OR-NAME with some other buffer in all windows showing it.
+BUFFER-OR-NAME may be a buffer or the name of an existing buffer
+and defaults to the current buffer.
+
+When a window showing BUFFER-OR-NAME is either dedicated, or the
+window has no previous buffer, that window is deleted. If that
+window is the only window on its frame, the frame is deleted too
+when there are other frames left. If there are no other frames
+left, some other buffer is displayed in that window.
+
+This function removes the buffer denoted by BUFFER-OR-NAME from
+all window-local buffer lists."
+ (let ((buffer (window-normalize-buffer buffer-or-name)))
+ (dolist (window (window-list-1 nil nil t))
+ (if (eq (window-buffer window) buffer)
+ (let ((deletable (window-deletable-p window)))
+ (cond
+ ((eq deletable 'frame)
+ ;; Delete frame.
+ (delete-frame (window-frame window)))
+ ((and (window-dedicated-p window) deletable)
+ ;; Delete window.
+ (delete-window window))
+ (t
+ ;; Switch to another buffer in window.
+ (set-window-dedicated-p window nil)
+ (switch-to-prev-buffer window 'kill))))
+ ;; Unrecord BUFFER in WINDOW.
+ (unrecord-window-buffer window buffer)))))
+
+(defun quit-restore-window (&optional window kill)
+ "Quit WINDOW in some way.
+WINDOW must be a live window and defaults to the selected window.
+Return nil.
+
+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.
+
+Optional argument KILL non-nil means in addition kill WINDOW's
+buffer. If KILL is nil, put WINDOW's buffer at the end of the
+buffer list. Interactively, KILL is the prefix argument."
+ (interactive "i\nP")
+ (setq window (window-normalize-live-window window))
+ (let ((buffer (window-buffer window))
+ (quit-restore (window-parameter window 'quit-restore))
+ deletable resize)
+ (cond
+ ((and (or (and (memq (car-safe quit-restore) '(new-window new-frame))
+ ;; Check that WINDOW's buffer is still the same.
+ (eq (window-buffer window) (nth 1 quit-restore)))
+ (window-dedicated-p window))
+ (setq deletable (window-deletable-p window)))
+ ;; WINDOW can be deleted.
+ (unrecord-buffer buffer)
+ (if (eq deletable 'frame)
+ ;; WINDOW's frame can be deleted.
+ (delete-frame (window-frame window))
+ ;; Just delete WINDOW.
+ (delete-window window))
+ ;; If the previously selected window is still alive, select it.
+ (when (window-live-p (nth 2 quit-restore))
+ (select-window (nth 2 quit-restore))))
+ ((and (buffer-live-p (nth 0 quit-restore))
+ ;; The buffer currently shown in WINDOW must still be the
+ ;; buffer shown when its `quit-restore' parameter was created
+ ;; in the first place.
+ (eq (window-buffer window) (nth 3 quit-restore)))
+ (setq resize (with-current-buffer buffer temp-buffer-resize-mode))
+ ;; Unrecord buffer.
+ (unrecord-buffer buffer)
+ (unrecord-window-buffer window buffer)
+ ;; Display buffer stored in the quit-restore parameter.
+ (set-window-dedicated-p window nil)
+ (set-window-buffer window (nth 0 quit-restore))
+ (set-window-start window (nth 1 quit-restore))
+ (set-window-point window (nth 2 quit-restore))
+ (when (and resize (/= (nth 4 quit-restore) (window-total-size window)))
+ (window-resize
+ window (- (nth 4 quit-restore) (window-total-size window))))
+ ;; Reset the quit-restore parameter.
+ (set-window-parameter window 'quit-restore nil)
+ (when (window-live-p (nth 5 quit-restore))
+ (select-window (nth 5 quit-restore))))
+ (t
+ ;; Otherwise, show another buffer in WINDOW and reset the
+ ;; quit-restore parameter.
+ (set-window-parameter window 'quit-restore nil)
+ (unrecord-buffer buffer)
+ (switch-to-prev-buffer window 'bury-or-kill)))
+
+ ;; Kill WINDOW's old-buffer if requested
+ (when kill (kill-buffer buffer))
+ nil))
+
+;;; Splitting windows.
+(defsubst window-split-min-size (&optional horizontal)
+ "Return minimum height of any window when splitting windows.
+Optional argument HORIZONTAL non-nil means return minimum width."
+ (if horizontal
+ (max window-min-width window-safe-min-width)
+ (max window-min-height window-safe-min-height)))
+
+(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.
+Return the new window which is always a live window.
+
+Optional argument SIZE a positive number means make WINDOW SIZE
+lines or columns tall. If SIZE is negative, make the new window
+-SIZE lines or columns tall. If and only if SIZE is non-nil, its
+absolute value can be less than `window-min-height' or
+`window-min-width'; so this command can make a new window as
+small as one line or two columns. SIZE defaults to half of
+WINDOW's size. Interactively, SIZE is the prefix argument.
+
+Optional third argument SIDE nil (or `below') specifies that the
+new window shall be located below WINDOW. SIDE `above' means the
+new window shall be located above WINDOW. In both cases SIZE
+specifies the new number of lines for WINDOW \(or the new window
+if SIZE is negative) including space reserved for the mode and/or
+header line.
+
+SIDE t (or `right') specifies that the new window shall be
+located on the right side of WINDOW. SIDE `left' means the new
+window shall be located on the left of WINDOW. In both cases
+SIZE specifies the new number of columns for WINDOW \(or the new
+window provided SIZE is negative) including space reserved for
+fringes and the scrollbar or a divider column. Any other non-nil
+value for SIDE is currently handled like t (or `right').
+
+If the variable `ignore-window-parameters' is non-nil or the
+`split-window' parameter of WINDOW equals t, do not process any
+parameters of WINDOW. Otherwise, if the `split-window' parameter
+of WINDOW specifies a function, call that function with all three
+arguments and return the value returned by that function.
+
+Otherwise, if WINDOW is part of an atomic window, \"split\" the
+root of that atomic window. The new window does not become a
+member of that atomic window.
+
+If WINDOW is live, properties of the new window like margins and
+scrollbars are inherited from WINDOW. If WINDOW is an internal
+window, these properties as well as the buffer displayed in the
+new window are inherited from the window selected on WINDOW's
+frame. The selected window is not changed by this function."
+ (interactive "i")
+ (setq window (window-normalize-any-window window))
+ (let* ((side (cond
+ ((not side) 'below)
+ ((memq side '(below above right left)) side)
+ (t 'right)))
+ (horizontal (not (memq side '(nil 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-nest' since in some cases we may have to
+ ;; override its value.
+ (window-nest window-nest)
+ atom-root)
+
+ (window-check frame)
+ (catch 'done
+ (cond
+ ;; Ignore window parameters if either `ignore-window-parameters'
+ ;; is t or the `split-window' parameter equals t.
+ ((or ignore-window-parameters (eq function t)))
+ ((functionp function)
+ ;; The `split-window' parameter specifies the function to call.
+ ;; If that function is `ignore', do nothing.
+ (throw 'done (funcall function window size side)))
+ ;; If WINDOW is a subwindow of an atomic window, split the root
+ ;; window of that atomic window instead.
+ ((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-nest' to t.
+ (setq window-nest t))
+
+ (when (and window-splits size (> size 0))
+ ;; If `window-splits' is non-nil and SIZE is a non-negative
+ ;; integer, we cannot reasonably resize other windows. Rather
+ ;; bind `window-nest' to t to make sure that subsequent window
+ ;; deletions are handled correctly.
+ (setq window-nest t))
+
+ (let* ((parent-size
+ ;; `parent-size' is the size of WINDOW's parent, provided
+ ;; it has one.
+ (when parent (window-total-size parent horizontal)))
+ ;; `resize' non-nil means we are supposed to resize other
+ ;; windows in WINDOW's combination.
+ (resize
+ (and window-splits (not window-nest)
+ ;; Resize makes sense in iso-combinations only.
+ (window-iso-combined-p window horizontal)))
+ ;; `old-size' is the current size of WINDOW.
+ (old-size (window-total-size window horizontal))
+ ;; `new-size' is the specified or calculated size of the
+ ;; new window.
+ (new-size
+ (cond
+ ((not size)
+ (max (window-split-min-size horizontal)
+ (if resize
+ ;; When resizing try to give the new window the
+ ;; average size of a window in its combination.
+ (min (- parent-size
+ (window-min-size parent horizontal))
+ (/ parent-size
+ (1+ (window-iso-combinations
+ parent horizontal))))
+ ;; Else try to give the new window half the size
+ ;; of WINDOW (plus an eventual odd line).
+ (+ (/ old-size 2) (% old-size 2)))))
+ ((>= size 0)
+ ;; SIZE non-negative specifies the new size of WINDOW.
+
+ ;; Note: Specifying a non-negative SIZE is practically
+ ;; always done as workaround for making the new window
+ ;; appear above or on the left of the new window (the
+ ;; ispell window is a typical example of that). In all
+ ;; these cases the SIDE argument should be set to 'above
+ ;; or 'left in order to support the 'resize option.
+ ;; Here we have to nest the windows instead, see above.
+ (- old-size size))
+ (t
+ ;; SIZE negative specifies the size of the new window.
+ (- size))))
+ new-parent new-normal)
+
+ ;; Check SIZE.
+ (cond
+ ((not size)
+ (cond
+ (resize
+ ;; SIZE unspecified, resizing.
+ (when (and (not (window-sizable-p parent (- new-size) horizontal))
+ ;; Try again with minimum split size.
+ (setq new-size
+ (max new-size (window-split-min-size horizontal)))
+ (not (window-sizable-p parent (- new-size) horizontal)))
+ (error "Window %s too small for splitting" parent)))
+ ((> (+ new-size (window-min-size window horizontal)) old-size)
+ ;; SIZE unspecified, no resizing.
+ (error "Window %s too small for splitting" window))))
+ ((and (>= size 0)
+ (or (>= size old-size)
+ (< new-size (if horizontal
+ window-safe-min-width
+ window-safe-min-width))))
+ ;; SIZE specified as new size of old window. If the new size
+ ;; is larger than the old size or the size of the new window
+ ;; would be less than the safe minimum, signal an error.
+ (error "Window %s too small for splitting" window))
+ (resize
+ ;; SIZE specified, resizing.
+ (unless (window-sizable-p parent (- new-size) horizontal)
+ ;; If we cannot resize the parent give up.
+ (error "Window %s too small for splitting" parent)))
+ ((or (< new-size
+ (if horizontal window-safe-min-width window-safe-min-height))
+ (< (- old-size new-size)
+ (if horizontal window-safe-min-width window-safe-min-height)))
+ ;; SIZE specification violates minimum size restrictions.
+ (error "Window %s too small for splitting" window)))
+
+ (window--resize-reset frame horizontal)
+
+ (setq new-parent
+ ;; 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-nest (not (window-iso-combined-p window horizontal))))
+ (setq new-normal
+ ;; Make new-normal the normal size of the new window.
+ (cond
+ (size (/ (float new-size) (if new-parent old-size parent-size)))
+ (new-parent 0.5)
+ (resize (/ 1.0 (1+ (window-iso-combinations parent horizontal))))
+ (t (/ (window-normal-size window horizontal) 2.0))))
+
+ (if resize
+ ;; Try to get space from OLD's siblings. We could go "up" and
+ ;; try getting additional space from surrounding windows but
+ ;; we won't be able to return space to those windows when we
+ ;; delete the one we create here. Hence we do not go up.
+ (progn
+ (window--resize-subwindows parent (- new-size) horizontal)
+ (let* ((normal (- 1.0 new-normal))
+ (sub (window-child parent)))
+ (while sub
+ (set-window-new-normal
+ sub (* (window-normal-size sub horizontal) normal))
+ (setq sub (window-right sub)))))
+ ;; Get entire space from WINDOW.
+ (set-window-new-total window (- old-size new-size))
+ (window--resize-this-window window (- new-size) horizontal)
+ (set-window-new-normal
+ window (- (if new-parent 1.0 (window-normal-size window horizontal))
+ 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))
+
+ (run-window-configuration-change-hook frame)
+ (window-check frame)
+ ;; Always return the new window.
+ new)))))
+
+;; I think this should be the default; I think people will prefer it--rms.
+(defcustom split-window-keep-point t
+ "If non-nil, \\[split-window-above-each-other] keeps the original point \
+in both children.
+This is often more convenient for editing.
+If nil, adjust point in each of the two windows to minimize redisplay.
+This is convenient on slow terminals, but point can move strangely.
+
+This option applies only to `split-window-above-each-other' and
+functions that call it. `split-window' always keeps the original
+point in both children."
+ :type 'boolean
+ :group 'windows)
+
+(defun split-window-above-each-other (&optional size)
+ "Split selected window into two windows, one above the other.
+The upper window gets SIZE lines and the lower one gets the rest.
+SIZE negative means the lower window gets -SIZE lines and the
+upper one the rest. With no argument, split windows equally or
+close to it. Both windows display the same buffer, now current.
+
+If the variable `split-window-keep-point' is non-nil, both new
+windows will get the same value of point as the selected window.
+This is often more convenient for editing. The upper window is
+the selected window.
+
+Otherwise, we choose window starts so as to minimize the amount of
+redisplay; this is convenient on slow terminals. The new selected
+window is the one that the current value of point appears in. The
+value of point can change if the text around point is hidden by the
+new mode line.
+
+Regardless of the value of `split-window-keep-point', the upper
+window is the original one and the return value is the new, lower
+window."
+ (interactive "P")
+ (let ((old-window (selected-window))
+ (old-point (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))
+ ;; `split-window' would not signal an error here.
+ (error "Size of new window too small"))
+ (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)))
+ ;; Always copy quit-restore parameter in interactive use.
+ (let ((quit-restore (window-parameter old-window 'quit-restore)))
+ (when quit-restore
+ (set-window-parameter new-window 'quit-restore quit-restore)))
+ new-window))
+
+(defalias 'split-window-vertically 'split-window-above-each-other)
-(defun bw-balance-sub (wt w h)
- (setq wt (bw-refresh-edges wt))
- (unless w (setq w (- (bw-r wt) (bw-l wt))))
- (unless h (setq h (- (bw-b wt) (bw-t wt))))
- (if (windowp wt)
- (progn
- (when w
- (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
- (when (/= 0 dw)
- (bw-adjust-window wt dw t))))
- (when h
- (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
- (when (/= 0 dh)
- (bw-adjust-window wt dh nil)))))
- (let* ((childs (cdr (assq 'childs wt)))
- (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
- (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
- (dolist (c childs)
- (bw-balance-sub c cw ch)))))
+(defun split-window-side-by-side (&optional size)
+ "Split selected window into two windows side by side.
+The selected window becomes the left one and gets SIZE columns.
+SIZE negative means the right window gets -SIZE lines.
+
+SIZE includes the width of the window's scroll bar; if there are
+no scroll bars, it includes the width of the divider column to
+the window's right, if any. SIZE omitted or nil means split
+window equally.
+
+The selected window remains selected. Return the new window."
+ (interactive "P")
+ (let ((old-window (selected-window))
+ (size (and size (prefix-numeric-value size)))
+ new-window)
+ (when (and size (< size 0) (< (- size) window-min-width))
+ ;; `split-window' would not signal an error here.
+ (error "Size of new window too small"))
+ (setq new-window (split-window nil size t))
+ ;; Always copy quit-restore parameter in interactive use.
+ (let ((quit-restore (window-parameter old-window 'quit-restore)))
+ (when quit-restore
+ (set-window-parameter new-window 'quit-restore quit-restore)))
+ new-window))
+
+(defalias 'split-window-horizontally 'split-window-side-by-side)
+
+;;; Balancing windows.
+
+;; The following routine uses the recycled code from an old version of
+;; `window--resize-subwindows'. It's not very pretty, but coding it the way the
+;; new `window--resize-subwindows' code does would hardly make it any shorter or
+;; more readable (FWIW we'd need three loops - one to calculate the
+;; minimum sizes per window, one to enlarge or shrink windows until the
+;; new parent-size matches, and one where we shrink the largest/enlarge
+;; the smallest window).
+(defun balance-windows-2 (window horizontal)
+ "Subroutine of `balance-windows-1'.
+WINDOW must be an iso-combination."
+ (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)
+ (while sub
+ (setq number-of-children (1+ number-of-children))
+ (when (window-size-fixed-p sub horizontal)
+ (setq total-sum
+ (- total-sum (window-total-size sub horizontal)))
+ (set-window-new-normal sub 'ignore))
+ (setq sub (window-right sub)))
+
+ (setq failed t)
+ (while (and failed (> number-of-children 0))
+ (setq size (/ total-sum number-of-children))
+ (setq failed nil)
+ (setq sub first)
+ (while (and sub (not failed))
+ ;; Ignore subwindows that should be ignored or are stuck.
+ (unless (window--resize-subwindows-skip-p sub)
+ (setq found t)
+ (setq sub-total (window-total-size sub horizontal))
+ (setq sub-delta (- size sub-total))
+ (setq sub-amount
+ (window-sizable sub sub-delta horizontal))
+ ;; Register the new total size for this subwindow.
+ (set-window-new-total sub (+ sub-total sub-amount))
+ (unless (= sub-amount sub-delta)
+ (setq total-sum (- total-sum sub-total sub-amount))
+ (setq number-of-children (1- number-of-children))
+ ;; We failed and need a new round.
+ (setq failed t)
+ (set-window-new-normal sub 'skip)))
+ (setq sub (window-right sub))))
+
+ (setq rest (% total-sum number-of-children))
+ ;; Fix rounding by trying to enlarge non-stuck windows by one line
+ ;; (column) until `rest' is zero.
+ (setq sub first)
+ (while (and sub (> rest 0))
+ (unless (window--resize-subwindows-skip-p window)
+ (set-window-new-total sub 1 t)
+ (setq rest (1- rest)))
+ (setq sub (window-right sub)))
+
+ ;; Fix rounding by trying to enlarge stuck windows by one line
+ ;; (column) until `rest' equals zero.
+ (setq sub first)
+ (while (and sub (> rest 0))
+ (unless (eq (window-new-normal sub) 'ignore)
+ (set-window-new-total sub 1 t)
+ (setq rest (1- rest)))
+ (setq sub (window-right sub)))
+
+ (setq sub first)
+ (while sub
+ ;; Record new normal sizes.
+ (set-window-new-normal
+ sub (/ (if (eq (window-new-normal sub) 'ignore)
+ (window-total-size sub horizontal)
+ (window-new-total sub))
+ (float parent-size)))
+ ;; Recursively balance each subwindow's subwindows.
+ (balance-windows-1 sub horizontal)
+ (setq sub (window-right sub)))))
+
+(defun balance-windows-1 (window &optional horizontal)
+ "Subroutine of `balance-windows'."
+ (if (window-child window)
+ (let ((sub (window-child window)))
+ (if (window-iso-combined-p sub horizontal)
+ (balance-windows-2 window horizontal)
+ (let ((size (window-new-total window)))
+ (while sub
+ (set-window-new-total sub size)
+ (balance-windows-1 sub horizontal)
+ (setq sub (window-right sub))))))))
+
+(defun balance-windows (&optional window-or-frame)
+ "Balance the sizes of subwindows of WINDOW-OR-FRAME.
+WINDOW-OR-FRAME is optional and defaults to the selected frame.
+If WINDOW-OR-FRAME denotes a frame, balance the sizes of all
+subwindows of that frame's root window. If WINDOW-OR-FRAME
+denots a window, balance the sizes of all subwindows of that
+window."
+ (interactive)
+ (let* ((window
+ (cond
+ ((or (not window-or-frame)
+ (frame-live-p window-or-frame))
+ (frame-root-window window-or-frame))
+ ((or (window-live-p window-or-frame)
+ (window-child window-or-frame))
+ window-or-frame)
+ (t
+ (error "Not a window or frame %s" window-or-frame))))
+ (frame (window-frame window)))
+ ;; Balance vertically.
+ (window--resize-reset (window-frame window))
+ (balance-windows-1 window)
+ (window-resize-apply frame)
+ ;; Balance horizontally.
+ (window--resize-reset (window-frame window) t)
+ (balance-windows-1 window t)
+ (window-resize-apply frame t)))
(defun window-fixed-size-p (&optional window direction)
"Return t if WINDOW cannot be resized in DIRECTION.
@@ -462,13 +3427,25 @@ nil (i.e. any), `height' or `width'."
'((height . width) (width . height))))))))
;;; A different solution to balance-windows.
-
(defvar window-area-factor 1
"Factor by which the window area should be over-estimated.
This is used by `balance-windows-area'.
Changing this globally has no effect.")
(make-variable-buffer-local 'window-area-factor)
+(defun balance-windows-area-adjust (window delta horizontal)
+ "Wrapper around `window-resize' with error checking.
+Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
+ ;; `window-resize' may fail if delta is too large.
+ (while (>= (abs delta) 1)
+ (condition-case nil
+ (progn
+ (window-resize window delta horizontal)
+ (setq delta 0))
+ (error
+ ;;(message "adjust: %s" (error-message-string err))
+ (setq delta (/ delta 2))))))
+
(defun balance-windows-area ()
"Make all visible windows the same area (approximately).
See also `window-area-factor' to change the relative size of
@@ -530,7 +3507,9 @@ specific buffers."
;; Make sure negligible differences don't accumulate to
;; become significant.
(setq carry (+ carry areadiff))
- (bw-adjust-window win diff horiz)
+ ;; This used `adjust-window-trailing-edge' before and uses
+ ;; `window-resize' now. Error wrapping is still needed.
+ (balance-windows-area-adjust win diff horiz)
;; (sit-for 0.5)
(let ((change (cons win (window-edges win))))
;; If the same change has been seen already for this window,
@@ -546,21 +3525,2654 @@ specific buffers."
;; (message "Done in %d rounds" round)
))
+;;; Window states, how to get them and how to put them in a window.
+(defsubst window-list-no-nils (&rest args)
+ "Like LIST but do not add nil elements of ARGS."
+ (delq nil (apply 'list args)))
+
+(defvar window-state-ignored-parameters '(quit-restore)
+ "List of window parameters ignored by `window-state-get'.")
+
+(defun window-state-get-1 (window &optional markers)
+ "Helper function for `window-state-get'."
+ (let* ((type
+ (cond
+ ((window-top-child window) 'vc)
+ ((window-left-child window) 'hc)
+ (t 'leaf)))
+ (buffer (window-buffer window))
+ (selected (eq window (selected-window)))
+ (head
+ (window-list-no-nils
+ type
+ (unless (window-next-sibling window) (cons 'last t))
+ (cons 'total-height (window-total-size window))
+ (cons 'total-width (window-total-size window t))
+ (cons 'normal-height (window-normal-size window))
+ (cons 'normal-width (window-normal-size window t))
+ (cons 'splits (window-splits window))
+ (cons 'nest (window-nest 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)))
+ (when list
+ (cons '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 (if selected (point) (window-point window)))
+ (start (window-start window))
+ (mark (mark)))
+ (window-list-no-nils
+ 'buffer (buffer-name buffer)
+ (cons 'selected selected)
+ (when window-size-fixed (cons 'size-fixed window-size-fixed))
+ (cons 'hscroll (window-hscroll window))
+ (cons 'fringes (window-fringes window))
+ (cons 'margins (window-margins window))
+ (cons 'scroll-bars (window-scroll-bars window))
+ (cons 'vscroll (window-vscroll window))
+ (cons 'dedicated (window-dedicated-p window))
+ (cons 'point (if markers (copy-marker point) point))
+ (cons 'start (if markers (copy-marker start) start))
+ (when mark
+ (cons 'mark (if markers (copy-marker mark) mark)))))))))
+ (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 window (window-right window)))
+ (nreverse list)))))
+ (append head tail)))
+
+(defun window-state-get (&optional window markers)
+ "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).
+
+The return value can be used as argument for `window-state-put'
+to put the state recorded here into an arbitrary window. The
+value can be also stored on disk and read back in a new session."
+ (setq window
+ (if window
+ (if (window-any-p window)
+ window
+ (error "%s is not a live or internal window" window))
+ (frame-root-window)))
+ ;; The return value is a cons whose car specifies some constraints on
+ ;; the size of WINDOW. The cdr lists the states of the subwindows of
+ ;; WINDOW.
+ (cons
+ ;; Frame related things would go into a function, say `frame-state',
+ ;; calling `window-state-get' to insert the frame's root window.
+ (window-list-no-nils
+ (cons 'min-height (window-min-size window))
+ (cons 'min-width (window-min-size window t))
+ (cons 'min-height-ignore (window-min-size window nil t))
+ (cons 'min-width-ignore (window-min-size window t t))
+ (cons 'min-height-safe (window-min-size window nil 'safe))
+ (cons 'min-width-safe (window-min-size window t 'safe))
+ ;; These are probably not needed.
+ (when (window-size-fixed-p window) (cons 'fixed-height t))
+ (when (window-size-fixed-p window t) (cons 'fixed-width t)))
+ (window-state-get-1 window markers)))
+
+(defvar window-state-put-list nil
+ "Helper variable for `window-state-put'.")
+
+(defun window-state-put-1 (state &optional window ignore totals)
+ "Helper function for `window-state-put'."
+ (let ((type (car state)))
+ (setq state (cdr state))
+ (cond
+ ((eq type 'leaf)
+ ;; For a leaf window just add unprocessed entries to
+ ;; `window-state-put-list'.
+ (setq window-state-put-list
+ (cons (cons window state) window-state-put-list)))
+ ((memq type '(vc hc))
+ (let* ((horizontal (eq type 'hc))
+ (total (window-total-size window horizontal))
+ (first t)
+ size new)
+ (dolist (item state)
+ ;; Find the next child window. WINDOW always points to the
+ ;; real window that we want to fill with what we find here.
+ (when (memq (car item) '(leaf vc hc))
+ (if (assq 'last item)
+ ;; The last child window. Below `window-state-put-1'
+ ;; will put into it whatever ITEM has in store.
+ (setq new nil)
+ ;; Not the last child window, prepare for splitting
+ ;; WINDOW. SIZE is the new (and final) size of the old
+ ;; window.
+ (setq size
+ (if totals
+ ;; Use total size.
+ (cdr (assq (if horizontal 'total-width 'total-height) item))
+ ;; Use normalized size and round.
+ (round (* total
+ (cdr (assq
+ (if horizontal 'normal-width 'normal-height)
+ item))))))
+
+ ;; Use safe sizes, we try to resize later.
+ (setq size (max size (if horizontal
+ window-safe-min-height
+ window-safe-min-width)))
+
+ (if (window-sizable-p window (- size) horizontal 'safe)
+ (let* ((window-nest (assq 'nest item)))
+ ;; We must inherit the nesting, otherwise we might mess
+ ;; up handling of atomic and side window.
+ (setq new (split-window window size horizontal)))
+ ;; Give up if we can't resize window down to safe sizes.
+ (error "Cannot resize window %s" window))
+
+ (when first
+ (setq first nil)
+ ;; When creating the first child window add for parent
+ ;; unprocessed entries to `window-state-put-list'.
+ (setq window-state-put-list
+ (cons (cons (window-parent window) state)
+ window-state-put-list))))
+
+ ;; Now process the current window (either the one we've just
+ ;; split or the last child of its parent).
+ (window-state-put-1 item window ignore totals)
+ ;; Continue with the last window split off.
+ (setq window new))))))))
+
+(defun window-state-put-2 (ignore)
+ "Helper function for `window-state-put'."
+ (dolist (item window-state-put-list)
+ (let ((window (car item))
+ (splits (cdr (assq 'splits item)))
+ (nest (cdr (assq 'nest item)))
+ (parameters (cdr (assq 'parameters item)))
+ (state (cdr (assq 'buffer item))))
+ (when splits (set-window-splits window splits))
+ (when nest (set-window-nest window nest))
+ ;; Process parameters.
+ (when parameters
+ (dolist (parameter parameters)
+ (set-window-parameter window (car parameter) (cdr parameter))))
+ ;; Process buffer related state.
+ (when state
+ ;; We don't want to raise an error here so we create a buffer if
+ ;; there's none.
+ (set-window-buffer window (get-buffer-create (car state)))
+ (with-current-buffer (window-buffer window)
+ (set-window-hscroll window (cdr (assq 'hscroll state)))
+ (apply 'set-window-fringes
+ (cons window (cdr (assq 'fringes state))))
+ (let ((margins (cdr (assq 'margins state))))
+ (set-window-margins window (car margins) (cdr margins)))
+ (let ((scroll-bars (cdr (assq 'scroll-bars state))))
+ (set-window-scroll-bars
+ window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars)))
+ (set-window-vscroll window (cdr (assq 'vscroll state)))
+ ;; Adjust vertically.
+ (if (memq window-size-fixed '(t height))
+ ;; A fixed height window, try to restore the original size.
+ (let ((delta (- (cdr (assq 'total-height item))
+ (window-total-height window)))
+ window-size-fixed)
+ (when (window-resizable-p window delta)
+ (window-resize window delta)))
+ ;; Else check whether the window is not high enough.
+ (let* ((min-size (window-min-size window nil ignore))
+ (delta (- min-size (window-total-size window))))
+ (when (and (> delta 0)
+ (window-resizable-p window delta nil ignore))
+ (window-resize window delta nil ignore))))
+ ;; Adjust horizontally.
+ (if (memq window-size-fixed '(t width))
+ ;; A fixed width window, try to restore the original size.
+ (let ((delta (- (cdr (assq 'total-width item))
+ (window-total-width window)))
+ window-size-fixed)
+ (when (window-resizable-p window delta)
+ (window-resize window delta)))
+ ;; Else check whether the window is not wide enough.
+ (let* ((min-size (window-min-size window t ignore))
+ (delta (- min-size (window-total-size window t))))
+ (when (and (> delta 0)
+ (window-resizable-p window delta t ignore))
+ (window-resize window delta t ignore))))
+ ;; Set dedicated status.
+ (set-window-dedicated-p window (cdr (assq 'dedicated state)))
+ ;; Install positions (maybe we should do this after all windows
+ ;; 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))))
+ ;; Select window if it's the selected one.
+ (when (cdr (assq 'selected state))
+ (select-window window)))))))
+
+(defun window-state-put (state &optional window ignore)
+ "Put window state STATE into WINDOW.
+STATE should be the state of a window returned by an earlier
+invocation of `window-state-get'. Optional argument WINDOW must
+specify a live window and defaults to the selected one.
+
+Optional argument IGNORE non-nil means ignore minimum window
+sizes and fixed size restrictions. IGNORE equal `safe' means
+subwindows can get as small as `window-safe-min-height' and
+`window-safe-min-width'."
+ (setq window (window-normalize-live-window window))
+ (let* ((frame (window-frame window))
+ (head (car state))
+ ;; We check here (1) whether the total sizes of root window of
+ ;; STATE and that of WINDOW are equal so we can avoid
+ ;; calculating new sizes, and (2) if we do have to resize
+ ;; whether we can do so without violating size restrictions.
+ (totals
+ (and (= (window-total-size window)
+ (cdr (assq 'total-height state)))
+ (= (window-total-size window t)
+ (cdr (assq 'total-width state)))))
+ (min-height (cdr (assq 'min-height head)))
+ (min-width (cdr (assq 'min-width head)))
+ window-splits selected)
+ (if (and (not totals)
+ (or (> min-height (window-total-size window))
+ (> min-width (window-total-size window t)))
+ (or (not ignore)
+ (and (setq min-height
+ (cdr (assq 'min-height-ignore head)))
+ (setq min-width
+ (cdr (assq 'min-width-ignore head)))
+ (or (> min-height (window-total-size window))
+ (> min-width (window-total-size window t)))
+ (or (not (eq ignore 'safe))
+ (and (setq min-height
+ (cdr (assq 'min-height-safe head)))
+ (setq min-width
+ (cdr (assq 'min-width-safe head)))
+ (or (> min-height
+ (window-total-size window))
+ (> min-width
+ (window-total-size window t))))))))
+ ;; The check above might not catch all errors due to rounding
+ ;; issues - so IGNORE equal 'safe might not always produce the
+ ;; minimum possible state. But such configurations hardly make
+ ;; sense anyway.
+ (error "Window %s too small to accomodate state" window)
+ (setq state (cdr state))
+ (setq window-state-put-list nil)
+ ;; Work on the windows of a temporary buffer to make sure that
+ ;; splitting proceeds regardless of any buffer local values of
+ ;; `window-size-fixed'. Release that buffer after the buffers of
+ ;; all live windows have been set by `window-state-put-2'.
+ (with-temp-buffer
+ (set-window-buffer window (current-buffer))
+ (window-state-put-1 state window nil totals)
+ (window-state-put-2 ignore))
+ (window-check frame))))
+(defconst display-buffer-macro-specifiers
+ '((same-window
+ ;; Use the same window.
+ (reuse-window same nil nil))
+ (same-frame
+ ;; Avoid other frames.
+ (reuse-window nil same nil)
+ (pop-up-window (largest . nil) (lru . nil))
+ (reuse-window nil other nil))
+ (same-frame-other-window
+ ;; Avoid other frames and selected window.
+ (reuse-window other same nil)
+ (pop-up-window (largest . nil) (lru . nil))
+ (reuse-window other other nil))
+ (other-frame
+ ;; Avoid selected frame.
+ (reuse-window nil same other)
+ (pop-up-frame)
+ (reuse-window nil other other)))
+ "Buffer display macro specifiers.")
+
+(defcustom display-buffer-alist nil
+ "List associating buffer identifiers with display specifiers.
+The car of each element of this list is built from a set of cons
+cells called buffer identifiers. `display-buffer' shows a buffer
+according to the display specifiers in the element's cdr
+\(elements are true lists) if at least one of the identifiers
+matches the first or third argument of `display-buffer'. Such a
+match occurs in one of the following three cases:
+
+- The car of the buffer identifier is the symbol `name' and its
+ cdr is a string equalling the name of the buffer specified by
+ the first \(BUFFER-OR-NAME) argument of `display-buffer'.
+
+- The car is the symbol `regexp' and the cdr is a regular
+ expression matching the name of the buffer specified by the
+ first \(BUFFER-OR-NAME) argument of `display-buffer'.
+
+- The car is the symbol `label' and the cdr is a symbol equalling
+ the third \(LABEL) argument of `display-buffer'.
+
+Display specifiers are either symbols, cons cells, or lists.
+Five specifiers have been reserved to indicate the basic method
+for displaying the buffer: `reuse-window', `pop-up-window',
+`pop-up-frame', `use-side-window', and `function'.
+
+A list whose car is the symbol `reuse-window' indicates that an
+existing window shall be reused for displaying the buffer. The
+second element of this list specifies the window to use and can
+be one of the following symbols:
+
+ nil stands for any window.
+
+ `same' stands for the selected window.
+
+ `other' stands for any but the selected window.
+
+The third element specifies whether the buffer shown in a window
+that shall be reused must be the same buffer that shall be
+displayed or another buffer and can be one of the following:
+
+ nil means to not care about the window's buffer.
+
+ `same' means the window must show the buffer already.
+
+ `other' means the window must not show the buffer yet.
+
+The fourth element specifies the set of frames to search for a
+suitable window and can be one of the following:
+
+ nil to reuse a window on the selected frame.
+
+ `visible' to search visible frames on the current terminal.
+
+ `other' stands for any visible frame but the selected one.
+
+ 0 \(the number zero) to search visible and iconified frames on
+ the current terminal.
+
+ t to search arbitrary frames including invisible ones.
+
+If more than one window fits the constraints imposed by these
+elements, the least recently used candidate is chosen. A side
+window is never reused unless it already shows the buffer.
+
+The following two specifiers are useful when the method equals
+`reuse-window':
+
+- A cons cell whose car is the symbol `reuse-window-even-sizes'
+ and whose cdr is non-nil means to even out the sizes of a
+ reused window and the selected window provided they (1) appear
+ adjacent to each other and (2) the selected window is larger
+ than the window chosen. If the cdr is nil, this means that the
+ window sizes are left alone.
+
+- A cons cell whose car is the symbol `reuse-window-dedicated'
+ and whose cdr is non-nil means that a window can be reused even
+ if it's weakly dedicated to its buffer. If the cdr is t, a
+ strongly dedicated window can be reused to show the buffer.
+ Any other non-nil value means only weakly dedicated windows can
+ be reused. If the cdr is nil, dedicated windows are not
+ reused.
+
+ This specifier should be used in emergency cases only since
+ windows are usually made dedicated in order to prevent
+ `display-buffer' from reusing them.
+
+A list whose car is the symbol `pop-up-window' and whose cdr is
+built from cons cells representing window/side tuples indicates
+that a new window shall be made for displaying the buffer on the
+selected frame.
+
+Window/side tuples are cons cells. The car of such a tuple
+identifies the window that shall be split. Possible values are
+`largest', `lru', `selected', and `root' to split the largest,
+least recently used, selected or root window of the selected
+frame.
+
+If the frame has side windows, these values do allow to split
+only the selected frame's main window or one of its subwindows.
+Setting the car to one of `left', `top', `right' and `bottom'
+splits the corresponding side window, provided such a window
+exists.
+
+The cdr of each pair specifies on which side of the window to
+split the new window shall appear and can be one of `below',
+`right', `above', or `left' with the obvious meanings. If the
+cdr is nil, the window is split in a fashion suitable for its
+current dimensions. If the cdr specifies a function, that
+function is called with one argument - the window to split. The
+function is supposed to split that window and return the new
+window.
+
+`display-buffer' scans these tuples until it can either produce a
+suitable window or fails. The default value for
+`display-buffer-alist' contains the tuples \(largest . nil) and
+\(lru . nil) in order to split the largest window first and, if
+that fails, the least recently used one.
+
+The following specifiers are useful if the method specifier is
+`pop-up-window'.
+
+- A cons cell whose car is the symbol `pop-up-window-min-height'
+ specifiies the minimum height of the new window. If the cdr is
+ an integer number, it specifies the minimum number of lines of
+ the window. A floating point number gives the minimum fraction
+ of the window height with respect to the height of the frame's
+ root window. A new window is created only if it can be made at
+ least as high as specified by the number. If the cdr is nil,
+ this means to use the value of `window-min-height'.
+
+- A cons cell whose car is the symbol `pop-up-window-min-width'
+ specifies the minimum width of the new window. If the cdr is
+ an integer number, it specifies the minimum number of columns
+ of the window. A floating point number gives the minimum
+ fraction of the window width with respect to the width of the
+ frame's root window. A new window is created only if it can be
+ made at least as wide as specified by the number. If the cdr
+ is nil, this means to use the value of `window-min-width'.
+
+- A cons cell whose car is `pop-up-window-set-height' with
+ the following interpretations for the cdr:
+
+ - nil means leave the height of the new window alone.
+
+ - 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
+ height with respect to the height of the frame's root window.
+
+ - If the 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 `shrink-window-if-larger-than-buffer'
+ and `fit-window-to-buffer'.
+
+- A cons cell whose car equals `pop-up-window-set-width' with
+ the following interpretations for the cdr:
+
+ - nil means leave the width of the new window alone.
+
+ - 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
+ width with respect to the width of the frame's root window.
+
+ - If the 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.
+
+ Observe that specifying `pop-up-window-set-height' or
+ `pop-up-window-set-width' may override restrictions given by
+ the `pop-up-window-min-height' and `pop-up-window-min-width'
+ specifiers.
+
+- A cons cell whose car is `pop-up-window-split-unsplittable' and
+ whose cdr is non-nil allows to make a new window on an
+ unsplittable frame. If the cdr is nil, unsplittable frames are
+ not split. This specifier should be used in special cases only
+ since frames are usually made unsplittable in order to prevent
+ `display-buffer' from splitting them.
+
+A list whose car is the symbol `pop-up-frame' specifies that a
+new frame shall be made for displaying the buffer. The second
+element, if non-nil, allows popping up a new frame on graphic
+displays only.
+
+The following specifiers are useful if the method specifier is
+`pop-up-frame'.
+
+- A list whose car is the symbol `pop-up-frame-function' together
+ with a valid function as cdr specifies the function for
+ creating a new frame. If the cdr is nil, the default function
+ `make-frame' is called. The function is called with the
+ parameters and values provided by the specifier described next.
+
+- A list whose car is the symbol `pop-up-frame-alist' followed by
+ an arbitrary number of frame parameter/value tuples, each given
+ as a cons cell, specifies the parameters passed to the pop-up
+ frame function.
+
+A list of three elements whose car is the symbol
+`use-side-window' specifies that the buffer shall be displayed in
+a side window of the selected frame. The second element denotes
+the side of the frame where the window appears or shall be made.
+The third element denotes the slot used by the window. If a side
+window with the specified slot exists already, that window is
+reused. If no such window exists it is created.
+
+The following specifiers are useful in connection with the
+`use-side-window' method specifier: `reuse-window-dedicated',
+`pop-up-window-min-height', `pop-up-window-min-width',
+`pop-up-window-set-height' and `pop-up-window-set-width'.
+
+A list whose car is the symbol `function' specifies that the
+function specified in the second element of the list is
+responsible for displaying the buffer. `display-buffer' calls
+this function with the buffer as first argument and the remaining
+elements of the list as the second.
+
+The function should choose or create a window, display the buffer
+in it, and return the window. It is also responsible for giving
+the variable `display-buffer-window' and the `quit-restore'
+parameter of the window used a meaningful value.
+
+Within the body of this function avoid calling `display-buffer'
+with the same buffer as argument since this may lead to endless
+recursion.
+
+Instead of supplying basic method specifiers, it's sometimes more
+convenient to use macro specifiers. They provide some commonly
+used display methods but do not support the fine control provided
+by the basic method specifiers. Macro specifiers are symbols.
+The following macro specifiers are provided:
+
+ `same-window' to display the buffer in the selected window.
+
+ `same-frame' to display the buffer on the selected frame.
+
+ `other-window' to display the buffer in any window but the
+ selected one.
+
+ `same-frame-other-window' as `other-window' but stay on the
+ selected frame.
+
+ `other-frame' to display the buffer on another visible
+ frame.
+
+ `default' to use the default value of `display-buffer-alist'.
+
+One specifier is useful with any method specifier: A list whose
+car is the symbol `dedicate' and whose cdr is non-nil will
+dedicate the window to its buffer. The following values are
+supported:
+
+- nil to not dedicate the window to the buffer.
+
+- `weak' to weakly dedicate the window to the buffer.
+
+- t to strongly dedicate the window to the buffer.
+
+A cons cell whose car is `other-window-means-other-frame' and
+whose cdr is non-nil means that you want calls of
+`display-buffer' with the second argument t or the symbol
+`other-window' to display the buffer in another frame. This
+means, for example, that you prefer functions like
+`find-file-other-window' or `switch-to-buffer-other-window' to
+make a new frame instead of a new window on the selected frame.
+
+Usually, applications are free to override the specifiers of
+`display-buffer-alist' by passing their own specifiers as second
+argument of `display-buffer'. For every `display-buffer-alist'
+entry you can, however, add a cons cell whose car is the symbol
+`override' and whose cdr is non-nil, to explicitly override any
+value supplied by the application.
+
+Overriding specifiers supplied by the calling application is, in
+general, not advisable. It permits, for example, to change the
+semantics of a function like `display-buffer-other-window' by
+using the location specifiers `same-window' or `other-frame'."
+ :risky t
+ :type
+ '(repeat
+ :offset 9
+ ;; Associations of buffer identifiers and display specifiers.
+ (list
+ :format "%v"
+ ;; Buffer identifiers.
+ (repeat
+ :tag "Buffer identifiers"
+ (choice
+ :tag "Identifier"
+ :format "%[%t%] %v" :size 15
+ (cons
+ :tag "Name"
+ :format "%v"
+ :help-echo "A buffer name."
+ (const :format "" name)
+ (string :format "Name: %v\n" :size 32))
+ (cons
+ :tag "Regexp"
+ :format "%v"
+ :help-echo "A regular expression matching buffer names."
+ (const :format "" regexp)
+ (string :format "Regexp: %v\n" :size 32))
+ (cons
+ :tag "Label"
+ :format "%v"
+ :help-echo "A symbol equalling the buffer display label."
+ (const :format "" label)
+ (symbol :format "Label: %v\n" :size 32))))
+
+ ;; Display specifiers.
+ (repeat
+ :offset 9
+ :tag "Display specifiers"
+ :inline t
+ (list
+ :inline t
+ :format "%v"
+ (choice
+ :tag "Method"
+ :value (reuse-window
+ (reuse-window nil same nil)
+ (reuse-window-even-sizes . t))
+ :inline t
+ :help-echo "Method for displaying the buffer."
+ :format "%[Method%] %v" :size 15
+
+ ;; Reuse window specifiers.
+ (list
+ :tag "Reuse window"
+ :value (reuse-window
+ (reuse-window nil same nil)
+ (reuse-window-even-sizes . t))
+ :format "%t\n%v"
+ :inline t
+ ;; For customization purposes only.
+ (const :format "" reuse-window)
+ (set
+ :format "%v"
+ :inline t
+ ;; The window to reuse.
+ (list
+ :format "%v\n"
+ (const :format "" reuse-window)
+ ;; The window type.
+ (choice
+ :tag "Window"
+ :help-echo "Window to reuse."
+ :value nil
+ :format "%[Window%] %v" :size 15
+ (const :tag "Any window" :format "%t" nil)
+ (const :tag "Same window" :format "%t" same)
+ (const :tag "Other window" :format "%t" other))
+ ;; The window's buffer.
+ (choice
+ :tag "Buffer"
+ :help-echo "Buffer shown by reused window."
+ :value t
+ :format " %[Buffer%] %v" :size 15
+ (const :tag "Any buffer" :format "%t" nil)
+ (const :tag "Same buffer" :format "%t" same)
+ (const :tag "Other buffer" :format "%t" other))
+ ;; The window's frame.
+ (choice
+ :help-echo "Frames to search for a window to reuse."
+ :tag "Frame"
+ :value nil
+ :format " %[Frame%] %v" :size 15
+ (const :tag "Same frame only" :format "%t" nil)
+ (const :tag "Visible frames" :format "%t" visible)
+ (const :tag "Any other visible frame" :format "%t" other)
+ (const :tag "Visible and iconified frames" :format "%t" 0)
+ (const :tag "All frames" :format "%t" t)))
+ ;; Whether window sizes should be evened out.
+ (cons
+ :format "%v\n"
+ :tag "Even window sizes"
+ (const :format "" reuse-window-even-sizes)
+ (choice
+ :tag "Even window sizes"
+ :help-echo "Whether to even sizes of selected and reused window."
+ :value t
+ :format "%[Even window sizes%] %v" :size 15
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Even window sizes" :format "%t" t)))
+ ;; Whether to reuse a dedicated window
+ (cons
+ :format "%v\n"
+ (const :format "" reuse-window-dedicated)
+ (choice
+ :tag "Reuse dedicated window" :value nil
+ :help-echo "Reuse a window even if it is dedicated to its buffer."
+ :format "%[Reuse dedicated window%] %v" :size 15
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Reuse weakly dedicated windows" :format "%t" weak)
+ (const :tag "Reuse any dedicated window" :format "%t" t)))))
+
+ ;; Pop-up window specifiers.
+ (list
+ :tag "Pop-up window"
+ :value (pop-up-window (pop-up-window (largest . nil) (lru . nil)))
+ :format "%t\n%v"
+ :inline t
+ (const :format "" pop-up-window)
+ (set
+ :format "%v"
+ :inline t
+ ;; Pop-up window list.
+ (list
+ :format "%v"
+ :value (pop-up-window (largest . nil) (lru . nil))
+ (const :format "" pop-up-window)
+ (repeat
+ :tag "Window / Side tuples"
+ :inline t
+ (cons
+ :format "%v\n"
+ (choice
+ :tag "Window"
+ :help-echo "The window to split."
+ :value largest
+ :format "%[Window%] %v"
+ (const :tag "Largest" :format "%t" largest)
+ (const :tag "Least recently used" :format "%t" lru)
+ (const :tag "Selected" :format "%t" selected)
+ (const :tag "Root" :format "%t" root)
+ (const :tag "Left" :format "%t" left)
+ (const :tag "Top" :format "%t" top)
+ (const :tag "Right" :format "%t" right)
+ (const :tag "Bottom" :format "%t" bottom))
+ (choice
+ :tag "Side"
+ :help-echo "The position of the new window with respect to the window to split."
+ :value nil
+ :format " %[Side%] %v"
+ (const :tag "Dynamic" :format "%t" nil)
+ (const :tag "Below" :format "%t" below)
+ (const :tag "Right" :format "%t" right)
+ (const :tag "Above" :format "%t" above)
+ (const :tag "Left" :format "%t" left)
+ (function
+ :tag "Function" :format "%v" :size 25)))))
+ ;; Minimum height of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-min-height)
+ (choice
+ :help-echo "Minimum height of popped-up window."
+ :format "%[Minimum height%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of lines" :value 12 :size 5)
+ (float :tag "Fraction of frame height" :value .25 :size 5)))
+ ;; Minimum width of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-min-width)
+ (choice
+ :help-echo "Minimum width of popped-up window."
+ :format "%[Minimum width%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of columns" :value 12 :size 5)
+ (float :tag "Fraction of frame width" :value .25 :size 5)))
+ ;; Desired height of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-set-height)
+ (choice
+ :help-echo "Desired height of popped-up window."
+ :format "%[Desired height%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of lines" :value 12 :size 5)
+ (float :tag "Fraction of frame height" :value .25 :size 5)
+ (function :tag "Function" :size 25)))
+ ;; Desired width of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-set-width)
+ (choice
+ :help-echo "Desired width of popped-up window."
+ :format "%[Desired width%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of column" :value 12 :size 5)
+ (float :tag "Fraction of frame width" :value .25 :size 5)
+ (function :tag "Function" :size 25)))
+ ;; Split unsplittable frames.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-unsplittable)
+ (choice
+ :help-echo "Allow popping up a window on \"unsplittable\" frames."
+ :format "%[Split unsplittable frame%] %v"
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Allow" :format "%t" t)))))
+
+ ;; Pop-up frame specifiers.
+ (list
+ :tag "Pop-up frame"
+ :value (pop-up-frame
+ (pop-up-frame))
+ :format "%t\n%v"
+ :inline t
+ (const :format "" pop-up-frame)
+ (set
+ :format "%v"
+ :inline t
+ ;; Pop-up frame.
+ (list
+ :tag "Pop-up a new frame"
+ :value (pop-up-frame)
+ :format "%v"
+ (const :format "" pop-up-frame)
+ (choice
+ :tag "Pop-up a new frame"
+ :help-echo "Whether to pop-up a new frame on a display."
+ :format "%[Display%] %v\n" :size 15
+ (const :tag "On any display" :format "%t" nil)
+ (const :tag "On graphic displays only" :format "%t" t)))
+ ;; Pop-up frame function.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-frame-function)
+ (choice
+ :tag "Pop-up frame function"
+ :value nil
+ :help-echo "Function to use to pop-up a new frame."
+ :format "%[Function%] %v" :size 15
+ (const :tag "Default" :format "%t" nil)
+ (function
+ :value make-frame
+ :format "%t: %v"
+ :size 25)))
+ ;; Pop-up frame alist.
+ (list
+ :format "%v"
+ (const :format "" pop-up-frame-alist)
+ (repeat
+ :tag "Parameter / Value tuples"
+ :inline t
+ (cons
+ :format "%v\n"
+ (symbol
+ :tag "Parameter"
+ :format "Parameter: %v"
+ :size 16)
+ (sexp
+ :tag "Value"
+ :format " Value: %v"
+ :size 8))))))
+
+ ;; Use side-window specifiers.
+ (list
+ :tag "Use side-window"
+ :value (use-side-window (use-side-window bottom 0))
+ :format "%t\n%v"
+ :inline t
+ ;; For customization purposes only.
+ (const :format "" use-side-window)
+ (set
+ :format "%v"
+ :inline t
+ ;; Side and slot.
+ (list
+ :format "%v\n"
+ :value (use-side-window bottom 0)
+ (const :format "" use-side-window)
+ ;; The side.
+ (choice
+ :tag "Side"
+ :help-echo "Side of frame."
+ :value bottom
+ :format "%[Side%] %v" :size 15
+ (const :tag "Left" :format "%t" left)
+ (const :tag "Top" :format "%t" top)
+ (const :tag "Right" :format "%t" right)
+ (const :tag "Bottom" :format "%t" bottom))
+ ;; The slot
+ (number
+ :tag "Slot"
+ :help-echo "The slot (an arbitrary number, where 0 stands for the center slot)."
+ :value 0
+ :format " Slot: %v" :size 8))
+ ;; Whether to reuse a dedicated side window
+ (cons
+ :format "%v\n"
+ (const :format "" reuse-window-dedicated)
+ (choice
+ :tag "Reuse dedicated side window" :value nil
+ :help-echo "Reuse a side window even if it is dedicated to its buffer."
+ :format "%[Reuse dedicated side window%] %v" :size 15
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Reuse weakly dedicated side windows" :format "%t" weak)
+ (const :tag "Reuse any dedicated side window" :format "%t" t)))
+ ;; Minimum height of pop-up side windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-min-height)
+ (choice
+ :help-echo "Minimum height of popped-up side window."
+ :format "%[Minimum height%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of lines" :value 12 :size 5)
+ (float :tag "Fraction of frame height" :value .25 :size 5)))
+ ;; Minimum width of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-min-width)
+ (choice
+ :help-echo "Minimum width of popped-up side window."
+ :format "%[Minimum width%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of columns" :value 12 :size 5)
+ (float :tag "Fraction of frame width" :value .25 :size 5)))
+ ;; Desired height of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-set-height)
+ (choice
+ :help-echo "Desired height of popped-up side window."
+ :format "%[Desired height%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of lines" :value 12 :size 5)
+ (float :tag "Fraction of frame height" :value .25 :size 5)
+ (function :tag "Function" :size 25)))
+ ;; Desired width of pop-up windows.
+ (cons
+ :format "%v\n"
+ (const :format "" pop-up-window-set-width)
+ (choice
+ :help-echo "Desired width of popped-up side window."
+ :format "%[Desired width%] %v"
+ (const :tag "Default" :format "%t" :value nil)
+ (integer :tag "Number of column" :value 12 :size 5)
+ (float :tag "Fraction of frame width" :value .25 :size 5)
+ (function :tag "Function" :size 25)))))
+
+ ;; Function with argument specifiers.
+ (list
+ :tag "Function with arguments"
+ :value (function (function 'ignore))
+ :format "%t\n%v"
+ :inline t
+ ;; For customization purposes only.
+ (const :format "" function)
+ (set
+ :format "%v"
+ :inline t
+ (list
+ :format "%v"
+ :value (function 'ignore)
+ (const :format "" function)
+ (function :tag "Function" :format "%t: %v\n" :size 25)
+ (list
+ :format "%v"
+ (repeat
+ :tag "Arguments"
+ :inline t
+ (sexp
+ :format "%v\n"
+ :size 16))))))
+
+ ;; Macro specifiers.
+ (list
+ :tag "Same window"
+ :format "%t%v"
+ :inline t
+ (const :format "\n" same-window))
+ (list
+ :tag "Same frame"
+ :format "%t%v"
+ :inline t
+ (const :format "\n" same-frame))
+ (list
+ :tag "Other window"
+ :format "%t%v"
+ :inline t
+ (const :format "\n" other-window))
+ (list
+ :tag "Same frame other window"
+ :format "%t%v"
+ :inline t
+ (const :format "\n" same-frame-other-window))
+ (list
+ :tag "Other frame"
+ :format "%t%v"
+ :inline t
+ (const :format "\n" other-frame))
+ (list
+ :tag "Default"
+ :format "%t%v"
+ :inline t
+ (const :format "\n" default)))))
+
+ (set
+ :format "%v"
+ :inline t
+ ;; Dedicate window to buffer.
+ (cons
+ :format "%v"
+ (const :format "" dedicate)
+ (choice
+ :help-echo "Mark window as dedicated to its buffer."
+ :format "%[Dedicate window to buffer%] %v\n" :size 15
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Weak" :format "%t" weak)
+ (const :tag "Strong" :format "%t" t)))
+ ;; No other window.
+ (cons
+ :format "%v"
+ (const :format "" no-other-window)
+ (choice
+ :help-echo "Whether `other-window' shall ignore the window."
+ :format "%[No other window%] %v\n" :size 15
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Ignore" :format "%t" t)))
+ ;; Other window means other frame.
+ (cons
+ :format "%v"
+ (const :format "" other-window-means-other-frame)
+ (choice
+ :help-echo "Whether other window means same or other frame."
+ :format "%[Other window means other frame%] %v\n" :size 15
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "On" :format "%t" t)))
+ ;; Overriding.
+ (cons
+ :format "%v\n"
+ (const :format "" override)
+ (choice
+ :help-echo "Override application supplied specifiers."
+ :format "%[Override%] %v"
+ (const :tag "Off" :format "%t" nil)
+ (const :tag "Override" :format "%t" t))))))
+ :group 'windows
+ :group 'frames)
+
(defcustom display-buffer-function nil
- "If non-nil, function to call to handle `display-buffer'.
-It will receive two args, the buffer and a flag which if non-nil
-means that the currently selected window is not acceptable. It
-should choose or create a window, display the specified buffer in
-it, and return the window.
-
-Commands such as `switch-to-buffer-other-window' and
-`find-file-other-window' work using this function."
+ "If non-nil, function to call to display a buffer.
+`display-buffer' calls this function with two arguments, the
+buffer to display and a list of buffer display specifiers, see
+`display-buffer-alist'.
+
+The function is supposed to choose or create a window, display
+the specified buffer in it, and return the window. It is also
+responsible for giving the variable `display-buffer-window' and
+the `quit-restore' parameter of the window used a meaningful
+value.
+
+The function specified here overrides all specifiers of the
+variable `display-buffer-alist' any specifiers passed to
+`display-buffer'.
+
+If you call `display-buffer' within the body of the function,
+bind the value of `display-buffer-function' to nil around that
+call to avoid that the function recursively calls itself."
:type '(choice
(const nil)
- (function :tag "function"))
+ (function :tag "Function"))
:group 'windows)
+;; The following is a global variable which is used externally (by
+;; help.el) to (1) know which window was used for displaying a buffer
+;; and (2) whether the window was new or reused.
+(defvar display-buffer-window nil
+ "Window used by `display-buffer' and related information.
+After `display-buffer' displays a buffer in some window this
+variable is a cons cell whose car denotes the window used to
+display the buffer. The cdr is supposed to be one of the symbols
+`reuse-buffer-window', `reuse-other-window', `new-window' or
+`new-frame'.
+
+If the buffer display location specifier is one of 'same-window,
+'same-frame, or 'other-frame, the `display-buffer' routines
+assign the value of this variable. If the location specifier is
+a function, that function becomes responsible for assigning a
+meaningful value to this variable. See the functions
+`display-buffer-reuse-window', `display-buffer-pop-up-window' and
+`display-buffer-pop-up-frame' for how this can be done.")
+
+(defun display-buffer-even-window-sizes (window specifiers)
+ "Even sizes of WINDOW and selected window according to SPECIFIERS.
+SPECIFIERS must be a list of buffer display specifiers, see the
+documentation of `display-buffer-alist' for a description.
+
+Sizes are evened out if and only if WINDOW and the selected
+window appear next to each other and the selected window is
+larger than WINDOW."
+ (cond
+ ((or (not (cdr (assq 'reuse-window-even-sizes specifiers)))
+ ;; Don't resize minibuffer windows.
+ (window-minibuffer-p)
+ ;; WINDOW must be adjacent to the selected one.
+ (not (or (eq window (window-prev-sibling))
+ (eq window (window-next-sibling))))))
+ ((and (window-iso-combined-p window)
+ ;; Resize iff the selected window is higher than WINDOW.
+ (> (window-total-height) (window-total-height window)))
+ ;; Don't throw an error if we can't even window heights for
+ ;; whatever reason. In any case, enlarging the selected window
+ ;; might fail anyway if there are other windows above or below
+ ;; WINDOW and the selected one. But for a simple two windows
+ ;; configuration the present behavior is good enough so why care?
+ (ignore-errors
+ (window-resize
+ window (/ (- (window-total-height) (window-total-height window))
+ 2))))
+ ((and (window-iso-combined-p window t)
+ ;; Resize iff the selected window is wider than WINDOW.
+ (> (window-total-width) (window-total-width window)))
+ ;; Don't throw an error if we can't even window widths, see
+ ;; comment above.
+ (ignore-errors
+ (window-resize
+ window (/ (- (window-total-width) (window-total-width window))
+ 2) t)))))
+
+(defun display-buffer-set-height (window specifiers)
+ "Adjust height of WINDOW according to SPECIFIERS.
+SPECIFIERS must be a list of buffer display specifiers, see the
+documentation of `display-buffer-alist' for a description."
+ (let ((set-height (cdr (assq 'pop-up-window-set-height specifiers))))
+ (cond
+ ((numberp set-height)
+ (let* ((height (if (integerp set-height)
+ set-height
+ (round
+ (* (window-total-size (frame-root-window window))
+ set-height))))
+ (delta (- height (window-total-size window))))
+ (when (and (window-resizable-p window delta nil 'safe)
+ (window-iso-combined-p window))
+ (window-resize window delta nil 'safe))))
+ ((functionp set-height)
+ (ignore-errors (funcall set-height window))))))
+
+(defun display-buffer-set-width (window specifiers)
+ "Adjust width of WINDOW according to SPECIFIERS.
+SPECIFIERS must be a list of buffer display specifiers, see the
+documentation of `display-buffer-alist' for a description."
+ (let ((set-width (cdr (assq 'pop-up-window-set-width specifiers))))
+ (cond
+ ((numberp set-width)
+ (let* ((width (if (integerp set-width)
+ set-width
+ (round
+ (* (window-total-size (frame-root-window window) t)
+ set-width))))
+ (delta (- width (window-total-size window t))))
+ (when (and (window-resizable-p window delta t 'safe)
+ (window-iso-combined-p window t))
+ (window-resize window delta t 'safe))))
+ ((functionp set-width)
+ (ignore-errors (funcall set-width window))))))
+
+(defun display-buffer-in-window (buffer window specifiers)
+ "Display BUFFER in WINDOW and raise its frame if needed.
+WINDOW must be a live window and defaults to the selected one.
+Return WINDOW.
+
+SPECIFIERS must be a list of buffer display specifiers, see the
+documentation of `display-buffer-alist' for a description."
+ (setq buffer (window-normalize-buffer buffer))
+ (setq window (window-normalize-live-window window))
+ (let* ((old-frame (selected-frame))
+ (new-frame (window-frame window))
+ (dedicate (cdr (assq 'dedicate specifiers)))
+ (no-other-window (cdr (assq 'no-other-window specifiers))))
+ ;; Show BUFFER in WINDOW.
+ (unless (eq buffer (window-buffer window))
+ ;; If we show another buffer in WINDOW, undedicate it first.
+ (set-window-dedicated-p window nil))
+ (set-window-buffer window buffer)
+ (when dedicate
+ (set-window-dedicated-p window dedicate))
+ (when no-other-window
+ (set-window-parameter window 'no-other-window t))
+ (unless (or (eq old-frame new-frame)
+ (not (frame-visible-p new-frame))
+ ;; Assume the selected frame is already visible enough.
+ (eq new-frame (selected-frame))
+ ;; Assume the frame from which we invoked the minibuffer
+ ;; is visible.
+ (and (minibuffer-window-active-p (selected-window))
+ (eq new-frame
+ (window-frame (minibuffer-selected-window)))))
+ (raise-frame new-frame))
+ ;; Return window.
+ window))
+
+(defun display-buffer-reuse-window (buffer method &optional specifiers other-window)
+ "Display BUFFER in an existing window.
+METHOD must be a list in the form of the cdr of a `reuse-window'
+buffer display specifier, see `display-buffer-alist' for an
+explanation. The first element must specifiy the window to use,
+and can be either nil, `same', `other', or a live window. The
+second element must specify the window's buffer and can be either
+nil, `same', `other', or a live buffer. The third element is the
+frame to use - either nil, 0, `visible', `other', t, or a live
+frame.
+
+Optional argument SPECIFIERS must be a list of valid display
+specifiers. Optional argument OTHER-WINDOW, if non-nil, means do
+not use the selected window. Return the window chosen to display
+BUFFER, nil if none was found."
+ (let* ((method-window (nth 0 method))
+ (method-buffer (nth 1 method))
+ (method-frame (nth 2 method))
+ (reuse-dedicated (cdr (assq 'reuse-window-dedicated specifiers)))
+ windows other-frame dedicated time best-window best-time)
+ (when (eq method-frame 'other)
+ ;; `other' is not handled by `window-list-1'.
+ (setq other-frame t)
+ (setq method-frame t))
+ (dolist (window (window-list-1 nil 'nomini method-frame))
+ (let ((window-buffer (window-buffer window)))
+ (when (and (not (window-minibuffer-p window))
+ ;; Don't reuse a side window.
+ (or (not (eq (window-parameter window 'window-side) 'side))
+ (eq window-buffer buffer))
+ (or (not method-window)
+ (and (eq method-window 'same)
+ (not other-window)
+ (eq window (selected-window)))
+ (and (eq method-window 'other)
+ (not (eq window (selected-window))))
+ ;; Special case for applications that specifiy
+ ;; the window explicitly.
+ (eq method-window window))
+ (or (not method-buffer)
+ (and (eq method-buffer 'same)
+ (eq window-buffer buffer))
+ (and (eq method-buffer 'other)
+ (not (eq window-buffer buffer)))
+ ;; Special case for applications that specifiy
+ ;; the window's buffer explicitly.
+ (eq method-buffer window-buffer))
+ (or (not other-frame)
+ (not (eq (window-frame window) (selected-frame))))
+ ;; Handle dedicatedness.
+ (or (eq window-buffer buffer)
+ ;; The window does not show the same buffer.
+ (not (setq dedicated (window-dedicated-p window)))
+ ;; If the window is weakly dedicated to its
+ ;; buffer, reuse-dedicated must be non-nil.
+ (and (not (eq dedicated t)) reuse-dedicated)
+ ;; If the window is strongly dedicated to its
+ ;; buffer, reuse-dedicated must be t.
+ (eq reuse-dedicated t)))
+ (setq windows (cons window windows)))))
+
+ (if (eq method-buffer 'same)
+ ;; When reusing a window on the same buffer use the lru one.
+ (dolist (window windows)
+ (setq time (window-use-time window))
+ (when (or (not best-window) (< time best-time))
+ (setq best-window window)
+ (setq best-time time)))
+ ;; Otherwise, sort windows according to their use-time.
+ (setq windows
+ (sort windows
+ #'(lambda (window-1 window-2)
+ (<= (window-use-time window-1)
+ (window-use-time window-2)))))
+ (setq best-window
+ ;; Try to get a full-width window (this is silly and can
+ ;; get us to another frame but let's ignore these issues
+ ;; for the moment).
+ (catch 'found
+ (dolist (window windows)
+ (when (window-full-width-p window)
+ (throw 'found window)))
+ ;; If there's no full-width window return the lru window.
+ (car windows))))
+
+ (when best-window
+ (display-buffer-even-window-sizes best-window specifiers)
+ ;; Never change the quit-restore parameter of a window here.
+ (if (eq (window-buffer best-window) buffer)
+ (setq display-buffer-window
+ (cons best-window 'reuse-buffer-window))
+ (setq display-buffer-window
+ (cons best-window 'reuse-other-window))
+ (unless (window-parameter best-window 'quit-restore)
+ ;; Don't overwrite an existing quit-restore entry.
+ (set-window-parameter
+ best-window 'quit-restore
+ (list (window-buffer best-window) (window-start best-window)
+ (window-point best-window) buffer
+ (window-total-size best-window) (selected-window)))))
+
+ (display-buffer-in-window buffer best-window specifiers))))
+
+(defconst display-buffer-split-specifiers '(largest lru selected root left top right bottom)
+ "List of symbols identifying window that shall be split.")
+
+(defconst display-buffer-side-specifiers '(below right above left nil)
+ "List of symbols identifying side of split-off window.")
+
+(defun display-buffer-split-window-1 (window side min-size)
+ "Subroutine of `display-buffer-split-window'."
+ (let* ((horizontal (memq side '(left right)))
+ (parent (window-parent window))
+ (resize (and window-splits (window-iso-combined-p window horizontal)))
+ (old-size
+ ;; We either resize WINDOW or its parent.
+ (window-total-size (if resize parent window) horizontal))
+ new-size)
+ ;; We don't call split-window-vertically/-horizontally any more
+ ;; here. If for some reason it's needed we can always do so
+ ;; (provided we give it an optional SIDE argument).
+ (cond
+ (resize
+ ;; When we resize a combination, the new window must be at least
+ ;; MIN-SIZE large after the split.
+ (setq new-size
+ (max min-size
+ (min (- old-size (window-min-size parent horizontal))
+ (/ old-size
+ ;; Try to make the size of the new window
+ ;; proportional to the number of iso-arranged
+ ;; windows in the combination.
+ (1+ (window-iso-combinations parent horizontal))))))
+ (when (window-sizable-p parent (- new-size) horizontal)
+ (split-window window (- new-size) side)))
+ ((window-live-p window)
+ (setq new-size (/ old-size 2))
+ ;; When WINDOW is live, the old _and_ the new window must be at
+ ;; least MIN-SIZE large after the split.
+ (when (and (>= new-size min-size)
+ (window-sizable-p window (- new-size) horizontal))
+ ;; Do an even split to make Stepan happy.
+ (split-window window nil side)))
+ (t
+ ;; When WINDOW is internal, the new window must be at least
+ ;; MIN-SIZE large after the split.
+ (setq new-size
+ (max min-size
+ (/ old-size
+ ;; Try to make the size of the new window
+ ;; proportional to the number of iso-arranged
+ ;; subwindows of WINDOW.
+ (1+ (window-iso-combinations window horizontal)))))
+ (when (window-sizable-p window (- new-size) horizontal)
+ (split-window window (- new-size) side))))))
+
+(defun display-buffer-split-window (window &optional side specifiers)
+ "Split WINDOW in a way suitable for `display-buffer'.
+Optional argument SIDE must be a side specifier \(one of the
+symbols below, right, above, left, or nil). SPECIFIERS must be a
+list of buffer display specifiers, see the documentation of
+`display-buffer-alist' for a description.
+
+Return the new window, nil if it could not be created."
+ (let ((min-height (cdr (assq 'pop-up-window-min-height specifiers)))
+ (min-width (cdr (assq 'pop-up-window-min-width specifiers)))
+ size)
+ ;; Normalize min-height and min-width, we might need both.
+ (setq min-height
+ ;; If min-height is specified, it can be as small as
+ ;; `window-safe-min-height'.
+ (cond
+ ((and (integerp min-height)
+ (>= min-height window-safe-min-height))
+ min-height)
+ ((and (floatp min-height)
+ (<= min-height 1)
+ (let* ((root-height (window-total-height
+ (frame-root-window
+ (window-frame window))))
+ (height (round (* min-height root-height))))
+ (when (>= height window-safe-min-height)
+ height))))
+ (t window-min-height)))
+ (setq min-width
+ ;; If min-width is specified, it can be as small as
+ ;; `window-safe-min-width'.
+ (cond
+ ((and (integerp min-width)
+ (>= min-width window-safe-min-width))
+ min-width)
+ ((and (floatp min-width)
+ (<= min-width 1)
+ (let* ((root-width (window-total-width
+ (frame-root-window
+ (window-frame window))))
+ (width (round (* min-width root-width))))
+ (when (>= width window-safe-min-width)
+ width))))
+ (t window-min-width)))
+
+ (or (and (memq side '(nil above below))
+ (display-buffer-split-window-1
+ window (or side 'below) min-height))
+ ;; If SIDE is nil and vertical splitting failed, we try again
+ ;; splitting horizontally this time.
+ (and (memq side '(nil left right))
+ (display-buffer-split-window-1
+ window (or side 'right) min-width))
+ ;; If WINDOW is live and the root window of its frame, try once
+ ;; more splitting vertically, disregarding the min-height
+ ;; specifier this time and using `window-min-height' instead.
+ (and (memq side '(nil above below))
+ (<= window-min-height min-height)
+ (window-live-p window)
+ (eq window (frame-root-window window))
+ (display-buffer-split-window-1
+ window (or side 'below) window-min-height)))))
+
+(defun display-buffer-split-atom-window (window &optional side nest specifiers)
+ "Make WINDOW part of an atomic window."
+ (let ((ignore-window-parameters t)
+ (window-nest t)
+ (selected-window (selected-window))
+ root new new-parent)
+
+ ;; We are in an atomic window.
+ (when (and (window-parameter window 'window-atom) (not nest))
+ ;; Split the root window.
+ (setq window (window-atom-root window)))
+
+ (when (setq new (display-buffer-split-window window side specifiers))
+ (setq new-parent (window-parent window))
+ ;; WINDOW is or becomes atomic.
+ (unless (window-parameter window 'window-atom)
+ (walk-window-subtree
+ (lambda (window)
+ (set-window-parameter window 'window-atom t))
+ window t))
+ ;; New window and any new parent get their window-atom parameter
+ ;; set too.
+ (set-window-parameter new 'window-atom t)
+ (set-window-parameter new-parent 'window-atom t)
+ new)))
+
+(defun display-buffer-pop-up-window (buffer methods &optional specifiers)
+ "Display BUFFER in a new window.
+Return the window displaying BUFFER, nil if popping up the window
+failed. METHODS must be a list of window/side tuples like those
+forming the cdr of the `pop-up-window' buffer display specifier.
+As a special case, the car of such a tuple can be also a live
+window.
+
+Optional argument SPECIFIERS must be a list of buffer display
+specifiers, see the doc-string of `display-buffer-alist' for a
+description."
+ (let* ((frame (display-buffer-frame))
+ (selected-window (frame-selected-window frame))
+ cand window side atomic)
+ (unless (and (cdr (assq 'unsplittable (frame-parameters frame)))
+ ;; Don't split an unsplittable frame unless
+ ;; SPECIFIERS allow it.
+ (not (cdr (assq 'split-unsplittable-frame specifiers))))
+ (catch 'done
+ (dolist (method methods)
+ (setq cand (car method))
+ (setq side (cdr method))
+ (setq window
+ (cond
+ ((eq cand 'largest)
+ ;; The largest window.
+ (get-largest-window frame t))
+ ((eq cand 'lru)
+ ;; The least recently used window.
+ (get-lru-window frame t))
+ ((eq cand 'selected)
+ ;; The selected window.
+ (frame-selected-window frame))
+ ((eq cand 'root)
+ ;; If there are side windows, split the main window
+ ;; else the frame's root window.
+ (or (window-with-parameter 'window-side 'none nil t)
+ (frame-root-window frame)))
+ ((memq cand window-sides)
+ ;; This should gets us the "root" side window if there
+ ;; exists more than one window on that side.
+ (window-with-parameter 'window-side cand nil t))
+ ((windowp cand)
+ ;; A window, directly specified.
+ cand)))
+
+ (when (and (window-any-p window)
+ ;; The window must be on the correct frame,
+ (eq (window-frame window) frame)
+ ;; and must be neither a minibuffer window
+ (not (window-minibuffer-p window))
+ ;; nor a side window.
+ (not (eq (window-parameter window 'window-side) 'side)))
+ (setq window
+ (cond
+ ((memq side display-buffer-side-specifiers)
+ (if (and (window-buffer window)
+ (setq atomic (cdr (assq 'atomic specifiers))))
+ (display-buffer-split-atom-window
+ window side (eq atomic 'nest) specifiers)
+ (display-buffer-split-window window side specifiers)))
+ ((functionp side)
+ (ignore-errors
+ ;; Don't pass any specifiers to this function.
+ (funcall side window)))))
+
+ (when (window-live-p window)
+ ;; Adjust sizes if asked for.
+ (display-buffer-set-height window specifiers)
+ (display-buffer-set-width window specifiers)
+ (set-window-parameter
+ window 'quit-restore (list 'new-window buffer selected-window))
+ (setq display-buffer-window (cons window 'new-window))
+ (display-buffer-in-window buffer window specifiers)
+ (set-window-prev-buffers window nil)
+ (throw 'done window))))))))
+
+(defun display-buffer-pop-up-frame (buffer &optional graphic-only specifiers)
+ "Make a new frame for displaying BUFFER.
+Return the window displaying BUFFER if creating the new frame was
+successful, nil otherwise. Optional argument GRAPHIC-ONLY
+non-nil means to make a new frame on graphic displays only.
+
+SPECIFIERS must be a list of buffer display specifiers, see the
+documentation of `display-buffer-alist' for a description."
+ (unless (or (and graphic-only (not (display-graphic-p)))
+ noninteractive)
+ (let* ((selected-window (selected-window))
+ (function (or (cdr (assq 'pop-up-frame-function specifiers))
+ 'make-frame))
+ (parameters
+ (when (symbolp function)
+ (cdr (assq 'pop-up-frame-alist specifiers))))
+ (frame
+ (if (symbolp function)
+ (funcall function parameters)
+ (funcall function))))
+ (when frame
+ (let ((window (frame-selected-window frame)))
+ (set-window-parameter
+ window 'quit-restore (list 'new-frame buffer selected-window))
+ (setq display-buffer-window (cons window 'new-frame))
+ (display-buffer-in-window buffer window specifiers))))))
+
+(defun display-buffer-pop-up-side-window (buffer side slot &optional specifiers)
+ "Display BUFFER in a new window on SIDE of the selected frame.
+SLOT specifies the slot to use. SPECIFIERS must be a list of
+buffer display specifiers.
+
+Return the window displaying BUFFER, nil if popping up the window
+failed."
+ (let* ((root (frame-root-window))
+ (main (window-with-parameter 'window-side 'none nil t))
+ (left-or-right (memq side '(left right)))
+ (main-or-root
+ (if (and main
+ (or (and left-or-right (not window-sides-vertical))
+ (and (not left-or-right) window-sides-vertical)))
+ main
+ root))
+ (selected-window (selected-window))
+ (on-side (cond
+ ((eq side 'top) 'above)
+ ((eq side 'bottom) 'below)
+ (t side)))
+ (window
+ (display-buffer-split-window main-or-root on-side specifiers))
+ fun)
+ (when window
+ (unless main
+ (walk-window-subtree
+ (lambda (window)
+ ;; Make all main-or-root subwindows main windows.
+ (set-window-parameter window 'window-side 'none))
+ main-or-root t))
+ ;; Make sure that parent's window-side is nil.
+ (set-window-parameter (window-parent window) 'window-side nil)
+ ;; Initialize side.
+ (set-window-parameter window 'window-side side)
+ ;; Adjust sizes if asked for.
+ (display-buffer-set-height window specifiers)
+ (display-buffer-set-width window specifiers)
+ ;; Set window parameters.
+ (set-window-parameter
+ window 'quit-restore (list 'new-window buffer selected-window))
+ (setq display-buffer-window (cons window 'new-window))
+ (set-window-parameter window 'window-slot slot)
+ (display-buffer-in-window buffer window specifiers)
+ (set-window-prev-buffers window nil)
+ window)))
+
+(defun display-buffer-in-side-window (buffer side &optional slot specifiers)
+ "Display BUFFER in a window on SIDE of the selected frame.
+SLOT, if non-nil, specifies the window slot where to display the
+BUFFER. SLOT zero or nil means use the central slot on SIDE.
+SLOT negative means use a slot preceding the central window.
+SLOT positive means use a slot following the central window.
+
+SPECIFIERS must be a list of buffer display specifiers."
+ (unless (memq side window-sides)
+ (error "Invalid side %s specified" side))
+ (let* ((major (window-with-parameter 'window-side side nil t))
+ ;; `major' is the major window on SIDE, `windows' the life
+ ;; windows on SIDE.
+ (windows (when major (windows-with-parameter 'window-side side)))
+ (reuse-dedicated (cdr (assq 'reuse-window-dedicated specifiers)))
+ (slots (when major (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 dedicated)
+
+ (unless (numberp slot)
+ (setq slot 0))
+ (if (not windows)
+ ;; No suitable side window exists, make one.
+ (display-buffer-pop-up-side-window buffer side slot specifiers)
+ ;; Scan windows on SIDE.
+ (catch 'found
+ (dolist (window windows)
+ (setq this-slot (window-parameter window 'window-slot))
+ (cond
+ ((not (numberp this-slot)))
+ ((and (= this-slot slot)
+ ;; Dedicatedness check.
+ (or (not (setq dedicated (window-dedicated-p window)))
+ ;; If the window is weakly dedicated to its
+ ;; buffer, reuse-dedicated must be non-nil.
+ (and (not (eq dedicated t)) reuse-dedicated)
+ ;; If the window is strongly dedicated to its
+ ;; buffer, reuse-dedicated must be t.
+ (eq reuse-dedicated t)))
+ ;; Window with matching SLOT, use it.
+ (setq this-window window)
+ (throw 'found t))
+ (t
+ (setq abs-slot (abs (- (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.
+ (or (and this-window
+ ;; Reuse this window.
+ (prog1
+ (setq window this-window)
+ (if (eq (window-buffer window) buffer)
+ (setq display-buffer-window
+ (cons window 'reuse-buffer-window))
+ (setq display-buffer-window
+ (cons window 'reuse-other-window))
+ (unless (window-parameter window 'quit-restore)
+ ;; Don't overwrite an existing quit-restore entry.
+ (set-window-parameter
+ window 'quit-restore
+ (list (window-buffer window) (window-start window)
+ (window-point window) buffer
+ (window-total-size window) (selected-window)))))))
+ (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)))
+ (setq window (display-buffer-split-window
+ next-window next-side specifiers))))
+ (and prev-window
+ ;; Make new window after prev-window.
+ (let ((prev-side
+ (if (memq side '(left right)) 'below 'right)))
+ (setq window (display-buffer-split-window
+ prev-window prev-side specifiers)))))
+ (progn
+ (display-buffer-set-height window specifiers)
+ (display-buffer-set-width window specifiers)
+ (set-window-parameter
+ window 'quit-restore
+ (list 'new-window buffer selected-window))
+ (setq display-buffer-window (cons window 'new-window))
+ window))
+ (and best-window
+ (setq window best-window)
+ ;; Reuse best window (the window nearest to SLOT).
+ (if (eq (window-buffer window) buffer)
+ (setq display-buffer-window
+ (cons window 'reuse-buffer-window))
+ (setq display-buffer-window
+ (cons window 'reuse-other-window))
+
+ (unless (window-parameter window 'quit-restore)
+ ;; Don't overwrite an existing quit-restore entry.
+ (set-window-parameter
+ window 'quit-restore
+ (list (window-buffer window) (window-start window)
+ (window-point window) buffer
+ (window-total-size window) (selected-window)))))
+ window))
+
+ (when window
+ (unless (window-parameter window 'window-slot)
+ ;; Don't change exisiting slot value.
+ (set-window-parameter window 'window-slot slot))
+ (display-buffer-in-window buffer window specifiers)))))
+
+(defun window-normalize-buffer-to-display (buffer-or-name)
+ "Normalize BUFFER-OR-NAME argument for buffer display functions.
+If BUFFER-OR-NAME is nil, return the curent buffer. Else, if a
+buffer specified by BUFFER-OR-NAME exists, return that buffer.
+If no such buffer exists, create a buffer with the name
+BUFFER-OR-NAME and return that buffer."
+ (if buffer-or-name
+ (or (get-buffer buffer-or-name)
+ (let ((buffer (get-buffer-create buffer-or-name)))
+ (set-buffer-major-mode buffer)
+ buffer))
+ (current-buffer)))
+
+(defun display-buffer-other-window-means-other-frame (buffer-or-name &optional label)
+ "Return non-nil if BUFFER shall be preferably displayed in another frame.
+BUFFER must be a live buffer or the name of a live buffer.
+
+Return nil if BUFFER shall be preferably displayed in another
+window on the selected frame. Return non-nil if BUFFER shall be
+preferably displayed in a window on any but the selected frame.
+
+Optional argument LABEL is like the same argument of
+`display-buffer'.
+
+The calculation of the return value is exclusively based on the
+user preferences expressed in `display-buffer-alist'."
+ (let* ((buffer-name
+ (buffer-name (window-normalize-buffer buffer-or-name)))
+ (default (display-buffer-normalize-default buffer-name))
+ (alist (display-buffer-normalize-alist buffer-name label)))
+ (or (cdr (assq 'other-window-means-other-frame default))
+ (cdr (assq 'other-window-means-other-frame (cdr alist))))))
+
+(defun display-buffer-normalize-special (&optional args)
+ "Return buffer display specifiers for `special-display-frame-alist'."
+ (progn ;; <-- reserved for with-no-warnings
+ (if (and (listp args) (symbolp (car args)))
+ ;; Note: `display-buffer' funcalls this so take "(nth 1 args)"
+ ;; where `special-display-popup-frame' (which uses apply) takes
+ ;; "(cdr args)".
+ `((function ,(car args) ,(nth 1 args)))
+ (append
+ '((reuse-window nil same 0))
+ (when (and (listp args) (cdr (assq 'same-window args)))
+ '((reuse-window same nil nil) (reuse-dedicated . weak)))
+ (when (and (listp args)
+ (or (cdr (assq 'same-frame args))
+ (cdr (assq 'same-window args))))
+ '((pop-up-window (largest . nil) (lru . nil))
+ (reuse-window nil nil nil)))
+ (unless display-buffer-mark-dedicated
+ ;; Don't make anything created above dedicated unless requested.
+ ;; Otherwise the dedication request below gets in our way.
+ '((dedicate . nil)))
+ `((pop-up-frame t)
+ ,(append '(pop-up-frame-alist)
+ (when (listp args) args)
+ special-display-frame-alist)
+ (dedicate . t))))))
+
+(defun display-buffer-normalize-default (buffer-or-name)
+ "Subroutine of `display-buffer-normalize-specifiers'.
+BUFFER-OR-NAME is the buffer to display.
+
+This routine provides a compatibility layer for the obsolete
+Emacs 23 buffer display options to set up the corresponding
+buffer display specifiers."
+ (progn ;; <-- reserved for with-no-warnings
+ (let* ((buffer (window-normalize-buffer buffer-or-name))
+ (buffer-name (buffer-name buffer))
+ (pop-up-frames
+ (and (boundp 'pop-up-frames)
+ (or (and (eq pop-up-frames 'graphic-only)
+ (display-graphic-p))
+ pop-up-frames)))
+ specifiers args)
+ ;; `other-window-means-other-frame'
+ (when pop-up-frames
+ (setq specifiers
+ (cons (cons 'other-window-means-other-frame t) specifiers)))
+
+ ;; `even-window-heights'
+ (unless (and (boundp 'even-window-heights)
+ (not even-window-heights))
+ (setq specifiers
+ (cons (cons 'reuse-window-even-sizes t) specifiers)))
+
+ ;; `display-buffer-mark-dedicated'
+ (when (and (boundp 'display-buffer-mark-dedicated)
+ display-buffer-mark-dedicated)
+ (setq specifiers
+ (cons (cons 'dedicate display-buffer-mark-dedicated)
+ specifiers)))
+
+ ;; `pop-up-window-min-height'
+ (let ((min-height
+ (if (boundp 'split-height-threshold)
+ (if (numberp split-height-threshold)
+ (/ split-height-threshold 2)
+ 1.0)
+ 40)))
+ (setq specifiers
+ (cons (cons 'pop-up-window-min-height min-height)
+ specifiers)))
+
+ ;; `pop-up-window-min-width'
+ (let ((min-width
+ (if (boundp 'split-width-threshold)
+ (if (numberp split-width-threshold)
+ (/ split-width-threshold 2)
+ 1.0)
+ 80)))
+ (setq specifiers
+ (cons (cons 'pop-up-window-min-width min-width)
+ specifiers)))
+
+ ;; `pop-up-window'
+ (unless (and (boundp 'pop-up-windows) (not pop-up-windows))
+ (let ((fun (when (and (boundp 'split-window-preferred-function)
+ (not (eq split-window-preferred-function
+ 'split-window-sensibly)))
+ split-window-preferred-function)))
+ ;; `pop-up-window'
+ (setq specifiers
+ (cons
+ (list 'pop-up-window (cons 'largest fun) (cons 'lru fun))
+ specifiers))))
+
+ ;; `pop-up-frame-function'
+ (when (and (boundp 'pop-up-frame-function)
+ (not (equal pop-up-frame-function
+ '(lambda nil
+ (make-frame pop-up-frame-alist)))))
+ (setq specifiers
+ (cons (cons 'pop-up-frame-function pop-up-frame-function)
+ specifiers)))
+
+ ;; `pop-up-frame-alist'
+ (when pop-up-frame-alist
+ (setq specifiers
+ (cons (cons 'pop-up-frame-alist pop-up-frame-alist)
+ specifiers)))
+
+ ;; `pop-up-frame'
+ (when pop-up-frames
+ ;; `pop-up-frame-function'. If `pop-up-frame-function' uses the
+ ;; now obsolete `pop-up-frame-alist' it will continue to do so.
+ ;; `pop-up-frame'
+ (setq specifiers
+ ;; Maybe we should merge graphic-only into the following?
+ (cons (list 'pop-up-frame t) specifiers)))
+
+ ;; `special-display'
+ (when (and (boundp 'special-display-function)
+ special-display-function
+ (fboundp 'special-display-p)
+ (setq args (special-display-p buffer-name)))
+ ;; `special-display-p' returns either t or a list of arguments
+ ;; to pass to `special-display-function'.
+ (if (eq special-display-function 'special-display-popup-frame)
+ (setq specifiers
+ (append (display-buffer-normalize-special args)
+ specifiers))
+ (setq specifiers
+ (cons
+ `(function ,special-display-function ,(when (listp args) args))
+ specifiers))))
+
+ ;; Reuse window showing same buffer on visible or iconified frame.
+ ;; `pop-up-frames', `display-buffer-reuse-frames' means search for
+ ;; a window showing the buffer on some visible or iconfied frame.
+ ;; `last-nonminibuffer-frame' non-nil means search that frame.
+ (let ((frames (or (and (or pop-up-frames
+ (and (boundp 'display-buffer-reuse-frames)
+ display-buffer-reuse-frames)
+ (not (last-nonminibuffer-frame)))
+ ;; All visible or iconfied frames.
+ 0)
+ ;; The following usually returns the same frame
+ ;; so we implicitly search for a window showing
+ ;; the buffer on the same frame already.
+ (last-nonminibuffer-frame))))
+ (when frames
+ (setq specifiers
+ (cons (list 'reuse-window 'other 'same frames)
+ specifiers))))
+
+ ;; `same-window'
+ (when (and (fboundp 'same-window-p) (same-window-p buffer-name))
+ ;; Try to reuse the same (selected) window.
+ (setq specifiers
+ (cons (list 'reuse-window 'same nil nil) specifiers)))
+
+ ;; Same window if showing this buffer already. Can be overridden
+ ;; by `other-window' argument if the buffer is already shown in
+ ;; the same window.
+ (setq specifiers
+ (cons (list 'reuse-window 'same 'same nil) specifiers))
+
+ specifiers)))
+
+(defun display-buffer-normalize-argument (buffer-name specifiers other-window-means-other-frame)
+ "Normalize second argument of `display-buffer'.
+BUFFER-NAME is the name of the buffer that shall be displayed,
+SPECIFIERS is the second argument of `display-buffer'.
+OTHER-WINDOW-MEANS-OTHER-FRAME non-nil means use other-frame for
+other-window."
+ (progn ;; <-- reserved for with-no-warnings
+ (let (normalized entry specifier pars)
+ (cond
+ ((not specifiers)
+ nil)
+ ((listp specifiers)
+ ;; If SPECIFIERS is a list, we assume it is a list of valid
+ ;; specifiers.
+ (dolist (specifier specifiers)
+ (cond
+ ((consp specifier)
+ (setq normalized (cons specifier normalized)))
+ ((eq specifier 'other-window)
+ ;; `other-window' must be treated separately.
+ (let ((entry (assq (if other-window-means-other-frame
+ 'other-frame
+ 'same-frame-other-window)
+ display-buffer-macro-specifiers)))
+ (dolist (item (cdr entry))
+ (setq normalized (cons item normalized)))))
+ ((symbolp specifier)
+ ;; Might be a macro specifier, try to expand it (the cdr is a
+ ;; list and we have to reverse it later, so do it one at a
+ ;; time).
+ (let ((entry (assq specifier display-buffer-macro-specifiers)))
+ (dolist (item (cdr entry))
+ (setq normalized (cons item normalized)))))))
+ ;; Reverse list.
+ (nreverse normalized))
+ ((setq entry (assq specifiers display-buffer-macro-specifiers))
+ ;; A macro specifier.
+ (cdr entry))
+ (t
+ ;; Anything else means use another window according to the
+ ;; non-overriding specifiers of `display-buffer-alist' and the
+ ;; specifiers produced by `display-buffer-normalize-default'.
+ '((other-window . t)))))))
+
+(defun display-buffer-normalize-alist-1 (specifiers label)
+ "Subroutine of `display-buffer-normalize-alist'.
+SPECIFIERS is a list of buffer display specfiers. LABEL is the
+same argument of `display-buffer'."
+ (let (normalized entry)
+ (cond
+ ((not specifiers)
+ nil)
+ ((listp specifiers)
+ ;; If SPECIFIERS is a list, we assume it is a list of specifiers.
+ (dolist (specifier specifiers)
+ (cond
+ ((consp specifier)
+ (setq normalized (cons specifier normalized)))
+ ((symbolp specifier)
+ ;; Might be a macro specifier, try to expand it (the cdr is a
+ ;; list and we have to reverse it later, so do it one at a
+ ;; time).
+ (let ((entry (assq specifier display-buffer-macro-specifiers)))
+ (dolist (item (cdr entry))
+ (setq normalized (cons item normalized)))))))
+ ;; Reverse list.
+ (nreverse normalized))
+ ((setq entry (assq specifiers display-buffer-macro-specifiers))
+ ;; A macro specifier.
+ (cdr entry)))))
+
+(defun display-buffer-normalize-alist (buffer-name label)
+ "Normalize `display-buffer-alist'.
+BUFFER-NAME must be the name of the buffer that shall be displayed.
+LABEL the corresponding argument of `display-buffer'."
+ (let (list-1 list-2)
+ (dolist (entry display-buffer-alist)
+ (when (and (listp entry)
+ (catch 'match
+ (dolist (id (car entry))
+ (when (consp id)
+ (let ((type (car id))
+ (value (cdr id)))
+ (when (or (and (eq type 'name) (stringp value)
+ (equal value buffer-name))
+ (and (eq type 'regexp) (stringp value)
+ (string-match-p value buffer-name))
+ (and (eq type 'label) (eq value label)))
+ (throw 'match t)))))))
+ (let* ((specifiers (cdr entry))
+ (normalized
+ (display-buffer-normalize-alist-1 specifiers label)))
+ (if (cdr (assq 'override specifiers))
+ (setq list-1
+ (if list-1
+ (append list-1 normalized)
+ normalized))
+ (setq list-2
+ (if list-2
+ (append list-2 normalized)
+ normalized))))))
+
+ (cons list-1 list-2)))
+
+(defun display-buffer-normalize-specifiers (buffer-name specifiers label)
+ "Return normalized specifiers for a buffer matching BUFFER-NAME or LABEL.
+BUFFER-NAME must be a string specifying a valid buffer name.
+SPECIFIERS and LABEL are the homonymous arguments of
+`display-buffer'.
+
+The method for displaying the buffer specified by BUFFER-NAME or
+LABEL is established by appending the following four lists of
+specifiers:
+
+- The specifiers in `display-buffer-alist' whose buffer
+ identifier matches BUFFER-NAME or LABEL and whose 'override
+ component is set.
+
+- SPECIFIERS.
+
+- The specifiers in `display-buffer-alist' whose buffer
+ identifier matches BUFFER-NAME or LABEL and whose 'override
+ component is not set."
+ (let* ((default (display-buffer-normalize-default buffer-name))
+ (alist (display-buffer-normalize-alist buffer-name label))
+ (other-window-means-other-frame
+ (or (cdr (assq 'other-window-means-other-frame default))
+ (cdr (assq 'other-window-means-other-frame (cdr alist)))))
+ (arg2 (display-buffer-normalize-argument
+ buffer-name specifiers other-window-means-other-frame))
+ (arg3
+ ;; Handle special meaning of the LABEL argument of
+ ;; `display-buffer'.
+ (when (or (memq label '(visible 0 t)) (frame-live-p label))
+ ;; LABEL must be one of visible (any visible frame), 0 (any
+ ;; visible or iconfied frame), t (any frame), or a live
+ ;; frame.
+ `((reuse-window nil same ,label)))))
+ (append
+ ;; Overriding user specifiers.
+ (car alist)
+ ;; Special value of third argument of display-buffer.
+ arg3
+ ;; Second argument of display-buffer.
+ arg2
+ ;; Non-overriding user specifiers.
+ (cdr alist)
+ ;; Default specifiers.
+ default)))
+
+;; Minibuffer-only frames should be documented better. They really
+;; deserve a separate section in the manual. Also
+;; `last-nonminibuffer-frame' is nowhere documented in the manual.
+(defun display-buffer-frame (&optional frame)
+ "Return FRAME if it is live and not a minibuffer-only frame.
+Return the value of `last-nonminibuffer-frame' otherwise."
+ (setq frame (window-normalize-frame frame))
+ (if (and (frame-live-p frame)
+ ;; A not very nice way to get that information.
+ (not (window-minibuffer-p (frame-root-window frame))))
+ frame
+ (last-nonminibuffer-frame)))
+
+(defun display-buffer (&optional buffer-or-name specifiers label)
+ "Make the buffer specified by BUFFER-OR-NAME appear in some window.
+Optional argument BUFFER-OR-NAME may be a buffer, a string \(a
+buffer name), or nil. If BUFFER-OR-NAME is a string not naming
+an existent buffer, create a buffer with that name. If
+BUFFER-OR-NAME is nil or omitted, display the current buffer.
+Interactively, prompt for the buffer name using the minibuffer.
+
+Return the window chosen to display the buffer or nil if no such
+window is found. Do not change the selected window unless the
+buffer is shown on a different frame than the selected one.
+
+Optional argument SPECIFIERS must be a list of buffer display
+specifiers, see the documentation of `display-buffer-alist' for a
+description.
+
+For convenience, SPECIFIERS may also consist of a single buffer
+display location specifier or t, where the latter means to
+display the buffer in any but the selected window. If SPECIFIERS
+is nil or omitted, this means to exclusively use the specifiers
+provided by the variable `display-buffer-alist' and the function
+`display-buffer-normalize-default'.
+
+As a special case, the `reuse-window' specifier allows to specify
+as second element an arbitrary window, as third element an
+arbitrary buffer, and as fourth element an arbitrary frame. As
+first element of a window/side pair of the `pop-up-window'
+specifier you can specifiy an arbitrary window.
+
+The optional third argument LABEL, if non-nil, must be a symbol
+specifiying the buffer display label. Applications should set
+this when the buffer shall be displayed in some special way but
+BUFFER-OR-NAME does not identify the buffer as special. Typical
+buffers that fit into this category are those whose names are
+derived from the name of the file they are visiting. A user can
+override SPECIFIERS by adding an entry to `display-buffer-alist'
+whose car contains LABEL and whose cdr specifies the preferred
+alternative display method.
+
+The following values of LABEL have a special meaning and allow to
+specify the set of frames to investigate when the buffer already
+appears in a window:
+
+`visible' - the set of visible frames.
+
+0 - the set of visible or iconified frames.
+
+t - the set of all frames.
+
+A live frame - the set containing that frame as its only element.
+
+If the buffer is already displayed in a window on a frame in the
+specified set, return that window.
+
+The method to display the buffer is derived by combining the
+values of `display-buffer-alist' and SPECIFIERS. Highest
+priority is given to overriding elements of
+`display-buffer-alist'. Next come the elements specified by
+SPECIFIERS, followed by the non-overriding elements of
+`display-buffer-alist'.
+
+The result must be a list of valid buffer display specifiers. If
+`display-buffer-function' is non-nil, call it with the buffer and
+this list as arguments."
+ (interactive "BDisplay buffer:\nP")
+ (let* ((buffer (window-normalize-buffer-to-display buffer-or-name))
+ (buffer-name (buffer-name buffer))
+ (normalized
+ ;; Normalize specifiers.
+ (display-buffer-normalize-specifiers buffer-name specifiers label))
+ ;; Don't use a minibuffer frame.
+ (frame (display-buffer-frame))
+ ;; `window' is the window we use for showing `buffer'.
+ window specifier method other-window)
+ ;; Reset this.
+ (setq display-buffer-window nil)
+ (if display-buffer-function
+ ;; Let `display-buffer-function' do the job.
+ (funcall display-buffer-function buffer specifiers)
+ ;; Retrieve the next location specifier while there a specifiers
+ ;; left and we don't have a valid window.
+ (while (and normalized (not (window-live-p window)))
+ (setq specifier (car normalized))
+ (setq normalized (cdr normalized))
+ (setq method (car specifier))
+ (setq window
+ (cond
+ ((eq method 'reuse-window)
+ (display-buffer-reuse-window
+ buffer (cdr specifier) normalized other-window))
+ ((eq method 'pop-up-window)
+ (display-buffer-pop-up-window
+ buffer (cdr specifier) normalized))
+ ((eq method 'pop-up-frame)
+ (display-buffer-pop-up-frame
+ buffer (cdr specifier) normalized))
+ ((eq method 'use-side-window)
+ (display-buffer-in-side-window
+ buffer (nth 1 specifier) (nth 2 specifier) normalized))
+ ((eq method 'function)
+ (funcall (nth 1 specifier) buffer (nth 2 specifier)))
+ ((eq method 'other-window)
+ (setq other-window t)))))
+
+ ;; If we don't have a window yet, try a fallback method. All
+ ;; specifiers have been used up by now. Try reusing a window
+ (or (and (window-live-p window) window)
+ ;; on the selected frame,
+ (display-buffer-reuse-window
+ buffer '(nil nil nil) nil other-window)
+ ;; showing BUFFER on any visible frame,
+ (display-buffer-reuse-window
+ buffer '(nil same visible) nil other-window)
+ ;; not showing BUFFER on any visible frame,
+ (display-buffer-reuse-window
+ buffer '(nil other visible) nil other-window)
+ ;; showing BUFFER on any visible or iconified frame,
+ (display-buffer-reuse-window
+ buffer '(nil same 0) nil other-window)
+ ;; not showing BUFFER on any visible or iconified frame.
+ (display-buffer-reuse-window
+ buffer '(nil other 0) nil other-window)
+ ;; If everything failed so far, try popping up a new frame
+ ;; regardless of graphic-only restrictions.
+ (display-buffer-pop-up-frame buffer)))))
+
+(defsubst display-buffer-same-window (&optional buffer-or-name label)
+ "Display buffer specified by BUFFER-OR-NAME in the selected window.
+Another window will be used only if the buffer can't be shown in
+the selected window, usually because it is dedicated to another
+buffer. Optional argument BUFFER-OR-NAME and LABEL are as for
+`display-buffer'."
+ (interactive "BDisplay buffer in same window:\nP")
+ (display-buffer buffer-or-name 'same-window label))
+
+(defsubst display-buffer-same-frame (&optional buffer-or-name label)
+ "Display buffer specified by BUFFER-OR-NAME in a window on the same frame.
+Another frame will be used only if there is no other choice.
+Optional argument BUFFER-OR-NAME and LABEL are as for
+`display-buffer'."
+ (interactive "BDisplay buffer on same frame:\nP")
+ (display-buffer buffer-or-name 'same-frame label))
+
+(defsubst display-buffer-other-window (&optional buffer-or-name label)
+ "Display buffer specified by BUFFER-OR-NAME in another window.
+The selected window will be used only if there is no other
+choice. Windows on the selected frame are preferred to windows
+on other frames. Optional argument BUFFER-OR-NAME and LABEL are as
+for `display-buffer'."
+ (interactive "BDisplay buffer in another window:\nP")
+ (display-buffer buffer-or-name 'other-window label))
+
+(defun display-buffer-same-frame-other-window (&optional buffer-or-name label)
+ "Display buffer specified by BUFFER-OR-NAME in another window on the same frame.
+The selected window or another frame will be used only if there
+is no other choice. Optional argument BUFFER-OR-NAME and LABEL are
+as for `display-buffer'."
+ (interactive "BDisplay buffer in another window on same frame:\nP")
+ (display-buffer buffer-or-name 'same-frame-other-window label))
+
+(defun display-buffer-other-frame (&optional buffer-or-name label)
+ "Display buffer specified by BUFFER-OR-NAME on another frame.
+The selected frame will be used only if there is no other choice.
+Optional argument BUFFER-OR-NAME and LABEL are as for
+`display-buffer'.
+
+If this command uses another frame, it will also select that frame."
+ (interactive "BDisplay buffer in other frame: ")
+ (display-buffer buffer-or-name 'other-frame label))
+
+(defun pop-to-buffer (&optional buffer-or-name specifiers norecord label)
+ "Display buffer specified by BUFFER-OR-NAME and select the window used.
+Optional argument BUFFER-OR-NAME may be a buffer, a string \(a
+buffer name), or nil. If BUFFER-OR-NAME is a string naming a buffer
+that does not exist, create a buffer with that name. If
+BUFFER-OR-NAME is nil or omitted, display the current buffer.
+Interactively, prompt for the buffer name using the minibuffer.
+
+Optional second argument SPECIFIERS can be: a list of buffer
+display specifiers (see `display-buffer-alist'); a single
+location specifier; t, which means to display the buffer in any
+but the selected window; or nil, which means to exclusively apply
+the specifiers customized by the user. See `display-buffer' for
+more details.
+
+Optional argument NORECORD non-nil means do not put the displayed
+buffer at the front of the buffer list, and do not make the window
+displaying it the most recently selected one.
+
+The optional argument LABEL, if non-nil, is a symbol specifying the
+display purpose. Applications should set this when the buffer
+should be displayed in a special way but BUFFER-OR-NAME does not
+identify the buffer as special. Buffers that typically fit into
+this category are those whose names have been derived from the
+name of the file they are visiting.
+
+Returns the displayed buffer, or nil if displaying the buffer failed.
+
+This uses the function `display-buffer' as a subroutine; see the
+documentations of `display-buffer' and `display-buffer-alist' for
+additional information."
+ (interactive "BPop to buffer:\nP")
+ (let ((buffer (window-normalize-buffer-to-display buffer-or-name))
+ (old-window (selected-window))
+ (old-frame (selected-frame))
+ new-window new-frame)
+ (set-buffer buffer)
+ (setq new-window (display-buffer buffer specifiers label))
+ (unless (eq new-window old-window)
+ ;; `display-buffer' has chosen another window, select it.
+ (select-window new-window norecord)
+ (setq new-frame (window-frame new-window))
+ (unless (eq new-frame old-frame)
+ ;; `display-buffer' has chosen another frame, make sure it gets
+ ;; input focus and is risen.
+ (select-frame-set-input-focus new-frame)))
+
+ buffer))
+
+(defsubst pop-to-buffer-same-window (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME in the selected window.
+Another window will be used only if the buffer can't be shown in
+the selected window, usually because it is dedicated to another
+buffer. Optional arguments BUFFER-OR-NAME, NORECORD and LABEL are
+as for `pop-to-buffer'."
+ (interactive "BPop to buffer in selected window:\nP")
+ (pop-to-buffer buffer-or-name 'same-window norecord label))
+
+(defsubst pop-to-buffer-same-frame (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME in a window on the selected frame.
+Another frame will be used only if there is no other choice.
+Optional arguments BUFFER-OR-NAME, NORECORD and LABEL are as for
+`pop-to-buffer'."
+ (interactive "BPop to buffer on same frame:\nP")
+ (pop-to-buffer buffer-or-name 'same-frame norecord label))
+
+(defsubst pop-to-buffer-other-window (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME in another window.
+The selected window will be used only if there is no other
+choice. Windows on the selected frame are preferred to windows
+on other frames. Optional arguments BUFFER-OR-NAME, NORECORD and
+LABEL are as for `pop-to-buffer'."
+ (interactive "BPop to buffer in another window:\nP")
+ (pop-to-buffer buffer-or-name 'other-window norecord))
+
+(defsubst pop-to-buffer-same-frame-other-window (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME in another window on the selected frame.
+The selected window or another frame will be used only if there
+is no other choice. Optional arguments BUFFER-OR-NAME, NORECORD
+and LABEL are as for `pop-to-buffer'."
+ (interactive "BPop to buffer in another window on same frame:\nP")
+ (pop-to-buffer buffer-or-name 'same-frame-other-window norecord label))
+
+(defsubst pop-to-buffer-other-frame (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME on another frame.
+The selected frame will be used only if there's no other choice.
+Optional arguments BUFFER-OR-NAME, NORECORD and LABEL are as for
+`pop-to-buffer'."
+ (interactive "BPop to buffer on another frame:\nP")
+ (pop-to-buffer buffer-or-name 'other-frame norecord label))
+
+(defun read-buffer-to-switch (prompt)
+ "Read the name of a buffer to switch to, prompting with PROMPT.
+Return the neame of the buffer as a string.
+
+This function is intended for the `switch-to-buffer' family of
+commands since these need to omit the name of the current buffer
+from the list of completions and default values."
+ (let ((rbts-completion-table (internal-complete-buffer-except)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuffer-completion-table rbts-completion-table)
+ ;; Since rbts-completion-table is built dynamically, we
+ ;; can't just add it to the default value of
+ ;; icomplete-with-completion-tables, so we add it
+ ;; here manually.
+ (if (and (boundp 'icomplete-with-completion-tables)
+ (listp icomplete-with-completion-tables))
+ (set (make-local-variable 'icomplete-with-completion-tables)
+ (cons rbts-completion-table
+ icomplete-with-completion-tables))))
+ (read-buffer prompt (other-buffer (current-buffer))
+ (confirm-nonexistent-file-or-buffer)))))
+
+(defun window-normalize-buffer-to-switch-to (buffer-or-name)
+ "Normalize BUFFER-OR-NAME argument of buffer switching functions.
+If BUFFER-OR-NAME is nil, return the buffer returned by
+`other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME
+exists, return that buffer. If no such buffer exists, create a
+buffer with the name BUFFER-OR-NAME and return that buffer."
+ (if buffer-or-name
+ (or (get-buffer buffer-or-name)
+ (let ((buffer (get-buffer-create buffer-or-name)))
+ (set-buffer-major-mode buffer)
+ buffer))
+ (other-buffer)))
+
+(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
+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'.
+
+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 FORCE-SAME-WINDOW is non-nil, BUFFER-OR-NAME must be displayed
+in the currently selected window; signal an error if that is
+impossible (e.g. if the selected window is minibuffer-only).
+If non-nil, BUFFER-OR-NAME may be displayed in another window.
+
+Return the buffer switched to."
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer: ") nil nil))
+ (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
+ (if (null force-same-window)
+ (pop-to-buffer buffer-or-name
+ '(same-window (reuse-window-dedicated . weak))
+ norecord nil)
+ (cond
+ ;; Don't call set-window-buffer if it's not needed since it
+ ;; might signal an error (e.g. if the window is dedicated).
+ ((eq buffer (window-buffer)) nil)
+ ((window-minibuffer-p)
+ (error "Cannot switch buffers in minibuffer window"))
+ ((eq (window-dedicated-p) t)
+ (error "Cannot switch buffers in a dedicated window"))
+ (t (set-window-buffer nil buffer)))
+ (unless norecord
+ (select-window (selected-window)))
+ (set-buffer buffer))))
+
+(defun switch-to-buffer-same-frame (buffer-or-name &optional norecord)
+ "Switch to buffer BUFFER-OR-NAME in a window on the selected frame.
+Another frame will be used only if there is no other choice.
+Arguments BUFFER-OR-NAME and NORECORD have the same meaning as
+for `switch-to-buffer'.
+
+This function is intended for interactive use only. Lisp
+functions should call `pop-to-buffer-same-frame' instead."
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer in other window: ")))
+ (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
+ (pop-to-buffer buffer 'same-frame norecord)))
+
+(defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
+ "Switch to buffer BUFFER-OR-NAME in another window.
+The selected window will be used only if there is no other
+choice. Windows on the selected frame are preferred to windows
+on other frames. Arguments BUFFER-OR-NAME and NORECORD have the
+same meaning as for `switch-to-buffer'.
+
+This function is intended for interactive use only. Lisp
+functions should call `pop-to-buffer-other-window' instead."
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer in other window: ")))
+ (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
+ (pop-to-buffer buffer 'other-window norecord)))
+
+(defun switch-to-buffer-other-window-same-frame (buffer-or-name &optional norecord)
+ "Switch to buffer BUFFER-OR-NAME in another window on the selected frame.
+The selected window or another frame will be used only if there
+is no other choice. Arguments BUFFER-OR-NAME and NORECORD have
+the same meaning as for `switch-to-buffer'.
+
+This function is intended for interactive use only. Lisp
+functions should call `pop-to-buffer-other-window-same-frame'
+instead."
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer in other window: ")))
+ (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
+ (pop-to-buffer buffer 'same-frame-other-window norecord)))
+
+(defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
+ "Switch to buffer BUFFER-OR-NAME on another frame.
+The same frame will be used only if there is no other choice.
+Arguments BUFFER-OR-NAME and NORECORD have the same meaning
+as for `switch-to-buffer'.
+
+This function is intended for interactive use only. Lisp
+functions should call `pop-to-buffer-other-frame' instead."
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
+ (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
+ (pop-to-buffer buffer 'other-frame norecord)))
+
+;;; Obsolete definitions of `display-buffer' below.
+(defcustom same-window-buffer-names nil
+ "List of names of buffers that should appear in the \"same\" window.
+`display-buffer' and `pop-to-buffer' show a buffer whose name is
+on this list in the selected rather than some other window.
+
+An element of this list can be a cons cell instead of just a
+string. In that case, the cell's car must be a string specifying
+the buffer name. This is for compatibility with
+`special-display-buffer-names'; the cdr of the cons cell is
+ignored.
+
+See also `same-window-regexps'."
+ :type '(repeat (string :format "%v"))
+ :group 'windows)
+;; (make-obsolete-variable
+ ;; 'same-window-buffer-names
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defcustom same-window-regexps nil
+ "List of regexps saying which buffers should appear in the \"same\" window.
+`display-buffer' and `pop-to-buffer' show a buffer whose name
+matches a regexp on this list in the selected rather than some
+other window.
+
+An element of this list can be a cons cell instead of just a
+string. In that case, the cell's car must be a regexp matching
+the buffer name. This is for compatibility with
+`special-display-regexps'; the cdr of the cons cell is ignored.
+
+See also `same-window-buffer-names'."
+ :type '(repeat (regexp :format "%v"))
+ :group 'windows)
+;; (make-obsolete-variable
+ ;; 'same-window-regexps
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defun same-window-p (buffer-name)
+ "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
+This function returns non-nil if `display-buffer' or
+`pop-to-buffer' would show a buffer named BUFFER-NAME in the
+selected rather than \(as usual\) some other window. See
+`same-window-buffer-names' and `same-window-regexps'."
+ (let ((buffer-names (with-no-warnings same-window-buffer-names))
+ (regexps (with-no-warnings same-window-regexps)))
+ (cond
+ ((not (stringp buffer-name)))
+ ;; The elements of `same-window-buffer-names' can be buffer
+ ;; names or cons cells whose cars are buffer names.
+ ((member buffer-name buffer-names))
+ ((assoc buffer-name buffer-names))
+ ((catch 'found
+ (dolist (regexp regexps)
+ ;; 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))
+ (and (consp regexp) (stringp (car regexp))
+ (string-match-p (car regexp) buffer-name)))
+ (throw 'found t))))))))
+;; (make-obsolete
+ ;; 'same-window-p "pass argument to buffer display function instead." "24.1")
+
+(defcustom special-display-frame-alist
+ '((height . 14) (width . 80) (unsplittable . t))
+ "Alist of parameters for special frames.
+Special frames are used for buffers whose names are listed in
+`special-display-buffer-names' and for buffers whose names match
+one of the regular expressions in `special-display-regexps'.
+
+This variable can be set in your init file, like this:
+
+ (setq special-display-frame-alist '((width . 80) (height . 20)))
+
+These supersede the values given in `default-frame-alist'."
+ :type '(repeat (cons :format "%v"
+ (symbol :tag "Parameter")
+ (sexp :tag "Value")))
+ :group 'frames)
+;; (make-obsolete-variable
+ ;; 'special-display-frame-alist
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defun special-display-popup-frame (buffer &optional args)
+ "Display BUFFER in a special frame and return the window chosen.
+If BUFFER is already displayed in a visible or iconified frame,
+raise that frame. Otherwise, display BUFFER in a way as
+specified by optional argument ARGS.
+
+If ARGS is an alist, use it as a list of frame parameters. If
+these parameters contain \(same-window . t), display BUFFER in
+the selected window. If they contain \(same-frame . t), display
+BUFFER in a window on 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 the rest of the arguments."
+ (if (and args (symbolp (car args)))
+ (apply (car args) buffer (cdr args))
+ (let ((window (get-buffer-window buffer 0)))
+ (or
+ ;; If we have a window already, make it visible.
+ (when window
+ (let ((frame (window-frame window)))
+ (make-frame-visible frame)
+ (raise-frame frame)
+ window))
+ ;; Reuse the current window if the user requested it.
+ (when (cdr (assq 'same-window args))
+ (display-buffer-reuse-window
+ buffer '(same nil nil) '((reuse-dedicated . weak))))
+ ;; Stay on the same frame if requested.
+ (when (or (cdr (assq 'same-frame args))
+ (cdr (assq 'same-window args)))
+ (or (display-buffer-pop-up-window
+ buffer '((largest . nil) (lru . nil)))
+ (display-buffer-reuse-window
+ buffer '(nil nil nil))))
+ ;; If no window yet, make one in a new frame.
+ (let ((frame
+ (with-current-buffer buffer
+ (make-frame
+ (append args (with-no-warnings
+ special-display-frame-alist))))))
+ (set-window-buffer (frame-selected-window frame) buffer)
+ (set-window-dedicated-p (frame-selected-window frame) t)
+ (frame-selected-window frame))))))
+;; (make-obsolete
+ ;; 'special-display-popup-frame
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defcustom special-display-function 'special-display-popup-frame
+ "Function to call for displaying special buffers.
+This function is called with two arguments - the buffer and,
+optionally, a list - and should return a window displaying that
+buffer. The default value usually makes a separate frame for the
+buffer using `special-display-frame-alist' to specify the frame
+parameters. See the definition of `special-display-popup-frame'
+for how to specify such a function.
+
+A buffer is special when its name is either listed in
+`special-display-buffer-names' or matches a regexp in
+`special-display-regexps'."
+ :type 'function
+ :group 'windows
+ :group 'frames)
+;; (make-obsolete-variable
+ ;; 'special-display-function
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
(defcustom special-display-buffer-names nil
"List of names of buffers that should be displayed specially.
Displaying a buffer with `display-buffer' or `pop-to-buffer', if
@@ -624,6 +6236,9 @@ See also `special-display-regexps'."
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
+;; (make-obsolete-variable
+ ;; 'special-display-buffer-names
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
;;;###autoload
(put 'special-display-buffer-names 'risky-local-variable t)
@@ -692,6 +6307,9 @@ See also `special-display-buffer-names'."
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
+;; (make-obsolete-variable
+ ;; 'special-display-regexps
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defun special-display-p (buffer-name)
"Return non-nil if a buffer named BUFFER-NAME gets a special frame.
@@ -701,15 +6319,17 @@ matching BUFFER-NAME. If `special-display-buffer-names' or
`special-display-regexps' contain a list entry whose car equals
or matches BUFFER-NAME, the return value is the cdr of that
entry."
- (let (tmp)
+ (let ((buffer-names (with-no-warnings special-display-buffer-names))
+ (regexps (with-no-warnings special-display-regexps))
+ tmp)
(cond
((not (stringp buffer-name)))
- ((member buffer-name special-display-buffer-names)
+ ((member buffer-name buffer-names)
t)
- ((setq tmp (assoc buffer-name special-display-buffer-names))
+ ((setq tmp (assoc buffer-name buffer-names))
(cdr tmp))
((catch 'found
- (dolist (regexp special-display-regexps)
+ (dolist (regexp regexps)
(cond
((stringp regexp)
(when (string-match-p regexp buffer-name)
@@ -717,73 +6337,43 @@ entry."
((and (consp regexp) (stringp (car regexp))
(string-match-p (car regexp) buffer-name))
(throw 'found (cdr regexp))))))))))
-
-(defcustom special-display-function 'special-display-popup-frame
- "Function to call for displaying special buffers.
-This function is called with two arguments - the buffer and,
-optionally, a list - and should return a window displaying that
-buffer. The default value usually makes a separate frame for the
-buffer using `special-display-frame-alist' to specify the frame
-parameters. See the definition of `special-display-popup-frame'
-for how to specify such a function.
-
-A buffer is special when its name is either listed in
-`special-display-buffer-names' or matches a regexp in
-`special-display-regexps'."
+;; (make-obsolete
+ ;; 'special-display-p
+ ;; "pass argument to buffer display function instead." "24.1")
+
+(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.
+
+Since `pop-up-frame-function' is used by `display-buffer' for
+making new frames, any value specified here by default affects
+the automatic generation of new frames via `display-buffer' and
+all functions based on it. The behavior of `make-frame' is not
+affected by this variable."
+ :type '(repeat (cons :format "%v"
+ (symbol :tag "Parameter")
+ (sexp :tag "Value")))
+ :group 'frames)
+;; (make-obsolete-variable
+ ;; 'pop-up-frame-alist
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defcustom pop-up-frame-function
+ (lambda () (make-frame pop-up-frame-alist))
+ "Function used by `display-buffer' for creating a new frame.
+This function is called with no arguments and should return a new
+frame. The default value calls `make-frame' with the argument
+`pop-up-frame-alist'."
:type 'function
:group 'frames)
-
-(defcustom same-window-buffer-names nil
- "List of names of buffers that should appear in the \"same\" window.
-`display-buffer' and `pop-to-buffer' show a buffer whose name is
-on this list in the selected rather than some other window.
-
-An element of this list can be a cons cell instead of just a
-string. In that case, the cell's car must be a string specifying
-the buffer name. This is for compatibility with
-`special-display-buffer-names'; the cdr of the cons cell is
-ignored.
-
-See also `same-window-regexps'."
- :type '(repeat (string :format "%v"))
- :group 'windows)
-
-(defcustom same-window-regexps nil
- "List of regexps saying which buffers should appear in the \"same\" window.
-`display-buffer' and `pop-to-buffer' show a buffer whose name
-matches a regexp on this list in the selected rather than some
-other window.
-
-An element of this list can be a cons cell instead of just a
-string. In that case, the cell's car must be a regexp matching
-the buffer name. This is for compatibility with
-`special-display-regexps'; the cdr of the cons cell is ignored.
-
-See also `same-window-buffer-names'."
- :type '(repeat (regexp :format "%v"))
- :group 'windows)
-
-(defun same-window-p (buffer-name)
- "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
-This function returns non-nil if `display-buffer' or
-`pop-to-buffer' would show a buffer named BUFFER-NAME in the
-selected rather than \(as usual\) some other window. See
-`same-window-buffer-names' and `same-window-regexps'."
- (cond
- ((not (stringp buffer-name)))
- ;; The elements of `same-window-buffer-names' can be buffer
- ;; names or cons cells whose cars are buffer names.
- ((member buffer-name same-window-buffer-names))
- ((assoc buffer-name same-window-buffer-names))
- ((catch 'found
- (dolist (regexp same-window-regexps)
- ;; 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))
- (and (consp regexp) (stringp (car regexp))
- (string-match-p (car regexp) buffer-name)))
- (throw 'found t)))))))
+;; (make-obsolete-variable
+ ;; 'pop-up-frame-function
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom pop-up-frames nil
"Whether `display-buffer' should make a separate frame.
@@ -795,39 +6385,48 @@ Any other non-nil value means always make a separate frame."
(const :tag "Never" nil)
(const :tag "On graphic displays only" graphic-only)
(const :tag "Always" t))
- :group 'windows)
+ :group 'windows
+ :group 'frames)
+;; (make-obsolete-variable
+ ;; 'pop-up-frames
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom display-buffer-reuse-frames nil
- "Non-nil means `display-buffer' should reuse frames.
+ "Set and non-nil means `display-buffer' should reuse frames.
If the buffer in question is already displayed in a frame, raise
that frame."
:type 'boolean
:version "21.1"
- :group 'windows)
+ :group 'windows
+ :group 'frames)
+;; (make-obsolete-variable
+ ;; 'display-buffer-reuse-frames
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom pop-up-windows t
"Non-nil means `display-buffer' should make a new window."
:type 'boolean
:group 'windows)
+;; (make-obsolete-variable
+ ;; 'pop-up-windows
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom split-window-preferred-function 'split-window-sensibly
- "Function called by `display-buffer' routines to split a window.
+ "Function called by `display-buffer' to split a window.
This function is called with a window as single argument and is
supposed to split that window and return the new window. If the
window can (or shall) not be split, it is supposed to return nil.
+
The default is to call the function `split-window-sensibly' which
tries to split the window in a way which seems most suitable.
You can customize the options `split-height-threshold' and/or
`split-width-threshold' in order to have `split-window-sensibly'
prefer either vertical or horizontal splitting.
-If you set this to any other function, bear in mind that the
-`display-buffer' routines may call this function two times. The
-argument of the first call is the largest window on its frame.
-If that call fails to return a live window, the function is
-called again with the least recently used window as argument. If
-that call fails too, `display-buffer' will use an existing window
-to display its buffer.
+If you set this to any other function, bear in mind that
+`display-buffer' may call that function repeatedly; the option
+`pop-up-windows' controls which windows may become the argument
+of this function.
The window selected at the time `display-buffer' was invoked is
still selected when this function is called. Hence you can
@@ -837,28 +6436,54 @@ not want to split the selected window."
:type 'function
:version "23.1"
:group 'windows)
+;; (make-obsolete-variable
+ ;; 'split-window-preferred-function
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom split-height-threshold 80
- "Minimum height for splitting windows sensibly.
-If this is an integer, `split-window-sensibly' may split a window
+ "Minimum height for splitting a window to display a buffer.
+If this is an integer, `display-buffer' can split a window
vertically only if it has at least this many lines. If this is
-nil, `split-window-sensibly' is not allowed to split a window
-vertically. If, however, a window is the only window on its
-frame, `split-window-sensibly' may split it vertically
-disregarding the value of this variable."
+nil, `display-buffer' does not split windows vertically. If a
+window is the only window on its frame, `display-buffer' may
+split it vertically disregarding the value of this variable."
:type '(choice (const nil) (integer :tag "lines"))
:version "23.1"
:group 'windows)
+;; (make-obsolete-variable
+ ;; 'split-height-threshold
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom split-width-threshold 160
- "Minimum width for splitting windows sensibly.
-If this is an integer, `split-window-sensibly' may split a window
+ "Minimum width for splitting a window to display a buffer.
+If this is an integer, `display-buffer' can split a window
horizontally only if it has at least this many columns. If this
-is nil, `split-window-sensibly' is not allowed to split a window
-horizontally."
+is nil, `display-buffer' cannot split windows horizontally."
:type '(choice (const nil) (integer :tag "columns"))
:version "23.1"
:group 'windows)
+;; (make-obsolete-variable
+ ;; 'split-width-threshold
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defcustom even-window-heights t
+ "If non-nil `display-buffer' will try to even window heights.
+Otherwise `display-buffer' will leave the window configuration
+alone. Heights are evened only when `display-buffer' chooses a
+window that appears above or below the selected window."
+ :type 'boolean
+ :group 'windows)
+;; (make-obsolete-variable
+ ;; 'even-window-heights
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
+
+(defvar display-buffer-mark-dedicated nil
+ "Non-nil means `display-buffer' marks the windows it creates as dedicated.
+The actual non-nil value of this variable will be copied to the
+`window-dedicated-p' flag.")
+;; (make-obsolete-variable
+ ;; 'display-buffer-mark-dedicated
+ ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defun window-splittable-p (window &optional horizontal)
"Return non-nil if `split-window-sensibly' may split WINDOW.
@@ -909,6 +6534,8 @@ hold:
(max split-height-threshold
(* 2 (max window-min-height
(if mode-line-format 2 1))))))))))
+;; (make-obsolete
+ ;; 'window-splittable-p "use 2nd arg of `display-buffer' instead." "24.1")
(defun split-window-sensibly (window)
"Split WINDOW in a way suitable for `display-buffer'.
@@ -941,11 +6568,11 @@ 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)
+ (or (and (with-no-warnings (window-splittable-p window))
;; Split window vertically.
(with-selected-window window
(split-window-vertically)))
- (and (window-splittable-p window t)
+ (and (with-no-warnings (window-splittable-p window t))
;; Split window horizontally.
(with-selected-window window
(split-window-horizontally)))
@@ -955,392 +6582,244 @@ split."
;; minibuffer window, try to split it vertically disregarding
;; the value of `split-height-threshold'.
(let ((split-height-threshold 0))
- (when (window-splittable-p window)
+ (when (with-no-warnings (window-splittable-p window))
(with-selected-window window
(split-window-vertically)))))))
-
-(defun window--try-to-split-window (window)
- "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))))
- (and (window-live-p new-window) new-window))))
-
-(defun window--frame-usable-p (frame)
- "Return FRAME if it can be used to display a buffer."
- (when (frame-live-p frame)
- (let ((window (frame-root-window frame)))
- ;; `frame-root-window' may be an internal window which is considered
- ;; "dead" by `window-live-p'. Hence if `window' is not live we
- ;; implicitly know that `frame' has a visible window we can use.
- (unless (and (window-live-p window)
- (or (window-minibuffer-p window)
- ;; If the window is soft-dedicated, the frame is usable.
- ;; Actually, even if the window is really dedicated,
- ;; the frame is still usable by splitting it.
- ;; At least Emacs-22 allowed it, and it is desirable
- ;; when displaying same-frame windows.
- nil ; (eq t (window-dedicated-p window))
- ))
- frame))))
-
-(defcustom even-window-heights t
- "If non-nil `display-buffer' will try to even window heights.
-Otherwise `display-buffer' will leave the window configuration
-alone. Heights are evened only when `display-buffer' chooses a
-window that appears above or below the selected window."
- :type 'boolean
- :group 'windows)
-
-(defun window--even-window-heights (window)
- "Even heights of WINDOW and selected window.
-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)))))
-
-(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)))
- (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.
- (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)))
-
-(defvar display-buffer-mark-dedicated nil
- "If non-nil, `display-buffer' marks the windows it creates as dedicated.
-The actual non-nil value of this variable will be copied to the
-`window-dedicated-p' flag.")
-
-(defun display-buffer (buffer-or-name &optional not-this-window frame)
- "Make buffer BUFFER-OR-NAME appear in some window but don't select it.
-BUFFER-OR-NAME must be a buffer or the name of an existing
-buffer. Return the window chosen to display BUFFER-OR-NAME or
-nil if no such window is found.
-
-Optional argument NOT-THIS-WINDOW non-nil means display the
-buffer in a window other than the selected one, even if it is
-already displayed in the selected window.
-
-Optional argument FRAME specifies which frames to investigate
-when the specified buffer is already displayed. If the buffer is
-already displayed in some window on one of these frames simply
-return that window. Possible values of FRAME are:
-
-`visible' - consider windows on all visible frames on the current
-terminal.
-
-0 - consider windows on all visible or iconified frames on the
-current terminal.
-
-t - consider windows on all frames.
-
-A specific frame - consider windows on that frame only.
-
-nil - consider windows on the selected frame \(actually the
-last non-minibuffer frame\) only. If, however, either
-`display-buffer-reuse-frames' or `pop-up-frames' is non-nil
-\(non-nil and not graphic-only on a text-only terminal),
-consider all visible or iconified frames on the current terminal."
- (interactive "BDisplay buffer:\nP")
- (let* ((can-use-selected-window
- ;; The selected window is usable unless either NOT-THIS-WINDOW
- ;; is non-nil, it is dedicated to its buffer, or it is the
- ;; `minibuffer-window'.
- (not (or not-this-window
- (window-dedicated-p (selected-window))
- (window-minibuffer-p))))
- (buffer (if (bufferp buffer-or-name)
- buffer-or-name
- (get-buffer buffer-or-name)))
- (name-of-buffer (buffer-name buffer))
- ;; On text-only terminals do not pop up a new frame when
- ;; `pop-up-frames' equals graphic-only.
- (use-pop-up-frames (if (eq pop-up-frames 'graphic-only)
- (display-graphic-p)
- pop-up-frames))
- ;; `frame-to-use' is the frame where to show `buffer' - either
- ;; the selected frame or the last nonminibuffer frame.
- (frame-to-use
- (or (window--frame-usable-p (selected-frame))
- (window--frame-usable-p (last-nonminibuffer-frame))))
- ;; `window-to-use' is the window we use for showing `buffer'.
- window-to-use)
- (cond
- ((not (buffer-live-p buffer))
- (error "No such buffer %s" buffer))
- (display-buffer-function
- ;; Let `display-buffer-function' do the job.
- (funcall display-buffer-function buffer not-this-window))
- ((and (not not-this-window)
- (eq (window-buffer (selected-window)) buffer))
- ;; The selected window already displays BUFFER and
- ;; `not-this-window' is nil, so use it.
- (window--display-buffer-1 (selected-window)))
- ((and can-use-selected-window (same-window-p name-of-buffer))
- ;; If the buffer's name tells us to use the selected window do so.
- (window--display-buffer-2 buffer (selected-window)))
- ((let ((frames (or frame
- (and (or use-pop-up-frames
- display-buffer-reuse-frames
- (not (last-nonminibuffer-frame)))
- 0)
- (last-nonminibuffer-frame))))
- (setq window-to-use
- (catch 'found
- ;; Search frames for a window displaying BUFFER. Return
- ;; the selected window only if we are allowed to do so.
- (dolist (window (get-buffer-window-list buffer 'nomini frames))
- (when (or can-use-selected-window
- (not (eq (selected-window) window)))
- (throw 'found window))))))
- ;; The buffer is already displayed in some window; use that.
- (window--display-buffer-1 window-to-use))
- ((and special-display-function
- ;; `special-display-p' returns either t or a list of frame
- ;; parameters to pass to `special-display-function'.
- (let ((pars (special-display-p name-of-buffer)))
- (when pars
- (funcall special-display-function
- buffer (if (listp pars) pars))))))
- ((or use-pop-up-frames (not frame-to-use))
- ;; We want or need a new frame.
- (let ((win (frame-selected-window (funcall pop-up-frame-function))))
- (window--display-buffer-2 buffer win display-buffer-mark-dedicated)))
- ((and pop-up-windows
- ;; Make a new window.
- (or (not (frame-parameter frame-to-use 'unsplittable))
- ;; If the selected frame cannot be split look at
- ;; `last-nonminibuffer-frame'.
- (and (eq frame-to-use (selected-frame))
- (setq frame-to-use (last-nonminibuffer-frame))
- (window--frame-usable-p frame-to-use)
- (not (frame-parameter frame-to-use 'unsplittable))))
- ;; Attempt to split largest or least recently used window.
- (setq window-to-use
- (or (window--try-to-split-window
- (get-largest-window frame-to-use t))
- (window--try-to-split-window
- (get-lru-window frame-to-use t)))))
- (window--display-buffer-2 buffer window-to-use
- display-buffer-mark-dedicated))
- ((let ((window-to-undedicate
- ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate
- ;; the selected window to its buffer, to avoid that some of
- ;; the `get-' routines below choose it. (Bug#1415)
- (and not-this-window (not (window-dedicated-p))
- (set-window-dedicated-p (selected-window) t)
- (selected-window))))
- (unwind-protect
- (setq window-to-use
- ;; Reuse an existing window.
- (or (get-lru-window frame-to-use)
- (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)
- (frame-selected-window (funcall pop-up-frame-function))))
- (when (window-live-p window-to-undedicate)
- ;; Restore dedicated status of selected window.
- (set-window-dedicated-p window-to-undedicate nil))))
- (window--even-window-heights window-to-use)
- (window--display-buffer-2 buffer window-to-use)))))
-
-(defun pop-to-buffer (buffer-or-name &optional other-window norecord)
- "Select buffer BUFFER-OR-NAME in some window, preferably a different one.
-BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
-nil. If BUFFER-OR-NAME is a string not naming an existent
-buffer, create a buffer with that name. If BUFFER-OR-NAME is
-nil, choose some other buffer.
-
-If `pop-up-windows' is non-nil, windows can be split to display
-the buffer. If optional second arg OTHER-WINDOW is non-nil,
-insist on finding another window even if the specified buffer is
-already visible in the selected window, and ignore
-`same-window-regexps' and `same-window-buffer-names'.
-
-If the window to show BUFFER-OR-NAME is not on the selected
-frame, raise that window's frame and give it input focus.
-
-This function returns the buffer it switched to. This uses the
-function `display-buffer' as a subroutine; see the documentation
-of `display-buffer' for additional customization information.
-
-Optional third arg NORECORD non-nil means do not put this buffer
-at the front of the list of recently selected ones."
- (let ((buffer
- ;; FIXME: This behavior is carried over from the previous C version
- ;; of pop-to-buffer, but really we should use just
- ;; `get-buffer' here.
- (if (null buffer-or-name) (other-buffer (current-buffer))
- (or (get-buffer buffer-or-name)
- (let ((buf (get-buffer-create buffer-or-name)))
- (set-buffer-major-mode buf)
- buf))))
- (old-frame (selected-frame))
- new-window new-frame)
- (set-buffer buffer)
- (setq new-window (display-buffer buffer other-window))
- (select-window new-window norecord)
- (setq new-frame (window-frame new-window))
- (unless (eq new-frame old-frame)
- ;; `display-buffer' has chosen another frame, make sure it gets
- ;; input focus and is risen.
- (select-frame-set-input-focus new-frame))
- buffer))
-
-;; I think this should be the default; I think people will prefer it--rms.
-(defcustom split-window-keep-point t
- "If non-nil, \\[split-window-vertically] keeps the original point \
-in both children.
-This is often more convenient for editing.
-If nil, adjust point in each of the two windows to minimize redisplay.
-This is convenient on slow terminals, but point can move strangely.
-
-This option applies only to `split-window-vertically' and
-functions that call it. `split-window' always keeps the original
-point in both children."
- :type 'boolean
- :group 'windows)
-
-(defun split-window-vertically (&optional size)
- "Split selected window into two windows, one above the other.
-The upper window gets SIZE lines and the lower one gets the rest.
-SIZE negative means the lower window gets -SIZE lines and the
-upper one the rest. With no argument, split windows equally or
-close to it. Both windows display the same buffer, now current.
-
-If the variable `split-window-keep-point' is non-nil, both new
-windows will get the same value of point as the selected window.
-This is often more convenient for editing. The upper window is
-the selected window.
-
-Otherwise, we choose window starts so as to minimize the amount of
-redisplay; this is convenient on slow terminals. The new selected
-window is the one that the current value of point appears in. The
-value of point can change if the text around point is hidden by the
-new mode line.
-
-Regardless of the value of `split-window-keep-point', the upper
-window is the original one and the return value is the new, lower
-window."
- (interactive "P")
- (let ((old-window (selected-window))
- (old-point (point))
- (size (and size (prefix-numeric-value size)))
- moved-by-window-height moved new-window bottom)
- (and size (< size 0)
- ;; Handle negative SIZE value.
- (setq size (+ (window-height) size)))
- (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)))
- (split-window-save-restore-data new-window old-window)))
-
-;; This is to avoid compiler warnings.
-(defvar view-return-to-alist)
-
-(defun split-window-save-restore-data (new-window old-window)
- (with-current-buffer (window-buffer)
- (when view-mode
- (let ((old-info (assq old-window view-return-to-alist)))
- (when old-info
- (push (cons new-window (cons (car (cdr old-info)) t))
- view-return-to-alist))))
- new-window))
-
-(defun split-window-horizontally (&optional size)
- "Split selected window into two windows side by side.
-The selected window becomes the left one and gets SIZE columns.
-SIZE negative means the right window gets -SIZE lines.
-
-SIZE includes the width of the window's scroll bar; if there are
-no scroll bars, it includes the width of the divider column to
-the window's right, if any. SIZE omitted or nil means split
-window equally.
-
-The selected window remains selected. Return the new window."
- (interactive "P")
- (let ((old-window (selected-window))
- (size (and size (prefix-numeric-value size))))
- (and size (< size 0)
- ;; Handle negative SIZE value.
- (setq size (+ (window-width) size)))
- (split-window-save-restore-data (split-window nil size t) old-window)))
-
+;; (make-obsolete
+ ;; 'split-window-sensibly "use 2nd arg of `display-buffer' instead." "24.1")
+
+;; Functions for converting Emacs 23 buffer display options to buffer
+;; display specifiers.
+(defun display-buffer-alist-add (identifiers specifiers &optional no-custom)
+ "Helper function for `display-buffer-alist-set'."
+ (unless identifiers
+ (setq identifiers '((regexp . ".*"))))
+ (unless (atom specifiers)
+ (setq specifiers (delq nil specifiers)))
+
+ (if no-custom
+ (setq display-buffer-alist
+ (cons (cons identifiers specifiers) display-buffer-alist))
+ (customize-set-variable
+ 'display-buffer-alist
+ (cons (cons identifiers specifiers) display-buffer-alist))))
+
+(defun display-buffer-alist-set (&optional no-custom add)
+ "Set `display-buffer-alist' from Emacs 23 buffer display options.
+Optional argument NO-CUSTOM nil means use `customize-set-variable'
+to set the value of `display-buffer-alist'. NO-CUSTOM non-nil
+means to use `setq' instead.
+
+Optional argument ADD nil means to replace the actual value of
+`display-buffer-alist' with the value calculated here. ADD
+non-nil means prepend the value calculated here to the current
+value of `display-buffer-alist'."
+ (unless add
+ (if no-custom
+ (setq display-buffer-alist nil)
+ (customize-set-variable 'display-buffer-alist nil)))
+
+ ;; Disable warnings, there are too many obsolete options here.
+ (with-no-warnings
+ ;; `pop-up-windows'
+ (display-buffer-alist-add
+ nil
+ (let ((fun (unless (eq split-window-preferred-function
+ 'split-window-sensibly)
+ ;; `split-window-sensibly' has been merged into the
+ ;; `display-buffer-split-window' code as `nil'.
+ split-window-preferred-function))
+ (min-height
+ (if (numberp split-height-threshold)
+ (/ split-height-threshold 2)
+ ;; Undocumented hack.
+ 1.0))
+ (min-width
+ (if (numberp split-width-threshold)
+ (/ split-width-threshold 2)
+ ;; Undocumented hack.
+ 1.0)))
+ (list
+ 'pop-up-window
+ (when pop-up-windows
+ (list
+ 'pop-up-window
+ (cons 'largest fun)
+ (cons 'lru fun)))
+ (cons 'pop-up-window-min-height min-height)
+ (cons 'pop-up-window-min-width min-width)))
+ no-custom)
+
+ ;; `pop-up-frames'
+ (display-buffer-alist-add
+ nil
+ (list
+ 'pop-up-frame
+ (when pop-up-frames
+ (list 'pop-up-frame pop-up-frames))
+ (when pop-up-frame-function
+ (cons 'pop-up-frame-function pop-up-frame-function))
+ (when pop-up-frame-alist
+ (cons 'pop-up-frame-alist pop-up-frame-alist)))
+ no-custom)
+
+ ;; `special-display-regexps'
+ (dolist (entry special-display-regexps)
+ (cond
+ ((stringp entry)
+ ;; Plain string.
+ (display-buffer-alist-add
+ `((regexp . ,entry))
+ (list
+ 'function
+ (list 'function special-display-function
+ special-display-frame-alist))
+ no-custom))
+ ((consp entry)
+ (let ((name (car entry))
+ (rest (cdr entry)))
+ (cond
+ ((functionp (car rest))
+ ;; A function.
+ (display-buffer-alist-add
+ `((name . ,name))
+ (list
+ 'function
+ ;; Weary.
+ (list 'function (car rest) (cadr rest)))
+ no-custom))
+ ((listp rest)
+ ;; A list of parameters.
+ (cond
+ ((assq 'same-window rest)
+ (display-buffer-alist-add
+ `((name . ,name))
+ (list 'reuse-window
+ (list 'reuse-window 'same)
+ (list 'reuse-window-dedicated 'weak))
+ no-custom))
+ ((assq 'same-frame rest)
+ (display-buffer-alist-add
+ `((name . ,name)) (list 'same-frame) no-custom))
+ (t
+ (display-buffer-alist-add
+ `((name . ,name))
+ (list
+ 'function
+ (list 'function special-display-function
+ special-display-frame-alist))
+ no-custom)))))))))
+
+ ;; `special-display-buffer-names'
+ (dolist (entry special-display-buffer-names)
+ (cond
+ ((stringp entry)
+ ;; Plain string.
+ (display-buffer-alist-add
+ `((name . ,entry))
+ (list
+ 'function
+ (list 'function special-display-function
+ special-display-frame-alist))
+ no-custom))
+ ((consp entry)
+ (let ((name (car entry))
+ (rest (cdr entry)))
+ (cond
+ ((functionp (car rest))
+ ;; A function.
+ (display-buffer-alist-add
+ `((name . ,name))
+ (list
+ 'function
+ ;; Weary.
+ (list 'function (car rest) (cadr rest)))
+ no-custom))
+ ((listp rest)
+ ;; A list of parameters.
+ (cond
+ ((assq 'same-window rest)
+ (display-buffer-alist-add
+ `((name . ,name))
+ (list 'reuse-window
+ (list 'reuse-window 'same)
+ (list 'reuse-window-dedicated 'weak))
+ no-custom))
+ ((assq 'same-frame rest)
+ (display-buffer-alist-add
+ `((name . ,name)) (list 'same-frame) no-custom))
+ (t
+ (display-buffer-alist-add
+ `((name . ,name))
+ (list
+ 'function
+ (list 'function special-display-function
+ special-display-frame-alist))
+ no-custom)))))))))
+
+ ;; `same-window-regexps'
+ (dolist (entry same-window-regexps)
+ (cond
+ ((stringp entry)
+ (display-buffer-alist-add
+ `((regexp . ,entry))
+ (list 'reuse-window (list 'reuse-window 'same))
+ no-custom))
+ ((consp entry)
+ (display-buffer-alist-add
+ `((regexp . ,(car entry)))
+ (list 'reuse-window (list 'reuse-window 'same))
+ no-custom))))
+
+ ;; `same-window-buffer-names'
+ (dolist (entry same-window-buffer-names)
+ (cond
+ ((stringp entry)
+ (display-buffer-alist-add
+ `((name . ,entry))
+ (list 'reuse-window (list 'reuse-window 'same))
+ no-custom))
+ ((consp entry)
+ (display-buffer-alist-add
+ `((name . ,(car entry)))
+ (list 'reuse-window (list 'reuse-window 'same))
+ no-custom))))
+
+ ;; `reuse-window'
+ (display-buffer-alist-add
+ nil
+ (list
+ 'reuse-window
+ (list 'reuse-window nil 'same
+ (when (or display-buffer-reuse-frames pop-up-frames)
+ ;; "0" (all visible and iconified frames) is hardcoded in
+ ;; Emacs 23.
+ 0))
+ (when even-window-heights
+ (cons 'reuse-window-even-sizes t)))
+ no-custom)
+
+ ;; `display-buffer-mark-dedicated'
+ (when display-buffer-mark-dedicated
+ (display-buffer-alist-add
+ nil
+ (list
+ (cons 'dedicate display-buffer-mark-dedicated))
+ no-custom)))
+
+ display-buffer-alist)
(defun set-window-text-height (window height)
"Set the height in lines of the text display area of WINDOW to HEIGHT.
-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. 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,
by allocating more lines than are actually needed in the case
where some error may be present."
+ (setq window (window-normalize-live-window window))
(let ((delta (- height (window-text-height window))))
(unless (zerop delta)
;; Setting window-min-height to a value like 1 can lead to very
@@ -1348,36 +6827,21 @@ where some error may be present."
;; 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.
- (if (and window (not (eq window (selected-window))))
- (save-selected-window
- (select-window window 'norecord)
- (enlarge-window delta))
- (enlarge-window delta))))))
+ (window-resize window delta)))))
-
-(defun enlarge-window-horizontally (columns)
- "Make selected window COLUMNS wider.
+(defun enlarge-window-horizontally (delta)
+ "Make selected window DELTA columns wider.
Interactively, if no argument is given, make selected window one
column wider."
(interactive "p")
- (enlarge-window columns t))
+ (enlarge-window delta t))
-(defun shrink-window-horizontally (columns)
- "Make selected window COLUMNS narrower.
+(defun shrink-window-horizontally (delta)
+ "Make selected window DELTA columns narrower.
Interactively, if no argument is given, make selected window one
column narrower."
(interactive "p")
- (shrink-window columns t))
-
-(defun window-buffer-height (window)
- "Return the height (in screen lines) of the buffer that WINDOW is displaying."
- (with-current-buffer (window-buffer window)
- (max 1
- (count-screen-lines (point-min) (point-max)
- ;; If buffer ends with a newline, ignore it when
- ;; counting height unless point is after it.
- (eobp)
- window))))
+ (shrink-window delta t))
(defun count-screen-lines (&optional beg end count-final-newline window)
"Return the number of screen lines in the region.
@@ -1415,80 +6879,99 @@ in some window."
(goto-char (point-min))
(1+ (vertical-motion (buffer-size) window))))))
-(defun fit-window-to-buffer (&optional window max-height min-height)
+(defun window-buffer-height (window)
+ "Return the height (in screen lines) of the buffer that WINDOW is displaying."
+ (with-current-buffer (window-buffer window)
+ (max 1
+ (count-screen-lines (point-min) (point-max)
+ ;; If buffer ends with a newline, ignore it when
+ ;; counting height unless point is after it.
+ (eobp)
+ window))))
+
+;;; Resizing buffers to fit their contents exactly.
+(defun fit-window-to-buffer (&optional window max-height min-height override)
"Adjust height of WINDOW to display its buffer's contents exactly.
-WINDOW defaults to the selected window.
-Optional argument MAX-HEIGHT specifies the maximum height of the
-window and defaults to the maximum permissible height of a window
-on WINDOW's frame.
-Optional argument MIN-HEIGHT specifies the minimum height of the
-window and 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.
-
-Return non-nil if height was orderly adjusted, nil otherwise.
-
-Caution: This function can delete WINDOW and/or other windows
-when their height shrinks to less than MIN-HEIGHT."
+WINDOW can be any 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
+argument MIN-HEIGHT specifies the minimum height of WINDOW and
+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.
+
+Return the number of lines by which WINDOW was enlarged or
+shrunk. If an error occurs during resizing, return nil but don't
+signal an error.
+
+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.
- (let ((old-buffer (current-buffer))
- value)
- (with-selected-window (or window (setq window (selected-window)))
- (set-buffer (window-buffer))
- ;; Use `condition-case' to handle any fixed-size windows and other
- ;; pitfalls nearby.
- (condition-case nil
- (let* (;; MIN-HEIGHT must not be less than 1 and defaults to
- ;; `window-min-height'.
- (min-height (max (or min-height window-min-height) 1))
- (max-window-height
- ;; Maximum height of any window on this frame.
- (min (window-height (frame-root-window)) (frame-height)))
- ;; MAX-HEIGHT must not be larger than max-window-height and
- ;; defaults to max-window-height.
- (max-height
- (min (or max-height max-window-height) max-window-height))
- (desired-height
- ;; The height necessary to show all of WINDOW's buffer,
- ;; constrained by MIN-HEIGHT and MAX-HEIGHT.
- (max
- (min
- ;; For an empty buffer `count-screen-lines' returns zero.
- ;; Even in that case we need one line for the cursor.
- (+ (max (count-screen-lines) 1)
- ;; For non-minibuffers count the mode line, if any.
- (if (and (not (window-minibuffer-p)) mode-line-format)
- 1 0)
- ;; Count the header line, if any.
- (if header-line-format 1 0))
- max-height)
- min-height))
- (delta
- ;; How much the window height has to change.
- (if (= (window-height) (window-height (frame-root-window)))
- ;; Don't try to resize a full-height window.
- 0
- (- desired-height (window-height))))
- ;; Do something reasonable so `enlarge-window' can make
- ;; windows as small as MIN-HEIGHT.
- (window-min-height (min min-height window-min-height)))
- ;; Don't try to redisplay with the cursor at the end on its
- ;; own line--that would force a scroll and spoil things.
- (when (and (eobp) (bolp) (not (bobp)))
- (set-window-point window (1- (window-point))))
- ;; Adjust WINDOW's height to the nominally correct one
- ;; (which may actually be slightly off because of variable
- ;; height text, etc).
- (unless (zerop delta)
- (enlarge-window delta))
- ;; `enlarge-window' might have deleted WINDOW, so make sure
- ;; WINDOW's still alive for the remainder of this.
- ;; Note: Deleting WINDOW is clearly counter-intuitive in
- ;; this context, but we can't do much about it given the
- ;; current semantics of `enlarge-window'.
- (when (window-live-p window)
+ (setq window (window-normalize-live-window window))
+ ;; 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.
+ (with-selected-window window
+ ;; We are in WINDOW's buffer now.
+ (let* ( ;; Adjust MIN-HEIGHT.
+ (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.
+ (max-height
+ (if (or override (not max-height))
+ max-window-height
+ (min max-height max-window-height)))
+ ;; Make `desired-height' the height necessary to show
+ ;; all of WINDOW's buffer, constrained by MIN-HEIGHT
+ ;; and MAX-HEIGHT.
+ (desired-height
+ (max
+ (min
+ (+ (count-screen-lines)
+ ;; For non-minibuffers count the mode line, if any.
+ (if (and (not (window-minibuffer-p window))
+ mode-line-format)
+ 1
+ 0)
+ ;; Count the header line, if any.
+ (if header-line-format 1 0))
+ max-height)
+ min-height))
+ (desired-delta
+ (- desired-height (window-total-size window)))
+ (delta
+ (if (> desired-delta 0)
+ (min desired-delta
+ (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 proces.
+ 0
+ ;; Don't try to redisplay with the cursor at the end on its
+ ;; own line--that would force a scroll and spoil things.
+ (when (and (eobp) (bolp) (not (bobp)))
+ ;; It's silly to put `point' at the end of the previous
+ ;; line and so maybe force horizontal scrolling.
+ (set-window-point window (line-beginning-position 0)))
+ ;; Call `window-resize' with OVERRIDE argument equal WINDOW.
+ (window-resize window delta nil window)
;; Check if the last line is surely fully visible. If
;; not, enlarge the window.
(let ((end (save-excursion
@@ -1506,25 +6989,29 @@ when their height shrinks to less than MIN-HEIGHT."
(forward-line 0))
(point))))
(set-window-vscroll window 0)
+ ;; This loop might in some rare pathological cases raise
+ ;; an error - another reason for the `condition-case'.
(while (and (< desired-height max-height)
- (= desired-height (window-height))
+ (= desired-height (window-total-size))
(not (pos-visible-in-window-p end)))
- (enlarge-window 1)
- (setq desired-height (1+ desired-height))))
- ;; Return non-nil only if nothing "bad" happened.
- (setq value t)))
- (error nil)))
- (when (buffer-live-p old-buffer)
- (set-buffer old-buffer))
- value))
+ (window-resize window 1 nil window)
+ (setq desired-height (1+ desired-height)))))
+ (error (setq delta nil)))
+ delta))))
(defun window-safely-shrinkable-p (&optional window)
"Return t if WINDOW can be shrunk without shrinking other windows.
WINDOW defaults to the selected window."
(with-selected-window (or window (selected-window))
(let ((edges (window-edges)))
+ ;; The following doesn't satisfy the doc-string's claim when
+ ;; window and previous-/next-window are not part of the same
+ ;; combination but still share a common edge. Using
+ ;; `window-iso-combined-p' instead should handle that.
(or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
(= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
+;; (make-obsolete
+ ;; 'window-safely-shrinkable-p "use `window-iso-combined-p' instead." "24.1")
(defun shrink-window-if-larger-than-buffer (&optional window)
"Shrink height of WINDOW if its buffer doesn't need so many lines.
@@ -1532,42 +7019,28 @@ 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.
-Do not shrink to less than `window-min-height' lines. Do nothing
-if the buffer contains more lines than the present window height,
-or if some of the window's contents are scrolled out of view, or
-if shrinking this window would also shrink another window, or if
-the window is the only window of its frame.
+Do not shrink WINDOW to less than `window-min-height' lines. Do
+nothing if the buffer contains more lines than the present window
+height, or if some of the window's contents are scrolled out of
+view, or if shrinking this window would also shrink another
+window, or if the window is the only window of its frame.
Return non-nil if the window was shrunk, nil otherwise."
(interactive)
- (when (null window)
- (setq window (selected-window)))
- (let* ((frame (window-frame window))
- (mini (frame-parameter frame 'minibuffer))
- (edges (window-edges window)))
- (if (and (not (eq window (frame-root-window frame)))
- (window-safely-shrinkable-p window)
- (pos-visible-in-window-p (point-min) window)
- (not (eq mini 'only))
- (or (not mini)
- (let ((mini-window (minibuffer-window frame)))
- (or (null mini-window)
- (not (eq frame (window-frame mini-window)))
- (< (nth 3 edges)
- (nth 1 (window-edges mini-window)))
- (> (nth 1 edges)
- (frame-parameter frame 'menu-bar-lines))))))
- (fit-window-to-buffer window (window-height window)))))
-
+ (setq window (window-normalize-live-window window))
+ ;; Make sure that WINDOW is vertically combined and `point-min' is
+ ;; visible (for whatever reason that's needed). The remaining issues
+ ;; should be taken care of by `fit-window-to-buffer'.
+ (when (and (window-iso-combined-p window)
+ (pos-visible-in-window-p (point-min) window))
+ (fit-window-to-buffer window (window-total-size window))))
+
(defun kill-buffer-and-window ()
"Kill the current buffer and delete the selected window."
(interactive)
(let ((window-to-delete (selected-window))
(buffer-to-kill (current-buffer))
- (delete-window-hook (lambda ()
- (condition-case nil
- (delete-window)
- (error nil)))))
+ (delete-window-hook (lambda () (ignore-errors (delete-window)))))
(unwind-protect
(progn
(add-hook 'kill-buffer-hook delete-window-hook t t)
@@ -1578,10 +7051,9 @@ Return non-nil if the window was shrunk, nil otherwise."
(delete-window))))
;; If the buffer is not dead for some reason (probably because
;; of a `quit' signal), remove the hook again.
- (condition-case nil
- (with-current-buffer buffer-to-kill
- (remove-hook 'kill-buffer-hook delete-window-hook t))
- (error nil)))))
+ (ignore-errors
+ (with-current-buffer buffer-to-kill
+ (remove-hook 'kill-buffer-hook delete-window-hook t))))))
(defun quit-window (&optional kill window)
"Quit WINDOW and bury its buffer.
@@ -1604,10 +7076,9 @@ Otherwise, bury WINDOW's buffer, see `bury-buffer'."
;; try to delete it.
(let* ((window (or window (selected-window)))
(frame (window-frame window)))
- (if (eq window (frame-root-window frame))
- ;; WINDOW is alone on its frame. `delete-windows-on'
- ;; knows how to handle that case.
- (delete-windows-on buffer frame)
+ (if (frame-root-window-p window)
+ ;; WINDOW is alone on its frame.
+ (delete-frame frame)
;; There are other windows on its frame, delete WINDOW.
(delete-window window)))
;; Otherwise, switch to another buffer in the selected window.
@@ -1617,7 +7088,6 @@ Otherwise, bury WINDOW's buffer, see `bury-buffer'."
(if kill
(kill-buffer buffer)
(bury-buffer buffer))))
-
(defvar recenter-last-op nil
"Indicates the last recenter operation performed.
@@ -1709,7 +7179,6 @@ by `recenter-positions'."
(move-to-window-line (round (* recenter-last-op (window-height))))))))))
(define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
-
;;; Scrolling commands.
@@ -1857,7 +7326,6 @@ With arg N, put point N/10 of the way from the true end."
(end-of-buffer arg))
(recenter '(t)))
(select-window orig-window))))
-
(defvar mouse-autoselect-window-timer nil
"Timer used by delayed window autoselection.")
@@ -1911,62 +7379,60 @@ means suspend autoselection."
If the mouse position has stabilized in a non-selected window, select
that window. The minibuffer window is selected only if the minibuffer is
active. This function is run by `mouse-autoselect-window-timer'."
- (condition-case nil
- (let* ((mouse-position (mouse-position))
- (window
- (condition-case nil
- (window-at (cadr mouse-position) (cddr mouse-position)
- (car mouse-position))
- (error nil))))
- (cond
- ((or (menu-or-popup-active-p)
- (and window
- (not (coordinates-in-window-p (cdr mouse-position) window))))
- ;; A menu / popup dialog is active or the mouse is on the scroll-bar
- ;; of WINDOW, temporarily suspend delayed autoselection.
- (mouse-autoselect-window-start mouse-position nil t))
- ((eq mouse-autoselect-window-state 'suspend)
- ;; Delayed autoselection was temporarily suspended, reenable it.
- (mouse-autoselect-window-start mouse-position))
- ((and window (not (eq window (selected-window)))
- (or (not (numberp mouse-autoselect-window))
- (and (> mouse-autoselect-window 0)
- ;; If `mouse-autoselect-window' is positive, select
- ;; window if the window is the same as before.
- (eq window mouse-autoselect-window-window))
- ;; Otherwise select window if the mouse is at the same
- ;; position as before. Observe that the first test after
- ;; starting autoselection usually fails since the value of
- ;; `mouse-autoselect-window-position' recorded there is the
- ;; position where the mouse has entered the new window and
- ;; not necessarily where the mouse has stopped moving.
- (equal mouse-position mouse-autoselect-window-position))
- ;; The minibuffer is a candidate window if it's active.
- (or (not (window-minibuffer-p window))
- (eq window (active-minibuffer-window))))
- ;; Mouse position has stabilized in non-selected window: Cancel
- ;; delayed autoselection and try to select that window.
- (mouse-autoselect-window-cancel t)
- ;; Select window where mouse appears unless the selected window is the
- ;; minibuffer. Use `unread-command-events' in order to execute pre-
- ;; and post-command hooks and trigger idle timers. To avoid delaying
- ;; autoselection again, set `mouse-autoselect-window-state'."
- (unless (window-minibuffer-p (selected-window))
- (setq mouse-autoselect-window-state 'select)
- (setq unread-command-events
- (cons (list 'select-window (list window))
- unread-command-events))))
- ((or (and window (eq window (selected-window)))
- (not (numberp mouse-autoselect-window))
- (equal mouse-position mouse-autoselect-window-position))
- ;; Mouse position has either stabilized in the selected window or at
- ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
- (mouse-autoselect-window-cancel t))
- (t
- ;; Mouse position has not stabilized yet, resume delayed
- ;; autoselection.
- (mouse-autoselect-window-start mouse-position window))))
- (error nil)))
+ (ignore-errors
+ (let* ((mouse-position (mouse-position))
+ (window
+ (ignore-errors
+ (window-at (cadr mouse-position) (cddr mouse-position)
+ (car mouse-position)))))
+ (cond
+ ((or (menu-or-popup-active-p)
+ (and window
+ (not (coordinates-in-window-p (cdr mouse-position) window))))
+ ;; A menu / popup dialog is active or the mouse is on the scroll-bar
+ ;; of WINDOW, temporarily suspend delayed autoselection.
+ (mouse-autoselect-window-start mouse-position nil t))
+ ((eq mouse-autoselect-window-state 'suspend)
+ ;; Delayed autoselection was temporarily suspended, reenable it.
+ (mouse-autoselect-window-start mouse-position))
+ ((and window (not (eq window (selected-window)))
+ (or (not (numberp mouse-autoselect-window))
+ (and (> mouse-autoselect-window 0)
+ ;; If `mouse-autoselect-window' is positive, select
+ ;; window if the window is the same as before.
+ (eq window mouse-autoselect-window-window))
+ ;; Otherwise select window if the mouse is at the same
+ ;; position as before. Observe that the first test after
+ ;; starting autoselection usually fails since the value of
+ ;; `mouse-autoselect-window-position' recorded there is the
+ ;; position where the mouse has entered the new window and
+ ;; not necessarily where the mouse has stopped moving.
+ (equal mouse-position mouse-autoselect-window-position))
+ ;; The minibuffer is a candidate window if it's active.
+ (or (not (window-minibuffer-p window))
+ (eq window (active-minibuffer-window))))
+ ;; Mouse position has stabilized in non-selected window: Cancel
+ ;; delayed autoselection and try to select that window.
+ (mouse-autoselect-window-cancel t)
+ ;; Select window where mouse appears unless the selected window is the
+ ;; minibuffer. Use `unread-command-events' in order to execute pre-
+ ;; and post-command hooks and trigger idle timers. To avoid delaying
+ ;; autoselection again, set `mouse-autoselect-window-state'."
+ (unless (window-minibuffer-p (selected-window))
+ (setq mouse-autoselect-window-state 'select)
+ (setq unread-command-events
+ (cons (list 'select-window (list window))
+ unread-command-events))))
+ ((or (and window (eq window (selected-window)))
+ (not (numberp mouse-autoselect-window))
+ (equal mouse-position mouse-autoselect-window-position))
+ ;; Mouse position has either stabilized in the selected window or at
+ ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
+ (mouse-autoselect-window-cancel t))
+ (t
+ ;; Mouse position has not stabilized yet, resume delayed
+ ;; autoselection.
+ (mouse-autoselect-window-start mouse-position window))))))
(defun handle-select-window (event)
"Handle select-window events."
@@ -2002,21 +7468,6 @@ active. This function is run by `mouse-autoselect-window-timer'."
(run-hooks 'mouse-leave-buffer-hook))
(select-window window))))
-(defun delete-other-windows-vertically (&optional window)
- "Delete the windows in the same column with WINDOW, but not WINDOW itself.
-This may be a useful alternative binding for \\[delete-other-windows]
- if you often split windows horizontally."
- (interactive)
- (let* ((window (or window (selected-window)))
- (edges (window-edges window))
- (w window) delenda)
- (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)))
- (push w delenda))))
- (mapc 'delete-window delenda)))
-
(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.
@@ -2032,9 +7483,13 @@ Otherwise, consult the value of `truncate-partial-width-windows'
(if (integerp t-p-w-w)
(< (window-width window) t-p-w-w)
t-p-w-w))))
-
-(define-key ctl-x-map "2" 'split-window-vertically)
-(define-key ctl-x-map "3" 'split-window-horizontally)
+
+(define-key ctl-x-map "0" 'delete-window)
+(define-key ctl-x-map "1" 'delete-other-windows)
+(define-key ctl-x-map "2" 'split-window-above-each-other)
+(define-key ctl-x-map "3" 'split-window-side-by-side)
+(define-key ctl-x-map "o" 'other-window)
+(define-key ctl-x-map "^" 'enlarge-window)
(define-key ctl-x-map "}" 'enlarge-window-horizontally)
(define-key ctl-x-map "{" 'shrink-window-horizontally)
(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
diff --git a/lisp/winner.el b/lisp/winner.el
index e5855ad8aac..70038362c2e 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -145,7 +145,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
;;; Saved configurations
-;; This variable contains the window cofiguration rings.
+;; This variable contains the window configuration rings.
;; The key in this alist is the frame.
(defvar winner-ring-alist nil)
diff --git a/lisp/woman.el b/lisp/woman.el
index eb801b55d4d..c6bd4a4c8d1 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -2157,8 +2157,8 @@ No external programs are used."
(run-hooks 'woman-pre-format-hook)
(and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1))
;; (fundamental-mode)
- (let ((start-time (current-time)) ; (HIGH LOW MICROSEC)
- time) ; HIGH * 2**16 + LOW seconds
+ (let ((start-time (current-time))
+ time)
(message "WoMan formatting buffer...")
; (goto-char (point-min))
; (cond
@@ -2167,10 +2167,8 @@ No external programs are used."
; (delete-region (point-min) (point))) ; potentially dangerous!
; (t (message "WARNING: .TH request not found -- not man-page format?")))
(woman-decode-region (point-min) (point-max))
- (setq time (current-time)
- time (+ (* (- (car time) (car start-time)) 65536)
- (- (cadr time) (cadr start-time))))
- (message "WoMan formatting buffer...done in %d seconds" time)
+ (setq time (float-time (time-since start-time)))
+ (message "WoMan formatting buffer...done in %g seconds" time)
(WoMan-log-end time))
(run-hooks 'woman-post-format-hook))
@@ -4529,7 +4527,7 @@ IGNORED is a string appended to the log message."
"Log the end of formatting in *WoMan-Log*.
TIME specifies the time it took to format the man page, to be printed
with the message."
- (WoMan-log-1 (format "Formatting time %d seconds." time) 'end))
+ (WoMan-log-1 (format "Formatting time %g seconds." time) 'end))
(defun WoMan-log-1 (string &optional end)
"Log a message STRING in *WoMan-Log*.
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 1c6af1f45f2..04b759a8116 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -433,6 +433,18 @@ otherwise return the frame coordinates."
(declare-function x-get-selection-internal "xselect.c"
(selection-symbol target-type &optional time-stamp))
+(defun x-dnd-version-from-flags (flags)
+ "Return the version byte from the 32 bit FLAGS in an XDndEnter message"
+ (if (consp flags) ;; Long as cons
+ (ash (car flags) -8)
+ (ash flags -24))) ;; Ordinary number
+
+(defun x-dnd-more-than-3-from-flags (flags)
+ "Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message"
+ (if (consp flags)
+ (logand (cdr flags) 1)
+ (logand flags 1)))
+
(defun x-dnd-handle-xdnd (event frame window message _format data)
"Receive one XDND event (client message) and send the appropriate reply.
EVENT is the client message. FRAME is where the mouse is now.
@@ -440,9 +452,10 @@ WINDOW is the window within FRAME where the mouse is now.
FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(cond ((equal "XdndEnter" message)
(let* ((flags (aref data 1))
- (version (and (consp flags) (ash (car flags) -8)))
- (more-than-3 (and (consp flags) (cdr flags)))
+ (version (x-dnd-version-from-flags flags))
+ (more-than-3 (x-dnd-more-than-3-from-flags flags))
(dnd-source (aref data 0)))
+ (message "%s %s" version more-than-3)
(if version ;; If flags is bad, version will be nil.
(x-dnd-save-state
window nil nil
diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog
index e98526f2546..7e332a9fd5d 100644
--- a/lwlib/ChangeLog
+++ b/lwlib/ChangeLog
@@ -1,3 +1,13 @@
+2011-06-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * Makefile.in (ALL_CFLAGS): Add -I../lib for generated header files
+ in out-of-tree build.
+
+2011-06-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (ALL_CFLAGS): Add -I$(srcdir)/../lib.
+ This is needed because lisp.h includes intprops.h now (Bug#8794).
+
2011-04-16 Paul Eggert <eggert@cs.ucla.edu>
Static checks with GCC 4.6.0 and non-default toolkits.
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index baaa198d7b9..1193cee4110 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -1,18 +1,18 @@
# Copyright (C) 1992, 1993 Lucid, Inc.
# Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
-#
+#
# This file is part of the Lucid Widget Library.
-#
+#
# The Lucid Widget 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 1, or (at your option)
# any later version.
-#
+#
# The Lucid Widget 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.
-#
+#
# 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,
@@ -55,7 +55,8 @@ OBJS = lwlib.o $(TOOLKIT_OBJS) lwlib-utils.o
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 -I$(srcdir) -I$(srcdir)/../src
+ -DHAVE_CONFIG_H -Demacs -I../src \
+ -I$(srcdir) -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib
.c.o:
$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
diff --git a/m4/alloca.m4 b/m4/alloca.m4
new file mode 100644
index 00000000000..a8744a844f3
--- /dev/null
+++ b/m4/alloca.m4
@@ -0,0 +1,121 @@
+# alloca.m4 serial 13
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2011 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_FUNC_ALLOCA],
+[
+ AC_REQUIRE([AC_FUNC_ALLOCA])
+ if test $ac_cv_func_alloca_works = no; then
+ gl_PREREQ_ALLOCA
+ fi
+
+ # Define an additional variable used in the Makefile substitution.
+ if test $ac_cv_working_alloca_h = yes; then
+ AC_CACHE_CHECK([for alloca as a compiler built-in], [gl_cv_rpl_alloca], [
+ AC_EGREP_CPP([Need own alloca], [
+#if defined __GNUC__ || defined _AIX || defined _MSC_VER
+ Need own alloca
+#endif
+ ], [gl_cv_rpl_alloca=yes], [gl_cv_rpl_alloca=no])
+ ])
+ if test $gl_cv_rpl_alloca = yes; then
+ dnl OK, alloca can be implemented through a compiler built-in.
+ AC_DEFINE([HAVE_ALLOCA], [1],
+ [Define to 1 if you have 'alloca' after including <alloca.h>,
+ a header that may be supplied by this distribution.])
+ ALLOCA_H=alloca.h
+ else
+ dnl alloca exists as a library function, i.e. it is slow and probably
+ dnl a memory leak. Don't define HAVE_ALLOCA in this case.
+ ALLOCA_H=
+ fi
+ else
+ ALLOCA_H=alloca.h
+ fi
+ AC_SUBST([ALLOCA_H])
+ AM_CONDITIONAL([GL_GENERATE_ALLOCA_H], [test -n "$ALLOCA_H"])
+])
+
+# Prerequisites of lib/alloca.c.
+# STACK_DIRECTION is already handled by AC_FUNC_ALLOCA.
+AC_DEFUN([gl_PREREQ_ALLOCA], [:])
+
+# This works around a bug in autoconf <= 2.68.
+# See <http://lists.gnu.org/archive/html/bug-gnulib/2011-06/msg00277.html>.
+
+m4_version_prereq([2.69], [] ,[
+
+# This is taken from the following Autoconf patch:
+# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497
+
+# _AC_LIBOBJ_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
+# that cause trouble. Some versions do not even contain alloca or
+# contain a buggy version. If you still want to use their 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_CACHE_CHECK(whether `alloca.c' needs Cray hooks, ac_cv_os_cray,
+[AC_EGREP_CPP(webecray,
+[#if defined CRAY && ! defined CRAY2
+webecray
+#else
+wenotbecray
+#endif
+], ac_cv_os_cray=yes, ac_cv_os_cray=no)])
+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
+ systems. This function is required for
+ `alloca.c' support on those systems.])
+ break])
+ done
+fi
+
+AC_CACHE_CHECK([stack direction for C alloca],
+ [ac_cv_c_stack_direction],
+[AC_RUN_IFELSE([AC_LANG_SOURCE(
+[AC_INCLUDES_DEFAULT
+int
+find_stack_direction (int *addr, int depth)
+{
+ int dir, dummy = 0;
+ if (! addr)
+ addr = &dummy;
+ *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1;
+ dir = depth ? find_stack_direction (addr, depth - 1) : 0;
+ return dir + dummy;
+}
+
+int
+main (int argc, char **argv)
+{
+ return find_stack_direction (0, argc + !argv + 20) < 0;
+}])],
+ [ac_cv_c_stack_direction=1],
+ [ac_cv_c_stack_direction=-1],
+ [ac_cv_c_stack_direction=0])])
+AH_VERBATIM([STACK_DIRECTION],
+[/* 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])dnl
+AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction)
+])# _AC_LIBOBJ_ALLOCA
+])
diff --git a/m4/c-strtod.m4 b/m4/c-strtod.m4
index d5f5f502cba..20c65b82584 100644
--- a/m4/c-strtod.m4
+++ b/m4/c-strtod.m4
@@ -1,4 +1,4 @@
-# c-strtod.m4 serial 12
+# c-strtod.m4 serial 14
# Copyright (C) 2004-2006, 2009-2011 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -33,11 +33,9 @@ AC_DEFUN([gl_C99_STRTOLD],
fi
])
+dnl Prerequisites of lib/c-strtod.c.
AC_DEFUN([gl_C_STRTOD],
[
- AC_LIBOBJ([c-strtod])
-
- dnl Prerequisites of lib/c-strtod.c.
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
AC_CHECK_FUNCS([strtod_l])
@@ -45,11 +43,9 @@ AC_DEFUN([gl_C_STRTOD],
:
])
+dnl Prerequisites of lib/c-strtold.c.
AC_DEFUN([gl_C_STRTOLD],
[
- AC_LIBOBJ([c-strtold])
-
- dnl Prerequisites of lib/c-strtold.c.
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
AC_REQUIRE([gl_C99_STRTOLD])
AC_CHECK_FUNCS([strtold_l])
diff --git a/m4/dup2.m4 b/m4/dup2.m4
new file mode 100644
index 00000000000..8d7f62c8876
--- /dev/null
+++ b/m4/dup2.m4
@@ -0,0 +1,76 @@
+#serial 13
+dnl Copyright (C) 2002, 2005, 2007, 2009-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.
+
+AC_DEFUN([gl_FUNC_DUP2],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ m4_ifdef([gl_FUNC_DUP2_OBSOLETE], [
+ AC_CHECK_FUNCS_ONCE([dup2])
+ if test $ac_cv_func_dup2 = no; then
+ HAVE_DUP2=0
+ AC_LIBOBJ([dup2])
+ fi
+ ], [
+ AC_DEFINE([HAVE_DUP2], [1], [Define to 1 if you have the 'dup2' function.])
+ ])
+ if test $HAVE_DUP2 = 1; then
+ AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works],
+ [AC_RUN_IFELSE([
+ AC_LANG_PROGRAM([[#include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>]],
+ [int result = 0;
+#ifdef FD_CLOEXEC
+ if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
+ result |= 1;
+#endif
+ if (dup2 (1, 1) == 0)
+ result |= 2;
+#ifdef FD_CLOEXEC
+ if (fcntl (1, F_GETFD) != FD_CLOEXEC)
+ result |= 4;
+#endif
+ close (0);
+ if (dup2 (0, 0) != -1)
+ result |= 8;
+ /* Many gnulib modules require POSIX conformance of EBADF. */
+ if (dup2 (2, 1000000) == -1 && errno != EBADF)
+ result |= 16;
+ return result;
+ ])
+ ],
+ [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;;
+ cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
+ gl_cv_func_dup2_works=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;;
+ freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
+ gl_cv_func_dup2_works=no;;
+ haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
+ gl_cv_func_dup2_works=no;;
+ *) gl_cv_func_dup2_works=yes;;
+ esac])
+ ])
+ if test "$gl_cv_func_dup2_works" = no; then
+ gl_REPLACE_DUP2
+ fi
+ fi
+])
+
+AC_DEFUN([gl_REPLACE_DUP2],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([dup2])
+ if test $ac_cv_func_dup2 = yes; then
+ REPLACE_DUP2=1
+ fi
+ AC_LIBOBJ([dup2])
+])
diff --git a/m4/filemode.m4 b/m4/filemode.m4
index 4147fd01e28..8f6e8bc3bb0 100644
--- a/m4/filemode.m4
+++ b/m4/filemode.m4
@@ -1,4 +1,4 @@
-# filemode.m4 serial 7
+# filemode.m4 serial 8
dnl Copyright (C) 2002, 2005-2006, 2009-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,
@@ -7,6 +7,5 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FILEMODE],
[
AC_REQUIRE([AC_STRUCT_ST_DM_MODE])
- AC_LIBOBJ([filemode])
AC_CHECK_DECLS_ONCE([strmode])
])
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4
index e58d29b238f..b75e05fa056 100644
--- a/m4/getloadavg.m4
+++ b/m4/getloadavg.m4
@@ -7,57 +7,70 @@
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-#serial 2
+#serial 4
# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent.
# New applications should use gl_GETLOADAVG instead.
-# gl_GETLOADAVG(LIBOBJDIR)
-# ------------------------
+# gl_GETLOADAVG
+# -------------
AC_DEFUN([gl_GETLOADAVG],
[AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
# Persuade glibc <stdlib.h> to declare getloadavg().
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
-# Make sure getloadavg.c is where it belongs, at configure-time.
-test -f "$srcdir/$1/getloadavg.c" ||
- AC_MSG_ERROR([$srcdir/$1/getloadavg.c is missing])
-
gl_save_LIBS=$LIBS
# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
+HAVE_GETLOADAVG=1
AC_CHECK_FUNC([getloadavg], [],
- [gl_have_func=no
+ [gl_func_getloadavg_done=no
# Some systems with -lutil have (and need) -lkvm as well, some do not.
# On Solaris, -lkvm requires nlist from -lelf, so check that first
# to get the right answer into the cache.
# For kstat on solaris, we need to test for libelf and libkvm to force the
# definition of SVR4 below.
- if test $gl_have_func = no; then
+ if test $gl_func_getloadavg_done = no; then
AC_CHECK_LIB([elf], [elf_begin], [LIBS="-lelf $LIBS"])
AC_CHECK_LIB([kvm], [kvm_open], [LIBS="-lkvm $LIBS"])
# Check for the 4.4BSD definition of getloadavg.
AC_CHECK_LIB([util], [getloadavg],
- [LIBS="-lutil $LIBS" gl_have_func=yes])
+ [LIBS="-lutil $LIBS" gl_func_getloadavg_done=yes])
fi
- if test $gl_have_func = no; then
+ if test $gl_func_getloadavg_done = no; then
# There is a commonly available library for RS/6000 AIX.
# Since it is not a standard part of AIX, it might be installed locally.
gl_getloadavg_LIBS=$LIBS
LIBS="-L/usr/local/lib $LIBS"
AC_CHECK_LIB([getloadavg], [getloadavg],
- [LIBS="-lgetloadavg $LIBS" gl_have_func=yes],
+ [LIBS="-lgetloadavg $LIBS" gl_func_getloadavg_done=yes],
[LIBS=$gl_getloadavg_LIBS])
fi
# Set up the replacement function if necessary.
- if test $gl_have_func = no; then
- AC_LIBOBJ([getloadavg])
- gl_PREREQ_GETLOADAVG
+ if test $gl_func_getloadavg_done = no; then
+ HAVE_GETLOADAVG=0
+
+ # Solaris has libkstat which does not require root.
+ AC_CHECK_LIB([kstat], [kstat_open])
+ test $ac_cv_lib_kstat_kstat_open = yes && gl_func_getloadavg_done=yes
+
+ # AIX has libperfstat which does not require root
+ if test $gl_func_getloadavg_done = no; then
+ AC_CHECK_LIB([perfstat], [perfstat_cpu_total])
+ test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_func_getloadavg_done=yes
+ fi
+
+ if test $gl_func_getloadavg_done = no; then
+ AC_CHECK_HEADER([sys/dg_sys_info.h],
+ [gl_func_getloadavg_done=yes
+ AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with <sys/dg_sys_info.h>.])
+ AC_CHECK_LIB([dgc], [dg_sys_info])])
+ fi
fi])
if test "x$gl_save_LIBS" = x; then
@@ -92,52 +105,35 @@ AC_DEFUN([gl_PREREQ_GETLOADAVG],
[
# Figure out what our getloadavg.c needs.
-# Solaris has libkstat which does not require root.
-AC_CHECK_LIB([kstat], [kstat_open])
-test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes
-
# On HPUX9, an unprivileged user can get load averages this way.
-if test $gl_have_func = no; then
- AC_CHECK_FUNCS([pstat_getdynamic], [gl_have_func=yes])
-fi
-
-# AIX has libperfstat which does not require root
-if test $gl_have_func = no; then
- AC_CHECK_LIB([perfstat], [perfstat_cpu_total])
- test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes
-fi
-
-if test $gl_have_func = no; then
- AC_CHECK_HEADER([sys/dg_sys_info.h],
- [gl_have_func=yes
- AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with <sys/dg_sys_info.h>.])
- AC_CHECK_LIB([dgc], [dg_sys_info])])
+if test $gl_func_getloadavg_done = no; then
+ AC_CHECK_FUNCS([pstat_getdynamic], [gl_func_getloadavg_done=yes])
fi
# We cannot check for <dwarf.h>, because Solaris 2 does not use dwarf (it
# uses stabs), but it is still SVR4. We cannot check for <elf.h> because
# Irix 4.0.5F has the header but not the library.
-if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \
+if test $gl_func_getloadavg_done = no && test "$ac_cv_lib_elf_elf_begin" = yes \
&& test "$ac_cv_lib_kvm_kvm_open" = yes; then
- gl_have_func=yes
+ gl_func_getloadavg_done=yes
AC_DEFINE([SVR4], [1], [Define to 1 on System V Release 4.])
fi
-if test $gl_have_func = no; then
+if test $gl_func_getloadavg_done = no; then
AC_CHECK_HEADER([inq_stats/cpustats.h],
- [gl_have_func=yes
+ [gl_func_getloadavg_done=yes
AC_DEFINE([UMAX], [1], [Define to 1 for Encore UMAX.])
AC_DEFINE([UMAX4_3], [1],
[Define to 1 for Encore UMAX 4.3 that has <inq_status/cpustats.h>
instead of <sys/cpustats.h>.])])
fi
-if test $gl_have_func = no; then
+if test $gl_func_getloadavg_done = no; then
AC_CHECK_HEADER([sys/cpustats.h],
- [gl_have_func=yes; AC_DEFINE([UMAX])])
+ [gl_func_getloadavg_done=yes; AC_DEFINE([UMAX])])
fi
-if test $gl_have_func = no; then
+if test $gl_func_getloadavg_done = no; then
AC_CHECK_HEADERS([mach/mach.h])
fi
diff --git a/m4/getopt.m4 b/m4/getopt.m4
index 035a530df2d..7e49ddde9f6 100644
--- a/m4/getopt.m4
+++ b/m4/getopt.m4
@@ -1,4 +1,4 @@
-# getopt.m4 serial 34
+# getopt.m4 serial 38
dnl Copyright (C) 2002-2006, 2008-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,
@@ -9,10 +9,25 @@ AC_DEFUN([gl_FUNC_GETOPT_POSIX],
[
m4_divert_text([DEFAULTS], [gl_getopt_required=POSIX])
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
- gl_GETOPT_IFELSE([
- gl_REPLACE_GETOPT
- ],
- [])
+ 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([
+ REPLACE_GETOPT=1
+ ],
+ [])
+ ])
+ 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
])
# Request a POSIX compliant getopt function with GNU extensions (such as
@@ -25,20 +40,6 @@ AC_DEFUN([gl_FUNC_GETOPT_GNU],
AC_REQUIRE([gl_FUNC_GETOPT_POSIX])
])
-# Request the gnulib implementation of the getopt functions unconditionally.
-# argp.m4 uses this.
-AC_DEFUN([gl_REPLACE_GETOPT],
-[
- 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
- dnl Arrange to compile the getopt implementation.
- AC_LIBOBJ([getopt])
- AC_LIBOBJ([getopt1])
- gl_PREREQ_GETOPT
-])
-
# emacs' configure.in uses this.
AC_DEFUN([gl_GETOPT_IFELSE],
[
@@ -88,15 +89,15 @@ 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
- dnl option processing. Existence of the variable, in and of
+ 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_COMPILE_IFELSE(
+ AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
[[#include <unistd.h>]],
[[int *p = &optreset; return optreset;]])],
@@ -120,22 +121,20 @@ int
main ()
{
{
- int argc = 0;
- char *argv[10];
+ 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;
- argv[argc++] = "program";
- argv[argc++] = "-a";
- argv[argc++] = "foo";
- argv[argc++] = "bar";
- argv[argc] = NULL;
optind = OPTIND_MIN;
opterr = 0;
- c = getopt (argc, argv, "ab");
+ c = getopt (4, argv, "ab");
if (!(c == 'a'))
return 1;
- c = getopt (argc, argv, "ab");
+ c = getopt (4, argv, "ab");
if (!(c == -1))
return 2;
if (!(optind == 2))
@@ -143,22 +142,20 @@ main ()
}
/* Some internal state exists at this point. */
{
- int argc = 0;
- char *argv[10];
+ 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;
- argv[argc++] = "program";
- argv[argc++] = "donald";
- argv[argc++] = "-p";
- argv[argc++] = "billy";
- argv[argc++] = "duck";
- argv[argc++] = "-a";
- argv[argc++] = "bar";
- argv[argc] = NULL;
optind = OPTIND_MIN;
opterr = 0;
- c = getopt (argc, argv, "+abp:q:");
+ c = getopt (7, argv, "+abp:q:");
if (!(c == -1))
return 4;
if (!(strcmp (argv[0], "program") == 0))
@@ -180,7 +177,9 @@ main ()
}
/* Detect MacOS 10.5, AIX 7.1 bug. */
{
- char *argv[3] = { "program", "-ab", NULL };
+ 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')
@@ -238,19 +237,22 @@ dnl is ambiguous with environment values that contain newlines.
and fails on MacOS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
OSF/1 5.1, Solaris 10. */
{
- char *myargv[3];
- myargv[0] = "conftest";
- myargv[1] = "-+";
- myargv[2] = 0;
+ static char conftest[] = "conftest";
+ static char plus[] = "-+";
+ char *argv[3] = { conftest, plus, NULL };
opterr = 0;
- if (getopt (2, myargv, "+a") != '?')
+ if (getopt (2, argv, "+a") != '?')
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,
IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */
{
- char *argv[] = { "program", "-p", "foo", "bar", NULL };
+ static char program[] = "program";
+ static char p[] = "-p";
+ static char foo[] = "foo";
+ static char bar[] = "bar";
+ char *argv[] = { program, p, foo, bar, NULL };
optind = 1;
if (getopt (4, argv, "p::") != 'p')
@@ -264,7 +266,10 @@ dnl is ambiguous with environment values that contain newlines.
}
/* This code succeeds on glibc 2.8 and fails on Cygwin 1.7.0. */
{
- char *argv[] = { "program", "foo", "-p", NULL };
+ static char program[] = "program";
+ static char foo[] = "foo";
+ static char p[] = "-p";
+ char *argv[] = { program, foo, p, NULL };
optind = 0;
if (getopt (3, argv, "-p") != 1)
result |= 16;
@@ -273,13 +278,26 @@ dnl is ambiguous with environment values that contain newlines.
}
/* This code fails on glibc 2.11. */
{
- char *argv[] = { "program", "-b", "-a", NULL };
+ static char program[] = "program";
+ static char b[] = "-b";
+ static char a[] = "-a";
+ char *argv[] = { program, b, a, NULL };
optind = opterr = 0;
if (getopt (3, argv, "+:a:b") != 'b')
result |= 64;
else if (getopt (3, argv, "+:a:b") != ':')
result |= 64;
}
+ /* This code dumps core on glibc 2.14. */
+ {
+ static char program[] = "program";
+ static char w[] = "-W";
+ static char dummy[] = "dummy";
+ char *argv[] = { program, w, dummy, NULL };
+ optind = opterr = 1;
+ if (getopt (3, argv, "W;") != 'W')
+ result |= 128;
+ }
return result;
]])],
[gl_cv_func_getopt_gnu=yes],
diff --git a/m4/gl-comp.m4 b/m4/gl-comp.m4
index 87d7616f8bb..8370c571655 100644
--- a/m4/gl-comp.m4
+++ b/m4/gl-comp.m4
@@ -26,13 +26,18 @@ AC_DEFUN([gl_EARLY],
m4_pattern_allow([^gl_LIBOBJS$])dnl a variable
m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable
AC_REQUIRE([AC_PROG_RANLIB])
+ # Code from module alloca-opt:
# Code from module allocator:
# Code from module arg-nonnull:
# Code from module c++defs:
# Code from module careadlinkat:
# 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 dup2:
# Code from module extensions:
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
# Code from module filemode:
@@ -47,7 +52,10 @@ AC_DEFUN([gl_EARLY],
# Code from module lstat:
# Code from module mktime:
# Code from module multiarch:
+ # Code from module pthread_sigmask:
# Code from module readlink:
+ # Code from module signal:
+ # Code from module sigprocmask:
# Code from module socklen:
# Code from module ssize_t:
# Code from module stat:
@@ -63,12 +71,15 @@ AC_DEFUN([gl_EARLY],
# Code from module stdio:
# Code from module stdlib:
# Code from module strftime:
+ # Code from module strtoimax:
+ # Code from module strtoll:
# Code from module strtoull:
# Code from module strtoumax:
# Code from module symlink:
# Code from module sys_stat:
# Code from module time:
# Code from module time_r:
+ # Code from module u64:
# Code from module unistd:
# Code from module verify:
# Code from module warn-on-use:
@@ -90,24 +101,62 @@ 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
+gl_UNISTD_MODULE_INDICATOR([dup2])
gl_FILEMODE
-gl_GETLOADAVG([$gl_source_base])
+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])
+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
@@ -117,19 +166,39 @@ gl_STDINT_H
gl_STDIO_H
gl_STDLIB_H
gl_FUNC_GNU_STRFTIME
+gl_FUNC_STRTOIMAX
+if test "$ac_cv_have_decl_strtoimax" != yes && 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_have_decl_strtoumax" != yes && 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_gnulib_enabled_dosname=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
+ gl_gnulib_enabled_sigprocmask=false
gl_gnulib_enabled_stat=false
+ gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_verify=false
func_gl_gnulib_m4code_dosname ()
@@ -146,21 +215,56 @@ AC_SUBST([LTLIBINTL])
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
fi
}
+ func_gl_gnulib_m4code_sigprocmask ()
+ {
+ 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
+ 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_gnulib_enabled_stat=true
if $condition; then
func_gl_gnulib_m4code_dosname
fi
+ if $condition; then
+ func_gl_gnulib_m4code_verify
+ fi
+ fi
+ }
+ 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_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_gnulib_enabled_strtoull=true
fi
@@ -171,7 +275,7 @@ gl_STDLIB_MODULE_INDICATOR([strtoull])
gl_gnulib_enabled_verify=true
fi
}
- if test $GNULIB_UNISTD_H_GETOPT = 1; then
+ if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
if test $REPLACE_LSTAT = 1; then
@@ -180,9 +284,18 @@ 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_have_decl_strtoimax" != yes && test $ac_cv_func_strtoimax = no; then
+ func_gl_gnulib_m4code_verify
+ fi
+ if test "$ac_cv_have_decl_strtoimax" != yes && test $ac_cv_func_strtoimax = no && test $ac_cv_type_long_long_int = yes; then
+ func_gl_gnulib_m4code_strtoll
+ fi
if test "$ac_cv_have_decl_strtoumax" != yes && test $ac_cv_func_strtoumax = no; then
func_gl_gnulib_m4code_verify
fi
@@ -192,7 +305,9 @@ gl_STDLIB_MODULE_INDICATOR([strtoull])
m4_pattern_allow([^gl_GNULIB_ENABLED_])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname])
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_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])
# End of code from modules
@@ -339,12 +454,14 @@ AC_DEFUN([gl_FILE_LIST], [
build-aux/arg-nonnull.h
build-aux/c++defs.h
build-aux/warn-on-use.h
+ lib/alloca.in.h
lib/allocator.c
lib/allocator.h
lib/careadlinkat.c
lib/careadlinkat.h
lib/dosname.h
lib/dtoastr.c
+ lib/dup2.c
lib/filemode.c
lib/filemode.h
lib/ftoastr.c
@@ -363,7 +480,16 @@ AC_DEFUN([gl_FILE_LIST], [
lib/md5.h
lib/mktime-internal.h
lib/mktime.c
+ 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
@@ -375,6 +501,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/strftime.h
lib/strtoimax.c
lib/strtol.c
+ lib/strtoll.c
lib/strtoul.c
lib/strtoull.c
lib/strtoumax.c
@@ -382,10 +509,13 @@ AC_DEFUN([gl_FILE_LIST], [
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
@@ -398,7 +528,13 @@ AC_DEFUN([gl_FILE_LIST], [
m4/md5.m4
m4/mktime.m4
m4/multiarch.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
@@ -410,6 +546,8 @@ AC_DEFUN([gl_FILE_LIST], [
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
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index c4d7a20ea35..843efe05181 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 24
+# gnulib-common.m4 serial 26
dnl Copyright (C) 2007-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,
@@ -34,6 +34,20 @@ AC_DEFUN([gl_COMMON_BODY], [
/* 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
+
+/* 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
])
dnl Preparation for running test programs:
dnl Tell glibc to write diagnostics from -D_FORTIFY_SOURCE=2 to stderr, not
@@ -47,16 +61,49 @@ AC_DEFUN([gl_COMMON_BODY], [
# expands to a C preprocessor expression that evaluates to 1 or 0, depending
# whether a gnulib module that has been requested shall be considered present
# or not.
-AC_DEFUN([gl_MODULE_INDICATOR_CONDITION], [1])
+m4_define([gl_MODULE_INDICATOR_CONDITION], [1])
# gl_MODULE_INDICATOR_SET_VARIABLE([modulename])
# sets the shell variable that indicates the presence of the given module to
# a C preprocessor expression that will evaluate to 1.
AC_DEFUN([gl_MODULE_INDICATOR_SET_VARIABLE],
[
- GNULIB_[]m4_translit([[$1]],
- [abcdefghijklmnopqrstuvwxyz./-],
- [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=gl_MODULE_INDICATOR_CONDITION
+ gl_MODULE_INDICATOR_SET_VARIABLE_AUX(
+ [GNULIB_[]m4_translit([[$1]],
+ [abcdefghijklmnopqrstuvwxyz./-],
+ [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])],
+ [gl_MODULE_INDICATOR_CONDITION])
+])
+
+# gl_MODULE_INDICATOR_SET_VARIABLE_AUX([variable])
+# modifies the shell variable to include the gl_MODULE_INDICATOR_CONDITION.
+# The shell variable's value is a C preprocessor expression that evaluates
+# to 0 or 1.
+AC_DEFUN([gl_MODULE_INDICATOR_SET_VARIABLE_AUX],
+[
+ m4_if(m4_defn([gl_MODULE_INDICATOR_CONDITION]), [1],
+ [
+ dnl Simplify the expression VALUE || 1 to 1.
+ $1=1
+ ],
+ [gl_MODULE_INDICATOR_SET_VARIABLE_AUX_OR([$1],
+ [gl_MODULE_INDICATOR_CONDITION])])
+])
+
+# gl_MODULE_INDICATOR_SET_VARIABLE_AUX_OR([variable], [condition])
+# modifies the shell variable to include the given condition. The shell
+# variable's value is a C preprocessor expression that evaluates to 0 or 1.
+AC_DEFUN([gl_MODULE_INDICATOR_SET_VARIABLE_AUX_OR],
+[
+ dnl Simplify the expression 1 || CONDITION to 1.
+ if test "$[]$1" != 1; then
+ dnl Simplify the expression 0 || CONDITION to CONDITION.
+ if test "$[]$1" = 0; then
+ $1=$2
+ else
+ $1="($[]$1 || $2)"
+ fi
+ fi
])
# gl_MODULE_INDICATOR([modulename])
diff --git a/m4/inttypes.m4 b/m4/inttypes.m4
index 1e81990bda2..cc027a417fa 100644
--- a/m4/inttypes.m4
+++ b/m4/inttypes.m4
@@ -1,4 +1,4 @@
-# inttypes.m4 serial 23
+# inttypes.m4 serial 24
dnl Copyright (C) 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,
@@ -13,7 +13,7 @@ AC_DEFUN([gl_INTTYPES_H],
gl_INTTYPES_PRI_SCN
])
-AC_DEFUN([gl_INTTYPES_INCOMPLETE],
+AC_DEFUN_ONCE([gl_INTTYPES_INCOMPLETE],
[
AC_REQUIRE([gl_STDINT_H])
AC_CHECK_HEADERS_ONCE([inttypes.h])
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index b9b22a6b20e..fe161d40101 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,4 +1,4 @@
-# serial 21
+# serial 23
# Copyright (C) 1997-2001, 2003-2011 Free Software Foundation, Inc.
#
@@ -15,24 +15,28 @@ AC_DEFUN([gl_FUNC_LSTAT],
dnl "#define lstat stat", and lstat.c is a no-op.
AC_CHECK_FUNCS_ONCE([lstat])
if test $ac_cv_func_lstat = yes; then
- AC_REQUIRE([AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
- if test $ac_cv_func_lstat_dereferences_slashed_symlink = no; then
- dnl Note: AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK does AC_LIBOBJ([lstat]).
+ AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
+ if test $gl_cv_func_lstat_dereferences_slashed_symlink = no; then
REPLACE_LSTAT=1
fi
- # Prerequisites of lib/lstat.c.
- AC_REQUIRE([AC_C_INLINE])
else
HAVE_LSTAT=0
fi
])
-# Redefine AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK, because it is no longer
-# maintained in Autoconf.
-AC_DEFUN([AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
+# Prerequisites of lib/lstat.c.
+AC_DEFUN([gl_PREREQ_LSTAT],
[
+ AC_REQUIRE([AC_C_INLINE])
+ :
+])
+
+AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
+[
+ dnl We don't use AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK any more, because it
+ dnl is no longer maintained in Autoconf and because it invokes AC_LIBOBJ.
AC_CACHE_CHECK([whether lstat correctly handles trailing slash],
- [ac_cv_func_lstat_dereferences_slashed_symlink],
+ [gl_cv_func_lstat_dereferences_slashed_symlink],
[rm -f conftest.sym conftest.file
echo >conftest.file
if test "$as_ln_s" = "ln -s" && ln -s conftest.file conftest.sym; then
@@ -45,25 +49,22 @@ AC_DEFUN([AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
have to compile and use the lstat wrapper. */
return lstat ("conftest.sym/", &sbuf) == 0;
]])],
- [ac_cv_func_lstat_dereferences_slashed_symlink=yes],
- [ac_cv_func_lstat_dereferences_slashed_symlink=no],
+ [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.
- ac_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink=no
])
else
# If the 'ln -s' command failed, then we probably don't even
# have an lstat function.
- ac_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink=no
fi
rm -f conftest.sym conftest.file
])
- test $ac_cv_func_lstat_dereferences_slashed_symlink = yes &&
+ 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.])
- if test "x$ac_cv_func_lstat_dereferences_slashed_symlink" = xno; then
- AC_LIBOBJ([lstat])
- fi
])
diff --git a/m4/md5.m4 b/m4/md5.m4
index ce7671d6cea..4b41a85b354 100644
--- a/m4/md5.m4
+++ b/m4/md5.m4
@@ -1,4 +1,4 @@
-# md5.m4 serial 11
+# md5.m4 serial 12
dnl Copyright (C) 2002-2006, 2008-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,
@@ -6,8 +6,6 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_MD5],
[
- AC_LIBOBJ([md5])
-
dnl Prerequisites of lib/md5.c.
AC_REQUIRE([gl_BIGENDIAN])
AC_REQUIRE([AC_C_INLINE])
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index 56b2416d619..8ed6d5d2a30 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,4 +1,4 @@
-# serial 19
+# serial 21
dnl Copyright (C) 2002-2003, 2005-2007, 2009-2011 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
@@ -7,21 +7,24 @@ dnl with or without modifications, as long as this notice is preserved.
dnl From Jim Meyering.
-# Redefine AC_FUNC_MKTIME, because it is no longer maintained in Autoconf.
-# AC_FUNC_MKTIME
-# --------------
-AC_DEFUN([AC_FUNC_MKTIME],
-[AC_CHECK_HEADERS_ONCE([unistd.h])
-AC_CHECK_FUNCS_ONCE([alarm])
-AC_REQUIRE([gl_MULTIARCH])
-if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple MacOS 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.
- ac_cv_func_working_mktime=no
-fi
-AC_CACHE_CHECK([for working mktime], [ac_cv_func_working_mktime],
-[AC_RUN_IFELSE([AC_LANG_SOURCE(
+AC_DEFUN([gl_FUNC_MKTIME],
+[
+ AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS])
+
+ dnl We don't use AC_FUNC_MKTIME any more, because it is no longer maintained
+ dnl in Autoconf and because it invokes AC_LIBOBJ.
+ AC_CHECK_HEADERS_ONCE([unistd.h])
+ AC_CHECK_FUNCS_ONCE([alarm])
+ AC_REQUIRE([gl_MULTIARCH])
+ if test $APPLE_UNIVERSAL_BUILD = 1; then
+ # A universal build on Apple MacOS 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
+ fi
+ AC_CACHE_CHECK([for working mktime], [gl_cv_func_working_mktime],
+ [AC_RUN_IFELSE(
+ [AC_LANG_SOURCE(
[[/* Test program from Paul Eggert and Tony Leneis. */
#include <limits.h>
#include <stdlib.h>
@@ -213,27 +216,33 @@ main ()
result |= 64;
return result;
}]])],
- [ac_cv_func_working_mktime=yes],
- [ac_cv_func_working_mktime=no],
- [ac_cv_func_working_mktime=no])])
-if test $ac_cv_func_working_mktime = no; then
- AC_LIBOBJ([mktime])
-fi
-])# AC_FUNC_MKTIME
+ [gl_cv_func_working_mktime=yes],
+ [gl_cv_func_working_mktime=no],
+ [gl_cv_func_working_mktime=no])
+ ])
-AC_DEFUN([gl_FUNC_MKTIME],
-[
- AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS])
- AC_FUNC_MKTIME
- dnl Note: AC_FUNC_MKTIME does AC_LIBOBJ([mktime]).
- if test $ac_cv_func_working_mktime = no; then
+ if test $gl_cv_func_working_mktime = no; then
REPLACE_MKTIME=1
- gl_PREREQ_MKTIME
else
REPLACE_MKTIME=0
fi
])
+AC_DEFUN([gl_FUNC_MKTIME_INTERNAL], [
+ AC_REQUIRE([gl_FUNC_MKTIME])
+ if test $REPLACE_MKTIME = 0; then
+ dnl BeOS has __mktime_internal in libc, but other platforms don't.
+ AC_CHECK_FUNC([__mktime_internal],
+ [AC_DEFINE([mktime_internal], [__mktime_internal],
+ [Define to the real name of the mktime_internal function.])
+ ],
+ [dnl mktime works but it doesn't export __mktime_internal,
+ dnl so we need to substitute our own mktime implementation.
+ REPLACE_MKTIME=1
+ ])
+ fi
+])
+
# Prerequisites of lib/mktime.c.
AC_DEFUN([gl_PREREQ_MKTIME],
[
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
new file mode 100644
index 00000000000..e98d8e0f4ea
--- /dev/null
+++ b/m4/pthread_sigmask.m4
@@ -0,0 +1,27 @@
+# pthread_sigmask.m4 serial 7-emacs1
+dnl Copyright (C) 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.
+
+AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
+[
+ AC_CHECK_FUNCS_ONCE([pthread_sigmask])
+ LIB_PTHREAD_SIGMASK=
+ dnl gl_THREADLIB is not in use. Assume the application wants
+ dnl POSIX semantics.
+ if test $ac_cv_func_pthread_sigmask != yes; then
+ gl_save_LIBS=$LIBS
+ AC_SEARCH_LIBS([pthread_sigmask], [pthread c_r])
+ LIBS=$gl_save_LIBS
+ if test "$ac_cv_search_pthread_sigmask" = no; then
+ HAVE_PTHREAD_SIGMASK=0
+ elif test "$ac_cv_search_pthread_sigmask" != 'none required'; then
+ LIB_PTHREAD_SIGMASK=$ac_cv_search_pthread_sigmask
+ fi
+ fi
+ AC_SUBST([LIB_PTHREAD_SIGMASK])
+ dnl We don't need a variable LTLIB_PTHREAD_SIGMASK, because when
+ dnl "$gl_threads_api" = posix, $LTLIBMULTITHREAD and $LIBMULTITHREAD are the
+ dnl same: either both empty or both "-lpthread".
+])
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index a502ca560fe..91d7df3c91c 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,4 +1,4 @@
-# readlink.m4 serial 9
+# readlink.m4 serial 11
dnl Copyright (C) 2003, 2007, 2009-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,
@@ -10,8 +10,6 @@ AC_DEFUN([gl_FUNC_READLINK],
AC_CHECK_FUNCS_ONCE([readlink])
if test $ac_cv_func_readlink = no; then
HAVE_READLINK=0
- AC_LIBOBJ([readlink])
- gl_PREREQ_READLINK
else
AC_CACHE_CHECK([whether readlink signature is correct],
[gl_cv_decl_readlink_works],
@@ -40,15 +38,14 @@ AC_DEFUN([gl_FUNC_READLINK],
AC_DEFINE([READLINK_TRAILING_SLASH_BUG], [1], [Define to 1 if readlink
fails to recognize a trailing slash.])
REPLACE_READLINK=1
- AC_LIBOBJ([readlink])
elif test "$gl_cv_decl_readlink_works" != yes; then
REPLACE_READLINK=1
- AC_LIBOBJ([readlink])
fi
fi
])
-# Like gl_FUNC_READLINK, except prepare for separate compilation (no AC_LIBOBJ).
+# Like gl_FUNC_READLINK, except prepare for separate compilation
+# (no REPLACE_READLINK, no AC_LIBOBJ).
AC_DEFUN([gl_FUNC_READLINK_SEPARATE],
[
AC_CHECK_FUNCS_ONCE([readlink])
diff --git a/m4/sha1.m4 b/m4/sha1.m4
new file mode 100644
index 00000000000..b8f5c1dcafe
--- /dev/null
+++ b/m4/sha1.m4
@@ -0,0 +1,13 @@
+# sha1.m4 serial 10
+dnl Copyright (C) 2002-2006, 2008-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.
+
+AC_DEFUN([gl_SHA1],
+[
+ dnl Prerequisites of lib/sha1.c.
+ AC_REQUIRE([gl_BIGENDIAN])
+ AC_REQUIRE([AC_C_INLINE])
+ :
+])
diff --git a/m4/sha256.m4 b/m4/sha256.m4
new file mode 100644
index 00000000000..a3429ed3423
--- /dev/null
+++ b/m4/sha256.m4
@@ -0,0 +1,12 @@
+# sha256.m4 serial 5
+dnl Copyright (C) 2005, 2008-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.
+
+AC_DEFUN([gl_SHA256],
+[
+ dnl Prerequisites of lib/sha256.c.
+ AC_REQUIRE([gl_BIGENDIAN])
+ AC_REQUIRE([AC_C_INLINE])
+])
diff --git a/m4/sha512.m4 b/m4/sha512.m4
new file mode 100644
index 00000000000..cd6a0bf302a
--- /dev/null
+++ b/m4/sha512.m4
@@ -0,0 +1,12 @@
+# sha512.m4 serial 6
+dnl Copyright (C) 2005-2006, 2008-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.
+
+AC_DEFUN([gl_SHA512],
+[
+ dnl Prerequisites of lib/sha512.c.
+ AC_REQUIRE([gl_BIGENDIAN])
+ AC_REQUIRE([AC_C_INLINE])
+])
diff --git a/m4/signal_h.m4 b/m4/signal_h.m4
new file mode 100644
index 00000000000..b9536fb0e3c
--- /dev/null
+++ b/m4/signal_h.m4
@@ -0,0 +1,77 @@
+# signal_h.m4 serial 16
+dnl Copyright (C) 2007-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.
+
+AC_DEFUN([gl_SIGNAL_H],
+[
+ AC_REQUIRE([gl_SIGNAL_H_DEFAULTS])
+ AC_REQUIRE([gl_CHECK_TYPE_SIGSET_T])
+ gl_NEXT_HEADERS([signal.h])
+
+# AIX declares sig_atomic_t to already include volatile, and C89 compilers
+# then choke on 'volatile sig_atomic_t'. C99 requires that it compile.
+ AC_CHECK_TYPE([volatile sig_atomic_t], [],
+ [HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=0], [[
+#include <signal.h>
+ ]])
+
+ AC_REQUIRE([AC_TYPE_UID_T])
+
+ dnl Persuade glibc <signal.h> to define sighandler_t.
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_TYPE([sighandler_t], [], [HAVE_SIGHANDLER_T=0], [[
+#include <signal.h>
+ ]])
+
+ 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 <signal.h>
+ ]], [pthread_sigmask sigaction
+ sigaddset sigdelset sigemptyset sigfillset sigismember
+ sigpending sigprocmask])
+])
+
+AC_DEFUN([gl_CHECK_TYPE_SIGSET_T],
+[
+ AC_CHECK_TYPES([sigset_t],
+ [gl_cv_type_sigset_t=yes], [gl_cv_type_sigset_t=no],
+ [[
+ #include <signal.h>
+ /* Mingw defines sigset_t not in <signal.h>, but in <sys/types.h>. */
+ #include <sys/types.h>
+ ]])
+ if test $gl_cv_type_sigset_t != yes; then
+ HAVE_SIGSET_T=0
+ fi
+])
+
+AC_DEFUN([gl_SIGNAL_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SIGNAL_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_SIGNAL_H_DEFAULTS],
+[
+ GNULIB_PTHREAD_SIGMASK=0; AC_SUBST([GNULIB_PTHREAD_SIGMASK])
+ GNULIB_SIGNAL_H_SIGPIPE=0; AC_SUBST([GNULIB_SIGNAL_H_SIGPIPE])
+ GNULIB_SIGPROCMASK=0; AC_SUBST([GNULIB_SIGPROCMASK])
+ GNULIB_SIGACTION=0; AC_SUBST([GNULIB_SIGACTION])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_POSIX_SIGNALBLOCKING=1; AC_SUBST([HAVE_POSIX_SIGNALBLOCKING])
+ HAVE_PTHREAD_SIGMASK=1; AC_SUBST([HAVE_PTHREAD_SIGMASK])
+ HAVE_SIGSET_T=1; AC_SUBST([HAVE_SIGSET_T])
+ HAVE_SIGINFO_T=1; AC_SUBST([HAVE_SIGINFO_T])
+ HAVE_SIGACTION=1; AC_SUBST([HAVE_SIGACTION])
+ HAVE_STRUCT_SIGACTION_SA_SIGACTION=1;
+ AC_SUBST([HAVE_STRUCT_SIGACTION_SA_SIGACTION])
+ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=1;
+ AC_SUBST([HAVE_TYPE_VOLATILE_SIG_ATOMIC_T])
+ HAVE_SIGHANDLER_T=1; AC_SUBST([HAVE_SIGHANDLER_T])
+ REPLACE_PTHREAD_SIGMASK=0; AC_SUBST([REPLACE_PTHREAD_SIGMASK])
+])
diff --git a/m4/signalblocking.m4 b/m4/signalblocking.m4
new file mode 100644
index 00000000000..15b74253ba6
--- /dev/null
+++ b/m4/signalblocking.m4
@@ -0,0 +1,25 @@
+# signalblocking.m4 serial 12
+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], [:])
diff --git a/m4/stat.m4 b/m4/stat.m4
index 27f82d5a91a..c63f59fd533 100644
--- a/m4/stat.m4
+++ b/m4/stat.m4
@@ -1,4 +1,4 @@
-# serial 7
+# serial 8
# Copyright (C) 2009-2011 Free Software Foundation, Inc.
#
@@ -58,9 +58,11 @@ AC_DEFUN([gl_FUNC_STAT],
AC_DEFINE([REPLACE_FUNC_STAT_FILE], [1], [Define to 1 if stat needs
help when passed a file name with a trailing slash]);;
esac
- if test $REPLACE_STAT = 1; then
- AC_LIBOBJ([stat])
- dnl Prerequisites of lib/stat.c.
- AC_REQUIRE([AC_C_INLINE])
- fi
+])
+
+# Prerequisites of lib/stat.c.
+AC_DEFUN([gl_PREREQ_STAT],
+[
+ AC_REQUIRE([AC_C_INLINE])
+ :
])
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index dff37fe1bf9..c75e95722a5 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,4 @@
-# stdint.m4 serial 40
+# stdint.m4 serial 41
dnl Copyright (C) 2001-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,
@@ -7,7 +7,7 @@ dnl with or without modifications, as long as this notice is preserved.
dnl From Paul Eggert and Bruno Haible.
dnl Test whether <stdint.h> is supported or must be substituted.
-AC_DEFUN([gl_STDINT_H],
+AC_DEFUN_ONCE([gl_STDINT_H],
[
AC_PREREQ([2.59])dnl
diff --git a/m4/strftime.m4 b/m4/strftime.m4
index d9de341bf6d..dd30ccfc054 100644
--- a/m4/strftime.m4
+++ b/m4/strftime.m4
@@ -1,4 +1,4 @@
-# serial 32
+# serial 33
# Copyright (C) 1996-1997, 1999-2007, 2009-2011 Free Software Foundation, Inc.
#
@@ -16,8 +16,6 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME],
# These are the prerequisite macros for GNU's strftime.c replacement.
AC_DEFUN([gl_FUNC_STRFTIME],
[
- AC_LIBOBJ([strftime])
-
# This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE.
AC_REQUIRE([AC_STRUCT_TIMEZONE])
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
new file mode 100644
index 00000000000..47fb1bc9c38
--- /dev/null
+++ b/m4/strtoimax.m4
@@ -0,0 +1,23 @@
+# strtoimax.m4 serial 10
+dnl Copyright (C) 2002-2004, 2006, 2009-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.
+
+AC_DEFUN([gl_FUNC_STRTOIMAX],
+[
+ AC_REQUIRE([gl_INTTYPES_H_DEFAULTS])
+
+ AC_CHECK_DECLS_ONCE([strtoimax])
+ if test "$ac_cv_have_decl_strtoimax" != yes; then
+ HAVE_DECL_STRTOIMAX=0
+
+ AC_CHECK_FUNCS([strtoimax])
+ fi
+])
+
+# Prerequisites of lib/strtoimax.c.
+AC_DEFUN([gl_PREREQ_STRTOIMAX], [
+ AC_CHECK_DECLS([strtoll])
+ AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+])
diff --git a/m4/strtoll.m4 b/m4/strtoll.m4
new file mode 100644
index 00000000000..ed6a854b58c
--- /dev/null
+++ b/m4/strtoll.m4
@@ -0,0 +1,24 @@
+# strtoll.m4 serial 7
+dnl Copyright (C) 2002, 2004, 2006, 2008-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.
+
+AC_DEFUN([gl_FUNC_STRTOLL],
+[
+ AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+ dnl We don't need (and can't compile) the replacement strtoll
+ dnl unless the type 'long long int' exists.
+ AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+ if test "$ac_cv_type_long_long_int" = yes; then
+ AC_CHECK_FUNCS([strtoll])
+ if test $ac_cv_func_strtoll = no; then
+ HAVE_STRTOLL=0
+ fi
+ fi
+])
+
+# Prerequisites of lib/strtoll.c.
+AC_DEFUN([gl_PREREQ_STRTOLL], [
+ :
+])
diff --git a/m4/strtoull.m4 b/m4/strtoull.m4
index abf607fd7b1..57ef75423df 100644
--- a/m4/strtoull.m4
+++ b/m4/strtoull.m4
@@ -1,4 +1,4 @@
-# strtoull.m4 serial 6
+# strtoull.m4 serial 7
dnl Copyright (C) 2002, 2004, 2006, 2008-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,
@@ -11,10 +11,9 @@ AC_DEFUN([gl_FUNC_STRTOULL],
dnl unless the type 'unsigned long long int' exists.
AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
if test "$ac_cv_type_unsigned_long_long_int" = yes; then
- AC_REPLACE_FUNCS([strtoull])
+ AC_CHECK_FUNCS([strtoull])
if test $ac_cv_func_strtoull = no; then
HAVE_STRTOULL=0
- gl_PREREQ_STRTOULL
fi
fi
])
diff --git a/m4/strtoumax.m4 b/m4/strtoumax.m4
index 7fa563642a8..58b310de85a 100644
--- a/m4/strtoumax.m4
+++ b/m4/strtoumax.m4
@@ -1,4 +1,4 @@
-# strtoumax.m4 serial 9
+# strtoumax.m4 serial 10
dnl Copyright (C) 2002-2004, 2006, 2009-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,
@@ -12,10 +12,7 @@ AC_DEFUN([gl_FUNC_STRTOUMAX],
if test "$ac_cv_have_decl_strtoumax" != yes; then
HAVE_DECL_STRTOUMAX=0
- AC_REPLACE_FUNCS([strtoumax])
- if test $ac_cv_func_strtoumax = no; then
- gl_PREREQ_STRTOUMAX
- fi
+ AC_CHECK_FUNCS([strtoumax])
fi
])
diff --git a/m4/symlink.m4 b/m4/symlink.m4
index 917d5f0ec2c..680c14f6610 100644
--- a/m4/symlink.m4
+++ b/m4/symlink.m4
@@ -1,4 +1,4 @@
-# serial 4
+# serial 5
# See if we need to provide symlink replacement.
dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
@@ -17,7 +17,6 @@ AC_DEFUN([gl_FUNC_SYMLINK],
dnl and Solaris 9, we want to fix a bug with trailing slash handling.
if test $ac_cv_func_symlink = no; then
HAVE_SYMLINK=0
- AC_LIBOBJ([symlink])
else
AC_CACHE_CHECK([whether symlink handles trailing slash correctly],
[gl_cv_func_symlink_works],
@@ -39,7 +38,6 @@ AC_DEFUN([gl_FUNC_SYMLINK],
rm -f conftest.f conftest.link conftest.lnk2])
if test "$gl_cv_func_symlink_works" != yes; then
REPLACE_SYMLINK=1
- AC_LIBOBJ([symlink])
fi
fi
])
diff --git a/m4/time_r.m4 b/m4/time_r.m4
index 9bb28005fc0..d646edc2d3c 100644
--- a/m4/time_r.m4
+++ b/m4/time_r.m4
@@ -50,10 +50,6 @@ AC_DEFUN([gl_TIME_R],
else
HAVE_LOCALTIME_R=0
fi
- if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
- AC_LIBOBJ([time_r])
- gl_PREREQ_TIME_R
- fi
])
# Prerequisites of lib/time_r.c.
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index eeb3360b058..fb6fe077265 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,4 +1,4 @@
-# unistd_h.m4 serial 55
+# unistd_h.m4 serial 56
dnl Copyright (C) 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,
@@ -36,8 +36,8 @@ AC_DEFUN([gl_UNISTD_H],
]], [chown dup2 dup3 environ euidaccess faccessat fchdir fchownat
fsync ftruncate getcwd getdomainname getdtablesize getgroups
gethostname getlogin getlogin_r getpagesize getusershell setusershell
- endusershell lchown link linkat lseek pipe pipe2 pread pwrite readlink
- readlinkat rmdir sleep symlink symlinkat ttyname_r unlink unlinkat
+ endusershell group_member lchown link linkat lseek pipe pipe2 pread pwrite
+ readlink readlinkat rmdir sleep symlink symlinkat ttyname_r unlink unlinkat
usleep])
])
@@ -72,6 +72,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_GETLOGIN_R=0; AC_SUBST([GNULIB_GETLOGIN_R])
GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE])
GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL])
+ GNULIB_GROUP_MEMBER=0; AC_SUBST([GNULIB_GROUP_MEMBER])
GNULIB_LCHOWN=0; AC_SUBST([GNULIB_LCHOWN])
GNULIB_LINK=0; AC_SUBST([GNULIB_LINK])
GNULIB_LINKAT=0; AC_SUBST([GNULIB_LINKAT])
@@ -110,6 +111,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
HAVE_GETHOSTNAME=1; AC_SUBST([HAVE_GETHOSTNAME])
HAVE_GETLOGIN=1; AC_SUBST([HAVE_GETLOGIN])
HAVE_GETPAGESIZE=1; AC_SUBST([HAVE_GETPAGESIZE])
+ HAVE_GROUP_MEMBER=1; AC_SUBST([HAVE_GROUP_MEMBER])
HAVE_LCHOWN=1; AC_SUBST([HAVE_LCHOWN])
HAVE_LINK=1; AC_SUBST([HAVE_LINK])
HAVE_LINKAT=1; AC_SUBST([HAVE_LINKAT])
diff --git a/make-dist b/make-dist
index 1a92d48a6ba..963236b936e 100755
--- a/make-dist
+++ b/make-dist
@@ -299,7 +299,6 @@ for subdir in site-lisp \
nt nt/inc nt/inc/sys nt/inc/arpa nt/inc/netinet nt/icons \
`find etc lisp -type d` \
doc doc/emacs doc/misc doc/man doc/lispref doc/lispintro \
- test test/automated test/cedet test/cedet/tests test/indent \
info m4 msdos \
nextstep nextstep/Cocoa nextstep/Cocoa/Emacs.base \
nextstep/Cocoa/Emacs.base/Contents \
@@ -485,26 +484,6 @@ echo "Making links to \`doc/man'"
ln ChangeLog* *.1 ../../${tempdir}/doc/man
cd ../../${tempdir}/doc/man)
-echo "Making links to \`test'"
-(cd test
- ln *.el ChangeLog README ../${tempdir}/test)
-
-echo "Making links to \`test/automated'"
-(cd test/automated
- ln *.el Makefile.in ../../${tempdir}/test/automated)
-
-echo "Making links to \`test/cedet'"
-(cd test/cedet
- ln *.el ../../${tempdir}/test/cedet)
-
-echo "Making links to \`test/cedet/tests'"
-(cd test/cedet/tests
- ln *.c *.[ch]pp *.el *.hh *.java *.make ../../../${tempdir}/test/cedet/tests)
-
-echo "Making links to \`test/indent'"
-(cd test/indent
- ln *.m *.mod *.prolog Makefile ../../${tempdir}/test/indent)
-
### It would be nice if they could all be symlinks to top-level copy, but
### you're not supposed to have any symlinks in distribution tar files.
echo "Making sure copying notices are all copies of \`COPYING'"
diff --git a/msdos/ChangeLog b/msdos/ChangeLog
index 12fd7675d67..e1ce2a312e0 100644
--- a/msdos/ChangeLog
+++ b/msdos/ChangeLog
@@ -1,3 +1,31 @@
+2011-06-07 Eli Zaretskii <eliz@gnu.org>
+
+ * sedlibmk.inp (PTRDIFF_T_SUFFIX): Edit to nothing.
+
+2011-05-28 Eli Zaretskii <eliz@gnu.org>
+
+ * sed1v2.inp: Edit "make-docfile -d FOO" commands to chdir back to
+ src/. Make editing of RUN_TEMACS commands less sensitive to
+ leading whitespace.
+
+ * sedlibmk.inp (gl_LIBOBJS): Add sha1.o.
+
+2011-05-20 Eli Zaretskii <eliz@gnu.org>
+
+ * sed1v2.inp (make-docfile commands): Recognize only if the line
+ begins with a TAB. Use $(etc) rather than a literal "../etc".
+ (`sed SED-COMMAND $(srcdir)/lisp.mk`): Edit to replace with "$(lisp).
+ (@lisp_frag@): Edit out.
+
+ * sedlibmk.inp (GNULIB_GROUP_MEMBER, HAVE_GROUP_MEMBER): Edit to
+ zero.
+
+2011-05-19 Glenn Morris <rgm@gnu.org>
+
+ * sed1x.inp (TOOLTIP_SUPPORT, WINDOW_SUPPORT):
+ * sed1v2.inp (MSDOS_SUPPORT, NS_SUPPORT, MOUSE_SUPPORT)
+ (TOOLTIP_SUPPORT, WINDOW_SUPPORT): No need to edit these any more.
+
2011-05-07 Eli Zaretskii <eliz@gnu.org>
* inttypes.h: Include stdint.h.
diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp
index 44ee53a5c34..623f5cacbc9 100644
--- a/msdos/sed1v2.inp
+++ b/msdos/sed1v2.inp
@@ -94,13 +94,11 @@ s/\.h\.in/.h-in/
/^WIDGET_OBJ *=/s/@WIDGET_OBJ@//
/^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@//
/^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/
-/^MSDOS_SUPPORT *=/s/= */= $(MSDOS_SUPPORT_REAL)/
/^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@//
-/^NS_SUPPORT *=/s/@NS_SUPPORT@//
/^GNU_OBJC_CFLAGS*=/s/@GNU_OBJC_CFLAGS@//
/^LIBRESOLV *=/s/@LIBRESOLV@//
/^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@//
@@ -111,9 +109,6 @@ s/\.h\.in/.h-in/
/^OTHER_FILES *=/s/@OTHER_FILES@//
/^XMENU_OBJ *=/s/@XMENU_OBJ@/xmenu.o/
/^FONT_OBJ *=/s/@FONT_OBJ@//
-/^MOUSE_SUPPORT *=/s/@MOUSE_SUPPORT@/$(REAL_MOUSE_SUPPORT)/
-/^TOOLTIP_SUPPORT *=/s/@TOOLTIP_SUPPORT@//
-/^WINDOW_SUPPORT *=/s/@WINDOW_SUPPORT@//
/^LIBGPM *=/s/@LIBGPM@//
/^EXEEXT *=/s/@EXEEXT@/.exe/
/^OLDXMENU *=/s/@OLDXMENU@/nothing/
@@ -132,15 +127,16 @@ s/\.h\.in/.h-in/
/^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-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
/^ if test -f/,/^ fi$/c\
command.com /c if exist .gdbinit rm -f _gdbinit
/^ if test "\$(CANNOT_DUMP)" =/,/^ else /d
/^ fi/d
-/^ LC_ALL=C \$(RUN_TEMACS)/i\
+/^ *LC_ALL=C \$(RUN_TEMACS)/i\
stubedit temacs.exe minstack=1024k
/^ *LC_ALL=C.*\$(RUN_TEMACS)/s/LC_ALL=C/set &;/
/-batch -l loadup/a\
@@ -166,6 +162,7 @@ s/^ [^ ]*move-if-change / update /
/^ -\{0,1\} *ln -/s/ln -f/cp -pf/
/^[ ]touch /s/touch/djecho $@ >/
s/@YMF_PASS_LDFLAGS@/flags/
+s/@lisp_frag@//
s/@deps_frag@//
s/@ns_frag@//
s/@PRE_EDIT_LDFLAGS@//
diff --git a/msdos/sed1x.inp b/msdos/sed1x.inp
index dff76fda27b..d0a37807d9e 100644
--- a/msdos/sed1x.inp
+++ b/msdos/sed1x.inp
@@ -26,7 +26,5 @@ s/DOC/DOC-X/g
/^LIBS_SYSTEM *=/s!= *!= -lxext -lsys!
/^MSDOS_X_OBJ *=/s!= *!= w16select.o termcap.o!
/^FONT_OBJ *=/s!= *!= xfont.o!
-/^TOOLTIP_SUPPORT *=/s!= *!= ${lispsource}tooltip.elc!
-/^WINDOW_SUPPORT *=/s!= *!= $(BASE_WINDOW_SUPPORT) $(X_WINDOW_SUPPORT)!
/^temacs *:/s!OLDXMENU!LIBXMENU!
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 0c501421821..3860203d2bf 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -197,6 +197,7 @@ am__cd = cd
/^GNULIB_GETSUBOPT *=/s/@GNULIB_GETSUBOPT@/0/
/^GNULIB_GETUSERSHELL *=/s/@GNULIB_GETUSERSHELL@/0/
/^GNULIB_GRANTPT *=/s/@GNULIB_GRANTPT@/0/
+/^GNULIB_GROUP_MEMBER *=/s/@GNULIB_GROUP_MEMBER@/0/
/^GNULIB_LCHMOD *=/s/@GNULIB_LCHMOD@/0/
/^GNULIB_LCHOWN *=/s/@GNULIB_LCHOWN@/0/
/^GNULIB_LINK *=/s/@GNULIB_LINK@/0/
@@ -328,6 +329,7 @@ am__cd = cd
/^HAVE_GETPAGESIZE *=/s/@HAVE_GETPAGESIZE@/1/
/^HAVE_GETSUBOPT *=/s/@HAVE_GETSUBOPT@/0/
/^HAVE_GRANTPT *=/s/@HAVE_GRANTPT@/0/
+/^HAVE_GROUP_MEMBER *=/s/@HAVE_GROUP_MEMBER@/0/
/^HAVE_LCHOWN *=/s/@HAVE_LCHOWN@/0/
/^HAVE_INTTYPES_H *=/s/@HAVE_INTTYPES_H@/HAVE_INTTYPES_H/
/^HAVE_LCHMOD *=/s/@HAVE_LCHMOD@/0/
@@ -422,6 +424,7 @@ am__cd = cd
/^PRAGMA_COLUMNS *=/s/@[^@\n]*@//
/^PRAGMA_SYSTEM_HEADER *=/s/@[^@\n]*@/\\\#pragma GCC system_header/
/^PTHREAD_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/
+/^PTRDIFF_T_SUFFIX *=/s/@[^@\n]*@//
/^RANLIB *=/s/@[^@\n]*@/ranlib/
/^REPLACE_CALLOC *=/s/@REPLACE_CALLOC@/0/
/^REPLACE_CANONICALIZE_FILE_NAME *=/s/@REPLACE_CANONICALIZE_FILE_NAME@/0/
@@ -519,7 +522,7 @@ am__cd = cd
/^WINT_T_SUFFIX *=/s/@WINT_T_SUFFIX@//
/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 md5.o filemode.o/
+/^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o md5.o filemode.o sha1.o/
/^BUILT_SOURCES *=/s/ *inttypes\.h//
/^am_libgnu_a_OBJECTS *=/s/careadlinkat\.\$(OBJEXT)//
/^am_libgnu_a_OBJECTS *=/s/allocator\.\$(OBJEXT)//
diff --git a/nt/ChangeLog b/nt/ChangeLog
index 6de2b15fced..087f006b88b 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,17 @@
+2011-06-07 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/stdint.h (INT32_MAX, INT64_MAX, INTPTR_MAX, PTRDIFF_MAX)
+ [!__GNUC__]: New macros.
+
+2011-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use 'inline', not 'INLINE'.
+ * config.nt (INLINE): Remove.
+
+2011-05-17 Eli Zaretskii <eliz@gnu.org>
+
+ * README.W32: Add information about GnuTLS libraries.
+
2011-05-09 Eli Zaretskii <eliz@gnu.org>
* config.nt [_MSC_VER] (va_copy): Replacement for the MS compiler.
diff --git a/nt/README.W32 b/nt/README.W32
index 4e26ef1c8d7..4a3f7c41e9e 100644
--- a/nt/README.W32
+++ b/nt/README.W32
@@ -147,6 +147,15 @@ See the end of the file for license conditions.
unreliable under Windows. See nt/INSTALL in the src distribution if
you wish to compile Emacs with SVG support.
+* GnuTLS support
+
+ In order to support GnuTLS at runtime, Emacs must be able to find
+ the relevant DLLs during startup; failure to do so is not an error,
+ 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/.
+
* Uninstalling Emacs
If you should need to uninstall Emacs, simply delete all the files
diff --git a/nt/config.nt b/nt/config.nt
index c071bafc7dc..2ba76df4446 100644
--- a/nt/config.nt
+++ b/nt/config.nt
@@ -362,14 +362,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* End of gnulib-related stuff. */
-/* If using GNU, then support inline function declarations. */
-#ifdef __GNUC__
-#define INLINE __inline__
-#define inline __inline__
-#else
-#define INLINE
-#endif
-
#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
#define NO_INLINE __attribute__((noinline))
#else
diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h
index 555ca9182ff..4af0346af2c 100644
--- a/nt/inc/stdint.h
+++ b/nt/inc/stdint.h
@@ -28,14 +28,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
stdint.h is not available, e.g. Microsoft Visual Studio. */
typedef unsigned int uint32_t;
+#define INT32_MAX 2147483647
+/* "i64" is the non-standard suffix used by MSVC for 64-bit constants. */
+#define INT64_MAX 9223372036854775807i64
#ifdef _WIN64
typedef __int64 intptr_t;
+#define INTPTR_MAX INT64_MAX
#else
typedef int intptr_t;
+#define INTPTR_MAX INT32_MAX
#endif
#define uintmax_t unsigned __int64
+#define PTRDIFF_MAX INTPTR_MAX
#endif /* !__GNUC__ */
diff --git a/src/ChangeLog b/src/ChangeLog
index 21c394480bf..c2bd1981e76 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,343 +1,2068 @@
2011-07-14 Eli Zaretskii <eliz@gnu.org>
- * bidi.c (bidi_cache_fetch_state, bidi_cache_search)
+ Support bidi reordering of display and overlay strings.
+ * xdisp.c (compute_display_string_pos)
+ (compute_display_string_end): Accept additional argument STRING.
+ (init_iterator, reseat_1): Initialize bidi_it->string.s to NULL.
+ (reseat_to_string): Initialize bidi_it->string.s and
+ bidi_it->string.schars.
+ (Fcurrent_bidi_paragraph_direction): Initialize itb.string.s to
+ NULL (avoids a crash in bidi_paragraph_init). Initialize
+ itb.string.lstring.
+ (init_iterator): Call bidi_init_it only of a valid
+ buffer position was specified. Initialize paragraph_embedding to
+ L2R.
+ (reseat_to_string): Initialize the bidi iterator.
+ (display_string): If we need to ignore text properties of
+ LISP_STRING, set IT->stop_charpos to IT->end_charpos. (The
+ original value of -1 will not work with bidi.)
+ (compute_display_string_pos): First arg is now struct
+ `text_pos *'; all callers changed. Support display properties on
+ Lisp strings.
+ (compute_display_string_end): Support display properties on Lisp
+ strings.
+ (init_iterator, reseat_1, reseat_to_string): Initialize the
+ string.bufpos member to 0 (zero, for compatibility with IT_CHARPOS
+ when iterating on a string not from display properties).
+ (compute_display_string_pos, compute_display_string_end): Fix
+ calculation of the object to scan. Fixes an error when using
+ arrow keys.
+ (next_element_from_buffer): Don't abort when IT_CHARPOS is before
+ base_level_stop; instead, set base_level_stop to BEGV. Fixes
+ crashes in vertical-motion.
+ (next_element_from_buffer): Improve commentary for when
+ the iterator is before prev_stop.
+ (init_iterator): Initialize bidi_p from the default value of
+ bidi-display-reordering, not from buffer-local value. Use the
+ buffer-local value only if initializing for buffer iteration.
+ (handle_invisible_prop): Support invisible properties on strings
+ that are being bidi-reordered.
+ (set_iterator_to_next): Support bidi reordering of C strings and
+ Lisp strings.
+ (next_element_from_string): Support bidi reordering of Lisp
+ strings.
+ (handle_stop_backwards): Support Lisp strings as well.
+ (display_string): Support display of R2L glyph rows. Use
+ IT_STRING_CHARPOS when displaying from a Lisp string.
+ (init_iterator): Don't initialize it->bidi_p for strings
+ here.
+ (reseat_to_string): Initialize it->bidi_p for strings here.
+ (next_element_from_string, next_element_from_c_string)
+ (next_element_from_buffer): Add xassert's for correspondence
+ between IT's object being iterated and it->bidi_it.string
+ structure.
+ (face_before_or_after_it_pos): Support bidi iteration.
+ (next_element_from_c_string): Handle the case of the first string
+ character that is not the first one in the visual order.
+ (get_visually_first_element): New function, refactored from common
+ parts of next_element_from_buffer, next_element_from_string, and
+ next_element_from_c_string.
+ (tool_bar_lines_needed, redisplay_tool_bar)
+ (display_menu_bar): Force left-to-right direction. Add a FIXME
+ comment for making that be controlled by a user option.
+ (push_it, pop_it): Save and restore the state of the
+ bidi iterator. Save and restore the bidi_p flag.
+ (pop_it): Iterate out of display property for string iteration as
+ well.
+ (iterate_out_of_display_property): Support iteration over strings.
+ (handle_single_display_spec): Set up it->bidi_it for iteration
+ over a display string, and call bidi_init_it.
+ (handle_single_display_spec, next_overlay_string)
+ (get_overlay_strings_1, push_display_prop): Set up the bidi
+ iterator for displaying display or overlay strings.
+ (forward_to_next_line_start): Don't use the shortcut if
+ bidi-iterating.
+ (back_to_previous_visible_line_start): If handle_display_prop
+ pushed the iterator stack, restore the internal state of the bidi
+ iterator by calling bidi_pop_it same number of times.
+ (reseat_at_next_visible_line_start): If ON_NEWLINE_P is non-zero,
+ and we are bidi-iterating, don't decrement the iterator position;
+ instead, set the first_elt flag in the bidi iterator, to produce
+ the same effect.
+ (reseat_1): Remove redundant setting of string_from_display_prop_p.
+ (push_display_prop): xassert that we are iterating a buffer.
+ (push_it, pop_it): Save and restore paragraph_embedding member.
+ (handle_single_display_spec, next_overlay_string)
+ (get_overlay_strings_1, reseat_1, reseat_to_string)
+ (push_display_prop): Set up the `unibyte' member of bidi_it.string
+ correctly. Don't assume unibyte strings are not bidi-reordered.
+ (compute_display_string_pos)
+ (compute_display_string_end): Fix handling the case of C string.
+ (push_it, pop_it): Save and restore from_disp_prop_p.
+ (handle_single_display_spec, push_display_prop): Set the
+ from_disp_prop_p flag.
+ (get_overlay_strings_1): Reset the from_disp_prop_p flag.
+ (pop_it): Call iterate_out_of_display_property only if we are
+ popping after iteration over a string that came from a display
+ property. Fix a typo in popping stretch info. Add an assertion
+ for verifying that the iterator position is in sync with the bidi
+ iterator.
+ (handle_single_display_spec, get_overlay_strings_1)
+ (push_display_prop): Fix initialization of paragraph direction for
+ string when that of the parent object is not yet determined.
+ (reseat_1): Call bidi_init_it to resync the bidi
+ iterator with IT's position. (Bug#7616)
+ (find_row_edges): If ROW->start.pos gives position
+ smaller than min_pos, use it as ROW->minpos. (Bug#7616)
+ (handle_stop, back_to_previous_visible_line_start, reseat_1):
+ Reset the from_disp_prop_p flag.
+ (SAVE_IT, RESTORE_IT): New macros.
+ (pos_visible_p, face_before_or_after_it_pos)
+ (back_to_previous_visible_line_start)
+ (move_it_in_display_line_to, move_it_in_display_line)
+ (move_it_to, move_it_vertically_backward, move_it_by_lines)
+ (try_scrolling, redisplay_window, display_line): Use them when
+ saving a temporary copy of the iterator and restoring it back.
+ (back_to_previous_visible_line_start, reseat_1)
+ (init_iterator): Empty the bidi cache "stack".
+ (move_it_in_display_line_to): If iterator ended up at
+ EOL, but we never saw any buffer positions smaller than
+ to_charpos, return MOVE_POS_MATCH_OR_ZV. Fixes vertical cursor
+ motion in bidi-reordered lines.
+ (move_it_in_display_line_to): Record prev_method and prev_pos
+ immediately before the call to set_iterator_to_next. Fixes cursor
+ motion in bidi-reordered lines with stretch glyphs and strings
+ displayed in margins. (Bug#8133) (Bug#8867)
+ Return MOVE_POS_MATCH_OR_ZV only if iterator position is past
+ TO_CHARPOS.
+ (pos_visible_p): Support positions in bidi-reordered lines. Save
+ and restore bidi cache.
+
+ * bidi.c (bidi_level_of_next_char): clen should be EMACS_NT, not int.
+ (bidi_paragraph_info): Delete unused struct.
+ (bidi_cache_idx, bidi_cache_last_idx): Declare EMACS_INT.
+ (bidi_cache_start): New variable.
+ (bidi_cache_reset): Reset bidi_cache_idx to bidi_cache_start, not
+ to zero.
+ (bidi_cache_fetch_state, bidi_cache_search)
+ (bidi_cache_find_level_change, bidi_cache_iterator_state)
+ (bidi_cache_find, bidi_peek_at_next_level)
+ (bidi_level_of_next_char, bidi_find_other_level_edge)
+ (bidi_move_to_visually_next): Compare cache index with
+ bidi_cache_start rather than with zero.
+ (bidi_fetch_char): Accept new argument STRING; all callers
+ changed. Support iteration over a string. Support strings with
+ display properties. Support unibyte strings. Fix the type of
+ `len' according to what STRING_CHAR_AND_LENGTH expects.
+ (bidi_paragraph_init, bidi_resolve_explicit_1)
+ (bidi_resolve_explicit, bidi_resolve_weak)
+ (bidi_level_of_next_char, bidi_move_to_visually_next): Support
+ iteration over a string.
+ (bidi_set_sor_type, bidi_resolve_explicit_1)
+ (bidi_resolve_explicit, bidi_type_of_next_char): ignore_bn_limit
+ can now be zero (for strings); special values 0 and -1 were
+ changed to -1 and -2, respectively.
+ (bidi_char_at_pos): New function.
+ (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak):
+ Call it instead of FETCH_MULTIBYTE_CHAR.
+ (bidi_move_to_visually_next): Abort if charpos or bytepos were not
+ initialized to valid values.
+ (bidi_init_it): Don't initialize charpos and bytepos with invalid
+ values.
+ (bidi_level_of_next_char): Allow the sentinel "position" to pass
+ the test for valid cached positions. Fix the logic for looking up
+ the sentinel state in the cache. GCPRO the Lisp string we are
+ iterating.
+ (bidi_push_it, bidi_pop_it): New functions.
+ (bidi_initialize): Initialize the bidi cache start stack pointer.
+ (bidi_cache_ensure_space): New function, refactored from part of
+ bidi_cache_iterator_state. Don't assume the required size is just
+ one BIDI_CACHE_CHUNK away.
+ (bidi_cache_start_stack, bidi_push_it): Use IT_STACK_SIZE.
+ (bidi_count_bytes, bidi_char_at_pos): New functions.
+ (bidi_cache_search): Don't assume bidi_cache_last_idx is
+ always valid if bidi_cache_idx is valid.
+ (bidi_cache_find_level_change): xassert that bidi_cache_last_idx
+ is valid if it's going to be used.
+ (bidi_shelve_cache, bidi_unshelve_cache): New functions.
+ (bidi_cache_fetch_state, bidi_cache_search)
(bidi_cache_find_level_change, bidi_cache_ensure_space)
(bidi_cache_iterator_state, bidi_cache_find)
(bidi_find_other_level_edge, bidi_cache_start_stack): All
variables related to cache indices are now EMACS_INT.
+ * dispextern.h (struct bidi_string_data): New structure.
+ (struct bidi_it): New member `string'. Make flag members be 1-bit
+ fields, and put them last in the struct.
+ (compute_display_string_pos, compute_display_string_end): Update
+ prototypes.
+ (bidi_push_it, bidi_pop_it): Add prototypes.
+ (struct iterator_stack_entry): New members bidi_p,
+ paragraph_embedding, and from_disp_prop_p.
+ (struct it): Member bidi_p is now a bit field 1 bit wide.
+ (bidi_shelve_cache, bidi_unshelve_cache): Declare
+ prototypes.
+
+ * .gdbinit (xvectype, xvector, xcompiled, xchartable, xboolvector)
+ (xpr, xfont, xbacktrace): Use "header.size" when accessing vectors
+ and vector-like objects.
+
+ * dispnew.c (buffer_posn_from_coords): Save and restore the bidi
+ cache around display iteration.
+
+ * window.c (Fwindow_end, window_scroll_pixel_based)
+ (displayed_window_lines, Frecenter): Save and restore the bidi
+ cache around display iteration.
+
+2011-07-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * editfns.c (Fdelete_region): Clarify the use of the named
+ parameters (bug#6788).
+
+2011-07-14 Martin Rudalics <rudalics@gmx.at>
+
+ * indent.c (Fvertical_motion): Set and restore w->pointm when
+ saving and restoring the window's buffer (Bug#9006).
+
+2011-07-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * editfns.c (Fstring_to_char): Clarify just what is returned
+ (bug#6576). Text by Eli Zaretskii.
+
+2011-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): Honor gnutls_log_level (bug#9059).
+
+2011-07-13 Eli Zaretskii <eliz@gnu.org>
+
+ * buffer.c (mmap_find): Fix a typo.
+
+2011-07-13 Johan Bockgård <bojohan@gnu.org>
+
+ Fix execution of x selection hooks.
+ * xselect.c (Qx_lost_selection_functions)
+ (Qx_sent_selection_functions): New vars.
+ (syms_of_xselect): DEFSYM them.
+ (x_handle_selection_request): Pass Qx_sent_selection_functions
+ rather than Vx_sent_selection_functions to Frun_hook_with_args.
+ (x_handle_selection_clear,x_clear_frame_selections):
+ Pass Qx_lost_selection_functions rather than
+ Vx_lost_selection_functions to Frun_hook_with_args.
+
+2011-07-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.c (Fget_buffer_create): Initialize inhibit_shrinking.
+ The old code sometimes used this field without initializing it.
+
+ * alloc.c (gc_sweep): Don't read past end of array.
+ In theory, the old code could also have corrupted Emacs internals,
+ though it'd be very unlikely.
+
+2011-07-12 Andreas Schwab <schwab@linux-m68k.org>
+
+ * character.c (Fcharacterp): Don't advertise optional ignored
+ argument. (Bug#4026)
+
+2011-07-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * keymap.c (syms_of_keymap): Clarify that "modifier" is "modifier
+ key" (bug#4257).
+
+ * window.c (Fset_window_start): Doc fix (bug#4199).
+ (Fset_window_hscroll): Ditto.
+
+2011-07-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor new problems caught by GCC 4.6.1.
+ * term.c (init_tty): Remove unused local.
+ * xsettings.c (store_monospaced_changed): Define this function only
+ if (defined HAVE_GSETTINGS || defined HAVE_GCONF), as it's
+ not used otherwise.
+
+2011-07-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * xdisp.c (Vresize_mini_windows): Minor doc fix (Bug#3300).
+
+2011-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * xdisp.c (syms_of_xdisp): Make it explicit that the mini-windows
+ are the mini-buffer and the echo area (bug#3320).
+
+ * term.c (init_tty): Remove support for supdup, c10 and perq
+ terminals, which are no longer supported (bug#1482).
+
+2011-07-10 Johan Bockgård <bojohan@gnu.org>
+
+ * xdisp.c (Ftool_bar_lines_needed): Fix WINDOWP check.
+
+2011-07-10 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xmenu.c (menu_highlight_callback): Only pass frame to show_help_event
+ for non-popups (Bug#3642).
+
+2011-07-10 Andreas Schwab <schwab@linux-m68k.org>
+
+ * alloc.c (reset_malloc_hooks): Protoize.
+ * buffer.c (mmap_init, mmap_find, mmap_free_1, mmap_enlarge)
+ (mmap_set_vars, mmap_alloc, mmap_free, mmap_realloc): Likewise.
+ * cm.c (losecursor): Likewise.
+ * data.c (fmod): Likewise.
+ * dispnew.c (swap_glyphs_in_rows): Likewise.
+ * emacs.c (memory_warning_signal): Likewise.
+ * floatfns.c (float_error): Likewise.
+ * font.c (check_gstring, check_otf_features, otf_tag_symbol)
+ (otf_open, font_otf_capability, generate_otf_features)
+ (font_otf_DeviceTable, font_otf_ValueRecord, font_otf_Anchor):
+ Likewise.
+ * image.c (pbm_read_file): Likewise.
+ * indent.c (string_display_width): Likewise.
+ * intervals.c (check_for_interval, search_for_interval)
+ (inc_interval_count, count_intervals, root_interval)
+ (adjust_intervals_for_insertion, make_new_interval): Likewise.
+ * lread.c (defalias): Likewise.
+ * ralloc.c (r_alloc_check): Likewise.
+ * regex.c (set_image_of_range_1, set_image_of_range)
+ (regex_grow_registers): Likewise.
+ * sysdep.c (strerror): Likewise.
+ * termcap.c (valid_filename_p, tprint, main): Likewise.
+ * tparam.c (main): Likewise.
+ * unexhp9k800.c (run_time_remap, save_data_space)
+ (update_file_ptrs, read_header, write_header, calculate_checksum)
+ (copy_file, copy_rest, display_header): Likewise.
+ * widget.c (mark_shell_size_user_specified, create_frame_gcs):
+ Likewise.
+ * xdisp.c (check_it): Likewise.
+ * xfaces.c (register_color, unregister_color, unregister_colors):
+ Likewise.
+ * xfns.c (print_fontset_result): Likewise.
+ * xrdb.c (member, fatal, main): Likewise.
+
+2011-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor problems found by static checking (Bug#9031).
+ * chartab.c (char_table_set_range, map_sub_char_table):
+ Remove unused locals.
+ (uniprop_table): Now static.
+ * composite.c (_work_char): Remove unused static var.
+
+2011-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * chartab.c (uniprop_table_uncompress): Remove unused local variable.
+
+2011-07-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (qttip_cb): Remove code without function.
+
2011-07-09 Eli Zaretskii <eliz@gnu.org>
- * bidi.c (bidi_fetch_char): Fix the type of `len' according to
- what STRING_CHAR_AND_LENGTH expects.
+ * w32.c (pthread_sigmask): New stub.
- * xdisp.c (move_it_in_display_line_to): Record prev_method and
- prev_pos immediately before the call to set_iterator_to_next.
- Fixes cursor motion in bidi-reordered lines with stretch glyphs
- and strings displayed in margins. (Bug#8133) (Bug#8867)
- Return MOVE_POS_MATCH_OR_ZV only if iterator position is past
- TO_CHARPOS.
- (pos_visible_p): Support positions in bidi-reordered lines. Save
- and restore bidi cache.
+2011-07-08 Paul Eggert <eggert@cs.ucla.edu>
-2011-07-08 Eli Zaretskii <eliz@gnu.org>
+ Use pthread_sigmask, not sigprocmask (Bug#9010).
+ sigprocmask is portable only for single-threaded applications, and
+ Emacs can be multi-threaded when it uses GTK.
+ * Makefile.in (LIB_PTHREAD_SIGMASK): New macro.
+ (LIBES): Use it.
+ * callproc.c (Fcall_process):
+ * process.c (create_process):
+ * sysdep.c (sys_sigblock, sys_sigunblock, sys_sigsetmask):
+ Use pthread_sigmask, not sigprocmask.
- * xdisp.c (move_it_in_display_line_to): If iterator ended up at
- EOL, but we never saw any buffer positions smaller than
- to_charpos, return MOVE_POS_MATCH_OR_ZV. Fixes vertical cursor
- motion in bidi-reordered lines.
+2011-07-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (qttip_cb): Set line wrap to FALSE for tooltip widget.
+ (xg_prepare_tooltip): Revert text in x->ttip_lbl, margins was
+ wrong (Bug#8591).
+
+2011-07-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_prepare_tooltip): Fix indentation and comment.
+ Put text in x->ttip_lbl instead of gtk_tooltip_set_text (Bug#8591).
+ (xg_hide_tooltip): Fix comment.
+
+ * nsterm.m (initFrameFromEmacs): Don't use ns_return_types
+ in registerServicesMenuSendTypes.
+ (validRequestorForSendType): Don't check ns_return_types.
+
+ * nsfns.m (Fx_open_connection): Put NSStringPboardType into
+ ns_return_type.
+
+2011-07-08 Jason Rumney <jasonr@gnu.org>
+
+ * w32fns.c (w32_wnd_proc) [WM_TIMER, WM_SET_CURSOR]: Avoid using
+ frame struct members of non-existent frames (Bug#6284).
+
+2011-07-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (keyDown): Call to wantsToDelayTextChangeNotifications and
+ variable firstTime not needed on OSX >= 10.6.
+ (setPosition): setFloatValue:knobProportion: is deprecated on OSX
+ >= 10.5. Use setKnobProportion, setDoubleValue.
+
+ * nsterm.h (MAC_OS_X_VERSION_10_3, MAC_OS_X_VERSION_10_4)
+ (MAC_OS_X_VERSION_10_5): Define if not defined.
+ (EmacsView, EmacsTooltip): Implements NSWindowDelegate on OSX >= 10.6.
+ (EmacsMenu): Implements NSMenuDelegate on OSX >= 10.6.
+ (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
+
+ * nsmenu.m (fillWithWidgetValue): Don't use depercated method
+ sizeToFit on OSX >= 10.2.
+
+ * nsimage.m (allocInitFromFile): Don't use deprecated method
+ bestRepresentationForDevice on OSX >= 10.6.
+
+ * nsfns.m (check_ns_display_info): Cast to long and use %ld in error
+ to avoid warning.
+
+ * emacs.c: Declare unexec_init_emacs_zone.
+
+ * nsgui.h: Fix compiler warning about gnulib redefining verify.
+
+ * nsselect.m (ns_get_local_selection): Change to extern (Bug#8842).
+
+ * nsmenu.m (ns_update_menubar): Remove useless setDelegate call
+ on svcsMenu (Bug#8842).
+
+ * nsfns.m (Fx_open_connection): Remove NSStringPboardType from
+ ns_return_types.
+ (Fns_list_services): Just return Qnil on 10.6, code not working there.
+
+ * nsterm.m (QUTF8_STRING): Declare.
+ (initFrameFromEmacs): Call registerServicesMenuSendTypes.
+ (validRequestorForSendType): Return type is (id).
+ Change indexOfObjectIdenticalTo to indexOfObject.
+ Check if we have local selection before returning self (Bug#8842).
+ (writeSelectionToPasteboard): Put local selection into paste board
+ if we have a local selection (Bug#8842).
+ (syms_of_nsterm): DEFSYM QUTF8_STRING.
+
+ * nsterm.h (MAC_OS_X_VERSION_10_6): Define here instead of nsterm.m.
+ (ns_get_local_selection): Declare.
+
+2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * keymap.c (describe_map_tree): Don't insert a double newline at
+ the end of the buffer (bug#1169) and return whether we inserted
+ something.
+
+ * callint.c (Fcall_interactively): Change "reading args" to
+ "providing args" to try to clarify what it does (bug#1010).
+
+2011-07-07 Kenichi Handa <handa@m17n.org>
+
+ * composite.c (composition_compute_stop_pos): Ignore a static
+ composition starting before CHARPOS (Bug#8915).
+
+ * xdisp.c (handle_composition_prop): Likewise.
2011-07-07 Eli Zaretskii <eliz@gnu.org>
- * xdisp.c (find_row_edges): If ROW->start.pos gives position
- smaller than min_pos, use it as ROW->minpos. (Bug#7616)
+ * term.c (produce_glyphs) <xassert>: Allow IT_GLYPHLESS in it->what.
+ (Bug#9015)
+
+2011-07-07 Kenichi Handa <handa@m17n.org>
+
+ * character.h (unicode_category_t): New enum type.
+
+ * chartab.c (uniprop_decoder_t, uniprop_encoder_t): New types.
+ (Qchar_code_property_table): New variable.
+ (UNIPROP_TABLE_P, UNIPROP_GET_DECODER)
+ (UNIPROP_COMPRESSED_FORM_P): New macros.
+ (char_table_ascii): Uncompress the compressed values.
+ (sub_char_table_ref): New arg is_uniprop. Callers changed.
+ Uncompress the compressed values.
+ (sub_char_table_ref_and_range): Likewise.
+ (char_table_ref_and_range): Uncompress the compressed values.
+ (sub_char_table_set): New arg is_uniprop. Callers changed.
+ Uncompress the compressed values.
+ (sub_char_table_set_range): Args changed. Callers changed.
+ (char_table_set_range): Adjuted for the above change.
+ (map_sub_char_table): Delete args default_val and parent. Add arg
+ top. Give decoded values to a Lisp function.
+ (map_char_table): Adjusted for the above change. Give decoded
+ values to a Lisp function. Gcpro more variables.
+ (uniprop_table_uncompress)
+ (uniprop_decode_value_run_length): New functions.
+ (uniprop_decoder, uniprop_decoder_count): New variables.
+ (uniprop_get_decoder, uniprop_encode_value_character)
+ (uniprop_encode_value_run_length, uniprop_encode_value_numeric):
+ New functions.
+ (uniprop_encoder, uniprop_encoder_count): New variables.
+ (uniprop_get_encoder, uniprop_table)
+ (Funicode_property_table_internal, Fget_unicode_property_internal)
+ (Fput_unicode_property_internal): New functions.
+ (syms_of_chartab): DEFSYM Qchar_code_property_table, defsubr
+ Sunicode_property_table_internal, Sget_unicode_property_internal,
+ and Sput_unicode_property_internal. Defvar_lisp
+ char-code-property-alist.
+
+ * composite.c (CHAR_COMPOSABLE_P): Adjusted for the change of
+ Vunicode_category_table.
+
+ * font.c (font_range): Adjusted for the change of
+ Vunicode_category_table.
+
+2011-07-07 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * m/iris4d.h: Remove file, move contents ...
+ * s/irix6-5.h: ... here.
+
+2011-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unportable assumption about struct layout (Bug#8884).
+ * alloc.c (mark_buffer):
+ * buffer.c (reset_buffer_local_variables, Fbuffer_local_variables)
+ (clone_per_buffer_values): Don't assume that
+ sizeof (struct buffer) is a multiple of sizeof (Lisp_Object).
+ This isn't true in general, and it's particularly not true
+ if Emacs is configured with --with-wide-int.
+ * buffer.h (FIRST_FIELD_PER_BUFFER, LAST_FIELD_PER_BUFFER):
+ New macros, used in the buffer.c change.
+
+2011-07-05 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xsettings.c: Use both GConf and GSettings if both are available.
+ (store_config_changed_event): Add comment.
+ (dpyinfo_valid, store_font_name_changed, map_tool_bar_style)
+ (store_tool_bar_style_changed): New functions.
+ (store_monospaced_changed): Add comment. Call dpyinfo_valid.
+ (struct xsettings): Move font inside HAVE_XFT.
+ (GSETTINGS_TOOL_BAR_STYLE, GSETTINGS_FONT_NAME): New defines.
+ (GSETTINGS_MONO_FONT): Renamed from SYSTEM_MONO_FONT.
+ Move inside HAVE_XFT.
+ (something_changed_gsettingsCB): Renamed from something_changedCB.
+ Check for changes in GSETTINGS_TOOL_BAR_STYLE and GSETTINGS_FONT_NAME
+ also.
+ (GCONF_TOOL_BAR_STYLE, GCONF_FONT_NAME): New defines.
+ (GCONF_MONO_FONT): Renamed from SYSTEM_MONO_FONT. Move inside HAVE_XFT.
+ (something_changed_gconfCB): Renamed from something_changedCB.
+ Check for changes in GCONF_TOOL_BAR_STYLE and GCONF_FONT_NAME also.
+ (parse_settings): Move check for font inside HAVE_XFT.
+ (read_settings, apply_xft_settings): Add comment.
+ (read_and_apply_settings): Add comment. Call map_tool_bar_style and
+ store_tool_bar_style_changed. Move check for font inside HAVE_XFT and
+ call store_font_name_changed.
+ (xft_settings_event): Add comment.
+ (init_gsettings): Add comment. Get values for GSETTINGS_TOOL_BAR_STYLE
+ and GSETTINGS_FONT_NAME. Move check for fonts within HAVE_XFT.
+ (init_gconf): Add comment. Get values for GCONF_TOOL_BAR_STYLE
+ and GCONF_FONT_NAME. Move check for fonts within HAVE_XFT.
+ (xsettings_initialize): Call init_gsettings last.
+ (xsettings_get_system_font, xsettings_get_system_normal_font): Add
+ comment.
+
+2011-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Random fixes. E.g., (random) never returned negative values.
+ * fns.c (Frandom): Use GET_EMACS_TIME for random seed, and add the
+ subseconds part to the entropy, as that's a bit more random.
+ Prefer signed to unsigned, since the signedness doesn't matter and
+ in general we prefer signed. When given a limit, use a
+ denominator equal to INTMASK + 1, not to VALMASK + 1, because the
+ latter isn't right if USE_2_TAGS_FOR_INTS.
+ * sysdep.c (get_random): Return a value in the range 0..INTMASK,
+ not 0..VALMASK. Don't discard "excess" bits that random () returns.
+
+2011-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textprop.c (text_property_stickiness):
+ Obey Vtext_property_default_nonsticky.
+ (syms_of_textprop): Add `display' to Vtext_property_default_nonsticky.
+ * w32fns.c (syms_of_w32fns):
+ * xfns.c (syms_of_xfns): Don't Add `display' since it's there by default.
+
+2011-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c (barf_or_query_if_file_exists): Use S_ISDIR.
+ This is more efficient than Ffile_directory_p and avoids a minor race.
+
+2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * buffer.c (Foverlay_put): Say what the return value is
+ (bug#7835).
+
+ * fileio.c (barf_or_query_if_file_exists): Check first if the file
+ is a directory before asking whether to use the file name
+ (bug#7564).
+ (barf_or_query_if_file_exists): Make the "File is a directory"
+ error be more correct.
+
+ * fns.c (Frequire): Remove the mention of the .gz files, since
+ that's installation-specific, but keep the mention of
+ `get-load-suffixes'.
+
+2011-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * editfns.c (Fformat_time_string): Don't assume strlen fits in int.
+ Report string overflow if the output is too long.
+
+2011-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (Fgnutls_boot): Don't mention :verify-error.
+ (syms_of_gnutls): Remove duplicate DEFSYM for
+ Qgnutls_bootprop_verify_hostname_error, an error for
+ Qgnutls_bootprop_verify_error (which is no longer used).
+
+ * eval.c (find_handler_clause): Remove parameters `sig' and `data',
+ unused since 2011-01-26T20:02:07Z!monnier@iro.umontreal.ca. All callers changed.
+ Also (re)move comments that are misplaced or no longer relevant.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * callint.c (Finteractive): Clarify the meaning of "@" (bug#8813).
+
+2011-07-03 Chong Yidong <cyd@stupidchicken.com>
+
+ * xfaces.c (Finternal_merge_in_global_face): Modify the foreground
+ and background color parameters if they have been changed.
+
+2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * editfns.c (Fformat): Clarify the - and 0 flags (bug#6659).
+
+2011-07-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xsettings.c (SYSTEM_FONT): Define only when used.
+ No need to define when HAVE_GSETTINGS || !HAVE_XFT.
+
+ * keymap.c (access_keymap_1): Now static.
+
+2011-07-02 Chong Yidong <cyd@stupidchicken.com>
+
+ * keyboard.c (command_loop_1): If a down-mouse event is unbound,
+ leave any prefix arg for the up event (Bug#1586).
+
+2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * lread.c (syms_of_lread): Mention single symbols defined by
+ `defvar' or `defconst' (bug#7154).
+
+ * fns.c (Frequire): Mention .el.gz files (bug#7314).
+ (Frequire): Mention get-load-suffixes.
+
+2011-07-02 Martin Rudalics <rudalics@gmx.at>
+
+ * window.h (window): Remove clone_number slot.
+ * window.c (Fwindow_clone_number, Fset_window_clone_number):
+ Remove.
+ (make_parent_window, make_window, saved_window)
+ (Fset_window_configuration, save_window_save): Don't deal with
+ clone numbers.
+ * buffer.c (Qclone_number): Remove declaration.
+ (sort_overlays, overlay_strings): Don't deal with clone numbers.
-2011-07-05 Eli Zaretskii <eliz@gnu.org>
+2011-07-02 Stefan Monnier <monnier@iro.umontreal.ca>
- * dispnew.c (buffer_posn_from_coords): Save and restore the bidi
- cache around display iteration.
+ Add multiple inheritance to keymaps.
+ * keymap.c (Fmake_composed_keymap): New function.
+ (Fset_keymap_parent): Simplify.
+ (fix_submap_inheritance): Remove.
+ (access_keymap_1): New function extracted from access_keymap to handle
+ embedded parents and handle lists of maps.
+ (access_keymap): Use it.
+ (Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap)
+ (Fcopy_keymap): Handle embedded parents.
+ (Fcommand_remapping, define_as_prefix): Simplify.
+ (Fkey_binding): Simplify.
+ (syms_of_keymap): Move minibuffer-local-completion-map,
+ minibuffer-local-filename-completion-map,
+ minibuffer-local-must-match-map, and
+ minibuffer-local-filename-must-match-map to Elisp.
+ (syms_of_keymap): Defsubr make-composed-keymap.
+ * keyboard.c (menu_bar_items): Use map_keymap_canonical.
+ (parse_menu_item): Trivial simplification.
- * window.c (Fwindow_end, window_scroll_pixel_based)
- (displayed_window_lines, Frecenter): Save and restore the bidi
- cache around display iteration.
+2011-07-01 Glenn Morris <rgm@gnu.org>
- * bidi.c (bidi_unshelve_cache): Ensure we have enough space before
- restoring the shelved cache.
- (bidi_cache_ensure_space): Don't assume the required size is just
- one BIDI_CACHE_CHUNK away.
+ * Makefile.in (SETTINGS_LIBS): Fix typo.
- * xdisp.c (back_to_previous_visible_line_start, reseat_1)
- (init_iterator): Empty the bidi cache "stack".
+2011-07-01 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny patch)
-2011-07-03 Eli Zaretskii <eliz@gnu.org>
+ * coding.c (Fencode_coding_string): Record the last coding system
+ used, as the function doc string says (bug#8738).
- * bidi.c (bidi_shelve_cache, bidi_unshelve_cache): New functions.
+2011-07-01 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xsettings.c (store_monospaced_changed): Take new font as arg and
+ check for change against current_mono_font.
+ (EMACS_TYPE_SETTINGS): Remove this and related defines.
+ (emacs_settings_constructor, emacs_settings_get_property)
+ (emacs_settings_set_property, emacs_settings_class_init)
+ (emacs_settings_init, gsettings_obj): Remove.
+ (something_changedCB): New function for HAVE_GSETTINGS.
+ (something_changedCB): HAVE_GCONF: Call store_monospaced_changed
+ with value as argument.
+ (init_gsettings): Check that GSETTINGS_SCHEMA exists before calling
+ g_settings_new (Bug#8967). Do not create gsettings_obj.
+ Remove calls to g_settings_bind. Connect something_changedCB to
+ "changed".
+
+ * xgselect.c: Add defined (HAVE_GSETTINGS).
+ (xgselect_initialize): Ditto.
+
+ * process.c: Add defined (HAVE_GSETTINGS) for xgselect.h
+ (wait_reading_process_output): Add defined (HAVE_GSETTINGS) for
+ xg_select.
+
+2011-07-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * eval.c (struct backtrace): Simplify and port the data structure.
+ Do not assume that "int nargs : BITS_PER_INT - 2;" produces a
+ signed bit field, as this assumption is not portable and it makes
+ Emacs crash when compiled with Sun C 5.8 on sparc. Do not use
+ "char debug_on_exit : 1" as this is not portable either; instead,
+ use the portable "unsigned int debug_on_exit : 1". Remove unused
+ member evalargs. Remove obsolete comments about cc bombing out.
+
+2011-06-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xsettings.c: Include glib-object.h, gio/gio.h if HAVE_GSETTINGS.
+ Let HAVE_GSETTINGS override HAVE_GCONF.
+ (store_monospaced_changed): New function.
+ (EMACS_SETTINGS): A new type derived from GObject to handle
+ GSettings notifications.
+ (emacs_settings_constructor, emacs_settings_get_property)
+ (emacs_settings_set_property, emacs_settings_class_init):
+ New functions.
+ (gsettings_client, gsettings_obj): New variables.
+ (GSETTINGS_SCHEMA): New define.
+ (something_changedCB): Call store_monospaced_changed.
+ (init_gsettings): New function.
+ (xsettings_initialize): Call init_gsettings.
+ (syms_of_xsettings): Initialize gsettings_client, gsettings_obj
+ to NULL.
+
+ * Makefile.in (SETTINGS_CFLAGS, SETTINGS_LIBS): Renamed from
+ GCONF_CFLAGS/LIBS.
+
+2011-06-29 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (resize_root_window, grow_mini_window)
+ (shrink_mini_window): Rename Qresize_root_window to
+ Qwindow_resize_root_window and Qresize_root_window_vertically to
+ Qwindow_resize_root_window_vertically.
+
+2011-06-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gnutls.c (Qgnutls_bootprop_verify_error): Remove unused var.
+
+2011-06-27 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Redesign dependencies so they reflect more
+ clearly which files are directly included by each source file,
+ and not through other includes.
+
+2011-06-27 Martin Rudalics <rudalics@gmx.at>
+
+ * buffer.c (Qclone_number): Declare static and DEFSYM it.
+ (sort_overlays, overlay_strings): When an overlay's clone number
+ matches the window's clone number process the overlay even if
+ the overlay's window property doesn't match the current window.
+
+ * window.c (Fwindow_vchild): Rename to Fwindow_top_child.
+ (Fwindow_hchild): Rename to Fwindow_left_child.
+ (Fwindow_next): Rename to Fwindow_next_sibling.
+ (Fwindow_prev): Rename to Fwindow_prev_sibling.
+ (resize_window_check): Rename to window_resize_check.
+ (resize_window_apply): Rename to window_resize_apply.
+ (Fresize_window_apply): Rename to Fwindow_resize_apply.
+ (Fdelete_other_windows_internal, resize_frame_windows)
+ (Fsplit_window_internal, Fdelete_window_internal)
+ (grow_mini_window, shrink_mini_window)
+ (Fresize_mini_window_internal): Fix callers accordingly.
+
+2011-06-26 Jan Djärv <jan.h.d@swipnet.se>
+
+ * emacsgtkfixed.h: State that this is only used with Gtk+3.
+ (emacs_fixed_set_min_size): Remove.
+ (emacs_fixed_new): Take frame as argument.
+
+ * emacsgtkfixed.c: State that this is only used with Gtk+3.
+ (_EmacsFixedPrivate): Remove minwidth/height.
+ Add struct frame *f.
+ (emacs_fixed_init): Initialize priv->f.
+ (get_parent_class, emacs_fixed_set_min_size): Remove.
+ (emacs_fixed_new): Set priv->f to argument.
+ (emacs_fixed_get_preferred_width)
+ (emacs_fixed_get_preferred_height): Use min_width/height from
+ frames size_hint to set minimum and natural (Bug#8919).
+ (XSetWMSizeHints, XSetWMNormalHints): Override these functions
+ and use min_width/height from frames size_hint to set
+ min_width/height (Bug#8919).
+
+ * gtkutil.c (xg_create_frame_widgets): Pass f to emacs_fixed_new.
+ (x_wm_set_size_hint): Remove call to emacs_fixed_set_min_size.
+ Fix indentation.
+
+2011-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (bidi_paragraph_init): Test for ZV_BYTE before calling
+ bidi_at_paragraph_end, since fast_looking_at doesn't like to be
+ called at ZV.
+
+2011-06-26 Chong Yidong <cyd@stupidchicken.com>
+
+ * process.c (wait_reading_process_output): Bypass select if
+ waiting for a cell while ignoring keyboard input, and input is
+ pending. Suggested by Jan Djärv (Bug#8869).
+
+2011-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use gnulib's dup2 module instead of rolling our own.
+ * sysdep.c (dup2) [!HAVE_DUP2]: Remove; gnulib now does this.
+
+2011-06-25 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * dispnew.c (scrolling_window): Before scrolling, turn off a
+ mouse-highlight in the window being scrolled.
+
+2011-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ Move DEFSYM to lisp.h and use everywhere.
+
+ * character.h (DEFSYM): Move declaration...
+ * lisp.h (DEFSYM): ...here.
+
+ * gnutls.c:
+ * minibuf.c:
+ * w32menu.c:
+ * w32proc.c:
+ * w32select.c: Don't include character.h.
+
+ * alloc.c (syms_of_alloc):
+ * buffer.c (syms_of_buffer):
+ * bytecode.c (syms_of_bytecode):
+ * callint.c (syms_of_callint):
+ * casefiddle.c (syms_of_casefiddle):
+ * casetab.c (init_casetab_once):
+ * category.c (init_category_once, syms_of_category):
+ * ccl.c (syms_of_ccl):
+ * cmds.c (syms_of_cmds):
+ * composite.c (syms_of_composite):
+ * dbusbind.c (syms_of_dbusbind):
+ * dired.c (syms_of_dired):
+ * dispnew.c (syms_of_display):
+ * doc.c (syms_of_doc):
+ * editfns.c (syms_of_editfns):
+ * emacs.c (syms_of_emacs):
+ * eval.c (syms_of_eval):
+ * fileio.c (syms_of_fileio):
+ * fns.c (syms_of_fns):
+ * frame.c (syms_of_frame):
+ * fringe.c (syms_of_fringe):
+ * insdel.c (syms_of_insdel):
+ * keymap.c (syms_of_keymap):
+ * lread.c (init_obarray, syms_of_lread):
+ * macros.c (syms_of_macros):
+ * msdos.c (syms_of_msdos):
+ * print.c (syms_of_print):
+ * process.c (syms_of_process):
+ * search.c (syms_of_search):
+ * sound.c (syms_of_sound):
+ * syntax.c (init_syntax_once, syms_of_syntax):
+ * terminal.c (syms_of_terminal):
+ * textprop.c (syms_of_textprop):
+ * undo.c (syms_of_undo):
+ * w32.c (globals_of_w32):
+ * window.c (syms_of_window):
+ * xdisp.c (syms_of_xdisp):
+ * xfaces.c (syms_of_xfaces):
+ * xfns.c (syms_of_xfns):
+ * xmenu.c (syms_of_xmenu):
+ * xsettings.c (syms_of_xsettings):
+ * xterm.c (syms_of_xterm): Use DEFSYM.
+
+2011-06-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnutls.c (syms_of_gnutls): Use the DEFSYM macro from character.h.
+
+2011-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Integer and buffer overflow fixes (Bug#8873).
+
+ * print.c (printchar, strout): Check for string overflow.
+ (PRINTPREPARE, printchar, strout):
+ Don't set size unless allocation succeeds.
+
+ * minibuf.c (read_minibuf_noninteractive): Use ptrdiff_t, not int,
+ for sizes. Check for string overflow more accurately.
+ Simplify newline removal at end; this suppresses a GCC 4.6.0 warning.
+
+ * macros.c: Integer and buffer overflow fixes.
+ * keyboard.h (struct keyboard.kbd_macro_bufsize):
+ * macros.c (Fstart_kbd_macro, store_kbd_macro_char):
+ Use ptrdiff_t, not int, for sizes.
+ Don't increment bufsize until after realloc succeeds.
+ Check for size-calculation overflow.
+ (Fstart_kbd_macro): Use EMACS_INT, not int, for XINT result.
+
+ * lisp.h (DEFVAR_KBOARD): Use offsetof instead of char * finagling.
+
+ * lread.c: Integer overflow fixes.
+ (read_integer): Radix is now EMACS_INT, not int,
+ to improve quality of diagnostics for out-of-range radices.
+ Calculate buffer size correctly for out-of-range radices.
+ (read1): Check for integer overflow in radices, and in
+ read-circle numbers.
+ (read_escape): Avoid int overflow.
+ (Fload, openp, read_buffer_size, read1)
+ (substitute_object_recurse, read_vector, read_list, map_obarray):
+ Use ptrdiff_t, not int, for sizes.
+ (read1): Use EMACS_INT, not int, for sizes.
+ Check for size overflow.
+
+ * image.c (cache_image): Check for size arithmetic overflow.
+
+ * lread.c: Integer overflow issues.
+ (saved_doc_string_size, saved_doc_string_length)
+ (prev_saved_doc_string_size, prev_saved_doc_string_length):
+ Now ptrdiff_t, not int.
+ (read1): Don't assume doc string length fits in int. Check for
+ out-of-range doc string lengths.
+ (read_list): Don't assume file position fits in int.
+ (read_escape): Check for hex character overflow.
+
+2011-06-22 Leo Liu <sdl.web@gmail.com>
+
+ * minibuf.c (Fcompleting_read_default, Vcompleting_read_function):
+ Move to minibuffer.el.
+
+2011-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fixes for GLYPH_DEBUG found by GCC 4.6.0 static checking.
+ The following patches are for when GLYPH_DEBUG && !XASSERT.
+ * dispextern.h (trace_redisplay_p, dump_glyph_string):
+ * dispnew.c (flush_stdout):
+ * xdisp.c (dump_glyph_row, dump_glyph_matrix, dump_glyph):
+ Mark as externally visible.
+ * dispnew.c (check_window_matrix_pointers): Now static.
+ * dispnew.c (window_to_frame_vpos):
+ * xfns.c (unwind_create_frame):
+ * xterm.c (x_check_font): Remove unused local.
+ * scroll.c (CHECK_BOUNDS):
+ * xfaces.c (cache_fache): Rename local to avoid shadowing.
+ * xfns.c, w32fns.c (image_cache_refcount, dpyinfo_refcount): Now static.
+ * xdisp.c (check_window_end): Now a no-op if !XASSERTS.
+ (debug_first_unchanged_at_end_vpos, debug_last_unchanged_at_beg_vpos)
+ (debug_dvpos, debug_dy, debug_delta, debug_delta_bytes, debug_end_vpos):
+ Now static.
+ (debug_method_add): Use va_list and vsprintf rather than relying
+ on undefined behavior with wrong number of arguments.
+ (dump_glyph, dump_glyph_row, Fdump_glyph_matrix):
+ Don't assume ptrdiff_t and EMACS_INT are the same width as int.
+ In this code, it's OK to assume C99 behavior for ptrdiff_t formats
+ since we're not interested in debugging glyphs with old libraries.
+ * xfaces.c (cache_face): Move debugging code earlier; this pacifies
+ GCC 4.6.0's static checking.
+
+2011-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Integer overflow and signedness fixes (Bug#8873).
+ A few related buffer overrun fixes, too.
+
+ * font.c (font_score): Use EMACS_INT, not int, to store XINT value.
+
+ * dispextern.h (struct face.stipple):
+ * image.c (x_bitmap_height, x_bitmap_width, x_bitmap_pixmap)
+ (x_bitmap_mask, x_allocate_bitmap_record)
+ (x_create_bitmap_from_data, x_create_bitmap_from_file)
+ (x_destroy_bitmap, x_destroy_all_bitmaps, x_create_bitmap_mask)
+ (x_create_bitmap_from_xpm_data):
+ * nsterm.h (struct ns_display_info.bitmaps_size, .bitmaps_last):
+ * w32term.h (struct w32_display_info.icon_bitmap_id, .bitmaps_size)
+ (.bitmaps_last):
+ * xfaces.c (load_pixmap):
+ * xterm.c (x_bitmap_icon, x_wm_set_icon_pixmap):
+ * xterm.h (struct x_display_info.icon_bitmap_id, .bitmaps_size)
+ (.bitmaps_last, struct x_output.icon_bitmap):
+ Use ptrdiff_t, not int, for bitmap indexes.
+ (x_allocate_bitmap_record): Check for size overflow.
+ * dispextern.h, lisp.h: Adjust to API changes elsewhere.
+
+ Use ptrdiff_t, not int, for overlay counts.
+ * buffer.h (overlays_at, sort_overlays, GET_OVERLAYS_AT):
+ * editfns.c (overlays_around, get_pos_property):
+ * textprop.c (get_char_property_and_overlay):
+ * xdisp.c (next_overlay_change, note_mouse_highlight):
+ * xfaces.c (face_at_buffer_position):
+ * buffer.c (OVERLAY_COUNT_MAX): New macro.
+ (overlays_at, overlays_in, sort_overlays, Foverlays_at)
+ (Fnext_overlay_change, Fprevious_overlay_change)
+ (mouse_face_overlay_overlaps, Foverlays_in):
+ Use ptrdiff_t, not int, for sizes.
+ (overlays_at, overlays_in): Check for size-calculation overflow.
+
+ * xterm.c (xim_initialize, same_x_server): Strlen may not fit in int.
+
+ * xsmfns.c (smc_save_yourself_CB, x_session_initialize): Avoid strlen.
+ (x_session_initialize): Do not assume string length fits in int.
+
+ * xsettings.c (apply_xft_settings): Fix potential buffer overrun.
+ This is unlikely, but can occur if DPI is outlandish.
+
+ * xsettings.c (Ffont_get_system_normal_font, Ffont_get_system_font):
+ * xselect.c (Fx_get_atom_name): Avoid need for strlen.
+
+ * xrdb.c: Don't assume strlen fits in int; avoid some strlens.
+ * xrdb.c (magic_file_p, search_magic_path):
+ Omit last arg SUFFIX; it was always 0. All callers changed.
+ (magic_file_p): Use ptrdiff_t, not int. Check for size overflow.
+
+ * xfont.c (xfont_match): Avoid need for strlen.
+
+ * xfns.c: Don't assume strlen fits in int.
+ (xic_create_fontsetname, x_window): Use ptrdiff_t, not int.
+
+ * xdisp.c (message_log_check_duplicate): Return intmax_t,
+ not unsigned long, as we prefer signed integers. All callers changed.
+ Detect integer overflow in repeat count.
+ (message_dolog): Don't assume print length fits in 39 bytes.
+ (display_mode_element): Don't assume strlen fits in int.
+
+ * termcap.c: Don't assume sizes fit in int and never overflow.
+ (struct termcap_buffer, tgetent): Use ptrdiff_t, not int, for sizes.
+ (gobble_line): Check for size-calculation overflow.
+
+ * minibuf.c (Fread_buffer):
+ * lread.c (intern, intern_c_string):
+ * image.c (xpm_scan) [HAVE_NS && !HAVE_XPM]:
+ Don't assume string length fits in int.
- * dispextern.h (bidi_shelve_cache, bidi_unshelve_cache): Declare
- prototypes.
+ * keyboard.c (parse_tool_bar_item):
+ * gtkutil.c (style_changed_cb): Avoid need for strlen.
+
+ * font.c: Don't assume string length fits in int.
+ (font_parse_xlfd, font_parse_fcname, font_unparse_fcname):
+ Use ptrdiff_t, not int.
+ (font_intern_prop): Don't assume string length fits in int.
+ Don't assume integer property fits in fixnum.
+ * font.h (font_intern_prop): 2nd arg is now ptrdiff_t, not int.
+
+ * filelock.c: Fix some buffer overrun and integer overflow issues.
+ (get_boot_time): Don't assume gzip command string fits in 100 bytes.
+ Reformulate so as not to need the command string.
+ Invoke gzip -cd rather than gunzip, as it's more portable.
+ (lock_info_type, lock_file_1, lock_file):
+ Don't assume pid_t and time_t fit in unsigned long.
+ (LOCK_PID_MAX): Remove; we now use more-reliable bounds.
+ (current_lock_owner): Prefer signed type for sizes.
+ Use memcpy, not strncpy, where memcpy is what is really wanted.
+ Don't assume (via atoi) that time_t and pid_t fit in int.
+ Check for time_t and/or pid_t out of range, e.g., via a network share.
+ Don't alloca where an auto var works fine.
+
+ * fileio.c: Fix some integer overflow issues.
+ (file_name_as_directory, Fexpand_file_name, Fsubstitute_in_file_name):
+ Don't assume string length fits in int.
+ (directory_file_name): Don't assume string length fits in long.
+ (make_temp_name): Don't assume pid fits in int, or that its print
+ length is less than 20.
- * xdisp.c (SAVE_IT, RESTORE_IT): New macros.
- (pos_visible_p, face_before_or_after_it_pos)
- (back_to_previous_visible_line_start)
- (move_it_in_display_line_to, move_it_in_display_line)
- (move_it_to, move_it_vertically_backward, move_it_by_lines)
- (try_scrolling, redisplay_window, display_line): Use them when
- saving a temporary copy of the iterator and restoring it back.
+ * data.c (Fsubr_name): Rewrite to avoid a strlen call.
-2011-07-02 Eli Zaretskii <eliz@gnu.org>
+ * coding.c (make_subsidiaries): Don't assume string length fits in int.
- * xdisp.c (reseat_1): Call bidi_init_it to resync the bidi
- iterator with IT's position. (Bug#7616)
- (handle_stop, back_to_previous_visible_line_start, reseat_1):
- Reset the from_disp_prop_p flag.
+ * callproc.c (child_setup): Rewrite to avoid two strlen calls.
- * bidi.c (bidi_cache_search): Don't assume bidi_cache_last_idx is
- always valid if bidi_cache_idx is valid.
- (bidi_cache_find_level_change): xassert that bidi_cache_last_idx
- is valid if it's going to be used.
+ * process.c (Fformat_network_address): Use EMACS_INT, not EMACS_UINT.
+ We prefer signed integers, even for size calculations.
- * dispextern.h (struct iterator_stack_entry, struct it): New
- member from_disp_prop_p.
+ * emacs.c: Don't assume string length fits in 'int'.
+ (DEFINE_DUMMY_FUNCTION, sort_args): Use ptrdiff_t, not int.
+ (main): Don't invoke strlen when not needed.
- * xdisp.c (push_it, pop_it): Save and restore from_disp_prop_p.
- (handle_single_display_spec, push_display_prop): Set the
- from_disp_prop_p flag.
- (get_overlay_strings_1): Reset the from_disp_prop_p flag.
- (pop_it): Call iterate_out_of_display_property only if we are
- popping after iteration over a string that came from a display
- property. Fix a typo in popping stretch info. Add an assertion
- for verifying that the iterator position is in sync with the bidi
- iterator.
- (handle_single_display_spec, get_overlay_strings_1)
- (push_display_prop): Fix initialization of paragraph direction for
- string when that of the parent object is not yet determined.
+ * dbusbind.c (XD_ERROR): Don't arbitrarily truncate string.
+ (XD_DEBUG_MESSAGE): Don't waste a byte.
-2011-07-01 Eli Zaretskii <eliz@gnu.org>
+ * callproc.c (getenv_internal_1, getenv_internal)
+ (Fgetenv_internal):
+ * buffer.c (init_buffer): Don't assume string length fits in 'int'.
- * dispextern.h (struct bidi_string_data): New member `unibyte'.
+ * lread.c (invalid_syntax): Omit length argument.
+ All uses changed. This doesn't fix a bug, but it simplifies the
+ code away from its former Hollerith-constant appearance, and it's
+ one less 'int' to worry about when looking at integer-overflow issues.
+ (string_to_number): Simplify 2011-04-26 change by invoking xsignal1.
- * xdisp.c (handle_single_display_spec, next_overlay_string)
- (get_overlay_strings_1, reseat_1, reseat_to_string)
- (push_display_prop): Set up the `unibyte' member of bidi_it.string
- correctly. Don't assume unibyte strings are not bidi-reordered.
- (compute_display_string_pos)
- (compute_display_string_end): Fix handling the case of C string.
+ * lisp.h (DEFUN): Remove bogus use of sizeof (struct Lisp_Subr).
+ This didn't break anything, but it didn't help either.
+ It's confusing to put a bogus integer in a place where the actual
+ value does not matter.
+ (LIST_END_P): Remove unused macro and its bogus comment.
+ (make_fixnum_or_float): Remove unnecessary cast to EMACS_INT.
- * bidi.c (bidi_count_bytes, bidi_char_at_pos): Accept an
- additional argument UNIBYTE, and support unibyte strings. All
- callers changed.
- (bidi_fetch_char): Support unibyte strings.
+ * lisp.h (union Lisp_Object.i): EMACS_INT, not EMACS_UINT.
+ This is for consistency with the ordinary, non-USE_LISP_UNION_TYPE,
+ implementation.
+ (struct Lisp_Bool_Vector.size): EMACS_INT, not EMACS_UINT.
+ We prefer signed types, and the value cannot exceed the EMACS_INT
+ range anyway (because otherwise the length would not be representable).
+ (XSET) [USE_LISP_UNION_TYPE]: Use uintptr_t and intptr_t,
+ not EMACS_UINT and EMACS_INT, when converting pointer to integer.
+ This avoids a GCC warning when WIDE_EMACS_INT.
-2011-06-25 Eli Zaretskii <eliz@gnu.org>
+ * indent.c (sane_tab_width): New function.
+ (current_column, scan_for_column, Findent_to, position_indentation)
+ (compute_motion): Use it. This is just for clarity.
+ (Fcompute_motion): Don't assume hscroll and tab offset fit in int.
- * xdisp.c (set_iterator_to_next, get_visually_first_element): Use
- it->bidi_it.string.schars rather than it->string_nchars when
- testing whether we're beyond string end, because string_nchars is
- zero for strings that come from overlays and display properties.
+ * image.c (xbm_image_p): Don't assume stated width, height fit in int.
- * bidi.c (bidi_cache_iterator_state): Fix a bug with testing
- character positions against the cached range, when we use a
- stacked cache.
+ * lisp.h (lint_assume): New macro.
+ * composite.c (composition_gstring_put_cache):
+ * ftfont.c (ftfont_shape_by_flt): Use it to pacify GCC 4.6.0.
- * xdisp.c (push_it, pop_it): Save and restore it.
+ * editfns.c, insdel.c:
+ Omit unnecessary forward decls, to simplify future changes.
- * dispextern.h (struct iterator_stack_entry): New member
- paragraph_embedding.
+ * ftfont.c (ftfont_shape_by_flt): Use signed integers for lengths.
- * xdisp.c (handle_single_display_spec, next_overlay_string)
- (get_overlay_strings_1, push_display_prop): Set up the bidi
- iterator for displaying display or overlay strings.
- (forward_to_next_line_start): Don't use the shortcut if
- bidi-iterating.
- (back_to_previous_visible_line_start): If handle_display_prop
- pushed the iterator stack, restore the internal state of the bidi
- iterator by calling bidi_pop_it same number of times.
- (reseat_at_next_visible_line_start): If ON_NEWLINE_P is non-zero,
- and we are bidi-iterating, don't decrement the iterator position;
- instead, set the first_elt flag in the bidi iterator, to produce
- the same effect.
- (reseat_1): Remove redundant setting of string_from_display_prop_p.
- (push_display_prop): xassert that we are iterating a buffer.
+ * font.c (Ffont_shape_gstring): Don't assume glyph len fits in 'int'.
- * bidi.c (bidi_cache_start_stack, bidi_push_it): Use IT_STACK_SIZE.
+ * fns.c (Ffillarray): Don't assume bool vector size fits in 'int'.
+ Use much-faster test for byte-length change.
+ Don't assume string byte-length fits in 'int'.
+ Check that character arg fits in 'int'.
+ (mapcar1): Declare byte as byte, for clarity.
-2011-06-24 Eli Zaretskii <eliz@gnu.org>
+ * alloc.c (Fmake_bool_vector): Avoid unnecessary multiplication.
- * xdisp.c (push_it, pop_it): Save and restore the state of the
- bidi iterator. Save and restore the bidi_p flag.
- (pop_it): Iterate out of display property for string iteration as
- well.
- (iterate_out_of_display_property): Support iteration over strings.
- (handle_single_display_spec): Set up it->bidi_it for iteration
- over a display string, and call bidi_init_it.
+ * fns.c (concat): Catch string overflow earlier.
+ Do not rely on integer wraparound.
- * dispextern.h (struct iterator_stack_entry): New member bidi_p.
- (struct it): Member bidi_p is now a bit field 1 bit wide.
+ * dispextern.h (struct it.overlay_strings_charpos)
+ (struct it.selective): Now EMACS_INT, not int.
+ * xdisp.c (forward_to_next_line_start)
+ (back_to_previous_visible_line_start)
+ (reseat_at_next_visible_line_start, next_element_from_buffer):
+ Don't arbitrarily truncate the value of 'selective' to int.
-2011-06-23 Eli Zaretskii <eliz@gnu.org>
+ * xdisp.c (init_iterator): Use XINT, not XFASTINT; it might be < 0.
- * dispextern.h (bidi_push_it, bidi_pop_it): Add prototypes.
+ * composite.c: Don't truncate sizes to 'int'.
+ (composition_gstring_p, composition_reseat_it)
+ (composition_adjust_point): Use EMACS_INT, not int.
+ (get_composition_id, composition_gstring_put_cache): Use EMACS_INT,
+ not EMACS_UINT, for indexes.
- * bidi.c (bidi_push_it, bidi_pop_it): New functions.
- (bidi_initialize): Initialize the bidi cache start stack pointer.
- (bidi_cache_ensure_space): New function, refactored from part of
- bidi_cache_iterator_state.
+ * category.h (CATEGORY_SET_P): Remove unnecessary cast to EMACS_INT.
-2011-06-18 Eli Zaretskii <eliz@gnu.org>
+ * buffer.c: Include <verify.h>.
+ (struct sortvec.priority, struct sortstr.priority):
+ Now EMACS_INT, not int.
+ (compare_overlays, cmp_for_strings): Avoid subtraction overflow.
+ (struct sortstr.size, record_overlay_string)
+ (struct sortstrlist.size, struct sortlist.used):
+ Don't truncate size to int.
+ (record_overlay_string): Check for size-calculation overflow.
+ (init_buffer_once): Check at compile-time, not run-time.
- * xdisp.c (tool_bar_lines_needed, redisplay_tool_bar)
- (display_menu_bar): Force left-to-right direction. Add a FIXME
- comment for making that be controlled by a user option.
+2011-06-22 Jim Meyering <meyering@redhat.com>
- * bidi.c (bidi_move_to_visually_next): GCPRO the Lisp string we
- are iterating.
+ Don't leak an XBM-image-sized buffer
+ * image.c (xbm_load): Free the image buffer after using it.
- * term.c (produce_glyphs): Add IT_GLYPHLESS to the values of
- it->what accepted by the xassert. Fixes a gratuitous crash in an
- Emacs built with -DXASSERTS.
+2011-06-21 Paul Eggert <eggert@cs.ucla.edu>
- * .gdbinit (xvectype, xvector, xcompiled, xchartable, xboolvector)
- (xpr, xfont, xbacktrace): Use "header.size" when accessing vectors
- and vector-like objects.
+ Port to Sun C.
+ * composite.c (find_automatic_composition): Omit needless 'return 0;'
+ that Sun C diagnosed.
+ * fns.c (secure_hash): Fix pointer signedness issue.
+ * intervals.c (static_offset_intervals): New function.
+ (offset_intervals): Use it.
- * xdisp.c (face_before_or_after_it_pos): Support bidi iteration.
- (next_element_from_c_string): Handle the case of the first string
- character that is not the first one in the visual order.
- (get_visually_first_element): New function, refactored from common
- parts of next_element_from_buffer, next_element_from_string, and
- next_element_from_c_string.
+2011-06-21 Leo Liu <sdl.web@gmail.com>
-2011-06-16 Eli Zaretskii <eliz@gnu.org>
+ * deps.mk (fns.o):
+ * makefile.w32-in ($(BLD)/fns.$(O)): Include sha256.h and
+ sha512.h.
- * xdisp.c (init_iterator): Don't initialize it->bidi_p for strings
- here.
- (reseat_to_string): Initialize it->bidi_p for strings here.
- (next_element_from_string, next_element_from_c_string)
- (next_element_from_buffer): Add xassert's for correspondence
- between IT's object being iterated and it->bidi_it.string
- structure.
+ * fns.c (secure_hash): Rename from crypto_hash_function and change
+ the first arg to accept symbols.
+ (Fsecure_hash): New primitive.
+ (syms_of_fns): New symbols.
- * bidi.c (bidi_level_of_next_char): Fix the logic for looking up
- the sentinel state in the cache.
+2011-06-20 Deniz Dogan <deniz@dogan.se>
-2011-06-13 Eli Zaretskii <eliz@gnu.org>
+ * process.c (Fset_process_buffer): Clarify return value in
+ docstring.
- * xdisp.c (compute_display_string_pos)
- (compute_display_string_end, reseat_to_string): Don't assume
- it->bidi_it.string.s always points to string.lstring's data.
+2011-06-18 Chong Yidong <cyd@stupidchicken.com>
- * bidi.c (bidi_fetch_char, bidi_paragraph_init)
- (bidi_resolve_explicit_1, bidi_resolve_explicit)
- (bidi_resolve_weak, bidi_level_of_next_char): Don't assume
- string.s always points to string.lstring's data.
+ * dispnew.c (add_window_display_history): Use BVAR.
-2011-06-11 Eli Zaretskii <eliz@gnu.org>
+ * xdisp.c (debug_method_add): Use BVAR.
+ (check_window_end, dump_glyph_matrix, dump_glyph)
+ (dump_glyph_row, dump_glyph_string): Convert arglist to ANSI C.
- * xdisp.c (set_iterator_to_next): Advance string position
- correctly when padding it with blanks.
+ * xfaces.c (check_lface_attrs, check_lface, dump_realized_face):
+ Likewise.
-2011-06-11 Eli Zaretskii <eliz@gnu.org>
+ * xfns.c (Fx_create_frame, x_create_tip_frame): Delay image cache
+ check till after the cache is created in init_frame_faces.
+
+2011-06-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * fns.c (Fsafe_length): Yet another int/Lisp_Object mixup.
+
+2011-06-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h: Include <limits.h>, for INT_MAX, LONG_MAX, LLONG_MAX.
+ Without this, prin1 mishandles Lisp_Misc_Save_Value printing on
+ hosts with pre-C99 libraries, because pD is wrongly defined to "t".
+
+ Improve buffer-overflow checking (Bug#8873).
+ * fileio.c (Finsert_file_contents):
+ * insdel.c (insert_from_buffer_1, replace_range, replace_range_2):
+ Remove the old (too-loose) buffer overflow checks.
+ They weren't needed, since make_gap checks for buffer overflow.
+ * insdel.c (make_gap_larger): Catch buffer overflows that were missed.
+ The old code merely checked for Emacs fixnum overflow, and relied
+ on undefined (wraparound) behavior. The new code avoids undefined
+ behavior, and also checks for ptrdiff_t and/or size_t overflow.
+
+ * editfns.c (Finsert_char): Don't dump core with very negative counts.
+ Tune. Don't use wider integers than needed. Don't use alloca.
+ Use a bigger 'string' buffer. Rewrite to avoid 'n > 0' test.
+
+ * insdel.c (replace_range): Fix buf overflow when insbytes < outgoing.
+
+ * insdel.c, lisp.h (buffer_overflow): New function.
+ (insert_from_buffer_1, replace_range, replace_range_2):
+ * insdel.c (make_gap_larger):
+ * editfns.c (Finsert_char):
+ * fileio.c (Finsert_file_contents): Use it, to normalize wording.
+
+ * buffer.h (BUF_BYTES_MAX): Cast to ptrdiff_t so that it's signed.
+
+2011-06-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Integer overflow and signedness fixes (Bug#8873).
+
+ * ccl.c (ASCENDING_ORDER): New macro, to work around GCC bug 43772.
+ (GET_CCL_RANGE, IN_INT_RANGE): Use it.
+
+ * fileio.c: Don't assume EMACS_INT fits in off_t.
+ (emacs_lseek): New static function.
+ (Finsert_file_contents, Fwrite_region): Use it.
+ Use SEEK_SET, SEEK_CUR, SEEK_END as appropriate.
+
+ * fns.c (Fload_average): Don't assume 100 * load average fits in int.
+
+ * fns.c: Don't overflow int when computing a list length.
+ * fns.c (QUIT_COUNT_HEURISTIC): New constant.
+ (Flength, Fsafe_length): Use EMACS_INT, not int, to avoid unwanted
+ truncation on 64-bit hosts. Check for QUIT every
+ QUIT_COUNT_HEURISTIC entries rather than every other entry; that's
+ faster and is responsive enough.
+ (Flength): Report an error instead of overflowing an integer.
+ (Fsafe_length): Return a float if the value is not representable
+ as a fixnum. This shouldn't happen except in contrived situations.
+ (Fnthcdr, Fsort): Don't assume list length fits in int.
+ (Fcopy_sequence): Don't assume vector length fits in int.
+
+ * alloc.c: Check that resized vectors' lengths fit in fixnums.
+ (header_size, word_size): New constants.
+ (allocate_vectorlike): Don't check size overflow here.
+ (allocate_vector): Check it here instead, since this is the only
+ caller of allocate_vectorlike that could cause overflow.
+ Check that the new vector's length is representable as a fixnum.
+
+ * fns.c (next_almost_prime): Don't return a multiple of 3 or 5.
+ The previous code was bogus. For example, next_almost_prime (32)
+ returned 39, which is undesirable as it is a multiple of 3; and
+ next_almost_prime (24) returned 25, which is a multiple of 5 so
+ why was the code bothering to check for multiples of 7?
+
+ * bytecode.c (exec_byte_code): Use ptrdiff_t, not int, for vector length.
+
+ * eval.c, doprnt.c (SIZE_MAX): Remove; inttypes.h defines this now.
+
+ Variadic C functions now count arguments with ptrdiff_t.
+ This partly undoes my 2011-03-30 change, which replaced int with size_t.
+ Back then I didn't know that the Emacs coding style prefers signed int.
+ Also, in the meantime I found a few more instances where arguments
+ were being counted with int, which may truncate counts on 64-bit
+ machines, or EMACS_INT, which may be unnecessarily wide.
+ * lisp.h (struct Lisp_Subr.function.aMANY)
+ (DEFUN_ARGS_MANY, internal_condition_case_n, safe_call):
+ Arg counts are now ptrdiff_t, not size_t.
+ All variadic functions and their callers changed accordingly.
+ (struct gcpro.nvars): Now size_t, not size_t. All uses changed.
+ * bytecode.c (exec_byte_code): Check maxdepth for overflow,
+ to avoid potential buffer overrun. Don't assume arg counts fit in 'int'.
+ * callint.c (Fcall_interactively): Check arg count for overflow,
+ to avoid potential buffer overrun. Use signed char, not 'int',
+ for 'varies' array, so that we needn't bother to check its size
+ calculation for overflow.
+ * editfns.c (Fformat): Use ptrdiff_t, not EMACS_INT, to count args.
+ * eval.c (apply_lambda):
+ * fns.c (Fmapconcat): Use XFASTINT, not XINT, to get args length.
+ (struct textprop_rec.argnum): Now ptrdiff_t, not int. All uses changed.
+ (mapconcat): Use ptrdiff_t, not int and EMACS_INT, to count args.
+
+ * callint.c (Fcall_interactively): Don't use index var as event count.
+
+ * vm-limit.c (check_memory_limits): Fix incorrect extern function decls.
+ * mem-limits.h (SIZE): Remove; no longer used.
+
+ * xterm.c (x_alloc_nearest_color_1): Prefer int to long when int works.
+
+ Remove unnecessary casts.
+ * xterm.c (x_term_init):
+ * xfns.c (x_set_border_pixel):
+ * widget.c (create_frame_gcs): Remove casts to unsigned long etc.
+ These aren't needed now that we assume ANSI C.
+
+ * sound.c (Fplay_sound_internal): Remove cast to unsigned long.
+ It's more likely to cause problems (due to unsigned overflow)
+ than to cure them.
+
+ * dired.c (Ffile_attributes): Don't use 32-bit hack on 64-bit hosts.
+
+ * unexelf.c (unexec): Don't assume BSS addr fits in unsigned.
+
+ * xterm.c (handle_one_xevent): Omit unnecessary casts to unsigned.
+
+ * keyboard.c (modify_event_symbol): Don't limit alist len to UINT_MAX.
+
+ * lisp.h (CHAR_TABLE_SET): Omit now-redundant test.
+
+ * lread.c (Fload): Don't compare a possibly-garbage time_t value.
+
+ GLYPH_CODE_FACE returns EMACS_INT, not int.
+ * dispextern.h (merge_faces):
+ * xfaces.c (merge_faces):
+ * xdisp.c (get_next_display_element, next_element_from_display_vector):
+ Don't assume EMACS_INT fits in int.
+
+ * character.h (CHAR_VALID_P): Remove unused parameter.
+ * fontset.c, lisp.h, xdisp.c: All uses changed.
+
+ * editfns.c (Ftranslate_region_internal): Omit redundant test.
+
+ * fns.c (concat): Minor tuning based on overflow analysis.
+ This doesn't fix any bugs. Use int to hold character, instead
+ of constantly refetching from Emacs object. Use XFASTINT, not
+ XINT, for value known to be a character. Don't bother comparing
+ a single byte to 0400, as it's always less.
+
+ * floatfns.c (Fexpt):
+ * fileio.c (make_temp_name): Omit unnecessary cast to unsigned.
+
+ * editfns.c (Ftranslate_region_internal): Use int, not EMACS_INT
+ for characters.
+
+ * doc.c (get_doc_string): Omit (unsigned)c that mishandled negatives.
+
+ * data.c (Faset): If ARRAY is a string, check that NEWELT is a char.
+ Without this fix, on a 64-bit host (aset S 0 4294967386) would
+ incorrectly succeed when S was a string, because 4294967386 was
+ truncated before it was used.
+
+ * chartab.c (Fchar_table_range): Use CHARACTERP to check range.
+ Otherwise, an out-of-range integer could cause undefined behavior
+ on a 64-bit host.
+
+ * composite.c: Use int, not EMACS_INT, for characters.
+ (fill_gstring_body, composition_compute_stop_pos): Use int, not
+ EMACS_INT, for values that are known to be in character range.
+ This doesn't fix any bugs but is the usual style inside Emacs and
+ may generate better code on 32-bit machines.
+
+ Make sure a 64-bit char is never passed to ENCODE_CHAR.
+ This is for reasons similar to the recent CHAR_STRING fix.
+ * charset.c (Fencode_char): Check that character arg is actually
+ a character. Pass an int to ENCODE_CHAR.
+ * charset.h (ENCODE_CHAR): Verify that the character argument is no
+ wider than 'int', as a compile-time check to prevent future regressions
+ in this area.
+
+ * character.c (char_string): Remove unnecessary casts.
+
+ Make sure a 64-bit char is never passed to CHAR_STRING.
+ Otherwise, CHAR_STRING would do the wrong thing on a 64-bit platform,
+ by silently ignoring the top 32 bits, allowing some values
+ that were far too large to be valid characters.
+ * character.h: Include <verify.h>.
+ (CHAR_STRING, CHAR_STRING_ADVANCE): Verify that the character
+ arguments are no wider than unsigned, as a compile-time check
+ to prevent future regressions in this area.
+ * data.c (Faset):
+ * editfns.c (Fchar_to_string, general_insert_function, Finsert_char)
+ (Fsubst_char_in_region):
+ * fns.c (concat):
+ * xdisp.c (decode_mode_spec_coding):
+ Adjust to CHAR_STRING's new requirement.
+ * editfns.c (Finsert_char, Fsubst_char_in_region):
+ * fns.c (concat): Check that character args are actually
+ characters. Without this test, these functions did the wrong
+ thing with wildly out-of-range values on 64-bit hosts.
- * xdisp.c (next_element_from_buffer): Improve commentary for when
- the iterator is before prev_stop.
- (init_iterator): Initialize bidi_p from the default value of
- bidi-display-reordering, not from buffer-local value. Use the
- buffer-local value only if initializing for buffer iteration.
- (handle_invisible_prop): Support invisible properties on strings
- that are being bidi-reordered.
- (reseat_to_string): Enable bidi-related code.
- (set_iterator_to_next): Support bidi reordering of C strings and
- Lisp strings.
- (next_element_from_string): Support bidi reordering of Lisp
- strings.
- (handle_stop_backwards): Support Lisp strings as well.
- (display_mode_line, display_mode_element): Temporarily force L2R
- paragraph direction.
- (display_string): Support display of R2L glyph rows. Use
- IT_STRING_CHARPOS when displaying from a Lisp string.
+ Remove incorrect casts to 'unsigned' that lose info on 64-bit hosts.
+ These casts should not be needed on 32-bit hosts, either.
+ * keyboard.c (read_char):
+ * lread.c (Fload): Remove casts to unsigned.
+
+ * lisp.h (UNSIGNED_CMP): New macro.
+ This fixes comparison bugs on 64-bit hosts.
+ (ASCII_CHAR_P): Use it.
+ * casefiddle.c (casify_object):
+ * character.h (ASCII_BYTE_P, CHAR_VALID_P)
+ (SINGLE_BYTE_CHAR_P, CHAR_STRING):
+ * composite.h (COMPOSITION_ENCODE_RULE_VALID):
+ * dispextern.h (FACE_FROM_ID):
+ * keyboard.c (read_char): Use UNSIGNED_CMP.
+
+ * xmenu.c (dialog_selection_callback) [!USE_GTK]: Cast to intptr_t,
+ not to EMACS_INT, to avoid GCC warning.
+
+ * xfns.c (x_set_scroll_bar_default_width): Remove unused 'int' locals.
+
+ * buffer.h (PTR_BYTE_POS, BUF_PTR_BYTE_POS): Remove harmful cast.
+ The cast incorrectly truncated 64-bit byte offsets to 32 bits, and
+ isn't needed on 32-bit machines.
+
+ * buffer.c (Fgenerate_new_buffer_name):
+ Use EMACS_INT for count, not int.
+ (advance_to_char_boundary): Return EMACS_INT, not int.
+
+ * data.c (Qcompiled_function): Now static.
+
+ * window.c (window_body_lines): Now static.
+
+ * image.c (gif_load): Rename local to avoid shadowing.
+
+ * lisp.h (SAFE_ALLOCA_LISP): Check for integer overflow.
+ (struct Lisp_Save_Value): Use ptrdiff_t, not int, for 'integer' member.
+ * alloc.c (make_save_value): Integer argument is now of type
+ ptrdiff_t, not int.
+ (mark_object): Use ptrdiff_t, not int.
+ * lisp.h (pD): New macro.
+ * print.c (print_object): Use it.
+
+ * alloc.c: Use EMACS_INT, not int, to count objects.
+ (total_conses, total_markers, total_symbols, total_vector_size)
+ (total_free_conses, total_free_markers, total_free_symbols)
+ (total_free_floats, total_floats, total_free_intervals)
+ (total_intervals, total_strings, total_free_strings):
+ Now EMACS_INT, not int. All uses changed.
+ (Fgarbage_collect): Compute overall total using a double, so that
+ integer overflow is less likely to be a problem. Check for overflow
+ when converting back to an integer.
+ (n_interval_blocks, n_string_blocks, n_float_blocks, n_cons_blocks)
+ (n_vectors, n_symbol_blocks, n_marker_blocks): Remove.
+ These were 'int' variables that could overflow on 64-bit hosts;
+ they were never used, so remove them instead of repairing them.
+ (nzombies, ngcs, max_live, max_zombies): Now EMACS_INT, not 'int'.
+ (inhibit_garbage_collection): Set gc_cons_threshold to max value.
+ Previously, this ceilinged at INT_MAX, but that doesn't work on
+ 64-bit machines.
+ (allocate_pseudovector): Don't use EMACS_INT when int would do.
+
+ * alloc.c (Fmake_bool_vector): Don't assume vector size fits in int.
+ (allocate_vectorlike): Check for ptrdiff_t overflow.
+ (mark_vectorlike, mark_char_table, mark_object): Avoid EMACS_UINT
+ when a (possibly-narrower) signed value would do just as well.
+ We prefer using signed arithmetic, to avoid comparison confusion.
+
+ * alloc.c: Catch some string size overflows that we were missing.
+ (XMALLOC_OVERRUN_CHECK_SIZE) [!XMALLOC_OVERRUN_CHECK]: Define to 0,
+ for convenience in STRING_BYTES_MAX.
+ (STRING_BYTES_MAX): New macro, superseding the old one in lisp.h.
+ The definition here is exact; the one in lisp.h was approximate.
+ (allocate_string_data): Check for string overflow. This catches
+ some instances we weren't catching before. Also, it catches
+ size_t overflow on (unusual) hosts where SIZE_MAX <= min
+ (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM), e.g., when size_t is 32 bits
+ and ptrdiff_t and EMACS_INT are both 64 bits.
+
+ * character.c, coding.c, doprnt.c, editfns.c, eval.c:
+ All uses of STRING_BYTES_MAX replaced by STRING_BYTES_BOUND.
+ * lisp.h (STRING_BYTES_BOUND): Renamed from STRING_BYTES_MAX.
+
+ * character.c (string_escape_byte8): Fix nbytes/nchars typo.
+
+ * alloc.c (Fmake_string): Check for out-of-range init.
+
+2011-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fdefvaralias): Also mark the target as variable-special-p.
+
+2011-06-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xfns.c (x_set_scroll_bar_default_width): Remove argument to
+ xg_get_default_scrollbar_width.
+
+ * gtkutil.c: Include emacsgtkfixed.h if HAVE_GTK3.
+ (int_gtk_range_get_value): Move to the scroll bar part of the file.
+ (style_changed_cb): Call update_theme_scrollbar_width and call
+ x_set_scroll_bar_default_width and xg_frame_set_char_size for
+ all frames (Bug#8505).
+ (xg_create_frame_widgets): Call emacs_fixed_new if HAVE_GTK3 (Bug#8505).
+ Call gtk_window_set_resizable if HAVE_GTK3.
+ (x_wm_set_size_hint): Call emacs_fixed_set_min_size with min width
+ and height if HAVE_GTK3 (Bug#8505).
+ (scroll_bar_width_for_theme): New variable.
+ (update_theme_scrollbar_width): New function.
+ (xg_get_default_scrollbar_width): Move code to
+ update_theme_scrollbar_width, just return scroll_bar_width_for_theme.
+ (xg_initialize): Call update_theme_scrollbar_width.
+
+ * gtkutil.h (xg_get_default_scrollbar_width): Remove argument.
+
+ * emacsgtkfixed.c, emacsgtkfixed.h: New files.
+
+2011-06-12 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (make_frame): Call other_buffer_safely instead of
+ other_buffer.
+
+ * window.c (temp_output_buffer_show): Call display_buffer with
+ second argument Vtemp_buffer_show_specifiers and reset latter
+ immediately after the call.
+ (Vtemp_buffer_show_specifiers): New variable.
+ (auto_window_vscroll_p, next_screen_context_lines)
+ (Vscroll_preserve_screen_position): Remove leading asterisks from
+ doc-strings.
+
+2011-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor problems found by GCC 4.6.0 static checking.
+ * buffer.c (Qclone_number): Remove for now, as it's unused.
+ (record_buffer, Funrecord_buffer): Rename local to avoid shadowing.
+ (record_buffer): Remove unused local.
+ * frame.c (other_visible_frames, frame_buffer_list): Now static.
+ (set_frame_buffer_list): Remove; unused.
+ * frame.h (other_visible_frames): Remove decl.
+ * keyboard.h (menu_items_inuse): Declare only if USE_GTK || USE_MOTIF.
+ * lisp.h (frame_buffer_list, set_frame_buffer_list): Remove decls.
+ (add_gpm_wait_descriptor, delete_gpm_wait_descriptor): Declare only
+ if HAVE_GPM.
+ * menu.c (menu_items_inuse): Now static unless USE_GTK || USE_MOTIF.
+ * process.c (add_gpm_wait_descriptor, delete_gpm_wait_descriptor):
+ Define only if HAVE_GPM.
+ * widget.c (EmacsFrameResize, emacsFrameClassRec): Now static.
+ (update_hints_inhibit): Remove; never set. All uses removed.
+ * widgetprv.h (emacsFrameClassRec): Remove decl.
+ * window.c (delete_deletable_window): Now returns void, since it
+ wasn't returning anything.
+ (compare_window_configurations): Remove unused locals.
+ * xfns.c (x_set_scroll_bar_default_width): Remove unused locals.
+ * xmenu.c (x_menu_set_in_use): Define only if USE_GTK || USE_MOTIF.
+ (dialog_selection_callback) [!USE_GTK]: Prefer intptr_t for integers
+ the same widths as pointers. This follows up on the 2011-05-06 patch.
+ * xterm.c (x_alloc_lighter_color_for_widget): Define only if USE_LUCID.
+ * xterm.h: Likewise.
+ (x_menu_set_in_use): Declare only if USE_GTK || USE_MOTIF.
+
+2011-06-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Update dependencies.
+ (LISP_H): Add lib/intprops.h.
+
+2011-06-11 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.c (gif_load): Add animation frame delay to the metadata.
+ (syms_of_image): Use DEFSYM. New symbol `delay'.
+
+2011-06-11 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (delete_deletable_window): Re-add.
+ (Fset_window_configuration): Rewrite to handle dead buffers and
+ consequently deletable windows.
+ (window_tree, Fwindow_tree): Remove. Supply functionality in
+ window.el.
+ (compare_window_configurations): Simplify code.
+
+2011-06-11 Andreas Schwab <schwab@linux-m68k.org>
+
+ * image.c (imagemagick_load_image): Fix type mismatch.
+ (Fimagemagick_types): Likewise.
+
+ * window.h (replace_buffer_in_windows): Declare.
+
+2011-06-11 Martin Rudalics <rudalics@gmx.at>
+
+ * buffer.c: New Lisp objects Qbuffer_list_update_hook and
+ Qclone_number. Remove external declaration of Qdelete_window.
+ (Fbuffer_list): Rewrite doc-string. Minor restructuring of
+ code.
+ (Fget_buffer_create, Fmake_indirect_buffer, Frename_buffer): Run
+ Qbuffer_list_update_hook if allowed.
+ (Fother_buffer): Rewrite doc-string. Major rewrite for new
+ buffer list implementation.
+ (other_buffer_safely): New function.
+ (Fkill_buffer): Replace call to replace_buffer_in_all_windows by
+ calls to replace_buffer_in_windows and
+ replace_buffer_in_windows_safely. Run Qbuffer_list_update_hook
+ if allowed.
+ (record_buffer): Inhibit quitting and rewrite using quittable
+ functions. Run Qbuffer_list_update_hook if allowed.
+ (Frecord_buffer, Funrecord_buffer): New functions.
+ (switch_to_buffer_1, Fswitch_to_buffer): Remove. Move
+ switch-to-buffer to window.el.
+ (bury-buffer): Move to window.el.
+ (Vbuffer_list_update_hook): New variable.
+
+ * lisp.h (other_buffer_safely): Add prototype in buffer.c
+ section.
+
+ * window.h (resize_frame_windows): Move up in code.
+ (Fwindow_frame): Remove EXFUN.
+ (replace_buffer_in_all_windows): Remove prototype.
+ (replace_buffer_in_windows_safely): Add prototype.
+
+ * window.c: Declare Qdelete_window static again. Move down
+ declaration of select_count.
+ (Fnext_window, Fprevious_window): Rewrite doc-strings.
+ (Fother_window): Move to window.el.
+ (window_loop): Remove DELETE_BUFFER_WINDOWS and UNSHOW_BUFFER
+ cases. Add REPLACE_BUFFER_IN_WINDOWS_SAFELY case.
+ (Fdelete_windows_on, Freplace_buffer_in_windows): Move to
+ window.el.
+ (replace_buffer_in_windows): Implement by calling
+ Qreplace_buffer_in_windows.
+ (replace_buffer_in_all_windows): Remove with some functionality
+ moved into replace_buffer_in_windows_safely.
+ (replace_buffer_in_windows_safely): New function.
+ (select_window_norecord, select_frame_norecord): Move in front
+ of run_window_configuration_change_hook. Remove now obsolete
+ declarations.
+ (Fset_window_buffer): Rewrite doc-string. Call
+ Qrecord_window_buffer.
+ (keys_of_window): Move binding for other-window to window.el.
+
+2011-06-11 Chong Yidong <cyd@stupidchicken.com>
+
+ * dispextern.h (struct image): Replace data member, whose int_val
+ and ptr_val fields were not used by anything, with a single
+ lisp_val object.
+
+ * image.c (Fimage_metadata, make_image, mark_image, tiff_load)
+ (gif_clear_image, gif_load, imagemagick_load_image)
+ (gs_clear_image, gs_load): Callers changed.
+
+2011-06-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h: Include <time.h>, for time_t.
+ Needed to build on FreeBSD 8.2. Problem reported by Herbert J. Skuhra.
+
+ Fix minor problems found by static checking.
+
+ * image.c (PixelGetMagickColor): Declare if ImageMagick headers don't.
+
+ Make identifiers static if they are not used in other modules.
+ * data.c (Qcompiled_function, Qframe, Qvector):
+ * image.c (QimageMagick, Qsvg):
+ * minibuf.c (Qmetadata):
+ * window.c (resize_window_check, resize_root_window): Now static.
+ * window.h (resize_window_check, resize_root_window): Remove decls.
+
+ * window.c (window_deletion_count, delete_deletable_window):
+ Remove; unused.
+ (window_body_lines): Now static.
+ (Fdelete_other_windows_internal): Mark vars as initialized.
+ Make sure 'resize_failed' is initialized.
+ (run_window_configuration_change_hook): Rename local to avoid shadowing.
+ (resize_window_apply): Remove unused local.
+ * window.h (delete_deletable_window): Remove decl.
+
+ * image.c (gif_load, svg_load_image): Rename locals to avoid shadowing.
+ (imagemagick_load_image): Fix pointer signedness problem by changing
+ last arg from unsigned char * to char *. All uses changed.
+ Also, fix a local for similar reasons.
+ Remove unused locals. Remove locals to avoid shadowing.
+ (fn_rsvg_handle_free): Remove; unused.
+ (svg_load, svg_load_image): Fix pointer signedness problem.
+ (imagemagick_load_image): Don't use garbage pointer image_wand.
+
+ * ftfont.c (ftfont_get_metrics, ftfont_drive_otf): Remove unused locals.
+
+2011-06-10 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.c (gif_load): Fix omitted cast error introduced by
+ 2011-06-06 change.
+
+2011-06-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.h (resize_proportionally, orig_total_lines)
+ (orig_top_line): Remove from window structure.
+ (set_window_height, set_window_width, change_window_heights)
+ (Fdelete_window): Remove prototypes.
+ (resize_frame_windows): Remove duplicate declaration.
2011-06-10 Eli Zaretskii <eliz@gnu.org>
- * xdisp.c (Fcurrent_bidi_paragraph_direction): Initialize
- itb.string.lstring.
- (compute_display_string_pos, compute_display_string_end):
- Fix calculation of the object to scan. Fixes an error when using
- arrow keys.
- (next_element_from_buffer): Don't abort when IT_CHARPOS is before
- base_level_stop; instead, set base_level_stop to BEGV. Fixes
- crashes in vertical-motion.
+ * window.h (resize_frame_windows, resize_window_check)
+ (delete_deletable_window, resize_root_window)
+ (resize_frame_windows): Declare prototypes.
+
+ * window.c (resize_window_apply): Make definition be "static" to
+ match the prototype.
+
+2011-06-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c: Remove declarations of Qwindow_size_fixed,
+ window_min_size_1, window_min_size_2, window_min_size,
+ size_window, window_fixed_size_p, enlarge_window, delete_window.
+ Remove static from declaration of Qdelete_window, it's
+ temporarily needed by Fbury_buffer.
+ (replace_window): Don't assign orig_top_line and
+ orig_total_lines.
+ (Fdelete_window, delete_window): Remove. Window deletion is
+ handled by window.el.
+ (window_loop): Remove DELETE_OTHER_WINDOWS case. Replace
+ Fdelete_window calls with calls to Qdelete_window.
+ (Fdelete_other_windows): Remove. Deleting other windows is
+ handled by window.el.
+ (window_fixed_size_p): Remove. Fixed-sizeness of windows is
+ handled in window.el.
+ (window_min_size_2, window_min_size_1, window_min_size): Remove.
+ Window minimum sizes are handled in window.el.
+ (shrink_windows, size_window, set_window_height)
+ (set_window_width, change_window_heights, window_height)
+ (window_width, CURBEG, CURSIZE, enlarge_window)
+ (adjust_window_trailing_edge, Fadjust_window_trailing_edge)
+ (Fenlarge_window, Fshrink_window): Remove. Window resizing is
+ handled in window.el.
+ (make_dummy_parent): Rename to make_parent_window and give it a
+ second argument horflag.
+ (make_window): Don't set resize_proportionally any more.
+ (Fsplit_window): Remove. Windows are split in window.el.
+ (save_restore_action, save_restore_orig_size)
+ (shrink_window_lowest_first, save_restore_orig_size): Remove.
+ Resize mini windows in window.el.
+ (grow_mini_window, shrink_mini_window): Implement by calling
+ Qresize_root_window_vertically, resize_window_check and
+ resize_window_apply.
+ (saved_window, Fset_window_configuration, save_window_save): Do
+ not handle orig_top_line, orig_total_lines, and
+ resize_proportionally.
+ (window_min_height, window_min_width): Move to window.el.
+ (keys_of_window): Move bindings for delete-other-windows,
+ split-window, delete-window and enlarge-window to window.el.
+
+ * buffer.c: Temporarily extern Qdelete_window.
+ (Fbury_buffer): Temporarily call Qdelete_window instead of
+ Fdelete_window (Fbury_buffer will move to window.el soon).
+
+ * frame.c (set_menu_bar_lines_1): Remove code handling
+ orig_top_line and orig_total_lines.
+
+ * dispnew.c (adjust_frame_glyphs_initially): Don't use
+ set_window_height but set heights directly.
+ (change_frame_size_1): Use resize_frame_windows.
+
+ * xdisp.c (init_xdisp): Don't use set_window_height but set
+ heights directly.
+
+ * xfns.c (x_set_menu_bar_lines, x_set_tool_bar_lines): Use
+ resize_frame_windows instead of change_window_heights and run
+ run_window_configuration_change_hook.
+
+ * w32fns.c (x_set_tool_bar_lines): Use resize_frame_windows
+ instead of change_window_heights and run
+ run_window_configuration_change_hook.
+
+2011-06-09 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (replace_window): Rename second argument REPLACEMENT to
+ NEW. New third argument SETFLAG. Rewrite.
+ (delete_window, make_dummy_parent): Call replace_window with
+ third argument 1.
+ (window_list_1): Move down in code.
+ (run_window_configuration_change_hook): Move set_buffer part
+ before select_frame_norecord part in order to unwind correctly.
+ Rename count1 to count.
+ (recombine_windows, delete_deletable_window, resize_root_window)
+ (Fdelete_other_windows_internal)
+ (Frun_window_configuration_change_hook, make_parent_window)
+ (resize_window_check, resize_window_apply, Fresize_window_apply)
+ (resize_frame_windows, Fsplit_window_internal)
+ (Fdelete_window_internal, Fresize_mini_window_internal): New
+ functions.
+ (syms_of_window): New variables Vwindow_splits and Vwindow_nest.
+
+2011-06-08 Martin Rudalics <rudalics@gmx.at>
+
+ * window.h (window): Add some new members to window structure -
+ normal_lines, normal_cols, new_total, new_normal, clone_number,
+ splits, nest, prev_buffers, next_buffers.
+ (WINDOW_TOTAL_SIZE): Move here from window.c.
+ (MIN_SAFE_WINDOW_WIDTH, MIN_SAFE_WINDOW_HEIGHT): Define here.
+
+ * window.c (Fwindow_height, Fwindow_width, Fwindow_full_width_p):
+ Remove.
+ (make_dummy_parent): Set new members of windows structure.
+ (make_window): Move down in code. Handle new members of window
+ structure.
+ (Fwindow_clone_number, Fwindow_splits, Fset_window_splits)
+ (Fwindow_nest, Fset_window_nest, Fwindow_new_total)
+ (Fwindow_normal_size, Fwindow_new_normal, Fwindow_prev_buffers)
+ (Fset_window_prev_buffers, Fwindow_next_buffers)
+ (Fset_window_next_buffers, Fset_window_clone_number): New
+ functions.
+ (Fwindow_hscroll, Fwindow_at, Fwindow_point, Fwindow_start)
+ (Fwindow_end, Fwindow_line_height, Fset_window_dedicated_p):
+ Doc-string fixes.
+ (Fwindow_parameters, Fwindow_parameter, Fset_window_parameter):
+ Argument WINDOW can be now internal window too.
+ (Fwindow_use_time): Move up in code.
+ (Fget_buffer_window): Rename argument FRAME to ALL-FRAMES.
+ Rewrite doc-string.
+ (Fset_window_configuration, saved_window)
+ (Fcurrent_window_configuration, save_window_save): Handle new
+ members of window structure.
+ (WINDOW_TOTAL_SIZE, MIN_SAFE_WINDOW_WIDTH)
+ (MIN_SAFE_WINDOW_HEIGHT): Move to window.h.
+ (syms_of_window): New Lisp objects Qrecord_window_buffer,
+ Qwindow_deletable_p, Qdelete_window, Qreplace_buffer_in_windows,
+ Qget_mru_window, Qresize_root_window,
+ Qresize_root_window_vertically, Qsafe, Qabove, Qbelow,
+ Qauto_buffer_name; staticpro them.
+
+2011-06-07 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fwindow_total_size, Fwindow_left_column)
+ (Fwindow_top_line, window_body_lines, Fwindow_body_size)
+ (Fwindow_list_1): New functions.
+ (window_box_text_cols): Replace with window_body_cols.
+ (Fwindow_width, Fscroll_left, Fscroll_right): Use
+ window_body_cols instead of window_box_text_cols.
+ (delete_window, Fset_window_configuration): Call
+ delete_all_subwindows with window as argument.
+ (delete_all_subwindows): Take a window as argument and not a
+ structure. Rewrite.
+ (window_loop): Remove handling of GET_LRU_WINDOW and
+ GET_LARGEST_WINDOW.
+ (Fget_lru_window, Fget_largest_window): Move to window.el.
+
+ * window.h: Extern window_body_cols instead of
+ window_box_text_cols. delete_all_subwindows now takes a
+ Lisp_Object as argument.
+
+ * indent.c (compute_motion, Fcompute_motion): Use
+ window_body_cols instead of window_box_text_cols.
+
+ * frame.c (delete_frame): Call delete_all_subwindows with root
+ window as argument.
+
+2011-06-07 Daniel Colascione <dan.colascione@gmail.com>
+
+ * fns.c (Fputhash): Document return value.
+
+2011-06-06 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.c (gif_load): Implement gif89a spec "no disposal" method.
+
+2011-06-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Cons<->int and similar integer overflow fixes (Bug#8794).
+
+ Check for overflow when converting integer to cons and back.
+ * charset.c (Fdefine_charset_internal, Fdecode_char):
+ Use cons_to_unsigned to catch overflow.
+ (Fencode_char): Use INTEGER_TO_CONS.
+ * composite.h (LGLYPH_CODE): Use cons_to_unsigned.
+ (LGLYPH_SET_CODE): Use INTEGER_TO_CONS.
+ * data.c (long_to_cons, cons_to_long): Remove.
+ (cons_to_unsigned, cons_to_signed): New functions.
+ These signal an error for invalid or out-of-range values.
+ * dired.c (Ffile_attributes): Use INTEGER_TO_CONS.
+ * fileio.c (Fset_visited_file_modtime): Use CONS_TO_INTEGER.
+ * font.c (Ffont_variation_glyphs):
+ * fontset.c (Finternal_char_font): Use INTEGER_TO_CONS.
+ * lisp.h: Include <intprops.h>.
+ (INTEGER_TO_CONS, CONS_TO_INTEGER): New macros.
+ (cons_to_signed, cons_to_unsigned): New decls.
+ (long_to_cons, cons_to_long): Remove decls.
+ * undo.c (record_first_change): Use INTEGER_TO_CONS.
+ (Fprimitive_undo): Use CONS_TO_INTEGER.
+ * xfns.c (Fx_window_property): Likewise.
+ * xselect.c: Include <limits.h>.
+ (x_own_selection, selection_data_to_lisp_data):
+ Use INTEGER_TO_CONS.
+ (x_handle_selection_request, x_handle_selection_clear)
+ (x_get_foreign_selection, Fx_disown_selection_internal)
+ (Fx_get_atom_name, x_send_client_event): Use CONS_TO_INTEGER.
+ (lisp_data_to_selection_data): Use cons_to_unsigned.
+ (x_fill_property_data): Use cons_to_signed.
+ Report values out of range.
+
+ Check for buffer and string overflow more precisely.
+ * buffer.h (BUF_BYTES_MAX): New macro.
+ * lisp.h (STRING_BYTES_MAX): New macro.
+ * alloc.c (Fmake_string):
+ * character.c (string_escape_byte8):
+ * coding.c (coding_alloc_by_realloc):
+ * doprnt.c (doprnt):
+ * editfns.c (Fformat):
+ * eval.c (verror):
+ Use STRING_BYTES_MAX, not MOST_POSITIVE_FIXNUM,
+ since they may not be the same number.
+ * editfns.c (Finsert_char):
+ * fileio.c (Finsert_file_contents):
+ Likewise for BUF_BYTES_MAX.
+
+ * image.c: Use ptrdiff_t, not int, for sizes.
+ (slurp_file): Switch from int to ptrdiff_t.
+ All uses changed.
+ (slurp_file): Check that file size fits in both size_t (for
+ malloc) and ptrdiff_t (for sanity and safety).
-2011-06-09 Eli Zaretskii <eliz@gnu.org>
+ * fileio.c (Fverify_visited_file_modtime): Avoid time overflow
+ if b->modtime has its maximal value.
- * xdisp.c (compute_display_string_pos): First arg is now struct
- `text_pos *'; all callers changed. Support display properties on
- Lisp strings.
- (compute_display_string_end): Support display properties on Lisp
- strings.
- (init_iterator, reseat_1, reseat_to_string): Initialize the
- string.bufpos member to 0 (zero, for compatibility with IT_CHARPOS
- when iterating on a string not from display properties).
+ * dired.c (Ffile_attributes): Don't assume EMACS_INT has >32 bits.
- * bidi.c (bidi_fetch_char): Support strings with display
- properties.
+ Don't assume time_t can fit into int.
+ * buffer.h (struct buffer.modtime): Now time_t, not int.
+ * fileio.c (Fvisited_file_modtime): No need for time_t cast now.
+ * undo.c (Fprimitive_undo): Use time_t, not int, for time_t value.
- * dispextern.h (struct bidi_string_data): New member bufpos.
- (compute_display_string_pos): Update prototype.
+ Minor fixes for signed vs unsigned integers.
+ * character.h (MAYBE_UNIFY_CHAR):
+ * charset.c (maybe_unify_char):
+ * keyboard.c (read_char, reorder_modifiers):
+ XINT -> XFASTINT, since the integer must be nonnegative.
+ * ftfont.c (ftfont_spec_pattern):
+ * keymap.c (access_keymap, silly_event_symbol_error):
+ XUINT -> XFASTINT, since the integer must be nonnegative.
+ (Fsingle_key_description, preferred_sequence_p): XUINT -> XINT,
+ since it makes no difference and we prefer signed.
+ * keyboard.c (record_char): Use XUINT when all the neighbors do.
+ (access_keymap): NATNUMP -> INTEGERP, since the integer must be
+ nonnegative.
-2011-06-09 Eli Zaretskii <eliz@gnu.org>
+2011-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
- * bidi.c (bidi_level_of_next_char): Allow the sentinel "position"
- to pass the test for valid cached positions.
+ * window.h (Fwindow_frame): Declare.
- * xdisp.c (init_iterator): Call bidi_init_it only of a valid
- buffer position was specified. Initialize paragraph_embedding to
- L2R.
- (reseat_to_string): Initialize the bidi iterator (for now ifdef'ed
- out).
- (display_string): If we need to ignore text properties of
- LISP_STRING, set IT->stop_charpos to IT->end_charpos. (The
- original value of -1 will not work with bidi.)
+2011-06-06 Paul Eggert <eggert@cs.ucla.edu>
- * dispextern.h (struct bidi_string_data): New member lstring.
+ * alloc.c: Simplify handling of large-request failures (Bug#8800).
+ (SPARE_MEMORY): Always define.
+ (LARGE_REQUEST): Remove.
+ (memory_full): Use SPARE_MEMORY rather than LARGE_REQUEST.
-2011-06-09 Eli Zaretskii <eliz@gnu.org>
+2011-06-06 Martin Rudalics <rudalics@gmx.at>
- * xdisp.c (Fcurrent_bidi_paragraph_direction): Initialize
- itb.string.s to NULL (avoids a crash in bidi_paragraph_init).
+ * lisp.h: Move EXFUNS for Fframe_root_window,
+ Fframe_first_window and Fset_frame_selected_window to window.h.
-2011-06-08 Eli Zaretskii <eliz@gnu.org>
+ * window.h: Move EXFUNS for Fframe_root_window,
+ Fframe_first_window and Fset_frame_selected_window here from
+ lisp.h.
- * bidi.c (bidi_paragraph_info): Delete unused struct.
- (bidi_cache_idx, bidi_cache_last_idx): Declare EMACS_INT.
- (bidi_cache_start): New variable.
- (bidi_cache_reset): Reset bidi_cache_idx to bidi_cache_start, not
- to zero.
- (bidi_cache_fetch_state, bidi_cache_search)
- (bidi_cache_find_level_change, bidi_cache_iterator_state)
- (bidi_cache_find, bidi_peek_at_next_level)
- (bidi_level_of_next_char, bidi_find_other_level_edge)
- (bidi_move_to_visually_next): Compare cache index with
- bidi_cache_start rather than with zero.
- (bidi_fetch_char): Accept new argument STRING; all callers
- changed. Support iteration over a string.
- (bidi_paragraph_init, bidi_resolve_explicit_1)
- (bidi_resolve_explicit, bidi_resolve_weak)
- (bidi_level_of_next_char, bidi_move_to_visually_next): Support
- iteration over a string.
- (bidi_set_sor_type, bidi_resolve_explicit_1)
- (bidi_resolve_explicit, bidi_type_of_next_char): ignore_bn_limit
- can now be zero (for strings); special values 0 and -1 were
- changed to -1 and -2, respectively.
- (bidi_char_at_pos): New function.
- (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak):
- Call it instead of FETCH_MULTIBYTE_CHAR.
- (bidi_move_to_visually_next): Abort if charpos or bytepos were not
- initialized to valid values.
- (bidi_init_it): Don't initialize charpos and bytepos with invalid
- values.
+ * frame.c (Fwindow_frame, Fframe_first_window)
+ (Fframe_root_window, Fframe_selected_window)
+ (Fset_frame_selected_window): Move to window.c.
+ (Factive_minibuffer_window): Move to minibuf.c.
+ (Fother_visible_frames_p): New function.
- * xdisp.c (compute_display_string_pos)
- (compute_display_string_end): Accept additional argument STRING.
- (init_iterator, reseat_1): Initialize bidi_it->string.s to NULL.
- (reseat_to_string): Initialize bidi_it->string.s and
- bidi_it->string.schars.
+ * minibuf.c (Factive_minibuffer_window): Move here from frame.c.
- * dispextern.h (struct bidi_string_data): New structure.
- (struct bidi_it): New member `string'. Make flag members be 1-bit
- fields, and put them last in the struct.
- (compute_display_string_pos, compute_display_string_end): Update
- prototypes.
+ * window.c (decode_window, decode_any_window): Move up in code.
+ (Fwindowp, Fwindow_live_p): Rewrite doc-strings.
+ (inhibit_frame_unsplittable): Remove unused variable.
+ (Fwindow_buffer): Move up and rewrite doc-string.
+ (Fwindow_parent, Fwindow_vchild, Fwindow_hchild, Fwindow_next)
+ (Fwindow_prev): New functions.
+ (Fwindow_frame): Move here from frame.c. Accept any window as
+ argument.
+ (Fframe_root_window, Fframe_first_window)
+ (Fframe_selected_window): Move here from frame.c. Accept frame
+ or arbitrary window as argument. Update doc-strings.
+ (Fminibuffer_window): Move up in code.
+ (Fwindow_minibuffer_p): Move up in code and simplify.
+ (Fset_frame_selected_window): Move here from frame.c.
+ Marginal rewrite.
+ (Fselected_window, select_window, Fselect_window): Move up in
+ code. Minor doc-string fixes.
+
+2011-06-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (memory_full) [SYSTEM_MALLOC]: Port to MacOS (Bug#8800).
+ Do not assume that spare memory exists; that assumption is valid
+ only if SYSTEM_MALLOC.
+ (LARGE_REQUEST): New macro, so that the issue of large requests
+ is separated from the issue of spare memory.
+
+2011-06-05 Andreas Schwab <schwab@linux-m68k.org>
+
+ * editfns.c (Fformat): Correctly handle zero flag with hexadecimal
+ format. (Bug#8806)
+
+ * gtkutil.c (xg_get_default_scrollbar_width): Avoid warning.
+
+ * xfns.c (x_set_scroll_bar_default_width): Move declarations
+ before statements.
+
+2011-06-05 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_get_default_scrollbar_width): New function.
+
+ * gtkutil.h: Declare xg_get_default_scrollbar_width.
+
+ * xfns.c (x_set_scroll_bar_default_width): If USE_GTK, get
+ min width by calling x_set_scroll_bar_default_width (Bug#8505).
+
+2011-06-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * xdisp.c (single_display_spec_intangible_p): Remove declaration.
+
+2011-06-04 Chong Yidong <cyd@stupidchicken.com>
+
+ * xselect.c (x_clipboard_manager_save): Remove redundant arg.
+ (x_clipboard_manager_save): Add return value.
+ (x_clipboard_manager_error_1, x_clipboard_manager_error_2):
+ New error handlers.
+ (x_clipboard_manager_save_frame, x_clipboard_manager_save_all):
+ Obey Vx_select_enable_clipboard_manager. Catch errors in
+ x_clipboard_manager_save (Bug#8779).
+ (Vx_select_enable_clipboard_manager): New variable.
+ (x_get_foreign_selection): Reduce scope of x_catch_errors (Bug#8790).
+
+2011-06-04 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * emacs.c (main): Warn when starting a GTK emacs in daemon mode.
+
+2011-06-04 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * fringe.c (update_window_fringes): Don't update overlay arrow bitmap
+ in the current matrix if keep_current_p is non-zero.
2011-06-04 Eli Zaretskii <eliz@gnu.org>
- * bidi.c (bidi_level_of_next_char): clen should be EMACS_NT, not int.
+ * bidi.c (bidi_level_of_next_char): Fix last change.
2011-06-03 Eli Zaretskii <eliz@gnu.org>
- * bidi.c (bidi_fetch_char_advance): Remove unused and
- unimplemented function.
+ Support bidi reordering of text covered by display properties.
-2011-05-28 Eli Zaretskii <eliz@gnu.org>
+ * bidi.c (bidi_copy_it): Use offsetof instead of emulating it.
+ (bidi_fetch_char, bidi_fetch_char_advance): New functions.
+ (bidi_cache_search, bidi_cache_iterator_state)
+ (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak)
+ (bidi_level_of_next_char, bidi_move_to_visually_next):
+ Support character positions inside a run of characters covered by a
+ display string.
+ (bidi_paragraph_init, bidi_resolve_explicit_1)
+ (bidi_level_of_next_char): Call bidi_fetch_char and
+ bidi_fetch_char_advance instead of FETCH_CHAR and
+ FETCH_CHAR_ADVANCE.
+ (bidi_init_it): Initialize new members.
+ (LRE_CHAR, RLE_CHAR, PDF_CHAR, LRO_CHAR, RLO_CHAR): Remove macro
+ definitions.
+ (bidi_explicit_dir_char): Lookup character type in bidi_type_table,
+ instead of using explicit *_CHAR codes.
+ (bidi_resolve_explicit, bidi_resolve_weak):
+ Use FETCH_MULTIBYTE_CHAR instead of FETCH_CHAR, as reordering of
+ bidirectional text is supported only in multibyte buffers.
+ (bidi_init_it): Accept additional argument FRAME_WINDOW_P and use
+ it to initialize the frame_window_p member of struct bidi_it.
+ (bidi_cache_iterator_state, bidi_resolve_explicit_1)
+ (bidi_resolve_explicit, bidi_resolve_weak)
+ (bidi_level_of_next_char, bidi_move_to_visually_next): Abort if
+ bidi_it->nchars is non-positive.
+ (bidi_level_of_next_char): Don't try to lookup the cache for the
+ next/previous character if nothing is cached there yet, or if we
+ were just reseat()'ed to a new position.
* xdisp.c (set_cursor_from_row): Set start and stop points
according to the row's direction when priming the loop that looks
@@ -345,22 +2070,14 @@
(single_display_spec_intangible_p): Function deleted.
(display_prop_intangible_p): Reimplement to call
handle_display_spec instead of single_display_spec_intangible_p.
- Accept 3 additional arguments needed by handle_display_spec. This
- fixes incorrect cursor motion across display property with complex
+ Accept 3 additional arguments needed by handle_display_spec.
+ This fixes incorrect cursor motion across display property with complex
values: lists, `(when COND...)' forms, etc.
(single_display_spec_string_p): Support property values that are
lists with the argument STRING its top-level element.
(display_prop_string_p): Fix the condition for processing a
property that is a list to be consistent with handle_display_spec.
-
- * keyboard.c (adjust_point_for_property): Adjust the call to
- display_prop_intangible_p to its new signature.
-
- * dispextern.h (display_prop_intangible_p): Adjust prototype.
-
-2011-05-21 Eli Zaretskii <eliz@gnu.org>
-
- * xdisp.c (handle_display_spec): New function, refactored from the
+ (handle_display_spec): New function, refactored from the
last portion of handle_display_prop.
(compute_display_string_pos): Accept additional argument
FRAME_WINDOW_P. Call handle_display_spec to determine whether the
@@ -371,71 +2088,589 @@
the display property will replace the characters it covers.
(Fcurrent_bidi_paragraph_direction): Initialize the nchars and
frame_window_p members of struct bidi_it.
+ (compute_display_string_pos, compute_display_string_end):
+ New functions.
+ (push_it): Accept second argument POSITION, where pop_it should
+ jump to continue iteration.
+ (reseat_1): Initialize bidi_it.disp_pos.
- * bidi.c (bidi_fetch_char): Accept additional argument
- FRAME_WINDOW_P and pass it to compute_display_string_pos. All
- callers changed.
- (bidi_init_it): Accept additional argument FRAME_WINDOW_P and use
- it to initialize the frame_window_p member of struct bidi_it.
+ * keyboard.c (adjust_point_for_property): Adjust the call to
+ display_prop_intangible_p to its new signature.
* dispextern.h (struct bidi_it): New member frame_window_p.
- (bidi_init_it, compute_display_string_pos): Update prototypes.
+ (bidi_init_it): Update prototypes.
+ (display_prop_intangible_p): Update prototype.
+ (compute_display_string_pos, compute_display_string_end):
+ Declare prototypes.
+ (struct bidi_it): New members nchars and disp_pos. ch_len is now
+ EMACS_INT.
-2011-05-14 Eli Zaretskii <eliz@gnu.org>
+2011-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Malloc failure behavior now depends on size of allocation.
+ * alloc.c (buffer_memory_full, memory_full): New arg NBYTES.
+ * lisp.h: Change signatures accordingly.
+ * alloc.c, buffer.c, editfns.c, menu.c, minibuf.c, xterm.c:
+ All callers changed. (Bug#8762)
+
+ * gnutls.c: Use Emacs's memory allocators.
+ Without this change, the gnutls library would invoke malloc etc.
+ directly, which causes problems on non-SYNC_INPUT hosts, and which
+ runs afoul of improving memory_full behavior. (Bug#8761)
+ (fn_gnutls_global_set_mem_functions): New macro or function pointer.
+ (emacs_gnutls_global_init): Use it to specify xmalloc, xrealloc,
+ xfree instead of the default malloc, realloc, free.
+ (Fgnutls_boot): No need to check for memory allocation failure,
+ since xmalloc does that for us.
+
+ Remove arbitrary limit of 2**31 entries in hash tables. (Bug#8771)
+ * category.c (hash_get_category_set):
+ * ccl.c (ccl_driver):
+ * charset.c (Fdefine_charset_internal):
+ * charset.h (struct charset.hash_index):
+ * composite.c (get_composition_id, gstring_lookup_cache)
+ (composition_gstring_put_cache):
+ * composite.h (struct composition.hash_index):
+ * dispextern.h (struct image.hash):
+ * fns.c (next_almost_prime, larger_vector, cmpfn_eql)
+ (cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql)
+ (hashfn_equal, hashfn_user_defined, make_hash_table)
+ (maybe_resize_hash_table, hash_lookup, hash_put)
+ (hash_remove_from_table, hash_clear, sweep_weak_table, SXHASH_COMBINE)
+ (sxhash_string, sxhash_list, sxhash_vector, sxhash_bool_vector)
+ (Fsxhash, Fgethash, Fputhash, Fmaphash):
+ * image.c (make_image, search_image_cache, lookup_image)
+ (xpm_put_color_table_h):
+ * lisp.h (struct Lisp_Hash_Table):
+ * minibuf.c (Ftry_completion, Fall_completions, Ftest_completion):
+ * print.c (print): Use 'EMACS_UINT' and 'EMACS_INT'
+ for hashes and hash indexes, instead of 'unsigned' and 'int'.
+ * alloc.c (allocate_vectorlike):
+ Check for overflow in vector size calculations.
+ * ccl.c (ccl_driver):
+ Check for overflow when converting EMACS_INT to int.
+ * fns.c, image.c: Remove unnecessary static decls that would otherwise
+ need to be updated by these changes.
+ * fns.c (make_hash_table, maybe_resize_hash_table):
+ Check for integer overflow with large hash tables.
+ (make_hash_table, maybe_resize_hash_table, Fmake_hash_table):
+ Prefer the faster XFLOAT_DATA to XFLOATINT where either will do.
+ (SXHASH_REDUCE): New macro.
+ (sxhash_string, sxhash_list, sxhash_vector, sxhash_bool_vector):
+ Use it instead of discarding useful hash info with large hash values.
+ (sxhash_float): New function.
+ (sxhash): Use it. No more need for "& INTMASK" due to above changes.
+ * lisp.h (FIXNUM_BITS): New macro, useful for SXHASH_REDUCE etc.
+ (MOST_NEGATIVE_FIXNUM, MOST_POSITIVE_FIXNUM, INTMASK):
+ Rewrite to use FIXNUM_BITS, as this simplifies things.
+ (next_almost_prime, larger_vector, sxhash, hash_lookup, hash_put):
+ Adjust signatures to match updated version of code.
+ (consing_since_gc): Now EMACS_INT, since a single hash table can
+ use more than INT_MAX bytes.
+
+2011-06-01 Dan Nicolaescu <dann@ics.uci.edu>
+
+ Make it possible to build with GCC-4.6+ -O2 -flto.
+
+ * emacs.c (__malloc_initialize_hook): Mark as EXTERNALLY_VISIBLE.
+
+2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuf.c (get_minibuffer, read_minibuf_unwind):
+ Call minibuffer-inactive-mode.
+
+2011-05-31 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/data.$(O), $(BLD)/editfns.$(O)):
+ Update dependencies.
- * xdisp.c (compute_display_string_pos): Non-trivial implementation.
- (compute_display_string_end): New function.
- (push_it): Accept second argument POSITION, where pop_it should
- jump to continue iteration.
+2011-05-31 Dan Nicolaescu <dann@ics.uci.edu>
- * dispextern.h (compute_display_string_end): Declare prototype.
+ * data.c (init_data): Remove code for UTS, this system is not
+ supported anymore.
- * bidi.c (bidi_resolve_explicit_1): Use ZV for disp_pos.
- (bidi_fetch_char): Implement support for runs of characters
- covered by display strings.
+2011-05-31 Dan Nicolaescu <dann@ics.uci.edu>
- * bidi.c (bidi_fetch_char): Accept also character position
- corresponding to BYTEPOS. DISP_POS is now a character position,
- not a byte position. All callers changed.
- (bidi_cache_iterator_state, bidi_resolve_explicit_1)
- (bidi_resolve_explicit, bidi_resolve_weak)
- (bidi_level_of_next_char, bidi_move_to_visually_next): Abort if
- bidi_it->nchars is non-positive.
- (bidi_level_of_next_char): Don't try to lookup the cache for the
- next/previous character if nothing is cached there yet, or if we
- were just reseat()'ed to a new position.
- (bidi_paragraph_init, bidi_resolve_explicit_1)
- (bidi_level_of_next_char): Fix arguments in the calls to
- bidi_fetch_char.
+ Don't force ./temacs to start in terminal mode.
-2011-05-10 Eli Zaretskii <eliz@gnu.org>
+ * frame.c (make_initial_frame): Initialize faces in all cases, not
+ only when CANNOT_DUMP is defined.
+ * dispnew.c (init_display): Remove CANNOT_DUMP condition.
- * xdisp.c (compute_display_string_pos): New function.
- (reseat_1): Initialize bidi_it.disp_pos.
+2011-05-31 Dan Nicolaescu <dann@ics.uci.edu>
- * bidi.c (bidi_copy_it): Use offsetof.
- (bidi_fetch_char, bidi_fetch_char_advance): New functions.
- (bidi_cache_search, bidi_cache_iterator_state)
- (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak)
- (bidi_level_of_next_char, bidi_move_to_visually_next): Support
- character positions inside a run of characters covered by a
- display string.
- (bidi_paragraph_init, bidi_resolve_explicit_1)
- (bidi_level_of_next_char): Call bidi_fetch_char and
- bidi_fetch_char_advance instead of FETCH_CHAR and
- FETCH_CHAR_ADVANCE.
- (bidi_init_it): Initialize new members.
- (LRE_CHAR, RLE_CHAR, PDF_CHAR, LRO_CHAR, RLO_CHAR): Remove macro
- definitions.
- (bidi_explicit_dir_char): Lookup character type in bidi_type_table,
- instead of using explicit *_CHAR codes.
- (bidi_resolve_explicit, bidi_resolve_weak): Use
- FETCH_MULTIBYTE_CHAR instead of FETCH_CHAR, as reordering of
- bidirectional text is supported only in multibyte buffers.
+ * dispnew.c (add_window_display_history): Use const for the string
+ pointer. Remove declaration, not needed.
+
+2011-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use 'inline', not 'INLINE'.
+ <http://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00914.html>
+ * alloc.c, fontset.c (INLINE): Remove.
+ * alloc.c, bidi.c, charset.c, coding.c, dispnew.c, fns.c, image.c:
+ * intervals.c, keyboard.c, process.c, syntax.c, textprop.c, w32term.c:
+ * xdisp.c, xfaces.c, xterm.c: Replace all uses of INLINE with inline.
+ * gmalloc.c (register_heapinfo): Use inline unconditionally.
+ * lisp.h (LISP_MAKE_RVALUE): Use inline, not __inline__.
+
+2011-05-31 Dan Nicolaescu <dann@ics.uci.edu>
+
+ Make it possible to run ./temacs.
+
+ * callproc.c (set_initial_environment): Remove CANNOT_DUMP code,
+ syms_of_callproc does the same thing. Remove test for
+ "initialized", do it in the caller.
+ * emacs.c (main): Avoid calling set_initial_environment when dumping.
- * dispextern.h (struct bidi_it): New members nchars and disp_pos.
- ch_len is now EMACS_INT.
- (compute_display_string_pos): Declare prototype.
+2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuf.c (Finternal_complete_buffer): Return `category' metadata.
+ (read_minibuf): Use get_minibuffer.
+ (syms_of_minibuf): Use DEFSYM.
+ (Qmetadata): New var.
+ * data.c (Qbuffer): Don't make it static.
+ (syms_of_data): Use DEFSYM.
+
+2011-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * ccl.c (CCL_CODE_RANGE): Allow negative numbers. (Bug#8751)
+ (CCL_CODE_MIN): New macro.
+
+2011-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (lisp_align_malloc): Omit unnecessary val==NULL tests.
+
+ * eval.c (Qdebug): Now static.
+ * lisp.h (Qdebug): Remove decl. This reverts a part of the
+ 2011-04-26T11:26:05Z!dan.colascione@gmail.com that inadvertently undid part of
+ 2011-04-14T06:48:41Z!eggert@cs.ucla.edu.
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * image.c: Various fixes to ImageMagick code comments.
+ (Fimagemagick_types): Doc fix.
+
+2011-05-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor fixes prompted by GCC 4.6.0 warnings.
+
+ * xselect.c (converted_selections, conversion_fail_tag): Now static.
+
+ * emacs.c [HAVE_X_WINDOWS]: Include "xterm.h".
+ (x_clipboard_manager_save_all): Move extern decl to ...
+ * xterm.h: ... here, so that it can be checked for consistency.
+
+2011-05-29 Chong Yidong <cyd@stupidchicken.com>
+
+ * xselect.c (x_clipboard_manager_save_frame)
+ (x_clipboard_manager_save_all): New functions.
+ (Fx_clipboard_manager_save): Lisp function deleted.
+
+ * emacs.c (Fkill_emacs): Call x_clipboard_manager_save_all.
+ * frame.c (delete_frame): Call x_clipboard_manager_save_frame.
+
+ * xterm.h: Update prototype.
+
+2011-05-28 William Xu <william.xwl@gmail.com>
+
+ * nsterm.m (ns_term_shutdown): Synchronize user defaults before
+ exiting (Bug#8239).
+
+2011-05-28 Jim Meyering <meyering@redhat.com>
+
+ Avoid a sign-extension bug in crypto_hash_function.
+ * fns.c (to_uchar): Define.
+ (crypto_hash_function): Use it to convert some newly-signed
+ variables to unsigned, to avoid sign-extension bugs. For example,
+ without this change, (md5 "truc") would evaluate to
+ 45723a2aff78ff4fff7fff1114760e62 rather than the expected
+ 45723a2af3788c4ff17f8d1114760e62. Reported by Antoine Levitt in
+ https://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00883.html.
+
+2011-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Integer overflow fixes.
+
+ * dbusbind.c: Serial number integer overflow fixes.
+ (CHECK_DBUS_SERIAL_GET_SERIAL): New macro.
+ (Fdbus_call_method_asynchronously, xd_read_message_1): Use a float
+ to hold a serial number that is too large for a fixnum.
+ (Fdbus_method_return_internal, Fdbus_method_error_internal):
+ Check for serial numbers out of range. Decode any serial number
+ that was so large that it became a float. (Bug#8722)
+
+ * dbusbind.c: Use XFASTINT rather than XUINT, and check for nonneg.
+ (Fdbus_call_method, Fdbus_call_method_asynchronously):
+ Use XFASTINT rather than XUINT when numbers are nonnegative.
+ (xd_append_arg, Fdbus_method_return_internal):
+ (Fdbus_method_error_internal): Likewise. Also, for unsigned
+ arguments, check that Lisp number is nonnegative, rather than
+ silently wrapping negative numbers around. (Bug#8722)
+ (xd_read_message_1): Don't assume dbus_uint32_t can fit in int.
+ (Bug#8722)
+
+ * data.c (arith_driver, Flsh): Avoid unnecessary casts to EMACS_UINT.
+
+ * ccl.c (ccl_driver): Redo slightly to avoid the need for 'unsigned'.
+
+ 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
+ decoding a CCL program. Many of the new checks are whether XINT (x)
+ fits in int; it doesn't always, on 64-bit hosts. The new version
+ doesn't catch all possible integer overflows, but it's an
+ improvement. (Bug#8719)
+
+ * alloc.c (make_event_array): Use XINT, not XUINT.
+ There's no need for unsigned here.
+
+ * mem-limits.h (EXCEEDS_LISP_PTR) [!USE_LSB_TAG]: EMACS_UINT -> uintptr_t
+ This follows up to the 2011-05-06 change that substituted uintptr_t
+ for EMACS_INT. This case wasn't caught back then.
+
+ Rework Fformat to avoid integer overflow issues.
+ * editfns.c: Include <float.h> unconditionally, as it's everywhere
+ now (part of C89). Include <verify.h>.
+ (MAX_10_EXP, CONVERTED_BYTE_SIZE): Remove; no longer needed.
+ (pWIDE, pWIDElen, signed_wide, unsigned_wide): New defns.
+ (Fformat): Avoid the prepass trying to compute sizes; it was only
+ approximate and thus did not catch overflow reliably. Instead, walk
+ through the format just once, formatting and computing sizes as we go,
+ checking for integer overflow at every step, and allocating a larger
+ buffer as needed. Keep track separately whether the format is
+ multibyte. Keep only the most-recently calculated precision, rather
+ than them all. Record whether each argument has been converted to
+ string. Use EMACS_INT, not int, for byte and char and arg counts.
+ Support field widths and precisions larger than INT_MAX. Avoid
+ sprintf's undefined behavior with conversion specifications such as %#d
+ and %.0c. Fix bug with strchr succeeding on '\0' when looking for
+ flags. Fix bug with (format "%c" 256.0). Avoid integer overflow when
+ formatting out-of-range floating point numbers with int
+ formats. (Bug#8668)
+
+ * lisp.h (FIXNUM_OVERFLOW_P): Work even if arg is a NaN.
+
+ * data.c: Avoid integer truncation in expressions involving floats.
+ * data.c: Include <intprops.h>.
+ (arith_driver): When there's an integer overflow in an expression
+ involving floating point, convert the integers to floating point
+ so that the resulting value does not suffer from catastrophic
+ integer truncation. For example, on a 64-bit host (* 4
+ most-negative-fixnum 0.5) should yield about -4.6e+18, not zero.
+ Do not rely on undefined behavior after integer overflow.
+
+ merge count_size_as_multibyte, parse_str_to_multibyte
+ * character.c, character.h (count_size_as_multibyte):
+ Rename from parse_str_to_multibyte; all uses changed.
+ Check for integer overflow.
+ * insdel.c, lisp.h (count_size_as_multibyte): Remove,
+ since it's now a duplicate of the other. This is more of
+ a character than a buffer op, so better that it's in character.c.
+ * fns.c, print.c: Adjust to above changes.
+
+2011-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xselect.c (x_convert_selection): Yet another int/Lisp_Object mixup.
+
+2011-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xselect.c: Fix minor problems prompted by GCC 4.6.0 warnings.
+ (x_handle_selection_request, frame_for_x_selection): Remove unused vars.
+ (x_clipboard_manager_save): Now static.
+ (Fx_clipboard_manager_save): Rename local to avoid shadowing.
+
+ * fns.c: Fix minor problems prompted by GCC 4.6.0 warnings.
+ (crypto_hash_function): Now static.
+ Fix pointer signedness problems. Avoid unnecessary initializations.
+
+2011-05-27 Chong Yidong <cyd@stupidchicken.com>
+
+ * termhooks.h (Vselection_alist): Make it terminal-local.
+
+ * terminal.c (create_terminal): Initialize it.
+
+ * xselect.c: Support for clipboard managers.
+ (Vselection_alist): Move to termhooks.h as terminal-local var.
+ (LOCAL_SELECTION): New macro.
+ (x_atom_to_symbol): Handle x_display_info_for_display fail case.
+ (symbol_to_x_atom): Remove gratuitous arg.
+ (x_handle_selection_request, lisp_data_to_selection_data)
+ (x_get_foreign_selection, Fx_register_dnd_atom): Callers changed.
+ (x_own_selection, x_get_local_selection, x_convert_selection):
+ New arg, specifying work frame. Use terminal-local Vselection_alist.
+ (some_frame_on_display): Delete unused function.
+ (Fx_own_selection_internal, Fx_get_selection_internal)
+ (Fx_disown_selection_internal, Fx_selection_owner_p)
+ (Fx_selection_exists_p): New optional frame arg.
+ (frame_for_x_selection, Fx_clipboard_manager_save): New functions.
+ (x_handle_selection_clear): Don't treat other terminals with the
+ same keyboard specially. Use the terminal-local Vselection_alist.
+ (x_clear_frame_selections): Use Frun_hook_with_args.
+
+ * xterm.c (x_term_init): Intern ATOM and CLIPBOARD_MANAGER atoms.
+
+ * xterm.h: Add support for those atoms.
+
+2011-05-26 Chong Yidong <cyd@stupidchicken.com>
+
+ * xselect.c: ICCCM-compliant handling of MULTIPLE targets.
+ (converted_selections, conversion_fail_tag): New global variables.
+ (x_selection_request_lisp_error): Free the above.
+ (x_get_local_selection): Remove unnecessary code.
+ (x_reply_selection_request): Args changed; handle arbitrary array
+ of converted selections stored in converted_selections.
+ Separate the XChangeProperty and SelectionNotify steps.
+ (x_handle_selection_request): Rewrite to handle MULTIPLE target.
+ (x_convert_selection): New function.
+ (x_handle_selection_event): Simplify.
+ (x_get_foreign_selection): Don't ignore incoming requests while
+ waiting for an answer; this will fail when we implement
+ SAVE_TARGETS, and seems unnecessary anyway.
+ (selection_data_to_lisp_data): Recognize ATOM_PAIR type.
+ (Vx_sent_selection_functions): Doc fix.
+
+2011-05-26 Leo Liu <sdl.web@gmail.com>
+
+ * editfns.c (Ftranspose_regions): Allow empty regions. (Bug#8699)
+
+2011-05-25 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * dispextern.h (struct glyph_row): New member fringe_bitmap_periodic_p.
+
+ * dispnew.c (shift_glyph_matrix, scrolling_window): Mark scrolled row
+ for fringe update if it has periodic bitmap.
+ (row_equal_p): Also compare left_fringe_offset, right_fringe_offset,
+ and fringe_bitmap_periodic_p.
+
+ * fringe.c (get_fringe_bitmap_data): New function.
+ (draw_fringe_bitmap_1, update_window_fringes): Use it.
+ (update_window_fringes): Record periodicity of fringe bitmap in glyph
+ row. Mark glyph row for fringe update if periodicity changed.
+
+ * xdisp.c (try_window_reusing_current_matrix): Don't mark scrolled row
+ for fringe update unless it has periodic bitmap.
+
+2011-05-25 Kenichi Handa <handa@m17n.org>
+
+ * xdisp.c (get_next_display_element): Set correct it->face_id for
+ a static composition.
+
+2011-05-24 Leo Liu <sdl.web@gmail.com>
+
+ * deps.mk (fns.o):
+ * makefile.w32-in ($(BLD)/fns.$(O)): Include sha1.h.
+
+ * fns.c (crypto_hash_function, Fsha1): New function.
+ (Fmd5): Use crypto_hash_function.
+ (syms_of_fns): Add Ssha1.
+
+2011-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gnutls.c: Remove unused macros.
+ (fn_gnutls_transport_set_lowat, fn_gnutls_transport_set_pull_function):
+ (fn_gnutls_transport_set_push_function) [!WINDOWSNT]:
+ Remove macros that are defined and never used.
+ Caught by gcc -Wunused-macros (GCC 4.6.0, Fedora 14).
+
+2011-05-22 Chong Yidong <cyd@stupidchicken.com>
+
+ * xselect.c (syms_of_xselect): Remove unused symbol SAVE_TARGETS.
+ (Fx_get_selection_internal): Minor cleanup.
+ (Fx_own_selection_internal): Rename arguments for consistency with
+ select.el.
+
+2011-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xselect.c (QSAVE_TARGETS): New static var, to fix build failure.
+
+2011-05-22 Chong Yidong <cyd@stupidchicken.com>
+
+ * xselect.c (syms_of_xselect): Include character.h; use DEFSYM.
+
+2011-05-21 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * dispnew.c (scrolling_window): Don't exclude the case that the
+ last enabled row in the desired matrix touches the bottom boundary.
+
+2011-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in ($(etc)/DOC): Make second command line even shorter.
+ (SOME_MACHINE_OBJECTS): Replace FONT_OBJ by its maximal expansion,
+ and add some more files.
+
+2011-05-20 Eli Zaretskii <eliz@gnu.org>
+
+ * callproc.c (Fcall_process) [MSDOS]: Fix arguments to
+ report_file_error introduced by the change from 2011-05-07.
+
+2011-05-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * systime.h (Time): Define only if emacs is defined.
+ This is to allow ../lib-src/profile.c to be compiled on FreeBSD,
+ 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>
+
+ * composite.c (find_automatic_composition): Fix previous change.
+
+2011-05-20 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk: New file, split from Makefile.in.
+ * Makefile.in (lisp): Move to separate file, inserted by @lisp_frag@.
+ (shortlisp): Remove.
+ ($(etc)/DOC): Edit lisp.mk rather than using $shortlisp.
+
+2011-05-19 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MSDOS_SUPPORT_REAL, MSDOS_SUPPORT, NS_SUPPORT)
+ (REAL_MOUSE_SUPPORT, GPM_MOUSE_SUPPORT, MOUSE_SUPPORT, TOOLTIP_SUPPORT)
+ (BASE_WINDOW_SUPPORT, X_WINDOW_SUPPORT, WINDOW_SUPPORT): Remove.
+ (lisp): Set the order to that of loadup.el.
+ (shortlisp): Make it a copy of $lisp.
+ (SOME_MACHINE_LISP): Remove.
+ ($(etc)/DOC): Depend just on $lisp, not $SOME_MACHINE_LISP too.
+ Use just $shortlisp, not $SOME_MACHINE_LISP too.
+
+2011-05-18 Kenichi Handa <handa@m17n.org>
+
+ * composite.c (CHAR_COMPOSABLE_P): Add more check for efficiency.
+ (BACKWARD_CHAR): Wrap the arg STOP by parenthesis.
+ (find_automatic_composition): Mostly rewrite for efficiency.
+
+2011-05-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Update dependencies.
+
+2011-05-18 Christoph Scholtes <cschol2112@googlemail.com>
+
+ * menu.c: Include limits.h (fixes the MS-Windows build broken by
+ 2011-06-18T18:49:19Z!cyd@stupidchicken.com).
+
+2011-05-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix some integer overflow issues, such as string length overflow.
+
+ * insdel.c (count_size_as_multibyte): Check for string overflow.
+
+ * character.c (lisp_string_width): Check for string overflow.
+ Use EMACS_INT, not int, for string indexes and lengths; in
+ particular, 2nd arg is now EMACS_INT, not int. Do not crash if
+ the resulting string length overflows an EMACS_INT; instead,
+ report a string overflow if no precision given. When checking for
+ precision exhaustion, use a check that cannot possibly have
+ integer overflow. (Bug#8675)
+ * character.h (lisp_string_width): Adjust to new signature.
+
+ * alloc.c (string_overflow): New function.
+ (Fmake_string): Use it. This doesn't change behavior, but saves
+ a few bytes and will simplify future changes.
+ * character.c (string_escape_byte8): Likewise.
+ * lisp.h (string_overflow): New decl.
+
+ Fixups, following up to the user-interface timestamp change.
+ * nsterm.m (last_mouse_movement_time, ns_mouse_position): Use Time
+ for UI timestamps, instead of unsigned long.
+ * msdos.c (mouse_get_pos): Likewise.
+ * w32inevt.c (movement_time, w32_console_mouse_position): Likewise.
+ * w32gui.h (Time): Define by including "systime.h" rather than by
+ declaring it ourselves. (Bug#8664)
+
+ * dispextern.h (struct image): Don't assume time_t <= unsigned long.
+ * image.c (clear_image_cache): Likewise.
+
+ * term.c (term_mouse_position): Don't assume time_t wraparound.
+
+ Be more systematic about user-interface timestamps.
+ Before, the code sometimes used 'Time', sometimes 'unsigned long',
+ and sometimes 'EMACS_UINT', to represent these timestamps.
+ This change causes it to use 'Time' uniformly, as that's what X uses.
+ This makes the code easier to follow, and makes it easier to catch
+ integer overflow bugs such as Bug#8664.
+ * frame.c (Fmouse_position, Fmouse_pixel_position):
+ Use Time, not unsigned long, for user-interface timestamps.
+ * keyboard.c (last_event_timestamp, kbd_buffer_get_event): Likewise.
+ (button_down_time, make_lispy_position, make_lispy_movement): Likewise.
+ * keyboard.h (last_event_timestamp): Likewise.
+ * menu.c (Fx_popup_menu) [!HAVE_X_WINDOWS]: Likewise.
+ * menu.h (xmenu_show): Likewise.
+ * term.c (term_mouse_position): Likewise.
+ * termhooks.h (struct input_event.timestamp): Likewise.
+ (struct terminal.mouse_position_hook): Likewise.
+ * xmenu.c (create_and_show_popup_menu, xmenu_show): Likewise.
+ * xterm.c (XTmouse_position, x_scroll_bar_report_motion): Likewise.
+ * systime.h (Time): New decl. Pull it in from <X11/X.h> if
+ HAVE_X_WINDOWS, otherwise define it as unsigned long, which is
+ what it was before.
+ * menu.h, termhooks.h: Include "systime.h", for Time.
+
+ * keyboard.c (make_lispy_event): Fix problem in integer overflow.
+ Don't assume that the difference between two unsigned long values
+ can fit into an integer. At this point, we know button_down_time
+ <= event->timestamp, so the difference must be nonnegative, so
+ there's no need to cast the result if double-click-time is
+ nonnegative, as it should be; check that it's nonnegative, just in
+ case. This bug is triggered when events are more than 2**31 ms
+ apart (about 25 days). (Bug#8664)
+
+ * xselect.c (last_event_timestamp): Remove duplicate decl.
+ (x_own_selection): Remove needless cast to unsigned long.
+
+ * xmenu.c (set_frame_menubar): Use int, not EMACS_UINT, for indexes
+ that always fit in int. Use a sentinel instead of a counter, to
+ avoid a temp and to allay GCC's concerns about possible int overflow.
+ * frame.h (struct frame): Use int for menu_bar_items_used
+ instead of EMACS_INT, since it always fits in int.
+
+ * menu.c (grow_menu_items): Check for int overflow.
+
+ * xmenu.c (set_frame_menubar): Don't mishandle vectors with no nils.
+
+ * xterm.c: Use EMACS_INT for Emacs modifiers, and int for X modifiers.
+ Before, the code was not consistent. These values cannot exceed
+ 2**31 - 1 so there's no need to make them unsigned.
+ (x_x_to_emacs_modifiers): Accept int and return EMACS_INT.
+ (x_emacs_to_x_modifiers): Accept EMACS_INT and return int.
+ (x_x_to_emacs_modifiers, x_emacs_to_x_modifiers): Reject non-integers
+ as modifiers.
+ * xterm.h (x_x_to_emacs_modifiers): Adjust to signature change.
+
+ * lisp.h (XINT) [USE_LISP_UNION_TYPE]: Cast to EMACS_INT.
+ (XUINT) [USE_LISP_UNION_TYPE]: Cast to EMACS_UINT.
+ Otherwise, GCC 4.6.0 warns about printf (pI, XINT (...)),
+ presumably because the widths might not match.
+
+ * window.c (size_window): Avoid needless test at loop start.
+
+2011-05-18 Courtney Bane <emacs-bugs-7626@cbane.org> (tiny change)
+
+ * term.c (Fresume_tty): Restore hooks before reinitializing (bug#8687).
+
+2011-05-12 Drew Adams <drew.adams@oracle.com>
+
+ * textprop.c (Fprevious_single_char_property_change): Doc fix (bug#8655).
+
+2011-05-12 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * w32term.c (w32_draw_fringe_bitmap): Rename local vars `left' and
+ `width' to `bar_area_x' and `bar_area_width', respectively.
+ (x_scroll_run): Take account of fringe background extension.
+
+ * xterm.c (x_draw_fringe_bitmap) [USE_TOOLKIT_SCROLL_BARS]:
+ Rename local vars `left' and `width' to `bar_area_x' and
+ `bar_area_width', respectively.
+ (x_scroll_run) [USE_TOOLKIT_SCROLL_BARS]: Take account of fringe
+ background extension.
+
+2011-05-10 Jim Meyering <meyering@redhat.com>
+
+ * xdisp.c (x_intersect_rectangles): Fix typo "the the -> the".
+
+2011-05-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * image.c (Finit_image_library): Return t for built-in image types,
+ like pbm and xbm. (Bug#8640)
2011-05-09 Andreas Schwab <schwab@linux-m68k.org>
@@ -447,11 +2682,11 @@
(Fget_screen_color): New function.
(syms_of_ntterm): Defsubr it.
- * callproc.c (call_process_cleanup): Don't close and unlink the
- temporary file if Fcall_process didn't create it in the first
- place.
- (Fcall_process): Don't create tempfile if stdout of the child
- process will be redirected to a file specified with `:file'.
+ * callproc.c (call_process_cleanup) [MSDOS]: Don't close and
+ unlink the temporary file if Fcall_process didn't create it in the
+ first place.
+ (Fcall_process) [MSDOS]: Don't create tempfile if stdout of the
+ child process will be redirected to a file specified with `:file'.
Don't try to re-open tempfile in that case, and set fd[0] to -1 as
cue to call_process_cleanup not to close that handle.
@@ -540,8 +2775,8 @@
* dbusbind.c: Do not use XPNTR on a value that may be an integer.
Reported by Stefan Monnier in
<http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00919.html>.
- (xd_remove_watch, Fdbus_init_bus, xd_read_queued_messages): Use
- SYMBOLP-guarded XSYMBOL, not XPNTR.
+ (xd_remove_watch, Fdbus_init_bus, xd_read_queued_messages):
+ Use SYMBOLP-guarded XSYMBOL, not XPNTR.
* lisp.h (EMACS_INTPTR): Remove. All uses changed to intptr_t.
(EMACS_UINTPTR): Likewise, with uintptr_t.
@@ -727,8 +2962,8 @@
* callproc.c: Indentation fixup.
* sysdep.c (wait_for_termination_1): Make static.
- (wait_for_termination, interruptible_wait_for_termination): Move
- after wait_for_termination_1.
+ (wait_for_termination, interruptible_wait_for_termination):
+ Move after wait_for_termination_1.
2011-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -844,8 +3079,8 @@
(emacs_gnutls_write): Don't use uninitialized rtnval if nbyte <= 0.
* lisp.h: Fix a problem with aliasing and vector headers. (Bug#8546)
- GCC 4.6.0 optimizes based on type-based alias analysis. For
- example, if b is of type struct buffer * and v of type struct
+ GCC 4.6.0 optimizes based on type-based alias analysis.
+ For example, if b is of type struct buffer * and v of type struct
Lisp_Vector *, then gcc -O2 was incorrectly assuming that &b->size
!= &v->size, and therefore "v->size = 1; b->size = 2; return
v->size;" must therefore return 1. This assumption is incorrect
@@ -865,8 +3100,8 @@
(XSETPSEUDOVECTOR): Rewrite in terms of XSETTYPED_PSEUDOVECTOR.
(XSETSUBR): Rewrite in terms of XSETTYPED_PSEUDOVECTOR and XSIZE,
since Lisp_Subr is a special case (no "next" field).
- (ASIZE): Now uses header.size rather than size. All
- previous uses of XVECTOR (foo)->size replaced to use this macro,
+ (ASIZE): Now uses header.size rather than size.
+ All previous uses of XVECTOR (foo)->size replaced to use this macro,
to avoid the hassle of writing XVECTOR (foo)->header.size.
(struct vectorlike_header): New type.
(TYPED_PSEUDOVECTORP): New macro, also specifying the C type of the
@@ -915,7 +3150,7 @@
Break out the floating-point parsing into a new
function string_to_number, so that Fstring_to_number parses
floating point numbers consistently with the Lisp reader.
- (digit_to_number): Moved here from data.c. Make it static inline.
+ (digit_to_number): Move here from data.c. Make it static inline.
(E_CHAR, EXP_INT): Remove, replacing with ...
(E_EXP): New macro, to solve the "1.0e+" problem mentioned below.
(string_to_number): New function, replacing isfloat_string.
@@ -1076,9 +3311,9 @@
:verify-hostname-error, :verify-error, and :verify-flags
parameters of `gnutls-boot' and documented those parameters in the
docstring. Start callback support.
- (emacs_gnutls_handshake): Add Woe32 support. Retry handshake
- unless a fatal error occured. Call gnutls_alert_send_appropriate
- on error. Return error code.
+ (emacs_gnutls_handshake): Add Woe32 support. Retry handshake
+ unless a fatal error occurred. Call gnutls_alert_send_appropriate
+ on error. Return error code.
(emacs_gnutls_write): Call emacs_gnutls_handle_error.
(emacs_gnutls_read): Likewise.
(Fgnutls_boot): Return handshake error code.
@@ -1152,8 +3387,8 @@
Fix doprnt so it could be used again safely in `verror'. (Bug#8435)
* doprnt.c: Include limits.h.
(SIZE_MAX): New macro.
- (doprnt): Return a size_t value. 2nd arg is now size_t. Many
- local variables are now size_t instead of int or unsigned.
+ (doprnt): Return a size_t value. 2nd arg is now size_t.
+ Many local variables are now size_t instead of int or unsigned.
Improve overflow protection. Support `l' modifier for integer
conversions. Support %l conversion. Don't assume an EMACS_INT
argument for integer conversions and for %c.
@@ -1354,8 +3589,8 @@
* syntax.c (update_syntax_table): Declare 2nd argument EMACS_INT.
- * textprop.c (verify_interval_modification, interval_of): Declare
- arguments EMACS_INT.
+ * textprop.c (verify_interval_modification, interval_of):
+ Declare arguments EMACS_INT.
* intervals.c (adjust_intervals_for_insertion): Declare arguments
EMACS_INT.
@@ -1606,8 +3841,8 @@
(free_realized_fontset) #if-0 the body, which does nothing.
(face_suitable_for_char_p): #if-0, as it's never called.
* fontset.h (face_suitable_for_char_p): Remove decl.
- * xfaces.c (face_at_string_position): Use
- FACE_SUITABLE_FOR_ASCII_CHAR_P, not FACE_SUITABLE_FOR_CHAR_P,
+ * xfaces.c (face_at_string_position):
+ Use FACE_SUITABLE_FOR_ASCII_CHAR_P, not FACE_SUITABLE_FOR_CHAR_P,
since 0 is always ASCII.
* fns.c (weak_hash_tables): Now static.
@@ -1716,8 +3951,8 @@
(last_point_position_window): Remove decls.
* keyboard.c: Make these variables static.
- * coding.h (coding, code_convert_region, encode_coding_gap): Remove
- decls.
+ * coding.h (coding, code_convert_region, encode_coding_gap):
+ Remove decls.
* coding.c (Vsjis_coding_system, Vbig5_coding_system):
(iso_code_class, detect_coding, code_convert_region): Now static.
(encode_coding_gap): Remove; unused.
@@ -1748,7 +3983,7 @@
exported only to the debugger.
* atimer.c (alarm_signal_handler, run_all_atimers): Now static.
- * atimer.h (run_all_atimers): Removed; not exported.
+ * atimer.h (run_all_atimers): Remove; not exported.
font.c: Make copy_font_spec and merge_font_spec ordinary C functions.
* font.c (copy_font_spec): Rename from Fcopy_font_spec, since it
@@ -2003,8 +4238,8 @@
2011-04-09 Chong Yidong <cyd@stupidchicken.com>
- * ftfont.c (get_adstyle_property, ftfont_pattern_entity): Use
- unsigned char, to match FcChar8 type definition.
+ * ftfont.c (get_adstyle_property, ftfont_pattern_entity):
+ Use unsigned char, to match FcChar8 type definition.
* xterm.c (handle_one_xevent):
* xmenu.c (create_and_show_popup_menu):
@@ -2077,8 +4312,8 @@
2011-04-06 Chong Yidong <cyd@stupidchicken.com>
- * process.c (Flist_processes): Removed to Lisp.
- (list_processes_1): Deleted.
+ * process.c (Flist_processes): Remove to Lisp.
+ (list_processes_1): Delete.
2011-04-06 Eli Zaretskii <eliz@gnu.org>
@@ -2336,8 +4571,8 @@
* callint.c (Fcall_interactively): Preserve lexical-binding mode for
interactive spec.
- * bytecode.c (Bstack_ref, Bstack_set, Bstack_set2, BdiscardN): New
- byte-codes.
+ * bytecode.c (Bstack_ref, Bstack_set, Bstack_set2, BdiscardN):
+ New byte-codes.
(exec_byte_code): New function extracted from Fbyte_code to handle new
calling convention for byte-code-functions. Add new byte-codes.
@@ -2352,8 +4587,8 @@
2011-03-31 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (SCROLL_LIMIT): New macro.
- (try_scrolling): Use it when setting scroll_limit. Limit
- scrolling to 100 screen lines.
+ (try_scrolling): Use it when setting scroll_limit.
+ Limit scrolling to 100 screen lines.
(redisplay_window): Even when falling back on "recentering",
position point in the window according to scroll-conservatively,
scroll-margin, and scroll-*-aggressively variables. (Bug#6671)
diff --git a/src/ChangeLog.6 b/src/ChangeLog.6
index d7903568102..f9372aa666a 100644
--- a/src/ChangeLog.6
+++ b/src/ChangeLog.6
@@ -4599,7 +4599,7 @@
1995-08-14 Erik Naggum <erik@naggum.no>
- * emacs.c (standard_args): Add option --eval to evalute an
+ * emacs.c (standard_args): Add option --eval to evaluate an
expression on the command line and print the result.
1995-08-14 Richard Stallman <rms@mole.gnu.ai.mit.edu>
diff --git a/src/ChangeLog.9 b/src/ChangeLog.9
index 0c39de74a6a..f25434087c1 100644
--- a/src/ChangeLog.9
+++ b/src/ChangeLog.9
@@ -5985,7 +5985,7 @@
GC_PROTECT_MALLOC_STATE]: New function.
(PROTECT_MALLOC_STATE): New macro.
(__malloc_initialize, morecore, _malloc_internal)
- (_free_internal) _realloc_internal): Use it to make _heapinfo
+ (_free_internal, _realloc_internal): Use it to make _heapinfo
read-only outside of gmalloc.
* keymap.c: Update copyright.
diff --git a/src/Makefile.in b/src/Makefile.in
index 8b596430cf5..f68fa5c2240 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -149,11 +149,13 @@ M17N_FLT_LIBS = @M17N_FLT_LIBS@
DBUS_CFLAGS = @DBUS_CFLAGS@
DBUS_LIBS = @DBUS_LIBS@
+## dbusbind.o if HAVE_DBUS, else empty.
DBUS_OBJ = @DBUS_OBJ@
-GCONF_CFLAGS = @GCONF_CFLAGS@
-GCONF_LIBS = @GCONF_LIBS@
+SETTINGS_CFLAGS = @SETTINGS_CFLAGS@
+SETTINGS_LIBS = @SETTINGS_LIBS@
+## gtkutil.o if USE_GTK, else empty.
GTK_OBJ=@GTK_OBJ@
## -ltermcap, or -lncurses, or -lcurses, or "".
@@ -198,7 +200,10 @@ OLDXMENU_DEPS=@OLDXMENU_DEPS@
## Else $(OLDXMENU).
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.
XOBJ=@XOBJ@
TOOLKIT_LIBW=@TOOLKIT_LIBW@
@@ -237,18 +242,14 @@ CYGWIN_OBJ=@CYGWIN_OBJ@
MSDOS_OBJ =
## w16select.o termcap.o if MSDOS && HAVE_X_WINDOWS.
MSDOS_X_OBJ =
-MSDOS_SUPPORT_REAL = $(lispsource)/ls-lisp.elc $(lispsource)/disp-table.elc \
- $(lispsource)/dos-fns.elc $(lispsource)/dos-w32.elc $(lispsource)/dos-vars.elc \
- $(lispsource)/term/internal.elc $(lispsource)/term/pc-win.elc
-## $MSDOS_SUPPORT_REAL if MSDOS.
-MSDOS_SUPPORT =
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@
-NS_SUPPORT=@NS_SUPPORT@
## Only set if NS_IMPL_GNUSTEP.
GNU_OBJC_CFLAGS=@GNU_OBJC_CFLAGS@
@@ -258,28 +259,7 @@ GNU_OBJC_CFLAGS=@GNU_OBJC_CFLAGS@
## else xfont.o
FONT_OBJ=@FONT_OBJ@
-## Used if HAVE_MOUSE.
-REAL_MOUSE_SUPPORT=$(lispsource)/mouse.elc $(lispsource)/select.elc \
- $(lispsource)/scroll-bar.elc
-## Used if HAVE_GPM && !HAVE_MOUSE
-GPM_MOUSE_SUPPORT=$(lispsource)/mouse.elc
LIBGPM = @LIBGPM@
-## Either of the two preceding options, or empty.
-MOUSE_SUPPORT=@MOUSE_SUPPORT@
-
-## $(lispsource)/tooltip.elc if HAVE_WINDOW_SYSTEM, else empty.
-TOOLTIP_SUPPORT=@TOOLTIP_SUPPORT@
-
-BASE_WINDOW_SUPPORT=$(lispsource)/fringe.elc $(lispsource)/image.elc \
- $(lispsource)/international/fontset.elc $(lispsource)/dnd.elc \
- $(lispsource)/tool-bar.elc $(lispsource)/mwheel.elc
-
-X_WINDOW_SUPPORT=$(lispsource)/x-dnd.elc $(lispsource)/term/common-win.elc \
- $(lispsource)/term/x-win.elc $(lispsource)/dynamic-setting.elc
-
-## If HAVE_X_WINDOWS, both the above
-## else if HAVE_WINDOW_SYSTEM (ie, HAVE_NS) just the former; else empty.
-WINDOW_SUPPORT=@WINDOW_SUPPORT@
## -lresolv, or empty.
LIBRESOLV = @LIBRESOLV@
@@ -289,6 +269,8 @@ LIBSELINUX_LIBS = @LIBSELINUX_LIBS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
+LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
+
INTERVALS_H = dispextern.h intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
@@ -325,7 +307,7 @@ ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I$(srcdir) \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(C_SWITCH_X_SYSTEM) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
- $(GCONF_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
+ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) $(PROFILING_CFLAGS) \
$(LIBGNUTLS_CFLAGS) \
$(C_WARNINGS_SWITCH) $(CFLAGS)
@@ -360,12 +342,16 @@ obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
## These go in the DOC file on all machines in case they are needed.
+## Some of them have no DOC entries, but it does no harm to have them
+## 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 \
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 $(FONT_OBJ)
+ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
+ w16select.o widget.o xfont.o ftfont.o xftfont.o ftxfont.o gtkutil.o \
+ xsettings.o xgselect.o termcap.o
## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty.
GMALLOC_OBJ=@GMALLOC_OBJ@
@@ -385,215 +371,10 @@ POST_ALLOC_OBJ=@POST_ALLOC_OBJ@
otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) \
$(POST_ALLOC_OBJ) $(VMLIMIT_OBJ) $(WIDGET_OBJ) $(LIBOBJS)
-## This is the platform-specific list of Lisp files loaded into the
-## dumped Emacs. It is arranged like this because it is easier to generate
-## it semi-mechanically from loadup.el this way.
-##
-## Note that this list should not include lisp files which might not
-## be present, like site-load.el and site-init.el; this makefile
-## expects them all to be either present or buildable.
-##
-## Files which are loaded unconditionally (i.e., on all platforms) should
-## also be in shortlisp. Files which are loaded conditionally (i.e., only
-## on some platforms) should instead be in SOME_MACHINE_LISP.
-##
-## Place loaddefs.el first, so it gets generated first, since it is on
-## the critical path (relevant in parallel compilations).
-lisp= \
- $(lispsource)/loaddefs.el \
- $(lispsource)/abbrev.elc \
- $(lispsource)/buff-menu.elc \
- $(lispsource)/button.elc \
- $(lispsource)/emacs-lisp/byte-run.elc \
- $(lispsource)/composite.elc \
- $(lispsource)/cus-face.elc \
- $(lispsource)/cus-start.elc \
- $(lispsource)/custom.elc \
- $(lispsource)/emacs-lisp/backquote.elc \
- $(lispsource)/emacs-lisp/lisp-mode.elc \
- $(lispsource)/emacs-lisp/lisp.elc \
- $(lispsource)/env.elc \
- $(lispsource)/faces.elc \
- $(lispsource)/files.elc \
- $(lispsource)/format.elc \
- $(lispsource)/facemenu.elc \
- $(MOUSE_SUPPORT) \
- $(lispsource)/emacs-lisp/float-sup.elc \
- $(lispsource)/frame.elc \
- $(lispsource)/help.elc \
- $(lispsource)/indent.elc \
- $(lispsource)/isearch.elc \
- $(lispsource)/rfn-eshadow.elc \
- $(lispsource)/loadup.el \
- $(lispsource)/bindings.elc \
- $(lispsource)/emacs-lisp/map-ynp.elc \
- $(lispsource)/menu-bar.elc \
- $(lispsource)/international/mule.elc \
- $(lispsource)/international/mule-conf.elc \
- $(lispsource)/international/mule-cmds.elc \
- $(lispsource)/international/characters.elc \
- $(lispsource)/international/charprop.el \
- $(lispsource)/case-table.elc \
- $(lispsource)/language/chinese.elc \
- $(lispsource)/language/cyrillic.elc \
- $(lispsource)/language/indian.elc \
- $(lispsource)/language/sinhala.el \
- $(lispsource)/language/english.el \
- $(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/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/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)/paths.el \
- $(lispsource)/register.elc \
- $(lispsource)/replace.elc \
- $(lispsource)/simple.elc \
- $(lispsource)/minibuffer.elc \
- $(lispsource)/startup.elc \
- $(lispsource)/subr.elc \
- $(lispsource)/term/tty-colors.elc \
- $(lispsource)/font-core.elc \
- $(lispsource)/emacs-lisp/syntax.elc \
- $(lispsource)/font-lock.elc \
- $(lispsource)/jit-lock.elc \
- $(lispsource)/textmodes/fill.elc \
- $(lispsource)/textmodes/page.elc \
- $(lispsource)/textmodes/paragraphs.elc \
- $(lispsource)/textmodes/text-mode.elc \
- $(lispsource)/emacs-lisp/timer.elc \
- $(lispsource)/jka-cmpr-hook.elc \
- $(lispsource)/vc/vc-hooks.elc \
- $(lispsource)/vc/ediff-hook.elc \
- $(lispsource)/epa-hook.elc \
- $(TOOLTIP_SUPPORT) \
- $(MSDOS_SUPPORT) \
- $(WINDOW_SUPPORT) \
- $(NS_SUPPORT) \
- $(lispsource)/widget.elc \
- $(lispsource)/window.elc \
- $(lispsource)/version.el
-
-## List of relative names for those files from $lisp that are loaded
-## unconditionally (i.e. on all platforms). Files from $lisp that
-## are only loaded on some platforms should instead be placed in
-## SOME_MACHINE_LISP. The only reason this variable exists is to prevent
-## the make-docfile command-line getting too long for some systems.
-shortlisp= \
- ../lisp/loaddefs.el \
- ../lisp/abbrev.elc \
- ../lisp/buff-menu.elc \
- ../lisp/button.elc \
- ../lisp/emacs-lisp/byte-run.elc \
- ../lisp/composite.elc \
- ../lisp/cus-face.elc \
- ../lisp/cus-start.elc \
- ../lisp/custom.elc \
- ../lisp/emacs-lisp/backquote.elc \
- ../lisp/emacs-lisp/lisp-mode.elc \
- ../lisp/emacs-lisp/lisp.elc \
- ../lisp/facemenu.elc \
- ../lisp/faces.elc \
- ../lisp/files.elc \
- ../lisp/emacs-lisp/float-sup.elc \
- ../lisp/format.elc \
- ../lisp/frame.elc \
- ../lisp/help.elc \
- ../lisp/indent.elc \
- ../lisp/isearch.elc \
- ../lisp/rfn-eshadow.elc \
- ../lisp/loadup.el \
- ../lisp/bindings.elc \
- ../lisp/emacs-lisp/map-ynp.elc \
- ../lisp/env.elc \
- ../lisp/international/mule.elc \
- ../lisp/international/mule-conf.elc \
- ../lisp/international/mule-cmds.elc \
- ../lisp/international/characters.elc \
- ../lisp/case-table.elc \
- ../lisp/language/chinese.elc \
- ../lisp/language/cyrillic.elc \
- ../lisp/language/indian.elc \
- ../lisp/language/sinhala.el \
- ../lisp/language/english.el \
- ../lisp/language/ethiopic.elc \
- ../lisp/language/european.elc \
- ../lisp/language/czech.el \
- ../lisp/language/slovak.el \
- ../lisp/language/romanian.el \
- ../lisp/language/greek.el \
- ../lisp/language/hebrew.elc \
- ../lisp/language/japanese.el \
- ../lisp/language/korean.el \
- ../lisp/language/lao.el \
- ../lisp/language/cham.el \
- ../lisp/language/tai-viet.el \
- ../lisp/language/thai.el \
- ../lisp/language/tibetan.elc \
- ../lisp/language/vietnamese.elc \
- ../lisp/language/misc-lang.el \
- ../lisp/language/utf-8-lang.el \
- ../lisp/language/georgian.el \
- ../lisp/language/khmer.el \
- ../lisp/language/burmese.el \
- ../lisp/menu-bar.elc \
- ../lisp/paths.el \
- ../lisp/register.elc \
- ../lisp/replace.elc \
- ../lisp/simple.elc \
- ../lisp/minibuffer.elc \
- ../lisp/startup.elc \
- ../lisp/subr.elc \
- ../lisp/term/tty-colors.elc \
- ../lisp/font-core.elc \
- ../lisp/emacs-lisp/syntax.elc \
- ../lisp/font-lock.elc \
- ../lisp/jit-lock.elc \
- ../lisp/textmodes/fill.elc \
- ../lisp/textmodes/page.elc \
- ../lisp/textmodes/paragraphs.elc \
- ../lisp/textmodes/text-mode.elc \
- ../lisp/emacs-lisp/timer.elc \
- ../lisp/vc/vc-hooks.elc \
- ../lisp/vc/ediff-hook.elc \
- ../lisp/jka-cmpr-hook.elc \
- ../lisp/epa-hook.elc \
- ../lisp/widget.elc \
- ../lisp/window.elc \
- ../lisp/version.el
-
-## Like $shortlisp, but includes only those files from $lisp that are loaded
-## conditionally (i.e., only on some platforms).
-## Confusingly, term/internal is not in loadup, but is unconditionally
-## loaded by pc-win, which is.
-SOME_MACHINE_LISP = ../lisp/mouse.elc \
- ../lisp/select.elc ../lisp/scroll-bar.elc \
- ../lisp/ls-lisp.elc ../lisp/dos-fns.elc \
- ../lisp/w32-fns.elc ../lisp/dos-w32.elc \
- ../lisp/disp-table.elc ../lisp/dos-vars.elc ../lisp/w32-vars.elc \
- ../lisp/tooltip.elc ../lisp/image.elc \
- ../lisp/fringe.elc ../lisp/dnd.elc \
- ../lisp/mwheel.elc ../lisp/tool-bar.elc \
- ../lisp/x-dnd.elc ../lisp/dynamic-setting.elc \
- ../lisp/international/fontset.elc \
- ../lisp/term/common-win.elc \
- ../lisp/term/x-win.elc \
- ../lisp/term/pc-win.elc ../lisp/term/internal.elc \
- ../lisp/term/ns-win.elc ../lisp/term/w32-win.elc
+
+## Configure inserts the file lisp.mk at this point, defining $lisp.
+@lisp_frag@
+
## Construct full set of libraries to be linked.
## Note that SunOS needs -lm to come before -lc; otherwise, you get
@@ -602,9 +383,9 @@ SOME_MACHINE_LISP = ../lisp/mouse.elc \
LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \
$(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(DBUS_LIBS) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
- $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(GCONF_LIBS) $(LIBSELINUX_LIBS) \
+ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
- $(LIBGNUTLS_LIBS) \
+ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD_SIGMASK) \
$(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
all: emacs$(EXEEXT) $(OTHER_FILES)
@@ -612,6 +393,9 @@ all: emacs$(EXEEXT) $(OTHER_FILES)
## 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)
if test "$(CANNOT_DUMP)" = "yes"; then \
ln -f temacs$(EXEEXT) emacs$(EXEEXT); \
@@ -624,22 +408,23 @@ emacs$(EXEEXT): temacs$(EXEEXT) $(etc)/DOC $(lisp)
fi
## We run make-docfile twice because the command line may get too long
-## on some systems.
+## on some systems. The sed command operating on lisp.mk also reduces
+## the length of the command line. Unfortunately, no-one has any idea
+## exactly how long the maximum safe command line length is on all the
+## various systems that Emacs supports. Obviously, the length depends
+## on what your value of $srcdir is. If the length restriction goes
+## away, lisp.mk can be merged back into this file.
+##
## $(SOME_MACHINE_OBJECTS) comes before $(obj) because some files may
## or may not be included in $(obj), but they are always included in
## $(SOME_MACHINE_OBJECTS). Since a file is processed when it is mentioned
## for the first time, this prevents any variation between configurations
## in the contents of the DOC file.
-## Likewise for $(SOME_MACHINE_LISP).
-## Most of this Makefile refers to Lisp files via $(lispsource), so
-## we also use $(lisp) rather than $(shortlisp) for the dependency since
-## the Makefile uses string equality to decide when we talk about identical
-## files. Apparently we pass $(shortlisp) rather than $(lisp) to make-docfile
-## only in order to reduce the command line length. --Stef
-$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp) $(SOME_MACHINE_LISP)
+##
+$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp)
-rm -f $(etc)/DOC
$(libsrc)/make-docfile -d $(srcdir) $(SOME_MACHINE_OBJECTS) $(obj) > $(etc)/DOC
- $(libsrc)/make-docfile -a $(etc)/DOC -d $(srcdir) $(SOME_MACHINE_LISP) $(shortlisp)
+ $(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) `sed -n -e 's| \\\\||' -e 's|^[ ]*$$(lispsource)/||p' $(srcdir)/lisp.mk`
$(libsrc)/make-docfile$(EXEEXT):
cd $(libsrc); $(MAKE) $(MFLAGS) make-docfile$(EXEEXT)
@@ -797,7 +582,7 @@ tags: TAGS TAGS-LISP $(lwlibdir)/TAGS
THEFILE=$< EMACS=$(bootstrap_exe)
## Since the .el.elc rule cannot specify an extra dependency, we do it here.
-$(lisp) $(SOME_MACHINE_LISP): $(BOOTSTRAPEMACS)
+$(lisp): $(BOOTSTRAPEMACS)
## VCSWITNESS points to the file that holds info about the current checkout.
## We use it as a heuristic to decide when to rebuild loaddefs.el.
diff --git a/src/alloc.c b/src/alloc.c
index 0bce83bfae7..44f935c243d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -22,10 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
-#ifdef ALLOC_DEBUG
-#undef INLINE
-#endif
-
#include <signal.h>
#ifdef HAVE_GTK_AND_PTHREAD
@@ -161,7 +157,7 @@ struct emacs_globals globals;
/* Number of bytes of consing done since the last gc. */
-int consing_since_gc;
+EMACS_INT consing_since_gc;
/* Similar minimum, computed from Vgc_cons_percentage. */
@@ -184,9 +180,9 @@ int abort_on_gc;
/* Number of live and free conses etc. */
-static int total_conses, total_markers, total_symbols, total_vector_size;
-static int total_free_conses, total_free_markers, total_free_symbols;
-static int total_free_floats, total_floats;
+static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
+static EMACS_INT total_free_floats, total_floats;
/* Points to memory space allocated as "spare", to be freed if we run
out of memory. We keep one large block, four cons-blocks, and
@@ -194,11 +190,10 @@ static int total_free_floats, total_floats;
static char *spare_memory[7];
-#ifndef SYSTEM_MALLOC
-/* Amount of spare memory to keep in large reserve block. */
+/* Amount of spare memory to keep in large reserve block, or to see
+ whether this much is available when malloc fails on a larger request. */
#define SPARE_MEMORY (1 << 14)
-#endif
/* Number of extra blocks malloc should get when it needs more core. */
@@ -408,7 +403,7 @@ static void mem_rotate_left (struct mem_node *);
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
-static INLINE struct mem_node *mem_find (void *);
+static inline struct mem_node *mem_find (void *);
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
@@ -471,7 +466,7 @@ display_malloc_warning (void)
/* Called if we can't allocate relocatable space for a buffer. */
void
-buffer_memory_full (void)
+buffer_memory_full (EMACS_INT nbytes)
{
/* If buffers use the relocating allocator, no need to free
spare_memory, because we may have plenty of malloc space left
@@ -481,7 +476,7 @@ buffer_memory_full (void)
malloc. */
#ifndef REL_ALLOC
- memory_full ();
+ memory_full (nbytes);
#endif
/* This used to call error, but if we've run out of memory, we could
@@ -490,7 +485,9 @@ buffer_memory_full (void)
}
-#ifdef XMALLOC_OVERRUN_CHECK
+#ifndef XMALLOC_OVERRUN_CHECK
+#define XMALLOC_OVERRUN_CHECK_SIZE 0
+#else
/* Check for overrun in malloc'ed buffers by wrapping a 16 byte header
and a 16 byte trailer around each block.
@@ -677,7 +674,7 @@ xmalloc (size_t size)
MALLOC_UNBLOCK_INPUT;
if (!val && size)
- memory_full ();
+ memory_full (size);
return val;
}
@@ -698,7 +695,8 @@ xrealloc (POINTER_TYPE *block, size_t size)
val = (POINTER_TYPE *) realloc (block, size);
MALLOC_UNBLOCK_INPUT;
- if (!val && size) memory_full ();
+ if (!val && size)
+ memory_full (size);
return val;
}
@@ -791,7 +789,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
- memory_full ();
+ memory_full (nbytes);
return val;
}
@@ -938,7 +936,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
if (base == 0)
{
MALLOC_UNBLOCK_INPUT;
- memory_full ();
+ memory_full (ABLOCKS_BYTES);
}
aligned = (base == abase);
@@ -964,7 +962,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
lisp_malloc_loser = base;
free (base);
MALLOC_UNBLOCK_INPUT;
- memory_full ();
+ memory_full (SIZE_MAX);
}
}
#endif
@@ -993,13 +991,11 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
free_ablock = free_ablock->x.next_free;
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
- if (val && type != MEM_TYPE_NON_LISP)
+ if (type != MEM_TYPE_NON_LISP)
mem_insert (val, (char *) val + nbytes, type);
#endif
MALLOC_UNBLOCK_INPUT;
- if (!val && nbytes)
- memory_full ();
eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
return val;
@@ -1262,7 +1258,7 @@ emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
calls malloc because it is the first call, and we have an endless loop. */
void
-reset_malloc_hooks ()
+reset_malloc_hooks (void)
{
__free_hook = old_free_hook;
__malloc_hook = old_malloc_hook;
@@ -1342,16 +1338,12 @@ static int interval_block_index;
/* Number of free and live intervals. */
-static int total_free_intervals, total_intervals;
+static EMACS_INT total_free_intervals, total_intervals;
/* List of free intervals. */
static INTERVAL interval_free_list;
-/* Total number of interval blocks now in use. */
-
-static int n_interval_blocks;
-
/* Initialize interval allocation. */
@@ -1361,7 +1353,6 @@ init_intervals (void)
interval_block = NULL;
interval_block_index = INTERVAL_BLOCK_SIZE;
interval_free_list = 0;
- n_interval_blocks = 0;
}
@@ -1393,7 +1384,6 @@ make_interval (void)
newi->next = interval_block;
interval_block = newi;
interval_block_index = 0;
- n_interval_blocks++;
}
val = &interval_block->intervals[interval_block_index++];
}
@@ -1586,10 +1576,9 @@ static struct sblock *oldest_sblock, *current_sblock;
static struct sblock *large_sblocks;
-/* List of string_block structures, and how many there are. */
+/* List of string_block structures. */
static struct string_block *string_blocks;
-static int n_string_blocks;
/* Free-list of Lisp_Strings. */
@@ -1597,7 +1586,7 @@ static struct Lisp_String *string_free_list;
/* Number of live and free Lisp_Strings. */
-static int total_strings, total_free_strings;
+static EMACS_INT total_strings, total_free_strings;
/* Number of bytes used by live strings. */
@@ -1665,6 +1654,18 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
#define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE)
+/* Exact bound on the number of bytes in a string, not counting the
+ terminating null. A string cannot contain more bytes than
+ 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_SIZE - 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
@@ -1673,7 +1674,6 @@ init_strings (void)
total_strings = total_free_strings = total_string_size = 0;
oldest_sblock = current_sblock = large_sblocks = NULL;
string_blocks = NULL;
- n_string_blocks = 0;
string_free_list = NULL;
empty_unibyte_string = make_pure_string ("", 0, 0, 0);
empty_multibyte_string = make_pure_string ("", 0, 0, 1);
@@ -1805,7 +1805,6 @@ allocate_string (void)
memset (b, 0, sizeof *b);
b->next = string_blocks;
string_blocks = b;
- ++n_string_blocks;
for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
{
@@ -1864,6 +1863,9 @@ allocate_string_data (struct Lisp_String *s,
struct sblock *b;
EMACS_INT needed, old_nbytes;
+ if (STRING_BYTES_MAX < nbytes)
+ string_overflow ();
+
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
@@ -2031,7 +2033,6 @@ sweep_strings (void)
&& total_free_strings > STRING_BLOCK_SIZE)
{
lisp_free (b);
- --n_string_blocks;
string_free_list = free_list_before;
}
else
@@ -2174,6 +2175,11 @@ compact_small_strings (void)
current_sblock = tb;
}
+void
+string_overflow (void)
+{
+ error ("Maximum string size exceeded");
+}
DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
doc: /* Return a newly created string of length LENGTH, with INIT in each element.
@@ -2187,9 +2193,9 @@ INIT must be an integer that represents a character. */)
EMACS_INT nbytes;
CHECK_NATNUM (length);
- CHECK_NUMBER (init);
+ CHECK_CHARACTER (init);
- c = XINT (init);
+ c = XFASTINT (init);
if (ASCII_CHAR_P (c))
{
nbytes = XINT (length);
@@ -2205,8 +2211,8 @@ INIT must be an integer that represents a character. */)
int len = CHAR_STRING (c, str);
EMACS_INT string_len = XINT (length);
- if (string_len > MOST_POSITIVE_FIXNUM / len)
- error ("Maximum string size exceeded");
+ if (string_len > STRING_BYTES_MAX / len)
+ string_overflow ();
nbytes = len * string_len;
val = make_uninit_multibyte_string (string_len, nbytes);
p = SDATA (val);
@@ -2230,7 +2236,6 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- int real_init, i;
EMACS_INT length_in_chars, length_in_elts;
int bits_per_value;
@@ -2252,14 +2257,14 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
- real_init = (NILP (init) ? 0 : -1);
- for (i = 0; i < length_in_chars ; i++)
- p->data[i] = real_init;
+ if (length_in_chars)
+ {
+ memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
- /* Clear the extraneous bits in the last byte. */
- if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
- p->data[length_in_chars - 1]
- &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ /* Clear any extraneous bits in the last byte. */
+ p->data[length_in_chars - 1]
+ &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ }
return val;
}
@@ -2464,10 +2469,6 @@ static struct float_block *float_block;
static int float_block_index;
-/* Total number of float blocks now in use. */
-
-static int n_float_blocks;
-
/* Free-list of Lisp_Floats. */
static struct Lisp_Float *float_free_list;
@@ -2481,7 +2482,6 @@ init_float (void)
float_block = NULL;
float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
float_free_list = 0;
- n_float_blocks = 0;
}
@@ -2515,7 +2515,6 @@ make_float (double float_value)
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
float_block = new;
float_block_index = 0;
- n_float_blocks++;
}
XSETFLOAT (val, &float_block->floats[float_block_index]);
float_block_index++;
@@ -2580,10 +2579,6 @@ static int cons_block_index;
static struct Lisp_Cons *cons_free_list;
-/* Total number of cons blocks now in use. */
-
-static int n_cons_blocks;
-
/* Initialize cons allocation. */
@@ -2593,7 +2588,6 @@ init_cons (void)
cons_block = NULL;
cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
cons_free_list = 0;
- n_cons_blocks = 0;
}
@@ -2637,7 +2631,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
new->next = cons_block;
cons_block = new;
cons_block_index = 0;
- n_cons_blocks++;
}
XSETCONS (val, &cons_block->conses[cons_block_index]);
cons_block_index++;
@@ -2706,7 +2699,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0,
doc: /* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (list &rest OBJECTS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object val;
val = Qnil;
@@ -2776,10 +2769,12 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
static struct Lisp_Vector *all_vectors;
-/* Total number of vector-like objects now in use. */
-
-static int n_vectors;
-
+/* Handy constants for vectorlike objects. */
+enum
+ {
+ header_size = offsetof (struct Lisp_Vector, contents),
+ word_size = sizeof (Lisp_Object)
+ };
/* Value is a pointer to a newly allocated Lisp_Vector structure
with room for LEN Lisp_Objects. */
@@ -2802,8 +2797,7 @@ allocate_vectorlike (EMACS_INT len)
/* This gets triggered by code which I haven't bothered to fix. --Stef */
/* eassert (!handling_signal); */
- nbytes = (offsetof (struct Lisp_Vector, contents)
- + len * sizeof p->contents[0]);
+ nbytes = header_size + len * word_size;
p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
#ifdef DOUG_LEA_MALLOC
@@ -2819,18 +2813,22 @@ allocate_vectorlike (EMACS_INT len)
MALLOC_UNBLOCK_INPUT;
- ++n_vectors;
return p;
}
-/* Allocate a vector with NSLOTS slots. */
+/* Allocate a vector with LEN slots. */
struct Lisp_Vector *
-allocate_vector (EMACS_INT nslots)
+allocate_vector (EMACS_INT len)
{
- struct Lisp_Vector *v = allocate_vectorlike (nslots);
- v->header.size = nslots;
+ struct Lisp_Vector *v;
+ ptrdiff_t nbytes_max = min (PTRDIFF_MAX, SIZE_MAX);
+
+ if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len)
+ memory_full (SIZE_MAX);
+ v = allocate_vectorlike (len);
+ v->header.size = len;
return v;
}
@@ -2841,7 +2839,7 @@ struct Lisp_Vector *
allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
- EMACS_INT i;
+ int i;
/* Only the first lisplen slots will be traced normally by the GC. */
for (i = 0; i < lisplen; ++i)
@@ -2922,10 +2920,10 @@ DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (vector &rest OBJECTS) */)
- (register size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register size_t i;
+ ptrdiff_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
@@ -2953,15 +2951,15 @@ argument to catch the left-over arguments. If such an integer is used, the
arguments will not be dynamically bound but will be instead pushed on the
stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
- (register size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register size_t i;
+ ptrdiff_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
if (!NILP (Vpurify_flag))
- val = make_pure_vector ((EMACS_INT) nargs);
+ val = make_pure_vector (nargs);
else
val = Fmake_vector (len, Qnil);
@@ -3015,10 +3013,6 @@ static int symbol_block_index;
static struct Lisp_Symbol *symbol_free_list;
-/* Total number of symbol blocks now in use. */
-
-static int n_symbol_blocks;
-
/* Initialize symbol allocation. */
@@ -3028,7 +3022,6 @@ init_symbol (void)
symbol_block = NULL;
symbol_block_index = SYMBOL_BLOCK_SIZE;
symbol_free_list = 0;
- n_symbol_blocks = 0;
}
@@ -3061,7 +3054,6 @@ Its value and function definition are void, and its property list is nil. */)
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
- n_symbol_blocks++;
}
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
symbol_block_index++;
@@ -3109,17 +3101,12 @@ static int marker_block_index;
static union Lisp_Misc *marker_free_list;
-/* Total number of marker blocks now in use. */
-
-static int n_marker_blocks;
-
static void
init_marker (void)
{
marker_block = NULL;
marker_block_index = MARKER_BLOCK_SIZE;
marker_free_list = 0;
- n_marker_blocks = 0;
}
/* Return a newly allocated Lisp_Misc object, with no substructure. */
@@ -3148,7 +3135,6 @@ allocate_misc (void)
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
- n_marker_blocks++;
total_free_markers += MARKER_BLOCK_SIZE;
}
XSETMISC (val, &marker_block->markers[marker_block_index]);
@@ -3181,7 +3167,7 @@ free_misc (Lisp_Object misc)
The unwind function can get the C values back using XSAVE_VALUE. */
Lisp_Object
-make_save_value (void *pointer, int integer)
+make_save_value (void *pointer, ptrdiff_t integer)
{
register Lisp_Object val;
register struct Lisp_Save_Value *p;
@@ -3239,7 +3225,7 @@ make_event_array (register int nargs, Lisp_Object *args)
are characters that are in 0...127,
after discarding the meta bit and all the bits above it. */
if (!INTEGERP (args[i])
- || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200)
+ || (XINT (args[i]) & ~(-CHAR_META)) >= 0200)
return Fvector (nargs, args);
/* Since the loop exited, we know that all the things in it are
@@ -3267,35 +3253,55 @@ make_event_array (register int nargs, Lisp_Object *args)
************************************************************************/
-/* Called if malloc returns zero. */
+/* Called if malloc (NBYTES) returns zero. If NBYTES == SIZE_MAX,
+ there may have been size_t overflow so that malloc was never
+ called, or perhaps malloc was invoked successfully but the
+ resulting pointer had problems fitting into a tagged EMACS_INT. In
+ either case this counts as memory being full even though malloc did
+ not fail. */
void
-memory_full (void)
+memory_full (size_t nbytes)
{
- int i;
+ /* Do not go into hysterics merely because a large request failed. */
+ int enough_free_memory = 0;
+ if (SPARE_MEMORY < nbytes)
+ {
+ void *p = malloc (SPARE_MEMORY);
+ if (p)
+ {
+ free (p);
+ enough_free_memory = 1;
+ }
+ }
- Vmemory_full = Qt;
+ if (! enough_free_memory)
+ {
+ int i;
- memory_full_cons_threshold = sizeof (struct cons_block);
+ Vmemory_full = Qt;
- /* The first time we get here, free the spare memory. */
- for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++)
- if (spare_memory[i])
- {
- if (i == 0)
- free (spare_memory[i]);
- else if (i >= 1 && i <= 4)
- lisp_align_free (spare_memory[i]);
- else
- lisp_free (spare_memory[i]);
- spare_memory[i] = 0;
- }
+ memory_full_cons_threshold = sizeof (struct cons_block);
+
+ /* The first time we get here, free the spare memory. */
+ for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++)
+ if (spare_memory[i])
+ {
+ if (i == 0)
+ free (spare_memory[i]);
+ else if (i >= 1 && i <= 4)
+ lisp_align_free (spare_memory[i]);
+ else
+ lisp_free (spare_memory[i]);
+ spare_memory[i] = 0;
+ }
- /* Record the space now used. When it decreases substantially,
- we can refill the memory reserve. */
+ /* 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;
+ bytes_used_when_full = BYTES_USED;
#endif
+ }
/* This used to call error, but if we've run out of memory, we could
get infinite recursion trying to build the string. */
@@ -3371,7 +3377,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 inline struct mem_node *
mem_find (void *start)
{
struct mem_node *p;
@@ -3747,7 +3753,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 inline int
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
@@ -3770,7 +3776,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 inline int
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
@@ -3796,7 +3802,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 inline int
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
@@ -3822,7 +3828,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 inline int
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
@@ -3846,7 +3852,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 inline int
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
@@ -3872,7 +3878,7 @@ live_misc_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_vector_p (struct mem_node *m, void *p)
{
return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
@@ -3882,7 +3888,7 @@ live_vector_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
@@ -3906,11 +3912,11 @@ static Lisp_Object zombies[MAX_ZOMBIES];
/* Number of zombie objects. */
-static int nzombies;
+static EMACS_INT nzombies;
/* Number of garbage collections. */
-static int ngcs;
+static EMACS_INT ngcs;
/* Average percentage of zombies per collection. */
@@ -3918,7 +3924,7 @@ static double avg_zombies;
/* Max. number of live and zombie objects. */
-static int max_live, max_zombies;
+static EMACS_INT max_live, max_zombies;
/* Average number of live objects per GC. */
@@ -3929,7 +3935,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
(void)
{
Lisp_Object args[8], zombie_list = Qnil;
- int i;
+ EMACS_INT i;
for (i = 0; i < nzombies; i++)
zombie_list = Fcons (zombies[i], zombie_list);
args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
@@ -3948,7 +3954,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 inline void
mark_maybe_object (Lisp_Object obj)
{
void *po;
@@ -4017,7 +4023,7 @@ mark_maybe_object (Lisp_Object obj)
/* If P points to Lisp data, mark that as live if it isn't already
marked. */
-static INLINE void
+static inline void
mark_maybe_pointer (void *p)
{
struct mem_node *m;
@@ -4239,7 +4245,7 @@ static void
check_gcpros (void)
{
struct gcpro *p;
- size_t i;
+ ptrdiff_t i;
for (p = gcprolist; p; p = p->next)
for (i = 0; i < p->nvars; ++i)
@@ -4256,7 +4262,7 @@ dump_zombies (void)
{
int i;
- fprintf (stderr, "\nZombies kept alive = %d:\n", nzombies);
+ fprintf (stderr, "\nZombies kept alive = %"pI":\n", nzombies);
for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i)
{
fprintf (stderr, " %d = ", i);
@@ -4828,9 +4834,8 @@ int
inhibit_garbage_collection (void)
{
int count = SPECPDL_INDEX ();
- int nbits = min (VALBITS, BITS_PER_INT);
- specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));
+ specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
return count;
}
@@ -4850,7 +4855,7 @@ returns nil, because real GC can't be done. */)
{
register struct specbinding *bind;
char stack_top_variable;
- register size_t i;
+ ptrdiff_t i;
int message_p;
Lisp_Object total[8];
int count = SPECPDL_INDEX ();
@@ -5080,9 +5085,10 @@ returns nil, because real GC can't be done. */)
if (gc_cons_threshold < 10000)
gc_cons_threshold = 10000;
+ gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- EMACS_INT tot = 0;
+ double tot = 0;
tot += total_conses * sizeof (struct Lisp_Cons);
tot += total_symbols * sizeof (struct Lisp_Symbol);
@@ -5093,10 +5099,15 @@ returns nil, because real GC can't be done. */)
tot += total_intervals * sizeof (struct interval);
tot += total_strings * sizeof (struct Lisp_String);
- gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage);
+ tot *= XFLOAT_DATA (Vgc_cons_percentage);
+ if (0 < tot)
+ {
+ if (tot < TYPE_MAXIMUM (EMACS_INT))
+ gc_relative_threshold = tot;
+ else
+ gc_relative_threshold = TYPE_MAXIMUM (EMACS_INT);
+ }
}
- else
- gc_relative_threshold = 0;
if (garbage_collection_messages)
{
@@ -5227,8 +5238,8 @@ static size_t mark_object_loop_halt;
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- register EMACS_UINT size = ptr->header.size;
- register EMACS_UINT i;
+ EMACS_INT size = ptr->header.size;
+ EMACS_INT i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr); /* Else mark it */
@@ -5250,8 +5261,8 @@ mark_vectorlike (struct Lisp_Vector *ptr)
static void
mark_char_table (struct Lisp_Vector *ptr)
{
- register EMACS_UINT size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
- register EMACS_UINT i;
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr);
@@ -5379,12 +5390,11 @@ mark_object (Lisp_Object arg)
recursion there. */
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_UINT size = ptr->header.size;
- register EMACS_UINT i;
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
- size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++) /* and then mark its elements */
{
if (i != COMPILED_CONSTANTS)
@@ -5511,7 +5521,7 @@ mark_object (Lisp_Object arg)
if (ptr->dogc)
{
Lisp_Object *p = (Lisp_Object *) ptr->pointer;
- int nelt;
+ ptrdiff_t nelt;
for (nelt = ptr->integer; nelt > 0; nelt--, p++)
mark_maybe_object (*p);
}
@@ -5609,7 +5619,8 @@ mark_buffer (Lisp_Object buf)
/* 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);
- (char *)ptr < (char *)buffer + sizeof (struct buffer);
+ ptr <= &PER_BUFFER_VALUE (buffer,
+ PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER));
ptr++)
mark_object (*ptr);
@@ -5711,7 +5722,7 @@ gc_sweep (void)
register struct cons_block *cblk;
struct cons_block **cprev = &cons_block;
register int lim = cons_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
cons_free_list = 0;
@@ -5722,7 +5733,7 @@ gc_sweep (void)
int ilim = (lim + BITS_PER_INT - 1) / BITS_PER_INT;
/* Scan the mark bits an int at a time. */
- for (i = 0; i <= ilim; i++)
+ for (i = 0; i < ilim; i++)
{
if (cblk->gcmarkbits[i] == -1)
{
@@ -5772,7 +5783,6 @@ gc_sweep (void)
/* Unhook from the free list. */
cons_free_list = cblk->conses[0].u.chain;
lisp_align_free (cblk);
- n_cons_blocks--;
}
else
{
@@ -5789,7 +5799,7 @@ gc_sweep (void)
register struct float_block *fblk;
struct float_block **fprev = &float_block;
register int lim = float_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
float_free_list = 0;
@@ -5819,7 +5829,6 @@ gc_sweep (void)
/* Unhook from the free list. */
float_free_list = fblk->floats[0].u.chain;
lisp_align_free (fblk);
- n_float_blocks--;
}
else
{
@@ -5836,7 +5845,7 @@ gc_sweep (void)
register struct interval_block *iblk;
struct interval_block **iprev = &interval_block;
register int lim = interval_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
interval_free_list = 0;
@@ -5869,7 +5878,6 @@ gc_sweep (void)
/* Unhook from the free list. */
interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]);
lisp_free (iblk);
- n_interval_blocks--;
}
else
{
@@ -5886,7 +5894,7 @@ gc_sweep (void)
register struct symbol_block *sblk;
struct symbol_block **sprev = &symbol_block;
register int lim = symbol_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
symbol_free_list = NULL;
@@ -5933,7 +5941,6 @@ gc_sweep (void)
/* Unhook from the free list. */
symbol_free_list = sblk->symbols[0].next;
lisp_free (sblk);
- n_symbol_blocks--;
}
else
{
@@ -5951,7 +5958,7 @@ gc_sweep (void)
register struct marker_block *mblk;
struct marker_block **mprev = &marker_block;
register int lim = marker_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
marker_free_list = 0;
@@ -5990,7 +5997,6 @@ gc_sweep (void)
/* Unhook from the free list. */
marker_free_list = mblk->markers[0].u_free.chain;
lisp_free (mblk);
- n_marker_blocks--;
}
else
{
@@ -6040,7 +6046,6 @@ gc_sweep (void)
all_vectors = vector->header.next.vector;
next = vector->header.next.vector;
lisp_free (vector);
- n_vectors--;
vector = next;
}
@@ -6247,8 +6252,7 @@ do hash-consing of the objects allocated to pure space. */);
DEFVAR_LISP ("post-gc-hook", Vpost_gc_hook,
doc: /* Hook run after garbage collection has finished. */);
Vpost_gc_hook = Qnil;
- Qpost_gc_hook = intern_c_string ("post-gc-hook");
- staticpro (&Qpost_gc_hook);
+ DEFSYM (Qpost_gc_hook, "post-gc-hook");
DEFVAR_LISP ("memory-signal-data", Vmemory_signal_data,
doc: /* Precomputed `signal' argument for memory-full error. */);
@@ -6262,11 +6266,8 @@ do hash-consing of the objects allocated to pure space. */);
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil;
- staticpro (&Qgc_cons_threshold);
- Qgc_cons_threshold = intern_c_string ("gc-cons-threshold");
-
- staticpro (&Qchar_table_extra_slots);
- Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
+ DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
+ DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
DEFVAR_LISP ("gc-elapsed", Vgc_elapsed,
doc: /* Accumulated time elapsed in garbage collections.
diff --git a/src/bidi.c b/src/bidi.c
index 3bee2009a0e..77043d9236f 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -1134,10 +1134,6 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
|| type == LRE || type == LRO));
type = bidi_get_type (ch, NEUTRAL_DIR))
{
- if (!string_p
- && type == NEUTRAL_B
- && bidi_at_paragraph_end (pos, bytepos) >= -1)
- break;
if (pos >= end)
{
/* Pretend there's a paragraph separator at end of
@@ -1145,6 +1141,10 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
type = NEUTRAL_B;
break;
}
+ if (!string_p
+ && type == NEUTRAL_B
+ && bidi_at_paragraph_end (pos, bytepos) >= -1)
+ break;
/* Fetch next character and advance to get past it. */
ch = bidi_fetch_char (bytepos, pos, &disp_pos, &bidi_it->string,
bidi_it->frame_window_p, &ch_len, &nchars);
diff --git a/src/buffer.c b/src/buffer.c
index 05bd129976f..81c537b9c6a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -27,6 +27,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <setjmp.h>
#include <unistd.h>
+#include <verify.h>
+
#include "lisp.h"
#include "intervals.h"
#include "window.h"
@@ -92,6 +94,11 @@ static Lisp_Object Vbuffer_local_symbols;
#define PER_BUFFER_SYMBOL(OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) &buffer_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)))
+
/* Flags indicating which built-in buffer-local variables
are permanent locals. */
static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
@@ -131,12 +138,14 @@ static Lisp_Object Qprotected_field;
static Lisp_Object QSFundamental; /* A string "Fundamental" */
static Lisp_Object Qkill_buffer_hook;
+static Lisp_Object Qbuffer_list_update_hook;
static Lisp_Object Qget_file_buffer;
static Lisp_Object Qoverlayp;
Lisp_Object Qpriority, Qbefore_string, Qafter_string;
+
static Lisp_Object Qevaporate;
Lisp_Object Qmodification_hooks;
@@ -171,9 +180,9 @@ Value is nil if OBJECT is not a buffer or if it has been killed. */)
DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
doc: /* Return a list of all existing live buffers.
-If the optional arg FRAME is a frame, we return the buffer list
-in the proper order for that frame: the buffers in FRAME's `buffer-list'
-frame parameter come first, followed by the rest of the buffers. */)
+If the optional arg FRAME is a frame, we return the buffer list in the
+proper order for that frame: the buffers show in FRAME come first,
+followed by the rest of the buffers. */)
(Lisp_Object frame)
{
Lisp_Object general;
@@ -185,9 +194,9 @@ frame parameter come first, followed by the rest of the buffers. */)
Lisp_Object args[3];
CHECK_FRAME (frame);
-
framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
- prevlist = Fnreverse (Fcopy_sequence (XFRAME (frame)->buried_buffer_list));
+ prevlist = Fnreverse (Fcopy_sequence
+ (XFRAME (frame)->buried_buffer_list));
/* Remove from GENERAL any buffer that duplicates one in
FRAMELIST or PREVLIST. */
@@ -209,8 +218,8 @@ frame parameter come first, followed by the rest of the buffers. */)
args[2] = prevlist;
return Fnconc (3, args);
}
-
- return general;
+ else
+ return general;
}
/* Like Fassoc, but use Fstring_equal to compare
@@ -328,7 +337,7 @@ even if it is dead. The return value is never nil. */)
alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
UNBLOCK_INPUT;
if (! BUF_BEG_ADDR (b))
- buffer_memory_full ();
+ buffer_memory_full (BUF_GAP_SIZE (b) + 1);
b->pt = BEG;
b->begv = BEG;
@@ -352,6 +361,7 @@ even if it is dead. The return value is never nil. */)
BUF_END_UNCHANGED (b) = 0;
BUF_BEG_UNCHANGED (b) = 0;
*(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
+ b->text->inhibit_shrinking = 0;
b->newline_cache = 0;
b->width_run_cache = 0;
@@ -384,6 +394,9 @@ even if it is dead. The return value is never nil. */)
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
+ /* And run buffer-list-update-hook. */
+ 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
@@ -459,8 +472,8 @@ clone_per_buffer_values (struct buffer *from, struct 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 (undo_list);
- offset < sizeof *to;
+ for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
+ offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
offset += sizeof (Lisp_Object))
{
Lisp_Object obj;
@@ -659,6 +672,10 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
set_buffer_internal_1 (old_b);
}
+ /* Run buffer-list-update-hook. */
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, Qbuffer_list_update_hook);
+
return buf;
}
@@ -814,8 +831,8 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
/* 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 (undo_list);
- offset < sizeof *b;
+ for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
+ offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
offset += sizeof (Lisp_Object))
{
int idx = PER_BUFFER_IDX (offset);
@@ -841,8 +858,8 @@ it is in the sequence to be tried) even if a buffer with that name exists. */)
(register Lisp_Object name, Lisp_Object ignore)
{
register Lisp_Object gentemp, tem;
- int count;
- char number[10];
+ EMACS_INT count;
+ char number[INT_BUFSIZE_BOUND (EMACS_INT) + sizeof "<>"];
CHECK_STRING (name);
@@ -856,7 +873,7 @@ it is in the sequence to be tried) even if a buffer with that name exists. */)
count = 1;
while (1)
{
- sprintf (number, "<%d>", ++count);
+ sprintf (number, "<%"pI"d>", ++count);
gentemp = concat2 (name, build_string (number));
tem = Fstring_equal (gentemp, ignore);
if (!NILP (tem))
@@ -1039,8 +1056,8 @@ No argument or nil as argument means use current buffer as BUFFER. */)
/* 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 (undo_list);
- offset < sizeof (struct buffer);
+ 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)))
{
@@ -1262,81 +1279,119 @@ This does not change the name of the visited file (if any). */)
if (NILP (BVAR (current_buffer, filename))
&& !NILP (BVAR (current_buffer, auto_save_file_name)))
call0 (intern ("rename-auto-save-file"));
+
+ /* Run buffer-list-update-hook. */
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, Qbuffer_list_update_hook);
+
/* Refetch since that last call may have done GC. */
return BVAR (current_buffer, name);
}
DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
doc: /* Return most recently selected buffer other than BUFFER.
-Buffers not visible in windows are preferred to visible buffers,
-unless optional second argument VISIBLE-OK is non-nil.
-If the optional third argument FRAME is non-nil, use that frame's
-buffer list instead of the selected frame's buffer list.
-If no other buffer exists, the buffer `*scratch*' is returned.
-If BUFFER is omitted or nil, some interesting buffer is returned. */)
+Buffers not visible in windows are preferred to visible buffers, unless
+optional second argument VISIBLE-OK is non-nil. Ignore the argument
+BUFFER unless it denotes a live buffer. If the optional third argument
+FRAME is non-nil, use that frame's buffer list instead of the selected
+frame's buffer list.
+
+The buffer is found by scanning the selected or specified frame's buffer
+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)
{
- register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
- notsogood = Qnil;
+ 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);
- tail = Vbuffer_alist;
pred = frame_buffer_predicate (frame);
-
- /* Consider buffers that have been seen in the selected frame
- before other buffers. */
-
- tem = frame_buffer_list (frame);
- add_ons = Qnil;
- while (CONSP (tem))
+ /* Consider buffers that have been seen in the frame first. */
+ tail = XFRAME (frame)->buffer_list;
+ for (; CONSP (tail); tail = XCDR (tail))
{
- if (BUFFERP (XCAR (tem)))
- add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
- tem = XCDR (tem);
+ buf = XCAR (tail);
+ if (BUFFERP (buf) && !EQ (buf, buffer)
+ && !NILP (BVAR (XBUFFER (buf), name))
+ && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
+ /* If the frame has a buffer_predicate, disregard buffers that
+ don't fit the predicate. */
+ && (NILP (pred) || !NILP (call1 (pred, buf))))
+ {
+ if (!NILP (visible_ok)
+ || NILP (Fget_buffer_window (buf, Qvisible)))
+ return buf;
+ else if (NILP (notsogood))
+ notsogood = buf;
+ }
}
- tail = nconc2 (Fnreverse (add_ons), tail);
+ /* Consider alist of all buffers next. */
+ tail = Vbuffer_alist;
for (; CONSP (tail); tail = XCDR (tail))
{
buf = Fcdr (XCAR (tail));
- if (EQ (buf, buffer))
- continue;
+ if (BUFFERP (buf) && !EQ (buf, buffer)
+ && !NILP (BVAR (XBUFFER (buf), name))
+ && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
+ /* If the frame has a buffer_predicate, disregard buffers that
+ don't fit the predicate. */
+ && (NILP (pred) || !NILP (call1 (pred, buf))))
+ {
+ if (!NILP (visible_ok)
+ || NILP (Fget_buffer_window (buf, Qvisible)))
+ return buf;
+ else if (NILP (notsogood))
+ notsogood = buf;
+ }
+ }
+
+ if (!NILP (notsogood))
+ return notsogood;
+ else
+ {
+ buf = Fget_buffer (build_string ("*scratch*"));
if (NILP (buf))
- continue;
- if (NILP (BVAR (XBUFFER (buf), name)))
- continue;
- if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
- continue;
- /* If the selected frame has a buffer_predicate,
- disregard buffers that don't fit the predicate. */
- if (!NILP (pred))
{
- tem = call1 (pred, buf);
- if (NILP (tem))
- continue;
+ buf = Fget_buffer_create (build_string ("*scratch*"));
+ Fset_buffer_major_mode (buf);
}
+ return buf;
+ }
+}
- if (NILP (visible_ok))
- tem = Fget_buffer_window (buf, Qvisible);
- else
- tem = Qnil;
- if (NILP (tem))
+/* The following function is a safe variant of Fother_buffer: It doesn't
+ pay attention to any frame-local buffer lists, doesn't care about
+ visibility of buffers, and doesn't evaluate any frame predicates. */
+
+Lisp_Object
+other_buffer_safely (Lisp_Object buffer)
+{
+ Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
+ Lisp_Object tail, buf;
+
+ tail = Vbuffer_alist;
+ for (; CONSP (tail); tail = XCDR (tail))
+ {
+ buf = Fcdr (XCAR (tail));
+ if (BUFFERP (buf) && !EQ (buf, buffer)
+ && !NILP (BVAR (XBUFFER (buf), name))
+ && (SREF (BVAR (XBUFFER (buf), name), 0) != ' '))
return buf;
- if (NILP (notsogood))
- notsogood = buf;
}
- if (!NILP (notsogood))
- return notsogood;
+
buf = Fget_buffer (build_string ("*scratch*"));
if (NILP (buf))
{
buf = Fget_buffer_create (build_string ("*scratch*"));
Fset_buffer_major_mode (buf);
}
+
return buf;
}
@@ -1509,13 +1564,20 @@ with SIGHUP. */)
if (NILP (BVAR (b, name)))
return Qnil;
+ /* These may run Lisp code and into infinite loops (if someone
+ insisted on circular lists) so allow quitting here. */
+ replace_buffer_in_windows (buffer);
+ frames_discard_buffer (buffer);
+
clear_charpos_cache (b);
tem = Vinhibit_quit;
Vinhibit_quit = Qt;
- replace_buffer_in_all_windows (buffer);
+ /* Remove the buffer from the list of all buffers. */
Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
- frames_discard_buffer (buffer);
+ /* If replace_buffer_in_windows didn't do its job correctly fix that
+ now. */
+ replace_buffer_in_windows_safely (buffer);
Vinhibit_quit = tem;
/* Delete any auto-save file, if we saved it in this session.
@@ -1589,83 +1651,102 @@ with SIGHUP. */)
UNBLOCK_INPUT;
BVAR (b, undo_list) = Qnil;
+ /* Run buffer-list-update-hook. */
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, Qbuffer_list_update_hook);
+
return Qt;
}
-/* Move the assoc for buffer BUF to the front of buffer-alist. Since
- we do this each time BUF is selected visibly, the more recently
- selected buffers are always closer to the front of the list. This
- means that other_buffer is more likely to choose a relevant buffer. */
+/* Move association for BUFFER to the front of buffer (a)lists. Since
+ we do this each time BUFFER is selected visibly, the more recently
+ selected buffers are always closer to the front of those lists. This
+ means that other_buffer is more likely to choose a relevant buffer.
+
+ Note that this moves BUFFER to the front of the buffer lists of the
+ selected frame even if BUFFER is not shown there. If BUFFER is not
+ shown in the selected frame, consider the present behavior a feature.
+ `select-window' gets this right since it shows BUFFER in the selected
+ window when calling us. */
void
-record_buffer (Lisp_Object buf)
+record_buffer (Lisp_Object buffer)
{
- register Lisp_Object list, prev;
- Lisp_Object frame;
- frame = selected_frame;
+ Lisp_Object aelt, aelt_cons, tem;
+ register struct frame *f = XFRAME (selected_frame);
- prev = Qnil;
- for (list = Vbuffer_alist; CONSP (list); list = XCDR (list))
- {
- if (EQ (XCDR (XCAR (list)), buf))
- break;
- prev = list;
- }
+ CHECK_BUFFER (buffer);
+
+ /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
+ Don't allow quitting since this might leave the buffer list in an
+ inconsistent state. */
+ tem = Vinhibit_quit;
+ Vinhibit_quit = Qt;
+ aelt = Frassq (buffer, Vbuffer_alist);
+ aelt_cons = Fmemq (aelt, Vbuffer_alist);
+ Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
+ XSETCDR (aelt_cons, Vbuffer_alist);
+ Vbuffer_alist = aelt_cons;
+ Vinhibit_quit = tem;
- /* Effectively do Vbuffer_alist = Fdelq (list, Vbuffer_alist);
- we cannot use Fdelq itself here because it allows quitting. */
+ /* 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);
- if (NILP (prev))
- Vbuffer_alist = XCDR (Vbuffer_alist);
- else
- XSETCDR (prev, XCDR (XCDR (prev)));
+ /* Run buffer-list-update-hook. */
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, Qbuffer_list_update_hook);
+}
- XSETCDR (list, Vbuffer_alist);
- Vbuffer_alist = list;
+DEFUN ("record-buffer", Frecord_buffer, Srecord_buffer, 1, 1, 0,
+ doc: /* Move BUFFER to the front of the buffer list.
+Return BUFFER. */)
+ (Lisp_Object buffer)
+{
+ CHECK_BUFFER (buffer);
- /* Effectively do a delq on buried_buffer_list. */
+ record_buffer (buffer);
- prev = Qnil;
- for (list = XFRAME (frame)->buried_buffer_list; CONSP (list);
- list = XCDR (list))
- {
- if (EQ (XCAR (list), buf))
- {
- if (NILP (prev))
- XFRAME (frame)->buried_buffer_list = XCDR (list);
- else
- XSETCDR (prev, XCDR (XCDR (prev)));
- break;
- }
- prev = list;
- }
+ return buffer;
+}
- /* Now move this buffer to the front of frame_buffer_list also. */
+ /* 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
+ called only when BUFFER was shown in the selected frame. */
- prev = Qnil;
- for (list = frame_buffer_list (frame); CONSP (list);
- list = XCDR (list))
- {
- if (EQ (XCAR (list), buf))
- break;
- prev = list;
- }
+DEFUN ("unrecord-buffer", Funrecord_buffer, Sunrecord_buffer, 1, 1, 0,
+ doc: /* Move BUFFER to the end of the buffer list.
+Return BUFFER. */)
+ (Lisp_Object buffer)
+{
+ Lisp_Object aelt, aelt_cons, tem;
+ register struct frame *f = XFRAME (selected_frame);
- /* Effectively do delq. */
+ CHECK_BUFFER (buffer);
- if (CONSP (list))
- {
- if (NILP (prev))
- set_frame_buffer_list (frame,
- XCDR (frame_buffer_list (frame)));
- else
- XSETCDR (prev, XCDR (XCDR (prev)));
+ /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
+ Don't allow quitting since this might leave the buffer list in an
+ inconsistent state. */
+ tem = Vinhibit_quit;
+ Vinhibit_quit = Qt;
+ aelt = Frassq (buffer, Vbuffer_alist);
+ aelt_cons = Fmemq (aelt, Vbuffer_alist);
+ Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
+ XSETCDR (aelt_cons, Qnil);
+ Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
+ Vinhibit_quit = tem;
- XSETCDR (list, frame_buffer_list (frame));
- set_frame_buffer_list (frame, list);
- }
- else
- set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
+ /* 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));
+
+ /* Run buffer-list-update-hook. */
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, Qbuffer_list_update_hook);
+
+ return buffer;
}
DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
@@ -1708,86 +1789,6 @@ the current buffer's major mode. */)
return unbind_to (count, Qnil);
}
-/* Switch to buffer BUFFER in the selected window.
- If NORECORD is non-nil, don't call record_buffer. */
-
-static Lisp_Object
-switch_to_buffer_1 (Lisp_Object buffer_or_name, Lisp_Object norecord)
-{
- register Lisp_Object buffer;
-
- if (NILP (buffer_or_name))
- buffer = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
- else
- {
- buffer = Fget_buffer (buffer_or_name);
- if (NILP (buffer))
- {
- buffer = Fget_buffer_create (buffer_or_name);
- Fset_buffer_major_mode (buffer);
- }
- }
- Fset_buffer (buffer);
- if (NILP (norecord))
- record_buffer (buffer);
-
- Fset_window_buffer (EQ (selected_window, minibuf_window)
- ? Fnext_window (minibuf_window, Qnil, Qnil)
- : selected_window,
- buffer, Qnil);
-
- return buffer;
-}
-
-DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2,
- "(list (read-buffer-to-switch \"Switch to buffer: \"))",
- doc: /* Make BUFFER-OR-NAME current and display it in selected window.
-BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
-nil. Return the buffer switched to.
-
-If BUFFER-OR-NAME is a string and does not identify an existing
-buffer, create a new buffer with that name. Interactively, if
-`confirm-nonexistent-file-or-buffer' is non-nil, request
-confirmation before creating a new buffer. If BUFFER-OR-NAME is
-nil, switch to buffer returned by `other-buffer'.
-
-Optional second arg NORECORD non-nil means do not put this buffer
-at the front of the list of recently selected ones. This
-function returns the buffer it switched to as a Lisp object.
-
-If the selected window is the minibuffer window or dedicated to
-its buffer, use `pop-to-buffer' for displaying the buffer.
-
-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. */)
- (Lisp_Object buffer_or_name, Lisp_Object norecord)
-{
- if (EQ (buffer_or_name, Fwindow_buffer (selected_window)))
- {
- /* Basically a NOP. Avoid signalling an error in the case where
- the selected window is dedicated, or a minibuffer. */
-
- /* But do put this buffer at the front of the buffer list, unless
- that has been inhibited. Note that even if BUFFER-OR-NAME is
- at the front of the main buffer-list already, we still want to
- move it to the front of the frame's buffer list. */
- if (NILP (norecord))
- record_buffer (buffer_or_name);
- return Fset_buffer (buffer_or_name);
- }
- else if (EQ (minibuf_window, selected_window)
- /* If `dedicated' is neither nil nor t, it means it's
- dedicatedness can be overridden by an explicit request
- such as a call to switch-to-buffer. */
- || EQ (Fwindow_dedicated_p (selected_window), Qt))
- /* We can't use the selected window so let `pop-to-buffer' try some
- other window. */
- return call3 (intern ("pop-to-buffer"), buffer_or_name, Qnil, norecord);
- else
- return switch_to_buffer_1 (buffer_or_name, norecord);
-}
-
DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
doc: /* Return the current buffer as a Lisp object. */)
(void)
@@ -1937,68 +1938,6 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
return Qnil;
}
-
-DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
- doc: /* Put BUFFER-OR-NAME at the end of the list of all buffers.
-There it is the least likely candidate for `other-buffer' to return;
-thus, the least likely buffer for \\[switch-to-buffer] to select by
-default.
-
-The argument may be a buffer name or an actual buffer object. If
-BUFFER-OR-NAME is nil or omitted, bury the current buffer and remove it
-from the selected window if it is displayed there. If the selected
-window is dedicated to its buffer, delete that window if there are other
-windows on the same frame. If the selected window is the only window on
-its frame, iconify that frame. */)
- (register Lisp_Object buffer_or_name)
-{
- Lisp_Object buffer;
-
- /* Figure out what buffer we're going to bury. */
- if (NILP (buffer_or_name))
- {
- Lisp_Object tem;
- XSETBUFFER (buffer, current_buffer);
-
- tem = Fwindow_buffer (selected_window);
- /* If we're burying the current buffer, unshow it. */
- if (EQ (buffer, tem))
- {
- if (NILP (Fwindow_dedicated_p (selected_window)))
- Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
- else if (NILP (XWINDOW (selected_window)->parent))
- Ficonify_frame (Fwindow_frame (selected_window));
- else
- Fdelete_window (selected_window);
- }
- }
- else
- {
- buffer = Fget_buffer (buffer_or_name);
- if (NILP (buffer))
- nsberror (buffer_or_name);
- }
-
- /* Move buffer to the end of the buffer list. Do nothing if the
- buffer is killed. */
- if (!NILP (BVAR (XBUFFER (buffer), name)))
- {
- Lisp_Object aelt, list;
-
- aelt = Frassq (buffer, Vbuffer_alist);
- list = Fmemq (aelt, Vbuffer_alist);
- Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
- XSETCDR (list, Qnil);
- Vbuffer_alist = nconc2 (Vbuffer_alist, list);
-
- XFRAME (selected_frame)->buffer_list
- = Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
- XFRAME (selected_frame)->buried_buffer_list
- = Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list));
- }
-
- return Qnil;
-}
DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
doc: /* Delete the entire contents of the current buffer.
@@ -2038,7 +1977,7 @@ validate_region (register Lisp_Object *b, register Lisp_Object *e)
/* Advance BYTE_POS up to a character boundary
and return the adjusted position. */
-static int
+static EMACS_INT
advance_to_char_boundary (EMACS_INT byte_pos)
{
int c;
@@ -2585,14 +2524,15 @@ swap_out_buffer_local_variables (struct buffer *b)
*NEXT_PTR is guaranteed to be not equal to POS, unless it is the
default (BEGV or ZV). */
-int
-overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr,
+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)
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
- int idx = 0;
- int len = *len_ptr;
+ ptrdiff_t idx = 0;
+ ptrdiff_t len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
EMACS_INT next = ZV;
EMACS_INT prev = BEGV;
@@ -2628,10 +2568,10 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr,
Either make it bigger, or don't store any more in it. */
if (extend)
{
+ if ((OVERLAY_COUNT_MAX - 4) / 2 < len)
+ memory_full (SIZE_MAX);
/* Make it work with an initial len == 0. */
- len *= 2;
- if (len == 0)
- len = 4;
+ len = len * 2 + 4;
*len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
@@ -2671,10 +2611,10 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr,
{
if (extend)
{
+ if ((OVERLAY_COUNT_MAX - 4) / 2 < len)
+ memory_full (SIZE_MAX);
/* Make it work with an initial len == 0. */
- len *= 2;
- if (len == 0)
- len = 4;
+ len = len * 2 + 4;
*len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
@@ -2724,15 +2664,15 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr,
and we store only as many overlays as will fit.
But we still return the total number of overlays. */
-static int
+static ptrdiff_t
overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
- Lisp_Object **vec_ptr, int *len_ptr,
+ Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
EMACS_INT *next_ptr, EMACS_INT *prev_ptr)
{
Lisp_Object overlay, ostart, oend;
struct Lisp_Overlay *tail;
- int idx = 0;
- int len = *len_ptr;
+ ptrdiff_t idx = 0;
+ ptrdiff_t len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
EMACS_INT next = ZV;
EMACS_INT prev = BEGV;
@@ -2768,10 +2708,10 @@ overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
Either make it bigger, or don't store any more in it. */
if (extend)
{
+ if ((OVERLAY_COUNT_MAX - 4) / 2 < len)
+ memory_full (SIZE_MAX);
/* Make it work with an initial len == 0. */
- len *= 2;
- if (len == 0)
- len = 4;
+ len = len * 2 + 4;
*len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
@@ -2816,10 +2756,10 @@ overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
{
if (extend)
{
+ if ((OVERLAY_COUNT_MAX - 4) / 2 < len)
+ memory_full (SIZE_MAX);
/* Make it work with an initial len == 0. */
- len *= 2;
- if (len == 0)
- len = 4;
+ len = len * 2 + 4;
*len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
@@ -2852,7 +2792,7 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
{
EMACS_INT start = OVERLAY_POSITION (OVERLAY_START (overlay));
EMACS_INT end = OVERLAY_POSITION (OVERLAY_END (overlay));
- int n, i, size;
+ ptrdiff_t n, i, size;
Lisp_Object *v, tem;
size = 10;
@@ -2918,7 +2858,7 @@ struct sortvec
{
Lisp_Object overlay;
EMACS_INT beg, end;
- int priority;
+ EMACS_INT priority;
};
static int
@@ -2927,21 +2867,21 @@ compare_overlays (const void *v1, const void *v2)
const struct sortvec *s1 = (const struct sortvec *) v1;
const struct sortvec *s2 = (const struct sortvec *) v2;
if (s1->priority != s2->priority)
- return s1->priority - s2->priority;
+ return s1->priority < s2->priority ? -1 : 1;
if (s1->beg != s2->beg)
- return s1->beg - s2->beg;
+ return s1->beg < s2->beg ? -1 : 1;
if (s1->end != s2->end)
- return s2->end - s1->end;
+ return s2->end < s1->end ? -1 : 1;
return 0;
}
/* Sort an array of overlays by priority. The array is modified in place.
The return value is the new size; this may be smaller than the original
size if some of the overlays were invalid or were window-specific. */
-int
-sort_overlays (Lisp_Object *overlay_vec, int noverlays, struct window *w)
+ptrdiff_t
+sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
{
- int i, j;
+ ptrdiff_t i, j;
struct sortvec *sortvec;
sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
@@ -2995,15 +2935,15 @@ sort_overlays (Lisp_Object *overlay_vec, int noverlays, struct window *w)
struct sortstr
{
Lisp_Object string, string2;
- int size;
- int priority;
+ ptrdiff_t size;
+ EMACS_INT priority;
};
struct sortstrlist
{
struct sortstr *buf; /* An array that expands as needed; never freed. */
- int size; /* Allocated length of that array. */
- int used; /* How much of the array is currently in use. */
+ ptrdiff_t size; /* Allocated length of that array. */
+ ptrdiff_t used; /* How much of the array is currently in use. */
EMACS_INT bytes; /* Total length of the strings in buf. */
};
@@ -3024,20 +2964,24 @@ cmp_for_strings (const void *as1, const void *as2)
struct sortstr *s1 = (struct sortstr *)as1;
struct sortstr *s2 = (struct sortstr *)as2;
if (s1->size != s2->size)
- return s2->size - s1->size;
+ return s2->size < s1->size ? -1 : 1;
if (s1->priority != s2->priority)
- return s1->priority - s2->priority;
+ return s1->priority < s2->priority ? -1 : 1;
return 0;
}
static void
-record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str2, Lisp_Object pri, int size)
+record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
+ Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
{
EMACS_INT nbytes;
if (ssl->used == ssl->size)
{
- if (ssl->buf)
+ if (min (PTRDIFF_MAX, SIZE_MAX) / (sizeof (struct sortstr) * 2)
+ < ssl->size)
+ memory_full (SIZE_MAX);
+ else if (0 < ssl->size)
ssl->size *= 2;
else
ssl->size = 5;
@@ -3943,9 +3887,8 @@ DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
doc: /* Return a list of the overlays that contain the character at POS. */)
(Lisp_Object pos)
{
- int noverlays;
+ ptrdiff_t len, noverlays;
Lisp_Object *overlay_vec;
- int len;
Lisp_Object result;
CHECK_NUMBER_COERCE_MARKER (pos);
@@ -3975,9 +3918,8 @@ between BEG and END, or at END provided END denotes the position at the
end of the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
- int noverlays;
+ ptrdiff_t len, noverlays;
Lisp_Object *overlay_vec;
- int len;
Lisp_Object result;
CHECK_NUMBER_COERCE_MARKER (beg);
@@ -4005,11 +3947,9 @@ If there are no overlay boundaries from POS to (point-max),
the value is (point-max). */)
(Lisp_Object pos)
{
- int noverlays;
+ ptrdiff_t i, len, noverlays;
EMACS_INT endpos;
Lisp_Object *overlay_vec;
- int len;
- int i;
CHECK_NUMBER_COERCE_MARKER (pos);
@@ -4048,7 +3988,7 @@ the value is (point-min). */)
{
EMACS_INT prevpos;
Lisp_Object *overlay_vec;
- int len;
+ ptrdiff_t len;
CHECK_NUMBER_COERCE_MARKER (pos);
@@ -4117,7 +4057,8 @@ DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
}
DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
- doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
+ doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
+VALUE will be returned.*/)
(Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
{
Lisp_Object tail, buffer;
@@ -4526,24 +4467,40 @@ static int mmap_initialized_p;
#define MMAP_ALLOCATED_P(start, end) 1
#endif
-/* Function prototypes. */
+/* Perform necessary intializations for the use of mmap. */
-static int mmap_free_1 (struct mmap_region *);
-static int mmap_enlarge (struct mmap_region *, int);
-static struct mmap_region *mmap_find (POINTER_TYPE *, POINTER_TYPE *);
-static POINTER_TYPE *mmap_alloc (POINTER_TYPE **, size_t);
-static POINTER_TYPE *mmap_realloc (POINTER_TYPE **, size_t);
-static void mmap_free (POINTER_TYPE **ptr);
-static void mmap_init (void);
+static void
+mmap_init (void)
+{
+#if MAP_ANON == 0
+ /* The value of mmap_fd is initially 0 in temacs, and -1
+ in a dumped Emacs. */
+ if (mmap_fd <= 0)
+ {
+ /* No anonymous mmap -- we need the file descriptor. */
+ mmap_fd = open ("/dev/zero", O_RDONLY);
+ if (mmap_fd == -1)
+ fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
+ }
+#endif /* MAP_ANON == 0 */
+ if (mmap_initialized_p)
+ return;
+ mmap_initialized_p = 1;
+
+#if MAP_ANON != 0
+ mmap_fd = -1;
+#endif
+
+ mmap_page_size = getpagesize ();
+}
/* Return a region overlapping address range START...END, or null if
none. END is not including, i.e. the last byte in the range
is at END - 1. */
static struct mmap_region *
-mmap_find (start, end)
- POINTER_TYPE *start, *end;
+mmap_find (POINTER_TYPE *start, POINTER_TYPE *end)
{
struct mmap_region *r;
char *s = (char *) start, *e = (char *) end;
@@ -4572,8 +4529,7 @@ mmap_find (start, end)
the region. Value is non-zero if successful. */
static int
-mmap_free_1 (r)
- struct mmap_region *r;
+mmap_free_1 (struct mmap_region *r)
{
if (r->next)
r->next->prev = r->prev;
@@ -4596,9 +4552,7 @@ mmap_free_1 (r)
Value is non-zero if successful. */
static int
-mmap_enlarge (r, npages)
- struct mmap_region *r;
- int npages;
+mmap_enlarge (struct mmap_region *r, int npages)
{
char *region_end = (char *) r + r->nbytes_mapped;
size_t nbytes;
@@ -4662,8 +4616,7 @@ mmap_enlarge (r, npages)
when Emacs starts. */
void
-mmap_set_vars (restore_p)
- int restore_p;
+mmap_set_vars (int restore_p)
{
struct mmap_region *r;
@@ -4696,9 +4649,7 @@ mmap_set_vars (restore_p)
return null. */
static POINTER_TYPE *
-mmap_alloc (var, nbytes)
- POINTER_TYPE **var;
- size_t nbytes;
+mmap_alloc (POINTER_TYPE **var, size_t nbytes)
{
void *p;
size_t map;
@@ -4735,15 +4686,29 @@ mmap_alloc (var, nbytes)
}
+/* Free a block of relocatable storage whose data is pointed to by
+ PTR. Store 0 in *PTR to show there's no block allocated. */
+
+static void
+mmap_free (POINTER_TYPE **var)
+{
+ mmap_init ();
+
+ if (*var)
+ {
+ mmap_free_1 (MMAP_REGION (*var));
+ *var = NULL;
+ }
+}
+
+
/* Given a pointer at address VAR to data allocated with mmap_alloc,
resize it to size NBYTES. Change *VAR to reflect the new block,
and return this value. If more memory cannot be allocated, then
leave *VAR unchanged, and return null. */
static POINTER_TYPE *
-mmap_realloc (var, nbytes)
- POINTER_TYPE **var;
- size_t nbytes;
+mmap_realloc (POINTER_TYPE **var, size_t nbytes)
{
POINTER_TYPE *result;
@@ -4813,51 +4778,6 @@ mmap_realloc (var, nbytes)
}
-/* Free a block of relocatable storage whose data is pointed to by
- PTR. Store 0 in *PTR to show there's no block allocated. */
-
-static void
-mmap_free (var)
- POINTER_TYPE **var;
-{
- mmap_init ();
-
- if (*var)
- {
- mmap_free_1 (MMAP_REGION (*var));
- *var = NULL;
- }
-}
-
-
-/* Perform necessary intializations for the use of mmap. */
-
-static void
-mmap_init ()
-{
-#if MAP_ANON == 0
- /* The value of mmap_fd is initially 0 in temacs, and -1
- in a dumped Emacs. */
- if (mmap_fd <= 0)
- {
- /* No anonymous mmap -- we need the file descriptor. */
- mmap_fd = open ("/dev/zero", O_RDONLY);
- if (mmap_fd == -1)
- fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
- }
-#endif /* MAP_ANON == 0 */
-
- if (mmap_initialized_p)
- return;
- mmap_initialized_p = 1;
-
-#if MAP_ANON != 0
- mmap_fd = -1;
-#endif
-
- mmap_page_size = getpagesize ();
-}
-
#endif /* USE_MMAP_FOR_BUFFERS */
@@ -4892,7 +4812,7 @@ alloc_buffer_text (struct buffer *b, size_t nbytes)
if (p == NULL)
{
UNBLOCK_INPUT;
- memory_full ();
+ memory_full (nbytes);
}
b->text->beg = (unsigned char *) p;
@@ -4920,7 +4840,7 @@ enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
if (p == NULL)
{
UNBLOCK_INPUT;
- memory_full ();
+ memory_full (nbytes);
}
BUF_BEG_ADDR (b) = (unsigned char *) p;
@@ -5040,7 +4960,7 @@ 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 */
- if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
+ { verify (sizeof (EMACS_INT) == sizeof (Lisp_Object)); }
/* 0 means not a lisp var, -1 means always local, else mask */
memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
@@ -5146,7 +5066,7 @@ init_buffer (void)
{
char *pwd;
Lisp_Object temp;
- int len;
+ ptrdiff_t len;
#ifdef USE_MMAP_FOR_BUFFERS
{
@@ -5270,39 +5190,26 @@ syms_of_buffer (void)
staticpro (&Vbuffer_alist);
staticpro (&Qprotected_field);
staticpro (&Qpermanent_local);
- Qpermanent_local_hook = intern_c_string ("permanent-local-hook");
- staticpro (&Qpermanent_local_hook);
staticpro (&Qkill_buffer_hook);
- Qoverlayp = intern_c_string ("overlayp");
- staticpro (&Qoverlayp);
- Qevaporate = intern_c_string ("evaporate");
- staticpro (&Qevaporate);
- Qmodification_hooks = intern_c_string ("modification-hooks");
- staticpro (&Qmodification_hooks);
- Qinsert_in_front_hooks = intern_c_string ("insert-in-front-hooks");
- staticpro (&Qinsert_in_front_hooks);
- Qinsert_behind_hooks = intern_c_string ("insert-behind-hooks");
- staticpro (&Qinsert_behind_hooks);
- Qget_file_buffer = intern_c_string ("get-file-buffer");
- staticpro (&Qget_file_buffer);
- Qpriority = intern_c_string ("priority");
- staticpro (&Qpriority);
- Qbefore_string = intern_c_string ("before-string");
- staticpro (&Qbefore_string);
- Qafter_string = intern_c_string ("after-string");
- staticpro (&Qafter_string);
- Qfirst_change_hook = intern_c_string ("first-change-hook");
- staticpro (&Qfirst_change_hook);
- Qbefore_change_functions = intern_c_string ("before-change-functions");
- staticpro (&Qbefore_change_functions);
- Qafter_change_functions = intern_c_string ("after-change-functions");
- staticpro (&Qafter_change_functions);
+
+ DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
+ DEFSYM (Qoverlayp, "overlayp");
+ DEFSYM (Qevaporate, "evaporate");
+ DEFSYM (Qmodification_hooks, "modification-hooks");
+ DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
+ DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
+ DEFSYM (Qget_file_buffer, "get-file-buffer");
+ DEFSYM (Qpriority, "priority");
+ DEFSYM (Qbefore_string, "before-string");
+ DEFSYM (Qafter_string, "after-string");
+ DEFSYM (Qfirst_change_hook, "first-change-hook");
+ DEFSYM (Qbefore_change_functions, "before-change-functions");
+ 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);
- Qkill_buffer_query_functions = intern_c_string ("kill-buffer-query-functions");
- staticpro (&Qkill_buffer_query_functions);
-
Fput (Qprotected_field, Qerror_conditions,
pure_cons (Qprotected_field, pure_cons (Qerror, Qnil)));
Fput (Qprotected_field, Qerror_message,
@@ -6096,8 +6003,15 @@ If any of them returns nil, the buffer is not killed. */);
doc: /* Normal hook run before changing the major mode of a buffer.
The function `kill-all-local-variables' runs this before doing anything else. */);
Vchange_major_mode_hook = Qnil;
- Qchange_major_mode_hook = intern_c_string ("change-major-mode-hook");
- staticpro (&Qchange_major_mode_hook);
+ DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
+
+ DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
+ 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'. */);
+ Vbuffer_list_update_hook = Qnil;
+ DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
defsubr (&Sbuffer_live_p);
defsubr (&Sbuffer_list);
@@ -6120,12 +6034,12 @@ The function `kill-all-local-variables' runs this before doing anything else. *
defsubr (&Sother_buffer);
defsubr (&Sbuffer_enable_undo);
defsubr (&Skill_buffer);
+ defsubr (&Srecord_buffer);
+ defsubr (&Sunrecord_buffer);
defsubr (&Sset_buffer_major_mode);
- defsubr (&Sswitch_to_buffer);
defsubr (&Scurrent_buffer);
defsubr (&Sset_buffer);
defsubr (&Sbarf_if_buffer_read_only);
- defsubr (&Sbury_buffer);
defsubr (&Serase_buffer);
defsubr (&Sbuffer_swap_text);
defsubr (&Sset_buffer_multibyte);
diff --git a/src/buffer.h b/src/buffer.h
index 2f33065cd1a..06864dd5789 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -18,6 +18,7 @@ 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 <time.h> /* for time_t */
/* Accessing the parameters of the current buffer. */
@@ -306,6 +307,13 @@ do \
} \
while (0)
+/* Maximum number of bytes in a buffer.
+ A buffer cannot contain more bytes than a 1-origin fixnum can represent,
+ nor can it be so large that C pointer arithmetic stops working.
+ The ptrdiff_t cast ensures that this is signed, not unsigned. */
+#define BUF_BYTES_MAX \
+ (ptrdiff_t) min (MOST_POSITIVE_FIXNUM - 1, min (SIZE_MAX, PTRDIFF_MAX))
+
/* Return the address of byte position N in current buffer. */
#define BYTE_POS_ADDR(n) \
@@ -332,7 +340,7 @@ while (0)
#define PTR_BYTE_POS(ptr) \
((ptr) - (current_buffer)->text->beg \
- - (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \
+ - (ptr - (current_buffer)->text->beg <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) \
+ BEG_BYTE)
/* Return character at byte position POS. */
@@ -391,7 +399,7 @@ extern unsigned char *_fetch_multibyte_char_p;
#define BUF_PTR_BYTE_POS(buf, ptr) \
((ptr) - (buf)->text->beg \
- - (ptr - (buf)->text->beg <= (unsigned) (BUF_GPT_BYTE ((buf)) - BEG_BYTE)\
+ - (ptr - (buf)->text->beg <= BUF_GPT_BYTE (buf) - BEG_BYTE \
? 0 : BUF_GAP_SIZE ((buf))) \
+ BEG_BYTE)
@@ -545,7 +553,7 @@ struct buffer
-1 means visited file was nonexistent.
0 means visited file modtime unknown; in no case complain
about any mismatch on next save attempt. */
- int modtime;
+ 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
@@ -604,6 +612,7 @@ struct buffer
/* 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.
@@ -838,6 +847,9 @@ struct buffer
t means to use hollow box cursor.
See `cursor-type' for other values. */
Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows);
+
+ /* This must be the last field in the above list. */
+ #define LAST_FIELD_PER_BUFFER cursor_in_non_selected_windows
};
@@ -879,10 +891,10 @@ 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 int overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
- int *len_ptr, EMACS_INT *next_ptr,
- EMACS_INT *prev_ptr, int change_req);
-extern int sort_overlays (Lisp_Object *, int, struct window *);
+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 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 validate_region (Lisp_Object *, Lisp_Object *);
@@ -900,7 +912,7 @@ extern void mmap_set_vars (int);
#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \
do { \
- int maxlen = 40; \
+ ptrdiff_t maxlen = 40; \
overlays = (Lisp_Object *) alloca (maxlen * sizeof (Lisp_Object)); \
noverlays = overlays_at (posn, 0, &overlays, &maxlen, \
nextp, NULL, chrq); \
diff --git a/src/bytecode.c b/src/bytecode.c
index c3cd3d43072..9ed29e94b54 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -144,7 +144,7 @@ Lisp_Object Qbytecode;
#define Bcurrent_column 0151
#define Bindent_to 0152
#ifdef BYTE_CODE_SAFE
-#define Bscan_buffer 0153 /* No longer generated as of v18 */
+#define Bscan_buffer 0153 /* No longer generated as of v18. */
#endif
#define Beolp 0154
#define Beobp 0155
@@ -433,7 +433,7 @@ If the third argument is incorrect, Emacs may crash. */)
Lisp_Object
exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
- Lisp_Object args_template, int nargs, Lisp_Object *args)
+ Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
{
int count = SPECPDL_INDEX ();
#ifdef BYTE_CODE_METER
@@ -444,7 +444,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Lisp_Object v1, v2; */
Lisp_Object *vectorp;
#ifdef BYTE_CODE_SAFE
- int const_length;
+ ptrdiff_t const_length;
Lisp_Object *stacke;
int bytestr_length;
#endif
@@ -464,7 +464,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CHECK_STRING (bytestr);
CHECK_VECTOR (vector);
- CHECK_NUMBER (maxdepth);
+ CHECK_NATNUM (maxdepth);
#ifdef BYTE_CODE_SAFE
const_length = ASIZE (vector);
@@ -486,6 +486,8 @@ 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))
+ memory_full (SIZE_MAX);
top = (Lisp_Object *) alloca (XFASTINT (maxdepth)
* sizeof (Lisp_Object));
#if BYTE_MAINTAIN_TOP
@@ -502,14 +504,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (INTEGERP (args_template))
{
- int at = XINT (args_template);
+ ptrdiff_t at = XINT (args_template);
int rest = at & 128;
int mandatory = at & 127;
- int nonrest = at >> 8;
+ ptrdiff_t nonrest = at >> 8;
eassert (mandatory <= nonrest);
if (nargs <= nonrest)
{
- int i;
+ ptrdiff_t i;
for (i = 0 ; i < nargs; i++, args++)
PUSH (*args);
if (nargs < mandatory)
@@ -528,7 +530,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
else if (rest)
{
- int i;
+ ptrdiff_t i;
for (i = 0 ; i < nonrest; i++, args++)
PUSH (*args);
PUSH (Flist (nargs - nonrest, args));
@@ -956,7 +958,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
save_restriction_save ());
break;
- case Bcatch: /* FIXME: ill-suited for lexbind */
+ case Bcatch: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
@@ -966,11 +968,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
break;
}
- case Bunwind_protect: /* FIXME: avoid closure for lexbind */
+ case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
break;
- case Bcondition_case: /* FIXME: ill-suited for lexbind */
+ case Bcondition_case: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object handlers, body;
handlers = POP;
@@ -1779,8 +1781,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
PUSH (*ptr);
break;
}
- /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
case Bstack_set:
+ /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
Lisp_Object *ptr = top - (FETCH);
*ptr = POP;
@@ -1838,8 +1840,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
void
syms_of_bytecode (void)
{
- Qbytecode = intern_c_string ("byte-code");
- staticpro (&Qbytecode);
+ DEFSYM (Qbytecode, "byte-code");
defsubr (&Sbyte_code);
@@ -1861,8 +1862,7 @@ integer, it is incremented each time that symbol's function is called. */);
byte_metering_on = 0;
Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
- Qbyte_code_meter = intern_c_string ("byte-code-meter");
- staticpro (&Qbyte_code_meter);
+ DEFSYM (Qbyte_code_meter, "byte-code-meter");
{
int i = 256;
while (i--)
diff --git a/src/callint.c b/src/callint.c
index 2cc3a7cb537..26b161a25b3 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -105,9 +105,10 @@ Z -- Coding system, nil if no prefix arg.
In addition, if the string begins with `*', an error is signaled if
the buffer is read-only.
-If the string begins with `@', Emacs searches the key sequence which
- invoked the command for its first mouse click (or any other event
- which specifies a window).
+If `@' 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 before the
+ command is run.
If the string begins with `^' and `shift-select-mode' is non-nil,
Emacs first calls the function `handle-shift-selection'.
You may use `@', `*', and `^' together. They are processed in the
@@ -233,7 +234,7 @@ fix_command (Lisp_Object input, Lisp_Object values)
}
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
- doc: /* Call FUNCTION, reading args according to its interactive calling specs.
+ doc: /* Call FUNCTION, providing args according to its interactive calling specs.
Return the value FUNCTION returns.
The function contains a specification of how to do the argument reading.
In the case of user-defined functions, this is specified by placing a call
@@ -269,10 +270,9 @@ invoke it. If KEYS is omitted or nil, the return value of
/* If varies[i] > 0, the i'th argument shouldn't just have its value
in this call quoted in the command history. It should be
recorded as a call to the function named callint_argfuns[varies[i]]. */
- int *varies;
+ signed char *varies;
- register size_t i;
- size_t nargs;
+ ptrdiff_t i, nargs;
int foo;
char prompt1[100];
char *tem1;
@@ -339,7 +339,7 @@ invoke it. If KEYS is omitted or nil, the return value of
{
Lisp_Object input;
Lisp_Object funval = Findirect_function (function, Qt);
- i = num_input_events;
+ size_t events = num_input_events;
input = specs;
/* Compute the arg values using the user's expression. */
GCPRO2 (input, filter_specs);
@@ -347,7 +347,7 @@ invoke it. If KEYS is omitted or nil, the return value of
CONSP (funval) && EQ (Qclosure, XCAR (funval))
? Qt : Qnil);
UNGCPRO;
- if (i != num_input_events || !NILP (record_flag))
+ if (events != num_input_events || !NILP (record_flag))
{
/* We should record this command on the command history. */
Lisp_Object values;
@@ -465,9 +465,14 @@ invoke it. If KEYS is omitted or nil, the return value of
break;
}
+ if (min (MOST_POSITIVE_FIXNUM,
+ min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
+ < nargs)
+ memory_full (SIZE_MAX);
+
args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- varies = (int *) alloca (nargs * sizeof (int));
+ varies = (signed char *) alloca (nargs);
for (i = 0; i < nargs; i++)
{
@@ -892,41 +897,20 @@ syms_of_callint (void)
pure_cons (intern_c_string ("point"),
pure_cons (intern_c_string ("mark"), Qnil))));
- Qlist = intern_c_string ("list");
- staticpro (&Qlist);
- Qlet = intern_c_string ("let");
- staticpro (&Qlet);
- Qif = intern_c_string ("if");
- staticpro (&Qif);
- Qwhen = intern_c_string ("when");
- staticpro (&Qwhen);
- Qletx = intern_c_string ("let*");
- staticpro (&Qletx);
- Qsave_excursion = intern_c_string ("save-excursion");
- staticpro (&Qsave_excursion);
- Qprogn = intern_c_string ("progn");
- staticpro (&Qprogn);
-
- Qminus = intern_c_string ("-");
- staticpro (&Qminus);
-
- Qplus = intern_c_string ("+");
- staticpro (&Qplus);
-
- Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
- staticpro (&Qhandle_shift_selection);
-
- Qcall_interactively = intern_c_string ("call-interactively");
- staticpro (&Qcall_interactively);
-
- Qcommand_debug_status = intern_c_string ("command-debug-status");
- staticpro (&Qcommand_debug_status);
-
- Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
- staticpro (&Qenable_recursive_minibuffers);
-
- Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
- staticpro (&Qmouse_leave_buffer_hook);
+ DEFSYM (Qlist, "list");
+ DEFSYM (Qlet, "let");
+ DEFSYM (Qif, "if");
+ DEFSYM (Qwhen, "when");
+ DEFSYM (Qletx, "let*");
+ DEFSYM (Qsave_excursion, "save-excursion");
+ DEFSYM (Qprogn, "progn");
+ DEFSYM (Qminus, "-");
+ DEFSYM (Qplus, "+");
+ DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
+ DEFSYM (Qcall_interactively, "call-interactively");
+ DEFSYM (Qcommand_debug_status, "command-debug-status");
+ DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
+ DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
doc: /* The value of the prefix argument for the next editing command.
diff --git a/src/callproc.c b/src/callproc.c
index a966a26b938..ad3eddbdd39 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -184,7 +184,7 @@ and returns a numeric exit status or a signal description string.
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) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object infile, buffer, current_dir, path;
volatile int display_p_volatile;
@@ -231,7 +231,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
/* Decide the coding-system for giving arguments. */
{
Lisp_Object val, *args2;
- size_t i;
+ ptrdiff_t i;
/* If arguments are supplied, we may have to encode them. */
if (nargs >= 5)
@@ -422,7 +422,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
(nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
if (nargs > 4)
{
- register size_t i;
+ ptrdiff_t i;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
GCPRO5 (infile, buffer, current_dir, path, error_file);
@@ -577,7 +577,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
unlink (tempfile);
emacs_close (filefd);
report_file_error ("Cannot re-open temporary file",
- Fcons (tempfile, Qnil));
+ Fcons (build_string (tempfile), Qnil));
}
}
else
@@ -596,7 +596,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
sigemptyset (&blocked);
sigaddset (&blocked, SIGPIPE);
sigaction (SIGPIPE, 0, &sigpipe_action);
- sigprocmask (SIG_BLOCK, &blocked, &procmask);
+ pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
#endif
BLOCK_INPUT;
@@ -633,7 +633,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
in the child. */
//signal (SIGPIPE, SIG_DFL);
#ifdef HAVE_WORKING_VFORK
- sigprocmask (SIG_SETMASK, &procmask, 0);
+ pthread_sigmask (SIG_SETMASK, &procmask, 0);
#endif
child_setup (filefd, fd1, fd_error, (char **) new_argv,
@@ -645,7 +645,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
#ifdef HAVE_WORKING_VFORK
/* Restore the signal state. */
sigaction (SIGPIPE, &sigpipe_action, 0);
- sigprocmask (SIG_SETMASK, &procmask, 0);
+ pthread_sigmask (SIG_SETMASK, &procmask, 0);
#endif
#endif /* not WINDOWSNT */
@@ -716,7 +716,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
{
if (EQ (coding_systems, Qt))
{
- size_t i;
+ ptrdiff_t i;
SAFE_ALLOCA (args2, Lisp_Object *, (nargs + 1) * sizeof *args2);
args2[0] = Qcall_process;
@@ -944,7 +944,7 @@ and returns a numeric exit status or a signal description string.
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
struct gcpro gcpro1;
Lisp_Object filename_string;
@@ -953,7 +953,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems;
Lisp_Object val, *args2;
- size_t i;
+ ptrdiff_t i;
char *tempfile;
Lisp_Object tmpdir, pattern;
@@ -1230,8 +1230,7 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
if (STRINGP (display))
{
- int vlen = strlen ("DISPLAY=") + strlen (SSDATA (display)) + 1;
- char *vdata = (char *) alloca (vlen);
+ char *vdata = (char *) alloca (sizeof "DISPLAY=" + SBYTES (display));
strcpy (vdata, "DISPLAY=");
strcat (vdata, SSDATA (display));
new_env = add_env (env, new_env, vdata);
@@ -1378,8 +1377,8 @@ relocate_fd (int fd, int minfd)
#endif /* not WINDOWSNT */
static int
-getenv_internal_1 (const char *var, int varlen, char **value, int *valuelen,
- Lisp_Object env)
+getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
+ ptrdiff_t *valuelen, Lisp_Object env)
{
for (; CONSP (env); env = XCDR (env))
{
@@ -1413,8 +1412,8 @@ getenv_internal_1 (const char *var, int varlen, char **value, int *valuelen,
}
static int
-getenv_internal (const char *var, int varlen, char **value, int *valuelen,
- Lisp_Object frame)
+getenv_internal (const char *var, ptrdiff_t varlen, char **value,
+ ptrdiff_t *valuelen, Lisp_Object frame)
{
/* Try to find VAR in Vprocess_environment first. */
if (getenv_internal_1 (var, varlen, value, valuelen,
@@ -1454,7 +1453,7 @@ If optional parameter ENV is a list, then search this list instead of
(Lisp_Object variable, Lisp_Object env)
{
char *value;
- int valuelen;
+ ptrdiff_t valuelen;
CHECK_STRING (variable);
if (CONSP (env))
@@ -1478,7 +1477,7 @@ char *
egetenv (const char *var)
{
char *value;
- int valuelen;
+ ptrdiff_t valuelen;
if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
return value;
@@ -1603,20 +1602,13 @@ init_callproc (void)
void
set_initial_environment (void)
{
- register char **envp;
-#ifdef CANNOT_DUMP
- Vprocess_environment = Qnil;
-#else
- if (initialized)
-#endif
- {
- for (envp = environ; *envp; envp++)
- Vprocess_environment = Fcons (build_string (*envp),
- Vprocess_environment);
- /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
- to use `delete' and friends on process-environment. */
- Vinitial_environment = Fcopy_sequence (Vprocess_environment);
- }
+ char **envp;
+ for (envp = environ; *envp; envp++)
+ Vprocess_environment = Fcons (build_string (*envp),
+ Vprocess_environment);
+ /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
+ to use `delete' and friends on process-environment. */
+ Vinitial_environment = Fcopy_sequence (Vprocess_environment);
}
void
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 9f286d73a5e..50ad4eeda74 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -52,7 +52,7 @@ casify_object (enum case_action flag, Lisp_Object obj)
/* If the character has higher bits set
above the flags, return it unchanged.
It is not a real character. */
- if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
+ if (UNSIGNED_CMP (XFASTINT (obj), >, flagbits))
return obj;
c1 = XFASTINT (obj) & ~flagbits;
@@ -417,8 +417,7 @@ With negative argument, capitalize previous words but do not move. */)
void
syms_of_casefiddle (void)
{
- Qidentity = intern_c_string ("identity");
- staticpro (&Qidentity);
+ DEFSYM (Qidentity, "identity");
defsubr (&Supcase);
defsubr (&Sdowncase);
defsubr (&Scapitalize);
diff --git a/src/casetab.c b/src/casetab.c
index 29120dd08ce..3433b313c03 100644
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -244,8 +244,7 @@ init_casetab_once (void)
{
register int i;
Lisp_Object down, up;
- Qcase_table = intern_c_string ("case-table");
- staticpro (&Qcase_table);
+ DEFSYM (Qcase_table, "case-table");
/* Intern this now in case it isn't already done.
Setting this variable twice is harmless.
@@ -288,8 +287,7 @@ init_casetab_once (void)
void
syms_of_casetab (void)
{
- Qcase_table_p = intern_c_string ("case-table-p");
- staticpro (&Qcase_table_p);
+ DEFSYM (Qcase_table_p, "case-table-p");
staticpro (&Vascii_canon_table);
staticpro (&Vascii_downcase_table);
diff --git a/src/category.c b/src/category.c
index 356801a179c..08eadb04730 100644
--- a/src/category.c
+++ b/src/category.c
@@ -67,8 +67,8 @@ static Lisp_Object
hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
{
struct Lisp_Hash_Table *h;
- int i;
- unsigned hash;
+ EMACS_INT i;
+ EMACS_UINT hash;
if (NILP (XCHAR_TABLE (table)->extras[1]))
XCHAR_TABLE (table)->extras[1]
@@ -453,8 +453,7 @@ void
init_category_once (void)
{
/* This has to be done here, before we call Fmake_char_table. */
- Qcategory_table = intern_c_string ("category-table");
- staticpro (&Qcategory_table);
+ DEFSYM (Qcategory_table, "category-table");
/* Intern this now in case it isn't already done.
Setting this variable twice is harmless.
@@ -475,12 +474,9 @@ init_category_once (void)
void
syms_of_category (void)
{
- Qcategoryp = intern_c_string ("categoryp");
- staticpro (&Qcategoryp);
- Qcategorysetp = intern_c_string ("categorysetp");
- staticpro (&Qcategorysetp);
- Qcategory_table_p = intern_c_string ("category-table-p");
- staticpro (&Qcategory_table_p);
+ DEFSYM (Qcategoryp, "categoryp");
+ DEFSYM (Qcategorysetp, "categorysetp");
+ DEFSYM (Qcategory_table_p, "category-table-p");
DEFVAR_LISP ("word-combining-categories", Vword_combining_categories,
doc: /* List of pair (cons) of categories to determine word boundary.
diff --git a/src/category.h b/src/category.h
index eacd89ce2cb..737198cc964 100644
--- a/src/category.h
+++ b/src/category.h
@@ -62,7 +62,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define XCATEGORY_SET XBOOL_VECTOR
#define CATEGORY_SET_P(x) \
- (BOOL_VECTOR_P ((x)) && (EMACS_INT) (XBOOL_VECTOR ((x))->size) == 128)
+ (BOOL_VECTOR_P (x) && XBOOL_VECTOR (x)->size == 128)
/* Return a new empty category set. */
#define MAKE_CATEGORY_SET (Fmake_bool_vector (make_number (128), Qnil))
diff --git a/src/ccl.c b/src/ccl.c
index 83afd7bc800..9cfcbfe8703 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <setjmp.h>
+#include <limits.h>
#include "lisp.h"
#include "character.h"
@@ -78,9 +79,8 @@ static Lisp_Object Vccl_program_table;
#define CCL_HEADER_EOF 1
#define CCL_HEADER_MAIN 2
-/* CCL code is a sequence of 28-bit non-negative integers (i.e. the
- MSB is always 0), each contains CCL command and/or arguments in the
- following format:
+/* CCL code is a sequence of 28-bit integers. Each contains a CCL
+ command and/or arguments in the following format:
|----------------- integer (28-bit) ------------------|
|------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
@@ -93,11 +93,14 @@ static Lisp_Object Vccl_program_table;
|------------- constant or other args ----------------|
cccccccccccccccccccccccccccc
- where, `cc...c' is a non-negative integer indicating constant value
- (the left most `c' is always 0) or an absolute jump address, `RRR'
+ where `cc...c' is a 17-bit, 20-bit, or 28-bit integer indicating a
+ constant value or a relative/absolute jump address, `RRR'
and `rrr' are CCL register number, `XXXXX' is one of the following
CCL commands. */
+#define CCL_CODE_MAX ((1 << (28 - 1)) - 1)
+#define CCL_CODE_MIN (-1 - CCL_CODE_MAX)
+
/* CCL commands
Each comment fields shows one or more lines for command syntax and
@@ -742,6 +745,28 @@ while(0)
#endif
+/* Use "&" rather than "&&" to suppress a bogus GCC warning; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
+#define ASCENDING_ORDER(lo, med, hi) (((lo) <= (med)) & ((med) <= (hi)))
+
+#define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \
+ do \
+ { \
+ EMACS_INT prog_word = XINT ((ccl_prog)[ic]); \
+ if (! ASCENDING_ORDER (lo, prog_word, hi)) \
+ CCL_INVALID_CMD; \
+ (var) = prog_word; \
+ } \
+ 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
output buffer. If CH is less than 256, CH is written as is. */
#define CCL_WRITE_CHAR(ch) \
@@ -899,7 +924,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
}
this_ic = ic;
- code = XINT (ccl_prog[ic]); ic++;
+ GET_CCL_CODE (code, ccl_prog, ic++);
field1 = code >> 8;
field2 = (code & 0xFF) >> 5;
@@ -920,15 +945,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
- reg[rrr] = XINT (ccl_prog[ic]);
- ic++;
+ GET_CCL_INT (reg[rrr], ccl_prog, ic++);
break;
case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
i = reg[RRR];
j = field1 >> 3;
- if ((unsigned int) i < j)
- reg[rrr] = XINT (ccl_prog[ic + i]);
+ if (0 <= i && i < j)
+ GET_CCL_INT (reg[rrr], ccl_prog, ic + i);
ic += j;
break;
@@ -956,13 +980,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 */
- i = XINT (ccl_prog[ic]);
+ GET_CCL_INT (i, ccl_prog, ic);
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
- i = XINT (ccl_prog[ic]);
+ GET_CCL_INT (i, ccl_prog, ic);
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
@@ -970,18 +994,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 */
- j = XINT (ccl_prog[ic]);
- ic++;
+ GET_CCL_INT (j, 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];
- j = XINT (ccl_prog[ic]);
- if ((unsigned int) i < j)
+ GET_CCL_INT (j, ccl_prog, ic);
+ if (0 <= i && i < j)
{
- i = XINT (ccl_prog[ic + 1 + i]);
+ GET_CCL_INT (i, ccl_prog, ic + 1 + i);
CCL_WRITE_CHAR (i);
}
ic += j + 2;
@@ -998,10 +1021,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
CCL_READ_CHAR (reg[rrr]);
/* fall through ... */
case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
- if ((unsigned int) reg[rrr] < field1)
- ic += XINT (ccl_prog[ic + reg[rrr]]);
- else
- ic += XINT (ccl_prog[ic + field1]);
+ {
+ int incr;
+ GET_CCL_INT (incr, ccl_prog,
+ ic + (0 <= reg[rrr] && reg[rrr] < field1
+ ? reg[rrr]
+ : field1));
+ ic += incr;
+ }
break;
case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
@@ -1009,7 +1036,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
CCL_READ_CHAR (reg[rrr]);
if (!field1) break;
- code = XINT (ccl_prog[ic]); ic++;
+ GET_CCL_CODE (code, ccl_prog, ic++);
field1 = code >> 8;
field2 = (code & 0xFF) >> 5;
}
@@ -1018,7 +1045,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
rrr = 7;
i = reg[RRR];
- j = XINT (ccl_prog[ic]);
+ GET_CCL_INT (j, ccl_prog, ic);
op = field1 >> 6;
jump_address = ic + 1;
goto ccl_set_expr;
@@ -1029,7 +1056,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
i = reg[rrr];
CCL_WRITE_CHAR (i);
if (!field1) break;
- code = XINT (ccl_prog[ic]); ic++;
+ GET_CCL_CODE (code, ccl_prog, ic++);
field1 = code >> 8;
field2 = (code & 0xFF) >> 5;
}
@@ -1051,10 +1078,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)
- {
- prog_id = XINT (ccl_prog[ic]);
- ic++;
- }
+ GET_CCL_INT (prog_id, ccl_prog, ic++);
else
prog_id = field1;
@@ -1095,9 +1119,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
i = reg[rrr];
- if ((unsigned int) i < field1)
+ if (0 <= i && i < field1)
{
- j = XINT (ccl_prog[ic + i]);
+ GET_CCL_INT (j, ccl_prog, ic + i);
CCL_WRITE_CHAR (j);
}
ic += field1;
@@ -1122,8 +1146,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
CCL_SUCCESS;
case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
- i = XINT (ccl_prog[ic]);
- ic++;
+ GET_CCL_INT (i, ccl_prog, ic++);
op = field1 >> 6;
goto ccl_expr_self;
@@ -1159,9 +1182,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
i = reg[RRR];
- j = XINT (ccl_prog[ic]);
+ GET_CCL_INT (j, ccl_prog, ic++);
op = field1 >> 6;
- jump_address = ++ic;
+ jump_address = ic;
goto ccl_set_expr;
case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
@@ -1175,10 +1198,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
CCL_READ_CHAR (reg[rrr]);
case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
- op = XINT (ccl_prog[ic]);
- jump_address = ic++ + ADDR;
- j = XINT (ccl_prog[ic]);
- ic++;
+ jump_address = ic + ADDR;
+ GET_CCL_INT (op, ccl_prog, ic++);
+ GET_CCL_INT (j, ccl_prog, ic++);
rrr = 7;
goto ccl_set_expr;
@@ -1186,10 +1208,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
CCL_READ_CHAR (reg[rrr]);
case CCL_JumpCondExprReg:
i = reg[rrr];
- op = XINT (ccl_prog[ic]);
- jump_address = ic++ + ADDR;
- j = reg[XINT (ccl_prog[ic])];
- ic++;
+ jump_address = ic + ADDR;
+ GET_CCL_INT (op, ccl_prog, ic++);
+ GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7);
+ j = reg[j];
rrr = 7;
ccl_set_expr:
@@ -1267,28 +1289,37 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_TranslateCharacterConstTbl:
- op = XINT (ccl_prog[ic]); /* table */
- ic++;
- i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
- op = translate_char (GET_TRANSLATION_TABLE (op), i);
- CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
+ {
+ EMACS_INT eop;
+ GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
+ (VECTORP (Vtranslation_table_vector)
+ ? ASIZE (Vtranslation_table_vector)
+ : -1));
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ op = translate_char (GET_TRANSLATION_TABLE (eop), i);
+ CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
+ }
break;
case CCL_LookupIntConstTbl:
- op = XINT (ccl_prog[ic]); /* table */
- ic++;
{
- struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
-
- op = hash_lookup (h, make_number (reg[RRR]), NULL);
- if (op >= 0)
+ EMACS_INT eop;
+ struct Lisp_Hash_Table *h;
+ GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
+ (VECTORP (Vtranslation_hash_table_vector)
+ ? ASIZE (Vtranslation_hash_table_vector)
+ : -1));
+ h = GET_HASH_TABLE (eop);
+
+ eop = hash_lookup (h, make_number (reg[RRR]), NULL);
+ if (eop >= 0)
{
Lisp_Object opl;
- opl = HASH_VALUE (h, op);
- if (! CHARACTERP (opl))
+ opl = HASH_VALUE (h, eop);
+ if (! (IN_INT_RANGE (eop) && CHARACTERP (opl)))
CCL_INVALID_CMD;
reg[RRR] = charset_unicode;
- reg[rrr] = op;
+ reg[rrr] = eop;
reg[7] = 1; /* r7 true for success */
}
else
@@ -1297,18 +1328,22 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_LookupCharConstTbl:
- op = XINT (ccl_prog[ic]); /* table */
- ic++;
- i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
{
- struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
-
- op = hash_lookup (h, make_number (i), NULL);
- if (op >= 0)
+ EMACS_INT eop;
+ struct Lisp_Hash_Table *h;
+ GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
+ (VECTORP (Vtranslation_hash_table_vector)
+ ? ASIZE (Vtranslation_hash_table_vector)
+ : -1));
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ h = GET_HASH_TABLE (eop);
+
+ eop = hash_lookup (h, make_number (i), NULL);
+ if (eop >= 0)
{
Lisp_Object opl;
- opl = HASH_VALUE (h, op);
- if (!INTEGERP (opl))
+ opl = HASH_VALUE (h, eop);
+ if (! (INTEGERP (opl) && IN_INT_RANGE (XINT (opl))))
CCL_INVALID_CMD;
reg[RRR] = XINT (opl);
reg[7] = 1; /* r7 true for success */
@@ -1321,9 +1356,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
- int point, size, fin_ic;
+ EMACS_INT point, size;
+ int fin_ic;
- j = XINT (ccl_prog[ic++]); /* number of maps. */
+ GET_CCL_INT (j, ccl_prog, ic++); /* number of maps. */
fin_ic = ic + j;
op = reg[rrr];
if ((j > reg[RRR]) && (j >= 0))
@@ -1343,7 +1379,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
- if (point >= size) continue;
+ if (! (0 <= point && point < size)) continue;
map = AREF (Vcode_conversion_map_vector, point);
/* Check map validity. */
@@ -1358,18 +1394,19 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
[t ELEMENT STARTPOINT ENDPOINT] */
- if (NUMBERP (content))
+ if (INTEGERP (content))
{
- point = XUINT (content);
- point = op - point + 1;
- if (!((point >= 1) && (point < size))) continue;
- content = AREF (map, point);
+ point = XINT (content);
+ if (!(point <= op && op - point + 1 < size)) continue;
+ content = AREF (map, op - point + 1);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
- if ((op >= XUINT (AREF (map, 2)))
- && (op < XUINT (AREF (map, 3))))
+ if (INTEGERP (AREF (map, 2))
+ && XINT (AREF (map, 2)) <= op
+ && INTEGERP (AREF (map, 3))
+ && op < XINT (AREF (map, 3)))
content = AREF (map, 1);
else
continue;
@@ -1379,7 +1416,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
if (NILP (content))
continue;
- else if (NUMBERP (content))
+ else if (INTEGERP (content) && IN_INT_RANGE (XINT (content)))
{
reg[RRR] = i;
reg[rrr] = XINT(content);
@@ -1394,10 +1431,11 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
attrib = XCAR (content);
value = XCDR (content);
- if (!NUMBERP (attrib) || !NUMBERP (value))
+ if (! (INTEGERP (attrib) && INTEGERP (value)
+ && IN_INT_RANGE (XINT (value))))
continue;
reg[RRR] = i;
- reg[rrr] = XUINT (value);
+ reg[rrr] = XINT (value);
break;
}
else if (SYMBOLP (content))
@@ -1432,8 +1470,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
mapping_stack_pointer = mapping_stack;
stack_idx_of_map_multiple = 0;
- map_set_rest_length =
- XINT (ccl_prog[ic++]); /* number of maps and separators. */
+ /* Get number of maps and separators. */
+ GET_CCL_INT (map_set_rest_length, ccl_prog, ic++);
+
fin_ic = ic + map_set_rest_length;
op = reg[rrr];
@@ -1501,7 +1540,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
- point = XINT(ccl_prog[ic]);
+ GET_CCL_INT (point, ccl_prog, ic);
if (point < 0)
{
/* +1 is for including separator. */
@@ -1531,18 +1570,19 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
[t ELEMENT STARTPOINT ENDPOINT] */
- if (NUMBERP (content))
+ if (INTEGERP (content))
{
- point = XUINT (content);
- point = op - point + 1;
- if (!((point >= 1) && (point < size))) continue;
- content = AREF (map, point);
+ point = XINT (content);
+ if (!(point <= op && op - point + 1 < size)) continue;
+ content = AREF (map, op - point + 1);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
- if ((op >= XUINT (AREF (map, 2))) &&
- (op < XUINT (AREF (map, 3))))
+ if (INTEGERP (AREF (map, 2))
+ && XINT (AREF (map, 2)) <= op
+ && INTEGERP (AREF (map, 3))
+ && op < XINT (AREF (map, 3)))
content = AREF (map, 1);
else
continue;
@@ -1554,7 +1594,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
continue;
reg[RRR] = i;
- if (NUMBERP (content))
+ if (INTEGERP (content) && IN_INT_RANGE (XINT (content)))
{
op = XINT (content);
i += map_set_rest_length - 1;
@@ -1566,9 +1606,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
attrib = XCAR (content);
value = XCDR (content);
- if (!NUMBERP (attrib) || !NUMBERP (value))
+ if (! (INTEGERP (attrib) && INTEGERP (value)
+ && IN_INT_RANGE (XINT (value))))
continue;
- op = XUINT (value);
+ op = XINT (value);
i += map_set_rest_length - 1;
ic += map_set_rest_length - 1;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
@@ -1613,7 +1654,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_MapSingle:
{
Lisp_Object map, attrib, value, content;
- int size, point;
+ int point;
j = XINT (ccl_prog[ic++]); /* map_id */
op = reg[rrr];
if (j >= ASIZE (Vcode_conversion_map_vector))
@@ -1628,41 +1669,36 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
}
map = XCDR (map);
- if (!VECTORP (map))
+ if (! (VECTORP (map)
+ && INTEGERP (AREF (map, 0))
+ && XINT (AREF (map, 0)) <= op
+ && op - XINT (AREF (map, 0)) + 1 < ASIZE (map)))
{
reg[RRR] = -1;
break;
}
- size = ASIZE (map);
- point = XUINT (AREF (map, 0));
+ point = XINT (AREF (map, 0));
point = op - point + 1;
reg[RRR] = 0;
- if ((size <= 1) ||
- (!((point >= 1) && (point < size))))
+ content = AREF (map, point);
+ if (NILP (content))
reg[RRR] = -1;
- else
+ else if (INTEGERP (content))
+ reg[rrr] = XINT (content);
+ else if (EQ (content, Qt));
+ else if (CONSP (content))
{
- reg[RRR] = 0;
- content = AREF (map, point);
- if (NILP (content))
- reg[RRR] = -1;
- else if (NUMBERP (content))
- reg[rrr] = XINT (content);
- else if (EQ (content, Qt));
- else if (CONSP (content))
- {
- attrib = XCAR (content);
- value = XCDR (content);
- if (!NUMBERP (attrib) || !NUMBERP (value))
- continue;
- reg[rrr] = XUINT(value);
- break;
- }
- else if (SYMBOLP (content))
- CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
- else
- reg[RRR] = -1;
+ attrib = XCAR (content);
+ value = XCDR (content);
+ if (!INTEGERP (attrib) || !INTEGERP (value))
+ continue;
+ reg[rrr] = XINT(value);
+ break;
}
+ else if (SYMBOLP (content))
+ CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
+ else
+ reg[RRR] = -1;
}
break;
@@ -2269,23 +2305,12 @@ syms_of_ccl (void)
staticpro (&Vccl_program_table);
Vccl_program_table = Fmake_vector (make_number (32), Qnil);
- Qccl = intern_c_string ("ccl");
- staticpro (&Qccl);
-
- Qcclp = intern_c_string ("cclp");
- staticpro (&Qcclp);
-
- Qccl_program = intern_c_string ("ccl-program");
- staticpro (&Qccl_program);
-
- Qccl_program_idx = intern_c_string ("ccl-program-idx");
- staticpro (&Qccl_program_idx);
-
- Qcode_conversion_map = intern_c_string ("code-conversion-map");
- staticpro (&Qcode_conversion_map);
-
- Qcode_conversion_map_id = intern_c_string ("code-conversion-map-id");
- staticpro (&Qcode_conversion_map_id);
+ DEFSYM (Qccl, "ccl");
+ DEFSYM (Qcclp, "cclp");
+ DEFSYM (Qccl_program, "ccl-program");
+ DEFSYM (Qccl_program_idx, "ccl-program-idx");
+ DEFSYM (Qcode_conversion_map, "code-conversion-map");
+ DEFSYM (Qcode_conversion_map_id, "code-conversion-map-id");
DEFVAR_LISP ("code-conversion-map-vector", Vcode_conversion_map_vector,
doc: /* Vector of code conversion maps. */);
diff --git a/src/character.c b/src/character.c
index 64ea2625abb..8e9b3e3775e 100644
--- a/src/character.c
+++ b/src/character.c
@@ -35,6 +35,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h>
#include <setjmp.h>
+#include <intprops.h>
#include "lisp.h"
#include "character.h"
#include "buffer.h"
@@ -122,7 +123,7 @@ char_string (unsigned int c, unsigned char *p)
if (c & CHAR_MODIFIER_MASK)
{
- c = (unsigned) char_resolve_modifier_mask ((int) c);
+ c = char_resolve_modifier_mask (c);
/* If C still has any modifier bits, just ignore it. */
c &= ~CHAR_MODIFIER_MASK;
}
@@ -257,7 +258,8 @@ multibyte_char_to_unibyte_safe (int c)
}
DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0,
- doc: /* Return non-nil if OBJECT is a character. */)
+ doc: /* Return non-nil if OBJECT is a character.
+usage: (characterp OBJECT) */)
(Lisp_Object object, Lisp_Object ignore)
{
return (CHARACTERP (object) ? Qt : Qnil);
@@ -404,7 +406,7 @@ strwidth (const char *str, EMACS_INT len)
in *NCHARS and *NBYTES respectively. */
EMACS_INT
-lisp_string_width (Lisp_Object string, int precision,
+lisp_string_width (Lisp_Object string, EMACS_INT precision,
EMACS_INT *nchars, EMACS_INT *nbytes)
{
EMACS_INT len = SCHARS (string);
@@ -419,7 +421,7 @@ lisp_string_width (Lisp_Object string, int precision,
while (i < len)
{
- int chars, bytes, thiswidth;
+ EMACS_INT chars, bytes, thiswidth;
Lisp_Object val;
int cmp_id;
EMACS_INT ignore, end;
@@ -437,7 +439,11 @@ lisp_string_width (Lisp_Object string, int precision,
int c;
if (multibyte)
- c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
+ {
+ int cbytes;
+ c = STRING_CHAR_AND_LENGTH (str + i_byte, cbytes);
+ bytes = cbytes;
+ }
else
c = str[i_byte], bytes = 1;
chars = 1;
@@ -455,8 +461,14 @@ lisp_string_width (Lisp_Object string, int precision,
}
}
- if (precision > 0
- && (width + thiswidth > precision))
+ if (precision <= 0)
+ {
+#ifdef emacs
+ if (INT_ADD_OVERFLOW (width, thiswidth))
+ string_overflow ();
+#endif
+ }
+ else if (precision - width < thiswidth)
{
*nchars = i;
*nbytes = i_byte;
@@ -465,7 +477,7 @@ lisp_string_width (Lisp_Object string, int precision,
i += chars;
i_byte += bytes;
width += thiswidth;
- }
+ }
if (precision > 0)
{
@@ -661,18 +673,23 @@ str_as_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT nbytes,
`str_to_multibyte'. */
EMACS_INT
-parse_str_to_multibyte (const unsigned char *str, EMACS_INT len)
+count_size_as_multibyte (const unsigned char *str, EMACS_INT len)
{
const unsigned char *endp = str + len;
EMACS_INT bytes;
for (bytes = 0; str < endp; str++)
- bytes += (*str < 0x80) ? 1 : 2;
+ {
+ int n = *str < 0x80 ? 1 : 2;
+ if (INT_ADD_OVERFLOW (bytes, n))
+ string_overflow ();
+ bytes += n;
+ }
return bytes;
}
-/* Convert unibyte text at STR of NBYTES bytes to a multibyte text
+/* Convert unibyte text at STR of BYTES bytes to a multibyte text
that contains the same single-byte characters. It actually
converts all 8-bit characters to multibyte forms. It is assured
that we can use LEN bytes at STR as a work area and that is
@@ -822,8 +839,8 @@ string_escape_byte8 (Lisp_Object string)
if (multibyte)
{
if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count
- || (MOST_POSITIVE_FIXNUM - nbytes) / 2 < byte8_count)
- error ("Maximum string size exceeded");
+ || (STRING_BYTES_BOUND - nbytes) / 2 < byte8_count)
+ string_overflow ();
/* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
val = make_uninit_multibyte_string (nchars + byte8_count * 3,
@@ -831,8 +848,9 @@ string_escape_byte8 (Lisp_Object string)
}
else
{
- if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count)
- error ("Maximum string size exceeded");
+ if ((STRING_BYTES_BOUND - nbytes) / 3 < byte8_count)
+ string_overflow ();
+
/* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
val = make_uninit_string (nbytes + byte8_count * 3);
}
@@ -876,9 +894,9 @@ DEFUN ("string", Fstring, Sstring, 0, MANY, 0,
doc: /*
Concatenate all the argument characters and make the result a string.
usage: (string &rest CHARACTERS) */)
- (size_t n, Lisp_Object *args)
+ (ptrdiff_t n, Lisp_Object *args)
{
- size_t i;
+ ptrdiff_t i;
int c;
unsigned char *buf, *p;
Lisp_Object str;
@@ -902,9 +920,9 @@ usage: (string &rest CHARACTERS) */)
DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0,
doc: /* Concatenate all the argument bytes and make the result a unibyte string.
usage: (unibyte-string &rest BYTES) */)
- (size_t n, Lisp_Object *args)
+ (ptrdiff_t n, Lisp_Object *args)
{
- size_t i;
+ ptrdiff_t i;
int c;
unsigned char *buf, *p;
Lisp_Object str;
diff --git a/src/character.h b/src/character.h
index 864882db7f6..063b5147dc9 100644
--- a/src/character.h
+++ b/src/character.h
@@ -23,6 +23,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_CHARACTER_H
#define EMACS_CHARACTER_H
+#include <verify.h>
+
/* character code 1st byte byte sequence
-------------- -------- -------------
0-7F 00..7F 0xxxxxxx
@@ -102,13 +104,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define make_char(c) make_number (c)
/* Nonzero iff C is an ASCII byte. */
-#define ASCII_BYTE_P(c) ((unsigned) (c) < 0x80)
+#define ASCII_BYTE_P(c) UNSIGNED_CMP (c, <, 0x80)
/* Nonzero iff X is a character. */
#define CHARACTERP(x) (NATNUMP (x) && XFASTINT (x) <= MAX_CHAR)
-/* Nonzero iff C is valid as a character code. GENERICP is not used. */
-#define CHAR_VALID_P(c, genericp) ((unsigned) (c) <= MAX_CHAR)
+/* Nonzero iff C is valid as a character code. */
+#define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR)
/* Check if Lisp object X is a character or not. */
#define CHECK_CHARACTER(x) \
@@ -129,7 +131,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
} while (0)
/* Nonzero iff C is a character of code less than 0x100. */
-#define SINGLE_BYTE_CHAR_P(c) ((unsigned) (c) < 0x100)
+#define SINGLE_BYTE_CHAR_P(c) UNSIGNED_CMP (c, <, 0x100)
/* Nonzero if character C has a printable glyph. */
#define CHAR_PRINTABLE_P(c) \
@@ -161,19 +163,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Returns the length of the multibyte form. */
#define CHAR_STRING(c, p) \
- ((unsigned) (c) <= MAX_1_BYTE_CHAR \
+ (UNSIGNED_CMP (c, <=, MAX_1_BYTE_CHAR) \
? ((p)[0] = (c), \
1) \
- : (unsigned) (c) <= MAX_2_BYTE_CHAR \
+ : UNSIGNED_CMP (c, <=, MAX_2_BYTE_CHAR) \
? ((p)[0] = (0xC0 | ((c) >> 6)), \
(p)[1] = (0x80 | ((c) & 0x3F)), \
2) \
- : (unsigned) (c) <= MAX_3_BYTE_CHAR \
+ : UNSIGNED_CMP (c, <=, MAX_3_BYTE_CHAR) \
? ((p)[0] = (0xE0 | ((c) >> 12)), \
(p)[1] = (0x80 | (((c) >> 6) & 0x3F)), \
(p)[2] = (0x80 | ((c) & 0x3F)), \
3) \
- : char_string ((unsigned) c, p))
+ : verify_expr (sizeof (c) <= sizeof (unsigned), char_string (c, p)))
/* Store multibyte form of byte B in P. The caller should allocate at
least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the
@@ -201,7 +203,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
*(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \
*(p)++ = (0x80 | ((c) & 0x3F)); \
else \
- (p) += char_string ((c), (p)); \
+ { \
+ verify (sizeof (c) <= sizeof (unsigned)); \
+ (p) += char_string (c, p); \
+ } \
} while (0)
@@ -544,7 +549,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Lisp_Object val; \
val = CHAR_TABLE_REF (Vchar_unify_table, c); \
if (INTEGERP (val)) \
- c = XINT (val); \
+ c = XFASTINT (val); \
else if (! NILP (val)) \
c = maybe_unify_char (c, val); \
} \
@@ -592,6 +597,45 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
: (c) <= 0xDFFF ? 2 \
: 0)
+/* Data type for Unicode general category.
+
+ The order of members must be in sync with the 8th element of the
+ member of unidata-prop-alist (in admin/unidata/unidata-getn.el) for
+ Unicode character property `general-category'. */
+
+typedef enum {
+ UNICODE_CATEGORY_UNKNOWN = 0,
+ UNICODE_CATEGORY_Lu,
+ UNICODE_CATEGORY_Ll,
+ UNICODE_CATEGORY_Lt,
+ UNICODE_CATEGORY_Lm,
+ UNICODE_CATEGORY_Lo,
+ UNICODE_CATEGORY_Mn,
+ UNICODE_CATEGORY_Mc,
+ UNICODE_CATEGORY_Me,
+ UNICODE_CATEGORY_Nd,
+ UNICODE_CATEGORY_Nl,
+ UNICODE_CATEGORY_No,
+ UNICODE_CATEGORY_Pc,
+ UNICODE_CATEGORY_Pd,
+ UNICODE_CATEGORY_Ps,
+ UNICODE_CATEGORY_Pe,
+ UNICODE_CATEGORY_Pi,
+ UNICODE_CATEGORY_Pf,
+ UNICODE_CATEGORY_Po,
+ UNICODE_CATEGORY_Sm,
+ UNICODE_CATEGORY_Sc,
+ UNICODE_CATEGORY_Sk,
+ UNICODE_CATEGORY_So,
+ UNICODE_CATEGORY_Zs,
+ UNICODE_CATEGORY_Zl,
+ UNICODE_CATEGORY_Zp,
+ UNICODE_CATEGORY_Cc,
+ UNICODE_CATEGORY_Cf,
+ UNICODE_CATEGORY_Cs,
+ UNICODE_CATEGORY_Co,
+ UNICODE_CATEGORY_Cn
+} unicode_category_t;
extern int char_resolve_modifier_mask (int);
extern int char_string (unsigned, unsigned char *);
@@ -602,7 +646,7 @@ 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 parse_str_to_multibyte (const unsigned char *, 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);
@@ -612,7 +656,7 @@ extern EMACS_INT str_to_unibyte (const unsigned char *, unsigned char *,
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, int,
+extern EMACS_INT lisp_string_width (Lisp_Object, EMACS_INT,
EMACS_INT *, EMACS_INT *);
extern Lisp_Object Qcharacterp;
@@ -623,7 +667,4 @@ extern Lisp_Object string_escape_byte8 (Lisp_Object);
#define GET_TRANSLATION_TABLE(id) \
(XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)]))
-#define DEFSYM(sym, name) \
- do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
-
#endif /* EMACS_CHARACTER_H */
diff --git a/src/charset.c b/src/charset.c
index 55fd57031ac..55234aa76aa 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -418,7 +418,7 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
/* Read a hexadecimal number (preceded by "0x") from the file FP while
paying attention to comment character '#'. */
-static INLINE unsigned
+static inline unsigned
read_hex (FILE *fp, int *eof)
{
int c;
@@ -844,12 +844,12 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
Sdefine_charset_internal, charset_arg_max, MANY, 0,
doc: /* For internal use only.
usage: (define-charset-internal ...) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
/* Charset attr vector. */
Lisp_Object attrs;
Lisp_Object val;
- unsigned hash_code;
+ EMACS_UINT hash_code;
struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table);
int i, j;
struct charset charset;
@@ -932,17 +932,8 @@ usage: (define-charset-internal ...) */)
val = args[charset_arg_min_code];
if (! NILP (val))
{
- unsigned code;
+ unsigned code = cons_to_unsigned (val, UINT_MAX);
- if (INTEGERP (val))
- code = XINT (val);
- else
- {
- CHECK_CONS (val);
- CHECK_NUMBER_CAR (val);
- CHECK_NUMBER_CDR (val);
- code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
- }
if (code < charset.min_code
|| code > charset.max_code)
args_out_of_range_3 (make_number (charset.min_code),
@@ -954,17 +945,8 @@ usage: (define-charset-internal ...) */)
val = args[charset_arg_max_code];
if (! NILP (val))
{
- unsigned code;
+ unsigned code = cons_to_unsigned (val, UINT_MAX);
- if (INTEGERP (val))
- code = XINT (val);
- else
- {
- CHECK_CONS (val);
- CHECK_NUMBER_CAR (val);
- CHECK_NUMBER_CDR (val);
- code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
- }
if (code < charset.min_code
|| code > charset.max_code)
args_out_of_range_3 (make_number (charset.min_code),
@@ -1637,7 +1619,7 @@ maybe_unify_char (int c, Lisp_Object val)
struct charset *charset;
if (INTEGERP (val))
- return XINT (val);
+ return XFASTINT (val);
if (NILP (val))
return c;
@@ -1647,7 +1629,7 @@ maybe_unify_char (int c, Lisp_Object val)
{
val = CHAR_TABLE_REF (Vchar_unify_table, c);
if (! NILP (val))
- c = XINT (val);
+ c = XFASTINT (val);
}
else
{
@@ -1865,17 +1847,7 @@ and CODE-POINT to a character. Currently not supported and just ignored. */)
struct charset *charsetp;
CHECK_CHARSET_GET_ID (charset, id);
- if (CONSP (code_point))
- {
- CHECK_NATNUM_CAR (code_point);
- CHECK_NATNUM_CDR (code_point);
- code = (XINT (XCAR (code_point)) << 16) | (XINT (XCDR (code_point)));
- }
- else
- {
- CHECK_NATNUM (code_point);
- code = XINT (code_point);
- }
+ code = cons_to_unsigned (code_point, UINT_MAX);
charsetp = CHARSET_FROM_ID (id);
c = DECODE_CHAR (charsetp, code);
return (c >= 0 ? make_number (c) : Qnil);
@@ -1890,19 +1862,18 @@ Optional argument RESTRICTION specifies a way to map CH to a
code-point in CCS. Currently not supported and just ignored. */)
(Lisp_Object ch, Lisp_Object charset, Lisp_Object restriction)
{
- int id;
+ int c, id;
unsigned code;
struct charset *charsetp;
CHECK_CHARSET_GET_ID (charset, id);
- CHECK_NATNUM (ch);
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
charsetp = CHARSET_FROM_ID (id);
- code = ENCODE_CHAR (charsetp, XINT (ch));
+ code = ENCODE_CHAR (charsetp, c);
if (code == CHARSET_INVALID_CODE (charsetp))
return Qnil;
- if (code > 0x7FFFFFF)
- return Fcons (make_number (code >> 16), make_number (code & 0xFFFF));
- return make_number (code);
+ return INTEGER_TO_CONS (code);
}
@@ -2174,11 +2145,11 @@ DEFUN ("set-charset-priority", Fset_charset_priority, Sset_charset_priority,
1, MANY, 0,
doc: /* Assign higher priority to the charsets given as arguments.
usage: (set-charset-priority &rest charsets) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object new_head, old_list, arglist[2];
Lisp_Object list_2022, list_emacs_mule;
- size_t i;
+ ptrdiff_t i;
int id;
old_list = Fcopy_sequence (Vcharset_ordered_list);
diff --git a/src/charset.h b/src/charset.h
index 53784bf8455..c2a52a38e7e 100644
--- a/src/charset.h
+++ b/src/charset.h
@@ -27,6 +27,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_CHARSET_H
#define EMACS_CHARSET_H
+#include <verify.h>
+
/* Index to arguments of Fdefine_charset_internal. */
enum define_charset_arg_index
@@ -146,7 +148,7 @@ struct charset
int id;
/* Index to Vcharset_hash_table. */
- int hash_index;
+ EMACS_INT hash_index;
/* Dimension of the charset: 1, 2, 3, or 4. */
int dimension;
@@ -424,28 +426,30 @@ extern Lisp_Object charset_work;
/* Return a code point of CHAR in CHARSET.
Try some optimization before calling encode_char. */
-#define ENCODE_CHAR(charset, c) \
- ((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \
- ? (c) \
- : ((charset)->unified_p \
- || (charset)->method == CHARSET_METHOD_SUBSET \
- || (charset)->method == CHARSET_METHOD_SUPERSET) \
- ? encode_char ((charset), (c)) \
- : ((c) < (charset)->min_char || (c) > (charset)->max_char) \
- ? (charset)->invalid_code \
- : (charset)->method == CHARSET_METHOD_OFFSET \
- ? ((charset)->code_linear_p \
- ? (c) - (charset)->code_offset + (charset)->min_code \
- : encode_char ((charset), (c))) \
- : (charset)->method == CHARSET_METHOD_MAP \
- ? (((charset)->compact_codes_p \
- && CHAR_TABLE_P (CHARSET_ENCODER (charset))) \
- ? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c)), \
- (NILP (charset_work) \
- ? (charset)->invalid_code \
- : XFASTINT (charset_work))) \
- : encode_char ((charset), (c))) \
- : encode_char ((charset), (c)))
+#define ENCODE_CHAR(charset, c) \
+ (verify_expr \
+ (sizeof (c) <= sizeof (int), \
+ (ASCII_CHAR_P (c) && (charset)->ascii_compatible_p \
+ ? (c) \
+ : ((charset)->unified_p \
+ || (charset)->method == CHARSET_METHOD_SUBSET \
+ || (charset)->method == CHARSET_METHOD_SUPERSET) \
+ ? encode_char (charset, c) \
+ : (c) < (charset)->min_char || (c) > (charset)->max_char \
+ ? (charset)->invalid_code \
+ : (charset)->method == CHARSET_METHOD_OFFSET \
+ ? ((charset)->code_linear_p \
+ ? (c) - (charset)->code_offset + (charset)->min_code \
+ : encode_char (charset, c)) \
+ : (charset)->method == CHARSET_METHOD_MAP \
+ ? (((charset)->compact_codes_p \
+ && CHAR_TABLE_P (CHARSET_ENCODER (charset))) \
+ ? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), c), \
+ (NILP (charset_work) \
+ ? (charset)->invalid_code \
+ : 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
diff --git a/src/chartab.c b/src/chartab.c
index 2f40ceee6ce..efe23eca83f 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -53,7 +53,38 @@ static const int chartab_bits[4] =
#define CHARTAB_IDX(c, depth, min_char) \
(((c) - (min_char)) >> chartab_bits[(depth)])
+
+/* Preamble for uniprop (Unicode character property) tables. See the
+ comment of "Unicode character property tables". */
+
+/* Purpose of uniprop tables. */
+static Lisp_Object Qchar_code_property_table;
+
+/* Types of decoder and encoder functions for uniprop values. */
+typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object);
+typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object);
+
+static Lisp_Object uniprop_table_uncompress (Lisp_Object, int);
+static uniprop_decoder_t uniprop_get_decoder (Lisp_Object);
+
+/* 1 iff TABLE is a uniprop table. */
+#define UNIPROP_TABLE_P(TABLE) \
+ (EQ (XCHAR_TABLE (TABLE)->purpose, Qchar_code_property_table) \
+ && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (TABLE)) == 5)
+
+/* Return a decoder for values in the uniprop table TABLE. */
+#define UNIPROP_GET_DECODER(TABLE) \
+ (UNIPROP_TABLE_P (TABLE) ? uniprop_get_decoder (TABLE) : NULL)
+/* Nonzero iff OBJ is a string representing uniprop values of 128
+ succeeding characters (the bottom level of a char-table) by a
+ compressed format. We are sure that no property value has a string
+ starting with '\001' nor '\002'. */
+#define UNIPROP_COMPRESSED_FORM_P(OBJ) \
+ (STRINGP (OBJ) && SCHARS (OBJ) > 0 \
+ && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2))))
+
+
DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
doc: /* Return a newly created char-table, with purpose PURPOSE.
Each element is initialized to INIT, which defaults to nil.
@@ -107,7 +138,7 @@ make_sub_char_table (int depth, int min_char, Lisp_Object defalt)
static Lisp_Object
char_table_ascii (Lisp_Object table)
{
- Lisp_Object sub;
+ Lisp_Object sub, val;
sub = XCHAR_TABLE (table)->contents[0];
if (! SUB_CHAR_TABLE_P (sub))
@@ -115,7 +146,10 @@ char_table_ascii (Lisp_Object table)
sub = XSUB_CHAR_TABLE (sub)->contents[0];
if (! SUB_CHAR_TABLE_P (sub))
return sub;
- return XSUB_CHAR_TABLE (sub)->contents[0];
+ val = XSUB_CHAR_TABLE (sub)->contents[0];
+ if (UNIPROP_TABLE_P (table) && UNIPROP_COMPRESSED_FORM_P (val))
+ val = uniprop_table_uncompress (sub, 0);
+ return val;
}
static Lisp_Object
@@ -169,16 +203,19 @@ copy_char_table (Lisp_Object table)
}
static Lisp_Object
-sub_char_table_ref (Lisp_Object table, int c)
+sub_char_table_ref (Lisp_Object table, int c, int is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
int min_char = XINT (tbl->min_char);
Lisp_Object val;
+ int idx = CHARTAB_IDX (c, depth, min_char);
- val = tbl->contents[CHARTAB_IDX (c, depth, min_char)];
+ val = tbl->contents[idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
+ val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref (val, c);
+ val = sub_char_table_ref (val, c, is_uniprop);
return val;
}
@@ -198,7 +235,7 @@ char_table_ref (Lisp_Object table, int c)
{
val = tbl->contents[CHARTAB_IDX (c, 0, 0)];
if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref (val, c);
+ val = sub_char_table_ref (val, c, UNIPROP_TABLE_P (table));
}
if (NILP (val))
{
@@ -210,7 +247,8 @@ 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)
+sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
+ Lisp_Object defalt, int is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
@@ -219,8 +257,10 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp
Lisp_Object val;
val = tbl->contents[chartab_idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
+ val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref_and_range (val, c, from, to, defalt);
+ val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop);
else if (NILP (val))
val = defalt;
@@ -232,8 +272,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp
c = min_char + idx * chartab_chars[depth] - 1;
idx--;
this_val = tbl->contents[idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
+ this_val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
+ this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
+ is_uniprop);
else if (NILP (this_val))
this_val = defalt;
@@ -251,8 +294,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp
chartab_idx++;
this_val = tbl->contents[chartab_idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
+ this_val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
+ this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
+ is_uniprop);
else if (NILP (this_val))
this_val = defalt;
if (! EQ (this_val, val))
@@ -277,17 +323,20 @@ 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);
val = tbl->contents[chartab_idx];
if (*from < 0)
*from = 0;
if (*to < 0)
*to = MAX_CHAR;
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
+ val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt);
+ val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt,
+ is_uniprop);
else if (NILP (val))
val = tbl->defalt;
-
idx = chartab_idx;
while (*from < idx * chartab_chars[0])
{
@@ -296,9 +345,11 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
c = idx * chartab_chars[0] - 1;
idx--;
this_val = tbl->contents[idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
+ this_val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
- tbl->defalt);
+ tbl->defalt, is_uniprop);
else if (NILP (this_val))
this_val = tbl->defalt;
@@ -315,9 +366,11 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
chartab_idx++;
c = chartab_idx * chartab_chars[0];
this_val = tbl->contents[chartab_idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
+ this_val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
- tbl->defalt);
+ tbl->defalt, is_uniprop);
else if (NILP (this_val))
this_val = tbl->defalt;
if (! EQ (this_val, val))
@@ -332,7 +385,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)
+sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
@@ -347,11 +400,17 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val)
sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
- sub = make_sub_char_table (depth + 1,
- min_char + i * chartab_chars[depth], sub);
- tbl->contents[i] = sub;
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (sub))
+ sub = uniprop_table_uncompress (table, i);
+ else
+ {
+ sub = make_sub_char_table (depth + 1,
+ min_char + i * chartab_chars[depth],
+ sub);
+ tbl->contents[i] = sub;
+ }
}
- sub_char_table_set (sub, c, val);
+ sub_char_table_set (sub, c, val, is_uniprop);
}
}
@@ -376,7 +435,7 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val)
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
tbl->contents[i] = sub;
}
- sub_char_table_set (sub, c, val);
+ sub_char_table_set (sub, c, val, UNIPROP_TABLE_P (table));
if (ASCII_CHAR_P (c))
tbl->ascii = char_table_ascii (table);
}
@@ -384,30 +443,40 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val)
}
static void
-sub_char_table_set_range (Lisp_Object *table, int depth, int min_char, int from, int to, Lisp_Object val)
+sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
+ int is_uniprop)
{
- int max_char = min_char + chartab_chars[depth] - 1;
-
- if (depth == 3 || (from <= min_char && to >= max_char))
- *table = val;
- else
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT ((tbl)->depth);
+ int min_char = XINT ((tbl)->min_char);
+ int chars_in_block = chartab_chars[depth];
+ int i, c, lim = chartab_size[depth];
+
+ if (from < min_char)
+ from = min_char;
+ i = CHARTAB_IDX (from, depth, min_char);
+ c = min_char + chars_in_block * i;
+ for (; i < lim; i++, c += chars_in_block)
{
- int i;
- unsigned j;
-
- depth++;
- if (! SUB_CHAR_TABLE_P (*table))
- *table = make_sub_char_table (depth, min_char, *table);
- if (from < min_char)
- from = min_char;
- if (to > max_char)
- to = max_char;
- i = CHARTAB_IDX (from, depth, min_char);
- j = CHARTAB_IDX (to, depth, min_char);
- min_char += chartab_chars[depth] * i;
- for (j++; i < j; i++, min_char += chartab_chars[depth])
- sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i,
- depth, min_char, from, to, val);
+ if (c > to)
+ break;
+ if (from <= c && c + chars_in_block - 1 <= to)
+ tbl->contents[i] = val;
+ else
+ {
+ Lisp_Object sub = tbl->contents[i];
+ if (! SUB_CHAR_TABLE_P (sub))
+ {
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (sub))
+ sub = uniprop_table_uncompress (table, i);
+ else
+ {
+ sub = make_sub_char_table (depth + 1, c, sub);
+ tbl->contents[i] = sub;
+ }
+ }
+ sub_char_table_set_range (sub, from, to, val, is_uniprop);
+ }
}
}
@@ -416,17 +485,33 @@ Lisp_Object
char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
- Lisp_Object *contents = tbl->contents;
- int i;
if (from == to)
char_table_set (table, from, val);
else
{
- unsigned lim = to / chartab_chars[0] + 1;
- for (i = CHARTAB_IDX (from, 0, 0); i < lim; i++)
- sub_char_table_set_range (contents + i, 0, i * chartab_chars[0],
- from, to, val);
+ int is_uniprop = UNIPROP_TABLE_P (table);
+ int lim = CHARTAB_IDX (to, 0, 0);
+ int i, c;
+
+ for (i = CHARTAB_IDX (from, 0, 0), c = 0; i <= lim;
+ i++, c += chartab_chars[0])
+ {
+ if (c > to)
+ break;
+ if (from <= c && c + chartab_chars[0] - 1 <= to)
+ tbl->contents[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;
+ }
+ sub_char_table_set_range (sub, from, to, val, is_uniprop);
+ }
+ }
if (ASCII_CHAR_P (from))
tbl->ascii = char_table_ascii (table);
}
@@ -504,6 +589,8 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
(Lisp_Object char_table, Lisp_Object n, Lisp_Object value)
{
CHECK_CHAR_TABLE (char_table);
+ if (EQ (XCHAR_TABLE (char_table)->purpose, Qchar_code_property_table))
+ error ("Can't change extra-slot of char-code-property-table");
CHECK_NUMBER (n);
if (XINT (n) < 0
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
@@ -524,16 +611,17 @@ a cons of character codes (for characters in the range), or a character code. *
if (EQ (range, Qnil))
val = XCHAR_TABLE (char_table)->defalt;
- else if (INTEGERP (range))
- val = CHAR_TABLE_REF (char_table, XINT (range));
+ else if (CHARACTERP (range))
+ val = CHAR_TABLE_REF (char_table, XFASTINT (range));
else if (CONSP (range))
{
int from, to;
CHECK_CHARACTER_CAR (range);
CHECK_CHARACTER_CDR (range);
- val = char_table_ref_and_range (char_table, XINT (XCAR (range)),
- &from, &to);
+ from = XFASTINT (XCAR (range));
+ to = XFASTINT (XCDR (range));
+ val = char_table_ref_and_range (char_table, from, &from, &to);
/* Not yet implemented. */
}
else
@@ -655,8 +743,7 @@ equivalent and can be merged. It defaults to `equal'. */)
/* Map C_FUNCTION or FUNCTION over TABLE (top or sub char-table),
calling it for each character or group of characters that share a
value. RANGE is a cons (FROM . TO) specifying the range of target
- characters, VAL is a value of FROM in TABLE, DEFAULT_VAL is the
- default value of the char-table, PARENT is the parent of the
+ characters, VAL is a value of FROM in TABLE, TOP is the top
char-table.
ARG is passed to C_FUNCTION when that is called.
@@ -669,10 +756,8 @@ equivalent and can be merged. It defaults to `equal'. */)
static Lisp_Object
map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
Lisp_Object function, Lisp_Object table, Lisp_Object arg, Lisp_Object val,
- Lisp_Object range, Lisp_Object default_val, Lisp_Object parent)
+ Lisp_Object range, Lisp_Object top)
{
- /* Pointer to the elements of TABLE. */
- Lisp_Object *contents;
/* Depth of TABLE. */
int depth;
/* Minimum and maxinum characters covered by TABLE. */
@@ -681,20 +766,20 @@ 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);
+ uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top);
if (SUB_CHAR_TABLE_P (table))
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
depth = XINT (tbl->depth);
- contents = tbl->contents;
min_char = XINT (tbl->min_char);
max_char = min_char + chartab_chars[depth - 1] - 1;
}
else
{
depth = 0;
- contents = XCHAR_TABLE (table)->contents;
min_char = 0;
max_char = MAX_CHAR;
}
@@ -710,28 +795,33 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
for (c = min_char + chars_in_block * i; c <= max_char;
i++, c += chars_in_block)
{
- Lisp_Object this = contents[i];
+ Lisp_Object this = (SUB_CHAR_TABLE_P (table)
+ ? XSUB_CHAR_TABLE (table)->contents[i]
+ : XCHAR_TABLE (table)->contents[i]);
int nextc = c + chars_in_block;
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this))
+ this = uniprop_table_uncompress (table, i);
if (SUB_CHAR_TABLE_P (this))
{
if (to >= nextc)
XSETCDR (range, make_number (nextc - 1));
val = map_sub_char_table (c_function, function, this, arg,
- val, range, default_val, parent);
+ val, range, top);
}
else
{
if (NILP (this))
- this = default_val;
+ this = XCHAR_TABLE (top)->defalt;
if (!EQ (val, this))
{
int different_value = 1;
if (NILP (val))
{
- if (! NILP (parent))
+ if (! NILP (XCHAR_TABLE (top)->parent))
{
+ Lisp_Object parent = XCHAR_TABLE (top)->parent;
Lisp_Object temp = XCHAR_TABLE (parent)->parent;
/* This is to get a value of FROM in PARENT
@@ -742,8 +832,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
XSETCDR (range, make_number (c - 1));
val = map_sub_char_table (c_function, function,
parent, arg, val, range,
- XCHAR_TABLE (parent)->defalt,
- XCHAR_TABLE (parent)->parent);
+ parent);
if (EQ (val, this))
different_value = 0;
}
@@ -756,14 +845,22 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
if (c_function)
(*c_function) (arg, XCAR (range), val);
else
- call2 (function, XCAR (range), val);
+ {
+ if (decoder)
+ val = decoder (top, val);
+ call2 (function, XCAR (range), val);
+ }
}
else
{
if (c_function)
(*c_function) (arg, range, val);
else
- call2 (function, range, val);
+ {
+ if (decoder)
+ val = decoder (top, val);
+ call2 (function, range, val);
+ }
}
}
val = this;
@@ -783,35 +880,39 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
ARG is passed to C_FUNCTION when that is called. */
void
-map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object function, Lisp_Object table, Lisp_Object arg)
+map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
+ Lisp_Object function, Lisp_Object table, Lisp_Object arg)
{
- Lisp_Object range, val;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object range, val, parent;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ uniprop_decoder_t decoder = UNIPROP_GET_DECODER (table);
range = Fcons (make_number (0), make_number (MAX_CHAR));
- GCPRO3 (table, arg, range);
+ parent = XCHAR_TABLE (table)->parent;
+
+ GCPRO4 (table, arg, range, parent);
val = XCHAR_TABLE (table)->ascii;
if (SUB_CHAR_TABLE_P (val))
val = XSUB_CHAR_TABLE (val)->contents[0];
val = map_sub_char_table (c_function, function, table, arg, val, range,
- XCHAR_TABLE (table)->defalt,
- XCHAR_TABLE (table)->parent);
+ table);
+
/* If VAL is nil and TABLE has a parent, we must consult the parent
recursively. */
while (NILP (val) && ! NILP (XCHAR_TABLE (table)->parent))
{
- Lisp_Object parent = XCHAR_TABLE (table)->parent;
- Lisp_Object temp = XCHAR_TABLE (parent)->parent;
+ Lisp_Object temp;
int from = XINT (XCAR (range));
+ parent = XCHAR_TABLE (table)->parent;
+ 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;
val = CHAR_TABLE_REF (parent, from);
XCHAR_TABLE (parent)->parent = temp;
val = map_sub_char_table (c_function, function, parent, arg, val, range,
- XCHAR_TABLE (parent)->defalt,
- XCHAR_TABLE (parent)->parent);
+ parent);
table = parent;
}
@@ -822,14 +923,22 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp
if (c_function)
(*c_function) (arg, XCAR (range), val);
else
- call2 (function, XCAR (range), val);
+ {
+ if (decoder)
+ val = decoder (table, val);
+ call2 (function, XCAR (range), val);
+ }
}
else
{
if (c_function)
(*c_function) (arg, range, val);
else
- call2 (function, range, val);
+ {
+ if (decoder)
+ val = decoder (table, val);
+ call2 (function, range, val);
+ }
}
}
@@ -984,9 +1093,314 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
}
+/* Unicode character property tables.
+
+ This section provides a convenient and efficient way to get a
+ Unicode character property from C code (from Lisp, you must use
+ get-char-code-property).
+
+ The typical usage is to get a char-table for a specific property at
+ a proper initialization time as this:
+
+ Lisp_Object bidi_class_table = uniprop_table (intern ("bidi-class"));
+
+ and get a property value for character CH as this:
+
+ Lisp_Object bidi_class = CHAR_TABLE_REF (CH, bidi_class_table);
+
+ In this case, what you actually get is an index number to the
+ vector of property values (symbols nil, L, R, etc).
+
+ A table for Unicode character property has these characteristics:
+
+ o The purpose is `char-code-property-table', which implies that the
+ table has 5 extra slots.
+
+ o The second extra slot is a Lisp function, an index (integer) to
+ the array uniprop_decoder[], or nil. If it is a Lisp function, we
+ can't use such a table from C (at the moment). If it is nil, it
+ means that we don't have to decode values.
+
+ o The third extra slot is a Lisp function, an index (integer) to
+ the array uniprop_enncoder[], or nil. If it is a Lisp function, we
+ can't use such a table from C (at the moment). If it is nil, it
+ means that we don't have to encode values. */
+
+
+/* Uncompress the IDXth element of sub-char-table TABLE. */
+
+static Lisp_Object
+uniprop_table_uncompress (Lisp_Object table, int idx)
+{
+ Lisp_Object val = XSUB_CHAR_TABLE (table)->contents[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;
+ p = SDATA (val), pend = p + SBYTES (val);
+ if (*p == 1)
+ {
+ /* SIMPLE TABLE */
+ p++;
+ idx = STRING_CHAR_ADVANCE (p);
+ while (p < pend && idx < chartab_chars[2])
+ {
+ int v = STRING_CHAR_ADVANCE (p);
+ subtbl->contents[idx++] = v > 0 ? make_number (v) : Qnil;
+ }
+ }
+ else if (*p == 2)
+ {
+ /* RUN-LENGTH TABLE */
+ p++;
+ for (idx = 0; p < pend; )
+ {
+ int v = STRING_CHAR_ADVANCE (p);
+ int count = 1;
+ int len;
+
+ if (p < pend)
+ {
+ count = STRING_CHAR_AND_LENGTH (p, len);
+ if (count < 128)
+ count = 1;
+ else
+ {
+ count -= 128;
+ p += len;
+ }
+ }
+ while (count-- > 0)
+ subtbl->contents[idx++] = make_number (v);
+ }
+ }
+/* It seems that we don't need this function because C code won't need
+ to get a property that is compressed in this form. */
+#if 0
+ else if (*p == 0)
+ {
+ /* WORD-LIST TABLE */
+ }
+#endif
+ return sub;
+}
+
+
+/* Decode VALUE as an elemnet of char-table TABLE. */
+
+static Lisp_Object
+uniprop_decode_value_run_length (Lisp_Object table, Lisp_Object value)
+{
+ if (VECTORP (XCHAR_TABLE (table)->extras[4]))
+ {
+ Lisp_Object valvec = XCHAR_TABLE (table)->extras[4];
+
+ if (XINT (value) >= 0 && XINT (value) < ASIZE (valvec))
+ value = AREF (valvec, XINT (value));
+ }
+ return value;
+}
+
+static uniprop_decoder_t uniprop_decoder [] =
+ { uniprop_decode_value_run_length };
+
+static int uniprop_decoder_count
+ = (sizeof uniprop_decoder) / sizeof (uniprop_decoder[0]);
+
+
+/* Return the decoder of char-table TABLE or nil if none. */
+
+static uniprop_decoder_t
+uniprop_get_decoder (Lisp_Object table)
+{
+ int i;
+
+ if (! INTEGERP (XCHAR_TABLE (table)->extras[1]))
+ return NULL;
+ i = XINT (XCHAR_TABLE (table)->extras[1]);
+ if (i < 0 || i >= uniprop_decoder_count)
+ return NULL;
+ return uniprop_decoder[i];
+}
+
+
+/* Encode VALUE as an element of char-table TABLE which contains
+ characters as elements. */
+
+static Lisp_Object
+uniprop_encode_value_character (Lisp_Object table, Lisp_Object value)
+{
+ if (! NILP (value) && ! CHARACTERP (value))
+ wrong_type_argument (Qintegerp, value);
+ return value;
+}
+
+
+/* Encode VALUE as an element of char-table TABLE which adopts RUN-LENGTH
+ compression. */
+
+static Lisp_Object
+uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value)
+{
+ Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents;
+ int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]);
+
+ for (i = 0; i < size; i++)
+ if (EQ (value, value_table[i]))
+ break;
+ if (i == size)
+ wrong_type_argument (build_string ("Unicode property value"), value);
+ return make_number (i);
+}
+
+
+/* Encode VALUE as an element of char-table TABLE which adopts RUN-LENGTH
+ compression and contains numbers as elements . */
+
+static Lisp_Object
+uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value)
+{
+ Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents;
+ int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]);
+
+ CHECK_NUMBER (value);
+ for (i = 0; i < size; i++)
+ if (EQ (value, value_table[i]))
+ break;
+ value = make_number (i);
+ if (i == size)
+ {
+ Lisp_Object args[2];
+
+ args[0] = XCHAR_TABLE (table)->extras[4];
+ args[1] = Fmake_vector (make_number (1), value);
+ XCHAR_TABLE (table)->extras[4] = Fvconcat (2, args);
+ }
+ return make_number (i);
+}
+
+static uniprop_encoder_t uniprop_encoder[] =
+ { uniprop_encode_value_character,
+ uniprop_encode_value_run_length,
+ uniprop_encode_value_numeric };
+
+static int uniprop_encoder_count
+ = (sizeof uniprop_encoder) / sizeof (uniprop_encoder[0]);
+
+
+/* Return the encoder of char-table TABLE or nil if none. */
+
+static uniprop_decoder_t
+uniprop_get_encoder (Lisp_Object table)
+{
+ int i;
+
+ if (! INTEGERP (XCHAR_TABLE (table)->extras[2]))
+ return NULL;
+ i = XINT (XCHAR_TABLE (table)->extras[2]);
+ if (i < 0 || i >= uniprop_encoder_count)
+ return NULL;
+ return uniprop_encoder[i];
+}
+
+/* Return a char-table for Unicode character property PROP. This
+ function may load a Lisp file and thus may cause
+ garbage-collection. */
+
+static Lisp_Object
+uniprop_table (Lisp_Object prop)
+{
+ Lisp_Object val, table, result;
+
+ val = Fassq (prop, Vchar_code_property_alist);
+ if (! CONSP (val))
+ return Qnil;
+ table = XCDR (val);
+ if (STRINGP (table))
+ {
+ struct gcpro gcpro1;
+ GCPRO1 (val);
+ result = Fload (concat2 (build_string ("international/"), table),
+ Qt, Qt, Qt, Qt);
+ UNGCPRO;
+ if (NILP (result))
+ return Qnil;
+ table = XCDR (val);
+ }
+ if (! CHAR_TABLE_P (table)
+ || ! UNIPROP_TABLE_P (table))
+ return Qnil;
+ val = XCHAR_TABLE (table)->extras[1];
+ if (INTEGERP (val)
+ ? (XINT (val) < 0 || XINT (val) >= uniprop_decoder_count)
+ : ! NILP (val))
+ return Qnil;
+ /* Prepare ASCII values in advance for CHAR_TABLE_REF. */
+ XCHAR_TABLE (table)->ascii = char_table_ascii (table);
+ return table;
+}
+
+DEFUN ("unicode-property-table-internal", Funicode_property_table_internal,
+ Sunicode_property_table_internal, 1, 1, 0,
+ doc: /* Return a char-table for Unicode character property PROP.
+Use `get-unicode-property-internal' and
+`put-unicode-property-internal' instead of `aref' and `aset' to get
+and put an element value. */)
+ (Lisp_Object prop)
+{
+ Lisp_Object table = uniprop_table (prop);
+
+ if (CHAR_TABLE_P (table))
+ return table;
+ return Fcdr (Fassq (prop, Vchar_code_property_alist));
+}
+
+DEFUN ("get-unicode-property-internal", Fget_unicode_property_internal,
+ Sget_unicode_property_internal, 2, 2, 0,
+ doc: /* Return an element of CHAR-TABLE for character CH.
+CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
+ (Lisp_Object char_table, Lisp_Object ch)
+{
+ Lisp_Object val;
+ uniprop_decoder_t decoder;
+
+ CHECK_CHAR_TABLE (char_table);
+ CHECK_CHARACTER (ch);
+ if (! UNIPROP_TABLE_P (char_table))
+ error ("Invalid Unicode property table");
+ val = CHAR_TABLE_REF (char_table, XINT (ch));
+ decoder = uniprop_get_decoder (char_table);
+ return (decoder ? decoder (char_table, val) : val);
+}
+
+DEFUN ("put-unicode-property-internal", Fput_unicode_property_internal,
+ Sput_unicode_property_internal, 3, 3, 0,
+ doc: /* Set an element of CHAR-TABLE for character CH to VALUE.
+CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
+ (Lisp_Object char_table, Lisp_Object ch, Lisp_Object value)
+{
+ uniprop_encoder_t encoder;
+
+ CHECK_CHAR_TABLE (char_table);
+ CHECK_CHARACTER (ch);
+ if (! UNIPROP_TABLE_P (char_table))
+ error ("Invalid Unicode property table");
+ encoder = uniprop_get_encoder (char_table);
+ if (encoder)
+ value = encoder (char_table, value);
+ CHAR_TABLE_SET (char_table, XINT (ch), value);
+ return Qnil;
+}
+
+
void
syms_of_chartab (void)
{
+ DEFSYM (Qchar_code_property_table, "char-code-property-table");
+
defsubr (&Smake_char_table);
defsubr (&Schar_table_parent);
defsubr (&Schar_table_subtype);
@@ -998,4 +1412,19 @@ syms_of_chartab (void)
defsubr (&Sset_char_table_default);
defsubr (&Soptimize_char_table);
defsubr (&Smap_char_table);
+ defsubr (&Sunicode_property_table_internal);
+ defsubr (&Sget_unicode_property_internal);
+ defsubr (&Sput_unicode_property_internal);
+
+ /* Each element has the form (PROP . TABLE).
+ PROP is a symbol representing a character property.
+ TABLE is a char-table containing the property value for each character.
+ TABLE may be a name of file to load to build a char-table.
+ This variable should be modified only through
+ `define-char-code-property'. */
+
+ DEFVAR_LISP ("char-code-property-alist", Vchar_code_property_alist,
+ doc: /* Alist of character property name vs char-table containing property values.
+Internal use only. */);
+ Vchar_code_property_alist = Qnil;
}
diff --git a/src/cm.c b/src/cm.c
index 42f855f1694..609632eba11 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -305,7 +305,8 @@ done:
}
#if 0
-losecursor ()
+void
+losecursor (void)
{
curY = -1;
}
diff --git a/src/cmds.c b/src/cmds.c
index 5dc4d2bfe30..f49cfc221be 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -511,20 +511,11 @@ internal_self_insert (int c, EMACS_INT n)
void
syms_of_cmds (void)
{
- Qkill_backward_chars = intern_c_string ("kill-backward-chars");
- staticpro (&Qkill_backward_chars);
-
- Qkill_forward_chars = intern_c_string ("kill-forward-chars");
- staticpro (&Qkill_forward_chars);
-
- Qoverwrite_mode_binary = intern_c_string ("overwrite-mode-binary");
- staticpro (&Qoverwrite_mode_binary);
-
- Qexpand_abbrev = intern_c_string ("expand-abbrev");
- staticpro (&Qexpand_abbrev);
-
- Qpost_self_insert_hook = intern_c_string ("post-self-insert-hook");
- staticpro (&Qpost_self_insert_hook);
+ DEFSYM (Qkill_backward_chars, "kill-backward-chars");
+ DEFSYM (Qkill_forward_chars, "kill-forward-chars");
+ DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary");
+ DEFSYM (Qexpand_abbrev, "expand-abbrev");
+ DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook");
DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook,
doc: /* Hook run at the end of `self-insert-command'.
diff --git a/src/coding.c b/src/coding.c
index 71253df6469..65c8a767c2b 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -55,8 +55,8 @@ CODING SYSTEM
character sequence of emacs-utf-8 to a byte sequence of a specific
coding system.
- In Emacs Lisp, a coding system is represented by a Lisp symbol. In
- C level, a coding system is represented by a vector of attributes
+ In Emacs Lisp, a coding system is represented by a Lisp symbol. On
+ the C level, a coding system is represented by a vector of attributes
stored in the hash table Vcharset_hash_table. The conversion from
coding system symbol to attributes vector is done by looking up
Vcharset_hash_table by the symbol.
@@ -864,21 +864,21 @@ 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 *,
+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,
+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,
+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 inline int char_encodable_p (int, Lisp_Object);
static Lisp_Object make_subsidiaries (Lisp_Object);
static void
@@ -1071,8 +1071,8 @@ coding_set_destination (struct coding_system *coding)
static void
coding_alloc_by_realloc (struct coding_system *coding, EMACS_INT bytes)
{
- if (coding->dst_bytes >= MOST_POSITIVE_FIXNUM - bytes)
- error ("Maximum size of buffer or string exceeded");
+ if (STRING_BYTES_BOUND - coding->dst_bytes < bytes)
+ string_overflow ();
coding->destination = (unsigned char *) xrealloc (coding->destination,
coding->dst_bytes + bytes);
coding->dst_bytes += bytes;
@@ -6829,7 +6829,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
[ -LENGTH ANNOTATION_MASK NCHARS NBYTES METHOD [ COMPONENTS... ] ]
*/
-static INLINE void
+static inline void
produce_composition (struct coding_system *coding, int *charbuf, EMACS_INT pos)
{
int len;
@@ -6873,7 +6873,7 @@ produce_composition (struct coding_system *coding, int *charbuf, EMACS_INT pos)
[ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ]
*/
-static INLINE void
+static inline void
produce_charset (struct coding_system *coding, int *charbuf, EMACS_INT pos)
{
EMACS_INT from = pos - charbuf[2];
@@ -7101,7 +7101,7 @@ decode_coding (struct coding_system *coding)
position of a composition after POS (if any) or to LIMIT, and
return BUF. */
-static INLINE int *
+static inline int *
handle_composition_annotation (EMACS_INT pos, EMACS_INT limit,
struct coding_system *coding, int *buf,
EMACS_INT *stop)
@@ -7184,7 +7184,7 @@ 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 *
+static inline int *
handle_charset_annotation (EMACS_INT pos, EMACS_INT limit,
struct coding_system *coding, int *buf,
EMACS_INT *stop)
@@ -8435,7 +8435,7 @@ highest priority. */)
}
-static INLINE int
+static inline int
char_encodable_p (int c, Lisp_Object attrs)
{
Lisp_Object tail;
@@ -9000,7 +9000,7 @@ not fully specified.) */)
(Lisp_Object string, Lisp_Object coding_system, Lisp_Object nocopy, Lisp_Object buffer)
{
return code_convert_string (string, coding_system, buffer,
- 1, ! NILP (nocopy), 1);
+ 1, ! NILP (nocopy), 0);
}
@@ -9278,7 +9278,7 @@ function to call for FILENAME, that function should examine the
contents of BUFFER instead of reading the file.
usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object operation, target_idx, target, val;
register Lisp_Object chain;
@@ -9355,9 +9355,9 @@ If multiple coding systems belong to the same category,
all but the first one are ignored.
usage: (set-coding-system-priority &rest coding-systems) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- size_t i, j;
+ ptrdiff_t i, j;
int changed[coding_category_max];
enum coding_category priorities[coding_category_max];
@@ -9442,7 +9442,7 @@ static Lisp_Object
make_subsidiaries (Lisp_Object base)
{
Lisp_Object subsidiaries;
- int base_name_len = SBYTES (SYMBOL_NAME (base));
+ ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
char *buf = (char *) alloca (base_name_len + 6);
int i;
@@ -9450,7 +9450,7 @@ make_subsidiaries (Lisp_Object base)
subsidiaries = Fmake_vector (make_number (3), Qnil);
for (i = 0; i < 3; i++)
{
- memcpy (buf + base_name_len, suffixes[i], strlen (suffixes[i]) + 1);
+ strcpy (buf + base_name_len, suffixes[i]);
ASET (subsidiaries, i, intern (buf));
}
return subsidiaries;
@@ -9461,7 +9461,7 @@ DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal,
Sdefine_coding_system_internal, coding_arg_max, MANY, 0,
doc: /* For internal use only.
usage: (define-coding-system-internal ...) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object name;
Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */
diff --git a/src/composite.c b/src/composite.c
index f069acce1c0..d402d5ad0c4 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -179,8 +179,8 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
Lisp_Object id, length, components, key, *key_contents;
int glyph_len;
struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
- int hash_index;
- unsigned hash_code;
+ EMACS_INT hash_index;
+ EMACS_UINT hash_code;
struct composition *cmp;
EMACS_INT i;
int ch;
@@ -285,7 +285,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
&& VECTORP (AREF (components, 0)))
{
/* COMPONENTS is a glyph-string. */
- EMACS_UINT len = ASIZE (key);
+ EMACS_INT len = ASIZE (key);
for (i = 1; i < len; i++)
if (! VECTORP (AREF (key, i)))
@@ -293,7 +293,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
}
else if (VECTORP (components) || CONSP (components))
{
- EMACS_UINT len = ASIZE (key);
+ EMACS_INT len = ASIZE (key);
/* The number of elements should be odd. */
if ((len % 2) == 0)
@@ -656,7 +656,7 @@ static Lisp_Object
gstring_lookup_cache (Lisp_Object header)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
- int i = hash_lookup (h, header, NULL);
+ EMACS_INT i = hash_lookup (h, header, NULL);
return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
}
@@ -665,7 +665,7 @@ Lisp_Object
composition_gstring_put_cache (Lisp_Object gstring, EMACS_INT len)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
- unsigned hash;
+ EMACS_UINT hash;
Lisp_Object header, copy;
EMACS_INT i;
@@ -673,13 +673,14 @@ composition_gstring_put_cache (Lisp_Object gstring, EMACS_INT len)
hash = h->hashfn (h, header);
if (len < 0)
{
- EMACS_UINT j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
+ EMACS_INT 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);
copy = Fmake_vector (make_number (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
@@ -705,7 +706,7 @@ int
composition_gstring_p (Lisp_Object gstring)
{
Lisp_Object header;
- int i;
+ EMACS_INT i;
if (! VECTORP (gstring) || ASIZE (gstring) < 2)
return 0;
@@ -858,7 +859,7 @@ fill_gstring_body (Lisp_Object gstring)
for (i = 0; i < len; i++)
{
Lisp_Object g = LGSTRING_GLYPH (gstring, i);
- EMACS_INT c = XINT (AREF (header, i + 1));
+ int c = XFASTINT (AREF (header, i + 1));
if (NILP (g))
{
@@ -966,17 +967,16 @@ autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT
}
static Lisp_Object _work_val;
-static int _work_char;
/* 1 iff the character C is composable. Characters of general
category Z? or C? are not composable except for ZWNJ and ZWJ. */
#define CHAR_COMPOSABLE_P(C) \
- ((C) == 0x200C || (C) == 0x200D \
- || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
- (SYMBOLP (_work_val) \
- && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
- && _work_char != 'Z')))
+ ((C) > ' ' \
+ && ((C) == 0x200C || (C) == 0x200D \
+ || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
+ (INTEGERP (_work_val) \
+ && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
BYTEPOS) where character composition may happen. If BYTEPOS is
@@ -994,7 +994,8 @@ static int _work_char;
void
composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, Lisp_Object string)
{
- EMACS_INT start, end, c;
+ EMACS_INT start, end;
+ int c;
Lisp_Object prop, val;
/* This is from forward_to_next_line_start in xdisp.c. */
const int MAX_NEWLINE_DISTANCE = 500;
@@ -1024,6 +1025,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
/* FIXME: Bidi is not yet handled well in static composition. */
if (charpos < endpos
&& find_composition (charpos, endpos, &start, &end, &prop, string)
+ && start >= charpos
&& COMPOSITION_VALID_P (start, end, prop))
{
cmp_it->stop_pos = endpos = start;
@@ -1250,7 +1252,7 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
{
Lisp_Object lgstring = Qnil;
Lisp_Object val, elt;
- int i;
+ EMACS_INT i;
val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
@@ -1471,7 +1473,7 @@ struct position_record
/* Update the members of POSITION to the previous character boundary. */
#define BACKWARD_CHAR(POSITION, STOP) \
do { \
- if ((POSITION).pos == STOP) \
+ if ((POSITION).pos == (STOP)) \
(POSITION).p = GPT_ADDR; \
do { \
(POSITION).pos_byte--; \
@@ -1481,180 +1483,199 @@ struct position_record
} while (0)
/* This is like find_composition, but find an automatic composition
- instead. If found, set *GSTRING to the glyph-string representing
- the composition, and return 1. Otherwise, return 0. */
+ 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. */
static int
-find_automatic_composition (EMACS_INT pos, EMACS_INT limit, EMACS_INT *start, EMACS_INT *end, Lisp_Object *gstring, Lisp_Object string)
+find_automatic_composition (EMACS_INT pos, EMACS_INT limit,
+ EMACS_INT *start, EMACS_INT *end,
+ Lisp_Object *gstring, Lisp_Object string)
{
EMACS_INT head, tail, stop;
- /* Limit to check a composition after POS. */
+ /* Forward limit position of checking a composition taking a
+ looking-back count into account. */
EMACS_INT fore_check_limit;
- struct position_record orig, cur;
-
- /* FIXME: It's not obvious whether these two variables need initialization.
- If they do, please supply initial values.
- If not, please remove this comment. */
- struct position_record check IF_LINT (= {0}), prev IF_LINT (= {0});
-
- Lisp_Object check_val, val, elt;
+ struct position_record cur, prev;
int c;
Lisp_Object window;
struct window *w;
+ int need_adjustment = 0;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
return 0;
w = XWINDOW (window);
- orig.pos = pos;
+ cur.pos = pos;
if (NILP (string))
{
head = BEGV, tail = ZV, stop = GPT;
- orig.pos_byte = CHAR_TO_BYTE (orig.pos);
- orig.p = BYTE_POS_ADDR (orig.pos_byte);
+ cur.pos_byte = CHAR_TO_BYTE (cur.pos);
+ cur.p = BYTE_POS_ADDR (cur.pos_byte);
}
else
{
head = 0, tail = SCHARS (string), stop = -1;
- orig.pos_byte = string_char_to_byte (string, orig.pos);
- orig.p = SDATA (string) + orig.pos_byte;
+ cur.pos_byte = string_char_to_byte (string, cur.pos);
+ cur.p = SDATA (string) + cur.pos_byte;
}
- if (limit < pos)
- fore_check_limit = min (tail, pos + MAX_AUTO_COMPOSITION_LOOKBACK);
+ if (limit < 0)
+ /* Finding a composition covering the character after POS is the
+ same as setting LIMIT to POS. */
+ limit = pos;
+ if (limit <= pos)
+ fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK);
else
fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
- cur = orig;
- retry:
- check_val = Qnil;
- /* At first, check if POS is composable. */
- c = STRING_CHAR (cur.p);
- if (! CHAR_COMPOSABLE_P (c))
- {
- if (limit < 0)
- return 0;
- if (limit >= cur.pos)
- goto search_forward;
- }
- else
- {
- val = CHAR_TABLE_REF (Vcomposition_function_table, c);
- if (! NILP (val))
- check_val = val, check = cur;
- else
- while (cur.pos + 1 < fore_check_limit)
- {
- EMACS_INT b, e;
+ /* Provided that we have these possible compositions now:
- FORWARD_CHAR (cur, stop);
- if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e,
- Qnil)
- && COMPOSITION_VALID_P (b, e, val))
- {
- fore_check_limit = cur.pos;
- break;
- }
- c = STRING_CHAR (cur.p);
- if (! CHAR_COMPOSABLE_P (c))
- break;
- val = CHAR_TABLE_REF (Vcomposition_function_table, c);
- if (NILP (val))
- continue;
- check_val = val, check = cur;
- break;
- }
- cur = orig;
- }
- /* Rewind back to the position where we can safely search forward
- for compositions. */
- while (cur.pos > head)
- {
- EMACS_INT b, e;
+ POS: 1 2 3 4 5 6 7 8 9
+ |-A-|
+ |-B-|-C-|--D--|
- BACKWARD_CHAR (cur, stop);
- if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e, Qnil)
- && COMPOSITION_VALID_P (b, e, val))
- break;
+ Here, it is known that characters after positions 1 and 9 can
+ never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
+ composition A is an invalid one because it's partially covered by
+ the valid composition C. And to know whether a composition is
+ valid or not, the only way is to start searching forward from a
+ position that can not be a tail part of composition (it's 2 in
+ the above case).
+
+ Now we have these cases (1 through 4):
+
+ -- character after POS is ... --
+ not composable composable
+ LIMIT <= POS (1) (3)
+ POS < LIMIT (2) (4)
+
+ Among them, in case (2), we simply search forward from POS.
+
+ In the other cases, we at first rewind back to the position where
+ the previous character is not composable or the beginning of
+ buffer (string), then search compositions forward. In case (1)
+ and (3) we repeat this process until a composition is found. */
+
+ while (1)
+ {
c = STRING_CHAR (cur.p);
if (! CHAR_COMPOSABLE_P (c))
- break;
- val = CHAR_TABLE_REF (Vcomposition_function_table, c);
- if (! NILP (val))
- check_val = val, check = cur;
- }
- prev = cur;
- /* Now search forward. */
- search_forward:
- *gstring = Qnil;
- if (! NILP (check_val) || limit >= orig.pos)
- {
- if (NILP (check_val))
- cur = orig;
- else
- cur = check;
- while (cur.pos < fore_check_limit)
{
- int need_adjustment = 0;
+ if (limit <= pos) /* case (1) */
+ {
+ do {
+ if (cur.pos <= limit)
+ return 0;
+ BACKWARD_CHAR (cur, stop);
+ c = STRING_CHAR (cur.p);
+ } while (! CHAR_COMPOSABLE_P (c));
+ fore_check_limit = cur.pos + 1;
+ }
+ else /* case (2) */
+ /* No need of rewinding back. */
+ goto search_forward;
+ }
- if (NILP (check_val))
+ /* Rewind back to the position where we can safely search
+ forward for compositions. It is assured that the character
+ at cur.pos is composable. */
+ while (head < cur.pos)
+ {
+ prev = cur;
+ BACKWARD_CHAR (cur, stop);
+ c = STRING_CHAR (cur.p);
+ if (! CHAR_COMPOSABLE_P (c))
{
- c = STRING_CHAR (cur.p);
- check_val = CHAR_TABLE_REF (Vcomposition_function_table, c);
+ cur = prev;
+ break;
}
- for (; CONSP (check_val); check_val = XCDR (check_val))
+ }
+
+ search_forward:
+ /* Now search forward. */
+ *gstring = Qnil;
+ prev = cur; /* remember the start of searching position. */
+ while (cur.pos < fore_check_limit)
+ {
+ Lisp_Object val;
+
+ c = STRING_CHAR (cur.p);
+ for (val = CHAR_TABLE_REF (Vcomposition_function_table, c);
+ CONSP (val); val = XCDR (val))
{
- elt = XCAR (check_val);
- if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
- && cur.pos - XFASTINT (AREF (elt, 1)) >= head)
+ Lisp_Object elt = XCAR (val);
+
+ if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)))
{
- check.pos = cur.pos - XFASTINT (AREF (elt, 1));
- if (check.pos == cur.pos)
- check.pos_byte = cur.pos_byte;
- else
- check.pos_byte = CHAR_TO_BYTE (check.pos);
- val = autocmp_chars (elt, check.pos, check.pos_byte,
- tail, w, NULL, string);
+ EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1));
+ struct position_record check;
+
+ if (check_pos < head
+ || (limit <= pos ? pos < check_pos
+ : limit <= check_pos))
+ continue;
+ for (check = cur; check_pos < check.pos; )
+ BACKWARD_CHAR (check, stop);
+ *gstring = autocmp_chars (elt, check.pos, check.pos_byte,
+ tail, w, NULL, string);
need_adjustment = 1;
- if (! NILP (val))
+ if (NILP (*gstring))
+ {
+ /* As we have called Lisp, there's a possibility
+ that buffer/string is relocated. */
+ if (NILP (string))
+ cur.p = BYTE_POS_ADDR (cur.pos_byte);
+ else
+ cur.p = SDATA (string) + cur.pos_byte;
+ }
+ else
{
- *gstring = val;
+ /* We found a candidate of a target composition. */
*start = check.pos;
*end = check.pos + LGSTRING_CHAR_LEN (*gstring);
- if (*start <= orig.pos ? *end > orig.pos
- : limit >= orig.pos)
+ if (pos < limit
+ ? pos < *end
+ : *start <= pos && pos < *end)
+ /* This is the target composition. */
return 1;
cur.pos = *end;
- cur.pos_byte = CHAR_TO_BYTE (cur.pos);
+ if (NILP (string))
+ {
+ cur.pos_byte = CHAR_TO_BYTE (cur.pos);
+ cur.p = BYTE_POS_ADDR (cur.pos_byte);
+ }
+ else
+ {
+ cur.pos_byte = string_char_to_byte (string, cur.pos);
+ cur.p = SDATA (string) + cur.pos_byte;
+ }
break;
}
}
}
- if (need_adjustment)
- {
- /* As we have called Lisp, there's a possibility that
- buffer/string is relocated. */
- if (NILP (string))
- cur.p = BYTE_POS_ADDR (cur.pos_byte);
- else
- cur.p = SDATA (string) + cur.pos_byte;
- }
- if (! CONSP (check_val))
+ if (! CONSP (val))
+ /* We found no composition here. */
FORWARD_CHAR (cur, stop);
- check_val = Qnil;
}
- }
- if (! NILP (*gstring))
- return (limit >= 0 || (*start <= orig.pos && *end > orig.pos));
- if (limit >= 0 && limit < orig.pos && prev.pos > head)
- {
+
+ if (pos < limit) /* case (2) and (4)*/
+ return 0;
+ if (! NILP (*gstring))
+ return 1;
+ if (prev.pos == head)
+ return 0;
cur = prev;
+ if (need_adjustment)
+ {
+ if (NILP (string))
+ cur.p = BYTE_POS_ADDR (cur.pos_byte);
+ else
+ cur.p = SDATA (string) + cur.pos_byte;
+ }
BACKWARD_CHAR (cur, stop);
- orig = cur;
- fore_check_limit = orig.pos;
- goto retry;
}
- return 0;
}
/* Return the adjusted point provided that point is moved from LAST_PT
@@ -1663,9 +1684,8 @@ find_automatic_composition (EMACS_INT pos, EMACS_INT limit, EMACS_INT *start, EM
EMACS_INT
composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt)
{
- EMACS_INT beg, end;
+ EMACS_INT i, beg, end;
Lisp_Object val;
- int i;
if (new_pt == BEGV || new_pt == ZV)
return new_pt;
@@ -1916,8 +1936,7 @@ syms_of_composite (void)
{
int i;
- Qcomposition = intern_c_string ("composition");
- staticpro (&Qcomposition);
+ DEFSYM (Qcomposition, "composition");
/* Make a hash table for static composition. */
{
@@ -1976,11 +1995,8 @@ valid.
The default value is the function `compose-chars-after'. */);
Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
- Qauto_composed = intern_c_string ("auto-composed");
- staticpro (&Qauto_composed);
-
- Qauto_composition_function = intern_c_string ("auto-composition-function");
- staticpro (&Qauto_composition_function);
+ DEFSYM (Qauto_composed, "auto-composed");
+ DEFSYM (Qauto_composition_function, "auto-composition-function");
DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode,
doc: /* Non-nil if Auto-Composition mode is enabled.
diff --git a/src/composite.h b/src/composite.h
index 5188f981d9c..8cedfdbe352 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -151,7 +151,7 @@ extern Lisp_Object composition_temp;
/* Nonzero if the global reference point GREF and new reference point NREF are
valid. */
#define COMPOSITION_ENCODE_RULE_VALID(gref, nref) \
- ((unsigned) (gref) < 12 && (unsigned) (nref) < 12)
+ (UNSIGNED_CMP (gref, <, 12) && UNSIGNED_CMP (nref, <, 12))
/* Return encoded composition rule for the pair of global reference
point GREF and new reference point NREF. Arguments must be valid. */
@@ -186,7 +186,7 @@ struct composition {
enum composition_method method;
/* Index to the composition hash table. */
- int hash_index;
+ EMACS_INT hash_index;
/* For which font we have calculated the remaining members. The
actual type is device dependent. */
@@ -265,10 +265,7 @@ enum lglyph_indices
#define LGLYPH_CODE(g) \
(NILP (AREF ((g), LGLYPH_IX_CODE)) \
? FONT_INVALID_CODE \
- : CONSP (AREF ((g), LGLYPH_IX_CODE)) \
- ? ((XFASTINT (XCAR (AREF ((g), LGLYPH_IX_CODE))) << 16) \
- | (XFASTINT (XCDR (AREF ((g), LGLYPH_IX_CODE))))) \
- : XFASTINT (AREF ((g), LGLYPH_IX_CODE)))
+ : cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned)))
#define LGLYPH_WIDTH(g) XINT (AREF ((g), LGLYPH_IX_WIDTH))
#define LGLYPH_LBEARING(g) XINT (AREF ((g), LGLYPH_IX_LBEARING))
#define LGLYPH_RBEARING(g) XINT (AREF ((g), LGLYPH_IX_RBEARING))
@@ -280,15 +277,8 @@ enum lglyph_indices
#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_number (val))
/* Callers must assure that VAL is not negative! */
#define LGLYPH_SET_CODE(g, val) \
- do { \
- if (val == FONT_INVALID_CODE) \
- ASET ((g), LGLYPH_IX_CODE, Qnil); \
- else if ((EMACS_INT)val > MOST_POSITIVE_FIXNUM) \
- ASET ((g), LGLYPH_IX_CODE, Fcons (make_number ((val) >> 16), \
- make_number ((val) & 0xFFFF))); \
- else \
- ASET ((g), LGLYPH_IX_CODE, make_number (val)); \
- } while (0)
+ ASET (g, LGLYPH_IX_CODE, \
+ val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val))
#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_number (val))
#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_number (val))
diff --git a/src/data.c b/src/data.c
index 577ae777d89..7bc04592c57 100644
--- a/src/data.c
+++ b/src/data.c
@@ -22,6 +22,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <signal.h>
#include <stdio.h>
#include <setjmp.h>
+
+#include <intprops.h>
+
#include "lisp.h"
#include "puresize.h"
#include "character.h"
@@ -29,14 +32,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "frame.h"
#include "syssignal.h"
-#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
+#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
#include "font.h"
#ifdef STDC_HEADERS
#include <float.h>
#endif
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
+/* 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)
@@ -87,7 +90,8 @@ static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
Lisp_Object Qwindow;
static Lisp_Object Qfloat, Qwindow_configuration;
static Lisp_Object Qprocess;
-static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
+static Lisp_Object Qcompiled_function, Qframe, Qvector;
+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;
@@ -699,7 +703,7 @@ SUBR must be a built-in function. */)
const char *name;
CHECK_SUBR (subr);
name = XSUBR (subr)->symbol_name;
- return make_string (name, strlen (name));
+ return build_string (name);
}
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
@@ -2144,61 +2148,62 @@ bool-vector. IDX starts at 0. */)
CHECK_CHARACTER (idx);
CHAR_TABLE_SET (array, idxval, newelt);
}
- else if (STRING_MULTIBYTE (array))
+ else
{
- EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes;
- unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
+ int c;
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_CHARACTER (newelt);
+ c = XFASTINT (newelt);
- nbytes = SBYTES (array);
-
- idxval_byte = string_char_to_byte (array, idxval);
- p1 = SDATA (array) + idxval_byte;
- prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
- new_bytes = CHAR_STRING (XINT (newelt), p0);
- if (prev_bytes != new_bytes)
+ if (STRING_MULTIBYTE (array))
{
- /* We must relocate the string data. */
- EMACS_INT nchars = SCHARS (array);
- unsigned char *str;
- USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA (str, unsigned char *, nbytes);
- memcpy (str, SDATA (array), nbytes);
- allocate_string_data (XSTRING (array), nchars,
- nbytes + new_bytes - prev_bytes);
- memcpy (SDATA (array), str, idxval_byte);
+ EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes;
+ unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
+
+ nbytes = SBYTES (array);
+ idxval_byte = string_char_to_byte (array, idxval);
p1 = SDATA (array) + idxval_byte;
- memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
- nbytes - (idxval_byte + prev_bytes));
- SAFE_FREE ();
- clear_string_char_byte_cache ();
+ prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
+ new_bytes = CHAR_STRING (c, p0);
+ if (prev_bytes != new_bytes)
+ {
+ /* We must relocate the string data. */
+ EMACS_INT nchars = SCHARS (array);
+ unsigned char *str;
+ USE_SAFE_ALLOCA;
+
+ SAFE_ALLOCA (str, unsigned char *, nbytes);
+ memcpy (str, SDATA (array), nbytes);
+ allocate_string_data (XSTRING (array), nchars,
+ nbytes + new_bytes - prev_bytes);
+ memcpy (SDATA (array), str, idxval_byte);
+ p1 = SDATA (array) + idxval_byte;
+ memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
+ nbytes - (idxval_byte + prev_bytes));
+ SAFE_FREE ();
+ clear_string_char_byte_cache ();
+ }
+ while (new_bytes--)
+ *p1++ = *p0++;
}
- while (new_bytes--)
- *p1++ = *p0++;
- }
- else
- {
- if (idxval < 0 || idxval >= SCHARS (array))
- args_out_of_range (array, idx);
- CHECK_NUMBER (newelt);
-
- if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt)))
+ else
{
- int i;
-
- for (i = SBYTES (array) - 1; i >= 0; i--)
- if (SREF (array, i) >= 0x80)
- args_out_of_range (array, newelt);
- /* ARRAY is an ASCII string. Convert it to a multibyte
- string, and try `aset' again. */
- STRING_SET_MULTIBYTE (array);
- return Faset (array, idx, newelt);
+ if (! SINGLE_BYTE_CHAR_P (c))
+ {
+ int i;
+
+ for (i = SBYTES (array) - 1; i >= 0; i--)
+ if (SREF (array, i) >= 0x80)
+ args_out_of_range (array, newelt);
+ /* ARRAY is an ASCII string. Convert it to a multibyte
+ string, and try `aset' again. */
+ STRING_SET_MULTIBYTE (array);
+ return Faset (array, idx, newelt);
+ }
+ SSET (array, idxval, c);
}
- SSET (array, idxval, XINT (newelt));
}
return newelt;
@@ -2323,33 +2328,110 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
return Qnil;
}
-/* Convert between long values and pairs of Lisp integers.
- Note that long_to_cons returns a single Lisp integer
- when the value fits in one. */
+/* Convert the cons-of-integers, integer, or float value C to an
+ unsigned value with maximum value MAX. Signal an error if C does not
+ have a valid format or is out of range. */
+uintmax_t
+cons_to_unsigned (Lisp_Object c, uintmax_t max)
+{
+ int valid = 0;
+ uintmax_t val IF_LINT (= 0);
+ if (INTEGERP (c))
+ {
+ valid = 0 <= XINT (c);
+ val = XINT (c);
+ }
+ else if (FLOATP (c))
+ {
+ double d = XFLOAT_DATA (c);
+ if (0 <= d
+ && d < (max == UINTMAX_MAX ? (double) UINTMAX_MAX + 1 : max + 1))
+ {
+ val = d;
+ valid = 1;
+ }
+ }
+ else if (CONSP (c) && NATNUMP (XCAR (c)))
+ {
+ uintmax_t top = XFASTINT (XCAR (c));
+ Lisp_Object rest = XCDR (c);
+ if (top <= UINTMAX_MAX >> 24 >> 16
+ && CONSP (rest)
+ && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24
+ && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16)
+ {
+ uintmax_t mid = XFASTINT (XCAR (rest));
+ val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest));
+ valid = 1;
+ }
+ else if (top <= UINTMAX_MAX >> 16)
+ {
+ if (CONSP (rest))
+ rest = XCAR (rest);
+ if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16)
+ {
+ val = top << 16 | XFASTINT (rest);
+ valid = 1;
+ }
+ }
+ }
-Lisp_Object
-long_to_cons (long unsigned int i)
-{
- unsigned long top = i >> 16;
- unsigned int bot = i & 0xFFFF;
- if (top == 0)
- return make_number (bot);
- if (top == (unsigned long)-1 >> 16)
- return Fcons (make_number (-1), make_number (bot));
- return Fcons (make_number (top), make_number (bot));
+ if (! (valid && val <= max))
+ error ("Not an in-range integer, float, or cons of integers");
+ return val;
}
-unsigned long
-cons_to_long (Lisp_Object c)
+/* Convert the cons-of-integers, integer, or float value C to a signed
+ value with extrema MIN and MAX. Signal an error if C does not have
+ a valid format or is out of range. */
+intmax_t
+cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
- Lisp_Object top, bot;
+ int valid = 0;
+ intmax_t val IF_LINT (= 0);
if (INTEGERP (c))
- return XINT (c);
- top = XCAR (c);
- bot = XCDR (c);
- if (CONSP (bot))
- bot = XCAR (bot);
- return ((XINT (top) << 16) | XINT (bot));
+ {
+ val = XINT (c);
+ valid = 1;
+ }
+ else if (FLOATP (c))
+ {
+ double d = XFLOAT_DATA (c);
+ if (min <= d
+ && d < (max == INTMAX_MAX ? (double) INTMAX_MAX + 1 : max + 1))
+ {
+ val = d;
+ valid = 1;
+ }
+ }
+ else if (CONSP (c) && INTEGERP (XCAR (c)))
+ {
+ intmax_t top = XINT (XCAR (c));
+ Lisp_Object rest = XCDR (c);
+ if (INTMAX_MIN >> 24 >> 16 <= top && top <= INTMAX_MAX >> 24 >> 16
+ && CONSP (rest)
+ && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24
+ && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16)
+ {
+ intmax_t mid = XFASTINT (XCAR (rest));
+ val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest));
+ valid = 1;
+ }
+ else if (INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16)
+ {
+ if (CONSP (rest))
+ rest = XCAR (rest);
+ if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16)
+ {
+ val = top << 16 | XFASTINT (rest);
+ valid = 1;
+ }
+ }
+ }
+
+ if (! (valid && min <= val && val <= max))
+ error ("Not an in-range integer, float, or cons of integers");
+ return val;
}
DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
@@ -2421,16 +2503,20 @@ enum arithop
Amin
};
-static Lisp_Object float_arith_driver (double, size_t, enum arithop,
- size_t, Lisp_Object *);
+static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
+ ptrdiff_t, Lisp_Object *);
static Lisp_Object
-arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
+arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object val;
- register size_t argnum;
+ ptrdiff_t argnum;
register EMACS_INT accum = 0;
register EMACS_INT next;
+ int overflow = 0;
+ ptrdiff_t ok_args;
+ EMACS_INT ok_accum;
+
switch (SWITCH_ENUM_CAST (code))
{
case Alogior:
@@ -2451,25 +2537,48 @@ arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
for (argnum = 0; argnum < nargs; argnum++)
{
+ if (! overflow)
+ {
+ ok_args = argnum;
+ ok_accum = accum;
+ }
+
/* Using args[argnum] as argument to CHECK_NUMBER_... */
val = args[argnum];
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
if (FLOATP (val))
- return float_arith_driver ((double) accum, argnum, code,
+ return float_arith_driver (ok_accum, ok_args, code,
nargs, args);
args[argnum] = val;
next = XINT (args[argnum]);
switch (SWITCH_ENUM_CAST (code))
{
case Aadd:
+ if (INT_ADD_OVERFLOW (accum, next))
+ {
+ overflow = 1;
+ accum &= INTMASK;
+ }
accum += next;
break;
case Asub:
+ if (INT_SUBTRACT_OVERFLOW (accum, next))
+ {
+ overflow = 1;
+ accum &= INTMASK;
+ }
accum = argnum ? accum - next : nargs == 1 ? - next : next;
break;
case Amult:
- accum *= next;
+ if (INT_MULTIPLY_OVERFLOW (accum, next))
+ {
+ EMACS_UINT a = accum, b = next, ab = a * b;
+ overflow = 1;
+ accum = ab & INTMASK;
+ }
+ else
+ accum *= next;
break;
case Adiv:
if (!argnum)
@@ -2509,8 +2618,8 @@ arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
#define isnan(x) ((x) != (x))
static Lisp_Object
-float_arith_driver (double accum, register size_t argnum, enum arithop code,
- size_t nargs, register Lisp_Object *args)
+float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
+ ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object val;
double next;
@@ -2572,7 +2681,7 @@ float_arith_driver (double accum, register size_t argnum, enum arithop code,
DEFUN ("+", Fplus, Splus, 0, MANY, 0,
doc: /* Return sum of any number of arguments, which are numbers or markers.
usage: (+ &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Aadd, nargs, args);
}
@@ -2582,7 +2691,7 @@ DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
With one arg, negates it. With more than one arg,
subtracts all but the first from the first.
usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Asub, nargs, args);
}
@@ -2590,7 +2699,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
doc: /* Return product of any number of arguments, which are numbers or markers.
usage: (* &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Amult, nargs, args);
}
@@ -2599,9 +2708,9 @@ DEFUN ("/", Fquo, Squo, 2, MANY, 0,
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- size_t argnum;
+ ptrdiff_t argnum;
for (argnum = 2; argnum < nargs; argnum++)
if (FLOATP (args[argnum]))
return float_arith_driver (0, 0, Adiv, nargs, args);
@@ -2627,8 +2736,7 @@ Both must be integers or markers. */)
#ifndef HAVE_FMOD
double
-fmod (f1, f2)
- double f1, f2;
+fmod (double f1, double f2)
{
double r = f1;
@@ -2683,7 +2791,7 @@ DEFUN ("max", Fmax, Smax, 1, MANY, 0,
doc: /* Return largest of all the arguments (which must be numbers or markers).
The value is always a number; markers are converted to numbers.
usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Amax, nargs, args);
}
@@ -2692,7 +2800,7 @@ DEFUN ("min", Fmin, Smin, 1, MANY, 0,
doc: /* Return smallest of all the arguments (which must be numbers or markers).
The value is always a number; markers are converted to numbers.
usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Amin, nargs, args);
}
@@ -2701,7 +2809,7 @@ DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
doc: /* Return bitwise-and of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logand &rest INTS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Alogand, nargs, args);
}
@@ -2710,7 +2818,7 @@ DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
doc: /* Return bitwise-or of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logior &rest INTS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Alogior, nargs, args);
}
@@ -2719,7 +2827,7 @@ DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
doc: /* Return bitwise-exclusive-or of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logxor &rest INTS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Alogxor, nargs, args);
}
@@ -2760,11 +2868,11 @@ In this case, zeros are shifted in on the left. */)
if (XINT (count) >= BITS_PER_EMACS_INT)
XSETINT (val, 0);
else if (XINT (count) > 0)
- XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
+ XSETINT (val, XUINT (value) << XFASTINT (count));
else if (XINT (count) <= -BITS_PER_EMACS_INT)
XSETINT (val, 0);
else
- XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
+ XSETINT (val, XUINT (value) >> -XINT (count));
return val;
}
@@ -2824,74 +2932,75 @@ syms_of_data (void)
{
Lisp_Object error_tail, arith_tail;
- Qquote = intern_c_string ("quote");
- Qlambda = intern_c_string ("lambda");
- Qsubr = intern_c_string ("subr");
- Qerror_conditions = intern_c_string ("error-conditions");
- Qerror_message = intern_c_string ("error-message");
- Qtop_level = intern_c_string ("top-level");
-
- Qerror = intern_c_string ("error");
- Qquit = intern_c_string ("quit");
- Qwrong_type_argument = intern_c_string ("wrong-type-argument");
- Qargs_out_of_range = intern_c_string ("args-out-of-range");
- Qvoid_function = intern_c_string ("void-function");
- Qcyclic_function_indirection = intern_c_string ("cyclic-function-indirection");
- Qcyclic_variable_indirection = intern_c_string ("cyclic-variable-indirection");
- Qvoid_variable = intern_c_string ("void-variable");
- Qsetting_constant = intern_c_string ("setting-constant");
- Qinvalid_read_syntax = intern_c_string ("invalid-read-syntax");
-
- Qinvalid_function = intern_c_string ("invalid-function");
- Qwrong_number_of_arguments = intern_c_string ("wrong-number-of-arguments");
- Qno_catch = intern_c_string ("no-catch");
- Qend_of_file = intern_c_string ("end-of-file");
- Qarith_error = intern_c_string ("arith-error");
- Qbeginning_of_buffer = intern_c_string ("beginning-of-buffer");
- Qend_of_buffer = intern_c_string ("end-of-buffer");
- Qbuffer_read_only = intern_c_string ("buffer-read-only");
- Qtext_read_only = intern_c_string ("text-read-only");
- Qmark_inactive = intern_c_string ("mark-inactive");
-
- Qlistp = intern_c_string ("listp");
- Qconsp = intern_c_string ("consp");
- Qsymbolp = intern_c_string ("symbolp");
- Qkeywordp = intern_c_string ("keywordp");
- Qintegerp = intern_c_string ("integerp");
- Qnatnump = intern_c_string ("natnump");
- Qwholenump = intern_c_string ("wholenump");
- Qstringp = intern_c_string ("stringp");
- Qarrayp = intern_c_string ("arrayp");
- Qsequencep = intern_c_string ("sequencep");
- Qbufferp = intern_c_string ("bufferp");
- Qvectorp = intern_c_string ("vectorp");
- Qchar_or_string_p = intern_c_string ("char-or-string-p");
- Qmarkerp = intern_c_string ("markerp");
- Qbuffer_or_string_p = intern_c_string ("buffer-or-string-p");
- Qinteger_or_marker_p = intern_c_string ("integer-or-marker-p");
- Qboundp = intern_c_string ("boundp");
- Qfboundp = intern_c_string ("fboundp");
-
- Qfloatp = intern_c_string ("floatp");
- Qnumberp = intern_c_string ("numberp");
- Qnumber_or_marker_p = intern_c_string ("number-or-marker-p");
-
- Qchar_table_p = intern_c_string ("char-table-p");
- Qvector_or_char_table_p = intern_c_string ("vector-or-char-table-p");
-
- Qsubrp = intern_c_string ("subrp");
- Qunevalled = intern_c_string ("unevalled");
- Qmany = intern_c_string ("many");
-
- Qcdr = intern_c_string ("cdr");
-
- /* Handle automatic advice activation */
- Qad_advice_info = intern_c_string ("ad-advice-info");
- Qad_activate_internal = intern_c_string ("ad-activate-internal");
+ DEFSYM (Qquote, "quote");
+ DEFSYM (Qlambda, "lambda");
+ DEFSYM (Qsubr, "subr");
+ DEFSYM (Qerror_conditions, "error-conditions");
+ DEFSYM (Qerror_message, "error-message");
+ DEFSYM (Qtop_level, "top-level");
+
+ DEFSYM (Qerror, "error");
+ DEFSYM (Qquit, "quit");
+ DEFSYM (Qwrong_type_argument, "wrong-type-argument");
+ DEFSYM (Qargs_out_of_range, "args-out-of-range");
+ DEFSYM (Qvoid_function, "void-function");
+ DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection");
+ DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection");
+ DEFSYM (Qvoid_variable, "void-variable");
+ DEFSYM (Qsetting_constant, "setting-constant");
+ DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax");
+
+ DEFSYM (Qinvalid_function, "invalid-function");
+ DEFSYM (Qwrong_number_of_arguments, "wrong-number-of-arguments");
+ DEFSYM (Qno_catch, "no-catch");
+ DEFSYM (Qend_of_file, "end-of-file");
+ DEFSYM (Qarith_error, "arith-error");
+ DEFSYM (Qbeginning_of_buffer, "beginning-of-buffer");
+ DEFSYM (Qend_of_buffer, "end-of-buffer");
+ DEFSYM (Qbuffer_read_only, "buffer-read-only");
+ DEFSYM (Qtext_read_only, "text-read-only");
+ DEFSYM (Qmark_inactive, "mark-inactive");
+
+ DEFSYM (Qlistp, "listp");
+ DEFSYM (Qconsp, "consp");
+ DEFSYM (Qsymbolp, "symbolp");
+ DEFSYM (Qkeywordp, "keywordp");
+ DEFSYM (Qintegerp, "integerp");
+ DEFSYM (Qnatnump, "natnump");
+ DEFSYM (Qwholenump, "wholenump");
+ DEFSYM (Qstringp, "stringp");
+ DEFSYM (Qarrayp, "arrayp");
+ DEFSYM (Qsequencep, "sequencep");
+ DEFSYM (Qbufferp, "bufferp");
+ DEFSYM (Qvectorp, "vectorp");
+ DEFSYM (Qchar_or_string_p, "char-or-string-p");
+ DEFSYM (Qmarkerp, "markerp");
+ DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
+ DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
+ DEFSYM (Qboundp, "boundp");
+ DEFSYM (Qfboundp, "fboundp");
+
+ DEFSYM (Qfloatp, "floatp");
+ DEFSYM (Qnumberp, "numberp");
+ DEFSYM (Qnumber_or_marker_p, "number-or-marker-p");
+
+ DEFSYM (Qchar_table_p, "char-table-p");
+ DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p");
+
+ DEFSYM (Qsubrp, "subrp");
+ DEFSYM (Qunevalled, "unevalled");
+ DEFSYM (Qmany, "many");
+
+ DEFSYM (Qcdr, "cdr");
+
+ /* Handle automatic advice activation. */
+ DEFSYM (Qad_advice_info, "ad-advice-info");
+ DEFSYM (Qad_activate_internal, "ad-activate-internal");
error_tail = pure_cons (Qerror, Qnil);
- /* ERROR is used as a signaler for random errors for which nothing else is right */
+ /* ERROR is used as a signaler for random errors for which nothing else is
+ right. */
Fput (Qerror, Qerror_conditions,
error_tail);
@@ -2928,8 +3037,7 @@ syms_of_data (void)
Fput (Qcyclic_variable_indirection, Qerror_message,
make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
- Qcircular_list = intern_c_string ("circular-list");
- staticpro (&Qcircular_list);
+ DEFSYM (Qcircular_list, "circular-list");
Fput (Qcircular_list, Qerror_conditions,
pure_cons (Qcircular_list, error_tail));
Fput (Qcircular_list, Qerror_message,
@@ -2996,11 +3104,11 @@ syms_of_data (void)
Fput (Qtext_read_only, Qerror_message,
make_pure_c_string ("Text is read-only"));
- Qrange_error = intern_c_string ("range-error");
- Qdomain_error = intern_c_string ("domain-error");
- Qsingularity_error = intern_c_string ("singularity-error");
- Qoverflow_error = intern_c_string ("overflow-error");
- Qunderflow_error = intern_c_string ("underflow-error");
+ DEFSYM (Qrange_error, "range-error");
+ DEFSYM (Qdomain_error, "domain-error");
+ DEFSYM (Qsingularity_error, "singularity-error");
+ DEFSYM (Qoverflow_error, "overflow-error");
+ DEFSYM (Qunderflow_error, "underflow-error");
Fput (Qdomain_error, Qerror_conditions,
pure_cons (Qdomain_error, arith_tail));
@@ -3027,93 +3135,29 @@ syms_of_data (void)
Fput (Qunderflow_error, Qerror_message,
make_pure_c_string ("Arithmetic underflow error"));
- staticpro (&Qrange_error);
- staticpro (&Qdomain_error);
- staticpro (&Qsingularity_error);
- staticpro (&Qoverflow_error);
- staticpro (&Qunderflow_error);
-
staticpro (&Qnil);
staticpro (&Qt);
- staticpro (&Qquote);
- staticpro (&Qlambda);
- staticpro (&Qsubr);
staticpro (&Qunbound);
- staticpro (&Qerror_conditions);
- staticpro (&Qerror_message);
- staticpro (&Qtop_level);
-
- staticpro (&Qerror);
- staticpro (&Qquit);
- staticpro (&Qwrong_type_argument);
- staticpro (&Qargs_out_of_range);
- staticpro (&Qvoid_function);
- staticpro (&Qcyclic_function_indirection);
- staticpro (&Qcyclic_variable_indirection);
- staticpro (&Qvoid_variable);
- staticpro (&Qsetting_constant);
- staticpro (&Qinvalid_read_syntax);
- staticpro (&Qwrong_number_of_arguments);
- staticpro (&Qinvalid_function);
- staticpro (&Qno_catch);
- staticpro (&Qend_of_file);
- staticpro (&Qarith_error);
- staticpro (&Qbeginning_of_buffer);
- staticpro (&Qend_of_buffer);
- staticpro (&Qbuffer_read_only);
- staticpro (&Qtext_read_only);
- staticpro (&Qmark_inactive);
-
- staticpro (&Qlistp);
- staticpro (&Qconsp);
- staticpro (&Qsymbolp);
- staticpro (&Qkeywordp);
- staticpro (&Qintegerp);
- staticpro (&Qnatnump);
- staticpro (&Qwholenump);
- staticpro (&Qstringp);
- staticpro (&Qarrayp);
- staticpro (&Qsequencep);
- staticpro (&Qbufferp);
- staticpro (&Qvectorp);
- staticpro (&Qchar_or_string_p);
- staticpro (&Qmarkerp);
- staticpro (&Qbuffer_or_string_p);
- staticpro (&Qinteger_or_marker_p);
- staticpro (&Qfloatp);
- staticpro (&Qnumberp);
- staticpro (&Qnumber_or_marker_p);
- staticpro (&Qchar_table_p);
- staticpro (&Qvector_or_char_table_p);
- staticpro (&Qsubrp);
- staticpro (&Qmany);
- staticpro (&Qunevalled);
-
- staticpro (&Qboundp);
- staticpro (&Qfboundp);
- staticpro (&Qcdr);
- staticpro (&Qad_advice_info);
- staticpro (&Qad_activate_internal);
/* Types that type-of returns. */
- Qinteger = intern_c_string ("integer");
- Qsymbol = intern_c_string ("symbol");
- Qstring = intern_c_string ("string");
- Qcons = intern_c_string ("cons");
- Qmarker = intern_c_string ("marker");
- Qoverlay = intern_c_string ("overlay");
- Qfloat = intern_c_string ("float");
- Qwindow_configuration = intern_c_string ("window-configuration");
- Qprocess = intern_c_string ("process");
- Qwindow = intern_c_string ("window");
- /* Qsubr = intern_c_string ("subr"); */
- Qcompiled_function = intern_c_string ("compiled-function");
- Qbuffer = intern_c_string ("buffer");
- Qframe = intern_c_string ("frame");
- Qvector = intern_c_string ("vector");
- Qchar_table = intern_c_string ("char-table");
- Qbool_vector = intern_c_string ("bool-vector");
- Qhash_table = intern_c_string ("hash-table");
+ DEFSYM (Qinteger, "integer");
+ DEFSYM (Qsymbol, "symbol");
+ DEFSYM (Qstring, "string");
+ DEFSYM (Qcons, "cons");
+ DEFSYM (Qmarker, "marker");
+ DEFSYM (Qoverlay, "overlay");
+ DEFSYM (Qfloat, "float");
+ 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");
+ DEFSYM (Qvector, "vector");
+ DEFSYM (Qchar_table, "char-table");
+ DEFSYM (Qbool_vector, "bool-vector");
+ DEFSYM (Qhash_table, "hash-table");
DEFSYM (Qfont_spec, "font-spec");
DEFSYM (Qfont_entity, "font-entity");
@@ -3121,25 +3165,6 @@ syms_of_data (void)
DEFSYM (Qinteractive_form, "interactive-form");
- staticpro (&Qinteger);
- staticpro (&Qsymbol);
- staticpro (&Qstring);
- staticpro (&Qcons);
- staticpro (&Qmarker);
- staticpro (&Qoverlay);
- staticpro (&Qfloat);
- staticpro (&Qwindow_configuration);
- staticpro (&Qprocess);
- staticpro (&Qwindow);
- /* staticpro (&Qsubr); */
- staticpro (&Qcompiled_function);
- staticpro (&Qbuffer);
- staticpro (&Qframe);
- staticpro (&Qvector);
- staticpro (&Qchar_table);
- staticpro (&Qbool_vector);
- staticpro (&Qhash_table);
-
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
defsubr (&Seq);
@@ -3273,8 +3298,4 @@ init_data (void)
return;
#endif /* CANNOT_DUMP */
signal (SIGFPE, arith_error);
-
-#ifdef uts
- signal (SIGEMT, arith_error);
-#endif /* uts */
}
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 80c52dc3bd0..4828f4e968d 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -111,13 +111,12 @@ static int xd_in_read_queued_messages = 0;
/* Raise a Lisp error from a D-Bus ERROR. */
#define XD_ERROR(error) \
do { \
- char s[1024]; \
- strncpy (s, error.message, 1023); \
- dbus_error_free (&error); \
/* Remove the trailing newline. */ \
- if (strchr (s, '\n') != NULL) \
- s[strlen (s) - 1] = '\0'; \
- XD_SIGNAL1 (build_string (s)); \
+ char const *mess = error.message; \
+ char const *nl = strchr (mess, '\n'); \
+ Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
+ dbus_error_free (&error); \
+ XD_SIGNAL1 (err); \
} while (0)
/* Macros for debugging. In order to enable them, build with
@@ -126,7 +125,7 @@ static int xd_in_read_queued_messages = 0;
#define XD_DEBUG_MESSAGE(...) \
do { \
char s[1024]; \
- snprintf (s, 1023, __VA_ARGS__); \
+ snprintf (s, sizeof s, __VA_ARGS__); \
printf ("%s: %s\n", __func__, s); \
message ("%s: %s", __func__, s); \
} while (0)
@@ -242,6 +241,24 @@ 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)
+
/* Compute SIGNATURE of OBJECT. It must have a form that it can be
used in dbus_message_iter_open_container. DTYPE is the DBusType
the object is related to. It is passed as argument, because it
@@ -431,9 +448,9 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
switch (dtype)
{
case DBUS_TYPE_BYTE:
- CHECK_NUMBER (object);
+ CHECK_NATNUM (object);
{
- unsigned char val = XUINT (object) & 0xFF;
+ unsigned char val = XFASTINT (object) & 0xFF;
XD_DEBUG_MESSAGE ("%c %d", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -460,9 +477,9 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
}
case DBUS_TYPE_UINT16:
- CHECK_NUMBER (object);
+ CHECK_NATNUM (object);
{
- dbus_uint16_t val = XUINT (object);
+ dbus_uint16_t val = XFASTINT (object);
XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -483,9 +500,9 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
#ifdef DBUS_TYPE_UNIX_FD
case DBUS_TYPE_UNIX_FD:
#endif
- CHECK_NUMBER (object);
+ CHECK_NATNUM (object);
{
- dbus_uint32_t val = XUINT (object);
+ dbus_uint32_t val = XFASTINT (object);
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);
@@ -503,10 +520,10 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
}
case DBUS_TYPE_UINT64:
- CHECK_NUMBER (object);
+ CHECK_NATNUM (object);
{
- dbus_uint64_t val = XUINT (object);
- XD_DEBUG_MESSAGE ("%c %"pI"u", dtype, XUINT (object));
+ dbus_uint64_t val = XFASTINT (object);
+ XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
@@ -1060,7 +1077,7 @@ object is returned instead of a list containing this single Lisp object.
=> "i686"
usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, method;
Lisp_Object result;
@@ -1072,7 +1089,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
DBusError derror;
unsigned int dtype;
int timeout = -1;
- size_t i = 5;
+ ptrdiff_t i = 5;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
@@ -1110,7 +1127,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
{
CHECK_NATNUM (args[i+1]);
- timeout = XUINT (args[i+1]);
+ timeout = XFASTINT (args[i+1]);
i = i+2;
}
@@ -1125,7 +1142,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-4),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
@@ -1133,7 +1150,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-4),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
SDATA (format2 ("%s", args[i], Qnil)));
}
@@ -1186,7 +1203,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
/* Return the result. If there is only one single Lisp object,
return it as-it-is, otherwise return the reversed list. */
- if (XUINT (Flength (result)) == 1)
+ if (XFASTINT (Flength (result)) == 1)
RETURN_UNGCPRO (CAR_SAFE (result));
else
RETURN_UNGCPRO (Fnreverse (result));
@@ -1242,7 +1259,7 @@ Example:
-| i686
usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, method, handler;
Lisp_Object result;
@@ -1251,8 +1268,9 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
+ dbus_uint32_t serial;
int timeout = -1;
- size_t i = 6;
+ ptrdiff_t i = 6;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
@@ -1292,7 +1310,7 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
{
CHECK_NATNUM (args[i+1]);
- timeout = XUINT (args[i+1]);
+ timeout = XFASTINT (args[i+1]);
i = i+2;
}
@@ -1307,7 +1325,7 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-4),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
@@ -1315,7 +1333,7 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i - 4),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
SDATA (format2 ("%s", args[i], Qnil)));
}
@@ -1335,7 +1353,8 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
XD_SIGNAL1 (build_string ("Cannot send message"));
/* The result is the key in Vdbus_registered_objects_table. */
- result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
+ serial = dbus_message_get_serial (dmessage);
+ result = list2 (bus, make_fixnum_or_float (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1366,27 +1385,28 @@ DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
This is an internal function, it shall not be used outside dbus.el.
usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object bus, serial, service;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object bus, service;
+ struct gcpro gcpro1, gcpro2;
DBusConnection *connection;
DBusMessage *dmessage;
DBusMessageIter iter;
- unsigned int dtype;
- size_t i;
+ dbus_uint32_t serial;
+ unsigned int ui_serial, dtype;
+ ptrdiff_t i;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
bus = args[0];
- serial = args[1];
service = args[2];
- CHECK_NUMBER (serial);
+ CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
CHECK_STRING (service);
- GCPRO3 (bus, serial, service);
+ GCPRO2 (bus, service);
- XD_DEBUG_MESSAGE ("%"pI"u %s ", XUINT (serial), SDATA (service));
+ ui_serial = serial;
+ XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
@@ -1394,7 +1414,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
/* Create the message. */
dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
if ((dmessage == NULL)
- || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
+ || (!dbus_message_set_reply_serial (dmessage, serial))
|| (!dbus_message_set_destination (dmessage, SSDATA (service))))
{
UNGCPRO;
@@ -1414,7 +1434,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-2),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
@@ -1422,7 +1442,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-2),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
SDATA (format2 ("%s", args[i], Qnil)));
}
@@ -1454,27 +1474,28 @@ DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
This is an internal function, it shall not be used outside dbus.el.
usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object bus, serial, service;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object bus, service;
+ struct gcpro gcpro1, gcpro2;
DBusConnection *connection;
DBusMessage *dmessage;
DBusMessageIter iter;
- unsigned int dtype;
- size_t i;
+ dbus_uint32_t serial;
+ unsigned int ui_serial, dtype;
+ ptrdiff_t i;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
bus = args[0];
- serial = args[1];
service = args[2];
- CHECK_NUMBER (serial);
+ CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
CHECK_STRING (service);
- GCPRO3 (bus, serial, service);
+ GCPRO2 (bus, service);
- XD_DEBUG_MESSAGE ("%"pI"u %s ", XUINT (serial), SDATA (service));
+ ui_serial = serial;
+ XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
@@ -1483,7 +1504,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
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, XUINT (serial)))
+ || (!dbus_message_set_reply_serial (dmessage, serial))
|| (!dbus_message_set_destination (dmessage, SSDATA (service))))
{
UNGCPRO;
@@ -1503,7 +1524,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-2),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
@@ -1511,7 +1532,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-2),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
SDATA (format2 ("%s", args[i], Qnil)));
}
@@ -1566,7 +1587,7 @@ Example:
"org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object bus, service, path, interface, signal;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
@@ -1574,7 +1595,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
- size_t i;
+ ptrdiff_t i;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
@@ -1618,7 +1639,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s %s", (unsigned long) (i-4),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
SDATA (format2 ("%s", args[i], Qnil)),
SDATA (format2 ("%s", args[i+1], Qnil)));
++i;
@@ -1626,7 +1647,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%lu %s", (unsigned long) (i-4),
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
SDATA (format2 ("%s", args[i], Qnil)));
}
@@ -1663,7 +1684,9 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
- int mtype, serial;
+ int mtype;
+ dbus_uint32_t serial;
+ unsigned int ui_serial;
const char *uname, *path, *interface, *member;
dmessage = dbus_connection_pop_message (connection);
@@ -1692,7 +1715,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Read message type, message serial, unique name, object path,
interface and member from the message. */
mtype = dbus_message_get_type (dmessage);
- serial =
+ ui_serial = serial =
((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
|| (mtype == DBUS_MESSAGE_TYPE_ERROR))
? dbus_message_get_reply_serial (dmessage)
@@ -1702,7 +1725,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
interface = dbus_message_get_interface (dmessage);
member = dbus_message_get_member (dmessage);
- XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
+ 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)
@@ -1712,14 +1735,14 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
: (mtype == DBUS_MESSAGE_TYPE_ERROR)
? "DBUS_MESSAGE_TYPE_ERROR"
: "DBUS_MESSAGE_TYPE_SIGNAL",
- serial, uname, path, interface, member,
+ ui_serial, uname, path, interface, member,
SDATA (format2 ("%s", args, Qnil)));
if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
|| (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list2 (bus, make_number (serial));
+ key = list2 (bus, make_fixnum_or_float (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
@@ -1785,7 +1808,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
event.arg);
event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
event.arg);
- event.arg = Fcons (make_number (serial), event.arg);
+ event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
event.arg = Fcons (make_number (mtype), event.arg);
/* Add the bus symbol to the event. */
@@ -1895,11 +1918,11 @@ Example:
=> :already-owner.
usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object bus, service;
DBusConnection *connection;
- size_t i;
+ ptrdiff_t i;
unsigned int value;
unsigned int flags = 0;
int result;
@@ -1995,13 +2018,13 @@ INTERFACE, SIGNAL and HANDLER must not be nil. Example:
`dbus-unregister-object' for removing the registration.
usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
- (size_t nargs, register Lisp_Object *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;
- size_t i;
+ ptrdiff_t i;
char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
DBusError derror;
@@ -2071,7 +2094,7 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
if (!NILP (args[i]))
{
CHECK_STRING (args[i]);
- sprintf (x, ",arg%lu='%s'", (unsigned long) (i-6),
+ sprintf (x, ",arg%"pD"d='%s'", i - 6,
SDATA (args[i]));
strcat (rule, x);
}
@@ -2166,142 +2189,76 @@ void
syms_of_dbusbind (void)
{
- Qdbus_init_bus = intern_c_string ("dbus-init-bus");
- staticpro (&Qdbus_init_bus);
+ DEFSYM (Qdbus_init_bus, "dbus-init-bus");
defsubr (&Sdbus_init_bus);
- Qdbus_close_bus = intern_c_string ("dbus-close-bus");
- staticpro (&Qdbus_close_bus);
+ DEFSYM (Qdbus_close_bus, "dbus-close-bus");
defsubr (&Sdbus_close_bus);
- Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name");
- staticpro (&Qdbus_get_unique_name);
+ DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
defsubr (&Sdbus_get_unique_name);
- Qdbus_call_method = intern_c_string ("dbus-call-method");
- staticpro (&Qdbus_call_method);
+ DEFSYM (Qdbus_call_method, "dbus-call-method");
defsubr (&Sdbus_call_method);
- Qdbus_call_method_asynchronously
- = intern_c_string ("dbus-call-method-asynchronously");
- staticpro (&Qdbus_call_method_asynchronously);
+ DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
defsubr (&Sdbus_call_method_asynchronously);
- Qdbus_method_return_internal
- = intern_c_string ("dbus-method-return-internal");
- staticpro (&Qdbus_method_return_internal);
+ DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
defsubr (&Sdbus_method_return_internal);
- Qdbus_method_error_internal = intern_c_string ("dbus-method-error-internal");
- staticpro (&Qdbus_method_error_internal);
+ DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
defsubr (&Sdbus_method_error_internal);
- Qdbus_send_signal = intern_c_string ("dbus-send-signal");
- staticpro (&Qdbus_send_signal);
+ DEFSYM (Qdbus_send_signal, "dbus-send-signal");
defsubr (&Sdbus_send_signal);
- Qdbus_register_service = intern_c_string ("dbus-register-service");
- staticpro (&Qdbus_register_service);
+ DEFSYM (Qdbus_register_service, "dbus-register-service");
defsubr (&Sdbus_register_service);
- Qdbus_register_signal = intern_c_string ("dbus-register-signal");
- staticpro (&Qdbus_register_signal);
+ DEFSYM (Qdbus_register_signal, "dbus-register-signal");
defsubr (&Sdbus_register_signal);
- Qdbus_register_method = intern_c_string ("dbus-register-method");
- staticpro (&Qdbus_register_method);
+ DEFSYM (Qdbus_register_method, "dbus-register-method");
defsubr (&Sdbus_register_method);
- Qdbus_error = intern_c_string ("dbus-error");
- staticpro (&Qdbus_error);
+ 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"));
- QCdbus_system_bus = intern_c_string (":system");
- staticpro (&QCdbus_system_bus);
-
- QCdbus_session_bus = intern_c_string (":session");
- staticpro (&QCdbus_session_bus);
-
- QCdbus_request_name_allow_replacement
- = intern_c_string (":allow-replacement");
- staticpro (&QCdbus_request_name_allow_replacement);
-
- QCdbus_request_name_replace_existing = intern_c_string (":replace-existing");
- staticpro (&QCdbus_request_name_replace_existing);
-
- QCdbus_request_name_do_not_queue = intern_c_string (":do-not-queue");
- staticpro (&QCdbus_request_name_do_not_queue);
-
- QCdbus_request_name_reply_primary_owner = intern_c_string (":primary-owner");
- staticpro (&QCdbus_request_name_reply_primary_owner);
-
- QCdbus_request_name_reply_exists = intern_c_string (":exists");
- staticpro (&QCdbus_request_name_reply_exists);
-
- QCdbus_request_name_reply_in_queue = intern_c_string (":in-queue");
- staticpro (&QCdbus_request_name_reply_in_queue);
-
- QCdbus_request_name_reply_already_owner = intern_c_string (":already-owner");
- staticpro (&QCdbus_request_name_reply_already_owner);
-
- QCdbus_timeout = intern_c_string (":timeout");
- staticpro (&QCdbus_timeout);
-
- QCdbus_type_byte = intern_c_string (":byte");
- staticpro (&QCdbus_type_byte);
-
- QCdbus_type_boolean = intern_c_string (":boolean");
- staticpro (&QCdbus_type_boolean);
-
- QCdbus_type_int16 = intern_c_string (":int16");
- staticpro (&QCdbus_type_int16);
-
- QCdbus_type_uint16 = intern_c_string (":uint16");
- staticpro (&QCdbus_type_uint16);
-
- QCdbus_type_int32 = intern_c_string (":int32");
- staticpro (&QCdbus_type_int32);
-
- QCdbus_type_uint32 = intern_c_string (":uint32");
- staticpro (&QCdbus_type_uint32);
-
- QCdbus_type_int64 = intern_c_string (":int64");
- staticpro (&QCdbus_type_int64);
-
- QCdbus_type_uint64 = intern_c_string (":uint64");
- staticpro (&QCdbus_type_uint64);
-
- QCdbus_type_double = intern_c_string (":double");
- staticpro (&QCdbus_type_double);
-
- QCdbus_type_string = intern_c_string (":string");
- staticpro (&QCdbus_type_string);
-
- QCdbus_type_object_path = intern_c_string (":object-path");
- staticpro (&QCdbus_type_object_path);
-
- QCdbus_type_signature = intern_c_string (":signature");
- staticpro (&QCdbus_type_signature);
+ 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");
+ DEFSYM (QCdbus_type_int16, ":int16");
+ DEFSYM (QCdbus_type_uint16, ":uint16");
+ DEFSYM (QCdbus_type_int32, ":int32");
+ DEFSYM (QCdbus_type_uint32, ":uint32");
+ DEFSYM (QCdbus_type_int64, ":int64");
+ DEFSYM (QCdbus_type_uint64, ":uint64");
+ DEFSYM (QCdbus_type_double, ":double");
+ DEFSYM (QCdbus_type_string, ":string");
+ DEFSYM (QCdbus_type_object_path, ":object-path");
+ DEFSYM (QCdbus_type_signature, ":signature");
#ifdef DBUS_TYPE_UNIX_FD
- QCdbus_type_unix_fd = intern_c_string (":unix-fd");
- staticpro (&QCdbus_type_unix_fd);
+ DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
#endif
- QCdbus_type_array = intern_c_string (":array");
- staticpro (&QCdbus_type_array);
-
- QCdbus_type_variant = intern_c_string (":variant");
- staticpro (&QCdbus_type_variant);
-
- QCdbus_type_struct = intern_c_string (":struct");
- staticpro (&QCdbus_type_struct);
-
- QCdbus_type_dict_entry = intern_c_string (":dict-entry");
- staticpro (&QCdbus_type_dict_entry);
+ DEFSYM (QCdbus_type_array, ":array");
+ DEFSYM (QCdbus_type_variant, ":variant");
+ DEFSYM (QCdbus_type_struct, ":struct");
+ DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
DEFVAR_LISP ("dbus-registered-buses",
Vdbus_registered_buses,
diff --git a/src/deps.mk b/src/deps.mk
index 8d0e0e69589..080144ae1e5 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -284,7 +284,8 @@ eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \
floatfns.o: floatfns.c syssignal.h lisp.h globals.h $(config_h)
fns.o: fns.c commands.h lisp.h $(config_h) frame.h buffer.h character.h \
keyboard.h keymap.h window.h $(INTERVALS_H) coding.h ../lib/md5.h \
- blockinput.h atimer.h systime.h xterm.h ../lib/unistd.h globals.h
+ ../lib/sha1.h ../lib/sha256.h ../lib/sha512.h blockinput.h atimer.h \
+ systime.h xterm.h ../lib/unistd.h globals.h
print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \
lisp.h globals.h $(config_h) termchar.h $(INTERVALS_H) msdos.h termhooks.h \
blockinput.h atimer.h systime.h font.h charset.h coding.h ccl.h \
diff --git a/src/dired.c b/src/dired.c
index 60d7bc64974..415f9ac5ae5 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -900,11 +900,10 @@ Elements of the attribute list are:
This is a floating point number if the size is too large for an integer.
8. File modes, as a string of ten letters or dashes as in ls -l.
9. t if file's gid would change if file were deleted and recreated.
-10. inode number. If inode number is larger than what Emacs integer
- can hold, but still fits into a 32-bit number, this is a cons cell
- containing two integers: first the high part, then the low 16 bits.
- If the inode number is wider than 32 bits, this is of the form
- (HIGH MIDDLE . LOW): first the high 24 bits, then middle 24 bits,
+10. inode number. If it is larger than what an Emacs integer can hold,
+ this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
+ If even HIGH is too large for an Emacs integer, this is instead of the form
+ (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
and finally the low 16 bits.
11. Filesystem device number. If it is larger than what the Emacs
integer can hold, this is a cons cell, similar to the inode number.
@@ -979,11 +978,14 @@ so last access time will always be midnight of that day. */)
values[4] = make_time (s.st_atime);
values[5] = make_time (s.st_mtime);
values[6] = make_time (s.st_ctime);
- values[7] = make_fixnum_or_float (s.st_size);
- /* If the size is negative, and its type is long, convert it back to
- positive. */
- if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
- values[7] = make_float ((double) ((unsigned long) s.st_size));
+
+ /* 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
+ common bug on older 32-bit platforms. */
+ if (sizeof (s.st_size) == 4)
+ values[7] = make_fixnum_or_float (s.st_size & 0xffffffffu);
+ else
+ values[7] = make_fixnum_or_float (s.st_size);
filemodestring (&s, modes);
values[8] = make_string (modes, 10);
@@ -998,35 +1000,8 @@ so last access time will always be midnight of that day. */)
#else /* file gid will be egid */
values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
#endif /* not BSD4_2 */
- if (!FIXNUM_OVERFLOW_P (s.st_ino))
- /* Keep the most common cases as integers. */
- values[10] = make_number (s.st_ino);
- else if (!FIXNUM_OVERFLOW_P (s.st_ino >> 16))
- /* To allow inode numbers larger than VALBITS, separate the bottom
- 16 bits. */
- values[10] = Fcons (make_number ((EMACS_INT)(s.st_ino >> 16)),
- make_number ((EMACS_INT)(s.st_ino & 0xffff)));
- else
- {
- /* To allow inode numbers beyond 32 bits, separate into 2 24-bit
- high parts and a 16-bit bottom part.
- The code on the next line avoids a compiler warning on
- systems where st_ino is 32 bit wide. (bug#766). */
- EMACS_INT high_ino = s.st_ino >> 31 >> 1;
- EMACS_INT low_ino = s.st_ino & 0xffffffff;
-
- values[10] = Fcons (make_number (high_ino >> 8),
- Fcons (make_number (((high_ino & 0xff) << 16)
- + (low_ino >> 16)),
- make_number (low_ino & 0xffff)));
- }
-
- /* Likewise for device. */
- if (FIXNUM_OVERFLOW_P (s.st_dev))
- values[11] = Fcons (make_number (s.st_dev >> 16),
- make_number (s.st_dev & 0xffff));
- else
- values[11] = make_number (s.st_dev);
+ values[10] = INTEGER_TO_CONS (s.st_ino);
+ values[11] = INTEGER_TO_CONS (s.st_dev);
return Flist (sizeof(values) / sizeof(values[0]), values);
}
@@ -1042,21 +1017,13 @@ Comparison is in lexicographic order and case is significant. */)
void
syms_of_dired (void)
{
- Qdirectory_files = intern_c_string ("directory-files");
- Qdirectory_files_and_attributes = intern_c_string ("directory-files-and-attributes");
- Qfile_name_completion = intern_c_string ("file-name-completion");
- Qfile_name_all_completions = intern_c_string ("file-name-all-completions");
- Qfile_attributes = intern_c_string ("file-attributes");
- Qfile_attributes_lessp = intern_c_string ("file-attributes-lessp");
- Qdefault_directory = intern_c_string ("default-directory");
-
- staticpro (&Qdirectory_files);
- staticpro (&Qdirectory_files_and_attributes);
- staticpro (&Qfile_name_completion);
- staticpro (&Qfile_name_all_completions);
- staticpro (&Qfile_attributes);
- staticpro (&Qfile_attributes_lessp);
- staticpro (&Qdefault_directory);
+ DEFSYM (Qdirectory_files, "directory-files");
+ DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
+ DEFSYM (Qfile_name_completion, "file-name-completion");
+ DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
+ DEFSYM (Qfile_attributes, "file-attributes");
+ DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
+ DEFSYM (Qdefault_directory, "default-directory");
defsubr (&Sdirectory_files);
defsubr (&Sdirectory_files_and_attributes);
diff --git a/src/dispextern.h b/src/dispextern.h
index 5bb72ff7600..dc44c698164 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -151,7 +151,7 @@ enum window_part
#if GLYPH_DEBUG
-extern int trace_redisplay_p;
+extern int trace_redisplay_p EXTERNALLY_VISIBLE;
#include <stdio.h>
#define TRACE(X) \
@@ -845,6 +845,10 @@ struct glyph_row
/* Vertical offset of the right fringe bitmap. */
signed right_fringe_offset : FRINGE_HEIGHT_BITS;
+ /* 1 means that at least one of the left and right fringe bitmaps is
+ periodic and thus depends on the y-position of the row. */
+ unsigned fringe_bitmap_periodic_p : 1;
+
/* 1 means that we must draw the bitmaps of this row. */
unsigned redraw_fringe_bitmaps_p : 1;
@@ -1528,12 +1532,12 @@ struct face
/* Background stipple or bitmap used for this face. This is
an id as returned from load_pixmap. */
- int stipple;
+ ptrdiff_t stipple;
#else /* not HAVE_WINDOW_SYSTEM */
/* Dummy. */
- int stipple;
+ ptrdiff_t stipple;
#endif /* not HAVE_WINDOW_SYSTEM */
@@ -1725,7 +1729,7 @@ struct face_cache
face doesn't exist. */
#define FACE_FROM_ID(F, ID) \
- (((unsigned) (ID) < FRAME_FACE_CACHE (F)->used) \
+ (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used) \
? FRAME_FACE_CACHE (F)->faces_by_id[ID] \
: NULL)
@@ -1769,7 +1773,11 @@ extern int face_change_count;
/* Data type for describing the bidirectional character types. The
first 7 must be at the beginning, because they are the only values
valid in the `bidi_type' member of `struct glyph'; we only reserve
- 3 bits for it, so we cannot use there values larger than 7. */
+ 3 bits for it, so we cannot use there values larger than 7.
+
+ The order of members must be in sync with the 8th element of the
+ member of unidata-prop-alist (in admin/unidata/unidata-getn.el) for
+ Unicode character property `bidi-class'. */
typedef enum {
UNKNOWN_BT = 0,
STRONG_L, /* strong left-to-right */
@@ -2198,7 +2206,7 @@ struct it
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. */
- int overlay_strings_charpos;
+ EMACS_INT overlay_strings_charpos;
/* Vector of overlays to process. Overlay strings are processed
OVERLAY_STRING_CHUNK_SIZE at a time. */
@@ -2277,7 +2285,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. */
- int selective;
+ EMACS_INT selective;
/* An enumeration describing what the next display element is
after a call to get_next_display_element. */
@@ -2737,7 +2745,7 @@ struct image
{
/* The time in seconds at which the image was last displayed. Set
in prepare_image_for_display. */
- unsigned long timestamp;
+ time_t timestamp;
/* Pixmaps of the image. */
Pixmap pixmap, mask;
@@ -2810,19 +2818,12 @@ struct image
/* 1 means that loading the image failed. Don't try again. */
unsigned load_failed_p;
- /* A place for image types to store additional data. The member
- data.lisp_val is marked during GC, so it's safe to store Lisp data
- there. Image types should free this data when their `free'
- function is called. */
- struct
- {
- int int_val;
- void *ptr_val;
- Lisp_Object lisp_val;
- } data;
+ /* A place for image types to store additional data. It is marked
+ during GC. */
+ Lisp_Object lisp_data;
/* Hash value of image specification to speed up comparisons. */
- unsigned hash;
+ EMACS_UINT hash;
/* Image id of this image. */
int id;
@@ -3041,7 +3042,7 @@ extern EMACS_INT compute_display_string_end (EMACS_INT,
#ifdef HAVE_WINDOW_SYSTEM
#if GLYPH_DEBUG
-extern void dump_glyph_string (struct glyph_string *);
+extern void dump_glyph_string (struct glyph_string *) EXTERNALLY_VISIBLE;
#endif
extern void x_get_glyph_overhangs (struct glyph *, struct frame *,
@@ -3113,21 +3114,21 @@ void w32_reset_fringes (void);
#ifdef HAVE_WINDOW_SYSTEM
-extern int x_bitmap_height (struct frame *, int);
-extern int x_bitmap_width (struct frame *, int);
-extern int x_bitmap_pixmap (struct frame *, int);
+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 void x_reference_bitmap (struct frame *, int);
-extern int x_create_bitmap_from_data (struct frame *, char *,
- unsigned int, unsigned int);
-extern int x_create_bitmap_from_file (struct frame *, Lisp_Object);
+extern ptrdiff_t x_create_bitmap_from_data (struct frame *, char *,
+ unsigned int, unsigned int);
+extern ptrdiff_t x_create_bitmap_from_file (struct frame *, Lisp_Object);
#if defined HAVE_XPM && defined HAVE_X_WINDOWS && !defined USE_GTK
-extern int x_create_bitmap_from_xpm_data (struct frame *f, const char **bits);
+extern ptrdiff_t x_create_bitmap_from_xpm_data (struct frame *, const char **);
#endif
#ifndef x_destroy_bitmap
-extern void x_destroy_bitmap (struct frame *, int);
+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 * , int);
+extern int 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 *);
@@ -3194,7 +3195,7 @@ 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, int, int);
+int merge_faces (struct frame *, Lisp_Object, EMACS_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;
diff --git a/src/dispnew.c b/src/dispnew.c
index 69b32a5cd79..0198942012c 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -155,7 +155,6 @@ static int update_text_area (struct window *, int);
static void make_current (struct glyph_matrix *, struct glyph_matrix *,
int);
static void mirror_make_current (struct window *, int);
-void check_window_matrix_pointers (struct window *);
#if GLYPH_DEBUG
static void check_matrix_pointers (struct glyph_matrix *,
struct glyph_matrix *);
@@ -290,7 +289,6 @@ static int history_idx;
static unsigned history_tick;
static void add_frame_display_history (struct frame *, int);
-static void add_window_display_history (struct window *, char *, int);
/* Add to the redisplay history how window W has been displayed.
MSG is a trace containing the information how W's glyph matrix
@@ -298,7 +296,7 @@ static void add_window_display_history (struct window *, char *, int);
has been interrupted for pending input. */
static void
-add_window_display_history (struct window *w, char *msg, int paused_p)
+add_window_display_history (struct window *w, const char *msg, int paused_p)
{
char *buf;
@@ -311,8 +309,8 @@ add_window_display_history (struct window *w, char *msg, int paused_p)
history_tick++,
w,
((BUFFERP (w->buffer)
- && STRINGP (XBUFFER (w->buffer)->name))
- ? SSDATA (XBUFFER (w->buffer)->name)
+ && STRINGP (BVAR (XBUFFER (w->buffer), name)))
+ ? SSDATA (BVAR (XBUFFER (w->buffer), name))
: "???"),
paused_p ? " ***paused***" : "");
strcat (buf, msg);
@@ -861,6 +859,8 @@ shift_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int start, in
row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y;
+ if (row->fringe_bitmap_periodic_p)
+ row->redraw_fringe_bitmaps_p = 1;
}
}
@@ -1062,8 +1062,7 @@ increment_row_positions (struct glyph_row *row,
B without changing glyph pointers in A and B. */
static void
-swap_glyphs_in_rows (a, b)
- struct glyph_row *a, *b;
+swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b)
{
int area;
@@ -1099,7 +1098,7 @@ swap_glyphs_in_rows (a, b)
/* Exchange pointers to glyph memory between glyph rows A and B. */
-static INLINE void
+static inline void
swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b)
{
int i;
@@ -1115,7 +1114,7 @@ swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b)
/* Copy glyph row structure FROM to glyph row structure TO, except
that glyph pointers in the structures are left unchanged. */
-static INLINE void
+static inline void
copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from)
{
struct glyph *pointers[1 + LAST_AREA];
@@ -1136,7 +1135,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 inline void
assign_row (struct glyph_row *to, struct glyph_row *from)
{
swap_glyph_pointers (to, from);
@@ -1302,7 +1301,7 @@ line_draw_cost (struct glyph_matrix *matrix, int vpos)
and B have equal contents. MOUSE_FACE_P non-zero means compare the
mouse_face_p flags of A and B, too. */
-static INLINE int
+static inline int
row_equal_p (struct glyph_row *a, struct glyph_row *b, int mouse_face_p)
{
if (a == b)
@@ -1339,8 +1338,11 @@ row_equal_p (struct glyph_row *a, struct glyph_row *b, int mouse_face_p)
|| a->cursor_in_fringe_p != b->cursor_in_fringe_p
|| a->left_fringe_bitmap != b->left_fringe_bitmap
|| a->left_fringe_face_id != b->left_fringe_face_id
+ || a->left_fringe_offset != b->left_fringe_offset
|| a->right_fringe_bitmap != b->right_fringe_bitmap
|| a->right_fringe_face_id != b->right_fringe_face_id
+ || a->right_fringe_offset != b->right_fringe_offset
+ || a->fringe_bitmap_periodic_p != b->fringe_bitmap_periodic_p
|| a->overlay_arrow_bitmap != b->overlay_arrow_bitmap
|| a->exact_window_width_line_p != b->exact_window_width_line_p
|| a->overlapped_p != b->overlapped_p
@@ -1474,6 +1476,8 @@ realloc_glyph_pool (struct glyph_pool *pool, struct dim matrix_dim)
stdout.
*/
+void flush_stdout (void) EXTERNALLY_VISIBLE;
+
void
flush_stdout (void)
{
@@ -1929,13 +1933,13 @@ adjust_frame_glyphs_initially (void)
/* 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);
- set_window_height (sf->root_window, frame_lines - 1 - top_margin, 0);
/* 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);
- set_window_height (root->next, 1, 0);
adjust_frame_glyphs (sf);
glyphs_initialized_initially_p = 1;
@@ -2724,7 +2728,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 inline void
set_frame_matrix_frame (struct frame *f)
{
frame_matrix_frame = f;
@@ -2739,7 +2743,7 @@ set_frame_matrix_frame (struct frame *f)
done in frame matrices, and that we have to perform analogous
operations in window matrices of frame_matrix_frame. */
-static INLINE void
+static inline 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);
@@ -3048,7 +3052,7 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy
matrices of leaf window agree with their frame matrices about
glyph pointers. */
-void
+static void
check_window_matrix_pointers (struct window *w)
{
while (w)
@@ -3112,12 +3116,10 @@ check_matrix_pointers (struct glyph_matrix *window_matrix,
static int
window_to_frame_vpos (struct window *w, int vpos)
{
- struct frame *f = XFRAME (w->frame);
-
- xassert (!FRAME_WINDOW_P (f));
+ xassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
xassert (vpos >= 0 && vpos <= w->desired_matrix->nrows);
vpos += WINDOW_TOP_EDGE_LINE (w);
- xassert (vpos >= 0 && vpos <= FRAME_LINES (f));
+ xassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame)));
return vpos;
}
@@ -4241,7 +4243,7 @@ static struct run **runs;
/* Add glyph row ROW to the scrolling hash table. */
-static INLINE struct row_entry *
+static inline struct row_entry *
add_row_entry (struct glyph_row *row)
{
struct row_entry *entry;
@@ -4330,23 +4332,29 @@ scrolling_window (struct window *w, int header_line_p)
first_old = first_new = i;
- /* Set last_new to the index + 1 of the last enabled row in the
- desired matrix. */
+ /* Set last_new to the index + 1 of the row that reaches the
+ bottom boundary in the desired matrix. Give up if we find a
+ disabled row before we reach the bottom boundary. */
i = first_new + 1;
- while (i < desired_matrix->nrows - 1
- && MATRIX_ROW (desired_matrix, i)->enabled_p
- && MATRIX_ROW_BOTTOM_Y (MATRIX_ROW (desired_matrix, i)) <= yb)
- ++i;
+ while (i < desired_matrix->nrows - 1)
+ {
+ int bottom;
- if (!MATRIX_ROW (desired_matrix, i)->enabled_p)
- return 0;
+ if (!MATRIX_ROW (desired_matrix, i)->enabled_p)
+ return 0;
+ bottom = MATRIX_ROW_BOTTOM_Y (MATRIX_ROW (desired_matrix, i));
+ if (bottom <= yb)
+ ++i;
+ if (bottom >= yb)
+ break;
+ }
last_new = i;
- /* Set last_old to the index + 1 of the last enabled row in the
- current matrix. We don't look at the enabled flag here because
- we plan to reuse part of the display even if other parts are
- disabled. */
+ /* Set last_old to the index + 1 of the row that reaches the bottom
+ boundary in the current matrix. We don't look at the enabled
+ flag here because we plan to reuse part of the display even if
+ other parts are disabled. */
i = first_old + 1;
while (i < current_matrix->nrows - 1)
{
@@ -4534,6 +4542,7 @@ scrolling_window (struct window *w, int header_line_p)
/* Copy on the display. */
if (r->current_y != r->desired_y)
{
+ rif->clear_window_mouse_face (w);
rif->scroll_run_hook (w, r);
/* Invalidate runs that copy from where we copied to. */
@@ -4559,13 +4568,7 @@ scrolling_window (struct window *w, int header_line_p)
to = MATRIX_ROW (current_matrix, r->desired_vpos + j);
from = MATRIX_ROW (desired_matrix, r->desired_vpos + j);
to_overlapped_p = to->overlapped_p;
- if (!from->mode_line_p && !w->pseudo_window_p
- && (to->left_fringe_bitmap != from->left_fringe_bitmap
- || to->right_fringe_bitmap != from->right_fringe_bitmap
- || to->left_fringe_face_id != from->left_fringe_face_id
- || to->right_fringe_face_id != from->right_fringe_face_id
- || to->overlay_arrow_bitmap != from->overlay_arrow_bitmap))
- from->redraw_fringe_bitmaps_p = 1;
+ from->redraw_fringe_bitmaps_p = from->fringe_bitmap_periodic_p;
assign_row (to, from);
to->enabled_p = 1, from->enabled_p = 0;
to->overlapped_p = to_overlapped_p;
@@ -5714,24 +5717,7 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int
if (newheight != FRAME_LINES (f))
{
- if (FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
- {
- /* Frame has both root and mini-buffer. */
- XSETFASTINT (XWINDOW (FRAME_ROOT_WINDOW (f))->top_line,
- FRAME_TOP_MARGIN (f));
- set_window_height (FRAME_ROOT_WINDOW (f),
- (newheight
- - 1
- - FRAME_TOP_MARGIN (f)),
- 2);
- XSETFASTINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top_line,
- newheight - 1);
- set_window_height (FRAME_MINIBUF_WINDOW (f), 1, 0);
- }
- else
- /* Frame has just one top-level window. */
- set_window_height (FRAME_ROOT_WINDOW (f),
- newheight - FRAME_TOP_MARGIN (f), 2);
+ resize_frame_windows (f, newheight, 0);
/* MSDOS frames cannot PRETEND, as they change frame size by
manipulating video hardware. */
@@ -5741,9 +5727,7 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int
if (new_frame_total_cols != FRAME_TOTAL_COLS (f))
{
- set_window_width (FRAME_ROOT_WINDOW (f), new_frame_total_cols, 2);
- if (FRAME_HAS_MINIBUF_P (f))
- set_window_width (FRAME_MINIBUF_WINDOW (f), new_frame_total_cols, 0);
+ resize_frame_windows (f, new_frame_total_cols, 1);
/* MSDOS frames cannot PRETEND, as they change frame size by
manipulating video hardware. */
@@ -6232,11 +6216,7 @@ init_display (void)
}
}
- if (!inhibit_window_system && display_arg
-#ifndef CANNOT_DUMP
- && initialized
-#endif
- )
+ if (!inhibit_window_system && display_arg)
{
Vinitial_window_system = Qx;
#ifdef HAVE_X11
@@ -6461,10 +6441,8 @@ syms_of_display (void)
frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda);
staticpro (&frame_and_buffer_state);
- Qdisplay_table = intern_c_string ("display-table");
- staticpro (&Qdisplay_table);
- Qredisplay_dont_pause = intern_c_string ("redisplay-dont-pause");
- staticpro (&Qredisplay_dont_pause);
+ DEFSYM (Qdisplay_table, "display-table");
+ DEFSYM (Qredisplay_dont_pause, "redisplay-dont-pause");
DEFVAR_INT ("baud-rate", baud_rate,
doc: /* *The output baud rate of the terminal.
diff --git a/src/doc.c b/src/doc.c
index 89a7d322966..69646f5af51 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -253,9 +253,12 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
else if (c == '_')
*to++ = 037;
else
- error ("\
+ {
+ unsigned char uc = c;
+ error ("\
Invalid data in documentation file -- %c followed by code %03o",
- 1, (unsigned)c);
+ 1, uc);
+ }
}
else
*to++ = *from++;
@@ -942,8 +945,7 @@ a new string, without any text properties, is returned. */)
void
syms_of_doc (void)
{
- Qfunction_documentation = intern_c_string ("function-documentation");
- staticpro (&Qfunction_documentation);
+ DEFSYM (Qfunction_documentation, "function-documentation");
DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
doc: /* Name of file containing documentation strings of built-in symbols. */);
diff --git a/src/doprnt.c b/src/doprnt.c
index d2abc119912..195598c07ea 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -118,10 +118,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
another macro. */
#include "character.h"
-#ifndef SIZE_MAX
-# define SIZE_MAX ((size_t) -1)
-#endif
-
#ifndef DBL_MAX_10_EXP
#define DBL_MAX_10_EXP 308 /* IEEE double */
#endif
@@ -329,7 +325,7 @@ doprnt (char *buffer, register size_t bufsize, const char *format,
minlen = atoi (&fmtcpy[1]);
string = va_arg (ap, char *);
tem = strlen (string);
- if (tem > MOST_POSITIVE_FIXNUM)
+ if (STRING_BYTES_BOUND < tem)
error ("String for %%s or %%S format is too long");
width = strwidth (string, tem);
goto doit1;
@@ -338,7 +334,7 @@ doprnt (char *buffer, register size_t bufsize, const char *format,
doit:
/* Coming here means STRING contains ASCII only. */
tem = strlen (string);
- if (tem > MOST_POSITIVE_FIXNUM)
+ if (STRING_BYTES_BOUND < tem)
error ("Format width or precision too large");
width = tem;
doit1:
diff --git a/src/editfns.c b/src/editfns.c
index 5e1dcce0275..b20c38faacd 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -45,9 +45,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#include <ctype.h>
+#include <float.h>
#include <limits.h>
#include <intprops.h>
#include <strftime.h>
+#include <verify.h>
#include "intervals.h"
#include "buffer.h"
@@ -57,13 +59,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "window.h"
#include "blockinput.h"
-#ifdef STDC_HEADERS
-#include <float.h>
-#define MAX_10_EXP DBL_MAX_10_EXP
-#else
-#define MAX_10_EXP 310
-#endif
-
#ifndef NULL
#define NULL 0
#endif
@@ -91,21 +86,7 @@ extern Lisp_Object w32_get_internal_run_time (void);
static void time_overflow (void) NO_RETURN;
static int tm_diff (struct tm *, struct tm *);
-static void find_field (Lisp_Object, Lisp_Object, Lisp_Object,
- EMACS_INT *, Lisp_Object, EMACS_INT *);
static void update_buffer_properties (EMACS_INT, EMACS_INT);
-static Lisp_Object region_limit (int);
-static size_t emacs_nmemftime (char *, size_t, const char *,
- size_t, const struct tm *, int, int);
-static void general_insert_function (void (*) (const char *, EMACS_INT),
- void (*) (Lisp_Object, EMACS_INT,
- EMACS_INT, EMACS_INT,
- EMACS_INT, int),
- int, size_t, Lisp_Object *);
-static Lisp_Object subst_char_in_region_unwind (Lisp_Object);
-static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object);
-static void transpose_markers (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT);
static Lisp_Object Qbuffer_access_fontify_functions;
static Lisp_Object Fuser_full_name (Lisp_Object);
@@ -190,12 +171,13 @@ DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
usage: (char-to-string CHAR) */)
(Lisp_Object character)
{
- int len;
+ int c, len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
CHECK_CHARACTER (character);
+ c = XFASTINT (character);
- len = CHAR_STRING (XFASTINT (character), str);
+ len = CHAR_STRING (c, str);
return make_string_from_bytes ((char *) str, 1, len);
}
@@ -212,8 +194,12 @@ DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0,
}
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
- doc: /* Convert arg STRING to a character, the first character of that string.
-A multibyte character is handled correctly. */)
+ doc: /* Return the first character in STRING.
+A multibyte character is handled correctly.
+The value returned is a Unicode codepoint if it is below #x110000 (in
+hex). Codepoints beyond that are Emacs extensions of Unicode. In
+particular, eight-bit characters are returned as codepoints in the
+range #x3FFF80 through #x3FFFFF, inclusive. */)
(register Lisp_Object string)
{
register Lisp_Object val;
@@ -349,13 +335,13 @@ If you set the marker not to point anywhere, the buffer will have no mark. */)
Return the number found, and store them in a vector in VEC
of length LEN. */
-static int
-overlays_around (EMACS_INT pos, Lisp_Object *vec, int len)
+static ptrdiff_t
+overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
EMACS_INT startpos, endpos;
- int idx = 0;
+ ptrdiff_t idx = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
@@ -423,7 +409,7 @@ get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object o
else
{
EMACS_INT posn = XINT (position);
- int noverlays;
+ ptrdiff_t noverlays;
Lisp_Object *overlay_vec, tem;
struct buffer *obuf = current_buffer;
@@ -1718,7 +1704,7 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
(Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
{
time_t value;
- int size;
+ ptrdiff_t size;
int usec;
int ns;
struct tm *tm;
@@ -1735,7 +1721,9 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
Vlocale_coding_system, 1);
/* This is probably enough. */
- size = SBYTES (format_string) * 6 + 50;
+ size = SBYTES (format_string);
+ if (size <= (STRING_BYTES_BOUND - 50) / 6)
+ size = size * 6 + 50;
BLOCK_INPUT;
tm = ut ? gmtime (&value) : localtime (&value);
@@ -1748,7 +1736,7 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
while (1)
{
char *buf = (char *) alloca (size + 1);
- int result;
+ size_t result;
buf[0] = '\1';
BLOCK_INPUT;
@@ -1767,6 +1755,8 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
SBYTES (format_string),
tm, ut, ns);
UNBLOCK_INPUT;
+ if (STRING_BYTES_BOUND <= result)
+ string_overflow ();
size = result + 1;
}
}
@@ -1862,7 +1852,7 @@ Years before 1970 are not guaranteed to work. On some systems,
year values as low as 1901 do work.
usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
time_t value;
struct tm tm;
@@ -2198,9 +2188,9 @@ general_insert_function (void (*insert_func)
void (*insert_from_string_func)
(Lisp_Object, EMACS_INT, EMACS_INT,
EMACS_INT, EMACS_INT, int),
- int inherit, size_t nargs, Lisp_Object *args)
+ int inherit, ptrdiff_t nargs, Lisp_Object *args)
{
- register size_t argnum;
+ ptrdiff_t argnum;
register Lisp_Object val;
for (argnum = 0; argnum < nargs; argnum++)
@@ -2208,16 +2198,15 @@ general_insert_function (void (*insert_func)
val = args[argnum];
if (CHARACTERP (val))
{
+ int c = XFASTINT (val);
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len;
if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
- len = CHAR_STRING (XFASTINT (val), str);
+ len = CHAR_STRING (c, str);
else
{
- str[0] = (ASCII_CHAR_P (XINT (val))
- ? XINT (val)
- : multibyte_char_to_unibyte (XINT (val)));
+ str[0] = ASCII_CHAR_P (c) ? c : multibyte_char_to_unibyte (c);
len = 1;
}
(*insert_func) ((char *) str, len);
@@ -2263,7 +2252,7 @@ buffer; to accomplish this, apply `string-as-multibyte' to the string
and insert the result.
usage: (insert &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
general_insert_function (insert, insert_from_string, 0, nargs, args);
return Qnil;
@@ -2282,7 +2271,7 @@ If the current buffer is unibyte, multibyte strings are converted
to unibyte for insertion.
usage: (insert-and-inherit &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
general_insert_function (insert_and_inherit, insert_from_string, 1,
nargs, args);
@@ -2299,7 +2288,7 @@ If the current buffer is unibyte, multibyte strings are converted
to unibyte for insertion.
usage: (insert-before-markers &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
general_insert_function (insert_before_markers,
insert_from_string_before_markers, 0,
@@ -2318,7 +2307,7 @@ If the current buffer is unibyte, multibyte strings are converted
to unibyte for insertion.
usage: (insert-before-markers-and-inherit &rest ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
general_insert_function (insert_before_markers_and_inherit,
insert_from_string_before_markers, 1,
@@ -2333,30 +2322,29 @@ The optional third arg INHERIT, if non-nil, says to inherit text properties
from adjoining text, if those properties are sticky. */)
(Lisp_Object character, Lisp_Object count, Lisp_Object inherit)
{
- register char *string;
- register EMACS_INT stringlen;
- register int i;
+ int i, stringlen;
register EMACS_INT n;
- int len;
+ int c, len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
+ char string[4000];
- CHECK_NUMBER (character);
+ CHECK_CHARACTER (character);
CHECK_NUMBER (count);
+ c = XFASTINT (character);
if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
- len = CHAR_STRING (XFASTINT (character), str);
+ len = CHAR_STRING (c, str);
else
- str[0] = XFASTINT (character), len = 1;
- if (MOST_POSITIVE_FIXNUM / len < XINT (count))
- error ("Maximum buffer size would be exceeded");
- n = XINT (count) * len;
- if (n <= 0)
+ str[0] = c, len = 1;
+ if (XINT (count) <= 0)
return Qnil;
- stringlen = min (n, 256 * len);
- string = (char *) alloca (stringlen);
+ if (BUF_BYTES_MAX / len < XINT (count))
+ buffer_overflow ();
+ n = XINT (count) * len;
+ stringlen = min (n, sizeof string - sizeof string % len);
for (i = 0; i < stringlen; i++)
string[i] = str[i % len];
- while (n >= stringlen)
+ while (n > stringlen)
{
QUIT;
if (!NILP (inherit))
@@ -2365,13 +2353,10 @@ from adjoining text, if those properties are sticky. */)
insert (string, stringlen);
n -= stringlen;
}
- if (n > 0)
- {
- if (!NILP (inherit))
- insert_and_inherit (string, n);
- else
- insert (string, n);
- }
+ if (!NILP (inherit))
+ insert_and_inherit (string, n);
+ else
+ insert (string, n);
return Qnil;
}
@@ -2789,17 +2774,20 @@ Both characters must have the same length of multi-byte form. */)
int maybe_byte_combining = COMBINING_NO;
EMACS_INT last_changed = 0;
int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ int fromc, toc;
restart:
validate_region (&start, &end);
- CHECK_NUMBER (fromchar);
- CHECK_NUMBER (tochar);
+ CHECK_CHARACTER (fromchar);
+ CHECK_CHARACTER (tochar);
+ fromc = XFASTINT (fromchar);
+ toc = XFASTINT (tochar);
if (multibyte_p)
{
- len = CHAR_STRING (XFASTINT (fromchar), fromstr);
- if (CHAR_STRING (XFASTINT (tochar), tostr) != len)
+ len = CHAR_STRING (fromc, fromstr);
+ if (CHAR_STRING (toc, tostr) != len)
error ("Characters in `subst-char-in-region' have different byte-lengths");
if (!ASCII_BYTE_P (*tostr))
{
@@ -2816,8 +2804,8 @@ Both characters must have the same length of multi-byte form. */)
else
{
len = 1;
- fromstr[0] = XFASTINT (fromchar);
- tostr[0] = XFASTINT (tochar);
+ fromstr[0] = fromc;
+ tostr[0] = toc;
}
pos = XINT (start);
@@ -3089,14 +3077,11 @@ It returns the number of characters changed. */)
}
else
{
- EMACS_INT c;
-
nc = oc;
val = CHAR_TABLE_REF (table, oc);
- if (CHARACTERP (val)
- && (c = XINT (val), CHAR_VALID_P (c, 0)))
+ if (CHARACTERP (val))
{
- nc = c;
+ nc = XFASTINT (val);
str_len = CHAR_STRING (nc, buf);
str = buf;
}
@@ -3175,10 +3160,9 @@ It returns the number of characters changed. */)
}
DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
- doc: /* Delete the text between point and mark.
-
-When called from a program, expects two arguments,
-positions (integers or markers) specifying the stretch to be deleted. */)
+ doc: /* Delete the text between START and END.
+If called interactively, delete the region between point and mark.
+This command deletes buffer text without modifying the kill ring. */)
(Lisp_Object start, Lisp_Object end)
{
validate_region (&start, &end);
@@ -3390,7 +3374,7 @@ any existing message; this lets the minibuffer contents show. See
also `current-message'.
usage: (message FORMAT-STRING &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
if (NILP (args[0])
|| (STRINGP (args[0])
@@ -3418,7 +3402,7 @@ If the first argument is nil or the empty string, clear any existing
message; let the minibuffer contents show.
usage: (message-box FORMAT-STRING &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
if (NILP (args[0]))
{
@@ -3475,7 +3459,7 @@ If the first argument is nil or the empty string, clear any existing
message; let the minibuffer contents show.
usage: (message-or-box FORMAT-STRING &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
@@ -3499,11 +3483,11 @@ First argument is the string to copy.
Remaining arguments form a sequence of PROPERTY VALUE pairs for text
properties to add to the result.
usage: (propertize STRING &rest PROPERTIES) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object properties, string;
struct gcpro gcpro1, gcpro2;
- size_t i;
+ ptrdiff_t i;
/* Number of args must be odd. */
if ((nargs & 1) == 0)
@@ -3525,14 +3509,21 @@ usage: (propertize STRING &rest PROPERTIES) */)
RETURN_UNGCPRO (string);
}
-
-/* Number of bytes that STRING will occupy when put into the result.
- MULTIBYTE is nonzero if the result should be multibyte. */
-
-#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
- (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
- ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
- : SBYTES (STRING))
+/* pWIDE is a conversion for printing large decimal integers (possibly with a
+ trailing "d" that is ignored). pWIDElen is its length. signed_wide and
+ unsigned_wide are signed and unsigned types for printing them. Use widest
+ integers if available so that more floating point values can be converted. */
+#ifdef PRIdMAX
+# define pWIDE PRIdMAX
+enum { pWIDElen = sizeof PRIdMAX - 2 }; /* Don't count trailing "d". */
+typedef intmax_t signed_wide;
+typedef uintmax_t unsigned_wide;
+#else
+# define pWIDE pI
+enum { pWIDElen = sizeof pI - 1 };
+typedef EMACS_INT signed_wide;
+typedef EMACS_UINT unsigned_wide;
+#endif
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
doc: /* Format a string out of a format-string and arguments.
@@ -3573,7 +3564,8 @@ The width specifier supplies a lower limit for the length of the
printed representation. The padding, if any, normally goes on the
left, but it goes on the right if the - flag is present. The padding
character is normally a space, but it is 0 if the 0 flag is present.
-The - flag takes precedence over the 0 flag.
+The 0 flag is ignored if the - flag is present, or the format sequence
+is something other than %d, %e, %f, and %g.
For %e, %f, and %g sequences, the number after the "." in the
precision specifier says how many decimal places to show; if zero, the
@@ -3581,13 +3573,19 @@ decimal point itself is omitted. For %s and %S, the precision
specifier truncates the string to the given width.
usage: (format STRING &rest OBJECTS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- register size_t n; /* The number of the next arg to substitute */
- register size_t total; /* An estimate of the final length */
- char *buf, *p;
+ 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;
+ char *p;
+ Lisp_Object buf_save_value IF_LINT (= {0});
register char *format, *end, *format_start;
- int nchars;
+ EMACS_INT formatlen, nchars;
+ /* Nonzero if the format is multibyte. */
+ int multibyte_format = 0;
/* Nonzero if the output should be a multibyte string,
which is true if any of the inputs is one. */
int multibyte = 0;
@@ -3596,14 +3594,6 @@ usage: (format STRING &rest OBJECTS) */)
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
int maybe_combine_byte;
- char *this_format;
- /* Precision for each spec, or -1, a flag value meaning no precision
- was given in that spec. Element 0, corresponding to the format
- string itself, will not be used. Element NARGS, corresponding to
- no argument, *will* be assigned to in the case that a `%' and `.'
- occur after the final format specifier. */
- int *precision = (int *) (alloca ((nargs + 1) * sizeof (int)));
- int longest_format;
Lisp_Object val;
int arg_intervals = 0;
USE_SAFE_ALLOCA;
@@ -3611,458 +3601,606 @@ usage: (format STRING &rest OBJECTS) */)
/* discarded[I] is 1 if byte I of the format
string was not copied into the output.
It is 2 if byte I was not the first byte of its character. */
- char *discarded = 0;
+ char *discarded;
/* Each element records, for one argument,
the start and end bytepos in the output string,
+ whether the argument has been converted to string (e.g., due to "%S"),
and whether the argument is a string with intervals.
info[0] is unused. Unused elements have -1 for start. */
struct info
{
- int start, end, intervals;
+ EMACS_INT start, end;
+ int converted_to_string;
+ int intervals;
} *info = 0;
/* It should not be necessary to GCPRO ARGS, because
the caller in the interpreter should take care of that. */
+ CHECK_STRING (args[0]);
+ format_start = SSDATA (args[0]);
+ formatlen = SBYTES (args[0]);
+
+ /* Allocate the info and discarded tables. */
+ {
+ 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);
+ discarded = (char *) &info[nargs + 1];
+ for (i = 0; i < nargs + 1; i++)
+ {
+ info[i].start = -1;
+ info[i].intervals = info[i].converted_to_string = 0;
+ }
+ memset (discarded, 0, formatlen);
+ }
+
/* Try to determine whether the result should be multibyte.
This is not always right; sometimes the result needs to be multibyte
because of an object that we will pass through prin1,
and in that case, we won't know it here. */
- for (n = 0; n < nargs; n++)
- {
- if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
- multibyte = 1;
- /* Piggyback on this loop to initialize precision[N]. */
- precision[n] = -1;
- }
- precision[nargs] = -1;
-
- CHECK_STRING (args[0]);
- /* We may have to change "%S" to "%s". */
- args[0] = Fcopy_sequence (args[0]);
-
- /* GC should never happen here, so abort if it does. */
- abort_on_gc++;
+ multibyte_format = STRING_MULTIBYTE (args[0]);
+ multibyte = multibyte_format;
+ for (n = 1; !multibyte && n < nargs; n++)
+ if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
+ multibyte = 1;
/* If we start out planning a unibyte result,
- then discover it has to be multibyte, we jump back to retry.
- That can only happen from the first large while loop below. */
+ then discover it has to be multibyte, we jump back to retry. */
retry:
- format = SSDATA (args[0]);
- format_start = format;
- end = format + SBYTES (args[0]);
- longest_format = 0;
-
- /* Make room in result for all the non-%-codes in the control string. */
- total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]) + 1;
-
- /* Allocate the info and discarded tables. */
- {
- size_t nbytes = (nargs+1) * sizeof *info;
- size_t i;
- if (!info)
- info = (struct info *) alloca (nbytes);
- memset (info, 0, nbytes);
- for (i = 0; i < nargs + 1; i++)
- info[i].start = -1;
- if (!discarded)
- SAFE_ALLOCA (discarded, char *, SBYTES (args[0]));
- memset (discarded, 0, SBYTES (args[0]));
- }
+ p = buf;
+ nchars = 0;
+ n = 0;
- /* Add to TOTAL enough space to hold the converted arguments. */
+ /* Scan the format and store result in BUF. */
+ format = format_start;
+ end = format + formatlen;
+ maybe_combine_byte = 0;
- n = 0;
while (format != end)
- if (*format++ == '%')
- {
- EMACS_INT thissize = 0;
- EMACS_INT actual_width = 0;
- char *this_format_start = format - 1;
- int field_width = 0;
-
- /* General format specifications look like
+ {
+ /* The values of N and FORMAT when the loop body is entered. */
+ ptrdiff_t n0 = n;
+ char *format0 = format;
- '%' [flags] [field-width] [precision] format
+ /* Bytes needed to represent the output of this conversion. */
+ EMACS_INT convbytes;
- where
+ if (*format == '%')
+ {
+ /* General format specifications look like
- flags ::= [-+ #0]+
- field-width ::= [0-9]+
- precision ::= '.' [0-9]*
+ '%' [flags] [field-width] [precision] format
- If a field-width is specified, it specifies to which width
- the output should be padded with blanks, if the output
- string is shorter than field-width.
+ where
- If precision is specified, it specifies the number of
- digits to print after the '.' for floats, or the max.
- number of chars to print from a string. */
+ flags ::= [-+0# ]+
+ field-width ::= [0-9]+
+ precision ::= '.' [0-9]*
- while (format != end
- && (*format == '-' || *format == '0' || *format == '#'
- || * format == ' ' || *format == '+'))
- ++format;
+ If a field-width is specified, it specifies to which width
+ the output should be padded with blanks, if the output
+ string is shorter than field-width.
- if (*format >= '0' && *format <= '9')
- {
- for (field_width = 0; *format >= '0' && *format <= '9'; ++format)
- field_width = 10 * field_width + *format - '0';
- }
+ If precision is specified, it specifies the number of
+ digits to print after the '.' for floats, or the max.
+ number of chars to print from a string. */
- /* N is not incremented for another few lines below, so refer to
- element N+1 (which might be precision[NARGS]). */
- if (*format == '.')
- {
- ++format;
- for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format)
- precision[n+1] = 10 * precision[n+1] + *format - '0';
- }
+ 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;
+ uintmax_t precision = UINTMAX_MAX;
+ char *num_end;
+ char conversion;
- /* Extra +1 for 'l' that we may need to insert into the
- format. */
- if (format - this_format_start + 2 > longest_format)
- longest_format = format - this_format_start + 2;
+ while (1)
+ {
+ switch (*++format)
+ {
+ case '-': minus_flag = 1; continue;
+ case '+': plus_flag = 1; continue;
+ case ' ': space_flag = 1; continue;
+ case '#': sharp_flag = 1; continue;
+ case '0': zero_flag = 1; continue;
+ }
+ break;
+ }
- if (format == end)
- error ("Format string ends in middle of format specifier");
- if (*format == '%')
- format++;
- else if (++n >= nargs)
- error ("Not enough arguments for format string");
- else if (*format == 'S')
- {
- /* For `S', prin1 the argument and then treat like a string. */
- register Lisp_Object tem;
- tem = Fprin1_to_string (args[n], Qnil);
- if (STRING_MULTIBYTE (tem) && ! multibyte)
- {
- multibyte = 1;
- goto retry;
- }
- args[n] = tem;
- /* If we restart the loop, we should not come here again
- because args[n] is now a string and calling
- Fprin1_to_string on it produces superflous double
- quotes. So, change "%S" to "%s" now. */
- *format = 's';
- goto string;
- }
- else if (SYMBOLP (args[n]))
- {
- args[n] = SYMBOL_NAME (args[n]);
- if (STRING_MULTIBYTE (args[n]) && ! multibyte)
- {
- multibyte = 1;
- goto retry;
- }
- goto string;
- }
- else if (STRINGP (args[n]))
- {
- string:
- if (*format != 's' && *format != 'S')
- error ("Format specifier doesn't match argument type");
- /* In the case (PRECISION[N] > 0), THISSIZE may not need
- to be as large as is calculated here. Easy check for
- the case PRECISION = 0. */
- thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0;
- /* The precision also constrains how much of the argument
- string will finally appear (Bug#5710). */
- actual_width = lisp_string_width (args[n], -1, NULL, NULL);
- if (precision[n] != -1)
- actual_width = min (actual_width, precision[n]);
- }
- /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
- else if (INTEGERP (args[n]) && *format != 's')
- {
- /* The following loop assumes the Lisp type indicates
- the proper way to pass the argument.
- So make sure we have a flonum if the argument should
- be a double. */
- if (*format == 'e' || *format == 'f' || *format == 'g')
- args[n] = Ffloat (args[n]);
- else
- if (*format != 'd' && *format != 'o' && *format != 'x'
- && *format != 'i' && *format != 'X' && *format != 'c')
- error ("Invalid format operation %%%c", *format);
-
- thissize = 30 + (precision[n] > 0 ? precision[n] : 0);
- if (*format == 'c')
- {
- if (! ASCII_CHAR_P (XINT (args[n]))
- /* Note: No one can remember why we have to treat
- the character 0 as a multibyte character here.
- But, until it causes a real problem, let's
- don't change it. */
- || XINT (args[n]) == 0)
- {
- if (! multibyte)
- {
- multibyte = 1;
- goto retry;
- }
- args[n] = Fchar_to_string (args[n]);
- thissize = SBYTES (args[n]);
- }
- }
- }
- else if (FLOATP (args[n]) && *format != 's')
- {
- if (! (*format == 'e' || *format == 'f' || *format == 'g'))
- {
- if (*format != 'd' && *format != 'o' && *format != 'x'
- && *format != 'i' && *format != 'X' && *format != 'c')
- error ("Invalid format operation %%%c", *format);
- /* This fails unnecessarily if args[n] is bigger than
- most-positive-fixnum but smaller than MAXINT.
- These cases are important because we sometimes use floats
- to represent such integer values (typically such values
- come from UIDs or PIDs). */
- /* args[n] = Ftruncate (args[n], Qnil); */
- }
+ /* Ignore flags when sprintf ignores them. */
+ space_flag &= ~ plus_flag;
+ zero_flag &= ~ minus_flag;
- /* Note that we're using sprintf to print floats,
- so we have to take into account what that function
- prints. */
- /* Filter out flag value of -1. */
- thissize = (MAX_10_EXP + 100
- + (precision[n] > 0 ? precision[n] : 0));
- }
- else
{
- /* Anything but a string, convert to a string using princ. */
- register Lisp_Object tem;
- tem = Fprin1_to_string (args[n], Qt);
- if (STRING_MULTIBYTE (tem) && ! multibyte)
- {
- multibyte = 1;
- goto retry;
- }
- args[n] = tem;
- goto string;
+ uintmax_t w = strtoumax (format, &num_end, 10);
+ if (max_bufsize <= w)
+ string_overflow ();
+ field_width = w;
}
-
- thissize += max (0, field_width - actual_width);
- total += thissize + 4;
- }
-
- abort_on_gc--;
-
- /* Now we can no longer jump to retry.
- TOTAL and LONGEST_FORMAT are known for certain. */
-
- this_format = (char *) alloca (longest_format + 1);
-
- /* Allocate the space for the result.
- Note that TOTAL is an overestimate. */
- SAFE_ALLOCA (buf, char *, total);
-
- p = buf;
- nchars = 0;
- n = 0;
-
- /* Scan the format and store result in BUF. */
- format = SSDATA (args[0]);
- format_start = format;
- end = format + SBYTES (args[0]);
- maybe_combine_byte = 0;
- while (format != end)
- {
- if (*format == '%')
- {
- int minlen;
- int negative = 0;
- char *this_format_start = format;
-
+ precision_given = *num_end == '.';
+ if (precision_given)
+ precision = strtoumax (num_end + 1, &num_end, 10);
+ format = num_end;
+
+ if (format == end)
+ error ("Format string ends in middle of format specifier");
+
+ memset (&discarded[format0 - format_start], 1, format - format0);
+ conversion = *format;
+ if (conversion == '%')
+ goto copy_char;
discarded[format - format_start] = 1;
format++;
- while (strchr ("-+0# ", *format))
+ ++n;
+ if (! (n < nargs))
+ error ("Not enough arguments for format string");
+
+ /* For 'S', prin1 the argument, and then treat like 's'.
+ For 's', princ any argument that is not a string or
+ symbol. But don't do this conversion twice, which might
+ happen after retrying. */
+ if ((conversion == 'S'
+ || (conversion == 's'
+ && ! STRINGP (args[n]) && ! SYMBOLP (args[n]))))
{
- if (*format == '-')
+ if (! info[n].converted_to_string)
{
- negative = 1;
+ Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
+ args[n] = Fprin1_to_string (args[n], noescape);
+ info[n].converted_to_string = 1;
+ if (STRING_MULTIBYTE (args[n]) && ! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
}
- discarded[format - format_start] = 1;
- ++format;
+ conversion = 's';
}
+ else if (conversion == 'c')
+ {
+ if (FLOATP (args[n]))
+ {
+ double d = XFLOAT_DATA (args[n]);
+ args[n] = make_number (FIXNUM_OVERFLOW_P (d) ? -1 : d);
+ }
- minlen = atoi (format);
+ if (INTEGERP (args[n]) && ! ASCII_CHAR_P (XINT (args[n])))
+ {
+ if (!multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
+ args[n] = Fchar_to_string (args[n]);
+ info[n].converted_to_string = 1;
+ }
- while ((*format >= '0' && *format <= '9') || *format == '.')
- {
- discarded[format - format_start] = 1;
- format++;
+ if (info[n].converted_to_string)
+ conversion = 's';
+ zero_flag = 0;
}
- if (*format++ == '%')
+ if (SYMBOLP (args[n]))
{
- *p++ = '%';
- nchars++;
- continue;
+ args[n] = SYMBOL_NAME (args[n]);
+ if (STRING_MULTIBYTE (args[n]) && ! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
}
- ++n;
-
- discarded[format - format_start - 1] = 1;
- info[n].start = nchars;
-
- if (STRINGP (args[n]))
+ if (conversion == 's')
{
/* handle case (precision[n] >= 0) */
- int width, padding;
- EMACS_INT nbytes, start;
+ EMACS_INT width, padding, nbytes;
EMACS_INT nchars_string;
+ EMACS_INT prec = -1;
+ if (precision_given && precision <= TYPE_MAXIMUM (EMACS_INT))
+ prec = precision;
+
/* lisp_string_width ignores a precision of 0, but GNU
libc functions print 0 characters when the precision
is 0. Imitate libc behavior here. Changing
lisp_string_width is the right thing, and will be
done, but meanwhile we work with it. */
- if (precision[n] == 0)
+ if (prec == 0)
width = nchars_string = nbytes = 0;
- else if (precision[n] > 0)
- width = lisp_string_width (args[n], precision[n],
- &nchars_string, &nbytes);
else
- { /* no precision spec given for this argument */
- width = lisp_string_width (args[n], -1, NULL, NULL);
- nbytes = SBYTES (args[n]);
- nchars_string = SCHARS (args[n]);
+ {
+ EMACS_INT nch, nby;
+ width = lisp_string_width (args[n], prec, &nch, &nby);
+ if (prec < 0)
+ {
+ nchars_string = SCHARS (args[n]);
+ nbytes = SBYTES (args[n]);
+ }
+ else
+ {
+ nchars_string = nch;
+ nbytes = nby;
+ }
}
- /* If spec requires it, pad on right with spaces. */
- padding = minlen - width;
- if (! negative)
- while (padding-- > 0)
- {
- *p++ = ' ';
- ++nchars;
- }
+ convbytes = nbytes;
+ if (convbytes && multibyte && ! STRING_MULTIBYTE (args[n]))
+ convbytes = count_size_as_multibyte (SDATA (args[n]), nbytes);
- info[n].start = start = nchars;
- nchars += nchars_string;
+ padding = width < field_width ? field_width - width : 0;
- if (p > buf
- && multibyte
- && !ASCII_BYTE_P (*((unsigned char *) p - 1))
- && STRING_MULTIBYTE (args[n])
- && !CHAR_HEAD_P (SREF (args[n], 0)))
- maybe_combine_byte = 1;
+ if (max_bufsize - padding <= convbytes)
+ string_overflow ();
+ convbytes += padding;
+ if (convbytes <= buf + bufsize - p)
+ {
+ if (! minus_flag)
+ {
+ memset (p, ' ', padding);
+ p += padding;
+ nchars += padding;
+ }
- p += copy_text (SDATA (args[n]), (unsigned char *) p,
- nbytes,
- STRING_MULTIBYTE (args[n]), multibyte);
+ if (p > buf
+ && multibyte
+ && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+ && STRING_MULTIBYTE (args[n])
+ && !CHAR_HEAD_P (SREF (args[n], 0)))
+ maybe_combine_byte = 1;
- info[n].end = nchars;
+ p += copy_text (SDATA (args[n]), (unsigned char *) p,
+ nbytes,
+ STRING_MULTIBYTE (args[n]), multibyte);
- if (negative)
- while (padding-- > 0)
- {
- *p++ = ' ';
- nchars++;
- }
+ info[n].start = nchars;
+ nchars += nchars_string;
+ info[n].end = nchars;
+
+ if (minus_flag)
+ {
+ memset (p, ' ', padding);
+ p += padding;
+ nchars += padding;
+ }
+
+ /* If this argument has text properties, record where
+ in the result string it appears. */
+ if (STRING_INTERVALS (args[n]))
+ info[n].intervals = arg_intervals = 1;
- /* If this argument has text properties, record where
- in the result string it appears. */
- if (STRING_INTERVALS (args[n]))
- info[n].intervals = arg_intervals = 1;
+ continue;
+ }
}
- else if (INTEGERP (args[n]) || FLOATP (args[n]))
+ else if (! (conversion == 'c' || conversion == 'd'
+ || conversion == 'e' || conversion == 'f'
+ || conversion == 'g' || conversion == 'i'
+ || conversion == 'o' || conversion == 'x'
+ || conversion == 'X'))
+ error ("Invalid format operation %%%c",
+ STRING_CHAR ((unsigned char *) format - 1));
+ else if (! (INTEGERP (args[n]) || FLOATP (args[n])))
+ error ("Format specifier doesn't match argument type");
+ else
{
- int this_nchars;
-
- memcpy (this_format, this_format_start,
- format - this_format_start);
- this_format[format - this_format_start] = 0;
+ enum
+ {
+ /* Maximum precision for a %f conversion such that the
+ trailing output digit might be nonzero. Any precisions
+ larger than this will not yield useful information. */
+ USEFUL_PRECISION_MAX =
+ ((1 - DBL_MIN_EXP)
+ * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1
+ : FLT_RADIX == 16 ? 4
+ : -1)),
+
+ /* Maximum number of bytes generated by any format, if
+ precision is no more than DBL_USEFUL_PRECISION_MAX.
+ On all practical hosts, %f is the worst case. */
+ SPRINTF_BUFSIZE =
+ sizeof "-." + (DBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX
+ };
+ verify (0 < USEFUL_PRECISION_MAX);
+
+ int prec;
+ EMACS_INT padding, sprintf_bytes;
+ uintmax_t excess_precision, numwidth;
+ uintmax_t leading_zeros = 0, trailing_zeros = 0;
+
+ char sprintf_buf[SPRINTF_BUFSIZE];
+
+ /* Copy of conversion specification, modified somewhat.
+ At most three flags F can be specified at once. */
+ char convspec[sizeof "%FFF.*d" + pWIDElen];
+
+ /* Avoid undefined behavior in underlying sprintf. */
+ if (conversion == 'd' || conversion == 'i')
+ sharp_flag = 0;
+
+ /* Create the copy of the conversion specification, with
+ any width and precision removed, with ".*" inserted,
+ and with pWIDE inserted for integer formats. */
+ {
+ char *f = convspec;
+ *f++ = '%';
+ *f = '-'; f += minus_flag;
+ *f = '+'; f += plus_flag;
+ *f = ' '; f += space_flag;
+ *f = '#'; f += sharp_flag;
+ *f = '0'; f += zero_flag;
+ *f++ = '.';
+ *f++ = '*';
+ if (conversion == 'd' || conversion == 'i'
+ || conversion == 'o' || conversion == 'x'
+ || conversion == 'X')
+ {
+ memcpy (f, pWIDE, pWIDElen);
+ f += pWIDElen;
+ zero_flag &= ~ precision_given;
+ }
+ *f++ = conversion;
+ *f = '\0';
+ }
- if (format[-1] == 'e' || format[-1] == 'f' || format[-1] == 'g')
- sprintf (p, this_format, XFLOAT_DATA (args[n]));
+ prec = -1;
+ if (precision_given)
+ prec = min (precision, USEFUL_PRECISION_MAX);
+
+ /* Use sprintf to format this number into sprintf_buf. Omit
+ padding and excess precision, though, because sprintf limits
+ output length to INT_MAX.
+
+ There are four types of conversion: double, unsigned
+ char (passed as int), wide signed int, and wide
+ unsigned int. Treat them separately because the
+ sprintf ABI is sensitive to which type is passed. Be
+ careful about integer overflow, NaNs, infinities, and
+ conversions; for example, the min and max macros are
+ not suitable here. */
+ if (conversion == 'e' || conversion == 'f' || conversion == 'g')
+ {
+ double x = (INTEGERP (args[n])
+ ? XINT (args[n])
+ : XFLOAT_DATA (args[n]));
+ sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
+ }
+ else if (conversion == 'c')
+ {
+ /* Don't use sprintf here, as it might mishandle prec. */
+ sprintf_buf[0] = XINT (args[n]);
+ sprintf_bytes = prec != 0;
+ }
+ else if (conversion == 'd')
+ {
+ /* For float, maybe we should use "%1.0f"
+ instead so it also works for values outside
+ the integer range. */
+ signed_wide x;
+ if (INTEGERP (args[n]))
+ x = XINT (args[n]);
+ else
+ {
+ double d = XFLOAT_DATA (args[n]);
+ if (d < 0)
+ {
+ x = TYPE_MINIMUM (signed_wide);
+ if (x < d)
+ x = d;
+ }
+ else
+ {
+ x = TYPE_MAXIMUM (signed_wide);
+ if (d < x)
+ x = d;
+ }
+ }
+ sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
+ }
else
{
- if (sizeof (EMACS_INT) > sizeof (int)
- && format[-1] != 'c')
+ /* Don't sign-extend for octal or hex printing. */
+ unsigned_wide x;
+ if (INTEGERP (args[n]))
+ x = XUINT (args[n]);
+ else
{
- /* Insert 'l' before format spec. */
- this_format[format - this_format_start]
- = this_format[format - this_format_start - 1];
- this_format[format - this_format_start - 1] = 'l';
- this_format[format - this_format_start + 1] = 0;
+ double d = XFLOAT_DATA (args[n]);
+ if (d < 0)
+ x = 0;
+ else
+ {
+ x = TYPE_MAXIMUM (unsigned_wide);
+ if (d < x)
+ x = d;
+ }
}
+ sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
+ }
- if (INTEGERP (args[n]))
+ /* Now the length of the formatted item is known, except it omits
+ padding and excess precision. Deal with excess precision
+ first. This happens only when the format specifies
+ ridiculously large precision. */
+ excess_precision = precision - prec;
+ if (excess_precision)
+ {
+ if (conversion == 'e' || conversion == 'f'
+ || conversion == 'g')
{
- if (format[-1] == 'c')
- sprintf (p, this_format, (int) XINT (args[n]));
- else if (format[-1] == 'd')
- sprintf (p, this_format, XINT (args[n]));
- /* Don't sign-extend for octal or hex printing. */
+ if ((conversion == 'g' && ! sharp_flag)
+ || ! ('0' <= sprintf_buf[sprintf_bytes - 1]
+ && sprintf_buf[sprintf_bytes - 1] <= '9'))
+ excess_precision = 0;
else
- sprintf (p, this_format, XUINT (args[n]));
+ {
+ if (conversion == 'g')
+ {
+ char *dot = strchr (sprintf_buf, '.');
+ if (!dot)
+ excess_precision = 0;
+ }
+ }
+ trailing_zeros = excess_precision;
}
- else if (format[-1] == 'c')
- sprintf (p, this_format, (int) XFLOAT_DATA (args[n]));
- else if (format[-1] == 'd')
- /* Maybe we should use "%1.0f" instead so it also works
- for values larger than MAXINT. */
- sprintf (p, this_format, (EMACS_INT) XFLOAT_DATA (args[n]));
else
- /* Don't sign-extend for octal or hex printing. */
- sprintf (p, this_format, (EMACS_UINT) XFLOAT_DATA (args[n]));
+ leading_zeros = excess_precision;
+ }
+
+ /* Compute the total bytes needed for this item, including
+ excess precision and padding. */
+ numwidth = sprintf_bytes + excess_precision;
+ padding = numwidth < field_width ? field_width - numwidth : 0;
+ if (max_bufsize - sprintf_bytes <= excess_precision
+ || max_bufsize - padding <= numwidth)
+ string_overflow ();
+ convbytes = numwidth + padding;
+
+ if (convbytes <= buf + bufsize - p)
+ {
+ /* Copy the formatted item from sprintf_buf into buf,
+ inserting padding and excess-precision zeros. */
+
+ char *src = sprintf_buf;
+ char src0 = src[0];
+ int exponent_bytes = 0;
+ int signedp = src0 == '-' || src0 == '+' || src0 == ' ';
+ int significand_bytes;
+ if (zero_flag
+ && ((src[signedp] >= '0' && src[signedp] <= '9')
+ || (src[signedp] >= 'a' && src[signedp] <= 'f')
+ || (src[signedp] >= 'A' && src[signedp] <= 'F')))
+ {
+ leading_zeros += padding;
+ padding = 0;
+ }
+
+ if (excess_precision
+ && (conversion == 'e' || conversion == 'g'))
+ {
+ char *e = strchr (src, 'e');
+ if (e)
+ exponent_bytes = src + sprintf_bytes - e;
+ }
+
+ if (! minus_flag)
+ {
+ memset (p, ' ', padding);
+ p += padding;
+ nchars += padding;
+ }
+
+ *p = src0;
+ src += signedp;
+ p += signedp;
+ memset (p, '0', leading_zeros);
+ p += leading_zeros;
+ significand_bytes = sprintf_bytes - signedp - exponent_bytes;
+ memcpy (p, src, significand_bytes);
+ p += significand_bytes;
+ src += significand_bytes;
+ memset (p, '0', trailing_zeros);
+ p += trailing_zeros;
+ memcpy (p, src, exponent_bytes);
+ p += exponent_bytes;
+
+ info[n].start = nchars;
+ nchars += leading_zeros + sprintf_bytes + trailing_zeros;
+ info[n].end = nchars;
+
+ if (minus_flag)
+ {
+ memset (p, ' ', padding);
+ p += padding;
+ nchars += padding;
+ }
+
+ continue;
}
+ }
+ }
+ else
+ copy_char:
+ {
+ /* Copy a single character from format to buf. */
+ char *src = format;
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
+
+ if (multibyte_format)
+ {
+ /* Copy a whole multibyte character. */
if (p > buf
- && multibyte
&& !ASCII_BYTE_P (*((unsigned char *) p - 1))
- && !CHAR_HEAD_P (*((unsigned char *) p)))
+ && !CHAR_HEAD_P (*format))
maybe_combine_byte = 1;
- this_nchars = strlen (p);
- if (multibyte)
- p += str_to_multibyte ((unsigned char *) p,
- buf + total - 1 - p, this_nchars);
+
+ do
+ format++;
+ while (! CHAR_HEAD_P (*format));
+
+ convbytes = format - format0;
+ memset (&discarded[format0 + 1 - format_start], 2, convbytes - 1);
+ }
+ else
+ {
+ unsigned char uc = *format++;
+ if (! multibyte || ASCII_BYTE_P (uc))
+ convbytes = 1;
else
- p += this_nchars;
- nchars += this_nchars;
- info[n].end = nchars;
+ {
+ int c = BYTE8_TO_CHAR (uc);
+ convbytes = CHAR_STRING (c, str);
+ src = (char *) str;
+ }
}
- }
- else if (STRING_MULTIBYTE (args[0]))
- {
- /* Copy a whole multibyte character. */
- if (p > buf
- && multibyte
- && !ASCII_BYTE_P (*((unsigned char *) p - 1))
- && !CHAR_HEAD_P (*format))
- maybe_combine_byte = 1;
- *p++ = *format++;
- while (! CHAR_HEAD_P (*format))
+ if (convbytes <= buf + bufsize - p)
{
- discarded[format - format_start] = 2;
- *p++ = *format++;
+ memcpy (p, src, convbytes);
+ p += convbytes;
+ nchars++;
+ continue;
}
- nchars++;
}
- else if (multibyte)
- {
- /* Convert a single-byte character to multibyte. */
- int len = copy_text ((unsigned char *) format, (unsigned char *) p,
- 1, 0, 1);
- p += len;
- format++;
- nchars++;
- }
- else
- *p++ = *format++, nchars++;
+ /* There wasn't enough room to store this conversion or single
+ character. CONVBYTES says how much room is needed. Allocate
+ enough room (and then some) and do it again. */
+ {
+ EMACS_INT used = p - buf;
+
+ if (max_bufsize - used < convbytes)
+ string_overflow ();
+ bufsize = used + convbytes;
+ bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize;
+
+ if (buf == initial_buffer)
+ {
+ buf = xmalloc (bufsize);
+ sa_must_free = 1;
+ buf_save_value = make_save_value (buf, 0);
+ record_unwind_protect (safe_alloca_unwind, buf_save_value);
+ memcpy (buf, initial_buffer, used);
+ }
+ else
+ XSAVE_VALUE (buf_save_value)->pointer = buf = xrealloc (buf, bufsize);
+
+ p = buf + used;
+ }
+
+ format = format0;
+ n = n0;
}
- if (p > buf + total)
+ if (bufsize < p - buf)
abort ();
if (maybe_combine_byte)
@@ -4089,7 +4227,7 @@ usage: (format STRING &rest OBJECTS) */)
if (CONSP (props))
{
EMACS_INT bytepos = 0, position = 0, translated = 0;
- int argn = 1;
+ EMACS_INT argn = 1;
Lisp_Object list;
/* Adjust the bounds of each text property
@@ -4353,8 +4491,9 @@ Transposing beyond buffer boundaries is an error. */)
if (start2 < end1)
error ("Transposed regions overlap");
- else if (start1 == end1 || start2 == end2)
- error ("Transposed region has length 0");
+ /* Nothing to change for adjacent regions with one being empty */
+ else if ((start1 == end1 || start2 == end2) && end1 == start2)
+ return Qnil;
/* The possibilities are:
1. Adjacent (contiguous) regions, or separate but equal regions
@@ -4607,9 +4746,7 @@ syms_of_editfns (void)
environbuf = 0;
initial_tz = 0;
- Qbuffer_access_fontify_functions
- = intern_c_string ("buffer-access-fontify-functions");
- staticpro (&Qbuffer_access_fontify_functions);
+ DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions");
DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion,
doc: /* Non-nil means text motion commands don't notice fields. */);
@@ -4671,10 +4808,8 @@ functions if all the text being accessed has this property. */);
defsubr (&Sregion_beginning);
defsubr (&Sregion_end);
- staticpro (&Qfield);
- Qfield = intern_c_string ("field");
- staticpro (&Qboundary);
- Qboundary = intern_c_string ("boundary");
+ DEFSYM (Qfield, "field");
+ DEFSYM (Qboundary, "boundary");
defsubr (&Sfield_beginning);
defsubr (&Sfield_end);
defsubr (&Sfield_string);
diff --git a/src/emacs.c b/src/emacs.c
index 8c4490b0a52..bc62735ab88 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -65,6 +65,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "nsterm.h"
#endif
+#ifdef HAVE_X_WINDOWS
+#include "xterm.h"
+#endif
+
#ifdef HAVE_SETLOCALE
#include <locale.h>
#endif
@@ -125,6 +129,10 @@ Lisp_Object empty_unibyte_string, empty_multibyte_string;
on subsequent starts. */
int initialized;
+#ifdef DARWIN_OS
+extern void unexec_init_emacs_zone (void);
+#endif
+
#ifdef DOUG_LEA_MALLOC
/* Preserves a pointer to the memory allocated that copies that
static data inside glibc's malloc. */
@@ -346,8 +354,7 @@ fatal_error_signal (int sig)
/* Handler for SIGDANGER. */
void
-memory_warning_signal (sig)
- int sig;
+memory_warning_signal (int sig)
{
signal (sig, memory_warning_signal);
SIGNAL_THREAD_CHECK (sig);
@@ -581,7 +588,7 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr,
int minlen, char **valptr, int *skipptr)
{
char *p = NULL;
- int arglen;
+ ptrdiff_t arglen;
char *arg;
/* Don't access argv[argc]; give up in advance. */
@@ -674,7 +681,7 @@ malloc_initialize_hook (void)
}
}
-void (*__malloc_initialize_hook) (void) = malloc_initialize_hook;
+void (*__malloc_initialize_hook) (void) EXTERNALLY_VISIBLE = malloc_initialize_hook;
#endif /* DOUG_LEA_MALLOC */
@@ -998,6 +1005,11 @@ main (int argc, char **argv)
}
#ifndef NS_IMPL_COCOA
+#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
f = fork ();
#else /* NS_IMPL_COCOA */
/* Under Cocoa we must do fork+exec as CoreFoundation lib fails in
@@ -1078,7 +1090,7 @@ main (int argc, char **argv)
dname_arg2[0] = '\0';
sscanf (dname_arg, "\n%d,%d\n%s", &(daemon_pipe[0]), &(daemon_pipe[1]),
dname_arg2);
- dname_arg = strlen (dname_arg2) ? dname_arg2 : NULL;
+ dname_arg = *dname_arg2 ? dname_arg2 : NULL;
}
#endif /* NS_IMPL_COCOA */
@@ -1419,8 +1431,11 @@ main (int argc, char **argv)
syms_of_callproc ();
/* 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. */
- set_initial_environment ();
+ until calling init_callproc. Do not do it when dumping. */
+ if (initialized || ((strcmp (argv[argc-1], "dump") != 0
+ && strcmp (argv[argc-1], "bootstrap") != 0)))
+ set_initial_environment ();
+
/* AIX crashes are reported in system versions 3.2.3 and 3.2.4
if this is not done. Do it after set_global_environment so that we
don't pollute Vglobal_environment. */
@@ -1834,8 +1849,7 @@ sort_args (int argc, char **argv)
priority[from] = 0;
if (argv[from][0] == '-')
{
- int match, thislen;
- char *equals;
+ int match;
/* If we have found "--", don't consider
any more arguments as options. */
@@ -1867,11 +1881,11 @@ sort_args (int argc, char **argv)
>= 0 (the table index of the match) if just one match so far. */
if (argv[from][1] == '-')
{
+ char const *equals = strchr (argv[from], '=');
+ ptrdiff_t thislen =
+ equals ? equals - argv[from] : strlen (argv[from]);
+
match = -1;
- thislen = strlen (argv[from]);
- equals = strchr (argv[from], '=');
- if (equals != 0)
- thislen = equals - argv[from];
for (i = 0;
i < sizeof (standard_args) / sizeof (standard_args[0]); i++)
@@ -1985,6 +1999,11 @@ all of which are called before Emacs is actually killed. */)
UNGCPRO;
+#ifdef HAVE_X_WINDOWS
+ /* Transfer any clipboards we own to the clipboard manager. */
+ x_clipboard_manager_save_all ();
+#endif
+
shut_down_emacs (0, 0, STRINGP (arg) ? arg : Qnil);
/* If we have an auto-save list file,
@@ -2359,10 +2378,8 @@ from the parent process and its tty file descriptors. */)
void
syms_of_emacs (void)
{
- Qfile_name_handler_alist = intern_c_string ("file-name-handler-alist");
- staticpro (&Qfile_name_handler_alist);
- Qrisky_local_variable = intern_c_string ("risky-local-variable");
- staticpro (&Qrisky_local_variable);
+ DEFSYM (Qfile_name_handler_alist, "file-name-handler-alist");
+ DEFSYM (Qrisky_local_variable, "risky-local-variable");
#ifndef CANNOT_DUMP
defsubr (&Sdump_emacs);
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
new file mode 100644
index 00000000000..0b57e2cdf36
--- /dev/null
+++ b/src/emacsgtkfixed.c
@@ -0,0 +1,166 @@
+/* A Gtk Widget that inherits GtkFixed, but can be shrinked.
+This file is only use when compiling with Gtk+ 3.
+
+Copyright (C) 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 <config.h>
+
+#include "emacsgtkfixed.h"
+#include <signal.h>
+#include <stdio.h>
+#include <setjmp.h>
+#include "lisp.h"
+#include "frame.h"
+#include "xterm.h"
+
+struct _EmacsFixedPrivate
+{
+ struct frame *f;
+};
+
+
+static void emacs_fixed_get_preferred_width (GtkWidget *widget,
+ gint *minimum,
+ gint *natural);
+static void emacs_fixed_get_preferred_height (GtkWidget *widget,
+ gint *minimum,
+ gint *natural);
+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)
+{
+ fixed->priv = G_TYPE_INSTANCE_GET_PRIVATE (fixed, EMACS_TYPE_FIXED,
+ EmacsFixedPrivate);
+ fixed->priv->f = 0;
+}
+
+/**
+ * emacs_fixed_new:
+ *
+ * Creates a new #EmacsFixed.
+ *
+ * Returns: a new #EmacsFixed.
+ */
+GtkWidget*
+emacs_fixed_new (struct frame *f)
+{
+ EmacsFixed *fixed = g_object_new (EMACS_TYPE_FIXED, NULL);
+ EmacsFixedPrivate *priv = fixed->priv;
+ priv->f = f;
+ return GTK_WIDGET (fixed);
+}
+
+static void
+emacs_fixed_get_preferred_width (GtkWidget *widget,
+ gint *minimum,
+ gint *natural)
+{
+ EmacsFixed *fixed = EMACS_FIXED (widget);
+ EmacsFixedPrivate *priv = fixed->priv;
+ int w = priv->f->output_data.x->size_hints.min_width;
+ if (minimum) *minimum = w;
+ if (natural) *natural = w;
+}
+
+static void
+emacs_fixed_get_preferred_height (GtkWidget *widget,
+ gint *minimum,
+ gint *natural)
+{
+ EmacsFixed *fixed = EMACS_FIXED (widget);
+ EmacsFixedPrivate *priv = fixed->priv;
+ int h = priv->f->output_data.x->size_hints.min_height;
+ if (minimum) *minimum = h;
+ if (natural) *natural = h;
+}
+
+
+/* Override the X function so we can intercept Gtk+ 3 calls.
+ Use our values for min_width/height so that KDE don't freak out
+ (Bug#8919), and so users can resize our frames as they wish. */
+
+void
+XSetWMSizeHints(Display* d,
+ Window w,
+ XSizeHints* hints,
+ Atom prop)
+{
+ struct x_display_info *dpyinfo = x_display_info_for_display (d);
+ struct frame *f = x_top_window_to_frame (dpyinfo, w);
+ long data[18];
+ data[0] = hints->flags;
+ data[1] = hints->x;
+ data[2] = hints->y;
+ data[3] = hints->width;
+ data[4] = hints->height;
+ data[5] = hints->min_width;
+ data[6] = hints->min_height;
+ data[7] = hints->max_width;
+ data[8] = hints->max_height;
+ data[9] = hints->width_inc;
+ data[10] = hints->height_inc;
+ data[11] = hints->min_aspect.x;
+ data[12] = hints->min_aspect.y;
+ data[13] = hints->max_aspect.x;
+ data[14] = hints->max_aspect.y;
+ data[15] = hints->base_width;
+ data[16] = hints->base_height;
+ data[17] = hints->win_gravity;
+
+ if ((hints->flags & PMinSize) && f)
+ {
+ int w = f->output_data.x->size_hints.min_width;
+ int h = f->output_data.x->size_hints.min_height;
+ data[5] = w;
+ data[6] = h;
+ }
+
+ XChangeProperty (d, w, prop, XA_WM_SIZE_HINTS, 32, PropModeReplace,
+ (unsigned char *) data, 18);
+}
+
+/* Override this X11 function.
+ This function is in the same X11 file as the one above. So we must
+ provide it also. */
+
+void
+XSetWMNormalHints (Display *d, Window w, XSizeHints *hints)
+{
+ XSetWMSizeHints (d, w, hints, XA_WM_NORMAL_HINTS);
+}
diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h
new file mode 100644
index 00000000000..dbac136bd7f
--- /dev/null
+++ b/src/emacsgtkfixed.h
@@ -0,0 +1,60 @@
+/* A Gtk Widget that inherits GtkFixed, but can be shrinked.
+This file is only use when compiling with Gtk+ 3.
+
+Copyright (C) 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/>. */
+
+#ifndef EMACSGTKFIXED_H
+#define EMACSGTKFIXED_H
+
+#include <gtk/gtk.h>
+
+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
+
+#endif /* EMACSGTKFIXED_H */
diff --git a/src/eval.c b/src/eval.c
index 6b4182cb319..90d0df61858 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -32,29 +32,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
#endif
-#ifndef SIZE_MAX
-# define SIZE_MAX ((size_t) -1)
-#endif
-
-/* This definition is duplicated in alloc.c and keyboard.c. */
-/* Putting it in lisp.h makes cc bomb out! */
-
struct backtrace
{
struct backtrace *next;
Lisp_Object *function;
Lisp_Object *args; /* Points to vector of args. */
-#define NARGS_BITS (BITS_PER_INT - 2)
- /* Let's not use size_t because we want to allow negative values (for
- UNEVALLED). Also let's steal 2 bits so we save a word (or more for
- alignment). In any case I doubt Emacs would survive a function call with
- more than 500M arguments. */
- int nargs : NARGS_BITS; /* Length of vector.
- If nargs is UNEVALLED, args points
- to slot holding list of unevalled args. */
- char evalargs : 1;
+ ptrdiff_t nargs; /* Length of vector. */
/* Nonzero means call value of debugger when done with this operation. */
- char debug_on_exit : 1;
+ unsigned int debug_on_exit : 1;
};
static struct backtrace *backtrace_list;
@@ -88,7 +73,7 @@ static Lisp_Object Qdebug_on_error;
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
-Lisp_Object Qdebug;
+static Lisp_Object Qdebug;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
@@ -139,7 +124,7 @@ Lisp_Object Vsignaling_function;
int handling_signal;
-static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *);
+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);
@@ -772,6 +757,7 @@ The return value is BASE-VARIABLE. */)
}
sym->declared_special = 1;
+ XSYMBOL (base_variable)->declared_special = 1;
sym->redirect = SYMBOL_VARALIAS;
SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->constant = SYMBOL_CONSTANT_P (base_variable);
@@ -1052,7 +1038,7 @@ usage: (let VARLIST BODY...) */)
Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
int count = SPECPDL_INDEX ();
- register size_t argnum;
+ ptrdiff_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
@@ -1608,8 +1594,8 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
and ARGS as second argument. */
Lisp_Object
-internal_condition_case_n (Lisp_Object (*bfun) (size_t, Lisp_Object *),
- size_t nargs,
+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))
@@ -1654,8 +1640,7 @@ internal_condition_case_n (Lisp_Object (*bfun) (size_t, Lisp_Object *),
}
-static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object,
- Lisp_Object, 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);
@@ -1731,8 +1716,7 @@ See also the function `condition-case'. */)
for (h = handlerlist; h; h = h->next)
{
- clause = find_handler_clause (h->handler, conditions,
- error_symbol, data);
+ clause = find_handler_clause (h->handler, conditions);
if (!NILP (clause))
break;
}
@@ -1903,8 +1887,10 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
}
/* Call the debugger if calling it is currently enabled for CONDITIONS.
- SIG and DATA describe the signal, as in find_handler_clause. */
-
+ SIG and DATA describe the signal. There are two ways to pass them:
+ = 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
maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
{
@@ -1931,19 +1917,8 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
return 0;
}
-/* Value of Qlambda means we have called debugger and user has continued.
- There are two ways to pass SIG and 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.
-
- We need to increase max_specpdl_size temporarily around
- anything we do that can push on the specpdl, so as not to get
- a second error here in case we're handling specpdl overflow. */
-
static Lisp_Object
-find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
- Lisp_Object sig, Lisp_Object data)
+find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
{
register Lisp_Object h;
@@ -1994,7 +1969,7 @@ verror (const char *m, va_list ap)
{
char buf[4000];
size_t size = sizeof buf;
- size_t size_max = min (MOST_POSITIVE_FIXNUM + 1, SIZE_MAX);
+ size_t size_max = STRING_BYTES_BOUND + 1;
size_t mlen = strlen (m);
char *buffer = buf;
size_t used;
@@ -2294,7 +2269,6 @@ eval_sub (Lisp_Object form)
backtrace.function = &original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
- backtrace.evalargs = 1;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
@@ -2328,15 +2302,12 @@ eval_sub (Lisp_Object form)
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
else if (XSUBR (fun)->max_args == UNEVALLED)
- {
- backtrace.evalargs = 0;
- val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- }
+ val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
else if (XSUBR (fun)->max_args == MANY)
{
/* Pass a vector of evaluated arguments. */
Lisp_Object *vals;
- register size_t argnum = 0;
+ ptrdiff_t argnum = 0;
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (vals, XINT (numargs));
@@ -2466,9 +2437,9 @@ DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- register size_t i, numargs;
+ ptrdiff_t i, numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
@@ -2550,7 +2521,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
/* Run hook variables in various ways. */
static Lisp_Object
-funcall_nil (size_t nargs, Lisp_Object *args)
+funcall_nil (ptrdiff_t nargs, Lisp_Object *args)
{
Ffuncall (nargs, args);
return Qnil;
@@ -2571,10 +2542,10 @@ hook; they should use `run-mode-hooks' instead.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hooks &rest HOOKS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object hook[1];
- register size_t i;
+ ptrdiff_t i;
for (i = 0; i < nargs; i++)
{
@@ -2600,7 +2571,7 @@ as that may change.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
usage: (run-hook-with-args HOOK &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, funcall_nil);
}
@@ -2620,13 +2591,13 @@ However, if they all return nil, we 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.
usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, Ffuncall);
}
static Lisp_Object
-funcall_not (size_t nargs, Lisp_Object *args)
+funcall_not (ptrdiff_t nargs, Lisp_Object *args)
{
return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
}
@@ -2645,13 +2616,13 @@ Then we return nil. However, if they all return non-nil, we return non-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.
usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return NILP (run_hook_with_args (nargs, args, funcall_not)) ? Qt : Qnil;
}
static Lisp_Object
-run_hook_wrapped_funcall (size_t nargs, Lisp_Object *args)
+run_hook_wrapped_funcall (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object tmp = args[0], ret;
args[0] = args[1];
@@ -2669,7 +2640,7 @@ it calls WRAP-FUNCTION with arguments FUN and ARGS.
As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
aborts and returns that value.
usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return run_hook_with_args (nargs, args, run_hook_wrapped_funcall);
}
@@ -2682,8 +2653,8 @@ usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
except that it isn't necessary to gcpro ARGS[0]. */
Lisp_Object
-run_hook_with_args (size_t nargs, Lisp_Object *args,
- Lisp_Object (*funcall) (size_t nargs, Lisp_Object *args))
+run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
+ Lisp_Object (*funcall) (ptrdiff_t nargs, Lisp_Object *args))
{
Lisp_Object sym, val, ret = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
@@ -2956,16 +2927,16 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
Return the value that function returns.
Thus, (funcall 'cons 'x 'y) returns (x . y).
usage: (funcall FUNCTION &rest ARGUMENTS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object fun, original_fun;
Lisp_Object funcar;
- size_t numargs = nargs - 1;
+ ptrdiff_t numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
struct backtrace backtrace;
register Lisp_Object *internal_args;
- register size_t i;
+ ptrdiff_t i;
QUIT;
if ((consing_since_gc > gc_cons_threshold
@@ -2987,7 +2958,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
backtrace.function = &args[0];
backtrace.args = &args[1];
backtrace.nargs = nargs - 1;
- backtrace.evalargs = 0;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
@@ -3119,14 +3089,13 @@ static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
- size_t numargs;
+ ptrdiff_t i, numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
- register size_t i;
register Lisp_Object tem;
USE_SAFE_ALLOCA;
- numargs = XINT (Flength (args));
+ numargs = XFASTINT (Flength (args));
SAFE_ALLOCA_LISP (arg_vector, numargs);
args_left = args;
@@ -3145,7 +3114,6 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
backtrace_list->args = arg_vector;
backtrace_list->nargs = i;
- backtrace_list->evalargs = 0;
tem = funcall_lambda (fun, numargs, arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */
@@ -3162,12 +3130,12 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
-funcall_lambda (Lisp_Object fun, size_t nargs,
+funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next, lexenv;
int count = SPECPDL_INDEX ();
- size_t i;
+ ptrdiff_t i;
int optional, rest;
if (CONSP (fun))
@@ -3194,7 +3162,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
shouldn't bind any arguments, instead just call the byte-code
interpreter directly; it will push arguments as necessary.
- Byte-code objects with either a non-existant, or a nil value for
+ Byte-code objects with either a non-existent, or a nil value for
the `push args' slot (the default), have dynamically-bound
arguments, and use the argument-binding code below instead (as do
all interpreted functions, even lexically bound ones). */
@@ -3584,7 +3552,7 @@ Output stream used is value of `standard-output'. */)
}
else
{
- size_t i;
+ ptrdiff_t i;
for (i = 0; i < backlist->nargs; i++)
{
if (i) write_string (" ", -1);
@@ -3644,7 +3612,7 @@ void
mark_backtrace (void)
{
register struct backtrace *backlist;
- register size_t i;
+ ptrdiff_t i;
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
@@ -3698,46 +3666,23 @@ To prevent this happening, set `quit-flag' to nil
before making `inhibit-quit' nil. */);
Vinhibit_quit = Qnil;
- Qinhibit_quit = intern_c_string ("inhibit-quit");
- staticpro (&Qinhibit_quit);
-
- Qautoload = intern_c_string ("autoload");
- staticpro (&Qautoload);
-
- Qdebug_on_error = intern_c_string ("debug-on-error");
- staticpro (&Qdebug_on_error);
-
- Qmacro = intern_c_string ("macro");
- staticpro (&Qmacro);
-
- Qdeclare = intern_c_string ("declare");
- staticpro (&Qdeclare);
+ DEFSYM (Qinhibit_quit, "inhibit-quit");
+ DEFSYM (Qautoload, "autoload");
+ DEFSYM (Qdebug_on_error, "debug-on-error");
+ DEFSYM (Qmacro, "macro");
+ DEFSYM (Qdeclare, "declare");
/* Note that the process handling also uses Qexit, but we don't want
to staticpro it twice, so we just do it here. */
- Qexit = intern_c_string ("exit");
- staticpro (&Qexit);
-
- Qinteractive = intern_c_string ("interactive");
- staticpro (&Qinteractive);
-
- Qcommandp = intern_c_string ("commandp");
- staticpro (&Qcommandp);
-
- Qdefun = intern_c_string ("defun");
- staticpro (&Qdefun);
-
- Qand_rest = intern_c_string ("&rest");
- staticpro (&Qand_rest);
-
- Qand_optional = intern_c_string ("&optional");
- staticpro (&Qand_optional);
-
- Qclosure = intern_c_string ("closure");
- staticpro (&Qclosure);
+ DEFSYM (Qexit, "exit");
- Qdebug = intern_c_string ("debug");
- staticpro (&Qdebug);
+ 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 ("debug-on-error", Vdebug_on_error,
doc: /* *Non-nil means enter debugger if an error is signaled.
@@ -3811,9 +3756,7 @@ The value the function returns is not used. */);
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. */
- Qinternal_interpreter_environment
- = intern_c_string ("internal-interpreter-environment");
- staticpro (&Qinternal_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.
@@ -3825,8 +3768,7 @@ alist of active lexical bindings. */);
(Just imagine if someone makes it buffer-local). */
Funintern (Qinternal_interpreter_environment, Qnil);
- Vrun_hooks = intern_c_string ("run-hooks");
- staticpro (&Vrun_hooks);
+ DEFSYM (Vrun_hooks, "run-hooks");
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
diff --git a/src/fileio.c b/src/fileio.c
index 7e6fd8c82a8..c6f8dfe4683 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -440,11 +440,9 @@ get a current directory to run processes in. */)
static char *
file_name_as_directory (char *out, const char *in)
{
- int size = strlen (in) - 1;
+ ptrdiff_t len = strlen (in);
- strcpy (out, in);
-
- if (size < 0)
+ if (len == 0)
{
out[0] = '.';
out[1] = '/';
@@ -452,11 +450,13 @@ file_name_as_directory (char *out, const char *in)
return out;
}
+ strcpy (out, in);
+
/* For Unix syntax, Append a slash if necessary */
- if (!IS_DIRECTORY_SEP (out[size]))
+ if (!IS_DIRECTORY_SEP (out[len - 1]))
{
- out[size + 1] = DIRECTORY_SEP;
- out[size + 2] = '\0';
+ out[len] = DIRECTORY_SEP;
+ out[len + 1] = '\0';
}
#ifdef DOS_NT
dostounix_filename (out);
@@ -503,7 +503,7 @@ For a Unix-syntax file name, just appends a slash. */)
static int
directory_file_name (char *src, char *dst)
{
- long slen;
+ ptrdiff_t slen;
slen = strlen (src);
@@ -587,9 +587,9 @@ make_temp_name (Lisp_Object prefix, int base64_p)
{
Lisp_Object val;
int len, clen;
- int pid;
+ intmax_t pid;
char *p, *data;
- char pidbuf[20];
+ char pidbuf[INT_BUFSIZE_BOUND (pid_t)];
int pidlen;
CHECK_STRING (prefix);
@@ -599,7 +599,7 @@ make_temp_name (Lisp_Object prefix, int base64_p)
three are incremented if the file already exists. This ensures
262144 unique file names per PID per PREFIX. */
- pid = (int) getpid ();
+ pid = getpid ();
if (base64_p)
{
@@ -611,8 +611,7 @@ make_temp_name (Lisp_Object prefix, int base64_p)
else
{
#ifdef HAVE_LONG_FILE_NAMES
- sprintf (pidbuf, "%d", pid);
- pidlen = strlen (pidbuf);
+ pidlen = sprintf (pidbuf, "%"PRIdMAX, pid);
#else
pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
@@ -643,7 +642,7 @@ make_temp_name (Lisp_Object prefix, int base64_p)
if (!make_temp_name_count_initialized_p)
{
- make_temp_name_count = (unsigned) time (NULL);
+ make_temp_name_count = time (NULL);
make_temp_name_count_initialized_p = 1;
}
@@ -737,14 +736,14 @@ filesystem tree, not (expand-file-name ".." dirname). */)
/* This should only point to alloca'd data. */
char *target;
- int tlen;
+ ptrdiff_t tlen;
struct passwd *pw;
#ifdef DOS_NT
int drive = 0;
int collapse_newdir = 1;
int is_escaped = 0;
#endif /* DOS_NT */
- int length;
+ ptrdiff_t length;
Lisp_Object handler, result;
int multibyte;
Lisp_Object hdir;
@@ -1314,7 +1313,7 @@ See also the function `substitute-in-file-name'.")
unsigned char *nm;
register unsigned char *newdir, *p, *o;
- int tlen;
+ ptrdiff_t tlen;
unsigned char *target;
struct passwd *pw;
int lose;
@@ -1366,7 +1365,7 @@ See also the function `substitute-in-file-name'.")
unsigned char *user = nm + 1;
/* Find end of name. */
unsigned char *ptr = (unsigned char *) strchr (user, '/');
- int len = ptr ? ptr - user : strlen (user);
+ ptrdiff_t len = ptr ? ptr - user : strlen (user);
/* Copy the user name into temp storage. */
o = (unsigned char *) alloca (len + 1);
memcpy (o, user, len);
@@ -1672,7 +1671,7 @@ those `/' is discarded. */)
else
{
Lisp_Object orig, decoded;
- int orig_length, decoded_length;
+ ptrdiff_t orig_length, decoded_length;
orig_length = strlen (o);
orig = make_unibyte_string (o, orig_length);
decoded = DECODE_FILE (orig);
@@ -1756,6 +1755,10 @@ barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
regardless of what access permissions it has. */
if (lstat (SSDATA (encoded_filename), &statbuf) >= 0)
{
+ if (S_ISDIR (statbuf.st_mode))
+ xsignal2 (Qfile_error,
+ build_string ("File is a directory"), absname);
+
if (! interactive)
xsignal2 (Qfile_already_exists,
build_string ("File already exists"), absname);
@@ -3109,6 +3112,21 @@ read_non_regular_quit (Lisp_Object ignore)
return Qnil;
}
+/* Reposition FD to OFFSET, based on WHENCE. This acts like lseek
+ except that it also tests for OFFSET being out of lseek's range. */
+static off_t
+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))))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ return lseek (fd, offset, whence);
+}
+
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
@@ -3248,8 +3266,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Check whether the size is too large or negative, which can happen on a
platform that allows file sizes greater than the maximum off_t value. */
if (! not_regular
- && ! (0 <= st.st_size && st.st_size <= MOST_POSITIVE_FIXNUM))
- error ("Maximum buffer size exceeded");
+ && ! (0 <= st.st_size && st.st_size <= BUF_BYTES_MAX))
+ buffer_overflow ();
/* Prevent redisplay optimizations. */
current_buffer->clip_changed = 1;
@@ -3317,7 +3335,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
nread = emacs_read (fd, read_buf, 1024);
if (nread >= 0)
{
- if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
+ if (lseek (fd, st.st_size - (1024 * 3), SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
nread += emacs_read (fd, read_buf + nread, 1024 * 3);
@@ -3361,7 +3379,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
specpdl_ptr--;
/* Rewind the file for the actual read done later. */
- if (lseek (fd, 0, 0) < 0)
+ if (lseek (fd, 0, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
@@ -3428,7 +3446,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (XINT (beg) != 0)
{
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (emacs_lseek (fd, XINT (beg), SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
@@ -3500,7 +3518,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
break;
/* How much can we scan in the next step? */
trial = min (curpos, sizeof buffer);
- if (lseek (fd, curpos - trial, 0) < 0)
+ if (emacs_lseek (fd, curpos - trial, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
@@ -3618,7 +3636,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* First read the whole file, performing code conversion into
CONVERSION_BUFFER. */
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (emacs_lseek (fd, XINT (beg), SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
@@ -3785,16 +3803,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
}
if (! not_regular)
- {
- register Lisp_Object temp;
-
- total = XINT (end) - XINT (beg);
-
- /* Make sure point-max won't overflow after this insertion. */
- XSETINT (temp, total);
- if (total != XINT (temp))
- error ("Maximum buffer size exceeded");
- }
+ total = XINT (end) - XINT (beg);
else
/* For a special file, all we can do is guess. */
total = READ_BUF_SIZE;
@@ -3817,7 +3826,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (XINT (beg) != 0 || !NILP (replace))
{
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (emacs_lseek (fd, XINT (beg), SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
@@ -4549,9 +4558,9 @@ This calls `write-region-annotate-functions' at the start, and
long ret;
if (NUMBERP (append))
- ret = lseek (desc, XINT (append), 1);
+ ret = emacs_lseek (desc, XINT (append), SEEK_CUR);
else
- ret = lseek (desc, 0, 2);
+ ret = lseek (desc, 0, SEEK_END);
if (ret < 0)
{
#ifdef CLASH_DETECTION
@@ -4960,7 +4969,7 @@ See Info node `(elisp)Modification Time' for more details. */)
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 == b->modtime + 1
+ && (st.st_mtime - 1 == b->modtime
|| st.st_mtime == b->modtime - 1)))
&& (st.st_size == b->modtime_size
|| b->modtime_size < 0))
@@ -4990,7 +4999,7 @@ See Info node `(elisp)Modification Time' for more details. */)
{
if (! current_buffer->modtime)
return make_number (0);
- return make_time ((time_t) current_buffer->modtime);
+ return make_time (current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
@@ -5005,7 +5014,7 @@ An argument specifies the modification time value to use
{
if (!NILP (time_list))
{
- current_buffer->modtime = cons_to_long (time_list);
+ CONS_TO_INTEGER (time_list, time_t, current_buffer->modtime);
current_buffer->modtime_size = -1;
}
else
@@ -5420,92 +5429,50 @@ Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filena
void
syms_of_fileio (void)
{
- Qoperations = intern_c_string ("operations");
- Qexpand_file_name = intern_c_string ("expand-file-name");
- Qsubstitute_in_file_name = intern_c_string ("substitute-in-file-name");
- Qdirectory_file_name = intern_c_string ("directory-file-name");
- Qfile_name_directory = intern_c_string ("file-name-directory");
- Qfile_name_nondirectory = intern_c_string ("file-name-nondirectory");
- Qunhandled_file_name_directory = intern_c_string ("unhandled-file-name-directory");
- Qfile_name_as_directory = intern_c_string ("file-name-as-directory");
- Qcopy_file = intern_c_string ("copy-file");
- Qmake_directory_internal = intern_c_string ("make-directory-internal");
- Qmake_directory = intern_c_string ("make-directory");
- Qdelete_directory_internal = intern_c_string ("delete-directory-internal");
- Qdelete_file = intern_c_string ("delete-file");
- Qrename_file = intern_c_string ("rename-file");
- Qadd_name_to_file = intern_c_string ("add-name-to-file");
- Qmake_symbolic_link = intern_c_string ("make-symbolic-link");
- Qfile_exists_p = intern_c_string ("file-exists-p");
- Qfile_executable_p = intern_c_string ("file-executable-p");
- Qfile_readable_p = intern_c_string ("file-readable-p");
- Qfile_writable_p = intern_c_string ("file-writable-p");
- Qfile_symlink_p = intern_c_string ("file-symlink-p");
- Qaccess_file = intern_c_string ("access-file");
- Qfile_directory_p = intern_c_string ("file-directory-p");
- Qfile_regular_p = intern_c_string ("file-regular-p");
- Qfile_accessible_directory_p = intern_c_string ("file-accessible-directory-p");
- Qfile_modes = intern_c_string ("file-modes");
- Qset_file_modes = intern_c_string ("set-file-modes");
- Qset_file_times = intern_c_string ("set-file-times");
- Qfile_selinux_context = intern_c_string("file-selinux-context");
- Qset_file_selinux_context = intern_c_string("set-file-selinux-context");
- Qfile_newer_than_file_p = intern_c_string ("file-newer-than-file-p");
- Qinsert_file_contents = intern_c_string ("insert-file-contents");
- Qwrite_region = intern_c_string ("write-region");
- Qverify_visited_file_modtime = intern_c_string ("verify-visited-file-modtime");
- Qset_visited_file_modtime = intern_c_string ("set-visited-file-modtime");
- Qauto_save_coding = intern_c_string ("auto-save-coding");
-
- staticpro (&Qoperations);
- staticpro (&Qexpand_file_name);
- staticpro (&Qsubstitute_in_file_name);
- staticpro (&Qdirectory_file_name);
- staticpro (&Qfile_name_directory);
- staticpro (&Qfile_name_nondirectory);
- staticpro (&Qunhandled_file_name_directory);
- staticpro (&Qfile_name_as_directory);
- staticpro (&Qcopy_file);
- staticpro (&Qmake_directory_internal);
- staticpro (&Qmake_directory);
- staticpro (&Qdelete_directory_internal);
- staticpro (&Qdelete_file);
- staticpro (&Qrename_file);
- staticpro (&Qadd_name_to_file);
- staticpro (&Qmake_symbolic_link);
- staticpro (&Qfile_exists_p);
- staticpro (&Qfile_executable_p);
- staticpro (&Qfile_readable_p);
- staticpro (&Qfile_writable_p);
- staticpro (&Qaccess_file);
- staticpro (&Qfile_symlink_p);
- staticpro (&Qfile_directory_p);
- staticpro (&Qfile_regular_p);
- staticpro (&Qfile_accessible_directory_p);
- staticpro (&Qfile_modes);
- staticpro (&Qset_file_modes);
- staticpro (&Qset_file_times);
- staticpro (&Qfile_selinux_context);
- staticpro (&Qset_file_selinux_context);
- staticpro (&Qfile_newer_than_file_p);
- staticpro (&Qinsert_file_contents);
- staticpro (&Qwrite_region);
- staticpro (&Qverify_visited_file_modtime);
- staticpro (&Qset_visited_file_modtime);
- staticpro (&Qauto_save_coding);
-
- Qfile_name_history = intern_c_string ("file-name-history");
+ DEFSYM (Qoperations, "operations");
+ DEFSYM (Qexpand_file_name, "expand-file-name");
+ DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
+ DEFSYM (Qdirectory_file_name, "directory-file-name");
+ DEFSYM (Qfile_name_directory, "file-name-directory");
+ DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
+ DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
+ DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
+ DEFSYM (Qcopy_file, "copy-file");
+ DEFSYM (Qmake_directory_internal, "make-directory-internal");
+ DEFSYM (Qmake_directory, "make-directory");
+ DEFSYM (Qdelete_directory_internal, "delete-directory-internal");
+ DEFSYM (Qdelete_file, "delete-file");
+ DEFSYM (Qrename_file, "rename-file");
+ DEFSYM (Qadd_name_to_file, "add-name-to-file");
+ DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
+ DEFSYM (Qfile_exists_p, "file-exists-p");
+ DEFSYM (Qfile_executable_p, "file-executable-p");
+ DEFSYM (Qfile_readable_p, "file-readable-p");
+ DEFSYM (Qfile_writable_p, "file-writable-p");
+ DEFSYM (Qfile_symlink_p, "file-symlink-p");
+ DEFSYM (Qaccess_file, "access-file");
+ DEFSYM (Qfile_directory_p, "file-directory-p");
+ DEFSYM (Qfile_regular_p, "file-regular-p");
+ DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
+ DEFSYM (Qfile_modes, "file-modes");
+ DEFSYM (Qset_file_modes, "set-file-modes");
+ DEFSYM (Qset_file_times, "set-file-times");
+ DEFSYM (Qfile_selinux_context, "file-selinux-context");
+ DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
+ DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
+ DEFSYM (Qinsert_file_contents, "insert-file-contents");
+ DEFSYM (Qwrite_region, "write-region");
+ DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
+ DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
+ DEFSYM (Qauto_save_coding, "auto-save-coding");
+
+ DEFSYM (Qfile_name_history, "file-name-history");
Fset (Qfile_name_history, Qnil);
- staticpro (&Qfile_name_history);
- Qfile_error = intern_c_string ("file-error");
- staticpro (&Qfile_error);
- Qfile_already_exists = intern_c_string ("file-already-exists");
- staticpro (&Qfile_already_exists);
- Qfile_date_error = intern_c_string ("file-date-error");
- staticpro (&Qfile_date_error);
- Qexcl = intern_c_string ("excl");
- staticpro (&Qexcl);
+ DEFSYM (Qfile_error, "file-error");
+ DEFSYM (Qfile_already_exists, "file-already-exists");
+ DEFSYM (Qfile_date_error, "file-date-error");
+ DEFSYM (Qexcl, "excl");
DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
doc: /* *Coding system for encoding file names.
@@ -5523,15 +5490,10 @@ instead use `file-name-coding-system' to get a constant encoding
of file names regardless of the current language environment. */);
Vdefault_file_name_coding_system = Qnil;
- Qformat_decode = intern_c_string ("format-decode");
- staticpro (&Qformat_decode);
- Qformat_annotate_function = intern_c_string ("format-annotate-function");
- staticpro (&Qformat_annotate_function);
- Qafter_insert_file_set_coding = intern_c_string ("after-insert-file-set-coding");
- staticpro (&Qafter_insert_file_set_coding);
-
- Qcar_less_than_car = intern_c_string ("car-less-than-car");
- staticpro (&Qcar_less_than_car);
+ DEFSYM (Qformat_decode, "format-decode");
+ DEFSYM (Qformat_annotate_function, "format-annotate-function");
+ DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
+ DEFSYM (Qcar_less_than_car, "car-less-than-car");
Fput (Qfile_error, Qerror_conditions,
Fpurecopy (list2 (Qfile_error, Qerror)));
@@ -5610,9 +5572,7 @@ After `write-region' completes, Emacs calls the function stored in
current when building the annotations (i.e., at least once), with that
buffer current. */);
Vwrite_region_annotate_functions = Qnil;
- staticpro (&Qwrite_region_annotate_functions);
- Qwrite_region_annotate_functions
- = intern_c_string ("write-region-annotate-functions");
+ DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
DEFVAR_LISP ("write-region-post-annotation-function",
Vwrite_region_post_annotation_function,
@@ -5676,12 +5636,10 @@ This includes interactive calls to `delete-file' and
`delete-directory' and the Dired deletion commands. */);
delete_by_moving_to_trash = 0;
Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
- Qmove_file_to_trash = intern_c_string ("move-file-to-trash");
- staticpro (&Qmove_file_to_trash);
- Qcopy_directory = intern_c_string ("copy-directory");
- staticpro (&Qcopy_directory);
- Qdelete_directory = intern_c_string ("delete-directory");
- staticpro (&Qdelete_directory);
+
+ DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
+ DEFSYM (Qcopy_directory, "copy-directory");
+ DEFSYM (Qdelete_directory, "delete-directory");
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
diff --git a/src/filelock.c b/src/filelock.c
index 13b27c72f19..18483b6f3f3 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -168,7 +168,7 @@ get_boot_time (void)
/* If we did not find a boot time in wtmp, look at wtmp, and so on. */
for (counter = 0; counter < 20 && ! boot_time; counter++)
{
- char cmd_string[100];
+ char cmd_string[sizeof WTMP_FILE ".19.gz"];
Lisp_Object tempname, filename;
int delete_flag = 0;
@@ -191,19 +191,16 @@ get_boot_time (void)
character long prefix, and call make_temp_file with
second arg non-zero, so that it will add not more
than 6 characters to the prefix. */
- tempname = Fexpand_file_name (build_string ("wt"),
+ filename = Fexpand_file_name (build_string ("wt"),
Vtemporary_file_directory);
- tempname = make_temp_name (tempname, 1);
- args[0] = Vshell_file_name;
+ filename = make_temp_name (filename, 1);
+ args[0] = build_string ("gzip");
args[1] = Qnil;
- args[2] = Qnil;
+ args[2] = list2 (QCfile, filename);
args[3] = Qnil;
- args[4] = build_string ("-c");
- sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
- WTMP_FILE, counter, SDATA (tempname));
- args[5] = build_string (cmd_string);
+ args[4] = build_string ("-cd");
+ args[5] = tempname;
Fcall_process (6, args);
- filename = tempname;
delete_flag = 1;
}
}
@@ -284,14 +281,10 @@ typedef struct
{
char *user;
char *host;
- unsigned long pid;
+ pid_t pid;
time_t boot_time;
} lock_info_type;
-/* When we read the info back, we might need this much more,
- enough for decimal representation plus null. */
-#define LOCK_PID_MAX (4 * sizeof (unsigned long))
-
/* Free the two dynamically-allocated pieces in PTR. */
#define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
@@ -344,7 +337,7 @@ static int
lock_file_1 (char *lfname, int force)
{
register int err;
- time_t boot;
+ intmax_t boot, pid;
const char *user_name;
const char *host_name;
char *lock_info_str;
@@ -361,14 +354,16 @@ lock_file_1 (char *lfname, int force)
else
host_name = "";
lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
- + LOCK_PID_MAX + 30);
+ + 2 * INT_STRLEN_BOUND (intmax_t)
+ + sizeof "@.:");
+ pid = getpid ();
if (boot)
- sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name,
- (unsigned long) getpid (), (unsigned long) boot);
+ sprintf (lock_info_str, "%s@%s.%"PRIdMAX":%"PRIdMAX,
+ user_name, host_name, pid, boot);
else
- sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
- (unsigned long) getpid ());
+ sprintf (lock_info_str, "%s@%s.%"PRIdMAX,
+ user_name, host_name, pid);
err = symlink (lock_info_str, lfname);
if (errno == EEXIST && force)
@@ -397,8 +392,9 @@ static int
current_lock_owner (lock_info_type *owner, char *lfname)
{
int ret;
- size_t len;
- int local_owner = 0;
+ ptrdiff_t len;
+ lock_info_type local_owner;
+ intmax_t n;
char *at, *dot, *colon;
char readlink_buf[READLINK_BUFSIZE];
char *lfinfo = emacs_readlink (lfname, readlink_buf);
@@ -408,12 +404,9 @@ current_lock_owner (lock_info_type *owner, char *lfname)
return errno == ENOENT ? 0 : -1;
/* Even if the caller doesn't want the owner info, we still have to
- read it to determine return value, so allocate it. */
+ read it to determine return value. */
if (!owner)
- {
- owner = (lock_info_type *) alloca (sizeof (lock_info_type));
- local_owner = 1;
- }
+ owner = &local_owner;
/* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
/* The USER is everything before the last @. */
@@ -427,24 +420,34 @@ current_lock_owner (lock_info_type *owner, char *lfname)
}
len = at - lfinfo;
owner->user = (char *) xmalloc (len + 1);
- strncpy (owner->user, lfinfo, len);
+ memcpy (owner->user, lfinfo, len);
owner->user[len] = 0;
/* The PID is everything from the last `.' to the `:'. */
- owner->pid = atoi (dot + 1);
- colon = dot;
- while (*colon && *colon != ':')
- colon++;
+ errno = 0;
+ n = strtoimax (dot + 1, NULL, 10);
+ owner->pid =
+ ((0 <= n && n <= TYPE_MAXIMUM (pid_t)
+ && (TYPE_MAXIMUM (pid_t) < INTMAX_MAX || errno != ERANGE))
+ ? n : 0);
+
+ colon = strchr (dot + 1, ':');
/* After the `:', if there is one, comes the boot time. */
- if (*colon == ':')
- owner->boot_time = atoi (colon + 1);
- else
- owner->boot_time = 0;
+ n = 0;
+ if (colon)
+ {
+ errno = 0;
+ n = strtoimax (colon + 1, NULL, 10);
+ }
+ owner->boot_time =
+ ((0 <= n && n <= TYPE_MAXIMUM (time_t)
+ && (TYPE_MAXIMUM (time_t) < INTMAX_MAX || errno != ERANGE))
+ ? n : 0);
/* The host is everything in between. */
len = dot - at - 1;
owner->host = (char *) xmalloc (len + 1);
- strncpy (owner->host, at + 1, len);
+ memcpy (owner->host, at + 1, len);
owner->host[len] = 0;
/* We're done looking at the link info. */
@@ -476,7 +479,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
}
/* Avoid garbage. */
- if (local_owner || ret <= 0)
+ if (owner == &local_owner || ret <= 0)
{
FREE_LOCK_INFO (*owner);
}
@@ -539,6 +542,7 @@ lock_file (Lisp_Object fn)
register Lisp_Object attack, orig_fn, encoded_fn;
register char *lfname, *locker;
lock_info_type lock_info;
+ intmax_t pid;
struct gcpro gcpro1;
/* Don't do locking while dumping Emacs.
@@ -577,9 +581,10 @@ lock_file (Lisp_Object fn)
/* Else consider breaking the lock */
locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
- + LOCK_PID_MAX + 9);
- sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
- lock_info.pid);
+ + INT_STRLEN_BOUND (intmax_t) + sizeof "@ (pid )");
+ pid = lock_info.pid;
+ sprintf (locker, "%s@%s (pid %"PRIdMAX")",
+ lock_info.user, lock_info.host, pid);
FREE_LOCK_INFO (lock_info);
attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
diff --git a/src/floatfns.c b/src/floatfns.c
index 1232fc0afa1..e003f492fe6 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -507,7 +507,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
if (y & 1)
acc *= x;
x *= x;
- y = (unsigned)y >> 1;
+ y >>= 1;
}
}
XSETINT (val, acc);
@@ -961,8 +961,7 @@ Rounds the value toward zero. */)
#ifdef FLOAT_CATCH_SIGILL
static void
-float_error (signo)
- int signo;
+float_error (int signo)
{
if (! in_float)
fatal_error_signal (signo);
diff --git a/src/fns.c b/src/fns.c
index 47ded456c6e..0ca731ed331 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -23,6 +23,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <time.h>
#include <setjmp.h>
+#include <intprops.h>
+
#include "lisp.h"
#include "commands.h"
#include "character.h"
@@ -51,6 +53,8 @@ Lisp_Object Qcursor_in_echo_area;
static Lisp_Object Qwidget_type;
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
@@ -75,10 +79,14 @@ Other values of LIMIT are ignored. */)
{
EMACS_INT val;
Lisp_Object lispy_val;
- EMACS_UINT denominator;
if (EQ (limit, Qt))
- seed_random (getpid () + time (NULL));
+ {
+ EMACS_TIME t;
+ EMACS_GET_TIME (t);
+ seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_USECS (t));
+ }
+
if (NATNUMP (limit) && XFASTINT (limit) != 0)
{
/* Try to take our random number from the higher bits of VAL,
@@ -88,7 +96,7 @@ Other values of LIMIT are ignored. */)
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. */
- denominator = ((EMACS_UINT) 1 << VALBITS) / XFASTINT (limit);
+ EMACS_INT denominator = (INTMASK + 1) / XFASTINT (limit);
do
val = get_random () / denominator;
while (val >= XFASTINT (limit));
@@ -99,6 +107,10 @@ Other values of LIMIT are ignored. */)
return lispy_val;
}
+/* Heuristic on how many iterations of a tight loop can be safely done
+ before it's time to do a QUIT. This must be a power of 2. */
+enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
+
/* Random data-structure functions */
DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -110,7 +122,6 @@ To get the number of bytes, use `string-bytes'. */)
(register Lisp_Object sequence)
{
register Lisp_Object val;
- register int i;
if (STRINGP (sequence))
XSETFASTINT (val, SCHARS (sequence));
@@ -124,19 +135,20 @@ To get the number of bytes, use `string-bytes'. */)
XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (sequence))
{
- i = 0;
- while (CONSP (sequence))
+ EMACS_INT i = 0;
+
+ do
{
- sequence = XCDR (sequence);
++i;
-
- if (!CONSP (sequence))
- break;
-
+ if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
+ {
+ if (MOST_POSITIVE_FIXNUM < i)
+ error ("List too long");
+ QUIT;
+ }
sequence = XCDR (sequence);
- ++i;
- QUIT;
}
+ while (CONSP (sequence));
CHECK_LIST_END (sequence, sequence);
@@ -159,22 +171,38 @@ it returns 0. If LIST is circular, it returns a finite value
which is at least the number of distinct elements. */)
(Lisp_Object list)
{
- Lisp_Object tail, halftail, length;
- int len = 0;
+ Lisp_Object tail, halftail;
+ double hilen = 0;
+ uintmax_t lolen = 1;
+
+ if (! CONSP (list))
+ return make_number (0);
/* halftail is used to detect circular lists. */
- halftail = list;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = halftail = list; ; )
{
- if (EQ (tail, halftail) && len != 0)
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
+ if (EQ (tail, halftail))
break;
- len++;
- if ((len & 1) == 0)
- halftail = XCDR (halftail);
+ lolen++;
+ if ((lolen & 1) == 0)
+ {
+ halftail = XCDR (halftail);
+ if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
+ {
+ QUIT;
+ if (lolen == 0)
+ hilen += UINTMAX_MAX + 1.0;
+ }
+ }
}
- XSETINT (length, len);
- return length;
+ /* If the length does not fit into a fixnum, return a float.
+ On all known practical machines this returns an upper bound on
+ the true length. */
+ return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
}
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@@ -344,7 +372,7 @@ Symbols are also allowed; their print names are used instead. */)
return i1 < SCHARS (s2) ? Qt : Qnil;
}
-static Lisp_Object concat (size_t nargs, Lisp_Object *args,
+static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
enum Lisp_Type target_type, int last_special);
/* ARGSUSED */
@@ -374,7 +402,7 @@ The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return concat (nargs, args, Lisp_Cons, 1);
}
@@ -384,7 +412,7 @@ DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
The result is a string whose elements are the elements of all the arguments.
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return concat (nargs, args, Lisp_String, 0);
}
@@ -394,7 +422,7 @@ DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
The result is a vector whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return concat (nargs, args, Lisp_Vectorlike, 0);
}
@@ -416,7 +444,7 @@ with the original. */)
if (BOOL_VECTOR_P (arg))
{
Lisp_Object val;
- int size_in_chars
+ ptrdiff_t size_in_chars
= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
@@ -436,13 +464,13 @@ with the original. */)
a string and has text properties to be copied. */
struct textprop_rec
{
- int argnum; /* refer to ARGS (arguments of `concat') */
+ 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) */
};
static Lisp_Object
-concat (size_t nargs, Lisp_Object *args,
+concat (ptrdiff_t nargs, Lisp_Object *args,
enum Lisp_Type target_type, int last_special)
{
Lisp_Object val;
@@ -452,18 +480,18 @@ concat (size_t nargs, Lisp_Object *args,
EMACS_INT toindex_byte = 0;
register EMACS_INT result_len;
register EMACS_INT result_len_byte;
- register size_t argnum;
+ ptrdiff_t argnum;
Lisp_Object last_tail;
Lisp_Object prev;
int some_multibyte;
/* When we make a multibyte string, we can't copy text properties
- while concatinating each string because the length of resulting
- string can't be decided until we finish the whole concatination.
+ while concatenating each string because the length of resulting
+ string can't be decided until we finish the whole concatenation.
So, we record strings that have text properties to be copied
- here, and copy the text properties after the concatination. */
+ here, and copy the text properties after the concatenation. */
struct textprop_rec *textprops = NULL;
/* Number of elements in textprops. */
- int num_textprops = 0;
+ ptrdiff_t num_textprops = 0;
USE_SAFE_ALLOCA;
tail = Qnil;
@@ -504,6 +532,7 @@ concat (size_t nargs, Lisp_Object *args,
as well as the number of characters. */
EMACS_INT i;
Lisp_Object ch;
+ int c;
EMACS_INT this_len_byte;
if (VECTORP (this) || COMPILEDP (this))
@@ -511,9 +540,10 @@ concat (size_t nargs, Lisp_Object *args,
{
ch = AREF (this, i);
CHECK_CHARACTER (ch);
- this_len_byte = CHAR_BYTES (XINT (ch));
+ c = XFASTINT (ch);
+ this_len_byte = CHAR_BYTES (c);
result_len_byte += this_len_byte;
- if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
+ if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
}
else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
@@ -523,9 +553,10 @@ concat (size_t nargs, Lisp_Object *args,
{
ch = XCAR (this);
CHECK_CHARACTER (ch);
- this_len_byte = CHAR_BYTES (XINT (ch));
+ c = XFASTINT (ch);
+ this_len_byte = CHAR_BYTES (c);
result_len_byte += this_len_byte;
- if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
+ if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
}
else if (STRINGP (this))
@@ -542,8 +573,8 @@ concat (size_t nargs, Lisp_Object *args,
}
result_len += len;
- if (result_len < 0)
- error ("String overflow");
+ if (STRING_BYTES_BOUND < result_len)
+ string_overflow ();
}
if (! some_multibyte)
@@ -631,23 +662,16 @@ concat (size_t nargs, Lisp_Object *args,
{
int c;
if (STRING_MULTIBYTE (this))
- {
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
- thisindex,
- thisindex_byte);
- XSETFASTINT (elt, c);
- }
+ FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
+ thisindex,
+ thisindex_byte);
else
{
- XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
- if (some_multibyte
- && !ASCII_CHAR_P (XINT (elt))
- && XINT (elt) < 0400)
- {
- c = BYTE8_TO_CHAR (XINT (elt));
- XSETINT (elt, c);
- }
+ c = SREF (this, thisindex); thisindex++;
+ if (some_multibyte && !ASCII_CHAR_P (c))
+ c = BYTE8_TO_CHAR (c);
}
+ XSETFASTINT (elt, c);
}
else if (BOOL_VECTOR_P (this))
{
@@ -679,12 +703,13 @@ concat (size_t nargs, Lisp_Object *args,
}
else
{
- CHECK_NUMBER (elt);
+ int c;
+ CHECK_CHARACTER (elt);
+ c = XFASTINT (elt);
if (some_multibyte)
- toindex_byte += CHAR_STRING (XINT (elt),
- SDATA (val) + toindex_byte);
+ toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
else
- SSET (val, toindex_byte++, XINT (elt));
+ SSET (val, toindex_byte++, c);
toindex++;
}
}
@@ -704,7 +729,7 @@ concat (size_t nargs, Lisp_Object *args,
make_number (0),
make_number (SCHARS (this)),
Qnil);
- /* If successive arguments have properites, be sure that the
+ /* If successive arguments have properties, be sure that the
value of `composition' property be the copy. */
if (last_to_end == textprops[argnum].to)
make_composition_value_copy (props);
@@ -898,7 +923,7 @@ string_to_multibyte (Lisp_Object string)
if (STRING_MULTIBYTE (string))
return string;
- nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
+ nbytes = count_size_as_multibyte (SDATA (string), SBYTES (string));
/* If all the chars are ASCII, they won't need any more bytes once
converted. */
if (nbytes == SBYTES (string))
@@ -1269,7 +1294,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
doc: /* Take cdr N times on LIST, return the result. */)
(Lisp_Object n, Lisp_Object list)
{
- register int i, num;
+ EMACS_INT i, num;
CHECK_NUMBER (n);
num = XINT (n);
for (i = 0; i < num && !NILP (list); i++)
@@ -1734,7 +1759,7 @@ if the first element should sort before the second. */)
Lisp_Object front, back;
register Lisp_Object len, tem;
struct gcpro gcpro1, gcpro2;
- register int length;
+ EMACS_INT length;
front = list;
len = Flength (list);
@@ -2076,7 +2101,7 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int
return compare_window_configurations (o1, o2, 0);
/* Aside from them, only true vectors, char-tables, compiled
- functions, and fonts (font-spec, font-entity, font-ojbect)
+ functions, and fonts (font-spec, font-entity, font-object)
are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
@@ -2122,7 +2147,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
(Lisp_Object array, Lisp_Object item)
{
register EMACS_INT size, idx;
- int charval;
if (VECTORP (array))
{
@@ -2142,27 +2166,21 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
else if (STRINGP (array))
{
register unsigned char *p = SDATA (array);
- CHECK_NUMBER (item);
- charval = XINT (item);
+ int charval;
+ CHECK_CHARACTER (item);
+ charval = XFASTINT (item);
size = SCHARS (array);
if (STRING_MULTIBYTE (array))
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
EMACS_INT size_byte = SBYTES (array);
- unsigned char *p1 = p, *endp = p + size_byte;
- int i;
- if (size != size_byte)
- while (p1 < endp)
- {
- int this_len = BYTES_BY_CHAR_HEAD (*p1);
- if (len != this_len)
- error ("Attempt to change byte length of a string");
- p1 += this_len;
- }
- for (i = 0; i < size_byte; i++)
- *p++ = str[i % len];
+ if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
+ || SCHARS (array) * len != size_byte)
+ error ("Attempt to change byte length of a string");
+ for (idx = 0; idx < size_byte; idx++)
+ *p++ = str[idx % len];
}
else
for (idx = 0; idx < size; idx++)
@@ -2171,19 +2189,18 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
else if (BOOL_VECTOR_P (array))
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
- int size_in_chars
- = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ 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);
- charval = (! NILP (item) ? -1 : 0);
- for (idx = 0; idx < size_in_chars - 1; idx++)
- p[idx] = charval;
- if (idx < size_in_chars)
+ if (size_in_chars)
{
- /* Mask out bits beyond the vector size. */
- if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
- charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
- p[idx] = charval;
+ memset (p, ! NILP (item) ? -1 : 0, size_in_chars);
+
+ /* Clear any extraneous bits in the last byte. */
+ p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
}
}
else
@@ -2220,9 +2237,9 @@ DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
doc: /* Concatenate any number of lists by altering them.
Only the last argument is not altered, and need not be a list.
usage: (nconc &rest LISTS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- register size_t argnum;
+ ptrdiff_t argnum;
register Lisp_Object tail, tem, val;
val = tail = Qnil;
@@ -2297,7 +2314,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
for (i = 0; i < leni; i++)
{
- int byte;
+ unsigned char byte;
byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil;
dummy = call1 (fn, dummy);
@@ -2345,9 +2362,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
{
Lisp_Object len;
register EMACS_INT leni;
- int nargs;
+ ptrdiff_t i, nargs;
register Lisp_Object *args;
- register EMACS_INT i;
struct gcpro gcpro1;
Lisp_Object ret;
USE_SAFE_ALLOCA;
@@ -2526,8 +2542,8 @@ advisable. */)
while (loads-- > 0)
{
- Lisp_Object load = (NILP (use_floats) ?
- make_number ((int) (100.0 * load_ave[loads]))
+ Lisp_Object load = (NILP (use_floats)
+ ? make_number (100.0 * load_ave[loads])
: make_float (load_ave[loads]));
ret = Fcons (load, ret);
}
@@ -2601,6 +2617,7 @@ is not loaded; so load the file FILENAME.
If FILENAME is omitted, the printname of FEATURE is used as the file name,
and `load' will try to load this name appended with the suffix `.elc' or
`.el', in that order. The name without appended suffix will not be used.
+See `get-load-suffixes' for the complete list of suffixes.
If the optional third argument NOERROR is non-nil,
then return nil if the file is not found instead of signaling an error.
Normally the return value is FEATURE.
@@ -2751,7 +2768,7 @@ DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
doc: /* Apply the value of WIDGET's PROPERTY to the widget itself.
ARGS are passed as extra arguments to the function.
usage: (widget-apply WIDGET PROPERTY &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
/* This function can GC. */
Lisp_Object newargs[3];
@@ -2782,7 +2799,7 @@ ITEM should be one of the following:
`months', returning a 12-element vector of month names (locale items MON_n);
`paper', returning a list (WIDTH HEIGHT) for the default paper size,
- both measured in milimeters (locale items PAPER_WIDTH, PAPER_HEIGHT).
+ both measured in millimeters (locale items PAPER_WIDTH, PAPER_HEIGHT).
If the system can't provide such information through a call to
`nl_langinfo', or if ITEM isn't from the list above, return nil.
@@ -3356,23 +3373,8 @@ 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 size_t get_key_arg (Lisp_Object, size_t, Lisp_Object *, char *);
+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 cmpfn_eql (struct Lisp_Hash_Table *, Lisp_Object, unsigned,
- Lisp_Object, unsigned);
-static int cmpfn_equal (struct Lisp_Hash_Table *, Lisp_Object, unsigned,
- Lisp_Object, unsigned);
-static int cmpfn_user_defined (struct Lisp_Hash_Table *, Lisp_Object,
- unsigned, Lisp_Object, unsigned);
-static unsigned hashfn_eq (struct Lisp_Hash_Table *, Lisp_Object);
-static unsigned hashfn_eql (struct Lisp_Hash_Table *, Lisp_Object);
-static unsigned hashfn_equal (struct Lisp_Hash_Table *, Lisp_Object);
-static unsigned hashfn_user_defined (struct Lisp_Hash_Table *,
- Lisp_Object);
-static unsigned sxhash_string (unsigned char *, int);
-static unsigned sxhash_list (Lisp_Object, int);
-static unsigned sxhash_vector (Lisp_Object, int);
-static unsigned sxhash_bool_vector (Lisp_Object);
static int sweep_weak_table (struct Lisp_Hash_Table *, int);
@@ -3395,16 +3397,12 @@ check_hash_table (Lisp_Object obj)
/* Value is the next integer I >= N, N >= 0 which is "almost" a prime
number. */
-int
-next_almost_prime (int n)
+EMACS_INT
+next_almost_prime (EMACS_INT n)
{
- if (n % 2 == 0)
- n += 1;
- if (n % 3 == 0)
- n += 2;
- if (n % 7 == 0)
- n += 4;
- return n;
+ for (n |= 1; ; n += 2)
+ if (n % 3 != 0 && n % 5 != 0 && n % 7 != 0)
+ return n;
}
@@ -3414,10 +3412,10 @@ next_almost_prime (int n)
0. This function is used to extract a keyword/argument pair from
a DEFUN parameter list. */
-static size_t
-get_key_arg (Lisp_Object key, size_t nargs, Lisp_Object *args, char *used)
+static ptrdiff_t
+get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used)
{
- size_t i;
+ ptrdiff_t i;
for (i = 1; i < nargs; i++)
if (!used[i - 1] && EQ (args[i - 1], key))
@@ -3436,10 +3434,10 @@ get_key_arg (Lisp_Object key, size_t nargs, Lisp_Object *args, char *used)
vector that are not copied from VEC are set to INIT. */
Lisp_Object
-larger_vector (Lisp_Object vec, int new_size, Lisp_Object init)
+larger_vector (Lisp_Object vec, EMACS_INT new_size, Lisp_Object init)
{
struct Lisp_Vector *v;
- int i, old_size;
+ EMACS_INT i, old_size;
xassert (VECTORP (vec));
old_size = ASIZE (vec);
@@ -3463,7 +3461,9 @@ larger_vector (Lisp_Object vec, int new_size, Lisp_Object init)
KEY2 are the same. */
static int
-cmpfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
+cmpfn_eql (struct Lisp_Hash_Table *h,
+ Lisp_Object key1, EMACS_UINT hash1,
+ Lisp_Object key2, EMACS_UINT hash2)
{
return (FLOATP (key1)
&& FLOATP (key2)
@@ -3476,7 +3476,9 @@ cmpfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp
KEY2 are the same. */
static int
-cmpfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
+cmpfn_equal (struct Lisp_Hash_Table *h,
+ Lisp_Object key1, EMACS_UINT hash1,
+ Lisp_Object key2, EMACS_UINT hash2)
{
return hash1 == hash2 && !NILP (Fequal (key1, key2));
}
@@ -3487,7 +3489,9 @@ cmpfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Li
if KEY1 and KEY2 are the same. */
static int
-cmpfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
+cmpfn_user_defined (struct Lisp_Hash_Table *h,
+ Lisp_Object key1, EMACS_UINT hash1,
+ Lisp_Object key2, EMACS_UINT hash2)
{
if (hash1 == hash2)
{
@@ -3507,10 +3511,10 @@ cmpfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int ha
`eq' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
-static unsigned
+static EMACS_UINT
hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- unsigned hash = XUINT (key) ^ XTYPE (key);
+ EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
xassert ((hash & ~INTMASK) == 0);
return hash;
}
@@ -3520,10 +3524,10 @@ hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
`eql' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
-static unsigned
+static EMACS_UINT
hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- unsigned hash;
+ EMACS_UINT hash;
if (FLOATP (key))
hash = sxhash (key, 0);
else
@@ -3537,10 +3541,10 @@ hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
`equal' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
-static unsigned
+static EMACS_UINT
hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- unsigned hash = sxhash (key, 0);
+ EMACS_UINT hash = sxhash (key, 0);
xassert ((hash & ~INTMASK) == 0);
return hash;
}
@@ -3550,7 +3554,7 @@ hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
user-defined function to compare keys. The hash code returned is
guaranteed to fit in a Lisp integer. */
-static unsigned
+static EMACS_UINT
hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
{
Lisp_Object args[2], hash;
@@ -3593,26 +3597,33 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
- int index_size, i, sz;
+ EMACS_INT index_size, i, sz;
+ double index_float;
/* Preconditions. */
xassert (SYMBOLP (test));
xassert (INTEGERP (size) && XINT (size) >= 0);
xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
- || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0));
+ || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)));
xassert (FLOATP (rehash_threshold)
- && XFLOATINT (rehash_threshold) > 0
- && XFLOATINT (rehash_threshold) <= 1.0);
+ && 0 < XFLOAT_DATA (rehash_threshold)
+ && XFLOAT_DATA (rehash_threshold) <= 1.0);
if (XFASTINT (size) == 0)
size = make_number (1);
+ sz = XFASTINT (size);
+ index_float = sz / XFLOAT_DATA (rehash_threshold);
+ index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ ? next_almost_prime (index_float)
+ : MOST_POSITIVE_FIXNUM + 1);
+ if (MOST_POSITIVE_FIXNUM < max (index_size, 2 * sz))
+ error ("Hash table too large");
+
/* Allocate a table and initialize it. */
h = allocate_hash_table ();
/* Initialize hash table slots. */
- sz = XFASTINT (size);
-
h->test = test;
if (EQ (test, Qeql))
{
@@ -3644,8 +3655,6 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil);
h->hash = Fmake_vector (size, Qnil);
h->next = Fmake_vector (size, Qnil);
- /* Cast to int here avoids losing with gcc 2.95 on Tru64/Alpha... */
- index_size = next_almost_prime ((int) (sz / XFLOATINT (rehash_threshold)));
h->index = Fmake_vector (make_number (index_size), Qnil);
/* Set up the free list. */
@@ -3704,25 +3713,34 @@ 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 inline void
maybe_resize_hash_table (struct Lisp_Hash_Table *h)
{
if (NILP (h->next_free))
{
- int old_size = HASH_TABLE_SIZE (h);
- int i, new_size, index_size;
+ EMACS_INT old_size = HASH_TABLE_SIZE (h);
+ EMACS_INT i, new_size, index_size;
EMACS_INT nsize;
+ double index_float;
if (INTEGERP (h->rehash_size))
new_size = old_size + XFASTINT (h->rehash_size);
else
- new_size = old_size * XFLOATINT (h->rehash_size);
- new_size = max (old_size + 1, new_size);
- index_size = next_almost_prime ((int)
- (new_size
- / XFLOATINT (h->rehash_threshold)));
- /* Assignment to EMACS_INT stops GCC whining about limited range
- of data type. */
+ {
+ double float_new_size = old_size * XFLOAT_DATA (h->rehash_size);
+ if (float_new_size < MOST_POSITIVE_FIXNUM + 1)
+ {
+ new_size = float_new_size;
+ if (new_size <= old_size)
+ new_size = old_size + 1;
+ }
+ else
+ new_size = MOST_POSITIVE_FIXNUM + 1;
+ }
+ index_float = new_size / XFLOAT_DATA (h->rehash_threshold);
+ index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ ? next_almost_prime (index_float)
+ : MOST_POSITIVE_FIXNUM + 1);
nsize = max (index_size, 2 * new_size);
if (nsize > MOST_POSITIVE_FIXNUM)
error ("Hash table too large to resize");
@@ -3756,8 +3774,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
for (i = 0; i < old_size; ++i)
if (!NILP (HASH_HASH (h, i)))
{
- unsigned hash_code = XUINT (HASH_HASH (h, i));
- int start_of_bucket = hash_code % ASIZE (h->index);
+ 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);
}
@@ -3769,11 +3787,11 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
the hash code of KEY. Value is the index of the entry in H
matching KEY, or -1 if not found. */
-int
-hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, unsigned int *hash)
+EMACS_INT
+hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
{
- unsigned hash_code;
- int start_of_bucket;
+ EMACS_UINT hash_code;
+ EMACS_INT start_of_bucket;
Lisp_Object idx;
hash_code = h->hashfn (h, key);
@@ -3786,7 +3804,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, unsigned int *hash)
/* We need not gcpro idx since it's either an integer or nil. */
while (!NILP (idx))
{
- int i = XFASTINT (idx);
+ EMACS_INT i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
|| (h->cmpfn
&& h->cmpfn (h, key, hash_code,
@@ -3803,10 +3821,11 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, unsigned int *hash)
HASH is a previously computed hash code of KEY.
Value is the index of the entry in H matching KEY. */
-int
-hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, unsigned int hash)
+EMACS_INT
+hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
+ EMACS_UINT hash)
{
- int start_of_bucket, i;
+ EMACS_INT start_of_bucket, i;
xassert ((hash & ~INTMASK) == 0);
@@ -3836,8 +3855,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, unsigne
static void
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- unsigned hash_code;
- int start_of_bucket;
+ EMACS_UINT hash_code;
+ EMACS_INT start_of_bucket;
Lisp_Object idx, prev;
hash_code = h->hashfn (h, key);
@@ -3848,7 +3867,7 @@ 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))
{
- int i = XFASTINT (idx);
+ EMACS_INT i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
|| (h->cmpfn
@@ -3886,7 +3905,7 @@ hash_clear (struct Lisp_Hash_Table *h)
{
if (h->count > 0)
{
- int i, size = HASH_TABLE_SIZE (h);
+ EMACS_INT i, size = HASH_TABLE_SIZE (h);
for (i = 0; i < size; ++i)
{
@@ -3924,7 +3943,8 @@ init_weak_hash_tables (void)
static int
sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
{
- int bucket, n, marked;
+ EMACS_INT bucket, n;
+ int marked;
n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
marked = 0;
@@ -3938,7 +3958,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
prev = Qnil;
for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
- int i = XFASTINT (idx);
+ 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;
@@ -4067,43 +4087,68 @@ sweep_weak_hash_tables (void)
#define SXHASH_MAX_LEN 7
-/* Combine two integers X and Y for hashing. */
+/* Combine two integers X and Y for hashing. The result might not fit
+ into a Lisp integer. */
#define SXHASH_COMBINE(X, Y) \
- ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \
- + (unsigned)(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)
/* Return a hash for string PTR which has length LEN. The hash
code returned is guaranteed to fit in a Lisp integer. */
-static unsigned
-sxhash_string (unsigned char *ptr, int len)
+static EMACS_UINT
+sxhash_string (unsigned char *ptr, EMACS_INT len)
{
unsigned char *p = ptr;
unsigned char *end = p + len;
unsigned char c;
- unsigned hash = 0;
+ EMACS_UINT hash = 0;
while (p != end)
{
c = *p++;
if (c >= 0140)
c -= 40;
- hash = ((hash << 4) + (hash >> 28) + c);
+ hash = SXHASH_COMBINE (hash, c);
}
- return hash & INTMASK;
+ return SXHASH_REDUCE (hash);
}
+/* Return a hash for the floating point value VAL. */
+
+static EMACS_INT
+sxhash_float (double val)
+{
+ EMACS_UINT hash = 0;
+ enum {
+ WORDS_PER_DOUBLE = (sizeof val / sizeof hash
+ + (sizeof val % sizeof hash != 0))
+ };
+ union {
+ double val;
+ EMACS_UINT word[WORDS_PER_DOUBLE];
+ } u;
+ int i;
+ 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]);
+ return SXHASH_REDUCE (hash);
+}
/* Return a hash for list LIST. DEPTH is the current depth in the
list. We don't recurse deeper than SXHASH_MAX_DEPTH in it. */
-static unsigned
+static EMACS_UINT
sxhash_list (Lisp_Object list, int depth)
{
- unsigned hash = 0;
+ EMACS_UINT hash = 0;
int i;
if (depth < SXHASH_MAX_DEPTH)
@@ -4111,63 +4156,62 @@ sxhash_list (Lisp_Object list, int depth)
CONSP (list) && i < SXHASH_MAX_LEN;
list = XCDR (list), ++i)
{
- unsigned hash2 = sxhash (XCAR (list), depth + 1);
+ EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1);
hash = SXHASH_COMBINE (hash, hash2);
}
if (!NILP (list))
{
- unsigned hash2 = sxhash (list, depth + 1);
+ EMACS_UINT hash2 = sxhash (list, depth + 1);
hash = SXHASH_COMBINE (hash, hash2);
}
- return hash;
+ return SXHASH_REDUCE (hash);
}
/* Return a hash for vector VECTOR. DEPTH is the current depth in
the Lisp structure. */
-static unsigned
+static EMACS_UINT
sxhash_vector (Lisp_Object vec, int depth)
{
- unsigned hash = ASIZE (vec);
+ EMACS_UINT hash = ASIZE (vec);
int i, n;
n = min (SXHASH_MAX_LEN, ASIZE (vec));
for (i = 0; i < n; ++i)
{
- unsigned hash2 = sxhash (AREF (vec, i), depth + 1);
+ EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1);
hash = SXHASH_COMBINE (hash, hash2);
}
- return hash;
+ return SXHASH_REDUCE (hash);
}
-
/* Return a hash for bool-vector VECTOR. */
-static unsigned
+static EMACS_UINT
sxhash_bool_vector (Lisp_Object vec)
{
- unsigned hash = XBOOL_VECTOR (vec)->size;
+ EMACS_UINT hash = XBOOL_VECTOR (vec)->size;
int i, n;
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]);
- return hash;
+ return SXHASH_REDUCE (hash);
}
/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
structure. Value is an unsigned integer clipped to INTMASK. */
-unsigned
+EMACS_UINT
sxhash (Lisp_Object obj, int depth)
{
- unsigned hash;
+ EMACS_UINT hash;
if (depth > SXHASH_MAX_DEPTH)
return 0;
@@ -4211,20 +4255,14 @@ sxhash (Lisp_Object obj, int depth)
break;
case Lisp_Float:
- {
- double val = XFLOAT_DATA (obj);
- unsigned char *p = (unsigned char *) &val;
- size_t i;
- for (hash = 0, i = 0; i < sizeof val; i++)
- hash = SXHASH_COMBINE (hash, p[i]);
- break;
- }
+ hash = sxhash_float (XFLOAT_DATA (obj));
+ break;
default:
abort ();
}
- return hash & INTMASK;
+ return hash;
}
@@ -4238,7 +4276,7 @@ DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0,
doc: /* Compute a hash code for OBJ and return it as integer. */)
(Lisp_Object obj)
{
- unsigned hash = sxhash (obj, 0);
+ EMACS_UINT hash = sxhash (obj, 0);
return make_number (hash);
}
@@ -4275,12 +4313,12 @@ WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
is nil.
usage: (make-hash-table &rest KEYWORD-ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object test, size, rehash_size, rehash_threshold, weak;
Lisp_Object user_test, user_hash;
char *used;
- size_t i;
+ ptrdiff_t i;
/* The vector `used' is used to keep track of arguments that
have been consumed. */
@@ -4315,17 +4353,16 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
/* Look for `:rehash-size SIZE'. */
i = get_key_arg (QCrehash_size, nargs, args, used);
rehash_size = i ? args[i] : make_float (DEFAULT_REHASH_SIZE);
- if (!NUMBERP (rehash_size)
- || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
- || XFLOATINT (rehash_size) <= 1.0)
+ if (! ((INTEGERP (rehash_size) && 0 < XINT (rehash_size))
+ || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size))))
signal_error ("Invalid hash table rehash size", rehash_size);
/* Look for `:rehash-threshold THRESHOLD'. */
i = get_key_arg (QCrehash_threshold, nargs, args, used);
rehash_threshold = i ? args[i] : make_float (DEFAULT_REHASH_THRESHOLD);
- if (!FLOATP (rehash_threshold)
- || XFLOATINT (rehash_threshold) <= 0.0
- || XFLOATINT (rehash_threshold) > 1.0)
+ if (! (FLOATP (rehash_threshold)
+ && 0 < XFLOAT_DATA (rehash_threshold)
+ && XFLOAT_DATA (rehash_threshold) <= 1))
signal_error ("Invalid hash table rehash threshold", rehash_threshold);
/* Look for `:weakness WEAK'. */
@@ -4437,7 +4474,7 @@ If KEY is not found, return DFLT which defaults to nil. */)
(Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- int i = hash_lookup (h, key, NULL);
+ EMACS_INT i = hash_lookup (h, key, NULL);
return i >= 0 ? HASH_VALUE (h, i) : dflt;
}
@@ -4445,12 +4482,12 @@ If KEY is not found, return DFLT which defaults to nil. */)
DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
doc: /* Associate KEY with VALUE in hash table TABLE.
If KEY is already present in table, replace its current value with
-VALUE. */)
+VALUE. In any case, return VALUE. */)
(Lisp_Object key, Lisp_Object value, Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- int i;
- unsigned hash;
+ EMACS_INT i;
+ EMACS_UINT hash;
i = hash_lookup (h, key, &hash);
if (i >= 0)
@@ -4479,7 +4516,7 @@ FUNCTION is called with two arguments, KEY and VALUE. */)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
Lisp_Object args[3];
- int i;
+ EMACS_INT i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)))
@@ -4514,42 +4551,19 @@ including negative integers. */)
/************************************************************************
- MD5
+ MD5, SHA-1, and SHA-2
************************************************************************/
#include "md5.h"
+#include "sha1.h"
+#include "sha256.h"
+#include "sha512.h"
-DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
- doc: /* Return MD5 message digest of OBJECT, a buffer or string.
-
-A message digest is a cryptographic checksum of a document, and the
-algorithm to calculate it is defined in RFC 1321.
-
-The two optional arguments START and END are character positions
-specifying for which part of OBJECT the message digest should be
-computed. If nil or omitted, the digest is computed for the whole
-OBJECT.
-
-The MD5 message digest is computed from the result of encoding the
-text in a coding system, not directly from the internal Emacs form of
-the text. The optional fourth argument CODING-SYSTEM specifies which
-coding system to encode the text with. It should be the same coding
-system that you used or will use when actually writing the text into a
-file.
-
-If CODING-SYSTEM is nil or omitted, the default depends on OBJECT. If
-OBJECT is a buffer, the default for CODING-SYSTEM is whatever coding
-system would be chosen by default for writing this text into a file.
-
-If OBJECT is a string, the most preferred coding system (see the
-command `prefer-coding-system') is used.
+/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
-If NOERROR is non-nil, silently assume the `raw-text' coding if the
-guesswork fails. Normally, an error is signaled in such case. */)
- (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror)
+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)
{
- unsigned char digest[16];
- char value[33];
int i;
EMACS_INT size;
EMACS_INT size_byte = 0;
@@ -4558,6 +4572,11 @@ guesswork fails. Normally, an error is signaled in such case. */)
register EMACS_INT b, e;
register struct buffer *bp;
EMACS_INT temp;
+ int digest_size;
+ void *(*hash_func) (const char *, size_t, void *);
+ Lisp_Object digest;
+
+ CHECK_SYMBOL (algorithm);
if (STRINGP (object))
{
@@ -4728,50 +4747,132 @@ guesswork fails. Normally, an error is signaled in such case. */)
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
}
- md5_buffer (SSDATA (object) + start_byte,
- SBYTES (object) - (size_byte - end_byte),
- digest);
+ if (EQ (algorithm, Qmd5))
+ {
+ digest_size = MD5_DIGEST_SIZE;
+ hash_func = md5_buffer;
+ }
+ else if (EQ (algorithm, Qsha1))
+ {
+ digest_size = SHA1_DIGEST_SIZE;
+ hash_func = sha1_buffer;
+ }
+ else if (EQ (algorithm, Qsha224))
+ {
+ digest_size = SHA224_DIGEST_SIZE;
+ hash_func = sha224_buffer;
+ }
+ else if (EQ (algorithm, Qsha256))
+ {
+ digest_size = SHA256_DIGEST_SIZE;
+ hash_func = sha256_buffer;
+ }
+ else if (EQ (algorithm, Qsha384))
+ {
+ digest_size = SHA384_DIGEST_SIZE;
+ hash_func = sha384_buffer;
+ }
+ else if (EQ (algorithm, Qsha512))
+ {
+ digest_size = SHA512_DIGEST_SIZE;
+ hash_func = sha512_buffer;
+ }
+ else
+ error ("Invalid algorithm arg: %s", SDATA (Fsymbol_name (algorithm)));
+
+ /* allocate 2 x digest_size so that it can be re-used to hold the
+ hexified value */
+ digest = make_uninit_string (digest_size * 2);
+
+ hash_func (SSDATA (object) + start_byte,
+ SBYTES (object) - (size_byte - end_byte),
+ SSDATA (digest));
+
+ if (NILP (binary))
+ {
+ unsigned char *p = SDATA (digest);
+ for (i = digest_size - 1; i >= 0; i--)
+ {
+ static char const hexdigit[16] = "0123456789abcdef";
+ int p_i = p[i];
+ p[2 * i] = hexdigit[p_i >> 4];
+ p[2 * i + 1] = hexdigit[p_i & 0xf];
+ }
+ return digest;
+ }
+ else
+ return make_unibyte_string (SSDATA (digest), digest_size);
+}
+
+DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
+ doc: /* Return MD5 message digest of OBJECT, a buffer or string.
+
+A message digest is a cryptographic checksum of a document, and the
+algorithm to calculate it is defined in RFC 1321.
+
+The two optional arguments START and END are character positions
+specifying for which part of OBJECT the message digest should be
+computed. If nil or omitted, the digest is computed for the whole
+OBJECT.
+
+The MD5 message digest is computed from the result of encoding the
+text in a coding system, not directly from the internal Emacs form of
+the text. The optional fourth argument CODING-SYSTEM specifies which
+coding system to encode the text with. It should be the same coding
+system that you used or will use when actually writing the text into a
+file.
+
+If CODING-SYSTEM is nil or omitted, the default depends on OBJECT. If
+OBJECT is a buffer, the default for CODING-SYSTEM is whatever coding
+system would be chosen by default for writing this text into a file.
- for (i = 0; i < 16; i++)
- sprintf (&value[2 * i], "%02x", digest[i]);
- value[32] = '\0';
+If OBJECT is a string, the most preferred coding system (see the
+command `prefer-coding-system') is used.
- return make_string (value, 32);
+If NOERROR is non-nil, silently assume the `raw-text' coding if the
+guesswork fails. Normally, an error is signaled in such case. */)
+ (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror)
+{
+ return secure_hash (Qmd5, object, start, end, coding_system, noerror, Qnil);
}
+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. */)
+ (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);
+}
void
syms_of_fns (void)
{
+ DEFSYM (Qmd5, "md5");
+ DEFSYM (Qsha1, "sha1");
+ DEFSYM (Qsha224, "sha224");
+ DEFSYM (Qsha256, "sha256");
+ DEFSYM (Qsha384, "sha384");
+ DEFSYM (Qsha512, "sha512");
+
/* Hash table stuff. */
- Qhash_table_p = intern_c_string ("hash-table-p");
- staticpro (&Qhash_table_p);
- Qeq = intern_c_string ("eq");
- staticpro (&Qeq);
- Qeql = intern_c_string ("eql");
- staticpro (&Qeql);
- Qequal = intern_c_string ("equal");
- staticpro (&Qequal);
- QCtest = intern_c_string (":test");
- staticpro (&QCtest);
- QCsize = intern_c_string (":size");
- staticpro (&QCsize);
- QCrehash_size = intern_c_string (":rehash-size");
- staticpro (&QCrehash_size);
- QCrehash_threshold = intern_c_string (":rehash-threshold");
- staticpro (&QCrehash_threshold);
- QCweakness = intern_c_string (":weakness");
- staticpro (&QCweakness);
- Qkey = intern_c_string ("key");
- staticpro (&Qkey);
- Qvalue = intern_c_string ("value");
- staticpro (&Qvalue);
- Qhash_table_test = intern_c_string ("hash-table-test");
- staticpro (&Qhash_table_test);
- Qkey_or_value = intern_c_string ("key-or-value");
- staticpro (&Qkey_or_value);
- Qkey_and_value = intern_c_string ("key-and-value");
- staticpro (&Qkey_and_value);
+ DEFSYM (Qhash_table_p, "hash-table-p");
+ DEFSYM (Qeq, "eq");
+ DEFSYM (Qeql, "eql");
+ DEFSYM (Qequal, "equal");
+ DEFSYM (QCtest, ":test");
+ DEFSYM (QCsize, ":size");
+ DEFSYM (QCrehash_size, ":rehash-size");
+ DEFSYM (QCrehash_threshold, ":rehash-threshold");
+ DEFSYM (QCweakness, ":weakness");
+ DEFSYM (Qkey, "key");
+ DEFSYM (Qvalue, "value");
+ DEFSYM (Qhash_table_test, "hash-table-test");
+ DEFSYM (Qkey_or_value, "key-or-value");
+ DEFSYM (Qkey_and_value, "key-and-value");
defsubr (&Ssxhash);
defsubr (&Smake_hash_table);
@@ -4790,18 +4891,12 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
- Qstring_lessp = intern_c_string ("string-lessp");
- staticpro (&Qstring_lessp);
- Qprovide = intern_c_string ("provide");
- staticpro (&Qprovide);
- Qrequire = intern_c_string ("require");
- staticpro (&Qrequire);
- Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history");
- staticpro (&Qyes_or_no_p_history);
- Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area");
- staticpro (&Qcursor_in_echo_area);
- Qwidget_type = intern_c_string ("widget-type");
- staticpro (&Qwidget_type);
+ DEFSYM (Qstring_lessp, "string-lessp");
+ DEFSYM (Qprovide, "provide");
+ DEFSYM (Qrequire, "require");
+ DEFSYM (Qyes_or_no_p_history, "yes-or-no-p-history");
+ DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area");
+ DEFSYM (Qwidget_type, "widget-type");
staticpro (&string_char_byte_cache_string);
string_char_byte_cache_string = Qnil;
@@ -4815,18 +4910,13 @@ syms_of_fns (void)
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
- Qsubfeatures = intern_c_string ("subfeatures");
- staticpro (&Qsubfeatures);
+ DEFSYM (Qsubfeatures, "subfeatures");
#ifdef HAVE_LANGINFO_CODESET
- Qcodeset = intern_c_string ("codeset");
- staticpro (&Qcodeset);
- Qdays = intern_c_string ("days");
- staticpro (&Qdays);
- Qmonths = intern_c_string ("months");
- staticpro (&Qmonths);
- Qpaper = intern_c_string ("paper");
- staticpro (&Qpaper);
+ DEFSYM (Qcodeset, "codeset");
+ DEFSYM (Qdays, "days");
+ DEFSYM (Qmonths, "months");
+ DEFSYM (Qpaper, "paper");
#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
@@ -4911,6 +5001,7 @@ this variable. */);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
+ defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
}
diff --git a/src/font.c b/src/font.c
index edbdc958539..5f8d22157d6 100644
--- a/src/font.c
+++ b/src/font.c
@@ -136,7 +136,7 @@ Lisp_Object Qja, Qko;
static Lisp_Object QCuser_spec;
-/* Alist of font registry symbol and the corresponding charsets
+/* Alist of font registry symbols and the corresponding charset
information. The information is retrieved from
Vfont_encoding_alist on demand.
@@ -226,32 +226,45 @@ static int num_font_drivers;
/* Return a Lispy value of a font property value at STR and LEN bytes.
- If STR is "*", it returns nil.
- If FORCE_SYMBOL is zero and all characters in STR are digits, it
- returns an integer. Otherwise, it returns a symbol interned from
+ 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. */
Lisp_Object
-font_intern_prop (const char *str, int len, int force_symbol)
+font_intern_prop (const char *str, ptrdiff_t len, int force_symbol)
{
- int i;
+ ptrdiff_t i;
Lisp_Object tem;
Lisp_Object obarray;
EMACS_INT nbytes, nchars;
if (len == 1 && *str == '*')
return Qnil;
- if (!force_symbol && len >=1 && isdigit (*str))
+ if (!force_symbol && 0 < len && '0' <= *str && *str <= '9')
{
for (i = 1; i < len; i++)
- if (! isdigit (str[i]))
+ if (! ('0' <= str[i] && str[i] <= '9'))
break;
if (i == len)
- return make_number (atoi (str));
+ {
+ EMACS_INT n;
+
+ i = 0;
+ for (n = 0; (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; n *= 10)
+ {
+ if (i == len)
+ return make_number (n);
+ if (MOST_POSITIVE_FIXNUM / 10 < n)
+ break;
+ }
+
+ xsignal1 (Qoverflow_error, make_string (str, len));
+ }
}
/* The following code is copied from the function intern (in
- lread.c), and modified to suite our purpose. */
+ lread.c), and modified to suit our purpose. */
obarray = Vobarray;
if (!VECTORP (obarray) || ASIZE (obarray) == 0)
obarray = check_obarray (obarray);
@@ -305,7 +318,7 @@ font_pixel_size (FRAME_PTR f, Lisp_Object spec)
font vector. If VAL is not valid (i.e. not registered in
font_style_table), return -1 if NOERROR is zero, and return a
proper index if NOERROR is nonzero. In that case, register VAL in
- font_style_table if VAL is a symbol, and return a closest index if
+ font_style_table if VAL is a symbol, and return the closest index if
VAL is an integer. */
int
@@ -473,7 +486,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct
}
-/* Font property value validaters. See the comment of
+/* Font property value validators. See the comment of
font_property_table for the meaning of the arguments. */
static Lisp_Object font_prop_validate (int, Lisp_Object, Lisp_Object);
@@ -591,7 +604,7 @@ font_prop_validate_otf (Lisp_Object prop, Lisp_Object val)
return val;
}
-/* Structure of known font property keys and validater of the
+/* Structure of known font property keys and validator of the
values. */
static const struct
{
@@ -742,7 +755,7 @@ enum xlfd_field_mask
};
-/* Parse P pointing the pixel/point size field of the form
+/* Parse P pointing to the pixel/point size field of the form
`[A B C D]' which specifies a transformation matrix:
A B 0
@@ -775,7 +788,7 @@ parse_matrix (const char *p)
}
/* Expand a wildcard field in FIELD (the first N fields are filled) to
- multiple fields to fill in all 14 XLFD fields while restring a
+ multiple fields to fill in all 14 XLFD fields while restricting a
field position by its contents. */
static int
@@ -982,7 +995,7 @@ font_expand_wildcards (Lisp_Object *field, int n)
int
font_parse_xlfd (char *name, Lisp_Object font)
{
- int len = strlen (name);
+ ptrdiff_t len = strlen (name);
int i, j, n;
char *f[XLFD_LAST_INDEX + 1];
Lisp_Object val;
@@ -1310,7 +1323,7 @@ font_parse_fcname (char *name, Lisp_Object font)
char *p, *q;
char *size_beg = NULL, *size_end = NULL;
char *props_beg = NULL, *family_end = NULL;
- int len = strlen (name);
+ ptrdiff_t len = strlen (name);
if (len == 0)
return -1;
@@ -1376,7 +1389,7 @@ font_parse_fcname (char *name, Lisp_Object font)
if (*q != '=')
{
/* Must be an enumerated value. */
- int word_len;
+ ptrdiff_t word_len;
p = p + 1;
word_len = q - p;
val = font_intern_prop (p, q - p, 1);
@@ -1452,7 +1465,7 @@ font_parse_fcname (char *name, Lisp_Object font)
Lisp_Object weight = Qnil, slant = Qnil;
Lisp_Object width = Qnil, size = Qnil;
char *word_start;
- int word_len;
+ ptrdiff_t word_len;
/* Scan backwards from the end, looking for a size. */
for (p = name + len - 1; p >= name; p--)
@@ -1542,7 +1555,8 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
Lisp_Object family, foundry;
Lisp_Object tail, val;
int point_size;
- int i, len = 1;
+ int i;
+ ptrdiff_t len = 1;
char *p;
Lisp_Object styles[3];
const char *style_names[3] = { "weight", "slant", "width" };
@@ -1724,8 +1738,7 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
#define LGSTRING_GLYPH_SIZE 8
static int
-check_gstring (gstring)
- Lisp_Object gstring;
+check_gstring (Lisp_Object gstring)
{
Lisp_Object val;
int i, j;
@@ -1779,8 +1792,7 @@ check_gstring (gstring)
}
static void
-check_otf_features (otf_features)
- Lisp_Object otf_features;
+check_otf_features (Lisp_Object otf_features)
{
Lisp_Object val;
@@ -1813,8 +1825,7 @@ check_otf_features (otf_features)
Lisp_Object otf_list;
static Lisp_Object
-otf_tag_symbol (tag)
- OTF_Tag tag;
+otf_tag_symbol (OTF_Tag tag)
{
char name[5];
@@ -1823,8 +1834,7 @@ otf_tag_symbol (tag)
}
static OTF *
-otf_open (file)
- Lisp_Object file;
+otf_open (Lisp_Object file)
{
Lisp_Object val = Fassoc (file, otf_list);
OTF *otf;
@@ -1846,8 +1856,7 @@ otf_open (file)
(struct font_driver).otf_capability. */
Lisp_Object
-font_otf_capability (font)
- struct font *font;
+font_otf_capability (struct font *font)
{
OTF *otf;
Lisp_Object capability = Fcons (Qnil, Qnil);
@@ -1921,9 +1930,7 @@ font_otf_capability (font)
FEATURES. */
static void
-generate_otf_features (spec, features)
- Lisp_Object spec;
- char *features;
+generate_otf_features (Lisp_Object spec, char *features)
{
Lisp_Object val;
char *p;
@@ -1958,8 +1965,7 @@ generate_otf_features (spec, features)
}
Lisp_Object
-font_otf_DeviceTable (device_table)
- OTF_DeviceTable *device_table;
+font_otf_DeviceTable (OTF_DeviceTable *device_table)
{
int len = device_table->StartSize - device_table->EndSize + 1;
@@ -1968,9 +1974,7 @@ font_otf_DeviceTable (device_table)
}
Lisp_Object
-font_otf_ValueRecord (value_format, value_record)
- int value_format;
- OTF_ValueRecord *value_record;
+font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
{
Lisp_Object val = Fmake_vector (make_number (8), Qnil);
@@ -1994,8 +1998,7 @@ font_otf_ValueRecord (value_format, value_record)
}
Lisp_Object
-font_otf_Anchor (anchor)
- OTF_Anchor *anchor;
+font_otf_Anchor (OTF_Anchor *anchor)
{
Lisp_Object val;
@@ -2054,14 +2057,14 @@ font_rescale_ratio (Lisp_Object font_entity)
font-spec. The score value is 32 bit (`unsigned'), and the smaller
the value is, the closer the font is to the font-spec.
- The lowest 2 bits of the score is used for driver type. The font
+ The lowest 2 bits of the score are used for driver type. The font
available by the most preferred font driver is 0.
- Each 7-bit in the higher 28 bits are used for numeric properties
+ The 4 7-bit fields in the higher 28 bits are used for numeric properties
WEIGHT, SLANT, WIDTH, and SIZE. */
/* How many bits to shift to store the difference value of each font
- property in a score. Note that flots for FONT_TYPE_INDEX and
+ property in a score. Note that floats for FONT_TYPE_INDEX and
FONT_REGISTRY_INDEX are not used. */
static int sort_shift_bits[FONT_SIZE_INDEX + 1];
@@ -2093,8 +2096,8 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop)
{
/* We use the higher 6-bit for the actual size difference. The
lowest bit is set if the DPI is different. */
- int diff;
- int pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
+ EMACS_INT diff;
+ EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
if (CONSP (Vface_font_rescale_alist))
pixel_size *= font_rescale_ratio (entity);
@@ -2598,7 +2601,7 @@ font_clear_cache (FRAME_PTR f, Lisp_Object cache, struct font_driver *driver)
static Lisp_Object scratch_font_spec, scratch_font_prefer;
/* Check each font-entity in VEC, and return a list of font-entities
- that satisfy this condition:
+ that satisfy these conditions:
(1) matches with SPEC and SIZE if SPEC is not nil, and
(2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
*/
@@ -3018,8 +3021,8 @@ font_clear_prop (Lisp_Object *attrs, enum font_property_index prop)
attrs[LFACE_FONT_INDEX] = font;
}
-/* Selecte a font from ENTITIES (list of font-entity vectors) that
- supports C and matches best with ATTRS and PIXEL_SIZE. */
+/* Select a font from ENTITIES (list of font-entity vectors) that
+ supports C and is the best match for ATTRS and PIXEL_SIZE. */
static Lisp_Object
font_select_entity (Lisp_Object frame, Lisp_Object entities, Lisp_Object *attrs, int pixel_size, int c)
@@ -3062,8 +3065,8 @@ font_select_entity (Lisp_Object frame, Lisp_Object entities, Lisp_Object *attrs,
return font_sort_entities (entities, prefer, frame, c);
}
-/* Return a font-entity satisfying SPEC and best matching with face's
- font related attributes in ATTRS. C, if not negative, is a
+/* Return a font-entity that satisfies SPEC and is the best match for
+ face's font related attributes in ATTRS. C, if not negative, is a
character that the entity must support. */
Lisp_Object
@@ -3254,8 +3257,8 @@ font_open_for_lface (FRAME_PTR f, Lisp_Object entity, Lisp_Object *attrs, Lisp_O
}
-/* Find a font satisfying SPEC and best matching with face's
- attributes in ATTRS on FRAME, and return the opened
+/* Find a font that satisfies SPEC and is the best match for
+ face's attributes in ATTRS on FRAME, and return the opened
font-object. */
Lisp_Object
@@ -3267,8 +3270,7 @@ font_load_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec)
if (NILP (entity))
{
/* No font is listed for SPEC, but each font-backend may have
- the different criteria about "font matching". So, try
- it. */
+ different criteria about "font matching". So, try it. */
entity = font_matching_entity (f, attrs, spec);
if (NILP (entity))
return Qnil;
@@ -3307,7 +3309,7 @@ font_done_for_face (FRAME_PTR f, struct face *face)
}
-/* Open a font matching with font-spec SPEC on frame F. If no proper
+/* Open a font that is a match for font-spec SPEC on frame F. If no proper
font is found, return Qnil. */
Lisp_Object
@@ -3331,7 +3333,7 @@ font_open_by_spec (FRAME_PTR f, Lisp_Object spec)
}
-/* Open a font matching with NAME on frame F. If no proper font is
+/* Open a font that matches NAME on frame F. If no proper font is
found, return Qnil. */
Lisp_Object
@@ -3355,7 +3357,7 @@ font_open_by_name (FRAME_PTR f, const char *name)
/* Register font-driver DRIVER. This function is used in two ways.
The first is with frame F non-NULL. In this case, make DRIVER
- available (but not yet activated) on F. All frame creaters
+ available (but not yet activated) on F. All frame creators
(e.g. Fx_create_frame) must call this function at least once with
an available font-driver.
@@ -3682,7 +3684,7 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
#ifdef HAVE_WINDOW_SYSTEM
/* Check how many characters after POS (at most to *LIMIT) can be
- displayed by the same font on the window W. FACE, if non-NULL, is
+ displayed by the same font in the window W. FACE, if non-NULL, is
the face selected for the character at POS. If STRING is not nil,
it is the string to check instead of the current buffer. In that
case, FACE must be not NULL.
@@ -3726,8 +3728,9 @@ font_range (EMACS_INT pos, EMACS_INT *limit, struct window *w, struct face *face
else
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
category = CHAR_TABLE_REF (Vunicode_category_table, c);
- if (EQ (category, QCf)
- || CHAR_VARIATION_SELECTOR_P (c))
+ if (INTEGERP (category)
+ && (XINT (category) == UNICODE_CATEGORY_Cf
+ || CHAR_VARIATION_SELECTOR_P (c)))
continue;
if (NILP (font_object))
{
@@ -3826,14 +3829,14 @@ GSUB and GPOS may contain `nil' element. In such a case, the font
must not have any of the remaining elements.
For instance, if the VALUE is `(thai nil nil (mark))', the font must
-be an OpenType font, and whose GPOS table of `thai' script's default
+be an OpenType font whose GPOS table of `thai' script's default
language system must contain `mark' feature.
usage: (font-spec ARGS...) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object spec = font_make_spec ();
- size_t i;
+ ptrdiff_t i;
for (i = 0; i < nargs; i += 2)
{
@@ -4189,7 +4192,7 @@ DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
FONT is a font-spec, font-entity, or font-object.
If the name is too long for XLFD (maximum 255 chars), return nil.
If the 2nd optional arg FOLD-WILDCARDS is non-nil,
-the consecutive wildcards are folded to one. */)
+the consecutive wildcards are folded into one. */)
(Lisp_Object font, Lisp_Object fold_wildcards)
{
char name[256];
@@ -4295,7 +4298,7 @@ created glyph-string. Otherwise, the value is nil. */)
{
struct font *font;
Lisp_Object font_object, n, glyph;
- int i, j, from, to;
+ EMACS_INT i, j, from, to;
if (! composition_gstring_p (gstring))
signal_error ("Invalid glyph-string: ", gstring);
@@ -4389,16 +4392,8 @@ where
for (i = 0; i < 255; i++)
if (variations[i])
{
- Lisp_Object code;
int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
- /* Stops GCC whining about limited range of data type. */
- EMACS_INT var = variations[i];
-
- if (var > MOST_POSITIVE_FIXNUM)
- code = Fcons (make_number ((variations[i]) >> 16),
- make_number ((variations[i]) & 0xFFFF));
- else
- code = make_number (variations[i]);
+ Lisp_Object code = INTEGER_TO_CONS (variations[i]);
val = Fcons (Fcons (make_number (vs), code), val);
}
return val;
@@ -4436,7 +4431,7 @@ the value is 0.
If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
produced in GSTRING-OUT, and the value is nil.
-See the documentation of `font-make-gstring' for the format of
+See the documentation of `composition-get-gstring' for the format of
glyph-string. */)
(Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index)
{
@@ -4571,10 +4566,10 @@ The value is a vector:
[ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
CAPABILITY ]
-NAME is a string of the font name (or nil if the font backend doesn't
+NAME is the font name, a string (or nil if the font backend doesn't
provide a name).
-FILENAME is a string of the font file (or nil if the font backend
+FILENAME is the font file name, a string (or nil if the font backend
doesn't provide a file name).
PIXEL-SIZE is a pixel size by which the font is opened.
diff --git a/src/font.h b/src/font.h
index 4b3ceed1dd3..e50eaff9a1f 100644
--- a/src/font.h
+++ b/src/font.h
@@ -36,22 +36,22 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
FONT-ENTITY
- Pseudo vector (length FONT_ENTITY_MAX) of fully instanciated
+ Pseudo vector (length FONT_ENTITY_MAX) of fully instantiated
font properties that a font-driver returns upon a request of
FONT-SPEC.
Note: Only the method `list' and `match' of a font-driver can
- create this object, and should never be modified by Lisp.
+ create this object, and it should never be modified by Lisp.
FONT-OBJECT
- Pseudo vector (length FONT_OBJECT_MAX) of a opend font.
+ Pseudo vector (length FONT_OBJECT_MAX) of an opened font.
Lisp object encapsulating "struct font". This corresponds to
an opened font.
Note: Only the method `open' of a font-driver can create this
- object, and should never be modified by Lisp. */
+ object, and it should never be modified by Lisp. */
extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
@@ -68,7 +68,7 @@ struct glyph_string;
enum font_property_index
{
/* FONT-TYPE is a symbol indicating a font backend; currently `x',
- `xft', `ftx' are available on X, `uniscribe' and `gdi' on
+ `xft', and `ftx' are available on X, `uniscribe' and `gdi' on
Windows, and `ns' under Cocoa / GNUstep. */
FONT_TYPE_INDEX,
@@ -86,26 +86,26 @@ enum font_property_index
FONT_REGISTRY_INDEX,
/* FONT-WEIGHT is a numeric value of weight (e.g. medium, bold) of
- the font. The lowest 8-bit is an index determining the
+ the font. The lowest 8 bits is an index determining the
symbolic name, and the higher bits is the actual numeric value
defined in `font-weight-table'. */
FONT_WEIGHT_INDEX,
/* FONT-SLANT is a numeric value of slant (e.g. r, i, o) of the
- font. The lowest 8-bit is an index determining the symbolic
+ font. The lowest 8 bits is an index determining the symbolic
name, and the higher bits is the actual numeric value defined
in `font-slant-table'. */
FONT_SLANT_INDEX,
/* FONT-WIDTH is a numeric value of setwidth (e.g. normal) of the
- font. The lowest 8-bit is an index determining the symbolic
+ font. The lowest 8 bits is an index determining the symbolic
name, and the higher bits is the actual numeric value defined
`font-width-table'. */
FONT_WIDTH_INDEX,
/* FONT-SIZE is a size of the font. If integer, it is a pixel
- size. For a font-spec, the value can be float specifying a
- point size. The value zero means that the font is
+ size. For a font-spec, the value can be a float specifying
+ the point size. The value zero means that the font is
scalable. */
FONT_SIZE_INDEX,
@@ -129,18 +129,18 @@ enum font_property_index
/* FONT-STYLE is a 24-bit integer containing indices for
style-related properties WEIGHT, SLANT, and WIDTH. The lowest
- 8-bit is an indice to the weight table AREF (font_style_table,
- 0), the next 8-bit is an indice to the slant table AREF
- (font_style_table, 1), the highest 8-bit is an indice to the
- slant table AREF (font_style_table, 2). The indice 0 indicates
+ 8 bits is an index to the weight table AREF (font_style_table,
+ 0), the next 8 bits is an index to the slant table AREF
+ (font_style_table, 1), the highest 8 bits is an index to the
+ slant table AREF (font_style_table, 2). The index 0 indicates
that the corresponding style is not specified. This way, we
can represent at most 255 different names for each style, which
is surely sufficient. */
FONT_STYLE_INDEX,
/* FONT-METRICS is a 27-bit integer containing metrics-related
- properties DPI, AVGWIDTH, SPACING. The lowest 12-bit is for
- DPI, the next 12-bit is for AVGWIDTH, the highest 3-bit is for
+ properties DPI, AVGWIDTH, SPACING. The lowest 12 bits is for
+ DPI, the next 12 bits is for AVGWIDTH, the highest 3 bits is for
SPACING. In each bit field, the highest bit indicates that the
corresponding value is set or not. This way, we can represent
DPI by 11-bit (0 to 2047), AVGWIDTH by 11-bit (0 to 2047),
@@ -176,7 +176,7 @@ enum font_property_index
FONT_NAME_INDEX = FONT_ENTITY_MAX,
/* Full name of the font (string). It is the name extracted from
- the opend font, and may be different from the above. It may be
+ the opened font, and may be different from the above. It may be
nil if the opened font doesn't give a name. */
FONT_FULLNAME_INDEX,
@@ -300,7 +300,7 @@ struct font
int space_width;
/* Average width of glyphs in the font. If the font itself doesn't
- have that information but has glyphs of ASCII character, the
+ have that information but has glyphs of ASCII characters, the
value is the average with of those glyphs. Otherwise, the value
is 0. */
int average_width;
@@ -321,7 +321,7 @@ struct font
int underline_position;
/* 1 if `vertical-centering-font-regexp' matches this font name.
- In this case, we render characters at vartical center positions
+ In this case, we render characters at vertical center positions
of lines. */
int vertical_centering;
@@ -335,27 +335,27 @@ struct font
unsigned char encoding_type;
/* The baseline position of a font is normally `ascent' value of the
- font. However, there exists many fonts which don't set `ascent'
+ font. However, there exist many fonts which don't set `ascent' to
an appropriate value to be used as baseline position. This is
typical in such ASCII fonts which are designed to be used with
Chinese, Japanese, Korean characters. When we use mixture of
such fonts and normal fonts (having correct `ascent' value), a
display line gets very ugly. Since we have no way to fix it
- automatically, it is users responsibility to supply well designed
+ automatically, it is user's responsibility to supply well designed
fonts or correct `ascent' value of fonts. But, the latter
requires heavy work (modifying all bitmap data in BDF files).
So, Emacs accepts a private font property
`_MULE_BASELINE_OFFSET'. If a font has this property, we
calculate the baseline position by subtracting the value from
- `ascent'. In other words, the value indicates how many bits
- higher we should draw a character of the font than normal ASCII
- text for a better looking.
+ `ascent'. In other words, the value indicates how many pixels
+ higher than normal ASCII text we should draw a character of the
+ font for better appearance.
We also have to consider the fact that the concept of `baseline'
differs among scripts to which each character belongs. For
- instance, baseline should be at the bottom most position of all
+ instance, baseline should be at the bottom-most position of all
glyphs for Chinese, Japanese, and Korean. But, many of existing
- fonts for those characters doesn't have correct `ascent' values
+ fonts for those characters don't have correct `ascent' values
because they are designed to be used with ASCII fonts. To
display characters of different language on the same line, the
best way will be to arrange them in the middle of the line. So,
@@ -365,20 +365,20 @@ struct font
of a line. */
int baseline_offset;
- /* Non zero means a character should be composed at a position
+ /* Non-zero means a character should be composed at a position
relative to the height (or depth) of previous glyphs in the
following cases:
(1) The bottom of the character is higher than this value. In
this case, the character is drawn above the previous glyphs.
(2) The top of the character is lower than 0 (i.e. baseline
- height). In this case, the character is drawn beneath the
+ height). In this case, the character is drawn below the
previous glyphs.
This value is taken from a private font property
`_MULE_RELATIVE_COMPOSE' which is introduced by Emacs. */
int relative_compose;
- /* Non zero means an ascent value to be used for a character
+ /* Non-zero means an ascent value to be used for a character
registered in char-table `use-default-ascent'. */
int default_ascent;
@@ -398,8 +398,8 @@ struct font
determine it. */
int repertory_charset;
- /* There will be more to this structure, but they are private to a
- font-driver. */
+ /* There are more members in this structure, but they are private
+ to the font-driver. */
};
enum font_spacing
@@ -484,8 +484,8 @@ struct font_bitmap
#define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
/* Return a point size corresponding to POINT size (integer)
- on resolution DPI. Note that though point size is a double, we expect
- it to be rounded to an int, so we add 0.5 here. If the desired value
+ on resolution DPI. Note that though point size is a double, we expect
+ it to be rounded to an int, so we add 0.5 here. If the desired value
is tenths of points (as in xfld specs), then the pixel size should
be multiplied BEFORE the conversion to avoid magnifying the error. */
#define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH / (DPI) + 0.5)
@@ -582,7 +582,7 @@ struct font_driver
If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
unsigned (*encode_char) (struct font *font, int c);
- /* Computate the total metrics of the NGLYPHS glyphs specified by
+ /* Compute the total metrics of the NGLYPHS glyphs specified by
the font FONT and the sequence of glyph codes CODE, and store the
result in METRICS. */
int (*text_extents) (struct font *font,
@@ -635,7 +635,7 @@ struct font_driver
FEATURES specifies which OTF features to apply in this format:
(SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
- See the documentation of `font-drive-otf' for the detail.
+ See the documentation of `font-drive-otf' for the details.
This method applies the specified features to the codes in the
elements of GSTRING-IN (between FROMth and TOth). The output
@@ -710,7 +710,7 @@ struct font_driver
struct font_driver_list
{
- /* 1 iff this driver is currently used. It is igonred in the global
+ /* 1 iff this driver is currently used. It is ignored in the global
font driver list.*/
int on;
/* Pointer to the font driver. */
@@ -777,7 +777,8 @@ 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_intern_prop (const char *str, int len, int force_symbol);
+extern Lisp_Object font_intern_prop (const char *str, ptrdiff_t len,
+ int force_symbol);
extern void font_update_sort_order (int *order);
extern void font_parse_family_registry (Lisp_Object family,
diff --git a/src/fontset.c b/src/fontset.c
index a40a3dd5f9c..3091f43d6e9 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -58,8 +58,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef xassert
#ifdef FONTSET_DEBUG
#define xassert(X) do {if (!(X)) abort ();} while (0)
-#undef INLINE
-#define INLINE
#else /* not FONTSET_DEBUG */
#define xassert(X) (void) 0
#endif /* not FONTSET_DEBUG */
@@ -1853,7 +1851,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
pos + 100, 0, -1);
}
- if (! CHAR_VALID_P (c, 0))
+ if (! CHAR_VALID_P (c))
return Qnil;
face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
face = FACE_FROM_ID (f, face_id);
@@ -1861,17 +1859,11 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
{
unsigned code = face->font->driver->encode_char (face->font, c);
Lisp_Object font_object;
- /* Assignment to EMACS_INT stops GCC whining about limited range
- of data type. */
- EMACS_INT cod = code;
if (code == FONT_INVALID_CODE)
return Qnil;
XSETFONT (font_object, face->font);
- if (cod <= MOST_POSITIVE_FIXNUM)
- return Fcons (font_object, make_number (code));
- return Fcons (font_object, Fcons (make_number (code >> 16),
- make_number (code & 0xFFFF)));
+ return Fcons (font_object, INTEGER_TO_CONS (code));
}
return Qnil;
}
diff --git a/src/frame.c b/src/frame.c
index b106c568e48..635996ca424 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -135,11 +135,6 @@ set_menu_bar_lines_1 (Lisp_Object window, int n)
XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
- if (INTEGERP (w->orig_top_line))
- XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
- if (INTEGERP (w->orig_total_lines))
- XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
-
/* Handle just the top child in a vertical split. */
if (!NILP (w->vchild))
set_menu_bar_lines_1 (w->vchild, n);
@@ -375,7 +370,7 @@ make_frame (int mini_p)
/* If buf is a 'hidden' buffer (i.e. one whose name starts with
a space), try to find another one. */
if (SREF (Fbuffer_name (buf), 0) == ' ')
- buf = Fother_buffer (buf, Qnil, Qnil);
+ buf = other_buffer_safely (buf);
/* Use set_window_buffer, not Fset_window_buffer, and don't let
hooks be run by it. The reason is that the whole frame/window
@@ -544,10 +539,8 @@ make_initial_frame (void)
/* The default value of menu-bar-mode is t. */
set_menu_bar_lines (f, make_number (1), Qnil);
-#ifdef CANNOT_DUMP
if (!noninteractive)
init_frame_faces (f);
-#endif
return f;
}
@@ -906,111 +899,6 @@ DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0,
return selected_frame;
}
-DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
- doc: /* Return the frame object that window WINDOW is on. */)
- (Lisp_Object window)
-{
- CHECK_LIVE_WINDOW (window);
- return XWINDOW (window)->frame;
-}
-
-DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
- doc: /* Returns the topmost, leftmost window of FRAME.
-If omitted, FRAME defaults to the currently selected frame. */)
- (Lisp_Object frame)
-{
- Lisp_Object w;
-
- if (NILP (frame))
- w = SELECTED_FRAME ()->root_window;
- else
- {
- CHECK_LIVE_FRAME (frame);
- w = XFRAME (frame)->root_window;
- }
- while (NILP (XWINDOW (w)->buffer))
- {
- if (! NILP (XWINDOW (w)->hchild))
- w = XWINDOW (w)->hchild;
- else if (! NILP (XWINDOW (w)->vchild))
- w = XWINDOW (w)->vchild;
- else
- abort ();
- }
- return w;
-}
-
-DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
- Sactive_minibuffer_window, 0, 0, 0,
- doc: /* Return the currently active minibuffer window, or nil if none. */)
- (void)
-{
- return minibuf_level ? minibuf_window : Qnil;
-}
-
-DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
- doc: /* Returns the root-window of FRAME.
-If omitted, FRAME defaults to the currently selected frame. */)
- (Lisp_Object frame)
-{
- Lisp_Object window;
-
- if (NILP (frame))
- window = SELECTED_FRAME ()->root_window;
- else
- {
- CHECK_LIVE_FRAME (frame);
- window = XFRAME (frame)->root_window;
- }
-
- return window;
-}
-
-DEFUN ("frame-selected-window", Fframe_selected_window,
- Sframe_selected_window, 0, 1, 0,
- doc: /* Return the selected window of FRAME.
-FRAME defaults to the currently selected frame. */)
- (Lisp_Object frame)
-{
- Lisp_Object window;
-
- if (NILP (frame))
- window = SELECTED_FRAME ()->selected_window;
- else
- {
- CHECK_LIVE_FRAME (frame);
- window = XFRAME (frame)->selected_window;
- }
-
- return window;
-}
-
-DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
- Sset_frame_selected_window, 2, 3, 0,
- doc: /* Set selected window of FRAME to WINDOW.
-If FRAME is nil, use the selected frame. If FRAME is the
-selected frame, this makes WINDOW the selected window.
-Optional argument NORECORD non-nil means to neither change the
-order of recently selected windows nor the buffer list.
-Return WINDOW. */)
- (Lisp_Object frame, Lisp_Object window, Lisp_Object norecord)
-{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
- CHECK_LIVE_WINDOW (window);
-
- if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
- error ("In `set-frame-selected-window', WINDOW is not on FRAME");
-
- if (EQ (frame, selected_frame))
- return Fselect_window (window, norecord);
-
- return XFRAME (frame)->selected_window = window;
-}
-
-
DEFUN ("frame-list", Fframe_list, Sframe_list,
0, 0, 0,
doc: /* Return a list of all live frames. */)
@@ -1227,7 +1115,7 @@ Otherwise, include all frames. */)
0 if all frames aside from F are invisible.
(Exception: if F is the terminal frame, and we are using X, return 1.) */
-int
+static int
other_visible_frames (FRAME_PTR f)
{
/* We know the selected frame is visible,
@@ -1267,6 +1155,17 @@ other_visible_frames (FRAME_PTR f)
return 1;
}
+DEFUN ("other-visible-frames-p", Fother_visible_frames_p, Sother_visible_frames_p, 0, 1, 0,
+ doc: /* Return t if there are other visible frames beside FRAME.
+FRAME defaults to the selected frame. */)
+ (Lisp_Object frame)
+{
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ return other_visible_frames (XFRAME (frame)) ? Qt : Qnil;
+}
+
/* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
unconditionally. x_connection_closed and delete_terminal use
this. Any other value of FORCE implements the semantics
@@ -1347,7 +1246,14 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
= Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
pending_funcalls);
else
- safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
+ {
+#ifdef HAVE_X_WINDOWS
+ /* Also, save clipboard to the the clipboard manager. */
+ x_clipboard_manager_save_frame (frame);
+#endif
+
+ safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
+ }
/* The hook may sometimes (indirectly) cause the frame to be deleted. */
if (! FRAME_LIVE_P (f))
@@ -1425,7 +1331,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_subwindows (XWINDOW (f->root_window));
+ delete_all_subwindows (f->root_window);
f->root_window = Qnil;
Vframe_list = Fdelq (frame, Vframe_list);
@@ -1631,7 +1537,7 @@ and returns whatever that function returns. */)
enum scroll_bar_part party_dummy;
Lisp_Object x, y, retval;
int col, row;
- unsigned long long_dummy;
+ Time long_dummy;
struct gcpro gcpro1;
f = SELECTED_FRAME ();
@@ -1676,7 +1582,7 @@ and nil for X and Y. */)
Lisp_Object lispy_dummy;
enum scroll_bar_part party_dummy;
Lisp_Object x, y;
- unsigned long long_dummy;
+ Time long_dummy;
f = SELECTED_FRAME ();
x = y = Qnil;
@@ -2106,20 +2012,12 @@ frame_buffer_predicate (Lisp_Object frame)
/* Return the buffer-list of the selected frame. */
-Lisp_Object
+static Lisp_Object
frame_buffer_list (Lisp_Object frame)
{
return XFRAME (frame)->buffer_list;
}
-/* Set the buffer-list of the selected frame. */
-
-void
-set_frame_buffer_list (Lisp_Object frame, Lisp_Object list)
-{
- XFRAME (frame)->buffer_list = list;
-}
-
/* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
void
@@ -2909,7 +2807,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
/* Record in these vectors all the parms specified. */
Lisp_Object *parms;
Lisp_Object *values;
- size_t i, p;
+ ptrdiff_t i, p;
int left_no_change = 0, top_no_change = 0;
int icon_left_no_change = 0, icon_top_no_change = 0;
int size_changed = 0;
@@ -4342,104 +4240,58 @@ selected frame. This is useful when `make-pointer-invisible' is set. */)
void
syms_of_frame (void)
{
- Qframep = intern_c_string ("framep");
- staticpro (&Qframep);
- Qframe_live_p = intern_c_string ("frame-live-p");
- staticpro (&Qframe_live_p);
- Qexplicit_name = intern_c_string ("explicit-name");
- staticpro (&Qexplicit_name);
- Qheight = intern_c_string ("height");
- staticpro (&Qheight);
- Qicon = intern_c_string ("icon");
- staticpro (&Qicon);
- Qminibuffer = intern_c_string ("minibuffer");
- staticpro (&Qminibuffer);
- Qmodeline = intern_c_string ("modeline");
- staticpro (&Qmodeline);
- Qonly = intern_c_string ("only");
- staticpro (&Qonly);
- Qwidth = intern_c_string ("width");
- staticpro (&Qwidth);
- Qgeometry = intern_c_string ("geometry");
- staticpro (&Qgeometry);
- Qicon_left = intern_c_string ("icon-left");
- staticpro (&Qicon_left);
- Qicon_top = intern_c_string ("icon-top");
- staticpro (&Qicon_top);
- Qtooltip = intern_c_string ("tooltip");
- staticpro (&Qtooltip);
- Qleft = intern_c_string ("left");
- staticpro (&Qleft);
- Qright = intern_c_string ("right");
- staticpro (&Qright);
- Quser_position = intern_c_string ("user-position");
- staticpro (&Quser_position);
- Quser_size = intern_c_string ("user-size");
- staticpro (&Quser_size);
- Qwindow_id = intern_c_string ("window-id");
- staticpro (&Qwindow_id);
+ DEFSYM (Qframep, "framep");
+ DEFSYM (Qframe_live_p, "frame-live-p");
+ DEFSYM (Qexplicit_name, "explicit-name");
+ DEFSYM (Qheight, "height");
+ DEFSYM (Qicon, "icon");
+ DEFSYM (Qminibuffer, "minibuffer");
+ DEFSYM (Qmodeline, "modeline");
+ DEFSYM (Qonly, "only");
+ DEFSYM (Qwidth, "width");
+ DEFSYM (Qgeometry, "geometry");
+ DEFSYM (Qicon_left, "icon-left");
+ DEFSYM (Qicon_top, "icon-top");
+ DEFSYM (Qtooltip, "tooltip");
+ DEFSYM (Qleft, "left");
+ DEFSYM (Qright, "right");
+ DEFSYM (Quser_position, "user-position");
+ DEFSYM (Quser_size, "user-size");
+ DEFSYM (Qwindow_id, "window-id");
#ifdef HAVE_X_WINDOWS
- Qouter_window_id = intern_c_string ("outer-window-id");
- staticpro (&Qouter_window_id);
+ DEFSYM (Qouter_window_id, "outer-window-id");
#endif
- Qparent_id = intern_c_string ("parent-id");
- staticpro (&Qparent_id);
- Qx = intern_c_string ("x");
- staticpro (&Qx);
- Qw32 = intern_c_string ("w32");
- staticpro (&Qw32);
- Qpc = intern_c_string ("pc");
- staticpro (&Qpc);
- Qmac = intern_c_string ("mac");
- staticpro (&Qmac);
- Qns = intern_c_string ("ns");
- staticpro (&Qns);
- Qvisible = intern_c_string ("visible");
- staticpro (&Qvisible);
- Qbuffer_predicate = intern_c_string ("buffer-predicate");
- staticpro (&Qbuffer_predicate);
- Qbuffer_list = intern_c_string ("buffer-list");
- staticpro (&Qbuffer_list);
- Qburied_buffer_list = intern_c_string ("buried-buffer-list");
- staticpro (&Qburied_buffer_list);
- Qdisplay_type = intern_c_string ("display-type");
- staticpro (&Qdisplay_type);
- Qbackground_mode = intern_c_string ("background-mode");
- staticpro (&Qbackground_mode);
- Qnoelisp = intern_c_string ("noelisp");
- staticpro (&Qnoelisp);
- Qtty_color_mode = intern_c_string ("tty-color-mode");
- staticpro (&Qtty_color_mode);
- Qtty = intern_c_string ("tty");
- staticpro (&Qtty);
- Qtty_type = intern_c_string ("tty-type");
- staticpro (&Qtty_type);
-
- Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default");
- staticpro (&Qface_set_after_frame_default);
-
- Qfullwidth = intern_c_string ("fullwidth");
- staticpro (&Qfullwidth);
- Qfullheight = intern_c_string ("fullheight");
- staticpro (&Qfullheight);
- Qfullboth = intern_c_string ("fullboth");
- staticpro (&Qfullboth);
- Qmaximized = intern_c_string ("maximized");
- staticpro (&Qmaximized);
- Qx_resource_name = intern_c_string ("x-resource-name");
- staticpro (&Qx_resource_name);
-
- Qx_frame_parameter = intern_c_string ("x-frame-parameter");
- staticpro (&Qx_frame_parameter);
-
- Qterminal = intern_c_string ("terminal");
- staticpro (&Qterminal);
- Qterminal_live_p = intern_c_string ("terminal-live-p");
- staticpro (&Qterminal_live_p);
+ DEFSYM (Qparent_id, "parent-id");
+ DEFSYM (Qx, "x");
+ DEFSYM (Qw32, "w32");
+ DEFSYM (Qpc, "pc");
+ DEFSYM (Qmac, "mac");
+ DEFSYM (Qns, "ns");
+ DEFSYM (Qvisible, "visible");
+ DEFSYM (Qbuffer_predicate, "buffer-predicate");
+ DEFSYM (Qbuffer_list, "buffer-list");
+ DEFSYM (Qburied_buffer_list, "buried-buffer-list");
+ DEFSYM (Qdisplay_type, "display-type");
+ DEFSYM (Qbackground_mode, "background-mode");
+ DEFSYM (Qnoelisp, "noelisp");
+ DEFSYM (Qtty_color_mode, "tty-color-mode");
+ DEFSYM (Qtty, "tty");
+ DEFSYM (Qtty_type, "tty-type");
+
+ DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default");
+
+ DEFSYM (Qfullwidth, "fullwidth");
+ DEFSYM (Qfullheight, "fullheight");
+ DEFSYM (Qfullboth, "fullboth");
+ DEFSYM (Qmaximized, "maximized");
+ DEFSYM (Qx_resource_name, "x-resource-name");
+ DEFSYM (Qx_frame_parameter, "x-frame-parameter");
+
+ DEFSYM (Qterminal, "terminal");
+ DEFSYM (Qterminal_live_p, "terminal-live-p");
#ifdef HAVE_NS
- Qns_parse_geometry = intern_c_string ("ns-parse-geometry");
- staticpro (&Qns_parse_geometry);
+ DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
#endif
{
@@ -4553,8 +4405,7 @@ actually deleted, or some time later (or even both when an earlier function
in `delete-frame-functions' (indirectly) calls `delete-frame'
recursively). */);
Vdelete_frame_functions = Qnil;
- Qdelete_frame_functions = intern_c_string ("delete-frame-functions");
- staticpro (&Qdelete_frame_functions);
+ DEFSYM (Qdelete_frame_functions, "delete-frame-functions");
DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode,
doc: /* Non-nil if Menu-Bar mode is enabled.
@@ -4600,7 +4451,6 @@ automatically. See also `mouse-autoselect-window'. */);
staticpro (&Vframe_list);
- defsubr (&Sactive_minibuffer_window);
defsubr (&Sframep);
defsubr (&Sframe_live_p);
defsubr (&Swindow_system);
@@ -4608,14 +4458,10 @@ automatically. See also `mouse-autoselect-window'. */);
defsubr (&Shandle_switch_frame);
defsubr (&Sselect_frame);
defsubr (&Sselected_frame);
- defsubr (&Swindow_frame);
- defsubr (&Sframe_root_window);
- defsubr (&Sframe_first_window);
- defsubr (&Sframe_selected_window);
- defsubr (&Sset_frame_selected_window);
defsubr (&Sframe_list);
defsubr (&Snext_frame);
defsubr (&Sprevious_frame);
+ defsubr (&Sother_visible_frames_p);
defsubr (&Sdelete_frame);
defsubr (&Smouse_position);
defsubr (&Smouse_pixel_position);
diff --git a/src/frame.h b/src/frame.h
index e73370340f1..8dccfb8540a 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -192,7 +192,7 @@ struct frame
struct face_cache *face_cache;
/* Number of elements in `menu_bar_vector' that have meaningful data. */
- EMACS_INT menu_bar_items_used;
+ int menu_bar_items_used;
/* A buffer to hold the frame's name. We can't use the Lisp
string's pointer (`name', above) because it might get relocated. */
@@ -844,7 +844,6 @@ extern struct frame *make_frame_without_minibuffer (Lisp_Object,
struct kboard *,
Lisp_Object);
#endif /* HAVE_WINDOW_SYSTEM */
-extern int other_visible_frames (struct frame *);
extern void frame_make_pointer_invisible (void);
extern void frame_make_pointer_visible (void);
extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object);
diff --git a/src/fringe.c b/src/fringe.c
index f2d61225be7..a4dc9433aff 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -521,6 +521,20 @@ get_fringe_bitmap_name (int bn)
return num;
}
+/* Get fringe bitmap data for bitmap number BN. */
+
+static struct fringe_bitmap *
+get_fringe_bitmap_data (int bn)
+{
+ struct fringe_bitmap *fb;
+
+ fb = fringe_bitmaps[bn];
+ if (fb == NULL)
+ fb = &standard_bitmaps[bn < MAX_STANDARD_FRINGE_BITMAPS
+ ? bn : UNDEF_FRINGE_BITMAP];
+
+ return fb;
+}
/* Draw the bitmap WHICH in one of the left or right fringes of
window W. ROW is the glyph row for which to display the bitmap; it
@@ -568,10 +582,7 @@ draw_fringe_bitmap_1 (struct window *w, struct glyph_row *row, int left_p, int o
face_id = FRINGE_FACE_ID;
}
- fb = fringe_bitmaps[which];
- if (fb == NULL)
- fb = &standard_bitmaps[which < MAX_STANDARD_FRINGE_BITMAPS
- ? which : UNDEF_FRINGE_BITMAP];
+ fb = get_fringe_bitmap_data (which);
period = fb->period;
@@ -1041,12 +1052,8 @@ update_window_fringes (struct window *w, int keep_current_p)
if (bn != NO_FRINGE_BITMAP)
{
- struct fringe_bitmap *fb;
+ struct fringe_bitmap *fb = get_fringe_bitmap_data (bn);
- fb = fringe_bitmaps[bn];
- if (fb == NULL)
- fb = &standard_bitmaps[bn < MAX_STANDARD_FRINGE_BITMAPS
- ? bn : UNDEF_FRINGE_BITMAP];
if (fb->align == ALIGN_BITMAP_TOP && fb->period == 0)
{
struct glyph_row *row1;
@@ -1100,12 +1107,8 @@ update_window_fringes (struct window *w, int keep_current_p)
if (bn != NO_FRINGE_BITMAP)
{
- struct fringe_bitmap *fb;
+ struct fringe_bitmap *fb = get_fringe_bitmap_data (bn);
- fb = fringe_bitmaps[bn];
- if (fb == NULL)
- fb = &standard_bitmaps[bn < MAX_STANDARD_FRINGE_BITMAPS
- ? bn : UNDEF_FRINGE_BITMAP];
if (fb->align == ALIGN_BITMAP_BOTTOM && fb->period == 0)
{
struct glyph_row *row1;
@@ -1141,6 +1144,7 @@ update_window_fringes (struct window *w, int keep_current_p)
int left, right;
unsigned left_face_id, right_face_id;
int left_offset, right_offset;
+ int periodic_p;
row = w->desired_matrix->rows + rn;
cur = w->current_matrix->rows + rn;
@@ -1149,6 +1153,7 @@ update_window_fringes (struct window *w, int keep_current_p)
left_face_id = right_face_id = DEFAULT_FACE_ID;
left_offset = right_offset = 0;
+ periodic_p = 0;
/* Decide which bitmap to draw in the left fringe. */
if (WINDOW_LEFT_FRINGE_WIDTH (w) == 0)
@@ -1240,6 +1245,9 @@ update_window_fringes (struct window *w, int keep_current_p)
else
right = NO_FRINGE_BITMAP;
+ periodic_p = (get_fringe_bitmap_data (left)->period != 0
+ || get_fringe_bitmap_data (right)->period != 0);
+
if (row->y != cur->y
|| row->visible_height != cur->visible_height
|| row->ends_at_zv_p != cur->ends_at_zv_p
@@ -1249,6 +1257,7 @@ update_window_fringes (struct window *w, int keep_current_p)
|| right_face_id != cur->right_fringe_face_id
|| left_offset != cur->left_fringe_offset
|| right_offset != cur->right_fringe_offset
+ || periodic_p != cur->fringe_bitmap_periodic_p
|| cur->redraw_fringe_bitmaps_p)
{
redraw_p = row->redraw_fringe_bitmaps_p = 1;
@@ -1261,6 +1270,7 @@ update_window_fringes (struct window *w, int keep_current_p)
cur->right_fringe_face_id = right_face_id;
cur->left_fringe_offset = left_offset;
cur->right_fringe_offset = right_offset;
+ cur->fringe_bitmap_periodic_p = periodic_p;
}
}
@@ -1269,8 +1279,12 @@ update_window_fringes (struct window *w, int keep_current_p)
if (row->overlay_arrow_bitmap != cur->overlay_arrow_bitmap)
{
- redraw_p = row->redraw_fringe_bitmaps_p = cur->redraw_fringe_bitmaps_p = 1;
- cur->overlay_arrow_bitmap = row->overlay_arrow_bitmap;
+ redraw_p = row->redraw_fringe_bitmaps_p = 1;
+ if (!keep_current_p)
+ {
+ cur->redraw_fringe_bitmaps_p = 1;
+ cur->overlay_arrow_bitmap = row->overlay_arrow_bitmap;
+ }
}
row->left_fringe_bitmap = left;
@@ -1279,6 +1293,7 @@ update_window_fringes (struct window *w, int keep_current_p)
row->right_fringe_face_id = right_face_id;
row->left_fringe_offset = left_offset;
row->right_fringe_offset = right_offset;
+ row->fringe_bitmap_periodic_p = periodic_p;
}
return redraw_p && !keep_current_p;
@@ -1723,18 +1738,12 @@ Return nil if POS is not visible in WINDOW. */)
void
syms_of_fringe (void)
{
- Qtruncation = intern_c_string ("truncation");
- staticpro (&Qtruncation);
- Qcontinuation = intern_c_string ("continuation");
- staticpro (&Qcontinuation);
- Qoverlay_arrow = intern_c_string ("overlay-arrow");
- staticpro (&Qoverlay_arrow);
- Qempty_line = intern_c_string ("empty-line");
- staticpro (&Qempty_line);
- Qtop_bottom = intern_c_string ("top-bottom");
- staticpro (&Qtop_bottom);
- Qhollow_small = intern_c_string ("hollow-small");
- staticpro (&Qhollow_small);
+ DEFSYM (Qtruncation, "truncation");
+ DEFSYM (Qcontinuation, "continuation");
+ DEFSYM (Qoverlay_arrow, "overlay-arrow");
+ DEFSYM (Qempty_line, "empty-line");
+ DEFSYM (Qtop_bottom, "top-bottom");
+ DEFSYM (Qhollow_small, "hollow-small");
defsubr (&Sdestroy_fringe_bitmap);
defsubr (&Sdefine_fringe_bitmap);
diff --git a/src/ftfont.c b/src/ftfont.c
index 47425e853da..4e313a89021 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -815,7 +815,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots
goto err;
for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars))
if (CHARACTERP (XCAR (chars))
- && ! FcCharSetAddChar (charset, XUINT (XCAR (chars))))
+ && ! FcCharSetAddChar (charset, XFASTINT (XCAR (chars))))
goto err;
}
}
@@ -1612,7 +1612,6 @@ ftfont_get_metrics (MFLTFont *font, MFLTGlyphString *gstring,
if (g->code != FONT_INVALID_CODE)
{
FT_Glyph_Metrics *m;
- int lbearing, rbearing, ascent, descent, xadv;
if (FT_Load_Glyph (ft_face, g->code, FT_LOAD_DEFAULT) != 0)
abort ();
@@ -1867,7 +1866,6 @@ ftfont_drive_otf (MFLTFont *font,
{
MFLTGlyph *g;
int min_from, max_to;
- int j;
int feature_idx = otfg->positioning_type >> 4;
g = out->glyphs + out->used;
@@ -2387,8 +2385,8 @@ static Lisp_Object
ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
FT_Face ft_face, OTF *otf, FT_Matrix *matrix)
{
- EMACS_UINT len = LGSTRING_GLYPH_LEN (lgstring);
- EMACS_UINT i;
+ EMACS_INT len = LGSTRING_GLYPH_LEN (lgstring);
+ EMACS_INT i;
struct MFLTFontFT flt_font_ft;
MFLT *flt = NULL;
int with_variation_selector = 0;
@@ -2414,7 +2412,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
if (CHAR_VARIATION_SELECTOR_P (c))
with_variation_selector++;
}
+
len = i;
+ lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
+
if (with_variation_selector)
{
setup_otf_gstring (len);
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 5237432872d..a023d2d78e5 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -552,12 +552,8 @@ 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 void register_heapinfo PP ((void));
-#ifdef __GNUC__
-__inline__
-#endif
-static void
-register_heapinfo ()
+static inline void
+register_heapinfo (void)
{
__malloc_size_t block, blocks;
@@ -2170,4 +2166,3 @@ mprobe (__ptr_t ptr)
}
#endif /* GC_MCHECK */
-
diff --git a/src/gnutls.c b/src/gnutls.c
index 540bfaac25c..3761951b866 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -51,7 +51,6 @@ static Lisp_Object Qgnutls_bootprop_callbacks;
static Lisp_Object Qgnutls_bootprop_loglevel;
static Lisp_Object Qgnutls_bootprop_hostname;
static Lisp_Object Qgnutls_bootprop_verify_flags;
-static Lisp_Object Qgnutls_bootprop_verify_error;
static Lisp_Object Qgnutls_bootprop_verify_hostname_error;
/* Callback keys for `gnutls-boot'. Unused currently. */
@@ -110,6 +109,10 @@ DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
DEF_GNUTLS_FN (int, gnutls_global_init, (void));
DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
+DEF_GNUTLS_FN (void, gnutls_global_set_mem_functions,
+ (gnutls_alloc_function, gnutls_alloc_function,
+ gnutls_is_secure_function, gnutls_realloc_function,
+ gnutls_free_function));
DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
@@ -140,10 +143,12 @@ static int
init_gnutls_functions (Lisp_Object libraries)
{
HMODULE library;
+ Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+ int max_log_level = 1;
if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
{
- GNUTLS_LOG (1, 1, "GnuTLS library not found");
+ GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
}
@@ -168,6 +173,7 @@ init_gnutls_functions (Lisp_Object libraries)
LOAD_GNUTLS_FN (library, gnutls_global_init);
LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
+ LOAD_GNUTLS_FN (library, gnutls_global_set_mem_functions);
LOAD_GNUTLS_FN (library, gnutls_handshake);
LOAD_GNUTLS_FN (library, gnutls_init);
LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
@@ -185,7 +191,10 @@ init_gnutls_functions (Lisp_Object libraries)
LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
- GNUTLS_LOG2 (1, 1, "GnuTLS library loaded:",
+ if (NUMBERP (gnutls_log_level))
+ max_log_level = XINT (gnutls_log_level);
+
+ GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
SDATA (Fget (Qgnutls_dll, QCloaded_from)));
return 1;
}
@@ -213,6 +222,7 @@ init_gnutls_functions (Lisp_Object libraries)
#define fn_gnutls_global_init gnutls_global_init
#define fn_gnutls_global_set_log_function gnutls_global_set_log_function
#define fn_gnutls_global_set_log_level gnutls_global_set_log_level
+#define fn_gnutls_global_set_mem_functions gnutls_global_set_mem_functions
#define fn_gnutls_handshake gnutls_handshake
#define fn_gnutls_init gnutls_init
#define fn_gnutls_priority_set_direct gnutls_priority_set_direct
@@ -221,10 +231,7 @@ init_gnutls_functions (Lisp_Object libraries)
#define fn_gnutls_record_send gnutls_record_send
#define fn_gnutls_strerror gnutls_strerror
#define fn_gnutls_transport_set_errno gnutls_transport_set_errno
-#define fn_gnutls_transport_set_lowat gnutls_transport_set_lowat
#define fn_gnutls_transport_set_ptr2 gnutls_transport_set_ptr2
-#define fn_gnutls_transport_set_pull_function gnutls_transport_set_pull_function
-#define fn_gnutls_transport_set_push_function gnutls_transport_set_push_function
#define fn_gnutls_x509_crt_check_hostname gnutls_x509_crt_check_hostname
#define fn_gnutls_x509_crt_deinit gnutls_x509_crt_deinit
#define fn_gnutls_x509_crt_import gnutls_x509_crt_import
@@ -377,7 +384,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
/* non-fatal error */
return -1;
else {
- /* a fatal error occured */
+ /* a fatal error occurred */
return 0;
}
}
@@ -585,7 +592,11 @@ emacs_gnutls_global_init (void)
int ret = GNUTLS_E_SUCCESS;
if (!gnutls_global_initialized)
- ret = fn_gnutls_global_init ();
+ {
+ fn_gnutls_global_set_mem_functions (xmalloc, xmalloc, NULL,
+ xrealloc, xfree);
+ ret = fn_gnutls_global_init ();
+ }
gnutls_global_initialized = 1;
return gnutls_make_error (ret);
@@ -632,9 +643,6 @@ certificates for `gnutls-x509pki'.
:verify-flags is a bitset as per GnuTLS'
gnutls_certificate_set_verify_flags.
-:verify-error, if non-nil, makes failure of the certificate validation
-an error. Otherwise it will be just a series of warnings.
-
:verify-hostname-error, if non-nil, makes a hostname mismatch an
error. Otherwise it will be just a warning.
@@ -771,8 +779,7 @@ one trustfile (usually a CA bundle). */)
{
GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
x509_cred = XPROCESS (proc)->gnutls_x509_cred;
- if (fn_gnutls_certificate_allocate_credentials (&x509_cred) < 0)
- memory_full ();
+ fn_gnutls_certificate_allocate_credentials (&x509_cred);
if (NUMBERP (verify_flags))
{
@@ -795,8 +802,7 @@ one trustfile (usually a CA bundle). */)
{
GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
anon_cred = XPROCESS (proc)->gnutls_anon_cred;
- if (fn_gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
- memory_full ();
+ fn_gnutls_anon_allocate_client_credentials (&anon_cred);
}
else
{
@@ -1096,72 +1102,35 @@ syms_of_gnutls (void)
{
gnutls_global_initialized = 0;
- Qgnutls_dll = intern_c_string ("gnutls");
- staticpro (&Qgnutls_dll);
-
- Qgnutls_log_level = intern_c_string ("gnutls-log-level");
- staticpro (&Qgnutls_log_level);
-
- Qgnutls_code = intern_c_string ("gnutls-code");
- staticpro (&Qgnutls_code);
-
- Qgnutls_anon = intern_c_string ("gnutls-anon");
- staticpro (&Qgnutls_anon);
-
- Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
- staticpro (&Qgnutls_x509pki);
-
- Qgnutls_bootprop_hostname = intern_c_string (":hostname");
- staticpro (&Qgnutls_bootprop_hostname);
-
- Qgnutls_bootprop_priority = intern_c_string (":priority");
- staticpro (&Qgnutls_bootprop_priority);
-
- Qgnutls_bootprop_trustfiles = intern_c_string (":trustfiles");
- staticpro (&Qgnutls_bootprop_trustfiles);
-
- Qgnutls_bootprop_keylist = intern_c_string (":keylist");
- staticpro (&Qgnutls_bootprop_keylist);
-
- Qgnutls_bootprop_crlfiles = intern_c_string (":crlfiles");
- staticpro (&Qgnutls_bootprop_crlfiles);
-
- Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
- staticpro (&Qgnutls_bootprop_callbacks);
-
- Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
- staticpro (&Qgnutls_bootprop_callbacks_verify);
-
- Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
- staticpro (&Qgnutls_bootprop_loglevel);
-
- Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
- staticpro (&Qgnutls_bootprop_verify_flags);
-
- Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
- staticpro (&Qgnutls_bootprop_verify_error);
-
- Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
- staticpro (&Qgnutls_bootprop_verify_hostname_error);
-
- Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
- staticpro (&Qgnutls_e_interrupted);
+ DEFSYM (Qgnutls_dll, "gnutls");
+ DEFSYM (Qgnutls_log_level, "gnutls-log-level");
+ DEFSYM (Qgnutls_code, "gnutls-code");
+ DEFSYM (Qgnutls_anon, "gnutls-anon");
+ DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
+ DEFSYM (Qgnutls_bootprop_hostname, ":hostname");
+ DEFSYM (Qgnutls_bootprop_priority, ":priority");
+ DEFSYM (Qgnutls_bootprop_trustfiles, ":trustfiles");
+ DEFSYM (Qgnutls_bootprop_keylist, ":keylist");
+ DEFSYM (Qgnutls_bootprop_crlfiles, ":crlfiles");
+ DEFSYM (Qgnutls_bootprop_callbacks, ":callbacks");
+ DEFSYM (Qgnutls_bootprop_callbacks_verify, "verify");
+ DEFSYM (Qgnutls_bootprop_loglevel, ":loglevel");
+ DEFSYM (Qgnutls_bootprop_verify_flags, ":verify-flags");
+ DEFSYM (Qgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");
+
+ DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
Fput (Qgnutls_e_interrupted, Qgnutls_code,
make_number (GNUTLS_E_INTERRUPTED));
- Qgnutls_e_again = intern_c_string ("gnutls-e-again");
- staticpro (&Qgnutls_e_again);
+ DEFSYM (Qgnutls_e_again, "gnutls-e-again");
Fput (Qgnutls_e_again, Qgnutls_code,
make_number (GNUTLS_E_AGAIN));
- Qgnutls_e_invalid_session = intern_c_string ("gnutls-e-invalid-session");
- staticpro (&Qgnutls_e_invalid_session);
+ DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
Fput (Qgnutls_e_invalid_session, Qgnutls_code,
make_number (GNUTLS_E_INVALID_SESSION));
- Qgnutls_e_not_ready_for_handshake =
- intern_c_string ("gnutls-e-not-ready-for-handshake");
- staticpro (&Qgnutls_e_not_ready_for_handshake);
+ DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 6e54006d913..35b366222de 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -42,6 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_GTK3
#include <gtk/gtkx.h>
+#include "emacsgtkfixed.h"
#endif
#define FRAME_TOTAL_PIXEL_HEIGHT(f) \
@@ -88,12 +89,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x))
-/* Get the current value of the range, truncated to an integer. */
-static int
-int_gtk_range_get_value (GtkRange *range)
-{
- return gtk_range_get_value (range);
-}
+static void update_theme_scrollbar_width (void);
/***********************************************************************
@@ -637,6 +633,9 @@ qttip_cb (GtkWidget *widget,
struct x_output *x = f->output_data.x;
if (x->ttip_widget == NULL)
{
+ GtkWidget *p;
+ GList *list, *iter;
+
g_object_set (G_OBJECT (widget), "has-tooltip", FALSE, NULL);
x->ttip_widget = tooltip;
g_object_ref (G_OBJECT (tooltip));
@@ -644,6 +643,18 @@ qttip_cb (GtkWidget *widget,
g_object_ref (G_OBJECT (x->ttip_lbl));
gtk_tooltip_set_custom (tooltip, x->ttip_lbl);
x->ttip_window = GTK_WINDOW (gtk_widget_get_toplevel (x->ttip_lbl));
+
+ /* Change stupid Gtk+ default line wrapping. */
+ p = gtk_widget_get_parent (x->ttip_lbl);
+ list = gtk_container_get_children (GTK_CONTAINER (p));
+ for (iter = list; iter; iter = g_list_next (iter))
+ {
+ GtkWidget *w = GTK_WIDGET (iter->data);
+ if (GTK_IS_LABEL (w))
+ gtk_label_set_line_wrap (GTK_LABEL (w), FALSE);
+ }
+ g_list_free (list);
+
/* ATK needs an empty title for some reason. */
gtk_window_set_title (x->ttip_window, "");
/* Realize so we can safely get screen later on. */
@@ -663,8 +674,8 @@ qttip_cb (GtkWidget *widget,
int
xg_prepare_tooltip (FRAME_PTR f,
- Lisp_Object string,
- int *width,
+ Lisp_Object string,
+ int *width,
int *height)
{
#ifndef USE_GTK_TOOLTIP
@@ -701,10 +712,9 @@ xg_prepare_tooltip (FRAME_PTR f,
(gtk_widget_get_display (GTK_WIDGET (x->ttip_window))),
"gdk-display-current-tooltip", NULL);
- /* Put out dummy widget in so we can get callbacks for unrealize and
+ /* Put our dummy widget in so we can get callbacks for unrealize and
hierarchy-changed. */
gtk_tooltip_set_custom (x->ttip_widget, widget);
-
gtk_tooltip_set_text (x->ttip_widget, SSDATA (encoded_string));
gtk_widget_get_preferred_size (GTK_WIDGET (x->ttip_window), NULL, &req);
if (width) *width = req.width;
@@ -735,7 +745,7 @@ xg_show_tooltip (FRAME_PTR f, int root_x, int root_y)
}
/* Hide tooltip if shown. Do nothing if not shown.
- Return non-zero if tip was hidden, non-ero if not (i.e. not using
+ Return non-zero if tip was hidden, non-zero if not (i.e. not using
system tooltips). */
int
@@ -1015,13 +1025,32 @@ style_changed_cb (GObject *go,
struct input_event event;
GdkDisplay *gdpy = (GdkDisplay *) user_data;
const char *display_name = gdk_display_get_name (gdpy);
+ Display *dpy = GDK_DISPLAY_XDISPLAY (gdpy);
EVENT_INIT (event);
event.kind = CONFIG_CHANGED_EVENT;
- event.frame_or_window = make_string (display_name, strlen (display_name));
+ event.frame_or_window = build_string (display_name);
/* Theme doesn't change often, so intern is called seldom. */
event.arg = intern ("theme-name");
kbd_buffer_store_event (&event);
+
+ update_theme_scrollbar_width ();
+
+ /* If scroll bar width changed, we need set the new size on all frames
+ on this display. */
+ if (dpy)
+ {
+ Lisp_Object rest, frame;
+ FOR_EACH_FRAME (rest, frame)
+ {
+ FRAME_PTR f = XFRAME (frame);
+ if (FRAME_X_DISPLAY (f) == dpy)
+ {
+ x_set_scroll_bar_default_width (f);
+ xg_frame_set_char_size (f, FRAME_COLS (f), FRAME_LINES (f));
+ }
+ }
+ }
}
/* Called when a delete-event occurs on WIDGET. */
@@ -1069,7 +1098,12 @@ xg_create_frame_widgets (FRAME_PTR f)
wvbox = gtk_vbox_new (FALSE, 0);
whbox = gtk_hbox_new (FALSE, 0);
- wfixed = gtk_fixed_new (); /* Must have this to place scroll bars */
+
+#ifdef HAVE_GTK3
+ wfixed = emacs_fixed_new (f);
+#else
+ wfixed = gtk_fixed_new ();
+#endif
if (! wtop || ! wvbox || ! whbox || ! wfixed)
{
@@ -1162,6 +1196,7 @@ xg_create_frame_widgets (FRAME_PTR f)
gtk_widget_modify_style (wfixed, style);
#else
gtk_widget_set_can_focus (wfixed, TRUE);
+ gtk_window_set_resizable (GTK_WINDOW (wtop), TRUE);
#endif
#ifdef USE_GTK_TOOLTIP
@@ -1303,7 +1338,7 @@ x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position)
{
BLOCK_INPUT;
gtk_window_set_geometry_hints (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- NULL, &size_hints, hint_flags);
+ NULL, &size_hints, hint_flags);
f->output_data.x->size_hints = size_hints;
f->output_data.x->hint_flags = hint_flags;
UNBLOCK_INPUT;
@@ -3250,6 +3285,10 @@ xg_event_is_for_menubar (FRAME_PTR f, XEvent *event)
int xg_ignore_gtk_scrollbar;
+/* The width of the scroll bar for the current theme. */
+
+static int scroll_bar_width_for_theme;
+
/* Xlib's `Window' fits in 32 bits. But we want to store pointers, and they
may be larger than 32 bits. Keep a mapping from integer index to widget
pointers to get around the 32 bit limitation. */
@@ -3326,6 +3365,34 @@ xg_get_widget_from_map (int idx)
return 0;
}
+static void
+update_theme_scrollbar_width (void)
+{
+#ifdef HAVE_GTK3
+ GtkAdjustment *vadj;
+#else
+ GtkObject *vadj;
+#endif
+ GtkWidget *wscroll;
+ 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));
+ g_object_ref_sink (G_OBJECT (wscroll));
+ gtk_widget_style_get (wscroll, "slider-width", &w, "trough-border", &b, NULL);
+ gtk_widget_destroy (wscroll);
+ g_object_unref (G_OBJECT (wscroll));
+ w += 2*b;
+ if (w < 16) w = 16;
+ scroll_bar_width_for_theme = w;
+}
+
+int
+xg_get_default_scrollbar_width (void)
+{
+ return scroll_bar_width_for_theme;
+}
+
/* Return the scrollbar id for X Window WID on display DPY.
Return -1 if WID not in id_to_widget. */
@@ -3509,6 +3576,15 @@ xg_update_scrollbar_pos (FRAME_PTR f,
}
}
+/* Get the current value of the range, truncated to an integer. */
+
+static int
+int_gtk_range_get_value (GtkRange *range)
+{
+ return gtk_range_get_value (range);
+}
+
+
/* Set the thumb size and position of scroll bar BAR. We are currently
displaying PORTION out of a whole WHOLE, and our position POSITION. */
@@ -4661,6 +4737,7 @@ xg_initialize (void)
(GTK_TYPE_MENU_SHELL));
gtk_binding_entry_add_signal (binding_set, GDK_KEY_g, GDK_CONTROL_MASK,
"cancel", 0);
+ update_theme_scrollbar_width ();
}
#endif /* USE_GTK */
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 3dc0a1dd150..769e56da917 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -135,6 +135,7 @@ extern void xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar,
int position,
int whole);
extern int 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);
diff --git a/src/image.c b/src/image.c
index 747142635af..fa39ff12681 100644
--- a/src/image.c
+++ b/src/image.c
@@ -182,20 +182,20 @@ XPutPixel (XImagePtr ximage, int x, int y, unsigned long pixel)
/* Functions to access the contents of a bitmap, given an id. */
int
-x_bitmap_height (FRAME_PTR f, int id)
+x_bitmap_height (FRAME_PTR f, ptrdiff_t id)
{
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
}
int
-x_bitmap_width (FRAME_PTR f, int id)
+x_bitmap_width (FRAME_PTR f, ptrdiff_t id)
{
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
}
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI)
int
-x_bitmap_pixmap (FRAME_PTR f, int id)
+x_bitmap_pixmap (FRAME_PTR f, ptrdiff_t id)
{
return (int) FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
}
@@ -203,7 +203,7 @@ x_bitmap_pixmap (FRAME_PTR f, int id)
#ifdef HAVE_X_WINDOWS
int
-x_bitmap_mask (FRAME_PTR f, int id)
+x_bitmap_mask (FRAME_PTR f, ptrdiff_t id)
{
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
}
@@ -211,11 +211,11 @@ x_bitmap_mask (FRAME_PTR f, int id)
/* Allocate a new bitmap record. Returns index of new record. */
-static int
+static ptrdiff_t
x_allocate_bitmap_record (FRAME_PTR f)
{
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int i;
+ ptrdiff_t i;
if (dpyinfo->bitmaps == NULL)
{
@@ -233,6 +233,9 @@ x_allocate_bitmap_record (FRAME_PTR f)
if (dpyinfo->bitmaps[i].refcount == 0)
return i + 1;
+ if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Bitmap_Record) / 2
+ < dpyinfo->bitmaps_size)
+ memory_full (SIZE_MAX);
dpyinfo->bitmaps_size *= 2;
dpyinfo->bitmaps
= (Bitmap_Record *) xrealloc (dpyinfo->bitmaps,
@@ -250,11 +253,11 @@ x_reference_bitmap (FRAME_PTR f, int id)
/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
-int
+ptrdiff_t
x_create_bitmap_from_data (struct frame *f, char *bits, unsigned int width, unsigned int height)
{
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int id;
+ ptrdiff_t id;
#ifdef HAVE_X_WINDOWS
Pixmap bitmap;
@@ -309,7 +312,7 @@ x_create_bitmap_from_data (struct frame *f, char *bits, unsigned int width, unsi
/* Create bitmap from file FILE for frame F. */
-int
+ptrdiff_t
x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
{
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
@@ -319,7 +322,7 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
- int id;
+ ptrdiff_t id;
void *bitmap = ns_image_from_file (file);
if (!bitmap)
@@ -340,7 +343,8 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
#ifdef HAVE_X_WINDOWS
unsigned int width, height;
Pixmap bitmap;
- int xhot, yhot, result, id;
+ int xhot, yhot, result;
+ ptrdiff_t id;
Lisp_Object found;
int fd;
char *filename;
@@ -413,7 +417,7 @@ free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm)
/* Remove reference to bitmap with id number ID. */
void
-x_destroy_bitmap (FRAME_PTR f, int id)
+x_destroy_bitmap (FRAME_PTR f, ptrdiff_t id)
{
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
@@ -435,7 +439,7 @@ x_destroy_bitmap (FRAME_PTR f, int id)
void
x_destroy_all_bitmaps (Display_Info *dpyinfo)
{
- int i;
+ ptrdiff_t i;
Bitmap_Record *bm = dpyinfo->bitmaps;
for (i = 0; i < dpyinfo->bitmaps_last; i++, bm++)
@@ -467,7 +471,7 @@ static void x_destroy_x_image (XImagePtr ximg);
It's nicer with some borders in this context */
int
-x_create_bitmap_mask (struct frame *f, int id)
+x_create_bitmap_mask (struct frame *f, ptrdiff_t id)
{
Pixmap pixmap, mask;
XImagePtr ximg, mask_img;
@@ -564,7 +568,6 @@ static Lisp_Object Qxbm;
/* Keywords. */
Lisp_Object QCascent, QCmargin, QCrelief;
-static Lisp_Object Qcount, Qextension_data;
Lisp_Object QCconversion;
static Lisp_Object QCheuristic_mask;
static Lisp_Object QCcolor_symbols;
@@ -573,6 +576,7 @@ static Lisp_Object QCcrop, QCrotation;
/* Other symbols. */
+static Lisp_Object Qcount, Qextension_data, Qdelay;
static Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
/* Function prototypes. */
@@ -623,7 +627,7 @@ define_image_type (struct image_type *type, int loaded)
/* 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 *
+static inline struct image_type *
lookup_image_type (Lisp_Object symbol)
{
struct image_type *type;
@@ -971,7 +975,7 @@ or omitted means use the selected frame. */)
struct frame *f = check_x_frame (frame);
int id = lookup_image (f, spec);
struct image *img = IMAGE_FROM_ID (f, id);
- ext = img->data.lisp_val;
+ ext = img->lisp_data;
}
return ext;
@@ -982,7 +986,6 @@ or omitted means use the selected frame. */)
Image type independent image structures
***********************************************************************/
-static struct image *make_image (Lisp_Object spec, unsigned hash);
static void free_image (struct frame *f, struct image *img);
static int check_image_size (struct frame *f, int width, int height);
@@ -991,7 +994,7 @@ static int check_image_size (struct frame *f, int width, int height);
SPEC. SPEC has a hash value of HASH. */
static struct image *
-make_image (Lisp_Object spec, unsigned int hash)
+make_image (Lisp_Object spec, EMACS_UINT hash)
{
struct image *img = (struct image *) xmalloc (sizeof *img);
Lisp_Object file = image_spec_value (spec, QCfile, NULL);
@@ -1002,7 +1005,7 @@ make_image (Lisp_Object spec, unsigned int hash)
img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
xassert (img->type != NULL);
img->spec = spec;
- img->data.lisp_val = Qnil;
+ img->lisp_data = Qnil;
img->ascent = DEFAULT_IMAGE_ASCENT;
img->hash = hash;
img->corners[BOT_CORNER] = -1; /* Full image */
@@ -1388,7 +1391,6 @@ x_alloc_image_color (struct frame *f, struct image *img, Lisp_Object color_name,
Image Cache
***********************************************************************/
-static struct image *search_image_cache (struct frame *, Lisp_Object, unsigned);
static void cache_image (struct frame *f, struct image *img);
static void postprocess_image (struct frame *, struct image *);
@@ -1414,7 +1416,7 @@ make_image_cache (void)
/* Find an image matching SPEC in the cache, and return it. If no
image is found, return NULL. */
static struct image *
-search_image_cache (struct frame *f, Lisp_Object spec, unsigned int hash)
+search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
{
struct image *img;
struct image_cache *c = FRAME_IMAGE_CACHE (f);
@@ -1523,7 +1525,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
{
/* Free cache based on timestamp. */
EMACS_TIME t;
- unsigned long old;
+ time_t old;
int delay, nimages = 0;
for (i = 0; i < c->used; ++i)
@@ -1714,7 +1716,7 @@ int
lookup_image (struct frame *f, Lisp_Object spec)
{
struct image *img;
- unsigned hash;
+ EMACS_UINT hash;
EMACS_TIME now;
/* F must be a window-system frame, and SPEC must be a valid image
@@ -1834,6 +1836,8 @@ cache_image (struct frame *f, struct image *img)
/* If no free slot found, maybe enlarge c->images. */
if (i == c->used && c->used == c->size)
{
+ if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *c->images / 2 < c->size)
+ memory_full (SIZE_MAX);
c->size *= 2;
c->images = (struct image **) xrealloc (c->images,
c->size * sizeof *c->images);
@@ -1866,8 +1870,8 @@ mark_image (struct image *img)
mark_object (img->spec);
mark_object (img->dependencies);
- if (!NILP (img->data.lisp_val))
- mark_object (img->data.lisp_val);
+ if (!NILP (img->lisp_data))
+ mark_object (img->lisp_data);
}
@@ -2114,9 +2118,6 @@ x_put_x_image (struct frame *f, XImagePtr ximg, Pixmap pixmap, int width, int he
File Handling
***********************************************************************/
-static unsigned char *slurp_file (char *, int *);
-
-
/* Find image file FILE. Look in data-directory/images, then
x-bitmap-file-path. Value is the encoded full name of the file
found, or nil if not found. */
@@ -2153,7 +2154,7 @@ x_find_image_file (Lisp_Object file)
occurred. *SIZE is set to the size of the file. */
static unsigned char *
-slurp_file (char *file, int *size)
+slurp_file (char *file, ptrdiff_t *size)
{
FILE *fp = NULL;
unsigned char *buf = NULL;
@@ -2161,6 +2162,7 @@ slurp_file (char *file, int *size)
if (stat (file, &st) == 0
&& (fp = fopen (file, "rb")) != NULL
+ && 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
&& (buf = (unsigned char *) xmalloc (st.st_size),
fread (buf, 1, st.st_size, fp) == st.st_size))
{
@@ -2312,7 +2314,7 @@ xbm_image_p (Lisp_Object object)
else
{
Lisp_Object data;
- int width, height;
+ EMACS_INT width, height;
/* Entries for `:width', `:height' and `:data' must be present. */
if (!kw[XBM_WIDTH].count
@@ -2328,7 +2330,7 @@ xbm_image_p (Lisp_Object object)
data. */
if (VECTORP (data))
{
- int i;
+ EMACS_INT i;
/* Number of elements of the vector must be >= height. */
if (ASIZE (data) < height)
@@ -2816,7 +2818,7 @@ xbm_load (struct frame *f, struct image *img)
{
Lisp_Object file;
unsigned char *contents;
- int size;
+ ptrdiff_t size;
file = x_find_image_file (file_name);
if (!STRINGP (file))
@@ -2833,6 +2835,7 @@ xbm_load (struct frame *f, struct image *img)
}
success_p = xbm_load_image (f, img, contents, contents + size);
+ xfree (contents);
}
else
{
@@ -3285,11 +3288,12 @@ xpm_image_p (Lisp_Object object)
#endif /* HAVE_XPM || HAVE_NS */
#if defined HAVE_XPM && defined HAVE_X_WINDOWS && !defined USE_GTK
-int
+ptrdiff_t
x_create_bitmap_from_xpm_data (struct frame *f, const char **bits)
{
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int id, rc;
+ ptrdiff_t id;
+ int rc;
XpmAttributes attrs;
Pixmap bitmap, mask;
@@ -3593,25 +3597,14 @@ xpm_load (struct frame *f, struct image *img)
/* XPM support functions for NS where libxpm is not available.
Only XPM version 3 (without any extensions) is supported. */
-static int xpm_scan (const unsigned char **, const unsigned char *,
- const unsigned char **, int *);
-static Lisp_Object xpm_make_color_table_v
- (void (**) (Lisp_Object, const unsigned char *, int, Lisp_Object),
- Lisp_Object (**) (Lisp_Object, const unsigned char *, int));
static void xpm_put_color_table_v (Lisp_Object, const unsigned char *,
int, Lisp_Object);
static Lisp_Object xpm_get_color_table_v (Lisp_Object,
const unsigned char *, int);
-static Lisp_Object xpm_make_color_table_h
- (void (**) (Lisp_Object, const unsigned char *, int, Lisp_Object),
- Lisp_Object (**) (Lisp_Object, const unsigned char *, int));
static void xpm_put_color_table_h (Lisp_Object, const unsigned char *,
int, Lisp_Object);
static Lisp_Object xpm_get_color_table_h (Lisp_Object,
const unsigned char *, int);
-static int xpm_str_to_color_key (const char *);
-static int xpm_load_image (struct frame *, struct image *,
- const unsigned char *, const unsigned char *);
/* Tokens returned from xpm_scan. */
@@ -3633,7 +3626,7 @@ static int
xpm_scan (const unsigned char **s,
const unsigned char *end,
const unsigned char **beg,
- int *len)
+ ptrdiff_t *len)
{
int c;
@@ -3751,7 +3744,7 @@ xpm_put_color_table_h (Lisp_Object color_table,
Lisp_Object color)
{
struct Lisp_Hash_Table *table = XHASH_TABLE (color_table);
- unsigned hash_code;
+ EMACS_UINT hash_code;
Lisp_Object chars = make_unibyte_string (chars_start, chars_len);
hash_lookup (table, chars, &hash_code);
@@ -3803,7 +3796,8 @@ xpm_load_image (struct frame *f,
unsigned char buffer[BUFSIZ];
int width, height, x, y;
int num_colors, chars_per_pixel;
- int len, LA1;
+ ptrdiff_t len;
+ int LA1;
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;
@@ -4041,7 +4035,7 @@ xpm_load (struct frame *f,
{
Lisp_Object file;
unsigned char *contents;
- int size;
+ ptrdiff_t size;
file = x_find_image_file (file_name);
if (!STRINGP (file))
@@ -5013,9 +5007,7 @@ pbm_scan_number (unsigned char **s, unsigned char *end)
occurred. *SIZE is set to the size of the file. */
static char *
-pbm_read_file (file, size)
- Lisp_Object file;
- int *size;
+pbm_read_file (Lisp_Object file, int *size)
{
FILE *fp = NULL;
char *buf = NULL;
@@ -5023,6 +5015,7 @@ pbm_read_file (file, size)
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))
{
@@ -5057,7 +5050,7 @@ pbm_load (struct frame *f, struct image *img)
enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
unsigned char *contents = NULL;
unsigned char *end, *p;
- int size;
+ ptrdiff_t size;
specified_file = image_spec_value (img->spec, QCfile, NULL);
@@ -6821,9 +6814,9 @@ tiff_load (struct frame *f, struct image *img)
continue;
if (count > 1)
- img->data.lisp_val = Fcons (Qcount,
- Fcons (make_number (count),
- img->data.lisp_val));
+ img->lisp_data = Fcons (Qcount,
+ Fcons (make_number (count),
+ img->lisp_data));
fn_TIFFClose (tiff);
if (!rc)
@@ -6962,8 +6955,7 @@ static struct image_type gif_type =
static void
gif_clear_image (struct frame *f, struct image *img)
{
- /* IMG->data.ptr_val may contain metadata with extension data. */
- img->data.lisp_val = Qnil;
+ img->lisp_data = Qnil;
x_clear_image (f, img);
}
@@ -7077,22 +7069,19 @@ static const int interlace_increment[] = {8, 8, 4, 2};
static int
gif_load (struct frame *f, struct image *img)
{
- Lisp_Object file, specified_file;
- Lisp_Object specified_data;
- int rc, width, height, x, y, i;
- boolean transparent_p = 0;
+ Lisp_Object file;
+ int rc, width, height, x, y, i, j;
XImagePtr ximg;
ColorMapObject *gif_color_map;
unsigned long pixel_colors[256];
GifFileType *gif;
- Lisp_Object image;
- int ino, image_height, image_width;
+ int image_height, image_width;
gif_memory_source memsrc;
- unsigned char *raster;
- unsigned int transparency_color_index IF_LINT (= 0);
-
- specified_file = image_spec_value (img->spec, QCfile, NULL);
- specified_data = image_spec_value (img->spec, QCdata, NULL);
+ Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL);
+ Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL);
+ Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL);
+ unsigned long bgcolor = 0;
+ int idx;
if (NILP (specified_data))
{
@@ -7143,40 +7132,31 @@ gif_load (struct frame *f, struct image *img)
/* Read entire contents. */
rc = fn_DGifSlurp (gif);
- if (rc == GIF_ERROR)
+ if (rc == GIF_ERROR || gif->ImageCount <= 0)
{
image_error ("Error reading `%s'", img->spec, Qnil);
fn_DGifCloseFile (gif);
return 0;
}
- image = image_spec_value (img->spec, QCindex, NULL);
- ino = INTEGERP (image) ? XFASTINT (image) : 0;
- if (ino >= gif->ImageCount)
- {
- image_error ("Invalid image number `%s' in image `%s'",
- image, img->spec);
- fn_DGifCloseFile (gif);
- return 0;
- }
-
- for (i = 0; i < gif->SavedImages[ino].ExtensionBlockCount; i++)
- if ((gif->SavedImages[ino].ExtensionBlocks[i].Function
- == GIF_LOCAL_DESCRIPTOR_EXTENSION)
- && gif->SavedImages[ino].ExtensionBlocks[i].ByteCount == 4
- /* Transparency enabled? */
- && gif->SavedImages[ino].ExtensionBlocks[i].Bytes[0] & 1)
+ /* Which sub-image are we to display? */
+ {
+ Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL);
+ idx = INTEGERP (image_number) ? XFASTINT (image_number) : 0;
+ if (idx < 0 || idx >= gif->ImageCount)
{
- transparent_p = 1;
- transparency_color_index
- = (unsigned char) gif->SavedImages[ino].ExtensionBlocks[i].Bytes[3];
+ image_error ("Invalid image number `%s' in image `%s'",
+ image_number, img->spec);
+ fn_DGifCloseFile (gif);
+ return 0;
}
+ }
- img->corners[TOP_CORNER] = gif->SavedImages[ino].ImageDesc.Top;
- img->corners[LEFT_CORNER] = gif->SavedImages[ino].ImageDesc.Left;
- image_height = gif->SavedImages[ino].ImageDesc.Height;
+ img->corners[TOP_CORNER] = gif->SavedImages[idx].ImageDesc.Top;
+ img->corners[LEFT_CORNER] = gif->SavedImages[idx].ImageDesc.Left;
+ image_height = gif->SavedImages[idx].ImageDesc.Height;
img->corners[BOT_CORNER] = img->corners[TOP_CORNER] + image_height;
- image_width = gif->SavedImages[ino].ImageDesc.Width;
+ image_width = gif->SavedImages[idx].ImageDesc.Width;
img->corners[RIGHT_CORNER] = img->corners[LEFT_CORNER] + image_width;
width = img->width = max (gif->SWidth,
@@ -7200,44 +7180,10 @@ gif_load (struct frame *f, struct image *img)
return 0;
}
- /* Allocate colors. */
- gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
- if (!gif_color_map)
- gif_color_map = gif->SColorMap;
- init_color_table ();
- memset (pixel_colors, 0, sizeof pixel_colors);
-
- if (gif_color_map)
- for (i = 0; i < gif_color_map->ColorCount; ++i)
- {
- if (transparent_p && transparency_color_index == i)
- {
- Lisp_Object specified_bg
- = image_spec_value (img->spec, QCbackground, NULL);
- pixel_colors[i] = STRINGP (specified_bg)
- ? x_alloc_image_color (f, img, specified_bg,
- FRAME_BACKGROUND_PIXEL (f))
- : FRAME_BACKGROUND_PIXEL (f);
- }
- else
- {
- int r = gif_color_map->Colors[i].Red << 8;
- int g = gif_color_map->Colors[i].Green << 8;
- int b = gif_color_map->Colors[i].Blue << 8;
- pixel_colors[i] = lookup_rgb_color (f, r, g, b);
- }
- }
-
-#ifdef COLOR_TABLE_SUPPORT
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
-#endif /* COLOR_TABLE_SUPPORT */
-
- /* Clear the part of the screen image that are not covered by
- the image from the GIF file. Full animated GIF support
- requires more than can be done here (see the gif89 spec,
- disposal methods). Let's simply assume that the part
- not covered by a sub-image is in the frame's background color. */
+ /* Clear the part of the screen image not covered by the image.
+ Full animated GIF support requires more here (see the gif89 spec,
+ disposal methods). Let's simply assume that the part not covered
+ by a sub-image is in the frame's background color. */
for (y = 0; y < img->corners[TOP_CORNER]; ++y)
for (x = 0; x < width; ++x)
XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
@@ -7254,67 +7200,146 @@ gif_load (struct frame *f, struct image *img)
XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
}
- /* Read the GIF image into the X image. We use a local variable
- `raster' here because RasterBits below is a char *, and invites
- problems with bytes >= 0x80. */
- raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
-
- if (gif->SavedImages[ino].ImageDesc.Interlace)
- {
- int pass;
- int row = interlace_start[0];
+ /* Read the GIF image into the X image. */
- pass = 0;
+ /* FIXME: With the current implementation, loading an animated gif
+ is quadratic in the number of animation frames, since each frame
+ is a separate struct image. We must provide a way for a single
+ gif_load call to construct and save all animation frames. */
- for (y = 0; y < image_height; y++)
+ init_color_table ();
+ if (STRINGP (specified_bg))
+ bgcolor = x_alloc_image_color (f, img, specified_bg,
+ FRAME_BACKGROUND_PIXEL (f));
+ for (j = 0; j <= idx; ++j)
+ {
+ /* We use a local variable `raster' here because RasterBits is a
+ char *, which invites problems with bytes >= 0x80. */
+ struct SavedImage *subimage = gif->SavedImages + j;
+ unsigned char *raster = (unsigned char *) subimage->RasterBits;
+ int transparency_color_index = -1;
+ int disposal = 0;
+
+ /* Find the Graphic Control Extension block for this sub-image.
+ Extract the disposal method and transparency color. */
+ for (i = 0; i < subimage->ExtensionBlockCount; i++)
{
- if (row >= image_height)
- {
- row = interlace_start[++pass];
- while (row >= image_height)
- row = interlace_start[++pass];
- }
+ ExtensionBlock *extblock = subimage->ExtensionBlocks + i;
- for (x = 0; x < image_width; x++)
+ if ((extblock->Function == GIF_LOCAL_DESCRIPTOR_EXTENSION)
+ && extblock->ByteCount == 4
+ && extblock->Bytes[0] & 1)
{
- int c = raster[(y * image_width) + x];
- XPutPixel (ximg, x + img->corners[LEFT_CORNER],
- row + img->corners[TOP_CORNER], pixel_colors[c]);
+ /* From gif89a spec: 1 = "keep in place", 2 = "restore
+ to background". Treat any other value like 2. */
+ disposal = (extblock->Bytes[0] >> 2) & 7;
+ transparency_color_index = (unsigned char) extblock->Bytes[3];
+ break;
}
-
- row += interlace_increment[pass];
}
- }
- else
- {
- for (y = 0; y < image_height; ++y)
- for (x = 0; x < image_width; ++x)
+
+ /* We can't "keep in place" the first subimage. */
+ if (j == 0)
+ disposal = 2;
+
+ /* Allocate subimage colors. */
+ memset (pixel_colors, 0, sizeof pixel_colors);
+ gif_color_map = subimage->ImageDesc.ColorMap;
+ if (!gif_color_map)
+ gif_color_map = gif->SColorMap;
+
+ if (gif_color_map)
+ for (i = 0; i < gif_color_map->ColorCount; ++i)
{
- int c = raster[y * image_width + x];
- XPutPixel (ximg, x + img->corners[LEFT_CORNER],
- y + img->corners[TOP_CORNER], pixel_colors[c]);
+ if (transparency_color_index == i)
+ pixel_colors[i] = STRINGP (specified_bg)
+ ? bgcolor : FRAME_BACKGROUND_PIXEL (f);
+ else
+ {
+ int r = gif_color_map->Colors[i].Red << 8;
+ int g = gif_color_map->Colors[i].Green << 8;
+ int b = gif_color_map->Colors[i].Blue << 8;
+ pixel_colors[i] = lookup_rgb_color (f, r, g, b);
+ }
}
+
+ /* Apply the pixel values. */
+ if (gif->SavedImages[j].ImageDesc.Interlace)
+ {
+ int row, pass;
+
+ for (y = 0, row = interlace_start[0], pass = 0;
+ y < image_height;
+ y++, row += interlace_increment[pass])
+ {
+ if (row >= image_height)
+ {
+ row = interlace_start[++pass];
+ while (row >= image_height)
+ row = interlace_start[++pass];
+ }
+
+ for (x = 0; x < image_width; x++)
+ {
+ int c = raster[y * image_width + x];
+ if (transparency_color_index != c || disposal != 1)
+ XPutPixel (ximg, x + img->corners[LEFT_CORNER],
+ row + img->corners[TOP_CORNER], pixel_colors[c]);
+ }
+ }
+ }
+ else
+ {
+ for (y = 0; y < image_height; ++y)
+ for (x = 0; x < image_width; ++x)
+ {
+ int c = raster[y * image_width + x];
+ if (transparency_color_index != c || disposal != 1)
+ XPutPixel (ximg, x + img->corners[LEFT_CORNER],
+ y + img->corners[TOP_CORNER], pixel_colors[c]);
+ }
+ }
}
+#ifdef COLOR_TABLE_SUPPORT
+ img->colors = colors_in_color_table (&img->ncolors);
+ free_color_table ();
+#endif /* COLOR_TABLE_SUPPORT */
+
/* Save GIF image extension data for `image-metadata'.
Format is (count IMAGES extension-data (FUNCTION "BYTES" ...)). */
- img->data.lisp_val = Qnil;
- if (gif->SavedImages[ino].ExtensionBlockCount > 0)
+ img->lisp_data = Qnil;
+ if (gif->SavedImages[idx].ExtensionBlockCount > 0)
{
- ExtensionBlock *ext = gif->SavedImages[ino].ExtensionBlocks;
- for (i = 0; i < gif->SavedImages[ino].ExtensionBlockCount; i++, ext++)
+ unsigned int delay = 0;
+ ExtensionBlock *ext = gif->SavedImages[idx].ExtensionBlocks;
+ for (i = 0; i < gif->SavedImages[idx].ExtensionBlockCount; i++, ext++)
/* Append (... FUNCTION "BYTES") */
- img->data.lisp_val = Fcons (make_unibyte_string (ext->Bytes, ext->ByteCount),
- Fcons (make_number (ext->Function),
- img->data.lisp_val));
- img->data.lisp_val = Fcons (Qextension_data,
- Fcons (Fnreverse (img->data.lisp_val),
- Qnil));
+ {
+ img->lisp_data
+ = Fcons (make_number (ext->Function),
+ Fcons (make_unibyte_string (ext->Bytes, ext->ByteCount),
+ img->lisp_data));
+ if (ext->Function == GIF_LOCAL_DESCRIPTOR_EXTENSION
+ && ext->ByteCount == 4)
+ {
+ delay = ext->Bytes[2] << CHAR_BIT;
+ delay |= ext->Bytes[1];
+ }
+ }
+ img->lisp_data = Fcons (Qextension_data,
+ Fcons (img->lisp_data, Qnil));
+ if (delay)
+ img->lisp_data
+ = Fcons (Qdelay,
+ Fcons (make_float (((double) delay) * 0.01),
+ img->lisp_data));
}
+
if (gif->ImageCount > 1)
- img->data.lisp_val = Fcons (Qcount,
- Fcons (make_number (gif->ImageCount),
- img->data.lisp_val));
+ img->lisp_data = Fcons (Qcount,
+ Fcons (make_number (gif->ImageCount),
+ img->lisp_data));
fn_DGifCloseFile (gif);
@@ -7350,7 +7375,11 @@ gif_load (struct frame *f, struct image *img)
***********************************************************************/
#if defined (HAVE_IMAGEMAGICK)
-Lisp_Object Qimagemagick;
+static Lisp_Object Qimagemagick;
+
+static int imagemagick_image_p (Lisp_Object);
+static int imagemagick_load (struct frame *, struct image *);
+static void imagemagick_clear_image (struct frame *, struct image *);
/* Indices of image specification fields in imagemagick_format. */
@@ -7394,6 +7423,18 @@ static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] =
{":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
+/* Structure describing the image type for any image handled via
+ ImageMagick. */
+
+static struct image_type imagemagick_type =
+ {
+ &Qimagemagick,
+ imagemagick_image_p,
+ imagemagick_load,
+ imagemagick_clear_image,
+ NULL
+ };
+
/* Free X resources of imagemagick image IMG which is used on frame F. */
static void
@@ -7425,38 +7466,37 @@ imagemagick_image_p (Lisp_Object object)
#define DrawRectangle DrawRectangleGif
#include <wand/MagickWand.h>
-/* imagemagick_load_image is a helper function for imagemagick_load,
- which does the actual loading given contents and size, apart from
- frame and image structures, passed from imagemagick_load.
+/* ImageMagick 6.5.3 through 6.6.5 hid PixelGetMagickColor for some reason.
+ Emacs seems to work fine with the hidden version, so unhide it. */
+#include <magick/version.h>
+#if 0x653 <= MagickLibVersion && MagickLibVersion <= 0x665
+extern WandExport void PixelGetMagickColor (const PixelWand *,
+ MagickPixelPacket *);
+#endif
+
+/* Helper function for imagemagick_load, which does the actual loading
+ given contents and size, apart from frame and image structures,
+ passed from imagemagick_load. Uses librimagemagick to do most of
+ the image processing.
- Uses librimagemagick to do most of the image processing.
+ F is a pointer to the Emacs frame; IMG to the image structure to
+ prepare; CONTENTS is the string containing the IMAGEMAGICK data to
+ 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 non-zero if successful. */
static int
-imagemagick_load_image (/* Pointer to emacs frame structure. */
- struct frame *f,
- /* Pointer to emacs image structure. */
- struct image *img,
- /* String containing the IMAGEMAGICK data to
- be parsed. */
- unsigned char *contents,
- /* Size of data in bytes. */
- unsigned int size,
- /* Filename, either pass filename or
- contents/size. */
- unsigned char *filename)
-{
- unsigned long width;
- unsigned long height;
-
- MagickBooleanType
- status;
+imagemagick_load_image (struct frame *f, struct image *img,
+ unsigned char *contents, unsigned int size,
+ char *filename)
+{
+ size_t width;
+ size_t height;
+
+ MagickBooleanType status;
XImagePtr ximg;
- Lisp_Object specified_bg;
- XColor background;
int x;
int y;
@@ -7467,7 +7507,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
MagickPixelPacket pixel;
Lisp_Object image;
Lisp_Object value;
- Lisp_Object crop, geometry;
+ Lisp_Object crop;
long ino;
int desired_width, desired_height;
double rotation;
@@ -7507,15 +7547,15 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
}
if (MagickGetNumberImages(ping_wand) > 1)
- img->data.lisp_val =
+ img->lisp_data =
Fcons (Qcount,
Fcons (make_number (MagickGetNumberImages (ping_wand)),
- img->data.lisp_val));
+ img->lisp_data));
DestroyMagickWand (ping_wand);
- /* Now, after pinging, we know how many images are inside the
- file. If it's not a bundle, the number is one. */
+ /* Now we know how many images are inside the file. If it's not a
+ bundle, the number is one. */
if (filename != NULL)
{
@@ -7528,23 +7568,18 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
im_image = ReadImage (image_info, exception);
DestroyExceptionInfo (exception);
- if (im_image != NULL)
- {
- image_wand = NewMagickWandFromImage (im_image);
- DestroyImage(im_image);
- status = MagickTrue;
- }
- else
- status = MagickFalse;
+ if (im_image == NULL)
+ goto imagemagick_no_wand;
+ image_wand = NewMagickWandFromImage (im_image);
+ DestroyImage(im_image);
}
else
{
image_wand = NewMagickWand ();
- status = MagickReadImageBlob (image_wand, contents, size);
+ if (MagickReadImageBlob (image_wand, contents, size) == MagickFalse)
+ goto imagemagick_error;
}
- if (status == MagickFalse) goto imagemagick_error;
-
/* 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
@@ -7585,7 +7620,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
than the alternatives, but it still reads the entire image into memory
before croping, which is aparently difficult to avoid when using
imagemagick. */
- int w, h, x, y;
+ int w, h;
w = XFASTINT (XCAR (crop));
crop = XCDR (crop);
if (CONSP (crop) && INTEGERP (XCAR (crop)))
@@ -7628,8 +7663,8 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
}
}
- /* Finaly we are done manipulating the image, figure out resulting
- width, height, and then transfer ownerwship to Emacs. */
+ /* Finally we are done manipulating the image. Figure out the
+ resulting width/height and transfer ownerwship to Emacs. */
height = MagickGetImageHeight (image_wand);
width = MagickGetImageWidth (image_wand);
@@ -7699,7 +7734,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
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);*/
- char* exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/
+ 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))
@@ -7772,6 +7807,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
imagemagick_error:
DestroyMagickWand (image_wand);
+ imagemagick_no_wand:
MagickWandTerminus ();
/* TODO more cleanup. */
image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil);
@@ -7784,8 +7820,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
the prototype thus needs to be compatible with that structure. */
static int
-imagemagick_load (struct frame *f,
- struct image *img)
+imagemagick_load (struct frame *f, struct image *img)
{
int success_p = 0;
Lisp_Object file_name;
@@ -7802,7 +7837,7 @@ imagemagick_load (struct frame *f,
image_error ("Cannot find image file `%s'", file_name, Qnil);
return 0;
}
- success_p = imagemagick_load_image (f, img, 0, 0, SDATA (file));
+ success_p = imagemagick_load_image (f, img, 0, 0, SSDATA (file));
}
/* Else its not a file, its a lisp object. Load the image from a
lisp object rather than a file. */
@@ -7823,36 +7858,18 @@ imagemagick_load (struct frame *f,
return success_p;
}
-/* Structure describing the image type `imagemagick'. 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 imagemagick_type =
- {
- /* An identifier showing that this is an image structure for the
- IMAGEMAGICK format. */
- &Qimagemagick,
- /* Handle to a function that can be used to identify a IMAGEMAGICK
- file. */
- imagemagick_image_p,
- /* Handle to function used to load a IMAGEMAGICK file. */
- imagemagick_load,
- /* Handle to function to free resources for IMAGEMAGICK. */
- imagemagick_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. */
- NULL
- };
-
-
DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0,
- doc: /* Return the image types supported by ImageMagick.
-Note that ImageMagick recognizes many file-types that Emacs does not recognize
-as images, such as .c. */)
+ doc: /* Return a list of image types supported by ImageMagick.
+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).
+
+Note that ImageMagick recognizes many file-types that Emacs does not
+recognize as images, such as C. See `imagemagick-types-inhibit'. */)
(void)
{
Lisp_Object typelist = Qnil;
- unsigned long numf;
+ size_t numf = 0;
ExceptionInfo ex;
char **imtypes = GetMagickList ("*", &numf, &ex);
int i;
@@ -7881,11 +7898,11 @@ static int svg_image_p (Lisp_Object object);
static int svg_load (struct frame *f, struct image *img);
static int svg_load_image (struct frame *, struct image *,
- unsigned char *, unsigned int);
+ unsigned char *, ptrdiff_t);
/* The symbol `svg' identifying images of this type. */
-Lisp_Object Qsvg;
+static Lisp_Object Qsvg;
/* Indices of image specification fields in svg_format, below. */
@@ -7968,7 +7985,6 @@ DEF_IMGLIB_FN (void, rsvg_handle_get_dimensions);
DEF_IMGLIB_FN (gboolean, rsvg_handle_write);
DEF_IMGLIB_FN (gboolean, rsvg_handle_close);
DEF_IMGLIB_FN (GdkPixbuf *, rsvg_handle_get_pixbuf);
-DEF_IMGLIB_FN (void, rsvg_handle_free);
DEF_IMGLIB_FN (int, gdk_pixbuf_get_width);
DEF_IMGLIB_FN (int, gdk_pixbuf_get_height);
@@ -8001,7 +8017,6 @@ init_svg_functions (Lisp_Object libraries)
LOAD_IMGLIB_FN (library, rsvg_handle_write);
LOAD_IMGLIB_FN (library, rsvg_handle_close);
LOAD_IMGLIB_FN (library, rsvg_handle_get_pixbuf);
- LOAD_IMGLIB_FN (library, rsvg_handle_free);
LOAD_IMGLIB_FN (gdklib, gdk_pixbuf_get_width);
LOAD_IMGLIB_FN (gdklib, gdk_pixbuf_get_height);
@@ -8027,7 +8042,6 @@ init_svg_functions (Lisp_Object libraries)
#define fn_rsvg_handle_write rsvg_handle_write
#define fn_rsvg_handle_close rsvg_handle_close
#define fn_rsvg_handle_get_pixbuf rsvg_handle_get_pixbuf
-#define fn_rsvg_handle_free rsvg_handle_free
#define fn_gdk_pixbuf_get_width gdk_pixbuf_get_width
#define fn_gdk_pixbuf_get_height gdk_pixbuf_get_height
@@ -8059,7 +8073,7 @@ svg_load (struct frame *f, struct image *img)
{
Lisp_Object file;
unsigned char *contents;
- int size;
+ ptrdiff_t size;
file = x_find_image_file (file_name);
if (!STRINGP (file))
@@ -8069,7 +8083,7 @@ svg_load (struct frame *f, struct image *img)
}
/* Read the entire file into memory. */
- contents = slurp_file (SDATA (file), &size);
+ contents = slurp_file (SSDATA (file), &size);
if (contents == NULL)
{
image_error ("Error loading SVG image `%s'", img->spec, Qnil);
@@ -8108,11 +8122,11 @@ static int
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. */
- unsigned int size) /* Size of data in bytes. */
+ ptrdiff_t size) /* Size of data in bytes. */
{
RsvgHandle *rsvg_handle;
RsvgDimensionData dimension_data;
- GError *error = NULL;
+ GError *err = NULL;
GdkPixbuf *pixbuf;
int width;
int height;
@@ -8131,13 +8145,13 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
rsvg_handle = fn_rsvg_handle_new ();
/* Parse the contents argument and fill in the rsvg_handle. */
- fn_rsvg_handle_write (rsvg_handle, contents, size, &error);
- if (error) goto rsvg_error;
+ fn_rsvg_handle_write (rsvg_handle, contents, size, &err);
+ if (err) goto rsvg_error;
/* The parsing is complete, rsvg_handle is ready to used, close it
for further writes. */
- fn_rsvg_handle_close (rsvg_handle, &error);
- if (error) goto rsvg_error;
+ fn_rsvg_handle_close (rsvg_handle, &err);
+ if (err) goto rsvg_error;
fn_rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
if (! check_image_size (f, dimension_data.width, dimension_data.height))
@@ -8177,7 +8191,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
color. */
specified_bg = image_spec_value (img->spec, QCbackground, NULL);
if (!STRINGP (specified_bg)
- || !x_defined_color (f, SDATA (specified_bg), &background, 0))
+ || !x_defined_color (f, SSDATA (specified_bg), &background, 0))
{
#ifndef HAVE_NS
background.pixel = FRAME_BACKGROUND_PIXEL (f);
@@ -8252,7 +8266,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
/* FIXME: Use error->message so the user knows what is the actual
problem with the image. */
image_error ("Error parsing SVG image `%s'", img->spec, Qnil);
- fn_g_error_free (error);
+ fn_g_error_free (err);
return 0;
}
@@ -8336,8 +8350,6 @@ static struct image_type gs_type =
static void
gs_clear_image (struct frame *f, struct image *img)
{
- /* IMG->data.ptr_val may contain a recorded colormap. */
- xfree (img->data.ptr_val);
x_clear_image (f, img);
}
@@ -8446,12 +8458,12 @@ gs_load (struct frame *f, struct image *img)
if (NILP (loader))
loader = intern ("gs-load-image");
- img->data.lisp_val = call6 (loader, frame, img->spec,
- make_number (img->width),
- make_number (img->height),
- window_and_pixmap_id,
- pixel_colors);
- return PROCESSP (img->data.lisp_val);
+ img->lisp_data = call6 (loader, frame, img->spec,
+ make_number (img->width),
+ make_number (img->height),
+ window_and_pixmap_id,
+ pixel_colors);
+ return PROCESSP (img->lisp_data);
}
@@ -8479,9 +8491,9 @@ 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->data.lisp_val));
- Fkill_process (img->data.lisp_val, Qnil);
- img->data.lisp_val = Qnil;
+ xassert (PROCESSP (img->lisp_data));
+ Fkill_process (img->lisp_data, Qnil);
+ img->lisp_data = Qnil;
#if defined (HAVE_X_WINDOWS)
@@ -8609,6 +8621,10 @@ of `dynamic-library-alist', which see). */)
return XCDR (tested);
#endif
+ /* Types pbm and xbm are built-in and always available. */
+ if (EQ (type, Qpbm) || EQ (type, Qxbm))
+ return Qt;
+
#if defined (HAVE_XPM) || defined (HAVE_NS)
if (EQ (type, Qxpm))
return CHECK_LIB_AVAILABLE (&xpm_type, init_xpm_functions, libraries);
@@ -8641,10 +8657,8 @@ of `dynamic-library-alist', which see). */)
#if defined (HAVE_IMAGEMAGICK)
if (EQ (type, Qimagemagick))
- {
- return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
- libraries);
- }
+ return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
+ libraries);
#endif
#ifdef HAVE_GHOSTSCRIPT
@@ -8685,75 +8699,49 @@ 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);
- Qpbm = intern_c_string ("pbm");
- staticpro (&Qpbm);
+ DEFSYM (Qpbm, "pbm");
ADD_IMAGE_TYPE (Qpbm);
- Qxbm = intern_c_string ("xbm");
- staticpro (&Qxbm);
+ DEFSYM (Qxbm, "xbm");
ADD_IMAGE_TYPE (Qxbm);
define_image_type (&xbm_type, 1);
define_image_type (&pbm_type, 1);
- Qcount = intern_c_string ("count");
- staticpro (&Qcount);
- Qextension_data = intern_c_string ("extension-data");
- staticpro (&Qextension_data);
-
- QCascent = intern_c_string (":ascent");
- staticpro (&QCascent);
- QCmargin = intern_c_string (":margin");
- staticpro (&QCmargin);
- QCrelief = intern_c_string (":relief");
- staticpro (&QCrelief);
- QCconversion = intern_c_string (":conversion");
- staticpro (&QCconversion);
- QCcolor_symbols = intern_c_string (":color-symbols");
- staticpro (&QCcolor_symbols);
- QCheuristic_mask = intern_c_string (":heuristic-mask");
- staticpro (&QCheuristic_mask);
- QCindex = intern_c_string (":index");
- staticpro (&QCindex);
- QCgeometry = intern_c_string (":geometry");
- staticpro (&QCgeometry);
- QCcrop = intern_c_string (":crop");
- staticpro (&QCcrop);
- QCrotation = intern_c_string (":rotation");
- staticpro (&QCrotation);
- QCmatrix = intern_c_string (":matrix");
- staticpro (&QCmatrix);
- QCcolor_adjustment = intern_c_string (":color-adjustment");
- staticpro (&QCcolor_adjustment);
- QCmask = intern_c_string (":mask");
- staticpro (&QCmask);
-
- Qlaplace = intern_c_string ("laplace");
- staticpro (&Qlaplace);
- Qemboss = intern_c_string ("emboss");
- staticpro (&Qemboss);
- Qedge_detection = intern_c_string ("edge-detection");
- staticpro (&Qedge_detection);
- Qheuristic = intern_c_string ("heuristic");
- staticpro (&Qheuristic);
-
- Qpostscript = intern_c_string ("postscript");
- staticpro (&Qpostscript);
+ DEFSYM (Qcount, "count");
+ DEFSYM (Qextension_data, "extension-data");
+ DEFSYM (Qdelay, "delay");
+
+ DEFSYM (QCascent, ":ascent");
+ DEFSYM (QCmargin, ":margin");
+ DEFSYM (QCrelief, ":relief");
+ DEFSYM (QCconversion, ":conversion");
+ DEFSYM (QCcolor_symbols, ":color-symbols");
+ DEFSYM (QCheuristic_mask, ":heuristic-mask");
+ DEFSYM (QCindex, ":index");
+ DEFSYM (QCgeometry, ":geometry");
+ DEFSYM (QCcrop, ":crop");
+ DEFSYM (QCrotation, ":rotation");
+ DEFSYM (QCmatrix, ":matrix");
+ DEFSYM (QCcolor_adjustment, ":color-adjustment");
+ DEFSYM (QCmask, ":mask");
+
+ DEFSYM (Qlaplace, "laplace");
+ DEFSYM (Qemboss, "emboss");
+ DEFSYM (Qedge_detection, "edge-detection");
+ DEFSYM (Qheuristic, "heuristic");
+
+ DEFSYM (Qpostscript, "postscript");
#ifdef HAVE_GHOSTSCRIPT
ADD_IMAGE_TYPE (Qpostscript);
- QCloader = intern_c_string (":loader");
- staticpro (&QCloader);
- QCbounding_box = intern_c_string (":bounding-box");
- staticpro (&QCbounding_box);
- QCpt_width = intern_c_string (":pt-width");
- staticpro (&QCpt_width);
- QCpt_height = intern_c_string (":pt-height");
- staticpro (&QCpt_height);
+ DEFSYM (QCloader, ":loader");
+ DEFSYM (QCbounding_box, ":bounding-box");
+ DEFSYM (QCpt_width, ":pt-width");
+ DEFSYM (QCpt_height, ":pt-height");
#endif /* HAVE_GHOSTSCRIPT */
#ifdef HAVE_NTGUI
- Qlibpng_version = intern_c_string ("libpng-version");
- staticpro (&Qlibpng_version);
+ DEFSYM (Qlibpng_version, "libpng-version");
Fset (Qlibpng_version,
#if HAVE_PNG
make_number (PNG_LIBPNG_VER)
@@ -8764,53 +8752,43 @@ non-numeric, there is no explicit limit on the size of images. */);
#endif
#if defined (HAVE_XPM) || defined (HAVE_NS)
- Qxpm = intern_c_string ("xpm");
- staticpro (&Qxpm);
+ DEFSYM (Qxpm, "xpm");
ADD_IMAGE_TYPE (Qxpm);
#endif
#if defined (HAVE_JPEG) || defined (HAVE_NS)
- Qjpeg = intern_c_string ("jpeg");
- staticpro (&Qjpeg);
+ DEFSYM (Qjpeg, "jpeg");
ADD_IMAGE_TYPE (Qjpeg);
#endif
#if defined (HAVE_TIFF) || defined (HAVE_NS)
- Qtiff = intern_c_string ("tiff");
- staticpro (&Qtiff);
+ DEFSYM (Qtiff, "tiff");
ADD_IMAGE_TYPE (Qtiff);
#endif
#if defined (HAVE_GIF) || defined (HAVE_NS)
- Qgif = intern_c_string ("gif");
- staticpro (&Qgif);
+ DEFSYM (Qgif, "gif");
ADD_IMAGE_TYPE (Qgif);
#endif
#if defined (HAVE_PNG) || defined (HAVE_NS)
- Qpng = intern_c_string ("png");
- staticpro (&Qpng);
+ DEFSYM (Qpng, "png");
ADD_IMAGE_TYPE (Qpng);
#endif
#if defined (HAVE_IMAGEMAGICK)
- Qimagemagick = intern_c_string ("imagemagick");
- staticpro (&Qimagemagick);
+ DEFSYM (Qimagemagick, "imagemagick");
ADD_IMAGE_TYPE (Qimagemagick);
#endif
#if defined (HAVE_RSVG)
- Qsvg = intern_c_string ("svg");
- staticpro (&Qsvg);
+ DEFSYM (Qsvg, "svg");
ADD_IMAGE_TYPE (Qsvg);
#ifdef HAVE_NTGUI
/* Other libraries used directly by svg code. */
- Qgdk_pixbuf = intern_c_string ("gdk-pixbuf");
- staticpro (&Qgdk_pixbuf);
- Qglib = intern_c_string ("glib");
- staticpro (&Qglib);
- Qgobject = intern_c_string ("gobject");
- staticpro (&Qgobject);
+ DEFSYM (Qgdk_pixbuf, "gdk-pixbuf");
+ DEFSYM (Qglib, "glib");
+ DEFSYM (Qgobject, "gobject");
#endif /* HAVE_NTGUI */
#endif /* HAVE_RSVG */
diff --git a/src/indent.c b/src/indent.c
index a73284c6657..c36b83daa02 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -318,6 +318,15 @@ invalidate_current_column (void)
last_known_column_point = 0;
}
+/* Return a non-outlandish value for the tab width. */
+
+static int
+sane_tab_width (void)
+{
+ EMACS_INT n = XFASTINT (BVAR (current_buffer, tab_width));
+ return 0 < n && n <= 1000 ? n : 8;
+}
+
EMACS_INT
current_column (void)
{
@@ -326,7 +335,7 @@ current_column (void)
register int tab_seen;
EMACS_INT post_tab;
register int c;
- register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
+ int tab_width = sane_tab_width ();
int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
register struct Lisp_Char_Table *dp = buffer_display_table ();
@@ -356,9 +365,6 @@ current_column (void)
else
stop = GAP_END_ADDR;
- if (tab_width <= 0 || tab_width > 1000)
- tab_width = 8;
-
col = 0, tab_seen = 0, post_tab = 0;
while (1)
@@ -509,7 +515,7 @@ check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
static void
scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
{
- register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
+ int tab_width = sane_tab_width ();
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));
@@ -535,7 +541,6 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
w = ! NILP (window) ? XWINDOW (window) : NULL;
- if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
memset (&cmp_it, 0, sizeof cmp_it);
cmp_it.id = -1;
composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil);
@@ -720,15 +725,14 @@ current_column_1 (void)
If END is nil, that stands for the end of STRING. */
static double
-string_display_width (string, beg, end)
- Lisp_Object string, beg, end;
+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 post_tab;
register int c;
- register int tab_width = XINT (current_buffer->tab_width);
+ int tab_width = sane_tab_width ();
int ctl_arrow = !NILP (current_buffer->ctl_arrow);
register struct Lisp_Char_Table *dp = buffer_display_table ();
int b, e;
@@ -755,8 +759,6 @@ string_display_width (string, beg, end)
going backwards from point. */
stop = SDATA (string) + b;
- if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
-
col = 0, tab_seen = 0, post_tab = 0;
while (1)
@@ -806,7 +808,7 @@ The return value is COLUMN. */)
{
EMACS_INT mincol;
register EMACS_INT fromcol;
- register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
+ int tab_width = sane_tab_width ();
CHECK_NUMBER (column);
if (NILP (minimum))
@@ -820,8 +822,6 @@ The return value is COLUMN. */)
if (fromcol == mincol)
return make_number (mincol);
- if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
-
if (indent_tabs_mode)
{
Lisp_Object n;
@@ -867,15 +867,13 @@ static EMACS_INT
position_indentation (register int pos_byte)
{
register EMACS_INT column = 0;
- register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
+ int tab_width = sane_tab_width ();
register unsigned char *p;
register unsigned char *stop;
unsigned char *start;
EMACS_INT next_boundary_byte = pos_byte;
EMACS_INT ceiling = next_boundary_byte;
- if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
-
p = BYTE_POS_ADDR (pos_byte);
/* STOP records the value of P at which we will need
to think about the gap, or about invisible text,
@@ -1102,8 +1100,8 @@ static struct position val_compute_motion;
WINDOW_HAS_VERTICAL_SCROLL_BAR (window)
and frame_cols = FRAME_COLS (XFRAME (window->frame))
- Or you can let window_box_text_cols do this all for you, and write:
- window_box_text_cols (w) - 1
+ Or you can let window_body_cols do this all for you, and write:
+ window_body_cols (w) - 1
The `-1' accounts for the continuation-line backslashes; the rest
accounts for window borders if the window is split horizontally, and
@@ -1118,7 +1116,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
register EMACS_INT pos;
EMACS_INT pos_byte;
register int c = 0;
- register EMACS_INT tab_width = XFASTINT (BVAR (current_buffer, tab_width));
+ int tab_width = sane_tab_width ();
register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
register struct Lisp_Char_Table *dp = window_display_table (win);
EMACS_INT selective
@@ -1173,13 +1171,10 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
run cache, because that's based on the buffer's display table. */
width_table = 0;
- if (tab_width <= 0 || tab_width > 1000)
- tab_width = 8;
-
/* Negative width means use all available text columns. */
if (width < 0)
{
- width = window_box_text_cols (win);
+ width = window_body_cols (win);
/* We must make room for continuation marks if we don't have fringes. */
#ifdef HAVE_WINDOW_SYSTEM
if (!FRAME_WINDOW_P (XFRAME (win->frame)))
@@ -1747,7 +1742,7 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
struct window *w;
Lisp_Object bufpos, hpos, vpos, prevhpos;
struct position *pos;
- int hscroll, tab_offset;
+ EMACS_INT hscroll, tab_offset;
CHECK_NUMBER_COERCE_MARKER (from);
CHECK_CONS (frompos);
@@ -1792,7 +1787,7 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
? window_internal_height (w)
: XINT (XCDR (topos))),
(NILP (topos)
- ? (window_box_text_cols (w)
+ ? (window_body_cols (w)
- (
#ifdef HAVE_WINDOW_SYSTEM
FRAME_WINDOW_P (XFRAME (w->frame)) ? 0 :
@@ -1990,7 +1985,8 @@ whether or not it is currently displayed in some window. */)
struct text_pos pt;
struct window *w;
Lisp_Object old_buffer;
- struct gcpro gcpro1;
+ EMACS_INT old_charpos, old_bytepos;
+ struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object lcols = Qnil;
double cols IF_LINT (= 0);
void *itdata = NULL;
@@ -2011,12 +2007,16 @@ whether or not it is currently displayed in some window. */)
w = XWINDOW (window);
old_buffer = Qnil;
- GCPRO1 (old_buffer);
+ GCPRO3 (old_buffer, old_charpos, old_bytepos);
if (XBUFFER (w->buffer) != current_buffer)
{
/* Set the window's buffer temporarily to the current buffer. */
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));
}
if (noninteractive)
@@ -2139,7 +2139,10 @@ whether or not it is currently displayed in some window. */)
}
if (BUFFERP (old_buffer))
- w->buffer = old_buffer;
+ {
+ w->buffer = old_buffer;
+ set_marker_both (w->pointm, w->buffer, old_charpos, old_bytepos);
+ }
RETURN_UNGCPRO (make_number (it.vpos));
}
diff --git a/src/insdel.c b/src/insdel.c
index 2662858c2a1..0cae578925d 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -20,6 +20,9 @@ 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"
@@ -41,12 +44,6 @@ static void insert_from_buffer_1 (struct buffer *buf,
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 void adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
- int before_markers);
-static void adjust_markers_for_replace (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, EMACS_INT);
-static void adjust_point (EMACS_INT nchars, EMACS_INT nbytes);
static Lisp_Object Fcombine_after_change_execute (void);
@@ -388,6 +385,12 @@ adjust_markers_for_replace (EMACS_INT from, EMACS_INT from_byte,
}
+void
+buffer_overflow (void)
+{
+ error ("Maximum buffer size exceeded");
+}
+
/* Make the gap NBYTES_ADDED bytes longer. */
static void
@@ -397,16 +400,16 @@ make_gap_larger (EMACS_INT nbytes_added)
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;
+ enum { enough_for_a_while = 2000 };
- /* If we have to get more space, get enough to last a while. */
- nbytes_added += 2000;
+ if (BUF_BYTES_MAX - current_size < nbytes_added)
+ buffer_overflow ();
- { EMACS_INT total_size = Z_BYTE - BEG_BYTE + GAP_SIZE + nbytes_added;
- if (total_size < 0
- /* Don't allow a buffer size that won't fit in a Lisp integer. */
- || total_size != XINT (make_number (total_size)))
- error ("Buffer exceeds maximum size");
- }
+ /* If we have to get more space, get enough to last a while;
+ but do not exceed the maximum buffer size. */
+ nbytes_added = min (nbytes_added + enough_for_a_while,
+ BUF_BYTES_MAX - current_size);
enlarge_buffer_text (current_buffer, nbytes_added);
@@ -567,32 +570,6 @@ copy_text (const unsigned char *from_addr, unsigned char *to_addr,
return to_addr - initial_to_addr;
}
}
-
-/* Return the number of bytes it would take
- to convert some single-byte text to multibyte.
- The single-byte text consists of NBYTES bytes at PTR. */
-
-EMACS_INT
-count_size_as_multibyte (const unsigned char *ptr, EMACS_INT nbytes)
-{
- EMACS_INT i;
- EMACS_INT outgoing_nbytes = 0;
-
- for (i = 0; i < nbytes; i++)
- {
- unsigned int c = *ptr++;
-
- if (ASCII_CHAR_P (c))
- outgoing_nbytes++;
- else
- {
- c = BYTE8_TO_CHAR (c);
- outgoing_nbytes += CHAR_BYTES (c);
- }
- }
-
- return outgoing_nbytes;
-}
/* Insert a string of specified length before point.
This function judges multibyteness based on
@@ -1086,7 +1063,6 @@ static void
insert_from_buffer_1 (struct buffer *buf,
EMACS_INT from, EMACS_INT nchars, int inherit)
{
- register Lisp_Object temp;
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);
@@ -1125,11 +1101,6 @@ insert_from_buffer_1 (struct buffer *buf,
outgoing_nbytes = outgoing_before_gap + outgoing_after_gap;
}
- /* Make sure point-max won't overflow after this insertion. */
- XSETINT (temp, outgoing_nbytes + Z);
- if (outgoing_nbytes + Z != XINT (temp))
- error ("Maximum buffer size exceeded");
-
/* Do this before moving and increasing the gap,
because the before-change hooks might move the gap
or make it smaller. */
@@ -1326,7 +1297,6 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
EMACS_INT insbytes = SBYTES (new);
EMACS_INT from_byte, to_byte;
EMACS_INT nbytes_del, nchars_del;
- register Lisp_Object temp;
struct gcpro gcpro1;
INTERVAL intervals;
EMACS_INT outgoing_insbytes = insbytes;
@@ -1370,11 +1340,6 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
outgoing_insbytes
= count_size_as_multibyte (SDATA (new), insbytes);
- /* Make sure point-max won't overflow after this insertion. */
- XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
- if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
- error ("Maximum buffer size exceeded");
-
GCPRO1 (new);
/* Make sure the gap is somewhere in or next to what we are deleting. */
@@ -1406,8 +1371,8 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- if (GAP_SIZE < insbytes)
- make_gap (insbytes - GAP_SIZE);
+ if (GAP_SIZE < outgoing_insbytes)
+ make_gap (outgoing_insbytes - GAP_SIZE);
/* Copy the string text into the buffer, perhaps converting
between single-byte and multibyte. */
@@ -1505,7 +1470,6 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
int markers)
{
EMACS_INT nbytes_del, nchars_del;
- Lisp_Object temp;
CHECK_MARKERS ();
@@ -1515,11 +1479,6 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
if (nbytes_del <= 0 && insbytes == 0)
return;
- /* Make sure point-max won't overflow after this insertion. */
- XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
- if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
- error ("Maximum buffer size exceeded");
-
/* Make sure the gap is somewhere in or next to what we are deleting. */
if (from > GPT)
gap_right (from, from_byte);
@@ -2260,8 +2219,7 @@ syms_of_insdel (void)
This affects `before-change-functions' and `after-change-functions',
as well as hooks attached to text properties and overlays. */);
inhibit_modification_hooks = 0;
- Qinhibit_modification_hooks = intern_c_string ("inhibit-modification-hooks");
- staticpro (&Qinhibit_modification_hooks);
+ DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks");
defsubr (&Scombine_after_change_execute);
}
diff --git a/src/intervals.c b/src/intervals.c
index e72bc146d16..2063655cdb9 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -247,8 +247,7 @@ static int zero_length;
INTERVAL search_interval, found_interval;
void
-check_for_interval (i)
- register INTERVAL i;
+check_for_interval (INTERVAL i)
{
if (i == search_interval)
{
@@ -258,8 +257,7 @@ check_for_interval (i)
}
INTERVAL
-search_for_interval (i, tree)
- register INTERVAL i, tree;
+search_for_interval (INTERVAL i, INTERVAL tree)
{
icount = 0;
search_interval = i;
@@ -269,8 +267,7 @@ search_for_interval (i, tree)
}
static void
-inc_interval_count (i)
- INTERVAL i;
+inc_interval_count (INTERVAL i)
{
icount++;
if (LENGTH (i) == 0)
@@ -280,8 +277,7 @@ inc_interval_count (i)
}
int
-count_intervals (i)
- register INTERVAL i;
+count_intervals (INTERVAL i)
{
icount = 0;
idepth = 0;
@@ -292,8 +288,7 @@ count_intervals (i)
}
static INTERVAL
-root_interval (interval)
- INTERVAL interval;
+root_interval (INTERVAL interval)
{
register INTERVAL i = interval;
@@ -313,7 +308,7 @@ root_interval (interval)
c c
*/
-static INLINE INTERVAL
+static inline INTERVAL
rotate_right (INTERVAL interval)
{
INTERVAL i;
@@ -360,7 +355,7 @@ rotate_right (INTERVAL interval)
c c
*/
-static INLINE INTERVAL
+static inline INTERVAL
rotate_left (INTERVAL interval)
{
INTERVAL i;
@@ -438,7 +433,7 @@ balance_an_interval (INTERVAL i)
/* Balance INTERVAL, potentially stuffing it back into its parent
Lisp Object. */
-static INLINE INTERVAL
+static inline INTERVAL
balance_possible_root_interval (register INTERVAL interval)
{
Lisp_Object parent;
@@ -804,9 +799,8 @@ update_interval (register INTERVAL i, EMACS_INT pos)
to the root. */
static INTERVAL
-adjust_intervals_for_insertion (tree, position, length)
- INTERVAL tree;
- EMACS_INT position, length;
+adjust_intervals_for_insertion (INTERVAL tree, EMACS_INT position,
+ EMACS_INT length)
{
register EMACS_INT relative_position;
register INTERVAL this;
@@ -1425,10 +1419,15 @@ 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. */
+ of LENGTH.
-INLINE void
-offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT 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. */
+
+static inline void
+static_offset_intervals (struct buffer *buffer, EMACS_INT start,
+ EMACS_INT length)
{
if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
return;
@@ -1441,6 +1440,12 @@ offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
adjust_intervals_for_deletion (buffer, start, -length);
}
}
+
+inline void
+offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
+{
+ static_offset_intervals (buffer, start, length);
+}
/* Merge interval I with its lexicographic successor. The resulting
interval is returned, and has the properties of the original
@@ -1604,9 +1609,7 @@ reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
interval. */
static INTERVAL
-make_new_interval (intervals, start, length)
- INTERVAL intervals;
- EMACS_INT start, length;
+make_new_interval (INTERVAL intervals, EMACS_INT start, EMACS_INT length)
{
INTERVAL slot;
@@ -1883,7 +1886,7 @@ lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop
/* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
byte position BYTEPOS. */
-INLINE void
+inline void
temp_set_point_both (struct buffer *buffer,
EMACS_INT charpos, EMACS_INT bytepos)
{
@@ -1903,7 +1906,7 @@ temp_set_point_both (struct buffer *buffer,
/* Set point "temporarily", without checking any text properties. */
-INLINE void
+inline void
temp_set_point (struct buffer *buffer, EMACS_INT charpos)
{
temp_set_point_both (buffer, charpos,
@@ -2392,7 +2395,7 @@ copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length)
/* Give STRING the properties of BUFFER from POSITION to LENGTH. */
-INLINE void
+inline void
copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
EMACS_INT position, EMACS_INT length)
{
diff --git a/src/keyboard.c b/src/keyboard.c
index ad4fd079049..16300e6154c 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -238,7 +238,7 @@ Lisp_Object internal_last_event_frame;
/* The timestamp of the last input event we received from the X server.
X Windows wants this for selection ownership. */
-unsigned long last_event_timestamp;
+Time last_event_timestamp;
static Lisp_Object Qx_set_selection, Qhandle_switch_frame;
Lisp_Object QPRIMARY;
@@ -448,7 +448,7 @@ static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
#endif
static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object,
Lisp_Object, const char *const *,
- Lisp_Object *, unsigned);
+ Lisp_Object *, EMACS_INT);
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
static int help_char_p (Lisp_Object);
static void save_getcjmp (jmp_buf);
@@ -1539,7 +1539,18 @@ command_loop_1 (void)
message_with_string ("%s is undefined", keys, 0);
KVAR (current_kboard, defining_kbd_macro) = Qnil;
update_mode_lines = 1;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ /* If this is a down-mouse event, don't reset prefix-arg;
+ pass it to the command run by the up event. */
+ if (EVENT_HAS_PARAMETERS (last_command_event))
+ {
+ Lisp_Object breakdown
+ = parse_modifiers (EVENT_HEAD (last_command_event));
+ int modifiers = XINT (XCAR (XCDR (breakdown)));
+ if (!(modifiers & down_modifier))
+ KVAR (current_kboard, Vprefix_arg) = Qnil;
+ }
+ else
+ KVAR (current_kboard, Vprefix_arg) = Qnil;
}
else
{
@@ -1901,7 +1912,7 @@ safe_run_hooks_error (Lisp_Object error_data)
}
static Lisp_Object
-safe_run_hook_funcall (size_t nargs, Lisp_Object *args)
+safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
{
eassert (nargs == 1);
if (CONSP (Vinhibit_quit))
@@ -2395,8 +2406,8 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event
c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
if (STRINGP (Vexecuting_kbd_macro)
- && (XINT (c) & 0x80) && (XUINT (c) <= 0xff))
- XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
+ && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff))
+ XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80));
executing_kbd_macro_index++;
@@ -2906,9 +2917,13 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event
goto exit;
if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
- && SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)) > (unsigned) XFASTINT (c))
+ && UNSIGNED_CMP (XFASTINT (c), <,
+ SCHARS (KVAR (current_kboard,
+ Vkeyboard_translate_table))))
|| (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
- && ASIZE (KVAR (current_kboard, Vkeyboard_translate_table)) > (unsigned) XFASTINT (c))
+ && UNSIGNED_CMP (XFASTINT (c), <,
+ ASIZE (KVAR (current_kboard,
+ Vkeyboard_translate_table))))
|| (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
&& CHARACTERP (c)))
{
@@ -2955,9 +2970,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event
save the echo area contents for it to refer to. */
if (INTEGERP (c)
&& ! NILP (Vinput_method_function)
- && (unsigned) XINT (c) >= ' '
- && (unsigned) XINT (c) != 127
- && (unsigned) XINT (c) < 256)
+ && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
{
previous_echo_area_message = Fcurrent_message ();
Vinput_method_previous_message = previous_echo_area_message;
@@ -2982,9 +2995,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event
/* Don't run the input method within a key sequence,
after the first event of the key sequence. */
&& NILP (prev_event)
- && (unsigned) XINT (c) >= ' '
- && (unsigned) XINT (c) != 127
- && (unsigned) XINT (c) < 256)
+ && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
{
Lisp_Object keys;
int key_count, key_count_reset;
@@ -3321,7 +3332,7 @@ record_char (Lisp_Object c)
if (INTEGERP (c))
{
if (XUINT (c) < 0x100)
- putc (XINT (c), dribble);
+ putc (XUINT (c), dribble);
else
fprintf (dribble, " 0x%"pI"x", XUINT (c));
}
@@ -3742,7 +3753,7 @@ kbd_buffer_events_waiting (int discard)
/* Clear input event EVENT. */
-static INLINE void
+static inline void
clear_event (struct input_event *event)
{
event->kind = NO_EVENT;
@@ -4085,7 +4096,7 @@ kbd_buffer_get_event (KBOARD **kbp,
Lisp_Object bar_window;
enum scroll_bar_part part;
Lisp_Object x, y;
- unsigned long t;
+ Time t;
*kbp = current_kboard;
/* Note that this uses F to determine which terminal to look at.
@@ -5088,7 +5099,7 @@ static Lisp_Object button_down_location;
static int last_mouse_button;
static int last_mouse_x;
static int last_mouse_y;
-static unsigned long button_down_time;
+static Time button_down_time;
/* The number of clicks in this multiple-click. */
@@ -5099,7 +5110,7 @@ static int double_click_count;
static Lisp_Object
make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
- unsigned long t)
+ Time t)
{
enum window_part part;
Lisp_Object posn = Qnil;
@@ -5391,7 +5402,7 @@ make_lispy_event (struct input_event *event)
Qfunction_key,
KVAR (current_kboard, Vsystem_key_alist),
0, &KVAR (current_kboard, system_key_syms),
- (unsigned) -1);
+ TYPE_MAXIMUM (EMACS_INT));
}
return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
@@ -5556,9 +5567,9 @@ make_lispy_event (struct input_event *event)
&& (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
&& button_down_time != 0
&& (EQ (Vdouble_click_time, Qt)
- || (INTEGERP (Vdouble_click_time)
- && ((int)(event->timestamp - button_down_time)
- < XINT (Vdouble_click_time)))));
+ || (NATNUMP (Vdouble_click_time)
+ && (event->timestamp - button_down_time
+ < XFASTINT (Vdouble_click_time)))));
}
last_mouse_button = button;
@@ -5742,9 +5753,9 @@ make_lispy_event (struct input_event *event)
&& (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
&& button_down_time != 0
&& (EQ (Vdouble_click_time, Qt)
- || (INTEGERP (Vdouble_click_time)
- && ((int)(event->timestamp - button_down_time)
- < XINT (Vdouble_click_time)))));
+ || (NATNUMP (Vdouble_click_time)
+ && (event->timestamp - button_down_time
+ < XFASTINT (Vdouble_click_time)))));
if (is_double)
{
double_click_count++;
@@ -5987,7 +5998,7 @@ make_lispy_event (struct input_event *event)
static Lisp_Object
make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_part part,
- Lisp_Object x, Lisp_Object y, unsigned long t)
+ Lisp_Object x, Lisp_Object y, Time t)
{
/* Is it a scroll bar movement? */
if (frame && ! NILP (bar_window))
@@ -6370,7 +6381,7 @@ reorder_modifiers (Lisp_Object symbol)
Lisp_Object parsed;
parsed = parse_modifiers (symbol);
- return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
+ return apply_modifiers (XFASTINT (XCAR (XCDR (parsed))),
XCAR (parsed));
}
@@ -6410,7 +6421,7 @@ reorder_modifiers (Lisp_Object symbol)
static Lisp_Object
modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind,
Lisp_Object name_alist_or_stem, const char *const *name_table,
- Lisp_Object *symbol_table, unsigned int table_size)
+ Lisp_Object *symbol_table, EMACS_INT table_size)
{
Lisp_Object value;
Lisp_Object symbol_int;
@@ -7470,7 +7481,7 @@ menu_bar_items (Lisp_Object old)
if (CONSP (def))
{
menu_bar_one_keymap_changed_items = Qnil;
- map_keymap (def, menu_bar_item, Qnil, NULL, 1);
+ map_keymap_canonical (def, menu_bar_item, Qnil, NULL);
}
}
@@ -7811,7 +7822,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
/* If we got no definition, this item is just unselectable text which
is OK in a submenu but not in the menubar. */
if (NILP (def))
- return (inmenubar ? 0 : 1);
+ return (!inmenubar);
/* See if this is a separate pane or a submenu. */
def = AREF (item_properties, ITEM_PROPERTY_DEF);
@@ -8225,7 +8236,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
/* `:label LABEL-STRING'. */
PROP (TOOL_BAR_ITEM_LABEL) = STRINGP (value)
? value
- : make_string (bad_label, strlen (bad_label));
+ : build_string (bad_label);
have_label = 1;
}
else if (EQ (ikey, QCfilter))
@@ -8291,7 +8302,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
else
label = "";
- new_lbl = Fupcase_initials (make_string (label, strlen (label)));
+ new_lbl = Fupcase_initials (build_string (label));
if (SCHARS (new_lbl) <= tool_bar_max_label_size)
PROP (TOOL_BAR_ITEM_LABEL) = new_lbl;
else
diff --git a/src/keyboard.h b/src/keyboard.h
index 1f5cbd23639..91008a3ea24 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -16,7 +16,7 @@ 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 "systime.h" /* for EMACS_TIME */
+#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
@@ -123,7 +123,7 @@ struct kboard
Lisp_Object *kbd_macro_end;
/* Allocated size of kbd_macro_buffer. */
- int kbd_macro_bufsize;
+ ptrdiff_t kbd_macro_bufsize;
/* Last anonymous kbd macro defined. */
Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro);
@@ -268,7 +268,9 @@ extern Lisp_Object menu_items;
/* If non-nil, means that the global vars defined here are already in use.
Used to detect cases where we try to re-enter this non-reentrant code. */
+#if defined USE_GTK || defined USE_MOTIF
extern Lisp_Object menu_items_inuse;
+#endif
/* Number of slots currently allocated in menu_items. */
extern int menu_items_allocated;
@@ -459,7 +461,7 @@ extern Lisp_Object Qevent_symbol_element_mask;
/* The timestamp of the last input event we received from the X server.
X Windows wants this for selection ownership. */
-extern unsigned long last_event_timestamp;
+extern Time last_event_timestamp;
extern int quit_char;
diff --git a/src/keymap.c b/src/keymap.c
index 79481833bde..0169276bef9 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -16,6 +16,27 @@ 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/>. */
+/* Old BUGS:
+ - [M-C-a] != [?\M-\C-a]
+ - [M-f2] != [?\e f2].
+ - (define-key map [menu-bar foo] <bla>) does not always place <bla>
+ at the head of the menu (if `foo' was already bound earlier and
+ then unbound, for example).
+ TODO:
+ - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak)
+ - Think about the various defaulting that's currently hard-coded in
+ keyboard.c (uppercase->lowercase, char->charset, button-events, ...)
+ and make it more generic. Maybe we should allow mappings of the
+ form (PREDICATE . BINDING) as generalization of the default binding,
+ tho probably a cleaner way to attack this is to allow functional
+ keymaps (i.e. keymaps that are implemented as functions that implement
+ a few different methods like `lookup', `map', ...).
+ - Make [a] equivalent to [?a].
+ BEWARE:
+ - map-keymap should work meaningfully even if entries are added/removed
+ to the keymap while iterating through it:
+ start - removed <= visited <= start + added
+ */
#include <config.h>
#include <stdio.h>
@@ -73,7 +94,6 @@ 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 void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
static void describe_command (Lisp_Object, Lisp_Object);
@@ -130,6 +150,17 @@ in case you use it as a menu with `x-popup-menu'. */)
return Fcons (Qkeymap, Qnil);
}
+DEFUN ("make-composed-keymap", Fmake_composed_keymap, Smake_composed_keymap,
+ 0, MANY, 0,
+ doc: /* Construct and return a new keymap composed of KEYMAPS.
+When looking up a key in the returned map, the key is looked in each
+keymap in turn until a binding is found.
+usage: (make-composed-keymap &rest KEYMAPS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ return Fcons (Qkeymap, Flist (nargs, args));
+}
+
/* This function is used for installing the standard key bindings
at initialization time.
@@ -174,6 +205,12 @@ when reading a key-sequence to be looked-up in this keymap. */)
Lisp_Object tem = XCAR (map);
if (STRINGP (tem))
return tem;
+ else if (KEYMAPP (tem))
+ {
+ tem = Fkeymap_prompt (tem);
+ if (!NILP (tem))
+ return tem;
+ }
map = XCDR (map);
}
return Qnil;
@@ -300,23 +337,16 @@ Return PARENT. PARENT should be nil or another keymap. */)
{
Lisp_Object list, prev;
struct gcpro gcpro1, gcpro2;
- int i;
- /* Force a keymap flush for the next call to where-is.
- Since this can be called from within where-is, we don't set where_is_cache
- directly but only where_is_cache_keymaps, since where_is_cache shouldn't
- be changed during where-is, while where_is_cache_keymaps is only used at
- the very beginning of where-is and can thus be changed here without any
- adverse effect.
- This is a very minor correctness (rather than safety) issue. */
- where_is_cache_keymaps = Qt;
+ /* Flush any reverse-map cache. */
+ where_is_cache = Qnil; where_is_cache_keymaps = Qt;
GCPRO2 (keymap, parent);
keymap = get_keymap (keymap, 1, 1);
if (!NILP (parent))
{
- parent = get_keymap (parent, 1, 1);
+ parent = get_keymap (parent, 1, 0);
/* Check for cycles. */
if (keymap_memberp (keymap, parent))
@@ -332,121 +362,35 @@ Return PARENT. PARENT should be nil or another keymap. */)
If we came to the end, add the parent in PREV. */
if (!CONSP (list) || KEYMAPP (list))
{
- /* If we already have the right parent, return now
- so that we avoid the loops below. */
- if (EQ (XCDR (prev), parent))
- RETURN_UNGCPRO (parent);
-
CHECK_IMPURE (prev);
XSETCDR (prev, parent);
- break;
+ RETURN_UNGCPRO (parent);
}
prev = list;
}
-
- /* Scan through for submaps, and set their parents too. */
-
- for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
- {
- /* Stop the scan when we come to the parent. */
- if (EQ (XCAR (list), Qkeymap))
- break;
-
- /* If this element holds a prefix map, deal with it. */
- if (CONSP (XCAR (list))
- && CONSP (XCDR (XCAR (list))))
- fix_submap_inheritance (keymap, XCAR (XCAR (list)),
- XCDR (XCAR (list)));
-
- if (VECTORP (XCAR (list)))
- for (i = 0; i < ASIZE (XCAR (list)); i++)
- if (CONSP (XVECTOR (XCAR (list))->contents[i]))
- fix_submap_inheritance (keymap, make_number (i),
- XVECTOR (XCAR (list))->contents[i]);
-
- if (CHAR_TABLE_P (XCAR (list)))
- {
- map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
- }
- }
-
- RETURN_UNGCPRO (parent);
-}
-
-/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
- if EVENT is also a prefix in MAP's parent,
- make sure that SUBMAP inherits that definition as its own parent. */
-
-static void
-fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap)
-{
- Lisp_Object map_parent, parent_entry;
-
- /* SUBMAP is a cons that we found as a key binding.
- Discard the other things found in a menu key binding. */
-
- submap = get_keymap (get_keyelt (submap, 0), 0, 0);
-
- /* If it isn't a keymap now, there's no work to do. */
- if (!CONSP (submap))
- return;
-
- map_parent = keymap_parent (map, 0);
- if (!NILP (map_parent))
- parent_entry =
- get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
- else
- parent_entry = Qnil;
-
- /* If MAP's parent has something other than a keymap,
- our own submap shadows it completely. */
- if (!CONSP (parent_entry))
- return;
-
- if (! EQ (parent_entry, submap))
- {
- Lisp_Object submap_parent;
- submap_parent = submap;
- while (1)
- {
- Lisp_Object tem;
-
- tem = keymap_parent (submap_parent, 0);
-
- if (KEYMAPP (tem))
- {
- if (keymap_memberp (tem, parent_entry))
- /* Fset_keymap_parent could create a cycle. */
- return;
- submap_parent = tem;
- }
- else
- break;
- }
- Fset_keymap_parent (submap_parent, parent_entry);
- }
}
+
/* Look up IDX in MAP. IDX may be any sort of event.
Note that this does only one level of lookup; IDX must be a single
event, not a sequence.
+ MAP must be a keymap or a list of keymaps.
+
If T_OK is non-zero, 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 NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
+ If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
-Lisp_Object
-access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
-{
- Lisp_Object val;
-
- /* Qunbound in VAL means we have found no binding yet. */
- val = Qunbound;
+ Returns Qunbound if no binding was found (and returns 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)
+{
/* If idx is a list (some sort of mouse click, perhaps?),
the index we want to use is the car of the list, which
ought to be a symbol. */
@@ -461,33 +405,33 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
with more than 24 bits of integer. */
XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
- /* Handle the special meta -> esc mapping. */
- if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
+ /* Handle the special meta -> esc mapping. */
+ if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier)
{
/* See if there is a meta-map. If there's none, there is
no binding for IDX, unless a default binding exists in MAP. */
struct gcpro gcpro1;
- Lisp_Object event_meta_map;
+ Lisp_Object event_meta_binding, event_meta_map;
GCPRO1 (map);
/* A strange value in which Meta is set would cause
infinite recursion. Protect against that. */
if (XINT (meta_prefix_char) & CHAR_META)
meta_prefix_char = make_number (27);
- event_meta_map = get_keymap (access_keymap (map, meta_prefix_char,
- t_ok, noinherit, autoload),
- 0, autoload);
+ event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
+ noinherit, autoload);
+ event_meta_map = get_keymap (event_meta_binding, 0, autoload);
UNGCPRO;
if (CONSP (event_meta_map))
{
map = event_meta_map;
- idx = make_number (XUINT (idx) & ~meta_modifier);
+ idx = make_number (XFASTINT (idx) & ~meta_modifier);
}
else if (t_ok)
/* Set IDX to t, so that we only find a default binding. */
idx = Qt;
else
- /* We know there is no binding. */
- return Qnil;
+ /* An explicit nil binding, or no binding at all. */
+ return NILP (event_meta_binding) ? Qnil : Qunbound;
}
/* t_binding is where we put a default binding that applies,
@@ -495,25 +439,52 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
for this key sequence. */
{
Lisp_Object tail;
- Lisp_Object t_binding = Qnil;
+ Lisp_Object t_binding = Qunbound;
+ Lisp_Object retval = Qunbound;
+ Lisp_Object retval_tail = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- GCPRO4 (map, tail, idx, t_binding);
+ GCPRO4 (tail, idx, t_binding, retval);
- for (tail = XCDR (map);
+ for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
(CONSP (tail)
|| (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
tail = XCDR (tail))
{
- Lisp_Object binding;
+ /* Qunbound in VAL means we have found no binding. */
+ Lisp_Object val = Qunbound;
+ Lisp_Object binding = XCAR (tail);
+ Lisp_Object submap = get_keymap (binding, 0, autoload);
- binding = XCAR (tail);
- if (SYMBOLP (binding))
+ if (EQ (binding, Qkeymap))
{
- /* If NOINHERIT, stop finding prefix definitions
- after we pass a second occurrence of the `keymap' symbol. */
- if (noinherit && EQ (binding, Qkeymap))
- RETURN_UNGCPRO (Qnil);
+ if (noinherit || NILP (retval))
+ /* If NOINHERIT, stop here, the rest is inherited. */
+ break;
+ else if (!EQ (retval, Qunbound))
+ {
+ Lisp_Object parent_entry;
+ eassert (KEYMAPP (retval));
+ parent_entry
+ = get_keymap (access_keymap_1 (tail, idx,
+ t_ok, 0, autoload),
+ 0, autoload);
+ if (KEYMAPP (parent_entry))
+ {
+ if (CONSP (retval_tail))
+ XSETCDR (retval_tail, parent_entry);
+ else
+ {
+ retval_tail = Fcons (retval, parent_entry);
+ retval = Fcons (Qkeymap, retval_tail);
+ }
+ }
+ break;
+ }
+ }
+ else if (CONSP (submap))
+ {
+ val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
}
else if (CONSP (binding))
{
@@ -529,7 +500,7 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
}
else if (VECTORP (binding))
{
- if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
+ if (INTEGERP (idx) && XFASTINT (idx) < ASIZE (binding))
val = AREF (binding, XFASTINT (idx));
}
else if (CHAR_TABLE_P (binding))
@@ -537,7 +508,7 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
/* Character codes with modifiers
are not included in a char-table.
All character codes without modifiers are included. */
- if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
+ if (INTEGERP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
{
val = Faref (binding, idx);
/* `nil' has a special meaning for char-tables, so
@@ -556,23 +527,47 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
(i.e. it shadows any parent binding but not bindings in
keymaps of lower precedence). */
val = Qnil;
+
val = get_keyelt (val, autoload);
- if (KEYMAPP (val))
- fix_submap_inheritance (map, idx, val);
- RETURN_UNGCPRO (val);
+
+ if (!KEYMAPP (val))
+ {
+ if (NILP (retval) || EQ (retval, Qunbound))
+ retval = val;
+ if (!NILP (val))
+ break; /* Shadows everything that follows. */
+ }
+ else if (NILP (retval) || EQ (retval, Qunbound))
+ retval = val;
+ else if (CONSP (retval_tail))
+ {
+ XSETCDR (retval_tail, Fcons (val, Qnil));
+ retval_tail = XCDR (retval_tail);
+ }
+ else
+ {
+ retval_tail = Fcons (val, Qnil);
+ retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
+ }
}
QUIT;
}
UNGCPRO;
- return get_keyelt (t_binding, autoload);
+ return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
}
}
+Lisp_Object
+access_keymap (Lisp_Object map, Lisp_Object idx,
+ int t_ok, int noinherit, int autoload)
+{
+ Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
+ return EQ (val, Qunbound) ? Qnil : val;
+}
+
static void
map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
{
- /* We should maybe try to detect bindings shadowed by previous
- ones and things like that. */
if (EQ (val, Qt))
val = Qnil;
(*fun) (key, val, args, data);
@@ -583,8 +578,8 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
{
if (!NILP (val))
{
- map_keymap_function_t fun =
- (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
+ map_keymap_function_t fun
+ = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
args = XCDR (args);
/* If the key is a range, make a copy since map_char_table modifies
it in place. */
@@ -612,7 +607,9 @@ map_keymap_internal (Lisp_Object map,
{
Lisp_Object binding = XCAR (tail);
- if (CONSP (binding))
+ if (KEYMAPP (binding)) /* An embedded parent. */
+ break;
+ else if (CONSP (binding))
map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
else if (VECTORP (binding))
{
@@ -644,7 +641,7 @@ map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
call2 (fun, key, val);
}
-/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
+/* Same as map_keymap_internal, but traverses parent keymaps as well.
A non-zero 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)
@@ -654,8 +651,15 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *
map = get_keymap (map, 1, autoload);
while (CONSP (map))
{
- map = map_keymap_internal (map, fun, args, data);
- map = get_keymap (map, 0, autoload);
+ if (KEYMAPP (XCAR (map)))
+ {
+ map_keymap (XCAR (map), fun, args, data, autoload);
+ map = XCDR (map);
+ }
+ else
+ map = map_keymap_internal (map, fun, args, data);
+ if (!CONSP (map))
+ map = get_keymap (map, 0, autoload);
}
UNGCPRO;
}
@@ -791,16 +795,10 @@ get_keyelt (Lisp_Object object, int autoload)
}
/* If the contents are (KEYMAP . ELEMENT), go indirect. */
+ else if (KEYMAPP (XCAR (object)))
+ error ("Wow, indirect keymap entry!!");
else
- {
- struct gcpro gcpro1;
- Lisp_Object map;
- GCPRO1 (object);
- map = get_keymap (Fcar_safe (object), 0, autoload);
- UNGCPRO;
- return (!CONSP (map) ? object /* Invalid keymap */
- : access_keymap (map, Fcdr (object), 0, 0, autoload));
- }
+ return object;
}
}
@@ -811,6 +809,9 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
where_is_cache = Qnil;
where_is_cache_keymaps = Qt;
+ if (EQ (idx, Qkeymap))
+ error ("`keymap' is reserved for embedded parent maps");
+
/* If we are preparing to dump, and DEF is a menu element
with a menu item indicator, copy it to ensure it is not pure. */
if (CONSP (def) && PURE_P (def)
@@ -903,7 +904,16 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
}
else if (CONSP (elt))
{
- if (EQ (idx, XCAR (elt)))
+ if (EQ (Qkeymap, XCAR (elt)))
+ { /* A sub keymap. This might be due to a lookup that found
+ two matching bindings (maybe because of a sub keymap).
+ It almost never happens (since the second binding normally
+ only happens in the inherited part of the keymap), but
+ if it does, we want to update the sub-keymap since the
+ main one might be temporary (built by access_keymap). */
+ tail = insertion_point = elt;
+ }
+ else if (EQ (idx, XCAR (elt)))
{
CHECK_IMPURE (elt);
XSETCDR (elt, def);
@@ -1068,7 +1078,13 @@ is not copied. */)
ASET (elt, i, copy_keymap_item (AREF (elt, i)));
}
else if (CONSP (elt))
- elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
+ {
+ if (EQ (XCAR (elt), Qkeymap))
+ /* This is a sub keymap. */
+ elt = Fcopy_keymap (elt);
+ else
+ elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
+ }
XSETCDR (tail, Fcons (elt, Qnil));
tail = XCDR (tail);
keymap = XCDR (keymap);
@@ -1234,23 +1250,15 @@ remapping in all currently active keymaps. */)
ASET (command_remapping_vector, 1, command);
if (NILP (keymaps))
- return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
+ command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
else
- {
- Lisp_Object maps, binding;
-
- for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
- {
- binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
- if (!NILP (binding) && !INTEGERP (binding))
- return binding;
- }
- return Qnil;
- }
+ command = Flookup_key (Fcons (Qkeymap, keymaps),
+ command_remapping_vector, Qnil);
+ return INTEGERP (command) ? Qnil : command;
}
/* Value is number if KEY is too long; nil if valid but has no definition. */
-/* GC is possible in this function if it autoloads a keymap. */
+/* GC is possible in this function. */
DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
@@ -1325,10 +1333,6 @@ define_as_prefix (Lisp_Object keymap, Lisp_Object c)
Lisp_Object cmd;
cmd = Fmake_sparse_keymap (Qnil);
- /* If this key is defined as a prefix in an inherited keymap,
- make it a prefix in this map, and make its definition
- inherit the other prefix definition. */
- cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
store_in_keymap (keymap, c, cmd);
return cmd;
@@ -1357,7 +1361,7 @@ silly_event_symbol_error (Lisp_Object c)
int modifiers;
parsed = parse_modifiers (c);
- modifiers = (int) XUINT (XCAR (XCDR (parsed)));
+ modifiers = XFASTINT (XCAR (XCDR (parsed)));
base = XCAR (parsed);
name = Fsymbol_name (base);
/* This alist includes elements such as ("RET" . "\\r"). */
@@ -1530,7 +1534,7 @@ like in the respective argument of `key-binding'. */)
{
int count = SPECPDL_INDEX ();
- Lisp_Object keymaps;
+ Lisp_Object keymaps = Fcons (current_global_map, Qnil);
/* If a mouse click position is given, our variables are based on
the buffer clicked on, not the current buffer. So we may have to
@@ -1560,12 +1564,11 @@ like in the respective argument of `key-binding'. */)
}
}
- keymaps = Fcons (current_global_map, Qnil);
-
if (!NILP (olp))
{
if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
- keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps);
+ keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map),
+ keymaps);
/* The doc said that overriding-terminal-local-map should
override overriding-local-map. The code used them both,
but it seems clearer to use just one. rms, jan 2005. */
@@ -1576,23 +1579,19 @@ like in the respective argument of `key-binding'. */)
{
Lisp_Object *maps;
int nmaps, i;
-
- Lisp_Object keymap, local_map;
- EMACS_INT pt;
-
- pt = INTEGERP (position) ? XINT (position)
+ EMACS_INT pt
+ = INTEGERP (position) ? XINT (position)
: MARKERP (position) ? marker_position (position)
: PT;
-
- /* Get the buffer local maps, possibly overriden by text or
- overlay properties */
-
- local_map = get_local_map (pt, current_buffer, Qlocal_map);
- keymap = get_local_map (pt, current_buffer, Qkeymap);
+ /* 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);
+ /* This returns nil unless there is a `keymap' property. */
+ Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap);
if (CONSP (position))
{
- Lisp_Object string;
+ Lisp_Object string = POSN_STRING (position);
/* For a mouse click, get the local text-property keymap
of the place clicked on, rather than point. */
@@ -1619,8 +1618,7 @@ like in the respective argument of `key-binding'. */)
consider `local-map' and `keymap' properties of
that string. */
- if (string = POSN_STRING (position),
- (CONSP (string) && STRINGP (XCAR (string))))
+ if (CONSP (string) && STRINGP (XCAR (string)))
{
Lisp_Object pos, map;
@@ -1691,12 +1689,7 @@ specified buffer position instead of point are used.
*/)
(Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
{
- Lisp_Object *maps, value;
- int nmaps, i;
- struct gcpro gcpro1, gcpro2;
- int count = SPECPDL_INDEX ();
-
- GCPRO2 (key, position);
+ Lisp_Object value;
if (NILP (position) && VECTORP (key))
{
@@ -1715,145 +1708,9 @@ specified buffer position instead of point are used.
}
}
- /* Key sequences beginning with mouse clicks
- are read using the keymaps of the buffer clicked on, not
- the current buffer. So we may have to switch the buffer
- here. */
-
- if (CONSP (position))
- {
- Lisp_Object window;
-
- window = POSN_WINDOW (position);
-
- if (WINDOWP (window)
- && BUFFERP (XWINDOW (window)->buffer)
- && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
- {
- /* Arrange to go back to the original buffer once we're done
- processing the key sequence. We don't use
- save_excursion_{save,restore} here, in analogy to
- `read-key-sequence' to avoid saving point. Maybe this
- would not be a problem here, but it is easier to keep
- things the same.
- */
-
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
-
- set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
- }
- }
-
- if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
- {
- value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map),
- key, accept_default);
- if (! NILP (value) && !INTEGERP (value))
- goto done;
- }
- else if (! NILP (Voverriding_local_map))
- {
- value = Flookup_key (Voverriding_local_map, key, accept_default);
- if (! NILP (value) && !INTEGERP (value))
- goto done;
- }
- else
- {
- Lisp_Object keymap, local_map;
- EMACS_INT pt;
-
- pt = INTEGERP (position) ? XINT (position)
- : MARKERP (position) ? marker_position (position)
- : PT;
-
- local_map = get_local_map (pt, current_buffer, Qlocal_map);
- keymap = get_local_map (pt, current_buffer, Qkeymap);
+ value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
+ key, accept_default);
- if (CONSP (position))
- {
- Lisp_Object string;
-
- /* For a mouse click, get the local text-property keymap
- of the place clicked on, rather than point. */
-
- if (POSN_INBUFFER_P (position))
- {
- Lisp_Object pos;
-
- pos = POSN_BUFFER_POSN (position);
- if (INTEGERP (pos)
- && XINT (pos) >= BEG && XINT (pos) <= Z)
- {
- local_map = get_local_map (XINT (pos),
- current_buffer, Qlocal_map);
-
- keymap = get_local_map (XINT (pos),
- current_buffer, Qkeymap);
- }
- }
-
- /* If on a mode line string with a local keymap,
- or for a click on a string, i.e. overlay string or a
- string displayed via the `display' property,
- consider `local-map' and `keymap' properties of
- that string. */
-
- if (string = POSN_STRING (position),
- (CONSP (string) && STRINGP (XCAR (string))))
- {
- Lisp_Object pos, map;
-
- pos = XCDR (string);
- string = XCAR (string);
- if (INTEGERP (pos)
- && XINT (pos) >= 0
- && XINT (pos) < SCHARS (string))
- {
- map = Fget_text_property (pos, Qlocal_map, string);
- if (!NILP (map))
- local_map = map;
-
- map = Fget_text_property (pos, Qkeymap, string);
- if (!NILP (map))
- keymap = map;
- }
- }
-
- }
-
- if (! NILP (keymap))
- {
- value = Flookup_key (keymap, key, accept_default);
- if (! NILP (value) && !INTEGERP (value))
- goto done;
- }
-
- nmaps = current_minor_maps (0, &maps);
- /* Note that all these maps are GCPRO'd
- in the places where we found them. */
-
- for (i = 0; i < nmaps; i++)
- if (! NILP (maps[i]))
- {
- value = Flookup_key (maps[i], key, accept_default);
- if (! NILP (value) && !INTEGERP (value))
- goto done;
- }
-
- if (! NILP (local_map))
- {
- value = Flookup_key (local_map, key, accept_default);
- if (! NILP (value) && !INTEGERP (value))
- goto done;
- }
- }
-
- value = Flookup_key (current_global_map, key, accept_default);
-
- done:
- unbind_to (count, Qnil);
-
- UNGCPRO;
if (NILP (value) || INTEGERP (value))
return Qnil;
@@ -2416,7 +2273,7 @@ around function keys and event symbols. */)
{
char tem[KEY_DESCRIPTION_SIZE];
- *push_key_description (XUINT (key), tem, 1) = 0;
+ *push_key_description (XINT (key), tem, 1) = 0;
return build_string (tem);
}
else if (SYMBOLP (key)) /* Function key or event-symbol */
@@ -2515,7 +2372,7 @@ preferred_sequence_p (Lisp_Object seq)
return 0;
else
{
- int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
+ int modifiers = XINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
if (modifiers == where_is_preferred_modifier)
result = 2;
else if (modifiers)
@@ -3094,9 +2951,11 @@ You type Translation\n\
to look through.
If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
- don't omit it; instead, mention it but say it is shadowed. */
+ don't omit it; instead, mention it but say it is shadowed.
-void
+ Return whether something was inserted or not. */
+
+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)
@@ -3206,10 +3065,8 @@ key binding\n\
skip: ;
}
- if (something)
- insert_string ("\n");
-
UNGCPRO;
+ return something;
}
static int previous_description_column;
@@ -3774,15 +3631,13 @@ Return list of symbols found. */)
void
syms_of_keymap (void)
{
- Qkeymap = intern_c_string ("keymap");
- staticpro (&Qkeymap);
+ DEFSYM (Qkeymap, "keymap");
staticpro (&apropos_predicate);
staticpro (&apropos_accumulate);
apropos_predicate = Qnil;
apropos_accumulate = Qnil;
- Qkeymap_canonicalize = intern_c_string ("keymap-canonicalize");
- staticpro (&Qkeymap_canonicalize);
+ DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize");
/* Now we are ready to set up this property, so we can
create char tables. */
@@ -3831,31 +3686,6 @@ don't alter it yourself. */);
Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
- DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map,
- doc: /* Local keymap for minibuffer input with completion. */);
- Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
- Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
-
- DEFVAR_LISP ("minibuffer-local-filename-completion-map",
- Vminibuffer_local_filename_completion_map,
- doc: /* Local keymap for minibuffer input with completion for filenames. */);
- Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
- Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
- Vminibuffer_local_completion_map);
-
-
- DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map,
- doc: /* Local keymap for minibuffer input with completion, for exact match. */);
- Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
- Fset_keymap_parent (Vminibuffer_local_must_match_map,
- Vminibuffer_local_completion_map);
-
- DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
- Vminibuffer_local_filename_must_match_map,
- doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
- Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
- Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
- Vminibuffer_local_must_match_map);
DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
doc: /* Alist of keymaps to use for minor modes.
@@ -3882,11 +3712,11 @@ the same way. The "active" keymaps in each alist are used before
Vemulation_mode_map_alists = Qnil;
DEFVAR_LISP ("where-is-preferred-modifier", Vwhere_is_preferred_modifier,
- doc: /* Preferred modifier to use for `where-is'.
+ doc: /* Preferred modifier key to use for `where-is'.
When a single binding is requested, `where-is' will return one that
-uses this modifier if possible. If nil, or if no such binding exists,
-bindings using keys without modifiers (or only with meta) will be
-preferred. */);
+uses this modifier key if possible. If nil, or if no such binding
+exists, bindings using keys without modifiers (or only with meta) will
+be preferred. */);
Vwhere_is_preferred_modifier = Qnil;
where_is_preferred_modifier = 0;
@@ -3902,27 +3732,13 @@ preferred. */);
pure_cons (intern_c_string ("mouse-5"),
Qnil)))))))));
-
- Qsingle_key_description = intern_c_string ("single-key-description");
- staticpro (&Qsingle_key_description);
-
- Qkey_description = intern_c_string ("key-description");
- staticpro (&Qkey_description);
-
- Qkeymapp = intern_c_string ("keymapp");
- staticpro (&Qkeymapp);
-
- Qnon_ascii = intern_c_string ("non-ascii");
- staticpro (&Qnon_ascii);
-
- Qmenu_item = intern_c_string ("menu-item");
- staticpro (&Qmenu_item);
-
- Qremap = intern_c_string ("remap");
- staticpro (&Qremap);
-
- QCadvertised_binding = intern_c_string (":advertised-binding");
- staticpro (&QCadvertised_binding);
+ DEFSYM (Qsingle_key_description, "single-key-description");
+ DEFSYM (Qkey_description, "key-description");
+ DEFSYM (Qkeymapp, "keymapp");
+ DEFSYM (Qnon_ascii, "non-ascii");
+ DEFSYM (Qmenu_item, "menu-item");
+ DEFSYM (Qremap, "remap");
+ DEFSYM (QCadvertised_binding, ":advertised-binding");
command_remapping_vector = Fmake_vector (make_number (2), Qremap);
staticpro (&command_remapping_vector);
@@ -3938,6 +3754,7 @@ preferred. */);
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
+ defsubr (&Smake_composed_keymap);
defsubr (&Smap_keymap_internal);
defsubr (&Smap_keymap);
defsubr (&Scopy_keymap);
diff --git a/src/keymap.h b/src/keymap.h
index 2b9d58b39dc..2c826b64e1f 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -36,8 +36,8 @@ 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 void describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object,
- const char *, int, int, int, int);
+extern int describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object,
+ const char *, int, int, int, int);
extern int 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 *);
diff --git a/src/lisp.h b/src/lisp.h
index 66f5c962be8..762d34abb9c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -23,6 +23,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdarg.h>
#include <stddef.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. */
@@ -58,6 +61,21 @@ extern void check_cons_list (void);
# define EMACS_UINT unsigned EMACS_INT
#endif
+/* Use pD to format ptrdiff_t values, which suffice for indexes into
+ buffers and strings. Emacs never allocates objects larger than
+ PTRDIFF_MAX bytes, as they cause problems with pointer subtraction.
+ In C99, pD can always be "t"; configure it here for the sake of
+ pre-C99 libraries such as glibc 2.0 and Solaris 8. */
+#if PTRDIFF_MAX == INT_MAX
+# define pD ""
+#elif PTRDIFF_MAX == LONG_MAX
+# define pD "l"
+#elif PTRDIFF_MAX == LLONG_MAX
+# define pD "ll"
+#else
+# define pD "t"
+#endif
+
/* Extra internal type checking? */
#ifdef ENABLE_CHECKING
@@ -273,7 +291,7 @@ union Lisp_Object
{
/* Used for comparing two Lisp_Objects;
also, positive integers can be accessed fast this way. */
- EMACS_UINT i;
+ EMACS_INT i;
struct
{
@@ -297,7 +315,7 @@ union Lisp_Object
{
/* Used for comparing two Lisp_Objects;
also, positive integers can be accessed fast this way. */
- EMACS_UINT i;
+ EMACS_INT i;
struct
{
@@ -317,7 +335,7 @@ Lisp_Object;
#endif /* WORDS_BIGENDIAN */
#ifdef __GNUC__
-static __inline__ Lisp_Object
+static inline Lisp_Object
LISP_MAKE_RVALUE (Lisp_Object o)
{
return o;
@@ -470,14 +488,14 @@ enum pvec_type
#define XHASH(a) ((a).i)
#define XTYPE(a) ((enum Lisp_Type) (a).u.type)
-#define XINT(a) ((a).s.val)
-#define XUINT(a) ((a).u.val)
+#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 ((((EMACS_UINT) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \
- (var).u.val = ((EMACS_UINT) (ptr)) >> GCTYPEBITS, \
+ (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
@@ -494,7 +512,7 @@ enum pvec_type
# define XSETFASTINT(a, b) ((a).i = (b))
# define XSET(var, vartype, ptr) \
- (((var).s.val = ((EMACS_INT) (ptr))), ((var).s.type = ((char) (vartype))))
+ (((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
@@ -525,30 +543,27 @@ extern Lisp_Object make_number (EMACS_INT);
#define EQ(x, y) (XHASH (x) == XHASH (y))
-/* Largest and smallest representable fixnum values. These are the C
- values. */
-
+/* Number of bits in a fixnum, including the sign bit. */
#ifdef USE_2_TAGS_FOR_INTS
-# define MOST_NEGATIVE_FIXNUM - ((EMACS_INT) 1 << VALBITS)
-# define MOST_POSITIVE_FIXNUM (((EMACS_INT) 1 << VALBITS) - 1)
-/* Mask indicating the significant bits of a Lisp_Int.
- I.e. (x & INTMASK) == XUINT (make_number (x)). */
-# define INTMASK ((((EMACS_INT) 1) << (VALBITS + 1)) - 1)
+# define FIXNUM_BITS (VALBITS + 1)
#else
-# define MOST_NEGATIVE_FIXNUM - ((EMACS_INT) 1 << (VALBITS - 1))
-# define MOST_POSITIVE_FIXNUM (((EMACS_INT) 1 << (VALBITS - 1)) - 1)
-/* Mask indicating the significant bits of a Lisp_Int.
- I.e. (x & INTMASK) == XUINT (make_number (x)). */
-# define INTMASK ((((EMACS_INT) 1) << VALBITS) - 1)
+# define FIXNUM_BITS VALBITS
#endif
+/* Mask indicating the significant bits of a fixnum. */
+#define INTMASK (((EMACS_INT) 1 << FIXNUM_BITS) - 1)
+
+/* Largest and smallest representable fixnum values. These are the C
+ values. */
+#define MOST_POSITIVE_FIXNUM (INTMASK / 2)
+#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
+
/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
written this way so that it also works if I is of unsigned
- type. */
+ type or if I is a NaN. */
#define FIXNUM_OVERFLOW_P(i) \
- ((i) > MOST_POSITIVE_FIXNUM \
- || ((i) < 0 && (i) < MOST_NEGATIVE_FIXNUM))
+ (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
/* Extract a value or address from a Lisp_Object. */
@@ -766,6 +781,20 @@ extern EMACS_INT string_bytes (struct Lisp_String *);
#endif /* not GC_CHECK_STRING_BYTES */
+/* An upper bound on the number of bytes in a Lisp string, not
+ counting the terminating null. This a tight enough bound to
+ prevent integer overflow errors that would otherwise occur during
+ string size calculations. A string cannot contain more bytes than
+ a fixnum can represent, nor can it be so long that C pointer
+ arithmetic stops working on the string plus its terminating null.
+ 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. */
+#define STRING_BYTES_BOUND \
+ min (MOST_POSITIVE_FIXNUM, (ptrdiff_t) min (SIZE_MAX, PTRDIFF_MAX) - 1)
+
/* Mark STR as a unibyte string. */
#define STRING_SET_UNIBYTE(STR) \
do { if (EQ (STR, empty_multibyte_string)) \
@@ -883,8 +912,18 @@ struct Lisp_Vector
#endif /* not __GNUC__ */
+/* Compute A OP B, using the unsigned comparison operator OP. A and B
+ should be integer expressions. This is not the same as
+ mathemeatical comparison; for example, UNSIGNED_CMP (0, <, -1)
+ returns 1. For efficiency, prefer plain unsigned comparison if A
+ and B's sizes both fit (after integer promotion). */
+#define UNSIGNED_CMP(a, op, b) \
+ (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \
+ ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \
+ : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0))
+
/* Nonzero iff C is an ASCII character. */
-#define ASCII_CHAR_P(c) ((unsigned) (c) < 0x80)
+#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
characters. Do not check validity of CT. */
@@ -903,8 +942,7 @@ struct Lisp_Vector
/* 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) \
- (((IDX) >= 0 && ASCII_CHAR_P (IDX) \
- && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii)) \
+ (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
: char_table_set (CT, IDX, VAL))
@@ -975,7 +1013,7 @@ struct Lisp_Bool_Vector
just the subtype information. */
struct vectorlike_header header;
/* This is the size in bits. */
- EMACS_UINT size;
+ EMACS_INT size;
/* This contains the actual bits, packed into bytes. */
unsigned char data[1];
};
@@ -1002,7 +1040,7 @@ struct Lisp_Subr
Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
Lisp_Object (*aUNEVALLED) (Lisp_Object args);
- Lisp_Object (*aMANY) (size_t, Lisp_Object *);
+ Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
} function;
short min_args, max_args;
const char *symbol_name;
@@ -1124,6 +1162,9 @@ struct Lisp_Symbol
#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
+#define DEFSYM(sym, name) \
+ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
+
/***********************************************************************
Hash Tables
@@ -1180,7 +1221,7 @@ struct Lisp_Hash_Table
a special way (e.g. because of weakness). */
/* Number of key/value entries in the table. */
- unsigned int count;
+ EMACS_INT 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.
@@ -1192,11 +1233,12 @@ struct Lisp_Hash_Table
struct Lisp_Hash_Table *next_weak;
/* C function to compare two keys. */
- int (* cmpfn) (struct Lisp_Hash_Table *, Lisp_Object,
- unsigned, Lisp_Object, unsigned);
+ int (*cmpfn) (struct Lisp_Hash_Table *,
+ Lisp_Object, EMACS_UINT,
+ Lisp_Object, EMACS_UINT);
/* C function to compute hash code. */
- unsigned (* hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
+ EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
};
@@ -1441,7 +1483,7 @@ struct Lisp_Save_Value
area containing INTEGER potential Lisp_Objects. */
unsigned int dogc : 1;
void *pointer;
- int integer;
+ ptrdiff_t integer;
};
@@ -1570,7 +1612,7 @@ typedef struct {
#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face))
/* Return 1 if GLYPH contains valid character code. */
-#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph), 1)
+#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph))
/* Glyph Code from a display vector may either be an integer which
@@ -1584,7 +1626,7 @@ typedef struct {
(CONSP (gc) ? XINT (XCDR (gc)) : INTEGERP (gc) ? (XINT (gc) >> CHARACTERBITS) : DEFAULT_FACE_ID)
/* 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), 1)
+#define GLYPH_CODE_CHAR_VALID_P(gc) CHAR_VALID_P (GLYPH_CODE_CHAR (gc))
#define GLYPH_CODE_P(gc) ((CONSP (gc) && INTEGERP (XCAR (gc)) && INTEGERP (XCDR (gc))) || INTEGERP (gc))
@@ -1851,14 +1893,14 @@ typedef struct {
#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)), \
+ { PVEC_SUBR, \
{ .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
/* Note that the weird token-substitution semantics of ANSI C makes
this work for MANY and UNEVALLED. */
-#define DEFUN_ARGS_MANY (size_t, Lisp_Object *)
+#define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
#define DEFUN_ARGS_0 (void)
#define DEFUN_ARGS_1 (Lisp_Object)
@@ -1941,10 +1983,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
#define DEFVAR_KBOARD(lname, vname, doc) \
do { \
static struct Lisp_Kboard_Objfwd ko_fwd; \
- defvar_kboard (&ko_fwd, \
- lname, \
- (int)((char *)(&current_kboard->vname ## _) \
- - (char *)current_kboard)); \
+ defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
} while (0)
@@ -2094,7 +2133,7 @@ extern Lisp_Object Vascii_canon_table;
/* Number of bytes of structure consed since last GC. */
-extern int consing_since_gc;
+extern EMACS_INT consing_since_gc;
extern EMACS_INT gc_relative_threshold;
@@ -2123,7 +2162,7 @@ struct gcpro
volatile Lisp_Object *var;
/* Number of consecutive protected variables. */
- size_t nvars;
+ ptrdiff_t nvars;
#ifdef DEBUG_GCPRO
int level;
@@ -2404,9 +2443,35 @@ 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.
+ I should not have side effects. */
+#define INTEGER_TO_CONS(i) \
+ (! FIXNUM_OVERFLOW_P (i) \
+ ? make_number (i) \
+ : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \
+ || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16)) \
+ ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
+ : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \
+ || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
+ ? Fcons (make_number ((i) >> 16 >> 24), \
+ Fcons (make_number ((i) >> 16 & 0xffffff), \
+ make_number ((i) & 0xffff))) \
+ : make_float (i))
+
+/* Convert the Emacs representation CONS back to an integer of type
+ TYPE, storing the result the variable VAR. Signal an error if CONS
+ is not a valid representation or is out of range for TYPE. */
+#define CONS_TO_INTEGER(cons, type, var) \
+ (TYPE_SIGNED (type) \
+ ? ((var) = cons_to_signed (cons, TYPE_MINIMUM (type), TYPE_MAXIMUM (type))) \
+ : ((var) = cons_to_unsigned (cons, TYPE_MAXIMUM (type))))
+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 Lisp_Object long_to_cons (unsigned long);
-extern unsigned long cons_to_long (Lisp_Object);
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;
@@ -2469,19 +2534,19 @@ extern void syms_of_syntax (void);
/* Defined in fns.c */
extern Lisp_Object QCrehash_size, QCrehash_threshold;
-extern int next_almost_prime (int);
-extern Lisp_Object larger_vector (Lisp_Object, int, Lisp_Object);
+extern EMACS_INT next_almost_prime (EMACS_INT);
+extern Lisp_Object larger_vector (Lisp_Object, EMACS_INT, Lisp_Object);
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;
-unsigned sxhash (Lisp_Object, int);
+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);
-int hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, unsigned *);
-int hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
- unsigned);
+EMACS_INT hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
+EMACS_INT 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);
@@ -2563,7 +2628,7 @@ extern void init_fringe_once (void);
/* Defined in image.c */
extern Lisp_Object QCascent, QCmargin, QCrelief;
extern Lisp_Object QCconversion;
-extern int x_bitmap_mask (struct frame *, int);
+extern int x_bitmap_mask (struct frame *, ptrdiff_t);
extern void syms_of_image (void);
extern void init_image (void);
@@ -2571,10 +2636,10 @@ extern void init_image (void);
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 EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT);
extern int count_combining_before (const unsigned char *,
EMACS_INT, EMACS_INT, EMACS_INT);
extern int count_combining_after (const unsigned char *,
@@ -2687,8 +2752,8 @@ 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 (void) NO_RETURN;
-extern void buffer_memory_full (void) NO_RETURN;
+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 void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC
@@ -2710,6 +2775,7 @@ 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);
@@ -2746,7 +2812,7 @@ extern int abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern int inhibit_garbage_collection (void);
-extern Lisp_Object make_save_value (void *, int);
+extern Lisp_Object make_save_value (void *, ptrdiff_t);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
@@ -2837,7 +2903,7 @@ extern void syms_of_lread (void);
/* Defined in eval.c. */
extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qclosure, Qdebug;
+extern Lisp_Object Qinhibit_quit, Qclosure;
extern Lisp_Object Qand_rest;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vsignaling_function;
@@ -2858,9 +2924,9 @@ 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 (size_t nargs, Lisp_Object *args,
+extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object (*funcall)
- (size_t nargs, Lisp_Object *args));
+ (ptrdiff_t nargs, Lisp_Object *args));
EXFUN (Fprogn, UNEVALLED);
EXFUN (Finteractive_p, 0);
EXFUN (Fthrow, 2) NO_RETURN;
@@ -2892,7 +2958,7 @@ extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_
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 (*) (size_t, Lisp_Object *), size_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));
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);
@@ -2902,7 +2968,7 @@ extern void verror (const char *, va_list)
extern void do_autoload (Lisp_Object, Lisp_Object);
extern Lisp_Object un_autoload (Lisp_Object);
extern void init_eval_once (void);
-extern Lisp_Object safe_call (size_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);
@@ -2979,6 +3045,7 @@ 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);
@@ -3183,19 +3250,13 @@ extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
extern Lisp_Object frame_buffer_predicate (Lisp_Object);
EXFUN (Fselect_frame, 2);
EXFUN (Fselected_frame, 0);
-EXFUN (Fwindow_frame, 1);
-EXFUN (Fframe_root_window, 1);
-EXFUN (Fframe_first_window, 1);
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);
-EXFUN (Fset_frame_selected_window, 3);
-extern Lisp_Object frame_buffer_list (Lisp_Object);
extern void frames_discard_buffer (Lisp_Object);
-extern void set_frame_buffer_list (Lisp_Object, Lisp_Object);
extern void syms_of_frame (void);
/* Defined in emacs.c */
@@ -3252,8 +3313,10 @@ extern int wait_reading_process_output (int, int, int, int,
int);
extern void add_keyboard_wait_descriptor (int);
extern void delete_keyboard_wait_descriptor (int);
+#ifdef HAVE_GPM
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 syms_of_process (void);
@@ -3287,7 +3350,7 @@ extern void mark_byte_stack (void);
#endif
extern void unmark_byte_stack (void);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, int, Lisp_Object *);
+ Lisp_Object, ptrdiff_t, Lisp_Object *);
/* Defined in macros.c */
extern Lisp_Object Qexecute_kbd_macro;
@@ -3527,29 +3590,19 @@ extern void init_system_name (void);
#define SWITCH_ENUM_CAST(x) (x)
-/* Loop over Lisp list LIST. Signal an error if LIST is not a proper
- list, or if it contains circles.
-
- HARE and TORTOISE should be the names of Lisp_Object variables, and
- N should be the name of an EMACS_INT variable declared in the
- function where the macro is used. Each nested loop should use
- its own variables.
+/* Use this to suppress gcc's warnings. */
+#ifdef lint
- In the loop body, HARE is set to each cons of LIST, and N is the
- length of the list processed so far. */
+/* Use CODE only if lint checking is in effect. */
+# define IF_LINT(Code) Code
-#define LIST_END_P(list, obj) \
- (NILP (obj) \
- ? 1 \
- : (CONSP (obj) \
- ? 0 \
- : (wrong_type_argument (Qlistp, (list))), 1))
+/* 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 ())
-/* 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 */
+# define lint_assume(cond) ((void) (0 && (cond)))
#endif
/* The ubiquitous min and max macros. */
@@ -3572,9 +3625,7 @@ extern void init_system_name (void);
fixnum. */
#define make_fixnum_or_float(val) \
- (FIXNUM_OVERFLOW_P (val) \
- ? make_float (val) \
- : make_number ((EMACS_INT)(val)))
+ (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val))
/* Checks the `cycle check' variable CHECK to see if it indicates that
@@ -3642,18 +3693,19 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object);
#define SAFE_ALLOCA_LISP(buf, nelt) \
do { \
- int size_ = (nelt) * sizeof (Lisp_Object); \
- if (size_ < MAX_ALLOCA) \
- buf = (Lisp_Object *) alloca (size_); \
- else \
+ 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 (size_); \
+ 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); \
} while (0)
diff --git a/src/lisp.mk b/src/lisp.mk
new file mode 100644
index 00000000000..68748b27f28
--- /dev/null
+++ b/src/lisp.mk
@@ -0,0 +1,160 @@
+### lisp.mk --- src/Makefile fragment for GNU Emacs
+
+## Copyright (C) 1985, 1987-1988, 1993-1995, 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/>.
+
+### Commentary:
+
+## This is the list of all Lisp files that might be loaded into the
+## dumped Emacs. Some of them are not loaded on all platforms, but
+## the DOC file on every platform uses them (because the DOC file is
+## supposed to be platform-independent).
+## It is arranged like this because it is easier to generate it
+## semi-mechanically from loadup.el this way.
+## Eg something like:
+## 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).
+
+## Confusingly, term/internal is not in loadup, but is unconditionally
+## loaded by pc-win, which is.
+
+## Note that this list should not include lisp files which might not
+## be present, like site-load.el and site-init.el; this makefile
+## expects them all to be either present or buildable.
+
+## Place loaddefs.el first, so it gets generated first, since it is on
+## the critical path (relevant in parallel compilations).
+
+### Code:
+
+## NB: This list is parsed by sed in the main src/Makefile.
+## Do not change the formatting.
+lisp = \
+ $(lispsource)/loaddefs.el \
+ $(lispsource)/loadup.el \
+ $(lispsource)/emacs-lisp/byte-run.elc \
+ $(lispsource)/emacs-lisp/backquote.elc \
+ $(lispsource)/subr.elc \
+ $(lispsource)/version.el \
+ $(lispsource)/widget.elc \
+ $(lispsource)/custom.elc \
+ $(lispsource)/emacs-lisp/map-ynp.elc \
+ $(lispsource)/cus-start.elc \
+ $(lispsource)/international/mule.elc \
+ $(lispsource)/international/mule-conf.elc \
+ $(lispsource)/env.elc \
+ $(lispsource)/format.elc \
+ $(lispsource)/bindings.elc \
+ $(lispsource)/files.elc \
+ $(lispsource)/cus-face.elc \
+ $(lispsource)/faces.elc \
+ $(lispsource)/button.elc \
+ $(lispsource)/startup.elc \
+ $(lispsource)/minibuffer.elc \
+ $(lispsource)/abbrev.elc \
+ $(lispsource)/simple.elc \
+ $(lispsource)/help.elc \
+ $(lispsource)/jka-cmpr-hook.elc \
+ $(lispsource)/epa-hook.elc \
+ $(lispsource)/international/mule-cmds.elc \
+ $(lispsource)/case-table.elc \
+ $(lispsource)/international/characters.elc \
+ $(lispsource)/composite.elc \
+ $(lispsource)/international/charprop.el \
+ $(lispsource)/language/chinese.elc \
+ $(lispsource)/language/cyrillic.elc \
+ $(lispsource)/language/indian.elc \
+ $(lispsource)/language/sinhala.el \
+ $(lispsource)/language/english.el \
+ $(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/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/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)/indent.elc \
+ $(lispsource)/window.elc \
+ $(lispsource)/frame.elc \
+ $(lispsource)/term/tty-colors.elc \
+ $(lispsource)/font-core.elc \
+ $(lispsource)/facemenu.elc \
+ $(lispsource)/emacs-lisp/syntax.elc \
+ $(lispsource)/font-lock.elc \
+ $(lispsource)/jit-lock.elc \
+ $(lispsource)/mouse.elc \
+ $(lispsource)/scroll-bar.elc \
+ $(lispsource)/select.elc \
+ $(lispsource)/emacs-lisp/timer.elc \
+ $(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 \
+ $(lispsource)/textmodes/paragraphs.elc \
+ $(lispsource)/emacs-lisp/lisp-mode.elc \
+ $(lispsource)/textmodes/text-mode.elc \
+ $(lispsource)/textmodes/fill.elc \
+ $(lispsource)/replace.elc \
+ $(lispsource)/buff-menu.elc \
+ $(lispsource)/fringe.elc \
+ $(lispsource)/image.elc \
+ $(lispsource)/international/fontset.elc \
+ $(lispsource)/dnd.elc \
+ $(lispsource)/tool-bar.elc \
+ $(lispsource)/dynamic-setting.elc \
+ $(lispsource)/x-dnd.elc \
+ $(lispsource)/term/common-win.elc \
+ $(lispsource)/term/x-win.elc \
+ $(lispsource)/w32-vars.elc \
+ $(lispsource)/term/w32-win.elc \
+ $(lispsource)/ls-lisp.elc \
+ $(lispsource)/disp-table.elc \
+ $(lispsource)/dos-w32.elc \
+ $(lispsource)/w32-fns.elc \
+ $(lispsource)/dos-fns.elc \
+ $(lispsource)/dos-vars.elc \
+ $(lispsource)/term/pc-win.elc \
+ $(lispsource)/term/internal.elc \
+ $(lispsource)/term/ns-win.elc \
+ $(lispsource)/mwheel.elc \
+ $(lispsource)/emacs-lisp/float-sup.elc \
+ $(lispsource)/vc/vc-hooks.elc \
+ $(lispsource)/vc/ediff-hook.elc \
+ $(lispsource)/tooltip.elc
+
+
+### lisp.mk ends here
diff --git a/src/lread.c b/src/lread.c
index b22ca930ee6..6cb217a21c6 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -120,9 +120,9 @@ static EMACS_INT readchar_count;
/* This contains the last string skipped with #@. */
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string. */
-static int saved_doc_string_size;
+static ptrdiff_t saved_doc_string_size;
/* Length of actual data in saved_doc_string. */
-static int saved_doc_string_length;
+static ptrdiff_t saved_doc_string_length;
/* This is the file position that string came from. */
static file_offset saved_doc_string_position;
@@ -131,9 +131,9 @@ static file_offset saved_doc_string_position;
is put in saved_doc_string. */
static char *prev_saved_doc_string;
/* Length of buffer allocated in prev_saved_doc_string. */
-static int prev_saved_doc_string_size;
+static ptrdiff_t prev_saved_doc_string_size;
/* Length of actual data in prev_saved_doc_string. */
-static int prev_saved_doc_string_length;
+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;
@@ -158,7 +158,7 @@ static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int,
static Lisp_Object load_unwind (Lisp_Object);
static Lisp_Object load_descriptor_unwind (Lisp_Object);
-static void invalid_syntax (const char *, int) NO_RETURN;
+static void invalid_syntax (const char *) NO_RETURN;
static void end_of_file_error (void) NO_RETURN;
@@ -1069,9 +1069,9 @@ 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 */
- if (SCHARS (file) > 0)
+ if (SBYTES (file) > 0)
{
- int size = SBYTES (file);
+ ptrdiff_t size = SBYTES (file);
found = Qnil;
GCPRO2 (file, found);
@@ -1203,12 +1203,15 @@ Return t if the file exists and loads successfully. */)
#ifdef DOS_NT
fmode = "rb";
#endif /* DOS_NT */
- stat (SSDATA (efound), &s1);
- SSET (efound, SBYTES (efound) - 1, 0);
- result = stat (SSDATA (efound), &s2);
- SSET (efound, SBYTES (efound) - 1, 'c');
+ result = stat (SSDATA (efound), &s1);
+ if (result == 0)
+ {
+ SSET (efound, SBYTES (efound) - 1, 0);
+ result = stat (SSDATA (efound), &s2);
+ SSET (efound, SBYTES (efound) - 1, 'c');
+ }
- if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
+ if (result == 0 && s1.st_mtime < s2.st_mtime)
{
/* Make the progress messages mention that source is newer. */
newer = 1;
@@ -1469,7 +1472,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- int lsuffix = SBYTES (XCAR (tail));
+ ptrdiff_t lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
int exists;
@@ -2011,11 +2014,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
S is error string of length N (if > 0) */
static void
-invalid_syntax (const char *s, int n)
+invalid_syntax (const char *s)
{
- if (!n)
- n = strlen (s);
- xsignal1 (Qinvalid_read_syntax, make_string (s, n));
+ xsignal1 (Qinvalid_read_syntax, build_string (s));
}
@@ -2036,7 +2037,7 @@ read0 (Lisp_Object readcharfun)
Fmake_string (make_number (1), make_number (c)));
}
-static int read_buffer_size;
+static ptrdiff_t read_buffer_size;
static char *read_buffer;
/* Read a \-escape sequence, assuming we already read the `\'.
@@ -2207,7 +2208,9 @@ read_escape (Lisp_Object readcharfun, int stringp)
UNREAD (c);
break;
}
- count++;
+ if (MAX_CHAR < i)
+ error ("Hex character out of range: \\x%x...", i);
+ count += count < 3;
}
if (count < 3 && i >= 0x80)
@@ -2235,10 +2238,7 @@ read_escape (Lisp_Object readcharfun, int stringp)
else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
else
- {
- error ("Non-hex digit used for Unicode escape");
- break;
- }
+ error ("Non-hex digit used for Unicode escape");
}
if (i > 0x10FFFF)
error ("Non-Unicode character: 0x%x", i);
@@ -2277,10 +2277,12 @@ digit_to_number (int character, int base)
range. */
static Lisp_Object
-read_integer (Lisp_Object readcharfun, int radix)
+read_integer (Lisp_Object readcharfun, EMACS_INT radix)
{
- /* Room for sign, leading 0, other digits, trailing null byte. */
- char buf[1 + 1 + sizeof (uintmax_t) * CHAR_BIT + 1];
+ /* Room for sign, leading 0, other digits, trailing null byte.
+ Also, room for invalid syntax diagnostic. */
+ char buf[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT + 1,
+ sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))];
int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
@@ -2332,8 +2334,8 @@ read_integer (Lisp_Object readcharfun, int radix)
if (! valid)
{
- sprintf (buf, "integer, radix %d", radix);
- invalid_syntax (buf, 0);
+ sprintf (buf, "integer, radix %"pI"d", radix);
+ invalid_syntax (buf);
}
return string_to_number (buf, radix, 0);
@@ -2450,7 +2452,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
return ht;
}
UNREAD (c);
- invalid_syntax ("#", 1);
+ invalid_syntax ("#");
}
if (c == '^')
{
@@ -2470,7 +2472,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (c == '[')
{
Lisp_Object tmp;
- int depth, size;
+ EMACS_INT depth, size;
tmp = read_vector (readcharfun, 0);
if (!INTEGERP (AREF (tmp, 0)))
@@ -2484,9 +2486,9 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
}
- invalid_syntax ("#^^", 3);
+ invalid_syntax ("#^^");
}
- invalid_syntax ("#^", 2);
+ invalid_syntax ("#^");
}
if (c == '&')
{
@@ -2496,7 +2498,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (c == '"')
{
Lisp_Object tmp, val;
- int size_in_chars
+ EMACS_INT size_in_chars
= ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
@@ -2510,7 +2512,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
version. */
&& ! (XFASTINT (length)
== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
- invalid_syntax ("#&...", 5);
+ invalid_syntax ("#&...");
val = Fmake_bool_vector (length, Qnil);
memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars);
@@ -2520,7 +2522,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
&= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
return val;
}
- invalid_syntax ("#&...", 5);
+ invalid_syntax ("#&...");
}
if (c == '[')
{
@@ -2540,7 +2542,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
/* Read the string itself. */
tmp = read1 (readcharfun, &ch, 0);
if (ch != 0 || !STRINGP (tmp))
- invalid_syntax ("#", 1);
+ invalid_syntax ("#");
GCPRO1 (tmp);
/* Read the intervals and their properties. */
while (1)
@@ -2556,7 +2558,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (ch == 0)
plist = read1 (readcharfun, &ch, 0);
if (ch)
- invalid_syntax ("Invalid string property list", 0);
+ invalid_syntax ("Invalid string property list");
Fset_text_properties (beg, end, plist, tmp);
}
UNGCPRO;
@@ -2568,13 +2570,16 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
and function definitions. */
if (c == '@')
{
- int i, nskip = 0;
+ enum { extra = 100 };
+ ptrdiff_t i, nskip = 0;
load_each_byte = 1;
/* Read a decimal integer. */
while ((c = READCHAR) >= 0
&& c >= '0' && c <= '9')
{
+ if ((STRING_BYTES_BOUND - extra) / 10 <= nskip)
+ string_overflow ();
nskip *= 10;
nskip += c - '0';
}
@@ -2593,9 +2598,9 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
with prev_saved_doc_string, so we save two strings. */
{
char *temp = saved_doc_string;
- int temp_size = saved_doc_string_size;
+ ptrdiff_t temp_size = saved_doc_string_size;
file_offset temp_pos = saved_doc_string_position;
- int temp_len = saved_doc_string_length;
+ ptrdiff_t temp_len = saved_doc_string_length;
saved_doc_string = prev_saved_doc_string;
saved_doc_string_size = prev_saved_doc_string_size;
@@ -2610,12 +2615,12 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (saved_doc_string_size == 0)
{
- saved_doc_string_size = nskip + 100;
+ saved_doc_string_size = nskip + extra;
saved_doc_string = (char *) xmalloc (saved_doc_string_size);
}
if (nskip > saved_doc_string_size)
{
- saved_doc_string_size = nskip + 100;
+ saved_doc_string_size = nskip + extra;
saved_doc_string = (char *) xrealloc (saved_doc_string,
saved_doc_string_size);
}
@@ -2660,49 +2665,60 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
/* Reader forms that can reuse previously read objects. */
if (c >= '0' && c <= '9')
{
- int n = 0;
+ EMACS_INT n = 0;
Lisp_Object tem;
/* Read a non-negative integer. */
while (c >= '0' && c <= '9')
{
- n *= 10;
- n += c - '0';
+ if (MOST_POSITIVE_FIXNUM / 10 < n
+ || MOST_POSITIVE_FIXNUM < n * 10 + c - '0')
+ n = MOST_POSITIVE_FIXNUM + 1;
+ else
+ n = n * 10 + c - '0';
c = READCHAR;
}
- /* #n=object returns object, but associates it with n for #n#. */
- if (c == '=' && !NILP (Vread_circle))
+
+ if (n <= MOST_POSITIVE_FIXNUM)
{
- /* Make a placeholder for #n# to use temporarily */
- Lisp_Object placeholder;
- Lisp_Object cell;
+ if (c == 'r' || c == 'R')
+ return read_integer (readcharfun, n);
- placeholder = Fcons (Qnil, Qnil);
- cell = Fcons (make_number (n), placeholder);
- read_objects = Fcons (cell, read_objects);
+ if (! NILP (Vread_circle))
+ {
+ /* #n=object returns object, but associates it with
+ n for #n#. */
+ if (c == '=')
+ {
+ /* Make a placeholder for #n# to use temporarily */
+ Lisp_Object placeholder;
+ Lisp_Object cell;
- /* Read the object itself. */
- tem = read0 (readcharfun);
+ placeholder = Fcons (Qnil, Qnil);
+ cell = Fcons (make_number (n), placeholder);
+ read_objects = Fcons (cell, read_objects);
- /* Now put it everywhere the placeholder was... */
- substitute_object_in_subtree (tem, placeholder);
+ /* Read the object itself. */
+ tem = read0 (readcharfun);
- /* ...and #n# will use the real value from now on. */
- Fsetcdr (cell, tem);
+ /* Now put it everywhere the placeholder was... */
+ substitute_object_in_subtree (tem, placeholder);
- return tem;
- }
- /* #n# returns a previously read object. */
- if (c == '#' && !NILP (Vread_circle))
- {
- tem = Fassq (make_number (n), read_objects);
- if (CONSP (tem))
- return XCDR (tem);
- /* Fall through to error message. */
- }
- else if (c == 'r' || c == 'R')
- return read_integer (readcharfun, n);
+ /* ...and #n# will use the real value from now on. */
+ Fsetcdr (cell, tem);
+
+ return tem;
+ }
+ /* #n# returns a previously read object. */
+ if (c == '#')
+ {
+ tem = Fassq (make_number (n), read_objects);
+ if (CONSP (tem))
+ return XCDR (tem);
+ }
+ }
+ }
/* Fall through to error message. */
}
else if (c == 'x' || c == 'X')
@@ -2713,7 +2729,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
return read_integer (readcharfun, 2);
UNREAD (c);
- invalid_syntax ("#", 1);
+ invalid_syntax ("#");
case ';':
while ((c = READCHAR) >= 0 && c != '\n');
@@ -2830,7 +2846,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (ok)
return make_number (c);
- invalid_syntax ("?", 1);
+ invalid_syntax ("?");
}
case '"':
@@ -2845,14 +2861,16 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
a single-byte character. */
int force_singlebyte = 0;
int cancel = 0;
- int nchars = 0;
+ ptrdiff_t nchars = 0;
while ((ch = READCHAR) >= 0
&& ch != '\"')
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
- int offset = p - read_buffer;
+ 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);
p = read_buffer + offset;
@@ -2995,7 +3013,9 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
- int offset = p - read_buffer;
+ 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);
p = read_buffer + offset;
@@ -3022,7 +3042,9 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (p == end)
{
- int offset = p - read_buffer;
+ 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);
p = read_buffer + offset;
@@ -3134,7 +3156,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
{
case Lisp_Vectorlike:
{
- int i, length = 0;
+ ptrdiff_t i, length = 0;
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
@@ -3332,7 +3354,7 @@ string_to_number (char const *string, int base, int ignore_trailing)
/* Unfortunately there's no simple and accurate way to convert
non-base-10 numbers that are out of C-language range. */
if (base != 10)
- xsignal (Qoverflow_error, list1 (build_string (string)));
+ xsignal1 (Qoverflow_error, build_string (string));
}
else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM))
{
@@ -3357,8 +3379,7 @@ string_to_number (char const *string, int base, int ignore_trailing)
static Lisp_Object
read_vector (Lisp_Object readcharfun, int bytecodeflag)
{
- register int i;
- register int size;
+ ptrdiff_t i, size;
register Lisp_Object *ptr;
register Lisp_Object tem, item, vector;
register struct Lisp_Cons *otem;
@@ -3498,7 +3519,7 @@ read_list (int flag, register Lisp_Object readcharfun)
{
if (ch == ']')
return val;
- invalid_syntax (") or . in a vector", 18);
+ invalid_syntax (") or . in a vector");
}
if (ch == ')')
return val;
@@ -3527,15 +3548,15 @@ read_list (int flag, register Lisp_Object readcharfun)
doc string, caller must make it
multibyte. */
- int pos = XINT (XCDR (val));
+ EMACS_INT pos = XINT (XCDR (val));
/* Position is negative for user variables. */
if (pos < 0) pos = -pos;
if (pos >= saved_doc_string_position
&& pos < (saved_doc_string_position
+ saved_doc_string_length))
{
- int start = pos - saved_doc_string_position;
- int from, to;
+ ptrdiff_t start = pos - saved_doc_string_position;
+ ptrdiff_t from, to;
/* Process quoting with ^A,
and find the end of the string,
@@ -3566,8 +3587,9 @@ read_list (int flag, register Lisp_Object readcharfun)
&& pos < (prev_saved_doc_string_position
+ prev_saved_doc_string_length))
{
- int start = pos - prev_saved_doc_string_position;
- int from, to;
+ ptrdiff_t start =
+ pos - prev_saved_doc_string_position;
+ ptrdiff_t from, to;
/* Process quoting with ^A,
and find the end of the string,
@@ -3600,9 +3622,9 @@ read_list (int flag, register Lisp_Object readcharfun)
return val;
}
- invalid_syntax (". in wrong context", 18);
+ invalid_syntax (". in wrong context");
}
- invalid_syntax ("] in a list", 11);
+ invalid_syntax ("] in a list");
}
tem = (read_pure && flag <= 0
? pure_cons (elt, Qnil)
@@ -3649,7 +3671,7 @@ Lisp_Object
intern (const char *str)
{
Lisp_Object tem;
- int len = strlen (str);
+ ptrdiff_t len = strlen (str);
Lisp_Object obarray;
obarray = Vobarray;
@@ -3665,7 +3687,7 @@ Lisp_Object
intern_c_string (const char *str)
{
Lisp_Object tem;
- int len = strlen (str);
+ ptrdiff_t len = strlen (str);
Lisp_Object obarray;
obarray = Vobarray;
@@ -3890,7 +3912,7 @@ hash_string (const char *ptr, size_t len)
void
map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
{
- register int i;
+ ptrdiff_t i;
register Lisp_Object tail;
CHECK_VECTOR (obarray);
for (i = ASIZE (obarray) - 1; i >= 0; i--)
@@ -3961,8 +3983,7 @@ init_obarray (void)
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
Vpurify_flag = Qt;
- Qvariable_documentation = intern_c_string ("variable-documentation");
- staticpro (&Qvariable_documentation);
+ DEFSYM (Qvariable_documentation, "variable-documentation");
read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
read_buffer = (char *) xmalloc (read_buffer_size);
@@ -3979,9 +4000,7 @@ defsubr (struct Lisp_Subr *sname)
#ifdef NOTDEF /* use fset in subr.el now */
void
-defalias (sname, string)
- struct Lisp_Subr *sname;
- char *string;
+defalias (struct Lisp_Subr *sname, char *string)
{
Lisp_Object sym;
sym = intern (string);
@@ -3990,7 +4009,7 @@ defalias (sname, string)
#endif /* NOTDEF */
/* Define an "integer variable"; a symbol whose value is forwarded to a
- C variable of type int. Sample call (munged w "xx" to fool make-docfile):
+ C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
void
defvar_int (struct Lisp_Intfwd *i_fwd,
@@ -4370,8 +4389,7 @@ customize `jka-compr-load-suffixes' rather than the present variable. */);
DEFVAR_BOOL ("load-in-progress", load_in_progress,
doc: /* Non-nil if inside of `load'. */);
- Qload_in_progress = intern_c_string ("load-in-progress");
- staticpro (&Qload_in_progress);
+ DEFSYM (Qload_in_progress, "load-in-progress");
DEFVAR_LISP ("after-load-alist", Vafter_load_alist,
doc: /* An alist of expressions to be evalled when particular files are loaded.
@@ -4400,9 +4418,11 @@ The remaining ENTRIES in the alist element describe the functions and
variables defined in that file, the features provided, and the
features required. Each entry has the form `(provide . FEATURE)',
`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
-`(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
-. SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
-SYMBOL was an autoload before this file redefined it as a function.
+`(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
+may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
+autoload before this file redefined it as a function. In addition,
+entries may also be single symbols, which means that SYMBOL was
+defined by `defvar' or `defconst'.
During preloading, the file name recorded is relative to the main Lisp
directory. These file names are converted to absolute at startup. */);
@@ -4502,67 +4522,34 @@ This variable is automatically set from the file variables of an interpreted
DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes,
doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
Vold_style_backquotes = Qnil;
- Qold_style_backquotes = intern_c_string ("old-style-backquotes");
- staticpro (&Qold_style_backquotes);
+ DEFSYM (Qold_style_backquotes, "old-style-backquotes");
/* Vsource_directory was initialized in init_lread. */
load_descriptor_list = Qnil;
staticpro (&load_descriptor_list);
- Qcurrent_load_list = intern_c_string ("current-load-list");
- staticpro (&Qcurrent_load_list);
-
- Qstandard_input = intern_c_string ("standard-input");
- staticpro (&Qstandard_input);
-
- Qread_char = intern_c_string ("read-char");
- staticpro (&Qread_char);
-
- Qget_file_char = intern_c_string ("get-file-char");
- staticpro (&Qget_file_char);
-
- Qget_emacs_mule_file_char = intern_c_string ("get-emacs-mule-file-char");
- staticpro (&Qget_emacs_mule_file_char);
-
- Qload_force_doc_strings = intern_c_string ("load-force-doc-strings");
- staticpro (&Qload_force_doc_strings);
-
- Qbackquote = intern_c_string ("`");
- staticpro (&Qbackquote);
- Qcomma = intern_c_string (",");
- staticpro (&Qcomma);
- Qcomma_at = intern_c_string (",@");
- staticpro (&Qcomma_at);
- Qcomma_dot = intern_c_string (",.");
- staticpro (&Qcomma_dot);
-
- Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation");
- staticpro (&Qinhibit_file_name_operation);
-
- Qascii_character = intern_c_string ("ascii-character");
- staticpro (&Qascii_character);
-
- Qfunction = intern_c_string ("function");
- staticpro (&Qfunction);
-
- Qload = intern_c_string ("load");
- staticpro (&Qload);
-
- Qload_file_name = intern_c_string ("load-file-name");
- staticpro (&Qload_file_name);
-
- Qeval_buffer_list = intern_c_string ("eval-buffer-list");
- staticpro (&Qeval_buffer_list);
-
- Qfile_truename = intern_c_string ("file-truename");
- staticpro (&Qfile_truename) ;
-
- Qdir_ok = intern_c_string ("dir-ok");
- staticpro (&Qdir_ok);
-
- Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation");
- staticpro (&Qdo_after_load_evaluation) ;
+ DEFSYM (Qcurrent_load_list, "current-load-list");
+ DEFSYM (Qstandard_input, "standard-input");
+ DEFSYM (Qread_char, "read-char");
+ DEFSYM (Qget_file_char, "get-file-char");
+ DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
+ DEFSYM (Qload_force_doc_strings, "load-force-doc-strings");
+
+ DEFSYM (Qbackquote, "`");
+ DEFSYM (Qcomma, ",");
+ DEFSYM (Qcomma_at, ",@");
+ DEFSYM (Qcomma_dot, ",.");
+
+ DEFSYM (Qinhibit_file_name_operation, "inhibit-file-name-operation");
+ DEFSYM (Qascii_character, "ascii-character");
+ DEFSYM (Qfunction, "function");
+ DEFSYM (Qload, "load");
+ DEFSYM (Qload_file_name, "load-file-name");
+ DEFSYM (Qeval_buffer_list, "eval-buffer-list");
+ DEFSYM (Qfile_truename, "file-truename");
+ DEFSYM (Qdir_ok, "dir-ok");
+ DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
staticpro (&dump_path);
@@ -4574,18 +4561,11 @@ This variable is automatically set from the file variables of an interpreted
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
- Qhash_table = intern_c_string ("hash-table");
- staticpro (&Qhash_table);
- Qdata = intern_c_string ("data");
- staticpro (&Qdata);
- Qtest = intern_c_string ("test");
- staticpro (&Qtest);
- Qsize = intern_c_string ("size");
- staticpro (&Qsize);
- Qweakness = intern_c_string ("weakness");
- staticpro (&Qweakness);
- Qrehash_size = intern_c_string ("rehash-size");
- staticpro (&Qrehash_size);
- Qrehash_threshold = intern_c_string ("rehash-threshold");
- staticpro (&Qrehash_threshold);
+ DEFSYM (Qhash_table, "hash-table");
+ DEFSYM (Qdata, "data");
+ DEFSYM (Qtest, "test");
+ DEFSYM (Qsize, "size");
+ DEFSYM (Qweakness, "weakness");
+ DEFSYM (Qrehash_size, "rehash-size");
+ DEFSYM (Qrehash_threshold, "rehash-threshold");
}
diff --git a/src/m/iris4d.h b/src/m/iris4d.h
deleted file mode 100644
index 881f71f846f..00000000000
--- a/src/m/iris4d.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/* machine description file for Iris-4D machines. Use with s/irix*.h.
-
-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/>. */
-
-
-/* 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/macros.c b/src/macros.c
index 3523e513d6a..60f30c3fbbe 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -71,10 +71,10 @@ macro before appending to it. */)
{
if (current_kboard->kbd_macro_bufsize > 200)
{
- current_kboard->kbd_macro_bufsize = 30;
current_kboard->kbd_macro_buffer
= (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
30 * sizeof (Lisp_Object));
+ current_kboard->kbd_macro_bufsize = 30;
}
current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer;
current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer;
@@ -82,7 +82,8 @@ macro before appending to it. */)
}
else
{
- int i, len;
+ ptrdiff_t i;
+ EMACS_INT len;
int cvt;
/* Check the type of last-kbd-macro in case Lisp code changed it. */
@@ -94,10 +95,13 @@ macro before appending to it. */)
has put another macro there. */
if (current_kboard->kbd_macro_bufsize < len + 30)
{
- current_kboard->kbd_macro_bufsize = len + 30;
+ if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) - 30
+ < current_kboard->kbd_macro_bufsize)
+ 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;
}
/* Must convert meta modifier when copying string to vector. */
@@ -191,14 +195,17 @@ store_kbd_macro_char (Lisp_Object c)
{
if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize)
{
- int ptr_offset, end_offset, nbytes;
+ ptrdiff_t ptr_offset, end_offset, nbytes;
ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer;
end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer;
- kb->kbd_macro_bufsize *= 2;
- nbytes = kb->kbd_macro_bufsize * sizeof *kb->kbd_macro_buffer;
+ if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *kb->kbd_macro_buffer / 2
+ < 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_bufsize *= 2;
kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
}
@@ -360,15 +367,13 @@ init_macros (void)
void
syms_of_macros (void)
{
- Qexecute_kbd_macro = intern_c_string ("execute-kbd-macro");
- staticpro (&Qexecute_kbd_macro);
+ DEFSYM (Qexecute_kbd_macro, "execute-kbd-macro");
DEFVAR_LISP ("kbd-macro-termination-hook", Vkbd_macro_termination_hook,
doc: /* Normal hook run whenever a keyboard macro terminates.
This is run whether the macro ends normally or prematurely due to an error. */);
Vkbd_macro_termination_hook = Qnil;
- Qkbd_macro_termination_hook = intern_c_string ("kbd-macro-termination-hook");
- staticpro (&Qkbd_macro_termination_hook);
+ DEFSYM (Qkbd_macro_termination_hook, "kbd-macro-termination-hook");
defsubr (&Sstart_kbd_macro);
defsubr (&Send_kbd_macro);
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index e19a19645f9..88b53554925 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -382,458 +382,452 @@ full-tags: TAGS TAGS-LISP ../nt/TAGS
### DEPENDENCIES ###
EMACS_ROOT = ..
-CONFIG_H = $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h
-LISP_H = $(SRC)/lisp.h \
- $(SRC)/globals.h \
- $(EMACS_ROOT)/nt/inc/inttypes.h \
- $(EMACS_ROOT)/nt/inc/stdint.h
-PROCESS_H = $(SRC)/process.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(SRC)/gnutls.h
+GNU_LIB = $(EMACS_ROOT)/lib
+NT_INC = $(EMACS_ROOT)/nt/inc
+
+SYSTIME_H = $(SRC)/systime.h \
+ $(NT_INC)/sys/time.h
+ATIMER_H = $(SRC)/atimer.h \
+ $(SYSTIME_H)
+BLOCKINPUT_H = $(SRC)/blockinput.h \
+ $(ATIMER_H)
+CAREADLINKAT_H = $(GNU_LIB)/careadlinkat.h \
+ $(NT_INC)/unistd.h
+CHARACTER_H = $(SRC)/character.h \
+ $(GNU_LIB)/verify.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 \
+ $(NT_INC)/sys/stat.h
+CONFIG_H = $(SRC)/config.h \
+ $(SRC)/m/intel386.h \
+ $(MS_W32_H)
+DIR_H = $(NT_INC)/sys/dir.h \
+ $(SRC)/ndir.h
+W32GUI_H = $(SRC)/w32gui.h \
+ $(SYSTIME_H)
+DISPEXTERN_H = $(SRC)/dispextern.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)
+FTOASTR_H = $(GNU_LIB)/ftoastr.h \
+ $(GNU_LIB)/intprops.h
+GRP_H = $(NT_INC)/grp.h \
+ $(NT_INC)/pwd.h
+INTERVALS_H = $(SRC)/intervals.h \
+ $(SRC)/composite.h \
+ $(DISPEXTERN_H)
+INTTYPES_H = $(NT_INC)/inttypes.h \
+ $(NT_INC)/stdint.h
+KEYBOARD_H = $(SRC)/keyboard.h \
+ $(CODING_H) \
+ $(SYSTIME_H)
+LANGINFO_H = $(NT_INC)/langinfo.h \
+ $(NT_INC)/nl_types.h
+LISP_H = $(SRC)/lisp.h \
+ $(SRC)/globals.h \
+ $(GNU_LIB)/intprops.h \
+ $(INTTYPES_H)
+MD5_H = $(GNU_LIB)/md5.h \
+ $(NT_INC)/stdint.h
+MENU_H = $(SRC)/menu.h \
+ $(SYSTIME_H)
+PROCESS_H = $(SRC)/process.h \
+ $(SRC)/gnutls.h \
+ $(NT_INC)/unistd.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)
+SOCKET_H = $(NT_INC)/sys/socket.h \
+ $(SRC)/w32.h
+SYSTTY_H = $(SRC)/systty.h \
+ $(NT_INC)/sys/ioctl.h \
+ $(NT_INC)/unistd.h
+TERMHOOKS_H = $(SRC)/termhooks.h \
+ $(SYSTIME_H)
+W32TERM_H = $(SRC)/w32term.h \
+ $(W32GUI_H)
+WINDOW_H = $(SRC)/window.h \
+ $(DISPEXTERN_H)
$(BLD)/alloc.$(O) : \
$(SRC)/alloc.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/puresize.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
$(SRC)/w32.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/atimer.$(O) : \
$(SRC)/atimer.c \
+ $(SRC)/syssignal.h \
+ $(NT_INC)/sys/time.h \
+ $(NT_INC)/unistd.h \
+ $(ATIMER_H) \
+ $(BLOCKINPUT_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/syssignal.h \
- $(SRC)/systime.h
+ $(SYSTIME_H)
$(BLD)/bidi.$(O) : \
$(SRC)/bidi.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/bidimirror.h \
$(SRC)/biditype.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/dispextern.h \
- $(SRC)/w32gui.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(LISP_H)
$(BLD)/buffer.$(O) : \
$(SRC)/buffer.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/param.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
$(SRC)/indent.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/region-cache.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/sys/param.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/verify.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/bytecode.$(O) : \
$(SRC)/bytecode.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/dispextern.h \
$(SRC)/syntax.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/callint.$(O) : \
$(SRC)/callint.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/callproc.$(O) : \
$(SRC)/callproc.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/epaths.h \
- $(SRC)/frame.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/systty.h \
- $(SRC)/termhooks.h \
$(SRC)/w32.h \
- $(SRC)/w32gui.h
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SYSTTY_H) \
+ $(TERMHOOKS_H)
$(BLD)/casefiddle.$(O) : \
$(SRC)/casefiddle.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/keymap.h \
- $(SRC)/syntax.h
+ $(SRC)/syntax.h \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/casetab.$(O) : \
$(SRC)/casetab.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/category.$(O) : \
$(SRC)/category.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
$(SRC)/category.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/keymap.h
+ $(SRC)/keymap.h \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/ccl.$(O) : \
$(SRC)/ccl.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/character.$(O) : \
$(SRC)/character.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
$(SRC)/composite.h \
- $(SRC)/disptab.h
+ $(SRC)/disptab.h \
+ $(GNU_LIB)/intprops.h \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/charset.$(O) : \
$(SRC)/charset.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/disptab.h
+ $(SRC)/disptab.h \
+ $(NT_INC)/unistd.h \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/chartab.$(O) : \
$(SRC)/chartab.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/cmds.$(O) : \
$(SRC)/cmds.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/coding.$(O) : \
$(SRC)/coding.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/composite.$(O) : \
$(SRC)/composite.c \
+ $(SRC)/buffer.h \
+ $(CHARACTER_H) \
+ $(CODING_H) \
$(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
$(LISP_H) \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/data.$(O) : \
$(SRC)/data.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
$(SRC)/puresize.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h
+ $(GNU_LIB)/intprops.h \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H)
$(BLD)/dired.$(O) : \
$(SRC)/dired.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/grp.h \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/dir.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/filemode.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/ndir.h \
$(SRC)/regex.h \
- $(SRC)/systime.h
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DIR_H) \
+ $(FILEMODE_H) \
+ $(GRP_H) \
+ $(LISP_H) \
+ $(SYSTIME_H)
$(BLD)/dispnew.$(O) : \
$(SRC)/dispnew.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
$(SRC)/cm.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/frame.h \
$(SRC)/indent.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SYSTIME_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/doc.$(O) : \
$(SRC)/doc.c \
- $(CONFIG_H) \
- buildobj.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/keyboard.h \
+ $(SRC)/buildobj.h \
$(SRC)/keymap.h \
- $(SRC)/systime.h
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/unistd.h \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H)
$(BLD)/doprnt.$(O) : \
$(SRC)/doprnt.c \
+ $(NT_INC)/unistd.h \
+ $(CHARACTER_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(LISP_H) \
- $(SRC)/character.h
+ $(LISP_H)
$(BLD)/editfns.$(O) : \
$(SRC)/editfns.c \
+ $(SRC)/buffer.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/strftime.h \
+ $(GNU_LIB)/verify.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CODING_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/intprops.h \
- $(EMACS_ROOT)/lib/strftime.h \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(SYSTIME_H) \
+ $(WINDOW_H)
$(BLD)/emacs.$(O) : \
$(SRC)/emacs.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
+ $(SRC)/gnutls.h \
$(SRC)/keymap.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/systty.h \
- $(SRC)/termhooks.h \
$(SRC)/unexec.h \
$(SRC)/w32.h \
- $(SRC)/w32gui.h \
$(SRC)/w32heap.h \
- $(SRC)/window.h
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SYSTTY_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/eval.$(O) : \
$(SRC)/eval.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h
+ $(BLOCKINPUT_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H)
$(BLD)/fileio.$(O) : \
$(SRC)/fileio.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(LISP_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 \
+ $(CHARACTER_H) \
+ $(CODING_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
$(LISP_H) \
- $(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/systime.h
+ $(SYSTIME_H)
$(BLD)/firstfile.$(O) : \
$(SRC)/firstfile.c \
@@ -841,265 +835,213 @@ $(BLD)/firstfile.$(O) : \
$(BLD)/floatfns.$(O) : \
$(SRC)/floatfns.c \
+ $(SRC)/syssignal.h \
$(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/syssignal.h
+ $(LISP_H)
$(BLD)/fns.$(O) : \
$(SRC)/fns.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/langinfo.h \
- $(EMACS_ROOT)/nt/inc/nl_types.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/md5.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/intprops.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LANGINFO_H) \
+ $(LISP_H) \
+ $(MD5_H) \
+ $(SHA1_H) \
+ $(SHA256_H) \
+ $(SHA512_H) \
+ $(WINDOW_H)
$(BLD)/font.$(O) : \
$(SRC)/font.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/fontset.$(O) : \
$(SRC)/fontset.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/frame.$(O) : \
$(SRC)/frame.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/fringe.$(O) : \
$(SRC)/fringe.c \
+ $(SRC)/buffer.h \
+ $(BLOCKINPUT_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/buffer.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/gmalloc.$(O) : \
$(SRC)/gmalloc.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(SRC)/getpagesize.h
+ $(SRC)/getpagesize.h \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
$(BLD)/gnutls.$(O) : \
$(SRC)/gnutls.c \
+ $(SRC)/w32.h \
$(CONFIG_H) \
$(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/w32.h
+ $(PROCESS_H)
$(BLD)/image.$(O) : \
$(SRC)/image.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/epaths.h \
- $(SRC)/font.h \
- $(SRC)/frame.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
$(SRC)/w32.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(SYSTIME_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/indent.$(O) : \
$(SRC)/indent.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
$(SRC)/category.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/frame.h \
$(SRC)/indent.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/region-cache.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/insdel.$(O) : \
$(SRC)/insdel.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/intervals.h \
$(SRC)/region-cache.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(GNU_LIB)/intprops.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(INTERVALS_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/intervals.$(O) : \
$(SRC)/intervals.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/intprops.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/puresize.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h
+ $(GNU_LIB)/intprops.h \
+ $(CONFIG_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H)
$(BLD)/keyboard.$(O) : \
$(SRC)/keyboard.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/macros.h \
$(SRC)/puresize.h \
$(SRC)/syntax.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(NT_INC)/sys/ioctl.h \
+ $(NT_INC)/unistd.h \
+ $(ATIMER_H) \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SYSTIME_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/keymap.$(O) : \
$(SRC)/keymap.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/puresize.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/lastfile.$(O) : \
$(SRC)/lastfile.c \
@@ -1107,696 +1049,560 @@ $(BLD)/lastfile.$(O) : \
$(BLD)/lread.$(O) : \
$(SRC)/lread.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/epaths.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H)
$(BLD)/macros.$(O) : \
$(SRC)/macros.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/keyboard.h \
$(SRC)/macros.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CONFIG_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/marker.$(O) : \
$(SRC)/marker.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/menu.$(O) : \
$(SRC)/menu.c \
+ $(SRC)/keymap.h \
+ $(BLOCKINPUT_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/keymap.h \
- $(SRC)/menu.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(MENU_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/minibuf.$(O) : \
$(SRC)/minibuf.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/w32.$(O) : \
$(SRC)/w32.c \
+ $(SRC)/ndir.h \
+ $(SRC)/w32.h \
+ $(SRC)/w32heap.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/time.h \
+ $(GNU_LIB)/allocator.h \
+ $(CAREADLINKAT_H) \
+ $(CODING_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/grp.h \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/socket.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/allocator.h \
- $(EMACS_ROOT)/lib/careadlinkat.h \
+ $(DISPEXTERN_H) \
+ $(GRP_H) \
$(LISP_H) \
$(PROCESS_H) \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/ndir.h \
- $(SRC)/systime.h \
- $(SRC)/w32.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32heap.h
+ $(SOCKET_H) \
+ $(SYSTIME_H)
$(BLD)/w32heap.$(O) : \
$(SRC)/w32heap.c \
+ $(SRC)/w32heap.h \
$(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/w32heap.h
+ $(LISP_H)
$(BLD)/w32inevt.$(O) : \
$(SRC)/w32inevt.c \
+ $(SRC)/w32heap.h \
+ $(BLOCKINPUT_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32heap.h \
- $(SRC)/w32term.h
+ $(TERMHOOKS_H) \
+ $(W32TERM_H)
$(BLD)/w32proc.$(O) : \
$(SRC)/w32proc.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/langinfo.h \
- $(EMACS_ROOT)/nt/inc/nl_types.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
$(SRC)/syswait.h \
$(SRC)/w32.h \
- $(SRC)/w32gui.h \
$(SRC)/w32heap.h \
- $(SRC)/w32term.h
+ $(NT_INC)/nl_types.h \
+ $(NT_INC)/sys/file.h \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(LANGINFO_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SYSTIME_H) \
+ $(W32TERM_H)
$(BLD)/w32console.$(O) : \
$(SRC)/w32console.c \
- $(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/character.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/frame.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32inevt.h
+ $(SRC)/w32inevt.h \
+ $(CHARACTER_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H)
$(BLD)/print.$(O) : \
$(SRC)/print.c \
+ $(SRC)/buffer.h \
+ $(SRC)/termchar.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/ftoastr.h \
- $(EMACS_ROOT)/lib/intprops.h \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(FTOASTR_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/process.$(O) : \
$(SRC)/process.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/netdb.h \
- $(EMACS_ROOT)/nt/inc/arpa/inet.h \
- $(EMACS_ROOT)/nt/inc/netinet/in.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/socket.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
+ $(SRC)/gnutls.h \
$(SRC)/sysselect.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/systty.h \
$(SRC)/syswait.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
- $(SRC)/w32.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/arpa/inet.h \
+ $(NT_INC)/netdb.h \
+ $(NT_INC)/netinet/in.h \
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/ioctl.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(ATIMER_H) \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SOCKET_H) \
+ $(SYSTIME_H) \
+ $(SYSTTY_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/ralloc.$(O) : \
$(SRC)/ralloc.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/getpagesize.h \
- $(SRC)/systime.h
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/regex.$(O) : \
$(SRC)/regex.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
$(SRC)/category.h \
- $(SRC)/character.h \
$(SRC)/regex.h \
- $(SRC)/syntax.h
+ $(SRC)/syntax.h \
+ $(NT_INC)/unistd.h \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/region-cache.$(O) : \
$(SRC)/region-cache.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
- $(SRC)/region-cache.h
+ $(SRC)/region-cache.h \
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/scroll.$(O) : \
$(SRC)/scroll.c \
+ $(SRC)/termchar.h \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/search.$(O) : \
$(SRC)/search.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/category.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/intervals.h \
$(SRC)/regex.h \
$(SRC)/region-cache.h \
$(SRC)/syntax.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(INTERVALS_H) \
+ $(LISP_H)
$(BLD)/sound.$(O) : \
$(SRC)/sound.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/dispextern.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h
+ $(NT_INC)/unistd.h \
+ $(ATIMER_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(LISP_H)
$(BLD)/syntax.$(O) : \
$(SRC)/syntax.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
$(SRC)/category.h \
- $(SRC)/character.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/intervals.h \
$(SRC)/keymap.h \
$(SRC)/regex.h \
$(SRC)/syntax.h \
- $(SRC)/w32gui.h
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(INTERVALS_H) \
+ $(LISP_H)
$(BLD)/sysdep.$(O) : \
$(SRC)/sysdep.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/grp.h \
- $(EMACS_ROOT)/nt/inc/netdb.h \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/socket.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(EMACS_ROOT)/lib/allocator.h \
- $(EMACS_ROOT)/lib/careadlinkat.h \
- $(EMACS_ROOT)/lib/ignore-value.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/cm.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
$(SRC)/sysselect.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/systty.h \
$(SRC)/syswait.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
- $(SRC)/w32.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/netdb.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/allocator.h \
+ $(GNU_LIB)/ignore-value.h \
+ $(BLOCKINPUT_H) \
+ $(CAREADLINKAT_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(GRP_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SOCKET_H) \
+ $(SYSTIME_H) \
+ $(SYSTTY_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/term.$(O) : \
$(SRC)/term.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
$(SRC)/cm.h \
- $(SRC)/coding.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/syssignal.h \
- $(SRC)/systime.h \
- $(SRC)/systty.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
$(SRC)/tparam.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/unistd.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(SYSTTY_H) \
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/terminal.$(O) : \
$(SRC)/terminal.c \
+ $(SRC)/termchar.h \
+ $(CHARSET_H) \
+ $(CODING_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h
+ $(TERMHOOKS_H)
$(BLD)/textprop.$(O) : \
$(SRC)/textprop.c \
+ $(SRC)/buffer.h \
$(CONFIG_H) \
+ $(INTERVALS_H) \
$(LISP_H) \
- $(SRC)/buffer.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/intervals.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(WINDOW_H)
$(BLD)/tparam.$(O) : \
$(SRC)/tparam.c \
+ $(SRC)/tparam.h \
$(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/tparam.h
+ $(LISP_H)
$(BLD)/undo.$(O) : \
$(SRC)/undo.c \
- $(CONFIG_H) \
- $(LISP_H) \
$(SRC)/buffer.h \
$(SRC)/commands.h \
- $(SRC)/dispextern.h \
- $(SRC)/w32gui.h \
- $(SRC)/window.h
+ $(CONFIG_H) \
+ $(LISP_H) \
+ $(WINDOW_H)
$(BLD)/unexw32.$(O) : \
$(SRC)/unexw32.c \
- $(CONFIG_H) \
$(SRC)/unexec.h \
- $(SRC)/w32heap.h
+ $(SRC)/w32heap.h \
+ $(CONFIG_H)
$(BLD)/vm-limit.$(O) : \
$(SRC)/vm-limit.c \
+ $(SRC)/mem-limits.h \
$(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/mem-limits.h
+ $(LISP_H)
$(BLD)/window.$(O) : \
$(SRC)/window.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/frame.h \
$(SRC)/indent.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/xdisp.$(O) : \
$(SRC)/xdisp.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
$(SRC)/commands.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
$(SRC)/indent.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
$(SRC)/macros.h \
$(SRC)/region-cache.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/xfaces.$(O) : \
$(SRC)/xfaces.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(NT_INC)/sys/stat.h \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/w32fns.$(O) : \
$(SRC)/w32fns.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/epaths.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
$(SRC)/w32.h \
$(SRC)/w32font.h \
- $(SRC)/w32gui.h \
$(SRC)/w32heap.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(SYSTIME_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/w32menu.$(O) : \
$(SRC)/w32menu.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
- $(SRC)/menu.h \
- $(SRC)/systime.h \
- $(SRC)/termhooks.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(BLOCKINPUT_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(MENU_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/w32term.$(O) : \
$(SRC)/w32term.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(PROCESS_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
$(SRC)/disptab.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/intervals.h \
- $(SRC)/keyboard.h \
$(SRC)/keymap.h \
- $(SRC)/systime.h \
- $(SRC)/systty.h \
$(SRC)/termchar.h \
- $(SRC)/termhooks.h \
$(SRC)/termopts.h \
$(SRC)/w32font.h \
- $(SRC)/w32gui.h \
$(SRC)/w32heap.h \
- $(SRC)/w32term.h \
- $(SRC)/window.h
+ $(NT_INC)/sys/stat.h \
+ $(ATIMER_H) \
+ $(BLOCKINPUT_H) \
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(INTERVALS_H) \
+ $(KEYBOARD_H) \
+ $(LISP_H) \
+ $(PROCESS_H) \
+ $(SYSTIME_H) \
+ $(SYSTTY_H) \
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/w32select.$(O) : \
$(SRC)/w32select.c \
- $(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
- $(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
$(SRC)/composite.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
$(SRC)/w32heap.h \
- $(SRC)/w32term.h
+ $(BLOCKINPUT_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(LISP_H) \
+ $(W32TERM_H)
$(BLD)/w32reg.$(O) : \
$(SRC)/w32reg.c \
+ $(BLOCKINPUT_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h
+ $(W32TERM_H)
$(BLD)/w32xfns.$(O) : \
$(SRC)/w32xfns.c \
+ $(SRC)/fontset.h \
+ $(BLOCKINPUT_H) \
+ $(CHARSET_H) \
$(CONFIG_H) \
- $(EMACS_ROOT)/nt/inc/sys/time.h \
+ $(FRAME_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
- $(SRC)/atimer.h \
- $(SRC)/blockinput.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/fontset.h \
- $(SRC)/frame.h \
- $(SRC)/keyboard.h \
- $(SRC)/systime.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h
+ $(W32TERM_H)
$(BLD)/w32font.$(O) : \
$(SRC)/w32font.c \
- $(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
- $(SRC)/coding.h \
- $(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
$(SRC)/w32font.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CODING_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(W32TERM_H)
$(BLD)/w32uniscribe.$(O) : \
$(SRC)/w32uniscribe.c \
- $(CONFIG_H) \
- $(LISP_H) \
- $(SRC)/ccl.h \
- $(SRC)/character.h \
- $(SRC)/charset.h \
$(SRC)/composite.h \
- $(SRC)/dispextern.h \
- $(SRC)/font.h \
$(SRC)/fontset.h \
- $(SRC)/frame.h \
$(SRC)/w32font.h \
- $(SRC)/w32gui.h \
- $(SRC)/w32term.h
+ $(CHARACTER_H) \
+ $(CHARSET_H) \
+ $(CONFIG_H) \
+ $(DISPEXTERN_H) \
+ $(FONT_H) \
+ $(FRAME_H) \
+ $(LISP_H) \
+ $(W32TERM_H)
# Each object file depends on stamp_BLD, because in parallel builds we must
# make sure $(BLD) exists before starting compilations.
diff --git a/src/mem-limits.h b/src/mem-limits.h
index 09be61be52c..86b2f44846d 100644
--- a/src/mem-limits.h
+++ b/src/mem-limits.h
@@ -33,15 +33,12 @@ extern int etext;
# endif
#endif
-typedef unsigned long SIZE;
-
extern char *start_of_data (void);
#if defined USE_LSB_TAG
#define EXCEEDS_LISP_PTR(ptr) 0
#elif defined DATA_SEG_BITS
#define EXCEEDS_LISP_PTR(ptr) \
- (((EMACS_UINT) (ptr) & ~DATA_SEG_BITS) >> VALBITS)
+ (((uintptr_t) (ptr) & ~DATA_SEG_BITS) >> VALBITS)
#else
-#define EXCEEDS_LISP_PTR(ptr) ((EMACS_UINT) (ptr) >> VALBITS)
+#define EXCEEDS_LISP_PTR(ptr) ((uintptr_t) (ptr) >> VALBITS)
#endif
-
diff --git a/src/menu.c b/src/menu.c
index 7a3edcb6f4f..fa31c8a51c1 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -21,6 +21,7 @@ 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"
#include "keyboard.h"
@@ -66,6 +67,9 @@ Lisp_Object menu_items;
/* If non-nil, means that the global vars defined here are already in use.
Used to detect cases where we try to re-enter this non-reentrant code. */
+#if ! (defined USE_GTK || defined USE_MOTIF)
+static
+#endif
Lisp_Object menu_items_inuse;
/* Number of slots currently allocated in menu_items. */
@@ -176,6 +180,8 @@ save_menu_items (void)
static void
grow_menu_items (void)
{
+ 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);
}
@@ -1145,13 +1151,13 @@ no quit occurs and `x-popup-menu' returns nil. */)
#else /* not HAVE_X_WINDOWS */
Lisp_Object bar_window;
enum scroll_bar_part part;
- unsigned long time;
+ Time time;
void (*mouse_position_hook) (struct frame **, int,
Lisp_Object *,
enum scroll_bar_part *,
Lisp_Object *,
Lisp_Object *,
- unsigned long *) =
+ Time *) =
FRAME_TERMINAL (new_f)->mouse_position_hook;
if (mouse_position_hook)
diff --git a/src/menu.h b/src/menu.h
index c3978dae8eb..451401b42d5 100644
--- a/src/menu.h
+++ b/src/menu.h
@@ -19,6 +19,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef MENU_H
#define MENU_H
+#include "systime.h" /* for Time */
+
extern void x_set_menu_bar_lines (struct frame *f,
Lisp_Object value,
Lisp_Object oldval);
@@ -48,6 +50,5 @@ extern Lisp_Object w32_menu_show (FRAME_PTR, int, int, int, int,
extern Lisp_Object ns_menu_show (FRAME_PTR, int, int, int, int,
Lisp_Object, const char **);
extern Lisp_Object xmenu_show (FRAME_PTR, int, int, int, int,
- Lisp_Object, const char **, EMACS_UINT);
+ Lisp_Object, const char **, Time);
#endif /* MENU_H */
-
diff --git a/src/minibuf.c b/src/minibuf.c
index 3f8bd835211..cf37c337be4 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -25,7 +25,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
-#include "character.h"
#include "dispextern.h"
#include "keyboard.h"
#include "frame.h"
@@ -43,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Lisp_Object Vminibuffer_list;
-/* Data to remember during recursive minibuffer invocations */
+/* Data to remember during recursive minibuffer invocations. */
static Lisp_Object minibuf_save_list;
@@ -55,7 +54,7 @@ int minibuf_level;
static Lisp_Object Qhistory_length;
-/* Fread_minibuffer leaves the input here as a string. */
+/* Fread_minibuffer leaves the input here as a string. */
Lisp_Object last_minibuf_string;
@@ -72,7 +71,6 @@ 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 Qcompleting_read_default;
static Lisp_Object Quser_variable_p;
static Lisp_Object Qminibuffer_default;
@@ -143,6 +141,14 @@ choose_minibuf_frame_1 (Lisp_Object ignore)
return Qnil;
}
+DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
+ Sactive_minibuffer_window, 0, 0, 0,
+ doc: /* Return the currently active minibuffer window, or nil if none. */)
+ (void)
+{
+ return minibuf_level ? minibuf_window : Qnil;
+}
+
DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
Sset_minibuffer_window, 1, 1, 0,
doc: /* Specify which minibuffer window to use for the minibuffer.
@@ -160,7 +166,7 @@ without invoking the usual minibuffer commands. */)
}
-/* Actual minibuffer invocation. */
+/* Actual minibuffer invocation. */
static Lisp_Object read_minibuf_unwind (Lisp_Object);
static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
@@ -229,7 +235,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
Lisp_Object defalt,
int allow_props, int inherit_input_method)
{
- size_t size, len;
+ ptrdiff_t size, len;
char *line, *s;
Lisp_Object val;
@@ -239,24 +245,22 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
val = Qnil;
size = 100;
len = 0;
- line = (char *) xmalloc (size * sizeof *line);
+ line = (char *) xmalloc (size);
while ((s = fgets (line + len, size - len, stdin)) != NULL
&& (len = strlen (line),
len == size - 1 && line[len - 1] != '\n'))
{
- if ((size_t) -1 / 2 < size)
- memory_full ();
+ if (STRING_BYTES_BOUND / 2 < size)
+ memory_full (SIZE_MAX);
size *= 2;
line = (char *) xrealloc (line, size);
}
if (s)
{
- len = strlen (line);
-
- if (len > 0 && line[len - 1] == '\n')
- line[--len] = '\0';
-
+ char *nl = strchr (line, '\n');
+ if (nl)
+ *nl = '\0';
val = build_string (line);
xfree (line);
}
@@ -266,7 +270,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
error ("Error reading from stdin");
}
- /* If Lisp form desired instead of string, parse it. */
+ /* If Lisp form desired instead of string, parse it. */
if (expflag)
val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
@@ -588,7 +592,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Empty out the minibuffers of all frames other than the one
where we are going to display one now.
Set them to point to ` *Minibuf-0*', which is always empty. */
- empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*"));
+ empty_minibuf = get_minibuffer (0);
FOR_EACH_FRAME (dummy, frame)
{
@@ -743,7 +747,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
}
}
- /* If Lisp form desired instead of string, parse it. */
+ /* If Lisp form desired instead of string, parse it. */
if (expflag)
val = string_to_object (val, defalt);
@@ -755,7 +759,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Return a buffer to be used as the minibuffer at depth `depth'.
depth = 0 is the lowest allowed argument, and that is the value
- used for nonrecursive minibuffer invocations */
+ used for nonrecursive minibuffer invocations. */
Lisp_Object
get_minibuffer (int depth)
@@ -793,7 +797,10 @@ get_minibuffer (int depth)
reset_buffer (XBUFFER (buf));
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
Fset_buffer (buf);
- Fkill_all_local_variables ();
+ if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
+ call0 (intern ("minibuffer-inactive-mode"));
+ else
+ Fkill_all_local_variables ();
unbind_to (count, Qnil);
}
@@ -808,7 +815,7 @@ run_exit_minibuf_hook (Lisp_Object data)
}
/* This function is called on exiting minibuffer, whether normally or
- not, and it restores the current window, buffer, etc. */
+ not, and it restores the current window, buffer, etc. */
static Lisp_Object
read_minibuf_unwind (Lisp_Object data)
@@ -868,6 +875,12 @@ read_minibuf_unwind (Lisp_Object data)
windows_or_buffers_changed++;
XSETFASTINT (XWINDOW (window)->last_modified, 0);
XSETFASTINT (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,
+ to make sure we don't leave around bindings and stuff which only
+ made sense during the read_minibuf invocation. */
+ call0 (intern ("minibuffer-inactive-mode"));
return Qnil;
}
@@ -978,7 +991,7 @@ Such arguments are used as in `read-from-minibuffer'.) */)
Qnil);
}
-/* Functions that use the minibuffer to read various things. */
+/* Functions that use the minibuffer to read various things. */
DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
doc: /* Read a string from the minibuffer, prompting with string PROMPT.
@@ -1098,7 +1111,7 @@ function, instead of the usual behavior. */)
{
Lisp_Object args[4], result;
char *s;
- int len;
+ ptrdiff_t len;
int count = SPECPDL_INDEX ();
if (BUFFERP (def))
@@ -1120,7 +1133,7 @@ function, instead of the usual behavior. */)
if (STRINGP (prompt))
{
s = SSDATA (prompt);
- len = strlen (s);
+ len = SBYTES (prompt);
if (len >= 2 && s[len - 2] == ':' && s[len - 1] == ' ')
len = len - 2;
else if (len >= 1 && (s[len - 1] == ':' || s[len - 1] == ' '))
@@ -1137,8 +1150,8 @@ function, instead of the usual behavior. */)
}
result = Fcompleting_read (prompt, intern ("internal-complete-buffer"),
- Qnil, require_match, Qnil, Qbuffer_name_history,
- def, Qnil);
+ Qnil, require_match, Qnil,
+ Qbuffer_name_history, def, Qnil);
}
else
{
@@ -1146,7 +1159,7 @@ function, instead of the usual behavior. */)
args[1] = prompt;
args[2] = def;
args[3] = require_match;
- result = Ffuncall(4, args);
+ result = Ffuncall (4, args);
}
return unbind_to (count, result);
}
@@ -1209,7 +1222,7 @@ is used to further constrain the set of candidates. */)
&& (!SYMBOLP (XCAR (collection))
|| NILP (XCAR (collection)))))
? list_table : function_table));
- int idx = 0, obsize = 0;
+ EMACS_INT idx = 0, obsize = 0;
int matchcount = 0;
int bindcount = -1;
Lisp_Object bucket, zero, end, tem;
@@ -1233,10 +1246,10 @@ is used to further constrain the set of candidates. */)
while (1)
{
- /* Get the next element of the alist, obarray, or hash-table. */
- /* Exit the loop if the elements are all used up. */
+ /* Get the next element of the alist, obarray, or hash-table. */
+ /* Exit the loop if the elements are all used up. */
/* elt gets the alist element or symbol.
- eltstring gets the name to check as a completion. */
+ eltstring gets the name to check as a completion. */
if (type == list_table)
{
@@ -1278,7 +1291,7 @@ is used to further constrain the set of candidates. */)
elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
}
- /* Is this element a possible completion? */
+ /* Is this element a possible completion? */
if (SYMBOLP (eltstring))
eltstring = Fsymbol_name (eltstring);
@@ -1291,7 +1304,7 @@ is used to further constrain the set of candidates. */)
completion_ignore_case ? Qt : Qnil),
EQ (Qt, tem)))
{
- /* Yes. */
+ /* Yes. */
Lisp_Object regexps;
/* Ignore this element if it fails to match all the regexps. */
@@ -1313,7 +1326,7 @@ is used to further constrain the set of candidates. */)
}
/* Ignore this element if there is a predicate
- and the predicate doesn't like it. */
+ and the predicate doesn't like it. */
if (!NILP (predicate))
{
@@ -1415,7 +1428,7 @@ is used to further constrain the set of candidates. */)
}
if (NILP (bestmatch))
- return Qnil; /* No completions found */
+ return Qnil; /* No completions found. */
/* If we are ignoring case, and there is no exact match,
and no additional text was supplied,
don't change the case of what the user typed. */
@@ -1429,7 +1442,7 @@ is used to further constrain the set of candidates. */)
return Qt;
XSETFASTINT (zero, 0); /* Else extract the part in which */
- XSETFASTINT (end, bestmatchsize); /* all completions agree */
+ XSETFASTINT (end, bestmatchsize); /* all completions agree. */
return Fsubstring (bestmatch, zero, end);
}
@@ -1474,7 +1487,7 @@ with a space are ignored unless STRING itself starts with a space. */)
: NILP (collection) || (CONSP (collection)
&& (!SYMBOLP (XCAR (collection))
|| NILP (XCAR (collection))));
- int idx = 0, obsize = 0;
+ EMACS_INT idx = 0, obsize = 0;
int bindcount = -1;
Lisp_Object bucket, tem, zero;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@@ -1496,10 +1509,10 @@ with a space are ignored unless STRING itself starts with a space. */)
while (1)
{
- /* Get the next element of the alist, obarray, or hash-table. */
- /* Exit the loop if the elements are all used up. */
+ /* Get the next element of the alist, obarray, or hash-table. */
+ /* Exit the loop if the elements are all used up. */
/* elt gets the alist element or symbol.
- eltstring gets the name to check as a completion. */
+ eltstring gets the name to check as a completion. */
if (type == 1)
{
@@ -1541,7 +1554,7 @@ with a space are ignored unless STRING itself starts with a space. */)
elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
}
- /* Is this element a possible completion? */
+ /* Is this element a possible completion? */
if (SYMBOLP (eltstring))
eltstring = Fsymbol_name (eltstring);
@@ -1561,7 +1574,7 @@ with a space are ignored unless STRING itself starts with a space. */)
completion_ignore_case ? Qt : Qnil),
EQ (Qt, tem)))
{
- /* Yes. */
+ /* Yes. */
Lisp_Object regexps;
/* Ignore this element if it fails to match all the regexps. */
@@ -1583,7 +1596,7 @@ with a space are ignored unless STRING itself starts with a space. */)
}
/* Ignore this element if there is a predicate
- and the predicate doesn't like it. */
+ and the predicate doesn't like it. */
if (!NILP (predicate))
{
@@ -1604,7 +1617,7 @@ with a space are ignored unless STRING itself starts with a space. */)
}
if (NILP (tem)) continue;
}
- /* Ok => put it on the list. */
+ /* Ok => put it on the list. */
allmatches = Fcons (eltstring, allmatches);
}
}
@@ -1677,7 +1690,7 @@ See also `completing-read-function'. */)
(Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate, Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist, Lisp_Object def, Lisp_Object inherit_input_method)
{
Lisp_Object args[9];
- args[0] = Vcompleting_read_function;
+ args[0] = Fsymbol_value (intern ("completing-read-function"));
args[1] = prompt;
args[2] = collection;
args[3] = predicate;
@@ -1688,76 +1701,6 @@ See also `completing-read-function'. */)
args[8] = inherit_input_method;
return Ffuncall (9, args);
}
-
-DEFUN ("completing-read-default", Fcompleting_read_default, Scompleting_read_default, 2, 8, 0,
- doc: /* Default method for reading from the minibuffer with completion.
-See `completing-read' for the meaning of the arguments. */)
- (Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate, Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist, Lisp_Object def, Lisp_Object inherit_input_method)
-{
- Lisp_Object val, histvar, histpos, position;
- Lisp_Object init;
- int pos = 0;
- int count = SPECPDL_INDEX ();
- struct gcpro gcpro1;
-
- init = initial_input;
- GCPRO1 (def);
-
- specbind (Qminibuffer_completion_table, collection);
- specbind (Qminibuffer_completion_predicate, predicate);
- specbind (Qminibuffer_completion_confirm,
- EQ (require_match, Qt) ? Qnil : require_match);
-
- position = Qnil;
- if (!NILP (init))
- {
- if (CONSP (init))
- {
- position = Fcdr (init);
- init = Fcar (init);
- }
- CHECK_STRING (init);
- if (!NILP (position))
- {
- CHECK_NUMBER (position);
- /* Convert to distance from end of input. */
- pos = XINT (position) - SCHARS (init);
- }
- }
-
- if (SYMBOLP (hist))
- {
- histvar = hist;
- histpos = Qnil;
- }
- else
- {
- histvar = Fcar_safe (hist);
- histpos = Fcdr_safe (hist);
- }
- if (NILP (histvar))
- histvar = Qminibuffer_history;
- if (NILP (histpos))
- XSETFASTINT (histpos, 0);
-
- val = read_minibuf (NILP (require_match)
- ? (NILP (Vminibuffer_completing_file_name)
- || EQ (Vminibuffer_completing_file_name, Qlambda)
- ? Vminibuffer_local_completion_map
- : Vminibuffer_local_filename_completion_map)
- : (NILP (Vminibuffer_completing_file_name)
- || EQ (Vminibuffer_completing_file_name, Qlambda)
- ? Vminibuffer_local_must_match_map
- : Vminibuffer_local_filename_must_match_map),
- init, prompt, make_number (pos), 0,
- histvar, histpos, def, 0,
- !NILP (inherit_input_method));
-
- if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
- val = CONSP (def) ? XCAR (def) : def;
-
- RETURN_UNGCPRO (unbind_to (count, val));
-}
Lisp_Object Fassoc_string (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold);
@@ -1770,7 +1713,7 @@ the values STRING, PREDICATE and `lambda'. */)
(Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
{
Lisp_Object regexps, tail, tem = Qnil;
- int i = 0;
+ EMACS_INT i = 0;
CHECK_STRING (string);
@@ -1810,9 +1753,9 @@ the values STRING, PREDICATE and `lambda'. */)
if (SYMBOLP (tail))
while (1)
{
- if (EQ((Fcompare_strings (string, make_number (0), Qnil,
+ if (EQ (Fcompare_strings (string, make_number (0), Qnil,
Fsymbol_name (tail),
- make_number (0) , Qnil, Qt)),
+ make_number (0) , Qnil, Qt),
Qt))
{
tem = tail;
@@ -1836,11 +1779,11 @@ the values STRING, PREDICATE and `lambda'. */)
tem = HASH_KEY (h, i);
else
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i)) &&
- EQ (Fcompare_strings (string, make_number (0), Qnil,
- HASH_KEY (h, i), make_number (0) , Qnil,
- completion_ignore_case ? Qt : Qnil),
- Qt))
+ if (!NILP (HASH_HASH (h, i))
+ && EQ (Fcompare_strings (string, make_number (0), Qnil,
+ HASH_KEY (h, i), make_number (0) , Qnil,
+ completion_ignore_case ? Qt : Qnil),
+ Qt))
{
tem = HASH_KEY (h, i);
break;
@@ -1878,13 +1821,16 @@ the values STRING, PREDICATE and `lambda'. */)
return Qt;
}
+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'.
The arguments STRING and PREDICATE are as in `try-completion',
-`all-completions', and `test-completion'. */)
+`all-completions', and `test-completion'. */)
(Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
{
if (NILP (flag))
@@ -1912,8 +1858,12 @@ The arguments STRING and PREDICATE are as in `try-completion',
return res;
}
}
- else /* assume `lambda' */
+ else if (EQ (flag, Qlambda))
return Ftest_completion (string, Vbuffer_alist, predicate);
+ else if (EQ (flag, Qmetadata))
+ return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil));
+ else
+ return Qnil;
}
/* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
@@ -1989,66 +1939,37 @@ syms_of_minibuf (void)
minibuf_save_list = Qnil;
staticpro (&minibuf_save_list);
- Qcompleting_read_default = intern_c_string ("completing-read-default");
- staticpro (&Qcompleting_read_default);
-
- Qcompletion_ignore_case = intern_c_string ("completion-ignore-case");
- staticpro (&Qcompletion_ignore_case);
-
- Qread_file_name_internal = intern_c_string ("read-file-name-internal");
- staticpro (&Qread_file_name_internal);
-
- Qminibuffer_default = intern_c_string ("minibuffer-default");
- staticpro (&Qminibuffer_default);
+ DEFSYM (Qcompletion_ignore_case, "completion-ignore-case");
+ DEFSYM (Qread_file_name_internal, "read-file-name-internal");
+ DEFSYM (Qminibuffer_default, "minibuffer-default");
Fset (Qminibuffer_default, Qnil);
- Qminibuffer_completion_table = intern_c_string ("minibuffer-completion-table");
- staticpro (&Qminibuffer_completion_table);
-
- Qminibuffer_completion_confirm = intern_c_string ("minibuffer-completion-confirm");
- staticpro (&Qminibuffer_completion_confirm);
-
- Qminibuffer_completion_predicate = intern_c_string ("minibuffer-completion-predicate");
- staticpro (&Qminibuffer_completion_predicate);
+ DEFSYM (Qminibuffer_completion_table, "minibuffer-completion-table");
+ DEFSYM (Qminibuffer_completion_confirm, "minibuffer-completion-confirm");
+ DEFSYM (Qminibuffer_completion_predicate, "minibuffer-completion-predicate");
staticpro (&last_minibuf_string);
last_minibuf_string = Qnil;
- Quser_variable_p = intern_c_string ("user-variable-p");
- staticpro (&Quser_variable_p);
-
- Qminibuffer_history = intern_c_string ("minibuffer-history");
- staticpro (&Qminibuffer_history);
-
- Qbuffer_name_history = intern_c_string ("buffer-name-history");
- staticpro (&Qbuffer_name_history);
+ DEFSYM (Quser_variable_p, "user-variable-p");
+ DEFSYM (Qminibuffer_history, "minibuffer-history");
+ DEFSYM (Qbuffer_name_history, "buffer-name-history");
Fset (Qbuffer_name_history, Qnil);
- Qminibuffer_setup_hook = intern_c_string ("minibuffer-setup-hook");
- staticpro (&Qminibuffer_setup_hook);
-
- Qminibuffer_exit_hook = intern_c_string ("minibuffer-exit-hook");
- staticpro (&Qminibuffer_exit_hook);
-
- Qhistory_length = intern_c_string ("history-length");
- staticpro (&Qhistory_length);
-
- Qcurrent_input_method = intern_c_string ("current-input-method");
- staticpro (&Qcurrent_input_method);
-
- Qactivate_input_method = intern_c_string ("activate-input-method");
- staticpro (&Qactivate_input_method);
-
- Qcase_fold_search = intern_c_string ("case-fold-search");
- staticpro (&Qcase_fold_search);
+ DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
+ DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
+ DEFSYM (Qhistory_length, "history-length");
+ DEFSYM (Qcurrent_input_method, "current-input-method");
+ DEFSYM (Qactivate_input_method, "activate-input-method");
+ DEFSYM (Qcase_fold_search, "case-fold-search");
+ DEFSYM (Qmetadata, "metadata");
DEFVAR_LISP ("read-expression-history", Vread_expression_history,
doc: /* A history list for arguments that are Lisp expressions to evaluate.
For example, `eval-expression' uses this. */);
Vread_expression_history = Qnil;
- Qread_expression_history = intern_c_string ("read-expression-history");
- staticpro (&Qread_expression_history);
+ DEFSYM (Qread_expression_history, "read-expression-history");
DEFVAR_LISP ("read-buffer-function", Vread_buffer_function,
doc: /* If this is non-nil, `read-buffer' does its work by calling this function.
@@ -2136,12 +2057,6 @@ If the value is `confirm-after-completion', the user may exit with an
doc: /* Non-nil means completing file names. */);
Vminibuffer_completing_file_name = Qnil;
- DEFVAR_LISP ("completing-read-function",
- Vcompleting_read_function,
- doc: /* The function called by `completing-read' to do the work.
-It should accept the same arguments as `completing-read'. */);
- Vcompleting_read_function = Qcompleting_read_default;
-
DEFVAR_LISP ("minibuffer-help-form", Vminibuffer_help_form,
doc: /* Value that `help-form' takes on inside the minibuffer. */);
Vminibuffer_help_form = Qnil;
@@ -2193,6 +2108,7 @@ properties. */);
doc: /* Minibuffer keymap used for reading Lisp expressions. */);
Vread_expression_map = Qnil;
+ defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
defsubr (&Seval_minibuffer);
@@ -2217,5 +2133,4 @@ properties. */);
defsubr (&Stest_completion);
defsubr (&Sassoc_string);
defsubr (&Scompleting_read);
- defsubr (&Scompleting_read_default);
}
diff --git a/src/msdos.c b/src/msdos.c
index 3dc586e42f5..3f12bc85cbe 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -287,7 +287,7 @@ mouse_button_depressed (int b, int *xp, int *yp)
void
mouse_get_pos (FRAME_PTR *f, int insist, Lisp_Object *bar_window,
enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y,
- unsigned long *time)
+ Time *time)
{
int ix, iy;
Lisp_Object frame, tail;
@@ -4267,8 +4267,7 @@ syms_of_msdos (void)
#ifndef HAVE_X_WINDOWS
/* The following two are from xfns.c: */
- Qreverse = intern_c_string ("reverse");
- staticpro (&Qreverse);
+ 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.
diff --git a/src/nsfns.m b/src/nsfns.m
index cdf350066be..0452086201e 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -162,7 +162,7 @@ check_ns_display_info (Lisp_Object frame)
struct terminal *t = get_terminal (frame, 1);
if (t->type != output_ns)
- error ("Terminal %d is not a Nextstep display", XINT (frame));
+ error ("Terminal %ld is not a Nextstep display", (long) XINT (frame));
return t->display_info.ns;
}
@@ -1728,8 +1728,9 @@ terminate Emacs if we can't open the connection.
/* Register our external input/output types, used for determining
applicable services and also drag/drop eligibility. */
- ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
- ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
+ ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
+ ns_return_types = [[NSArray arrayWithObjects: NSStringPboardType, nil]
+ retain];
ns_drag_types = [[NSArray arrayWithObjects:
NSStringPboardType,
NSTabularTextPboardType,
@@ -1876,6 +1877,10 @@ DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
doc: /* List available Nextstep services by querying NSApp. */)
(void)
{
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ /* You can't get services like this in 10.6+. */
+ return Qnil;
+#else
Lisp_Object ret = Qnil;
NSMenu *svcs;
id delegate;
@@ -1919,6 +1924,7 @@ DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
ret = interpret_services_menu (svcs, Qnil, ret);
return ret;
+#endif
}
diff --git a/src/nsgui.h b/src/nsgui.h
index a6955630941..999dc27e310 100644
--- a/src/nsgui.h
+++ b/src/nsgui.h
@@ -30,6 +30,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef init_process
#endif /* NS_IMPL_COCOA */
+#undef verify
+
#import <AppKit/AppKit.h>
#ifdef NS_IMPL_COCOA
@@ -44,6 +46,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif /* __OBJC__ */
+#undef verify
+#undef _GL_VERIFY_H
+#include <verify.h>
/* menu-related */
#define free_widget_value(wv) xfree (wv)
diff --git a/src/nsimage.m b/src/nsimage.m
index c38cefdc5d5..2cb0c3bff76 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -189,7 +189,11 @@ static EmacsImage *ImageList = nil;
image = [[EmacsImage alloc] initByReferencingFile:
[NSString stringWithUTF8String: SDATA (found)]];
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]];
+#else
imgRep = [image bestRepresentationForDevice: nil];
+#endif
if (imgRep == nil)
{
[image release];
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 2a2f952e751..6a9ee7dd4f5 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -457,7 +457,6 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
{
/* but we need to make sure it will update on demand */
[svcsMenu setFrame: f];
- [svcsMenu setDelegate: svcsMenu];
}
else
#endif
@@ -696,9 +695,11 @@ set_frame_menubar (struct frame *f, int first_time, int deep_p)
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
}
diff --git a/src/nsselect.m b/src/nsselect.m
index 950fb1f1f14..867cf3252e5 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -175,7 +175,7 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
}
-static Lisp_Object
+Lisp_Object
ns_get_local_selection (Lisp_Object selection_name,
Lisp_Object target_type)
{
@@ -352,16 +352,22 @@ 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)
{
utfStr = [mstr cString];
length = strlen (utfStr);
}
+#endif
}
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
+ utfStr = "Conversion failed";
+#else
utfStr = [str lossyCString];
+#endif
length = strlen (utfStr);
}
NS_ENDHANDLER
diff --git a/src/nsterm.h b/src/nsterm.h
index 09ec8c19b1a..f419391a11e 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -25,6 +25,21 @@ 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
+#ifndef MAC_OS_X_VERSION_10_5
+#define MAC_OS_X_VERSION_10_5 1050
+#endif
+#ifndef MAC_OS_X_VERSION_10_6
+#define MAC_OS_X_VERSION_10_6 1060
+#endif
+#endif /* NS_IMPL_COCOA */
+
#ifdef __OBJC__
/* ==========================================================================
@@ -55,7 +70,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
@class EmacsToolbar;
-@interface EmacsView : NSView <NSTextInput> /* 10.6+: NSWindowDelegate */
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+@interface EmacsView : NSView <NSTextInput, NSWindowDelegate>
+#else
+@interface EmacsView : NSView <NSTextInput>
+#endif
{
char *old_title;
BOOL windowClosing;
@@ -106,7 +125,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
========================================================================== */
-@interface EmacsMenu : NSMenu /* 10.6+: <NSMenuDelegate> */
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+@interface EmacsMenu : NSMenu <NSMenuDelegate>
+#else
+@interface EmacsMenu : NSMenu
+#endif
{
struct frame *frame;
unsigned long keyEquivModMask;
@@ -133,7 +156,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
@class EmacsImage;
-@interface EmacsToolbar : NSToolbar /* 10.6+: <NSToolbarDelegate> */
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+@interface EmacsToolbar : NSToolbar <NSToolbarDelegate>
+#else
+@interface EmacsToolbar : NSToolbar
+#endif
{
EmacsView *emacsView;
NSMutableDictionary *identifierToItem;
@@ -176,7 +203,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
- (Lisp_Object)runDialogAt: (NSPoint)p;
@end
-@interface EmacsTooltip : NSObject /* 10.6+: <NSWindowDelegate> */
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+@interface EmacsTooltip : NSObject <NSWindowDelegate>
+#else
+@interface EmacsTooltip : NSObject
+#endif
{
NSWindow *win;
NSTextField *textField;
@@ -468,8 +499,8 @@ struct ns_display_info
int smallest_font_height;
struct ns_bitmap_record *bitmaps;
- int bitmaps_size;
- int bitmaps_last;
+ ptrdiff_t bitmaps_size;
+ ptrdiff_t bitmaps_last;
struct image_cache *image_cache;
@@ -700,6 +731,8 @@ 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_get_local_selection (Lisp_Object selection_name,
+ Lisp_Object target_type);
extern void nxatoms_of_nsselect ();
extern int ns_lisp_to_cursor_type ();
extern Lisp_Object ns_cursor_type_to_lisp (int arg);
@@ -818,4 +851,3 @@ extern char gnustep_base_version[]; /* version tracking */
#endif /* HAVE_NS */
-
diff --git a/src/nsterm.m b/src/nsterm.m
index c4756dc83cd..546247ab74a 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -134,11 +134,12 @@ static unsigned convert_ns_to_X_keysym[] =
0x1B, 0x1B /* escape */
};
-
static Lisp_Object Qmodifier_value;
Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper, Qnone;
extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft;
+static Lisp_Object QUTF8_STRING;
+
/* On OS X picks up the default NSGlobalDomain AppleAntiAliasingThreshold,
the maximum font size to NOT antialias. On GNUstep there is currently
no way to control this behavior. */
@@ -158,7 +159,7 @@ long context_menu_value = 0;
/* display update */
NSPoint last_mouse_motion_position;
static NSRect last_mouse_glyph;
-static unsigned long last_mouse_movement_time = 0;
+static Time last_mouse_movement_time = 0;
static Lisp_Object last_mouse_motion_frame;
static EmacsScroller *last_mouse_scroll_bar = nil;
static struct frame *ns_updating_frame;
@@ -1789,7 +1790,7 @@ note_mouse_movement (struct frame *frame, float x, float y)
static void
ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y,
- unsigned long *time)
+ Time *time)
/* --------------------------------------------------------------------------
External (hook): inform emacs about mouse position and hit parts.
If a scrollbar is being dragged, set bar_window, part, x, y, time.
@@ -4058,6 +4059,8 @@ ns_term_init (Lisp_Object display_name)
void
ns_term_shutdown (int sig)
{
+ [[NSUserDefaults standardUserDefaults] synchronize];
+
/* 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));
@@ -4512,7 +4515,9 @@ ns_term_shutdown (int sig)
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;
NSTRACE (keyDown);
@@ -4700,13 +4705,15 @@ ns_term_shutdown (int sig)
}
}
+
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
/* if we get here we should send the key for input manager processing */
if (firstTime && [[NSInputManager currentInputManager]
wantsToDelayTextChangeNotifications] == NO)
fprintf (stderr,
"Emacs: WARNING: TextInput mgr wants marked text to be permanent!\n");
firstTime = NO;
-
+#endif
if (NS_KEYLOG && !processingCompose)
fprintf (stderr, "keyDown: Begin compose sequence.\n");
@@ -5362,6 +5369,9 @@ ns_term_shutdown (int sig)
[self allocateGState];
+ [NSApp registerServicesMenuSendTypes: ns_send_types
+ returnTypes: nil];
+
ns_window_num++;
return self;
}
@@ -5733,13 +5743,16 @@ ns_term_shutdown (int sig)
}
-- validRequestorForSendType: (NSString *)typeSent
- returnType: (NSString *)typeReturned
+- (id) validRequestorForSendType: (NSString *)typeSent
+ returnType: (NSString *)typeReturned
{
NSTRACE (validRequestorForSendType);
- if ([ns_send_types indexOfObjectIdenticalTo: typeSent] != NSNotFound &&
- [ns_return_types indexOfObjectIdenticalTo: typeSent] != NSNotFound)
- return self;
+ if (typeSent != nil && [ns_send_types indexOfObject: typeSent] != NSNotFound
+ && typeReturned == nil)
+ {
+ if (! NILP (ns_get_local_selection (QPRIMARY, QUTF8_STRING)))
+ return self;
+ }
return [super validRequestorForSendType: typeSent
returnType: typeReturned];
@@ -5763,8 +5776,28 @@ ns_term_shutdown (int sig)
- (BOOL) writeSelectionToPasteboard: (NSPasteboard *)pb types: (NSArray *)types
{
- /* supposed to write for as many of types as we are able */
- return NO;
+ NSArray *typesDeclared;
+ Lisp_Object val;
+
+ /* We only support NSStringPboardType */
+ if ([types containsObject:NSStringPboardType] == NO) {
+ return NO;
+ }
+
+ val = ns_get_local_selection (QPRIMARY, QUTF8_STRING);
+ if (CONSP (val) && SYMBOLP (XCAR (val)))
+ {
+ val = XCDR (val);
+ if (CONSP (val) && NILP (XCDR (val)))
+ val = XCAR (val);
+ }
+ if (! STRINGP (val))
+ return NO;
+
+ typesDeclared = [NSArray arrayWithObject:NSStringPboardType];
+ [pb declareTypes:typesDeclared owner:nil];
+ ns_string_to_pasteboard (pb, val);
+ return YES;
}
@@ -6036,14 +6069,26 @@ ns_term_shutdown (int sig)
em_whole = whole;
if (portion >= whole)
- [self setFloatValue: 0.0 knobProportion: 1.0];
+ {
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > MAC_OS_X_VERSION_10_5
+ [self setKnobProportion: 1.0];
+ [self setDoubleValue: 1.0];
+#else
+ [self setFloatValue: 0.0 knobProportion: 1.0];
+#endif
+ }
else
{
float pos, por;
portion = max ((float)whole*min_portion/pixel_height, portion);
pos = (float)position / (whole - portion);
por = (float)portion/whole;
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > MAC_OS_X_VERSION_10_5
+ [self setKnobProportion: por];
+ [self setDoubleValue: pos];
+#else
[self setFloatValue: pos knobProportion: por];
+#endif
}
return self;
}
@@ -6388,6 +6433,8 @@ syms_of_nsterm (void)
DEFSYM (Qsuper, "super");
DEFSYM (Qcontrol, "control");
DEFSYM (Qnone, "none");
+ DEFSYM (QUTF8_STRING, "UTF8_STRING");
+
Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier));
Fput (Qmeta, Qmodifier_value, make_number (meta_modifier));
@@ -6531,5 +6578,3 @@ baseline level. The default value is nil. */);
/* Tell emacs about this window system. */
Fprovide (intern ("ns"), Qnil);
}
-
-
diff --git a/src/print.c b/src/print.c
index f0624d5d16e..14b4326bb6f 100644
--- a/src/print.c
+++ b/src/print.c
@@ -159,8 +159,9 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
} \
else \
{ \
- print_buffer_size = 1000; \
- print_buffer = (char *) xmalloc (print_buffer_size); \
+ ptrdiff_t new_size = 1000; \
+ print_buffer = (char *) xmalloc (new_size); \
+ print_buffer_size = new_size; \
free_print_buffer = 1; \
} \
print_buffer_pos = 0; \
@@ -235,9 +236,15 @@ printchar (unsigned int ch, Lisp_Object fun)
if (NILP (fun))
{
- if (print_buffer_pos_byte + len >= print_buffer_size)
- print_buffer = (char *) xrealloc (print_buffer,
- print_buffer_size *= 2);
+ 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;
+ }
memcpy (print_buffer + print_buffer_pos_byte, str, len);
print_buffer_pos += 1;
print_buffer_pos_byte += len;
@@ -280,11 +287,14 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
if (NILP (printcharfun))
{
- if (print_buffer_pos_byte + size_byte > print_buffer_size)
+ if (print_buffer_size - size_byte < print_buffer_pos_byte)
{
- print_buffer_size = print_buffer_size * 2 + size_byte;
- print_buffer = (char *) xrealloc (print_buffer,
- print_buffer_size);
+ 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;
}
memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
print_buffer_pos += size;
@@ -381,7 +391,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
EMACS_INT bytes;
chars = SBYTES (string);
- bytes = parse_str_to_multibyte (SDATA (string), chars);
+ bytes = count_size_as_multibyte (SDATA (string), chars);
if (chars < bytes)
{
newstr = make_uninit_multibyte_string (chars, bytes);
@@ -1082,7 +1092,7 @@ print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
Maybe a better way to do that is to copy elements to
a new hash table. */
struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
- int i;
+ EMACS_INT i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i))
@@ -2004,7 +2014,7 @@ 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=%d",
+ sprintf(buf, "ptr=%p int=%"pD"d",
XSAVE_VALUE (obj)->pointer,
XSAVE_VALUE (obj)->integer);
strout (buf, -1, -1, printcharfun);
@@ -2059,8 +2069,7 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun)
void
syms_of_print (void)
{
- Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
- staticpro (&Qtemp_buffer_setup_hook);
+ DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook");
DEFVAR_LISP ("standard-output", Vstandard_output,
doc: /* Output stream `print' uses by default for outputting a character.
@@ -2069,8 +2078,7 @@ It may also be a buffer (output is inserted before point)
or a marker (output is inserted and the marker is advanced)
or the symbol t (output appears in the echo area). */);
Vstandard_output = Qt;
- Qstandard_output = intern_c_string ("standard-output");
- staticpro (&Qstandard_output);
+ DEFSYM (Qstandard_output, "standard-output");
DEFVAR_LISP ("float-output-format", Vfloat_output_format,
doc: /* The format descriptor string used to print floats.
@@ -2089,8 +2097,7 @@ decimal point. 0 is not allowed with `e' or `g'.
A value of nil means to use the shortest notation
that represents the number without losing information. */);
Vfloat_output_format = Qnil;
- Qfloat_output_format = intern_c_string ("float-output-format");
- staticpro (&Qfloat_output_format);
+ DEFSYM (Qfloat_output_format, "float-output-format");
DEFVAR_LISP ("print-length", Vprint_length,
doc: /* Maximum length of list to print before abbreviating.
@@ -2195,17 +2202,10 @@ priorities. */);
defsubr (&Sredirect_debugging_output);
#endif
- Qexternal_debugging_output = intern_c_string ("external-debugging-output");
- staticpro (&Qexternal_debugging_output);
-
- Qprint_escape_newlines = intern_c_string ("print-escape-newlines");
- staticpro (&Qprint_escape_newlines);
-
- Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte");
- staticpro (&Qprint_escape_multibyte);
-
- Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii");
- staticpro (&Qprint_escape_nonascii);
+ DEFSYM (Qexternal_debugging_output, "external-debugging-output");
+ DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
+ DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
+ DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
print_prune_charset_plist = Qnil;
staticpro (&print_prune_charset_plist);
diff --git a/src/process.c b/src/process.c
index 8a94b3e6047..1a884357b86 100644
--- a/src/process.c
+++ b/src/process.c
@@ -102,9 +102,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gnutls.h"
#endif
-#if defined (USE_GTK) || defined (HAVE_GCONF)
+#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
#include "xgselect.h"
-#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
+#endif
#ifdef HAVE_NS
#include "nsterm.h"
#endif
@@ -892,7 +892,8 @@ not the name of the pty that Emacs uses to talk with that terminal. */)
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
2, 2, 0,
- doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
+ doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
+Return BUFFER. */)
(register Lisp_Object process, Lisp_Object buffer)
{
struct Lisp_Process *p;
@@ -1186,7 +1187,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_UINT size = p->header.size;
+ EMACS_INT size = p->header.size;
Lisp_Object args[10];
int nargs, i;
@@ -1272,11 +1273,11 @@ the command through a shell and redirect one of them using the shell
syntax.
usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object buffer, name, program, proc, current_dir, tem;
register unsigned char **new_argv;
- register size_t i;
+ ptrdiff_t i;
int count = SPECPDL_INDEX ();
buffer = args[1];
@@ -1651,7 +1652,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
#endif
#endif /* HAVE_WORKING_VFORK */
- sigprocmask (SIG_BLOCK, &blocked, &procmask);
+ pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
FD_SET (inchannel, &input_wait_mask);
FD_SET (inchannel, &non_keyboard_wait_mask);
@@ -1807,7 +1808,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
signal (SIGPIPE, SIG_DFL);
/* Stop blocking signals in the child. */
- sigprocmask (SIG_SETMASK, &procmask, 0);
+ pthread_sigmask (SIG_SETMASK, &procmask, 0);
if (pty_flag)
child_setup_tty (xforkout);
@@ -1899,7 +1900,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
#endif
#endif /* HAVE_WORKING_VFORK */
/* Stop blocking signals in the parent. */
- sigprocmask (SIG_SETMASK, &procmask, 0);
+ pthread_sigmask (SIG_SETMASK, &procmask, 0);
/* Now generate the error if vfork failed. */
if (pid < 0)
@@ -2436,7 +2437,7 @@ Examples:
\(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
usage: (serial-process-configure &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
struct Lisp_Process *p;
Lisp_Object contact = Qnil;
@@ -2554,7 +2555,7 @@ Examples:
\(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
usage: (make-serial-process &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
int fd = -1;
Lisp_Object proc, contact, port;
@@ -2832,7 +2833,7 @@ The original argument list, modified with the actual connection
information, is available via the `process-contact' function.
usage: (make-network-process &rest ARGS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object proc;
Lisp_Object contact;
@@ -3148,7 +3149,7 @@ usage: (make-network-process &rest ARGS) */)
for (lres = res; lres; lres = lres->ai_next)
{
- size_t optn;
+ ptrdiff_t optn;
int optbits;
#ifdef WINDOWSNT
@@ -4162,7 +4163,7 @@ wait_reading_process_output_1 (void)
impossible to step through wait_reading_process_output. */
#ifndef select
-static INLINE int
+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);
@@ -4478,13 +4479,19 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
set_waiting_for_input (&timeout);
}
+ /* Skip the `select' call if input is available and we're
+ waiting for keyboard input or a cell change (which can be
+ triggered by processing X events). In the latter case, set
+ nfds to 1 to avoid breaking the loop. */
no_avail = 0;
- if (read_kbd && detect_input_pending ())
+ if ((read_kbd || !NILP (wait_for_cell))
+ && detect_input_pending ())
{
- nfds = 0;
+ nfds = read_kbd ? 0 : 1;
no_avail = 1;
}
- else
+
+ if (!no_avail)
{
#ifdef ADAPTIVE_READ_BUFFERING
@@ -4520,7 +4527,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
process_output_skip = 0;
}
#endif
-#if defined (USE_GTK) || defined (HAVE_GCONF)
+#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
nfds = xg_select
#elif defined (HAVE_NS)
nfds = ns_select
@@ -6593,6 +6600,8 @@ DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
+# ifdef HAVE_GPM
+
void
add_gpm_wait_descriptor (int desc)
{
@@ -6605,6 +6614,8 @@ delete_gpm_wait_descriptor (int desc)
delete_keyboard_wait_descriptor (desc);
}
+# endif
+
# ifdef SIGIO
/* Return nonzero if *MASK has a bit set
@@ -7231,14 +7242,10 @@ syms_of_process (void)
{
#ifdef subprocesses
- Qprocessp = intern_c_string ("processp");
- staticpro (&Qprocessp);
- Qrun = intern_c_string ("run");
- staticpro (&Qrun);
- Qstop = intern_c_string ("stop");
- staticpro (&Qstop);
- Qsignal = intern_c_string ("signal");
- staticpro (&Qsignal);
+ DEFSYM (Qprocessp, "processp");
+ DEFSYM (Qrun, "run");
+ DEFSYM (Qstop, "stop");
+ DEFSYM (Qsignal, "signal");
/* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
here again.
@@ -7246,92 +7253,52 @@ syms_of_process (void)
Qexit = intern_c_string ("exit");
staticpro (&Qexit); */
- Qopen = intern_c_string ("open");
- staticpro (&Qopen);
- Qclosed = intern_c_string ("closed");
- staticpro (&Qclosed);
- Qconnect = intern_c_string ("connect");
- staticpro (&Qconnect);
- Qfailed = intern_c_string ("failed");
- staticpro (&Qfailed);
- Qlisten = intern_c_string ("listen");
- staticpro (&Qlisten);
- Qlocal = intern_c_string ("local");
- staticpro (&Qlocal);
- Qipv4 = intern_c_string ("ipv4");
- staticpro (&Qipv4);
+ DEFSYM (Qopen, "open");
+ DEFSYM (Qclosed, "closed");
+ DEFSYM (Qconnect, "connect");
+ DEFSYM (Qfailed, "failed");
+ DEFSYM (Qlisten, "listen");
+ DEFSYM (Qlocal, "local");
+ DEFSYM (Qipv4, "ipv4");
#ifdef AF_INET6
- Qipv6 = intern_c_string ("ipv6");
- staticpro (&Qipv6);
-#endif
- Qdatagram = intern_c_string ("datagram");
- staticpro (&Qdatagram);
- Qseqpacket = intern_c_string ("seqpacket");
- staticpro (&Qseqpacket);
-
- QCport = intern_c_string (":port");
- staticpro (&QCport);
- QCspeed = intern_c_string (":speed");
- staticpro (&QCspeed);
- QCprocess = intern_c_string (":process");
- staticpro (&QCprocess);
-
- QCbytesize = intern_c_string (":bytesize");
- staticpro (&QCbytesize);
- QCstopbits = intern_c_string (":stopbits");
- staticpro (&QCstopbits);
- QCparity = intern_c_string (":parity");
- staticpro (&QCparity);
- Qodd = intern_c_string ("odd");
- staticpro (&Qodd);
- Qeven = intern_c_string ("even");
- staticpro (&Qeven);
- QCflowcontrol = intern_c_string (":flowcontrol");
- staticpro (&QCflowcontrol);
- Qhw = intern_c_string ("hw");
- staticpro (&Qhw);
- Qsw = intern_c_string ("sw");
- staticpro (&Qsw);
- QCsummary = intern_c_string (":summary");
- staticpro (&QCsummary);
-
- Qreal = intern_c_string ("real");
- staticpro (&Qreal);
- Qnetwork = intern_c_string ("network");
- staticpro (&Qnetwork);
- Qserial = intern_c_string ("serial");
- staticpro (&Qserial);
- QCbuffer = intern_c_string (":buffer");
- staticpro (&QCbuffer);
- QChost = intern_c_string (":host");
- staticpro (&QChost);
- QCservice = intern_c_string (":service");
- staticpro (&QCservice);
- QClocal = intern_c_string (":local");
- staticpro (&QClocal);
- QCremote = intern_c_string (":remote");
- staticpro (&QCremote);
- QCcoding = intern_c_string (":coding");
- staticpro (&QCcoding);
- QCserver = intern_c_string (":server");
- staticpro (&QCserver);
- QCnowait = intern_c_string (":nowait");
- staticpro (&QCnowait);
- QCsentinel = intern_c_string (":sentinel");
- staticpro (&QCsentinel);
- QClog = intern_c_string (":log");
- staticpro (&QClog);
- QCnoquery = intern_c_string (":noquery");
- staticpro (&QCnoquery);
- QCstop = intern_c_string (":stop");
- staticpro (&QCstop);
- QCoptions = intern_c_string (":options");
- staticpro (&QCoptions);
- QCplist = intern_c_string (":plist");
- staticpro (&QCplist);
-
- Qlast_nonmenu_event = intern_c_string ("last-nonmenu-event");
- staticpro (&Qlast_nonmenu_event);
+ DEFSYM (Qipv6, "ipv6");
+#endif
+ DEFSYM (Qdatagram, "datagram");
+ DEFSYM (Qseqpacket, "seqpacket");
+
+ DEFSYM (QCport, ":port");
+ DEFSYM (QCspeed, ":speed");
+ DEFSYM (QCprocess, ":process");
+
+ DEFSYM (QCbytesize, ":bytesize");
+ DEFSYM (QCstopbits, ":stopbits");
+ DEFSYM (QCparity, ":parity");
+ DEFSYM (Qodd, "odd");
+ DEFSYM (Qeven, "even");
+ DEFSYM (QCflowcontrol, ":flowcontrol");
+ DEFSYM (Qhw, "hw");
+ DEFSYM (Qsw, "sw");
+ DEFSYM (QCsummary, ":summary");
+
+ DEFSYM (Qreal, "real");
+ DEFSYM (Qnetwork, "network");
+ DEFSYM (Qserial, "serial");
+ DEFSYM (QCbuffer, ":buffer");
+ DEFSYM (QChost, ":host");
+ DEFSYM (QCservice, ":service");
+ DEFSYM (QClocal, ":local");
+ DEFSYM (QCremote, ":remote");
+ DEFSYM (QCcoding, ":coding");
+ DEFSYM (QCserver, ":server");
+ DEFSYM (QCnowait, ":nowait");
+ DEFSYM (QCsentinel, ":sentinel");
+ DEFSYM (QClog, ":log");
+ DEFSYM (QCnoquery, ":noquery");
+ DEFSYM (QCstop, ":stop");
+ DEFSYM (QCoptions, ":options");
+ DEFSYM (QCplist, ":plist");
+
+ DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
staticpro (&Vprocess_alist);
#ifdef SIGCHLD
@@ -7340,73 +7307,40 @@ syms_of_process (void)
#endif /* subprocesses */
- QCname = intern_c_string (":name");
- staticpro (&QCname);
- QCtype = intern_c_string (":type");
- staticpro (&QCtype);
-
- Qeuid = intern_c_string ("euid");
- staticpro (&Qeuid);
- Qegid = intern_c_string ("egid");
- staticpro (&Qegid);
- Quser = intern_c_string ("user");
- staticpro (&Quser);
- Qgroup = intern_c_string ("group");
- staticpro (&Qgroup);
- Qcomm = intern_c_string ("comm");
- staticpro (&Qcomm);
- Qstate = intern_c_string ("state");
- staticpro (&Qstate);
- Qppid = intern_c_string ("ppid");
- staticpro (&Qppid);
- Qpgrp = intern_c_string ("pgrp");
- staticpro (&Qpgrp);
- Qsess = intern_c_string ("sess");
- staticpro (&Qsess);
- Qttname = intern_c_string ("ttname");
- staticpro (&Qttname);
- Qtpgid = intern_c_string ("tpgid");
- staticpro (&Qtpgid);
- Qminflt = intern_c_string ("minflt");
- staticpro (&Qminflt);
- Qmajflt = intern_c_string ("majflt");
- staticpro (&Qmajflt);
- Qcminflt = intern_c_string ("cminflt");
- staticpro (&Qcminflt);
- Qcmajflt = intern_c_string ("cmajflt");
- staticpro (&Qcmajflt);
- Qutime = intern_c_string ("utime");
- staticpro (&Qutime);
- Qstime = intern_c_string ("stime");
- staticpro (&Qstime);
- Qtime = intern_c_string ("time");
- staticpro (&Qtime);
- Qcutime = intern_c_string ("cutime");
- staticpro (&Qcutime);
- Qcstime = intern_c_string ("cstime");
- staticpro (&Qcstime);
- Qctime = intern_c_string ("ctime");
- staticpro (&Qctime);
- Qpri = intern_c_string ("pri");
- staticpro (&Qpri);
- Qnice = intern_c_string ("nice");
- staticpro (&Qnice);
- Qthcount = intern_c_string ("thcount");
- staticpro (&Qthcount);
- Qstart = intern_c_string ("start");
- staticpro (&Qstart);
- Qvsize = intern_c_string ("vsize");
- staticpro (&Qvsize);
- Qrss = intern_c_string ("rss");
- staticpro (&Qrss);
- Qetime = intern_c_string ("etime");
- staticpro (&Qetime);
- Qpcpu = intern_c_string ("pcpu");
- staticpro (&Qpcpu);
- Qpmem = intern_c_string ("pmem");
- staticpro (&Qpmem);
- Qargs = intern_c_string ("args");
- staticpro (&Qargs);
+ DEFSYM (QCname, ":name");
+ DEFSYM (QCtype, ":type");
+
+ DEFSYM (Qeuid, "euid");
+ DEFSYM (Qegid, "egid");
+ DEFSYM (Quser, "user");
+ DEFSYM (Qgroup, "group");
+ DEFSYM (Qcomm, "comm");
+ DEFSYM (Qstate, "state");
+ DEFSYM (Qppid, "ppid");
+ DEFSYM (Qpgrp, "pgrp");
+ DEFSYM (Qsess, "sess");
+ DEFSYM (Qttname, "ttname");
+ DEFSYM (Qtpgid, "tpgid");
+ DEFSYM (Qminflt, "minflt");
+ DEFSYM (Qmajflt, "majflt");
+ DEFSYM (Qcminflt, "cminflt");
+ DEFSYM (Qcmajflt, "cmajflt");
+ DEFSYM (Qutime, "utime");
+ DEFSYM (Qstime, "stime");
+ DEFSYM (Qtime, "time");
+ DEFSYM (Qcutime, "cutime");
+ DEFSYM (Qcstime, "cstime");
+ DEFSYM (Qctime, "ctime");
+ DEFSYM (Qpri, "pri");
+ DEFSYM (Qnice, "nice");
+ DEFSYM (Qthcount, "thcount");
+ DEFSYM (Qstart, "start");
+ DEFSYM (Qvsize, "vsize");
+ DEFSYM (Qrss, "rss");
+ DEFSYM (Qetime, "etime");
+ DEFSYM (Qpcpu, "pcpu");
+ DEFSYM (Qpmem, "pmem");
+ DEFSYM (Qargs, "args");
DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
doc: /* *Non-nil means delete processes immediately when they exit.
diff --git a/src/puresize.h b/src/puresize.h
index 8024aa95d31..c26c496a757 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -86,7 +86,6 @@ extern EMACS_INT pure[];
&& (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
#else /* not VIRT_ADDR_VARIES */
-/* When PNTR_COMPARISON_TYPE is not the default (unsigned int). */
extern char my_edata[];
@@ -94,4 +93,3 @@ extern char my_edata[];
((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) my_edata)
#endif /* VIRT_ADDRESS_VARIES */
-
diff --git a/src/ralloc.c b/src/ralloc.c
index 9c601a0ac24..64a47416202 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -1079,7 +1079,7 @@ r_alloc_reinit (void)
#include <assert.h>
void
-r_alloc_check ()
+r_alloc_check (void)
{
int found = 0;
heap_ptr h, ph = 0;
diff --git a/src/regex.c b/src/regex.c
index 479239897bc..625c59ccf0b 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -2202,10 +2202,9 @@ extend_range_table_work_area (struct range_table_work_area *work_area)
Returns -1 if successful, REG_ESPACE if ran out of space. */
static int
-set_image_of_range_1 (work_area, start, end, translate)
- RE_TRANSLATE_TYPE translate;
- struct range_table_work_area *work_area;
- re_wchar_t start, end;
+set_image_of_range_1 (struct range_table_work_area *work_area,
+ re_wchar_t start, re_wchar_t end,
+ RE_TRANSLATE_TYPE translate)
{
/* `one_case' indicates a character, or a run of characters,
each of which is an isolate (no case-equivalents).
@@ -2355,10 +2354,9 @@ set_image_of_range_1 (work_area, start, end, translate)
Returns -1 if successful, REG_ESPACE if ran out of space. */
static int
-set_image_of_range (work_area, start, end, translate)
- RE_TRANSLATE_TYPE translate;
- struct range_table_work_area *work_area;
- re_wchar_t start, end;
+set_image_of_range (struct range_table_work_area *work_area,
+ re_wchar_t start, re_wchar_t end,
+ RE_TRANSLATE_TYPE translate)
{
re_wchar_t cmin, cmax;
@@ -2445,8 +2443,7 @@ static re_char **best_regstart, **best_regend;
but don't make them smaller. */
static
-regex_grow_registers (num_regs)
- int num_regs;
+regex_grow_registers (int num_regs)
{
if (num_regs > regs_allocated_size)
{
diff --git a/src/s/irix6-5.h b/src/s/irix6-5.h
index d283571d8fb..26eb7dcde77 100644
--- a/src/s/irix6-5.h
+++ b/src/s/irix6-5.h
@@ -96,3 +96,10 @@ char *_getpty();
/* 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/scroll.c b/src/scroll.c
index ba012874460..6291936a541 100644
--- a/src/scroll.c
+++ b/src/scroll.c
@@ -268,10 +268,10 @@ do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
# define CHECK_BOUNDS \
do \
{ \
- int k; \
- for (k = 0; k < window_size; ++k) \
- xassert (copy_from[k] == -1 \
- || (copy_from[k] >= 0 && copy_from[k] < window_size)); \
+ int ck; \
+ for (ck = 0; ck < window_size; ++ck) \
+ xassert (copy_from[ck] == -1 \
+ || (copy_from[ck] >= 0 && copy_from[ck] < window_size)); \
} \
while (0);
#endif
diff --git a/src/search.c b/src/search.c
index 6c835f2cc64..d29a51c695b 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3181,10 +3181,8 @@ syms_of_search (void)
}
searchbuf_head = &searchbufs[0];
- Qsearch_failed = intern_c_string ("search-failed");
- staticpro (&Qsearch_failed);
- Qinvalid_regexp = intern_c_string ("invalid-regexp");
- staticpro (&Qinvalid_regexp);
+ DEFSYM (Qsearch_failed, "search-failed");
+ DEFSYM (Qinvalid_regexp, "invalid-regexp");
Fput (Qsearch_failed, Qerror_conditions,
pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil)));
diff --git a/src/sound.c b/src/sound.c
index 794c8e64e54..07c7dab0ada 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -1447,7 +1447,7 @@ Internal use only, use `play-sound' instead. */)
}
else if (FLOATP (attrs[SOUND_VOLUME]))
{
- ui_volume_tmp = (unsigned long) XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100;
+ ui_volume_tmp = XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100;
}
/*
Based on some experiments I have conducted, a value of 100 or less
@@ -1477,14 +1477,10 @@ Internal use only, use `play-sound' instead. */)
void
syms_of_sound (void)
{
- QCdevice = intern_c_string(":device");
- staticpro (&QCdevice);
- QCvolume = intern_c_string (":volume");
- staticpro (&QCvolume);
- Qsound = intern_c_string ("sound");
- staticpro (&Qsound);
- Qplay_sound_functions = intern_c_string ("play-sound-functions");
- staticpro (&Qplay_sound_functions);
+ DEFSYM (QCdevice, ":device");
+ DEFSYM (QCvolume, ":volume");
+ DEFSYM (Qsound, "sound");
+ DEFSYM (Qplay_sound_functions, "play-sound-functions");
defsubr (&Splay_sound_internal);
}
diff --git a/src/syntax.c b/src/syntax.c
index cff6d50f510..8c2d5ded21f 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -367,7 +367,7 @@ 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
+static inline EMACS_INT
dec_bytepos (EMACS_INT bytepos)
{
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
@@ -3362,8 +3362,7 @@ init_syntax_once (void)
Lisp_Object temp;
/* This has to be done here, before we call Fmake_char_table. */
- Qsyntax_table = intern_c_string ("syntax-table");
- staticpro (&Qsyntax_table);
+ DEFSYM (Qsyntax_table, "syntax-table");
/* Intern_C_String this now in case it isn't already done.
Setting this variable twice is harmless.
@@ -3448,8 +3447,7 @@ init_syntax_once (void)
void
syms_of_syntax (void)
{
- Qsyntax_table_p = intern_c_string ("syntax-table-p");
- staticpro (&Qsyntax_table_p);
+ DEFSYM (Qsyntax_table_p, "syntax-table-p");
staticpro (&Vsyntax_code_object);
@@ -3461,8 +3459,7 @@ syms_of_syntax (void)
/* Defined in regex.c */
staticpro (&re_match_object);
- Qscan_error = intern_c_string ("scan-error");
- staticpro (&Qscan_error);
+ DEFSYM (Qscan_error, "scan-error");
Fput (Qscan_error, Qerror_conditions,
pure_cons (Qscan_error, pure_cons (Qerror, Qnil)));
Fput (Qscan_error, Qerror_message,
diff --git a/src/sysdep.c b/src/sysdep.c
index 5ad3389dd8f..fc2f846b0dc 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1534,7 +1534,7 @@ sigset_t
sys_sigblock (sigset_t new_mask)
{
sigset_t old_mask;
- sigprocmask (SIG_BLOCK, &new_mask, &old_mask);
+ pthread_sigmask (SIG_BLOCK, &new_mask, &old_mask);
return (old_mask);
}
@@ -1542,7 +1542,7 @@ sigset_t
sys_sigunblock (sigset_t new_mask)
{
sigset_t old_mask;
- sigprocmask (SIG_UNBLOCK, &new_mask, &old_mask);
+ pthread_sigmask (SIG_UNBLOCK, &new_mask, &old_mask);
return (old_mask);
}
@@ -1550,7 +1550,7 @@ sigset_t
sys_sigsetmask (sigset_t new_mask)
{
sigset_t old_mask;
- sigprocmask (SIG_SETMASK, &new_mask, &old_mask);
+ pthread_sigmask (SIG_SETMASK, &new_mask, &old_mask);
return (old_mask);
}
@@ -1783,7 +1783,8 @@ seed_random (long int arg)
}
/*
- * Build a full Emacs-sized word out of whatever we've got.
+ * Return a nonnegative random integer out of whatever we've got.
+ * It contains enough bits to make a random (signed) Emacs fixnum.
* This suffices even for a 64-bit architecture with a 15-bit rand.
*/
EMACS_INT
@@ -1791,16 +1792,17 @@ get_random (void)
{
EMACS_UINT val = 0;
int i;
- for (i = 0; i < (VALBITS + RAND_BITS - 1) / RAND_BITS; i++)
- val = (val << RAND_BITS) ^ random ();
- return val & (((EMACS_INT) 1 << VALBITS) - 1);
+ for (i = 0; i < (FIXNUM_BITS + RAND_BITS - 1) / RAND_BITS; i++)
+ val = (random () ^ (val << RAND_BITS)
+ ^ (val >> (BITS_PER_EMACS_INT - RAND_BITS)));
+ val ^= val >> (BITS_PER_EMACS_INT - FIXNUM_BITS);
+ return val & INTMASK;
}
#ifndef HAVE_STRERROR
#ifndef WINDOWSNT
char *
-strerror (errnum)
- int errnum;
+strerror (int errnum)
{
extern char *sys_errlist[];
extern int sys_nerr;
@@ -2012,37 +2014,6 @@ perror (void)
}
#endif /* HPUX and not HAVE_PERROR */
-#ifndef HAVE_DUP2
-
-/*
- * Emulate BSD dup2. First close newd if it already exists.
- * Then, attempt to dup oldd. If not successful, call dup2 recursively
- * until we are, then close the unsuccessful ones.
- */
-
-int
-dup2 (int oldd, int newd)
-{
- register int fd, ret;
-
- emacs_close (newd);
-
-#ifdef F_DUPFD
- return fcntl (oldd, F_DUPFD, newd);
-#else
- fd = dup (old);
- if (fd == -1)
- return -1;
- if (fd == new)
- return new;
- ret = dup2 (old,new);
- emacs_close (fd);
- return ret;
-#endif
-}
-
-#endif /* not HAVE_DUP2 */
-
/*
* Gettimeofday. Simulate as much as possible. Only accurate
* to nearest second. Emacs doesn't use tzp so ignore it for now.
diff --git a/src/systime.h b/src/systime.h
index cb1ea230f7d..bed9ed4aa71 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -30,6 +30,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#endif
+#ifdef emacs
+# ifdef HAVE_X_WINDOWS
+# include <X11/X.h>
+# else
+typedef unsigned long Time;
+# endif
+#endif
+
#ifdef HAVE_TZNAME
#ifndef tzname /* For SGI. */
extern char *tzname[]; /* RS6000 and others want it this way. */
diff --git a/src/term.c b/src/term.c
index ab0bc1a4277..22056451cb9 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1546,8 +1546,8 @@ produce_glyphs (struct it *it)
/* Nothing but characters are supported on terminal frames. */
xassert (it->what == IT_CHARACTER
|| it->what == IT_COMPOSITION
- || it->what == IT_GLYPHLESS
- || it->what == IT_STRETCH);
+ || it->what == IT_STRETCH
+ || it->what == IT_GLYPHLESS);
if (it->what == IT_STRETCH)
{
@@ -2596,6 +2596,7 @@ frame's terminal). */)
FRAME_SET_VISIBLE (XFRAME (t->display_info.tty->top_frame), 1);
}
+ set_tty_hooks (t);
init_sys_modes (t->display_info.tty);
{
@@ -2699,9 +2700,10 @@ term_mouse_movement (FRAME_PTR frame, Gpm_Event *event)
static void
term_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
enum scroll_bar_part *part, Lisp_Object *x,
- Lisp_Object *y, unsigned long *timeptr)
+ Lisp_Object *y, Time *timeptr)
{
struct timeval now;
+ Time sec, usec;
*fp = SELECTED_FRAME ();
(*fp)->mouse_moved = 0;
@@ -2712,7 +2714,9 @@ 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);
- *timeptr = (now.tv_sec * 1000) + (now.tv_usec / 1000);
+ sec = now.tv_sec;
+ usec = now.tv_usec;
+ *timeptr = (sec * 1000) + (usec / 1000);
}
/* Prepare a mouse-event in *RESULT for placement in the input queue.
@@ -3093,7 +3097,6 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
char *area = NULL;
char **address = &area;
int buffer_size = 4096;
- register char *p = NULL;
int status;
struct tty_display_info *tty = NULL;
struct terminal *terminal = NULL;
@@ -3501,55 +3504,6 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\
Down (tty) = 0;
}
- /* Special handling for certain terminal types known to need it */
-
- if (!strcmp (terminal_type, "supdup"))
- {
- terminal->memory_below_frame = 1;
- tty->Wcm->cm_losewrap = 1;
- }
- if (!strncmp (terminal_type, "c10", 3)
- || !strcmp (terminal_type, "perq"))
- {
- /* Supply a makeshift :wi string.
- This string is not valid in general since it works only
- for windows starting at the upper left corner;
- but that is all Emacs uses.
-
- This string works only if the frame is using
- the top of the video memory, because addressing is memory-relative.
- So first check the :ti string to see if that is true.
-
- It would be simpler if the :wi string could go in the termcap
- entry, but it can't because it is not fully valid.
- If it were in the termcap entry, it would confuse other programs. */
- if (!tty->TS_set_window)
- {
- const char *m = tty->TS_termcap_modes;
- while (*m && strcmp (m, "\033v "))
- m++;
- if (*m)
- tty->TS_set_window = "\033v%C %C %C %C ";
- }
- /* Termcap entry often fails to have :in: flag */
- terminal->must_write_spaces = 1;
- /* :ti string typically fails to have \E^G! in it */
- /* This limits scope of insert-char to one line. */
- strcpy (area, tty->TS_termcap_modes);
- strcat (area, "\033\007!");
- tty->TS_termcap_modes = area;
- area += strlen (area) + 1;
- p = AbsPosition (tty);
- /* Change all %+ parameters to %C, to handle
- values above 96 correctly for the C100. */
- while (*p)
- {
- if (p[0] == '%' && p[1] == '+')
- p[1] = 'C';
- p++;
- }
- }
-
tty->specified_window = FrameRows (tty);
if (Wcm_init (tty) == -1) /* can't do cursor motion */
diff --git a/src/termcap.c b/src/termcap.c
index 5b71ad229d7..96b9303d62d 100644
--- a/src/termcap.c
+++ b/src/termcap.c
@@ -323,10 +323,10 @@ tputs (register const char *str, int nlines, int (*outfun) (int))
struct termcap_buffer
{
char *beg;
- int size;
+ ptrdiff_t size;
char *ptr;
int ateof;
- int full;
+ ptrdiff_t full;
};
/* Forward declarations of static functions. */
@@ -338,8 +338,7 @@ static int name_match (char *line, char *name);
#ifdef MSDOS /* MW, May 1993 */
static int
-valid_filename_p (fn)
- char *fn;
+valid_filename_p (char *fn)
{
return *fn == '/' || fn[1] == ':';
}
@@ -367,7 +366,7 @@ tgetent (char *bp, const char *name)
register char *bp1;
char *tc_search_point;
char *term;
- int malloc_size = 0;
+ ptrdiff_t malloc_size = 0;
register int c;
char *tcenv = NULL; /* TERMCAP value, if it contains :tc=. */
char *indirect = NULL; /* Terminal type in :tc= in TERMCAP value. */
@@ -637,6 +636,8 @@ gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end)
{
if (bufp->full == bufp->size)
{
+ if ((PTRDIFF_MAX - 1) / 2 < bufp->size)
+ memory_full (SIZE_MAX);
bufp->size *= 2;
/* Add 1 to size to ensure room for terminating null. */
tem = (char *) xrealloc (buf, bufp->size + 1);
@@ -667,9 +668,29 @@ gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end)
#include <stdio.h>
-main (argc, argv)
- int argc;
- char **argv;
+static void
+tprint (char *cap)
+{
+ char *x = tgetstr (cap, 0);
+ register char *y;
+
+ printf ("%s: ", cap);
+ if (x)
+ {
+ for (y = x; *y; y++)
+ if (*y <= ' ' || *y == 0177)
+ printf ("\\%0o", *y);
+ else
+ putchar (*y);
+ free (x);
+ }
+ else
+ printf ("none");
+ putchar ('\n');
+}
+
+int
+main (int argc, char **argv)
{
char *term;
char *buf;
@@ -691,28 +712,8 @@ main (argc, argv)
printf ("co: %d\n", tgetnum ("co"));
printf ("am: %d\n", tgetflag ("am"));
-}
-
-tprint (cap)
- char *cap;
-{
- char *x = tgetstr (cap, 0);
- register char *y;
- printf ("%s: ", cap);
- if (x)
- {
- for (y = x; *y; y++)
- if (*y <= ' ' || *y == 0177)
- printf ("\\%0o", *y);
- else
- putchar (*y);
- free (x);
- }
- else
- printf ("none");
- putchar ('\n');
+ return 0;
}
#endif /* TEST */
-
diff --git a/src/termhooks.h b/src/termhooks.h
index 3a49b49aede..6a58517a85a 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Miscellanea. */
+#include "systime.h" /* for Time */
+
struct glyph;
struct frame;
@@ -233,7 +235,7 @@ struct input_event
int modifiers; /* See enum below for interpretation. */
Lisp_Object x, y;
- unsigned long timestamp;
+ Time timestamp;
/* This is padding just to put the frame_or_window field
past the size of struct selection_input_event. */
@@ -333,6 +335,22 @@ struct terminal
the member terminal_coding. */
Lisp_Object charset_list;
+ /* This is an association list containing the X selections that
+ Emacs might own on this terminal. Each element has the form
+ (SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
+ SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
+ SELECTION-VALUE is the value that emacs owns for that selection.
+ It may be any kind of Lisp object.
+ SELECTION-TIMESTAMP is the time at which emacs began owning this
+ selection, as a cons of two 16-bit numbers (making a 32 bit
+ time.)
+ FRAME is the frame for which we made the selection. If there is
+ an entry in this alist, then it can be assumed that Emacs owns
+ that selection.
+ The only (eq) parts of this list that are visible from Lisp are
+ the selection-values. */
+ Lisp_Object Vselection_alist;
+
/* All fields before `next_terminal' should be Lisp_Object and are traced
by the GC. All fields afterwards are ignored by the GC. */
@@ -463,7 +481,7 @@ struct terminal
enum scroll_bar_part *part,
Lisp_Object *x,
Lisp_Object *y,
- unsigned long *);
+ 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
diff --git a/src/terminal.c b/src/terminal.c
index c5185601fb6..67577adf3b4 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -256,6 +256,8 @@ create_terminal (void)
setup_coding_system (terminal_coding, terminal->terminal_coding);
terminal->param_alist = Qnil;
+ terminal->charset_list = Qnil;
+ terminal->Vselection_alist = Qnil;
return terminal;
}
@@ -553,10 +555,8 @@ Each function is called with argument, the terminal.
This may be called just before actually deleting the terminal,
or some time later. */);
Vdelete_terminal_functions = Qnil;
- Qdelete_terminal_functions = intern_c_string ("delete-terminal-functions");
- staticpro (&Qdelete_terminal_functions);
- Qrun_hook_with_args = intern_c_string ("run-hook-with-args");
- staticpro (&Qrun_hook_with_args);
+ DEFSYM (Qdelete_terminal_functions, "delete-terminal-functions");
+ DEFSYM (Qrun_hook_with_args, "run-hook-with-args");
defsubr (&Sdelete_terminal);
defsubr (&Sframe_terminal);
diff --git a/src/textprop.c b/src/textprop.c
index aad090c5b41..29425f7a550 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -248,7 +248,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 inline int
interval_has_some_properties (Lisp_Object plist, INTERVAL i)
{
register Lisp_Object tail1, tail2, sym;
@@ -270,7 +270,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 inline int
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
{
register Lisp_Object tail1, tail2, sym;
@@ -499,7 +499,7 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object
/* Remove all properties from interval I. Return non-zero
if this changes the interval. */
-static INLINE int
+static inline int
erase_properties (INTERVAL i)
{
if (NILP (i->plist))
@@ -613,7 +613,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
}
if (BUFFERP (object))
{
- int noverlays;
+ ptrdiff_t noverlays;
Lisp_Object *overlay_vec;
struct buffer *obuf = current_buffer;
@@ -838,8 +838,8 @@ In a buffer, it runs to (point-min), and the value cannot be less than that.
The property values are compared with `eq'.
If the property is constant all the way to the start of OBJECT, return the
first valid position in OBJECT.
-If the optional fourth argument LIMIT is non-nil, don't search
-back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
+If the optional fourth argument LIMIT is non-nil, don't search back past
+position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
(Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
{
if (STRINGP (object))
@@ -1707,10 +1707,14 @@ text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
{
Lisp_Object prev_pos, front_sticky;
int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
+ Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
if (NILP (buffer))
XSETBUFFER (buffer, current_buffer);
+ if (CONSP (defalt) && !NILP (XCDR (defalt)))
+ is_rear_sticky = 0;
+
if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
/* Consider previous character. */
{
@@ -2230,9 +2234,11 @@ If a character in a buffer has PROPERTY, new text inserted adjacent to
the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
inherits it if NONSTICKINESS is nil. The `front-sticky' and
`rear-nonsticky' properties of the character override NONSTICKINESS. */);
- /* Text property `syntax-table' should be nonsticky by default. */
+ /* Text properties `syntax-table'and `display' should be nonsticky
+ by default. */
Vtext_property_default_nonsticky
- = Fcons (Fcons (intern_c_string ("syntax-table"), Qt), Qnil);
+ = Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
+ Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
staticpro (&interval_insert_behind_hooks);
staticpro (&interval_insert_in_front_hooks);
@@ -2242,45 +2248,27 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and
/* Common attributes one might give text */
- staticpro (&Qforeground);
- Qforeground = intern_c_string ("foreground");
- staticpro (&Qbackground);
- Qbackground = intern_c_string ("background");
- staticpro (&Qfont);
- Qfont = intern_c_string ("font");
- staticpro (&Qstipple);
- Qstipple = intern_c_string ("stipple");
- staticpro (&Qunderline);
- Qunderline = intern_c_string ("underline");
- staticpro (&Qread_only);
- Qread_only = intern_c_string ("read-only");
- staticpro (&Qinvisible);
- Qinvisible = intern_c_string ("invisible");
- staticpro (&Qintangible);
- Qintangible = intern_c_string ("intangible");
- staticpro (&Qcategory);
- Qcategory = intern_c_string ("category");
- staticpro (&Qlocal_map);
- Qlocal_map = intern_c_string ("local-map");
- staticpro (&Qfront_sticky);
- Qfront_sticky = intern_c_string ("front-sticky");
- staticpro (&Qrear_nonsticky);
- Qrear_nonsticky = intern_c_string ("rear-nonsticky");
- staticpro (&Qmouse_face);
- Qmouse_face = intern_c_string ("mouse-face");
- staticpro (&Qminibuffer_prompt);
- Qminibuffer_prompt = intern_c_string ("minibuffer-prompt");
+ DEFSYM (Qforeground, "foreground");
+ DEFSYM (Qbackground, "background");
+ DEFSYM (Qfont, "font");
+ DEFSYM (Qstipple, "stipple");
+ DEFSYM (Qunderline, "underline");
+ DEFSYM (Qread_only, "read-only");
+ DEFSYM (Qinvisible, "invisible");
+ DEFSYM (Qintangible, "intangible");
+ DEFSYM (Qcategory, "category");
+ DEFSYM (Qlocal_map, "local-map");
+ DEFSYM (Qfront_sticky, "front-sticky");
+ DEFSYM (Qrear_nonsticky, "rear-nonsticky");
+ DEFSYM (Qmouse_face, "mouse-face");
+ DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
/* Properties that text might use to specify certain actions */
- staticpro (&Qmouse_left);
- Qmouse_left = intern_c_string ("mouse-left");
- staticpro (&Qmouse_entered);
- Qmouse_entered = intern_c_string ("mouse-entered");
- staticpro (&Qpoint_left);
- Qpoint_left = intern_c_string ("point-left");
- staticpro (&Qpoint_entered);
- Qpoint_entered = intern_c_string ("point-entered");
+ DEFSYM (Qmouse_left, "mouse-left");
+ DEFSYM (Qmouse_entered, "mouse-entered");
+ DEFSYM (Qpoint_left, "point-left");
+ DEFSYM (Qpoint_entered, "point-entered");
defsubr (&Stext_properties_at);
defsubr (&Sget_text_property);
diff --git a/src/tparam.c b/src/tparam.c
index 6aae0b97db9..ed28cd7397f 100644
--- a/src/tparam.c
+++ b/src/tparam.c
@@ -265,9 +265,8 @@ tparam1 (const char *string, char *outstring, int len,
#ifdef DEBUG
-main (argc, argv)
- int argc;
- char **argv;
+int
+main (int argc, char **argv)
{
char buf[50];
int args[3];
diff --git a/src/undo.c b/src/undo.c
index 80aff50d18a..7e121e8b27d 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -212,7 +212,6 @@ record_change (EMACS_INT beg, EMACS_INT length)
void
record_first_change (void)
{
- Lisp_Object high, low;
struct buffer *base_buffer = current_buffer;
if (EQ (BVAR (current_buffer, undo_list), Qt))
@@ -225,9 +224,9 @@ record_first_change (void)
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
- XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
- XSETFASTINT (low, base_buffer->modtime & 0xffff);
- BVAR (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), BVAR (current_buffer, undo_list));
+ BVAR (current_buffer, undo_list) =
+ Fcons (Fcons (Qt, INTEGER_TO_CONS (base_buffer->modtime)),
+ BVAR (current_buffer, undo_list));
}
/* Record a change in property PROP (whose old value was VAL)
@@ -499,13 +498,9 @@ Return what remains of the list. */)
if (EQ (car, Qt))
{
/* Element (t high . low) records previous modtime. */
- Lisp_Object high, low;
- int mod_time;
struct buffer *base_buffer = current_buffer;
-
- high = Fcar (cdr);
- low = Fcdr (cdr);
- mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
+ time_t mod_time;
+ CONS_TO_INTEGER (cdr, time_t, mod_time);
if (current_buffer->base_buffer)
base_buffer = current_buffer->base_buffer;
@@ -642,11 +637,8 @@ Return what remains of the list. */)
void
syms_of_undo (void)
{
- Qinhibit_read_only = intern_c_string ("inhibit-read-only");
- staticpro (&Qinhibit_read_only);
-
- Qapply = intern_c_string ("apply");
- staticpro (&Qapply);
+ DEFSYM (Qinhibit_read_only, "inhibit-read-only");
+ DEFSYM (Qapply, "apply");
pending_boundary = Qnil;
staticpro (&pending_boundary);
diff --git a/src/unexelf.c b/src/unexelf.c
index 8b45894f853..951e7c0eea6 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -391,6 +391,7 @@ temacs:
extern void fatal (const char *msgid, ...);
#include <sys/types.h>
+#include <stdint.h>
#include <stdio.h>
#include <sys/stat.h>
#include <memory.h>
@@ -784,7 +785,7 @@ unexec (const char *new_name, const char *old_name)
fprintf (stderr, "new_data2_incr %x\n", new_data2_incr);
#endif
- if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size)
+ if ((uintptr_t) new_bss_addr < (uintptr_t) old_bss_addr + old_bss_size)
fatal (".bss shrank when undumping???\n", 0, 0);
/* Set the output file to the right size. Allocate a buffer to hold
diff --git a/src/unexhp9k800.c b/src/unexhp9k800.c
index f27415a252c..ce65faffd4e 100644
--- a/src/unexhp9k800.c
+++ b/src/unexhp9k800.c
@@ -64,8 +64,7 @@ static long brk_on_dump = 0;
/* Called from main, if we use shared libraries. */
int
-run_time_remap (ignored)
- char *ignored;
+run_time_remap (char *ignored)
{
brk ((char *) brk_on_dump);
}
@@ -74,74 +73,11 @@ run_time_remap (ignored)
#define roundup(x,n) (((x) + ((n) - 1)) & ~((n) - 1)) /* n is power of 2 */
#define min(x,y) (((x) < (y)) ? (x) : (y))
-
-/* Create a new a.out file, same as old but with current data space */
-void
-unexec (const char *new_name, /* name of the new a.out file to be created */
- const char *old_name) /* name of the old a.out file */
-{
- int old, new;
- int old_size, new_size;
- struct header hdr;
- struct som_exec_auxhdr auxhdr;
- long i;
-
- /* For the greatest flexibility, should create a temporary file in
- the same directory as the new file. When everything is complete,
- rename the temp file to the new name.
- This way, a program could update its own a.out file even while
- it is still executing. If problems occur, everything is still
- intact. NOT implemented. */
-
- /* Open the input and output a.out files */
- old = open (old_name, O_RDONLY);
- if (old < 0)
- { perror (old_name); exit (1); }
- new = open (new_name, O_CREAT|O_RDWR|O_TRUNC, 0777);
- if (new < 0)
- { perror (new_name); exit (1); }
-
- /* Read the old headers */
- read_header (old, &hdr, &auxhdr);
-
- brk_on_dump = (long) sbrk (0);
-
- /* Decide how large the new and old data areas are */
- old_size = auxhdr.exec_dsize;
- /* I suspect these two statements are separate
- to avoid a compiler bug in hpux version 8. */
- i = (long) sbrk (0);
- new_size = i - auxhdr.exec_dmem;
-
- /* Copy the old file to the new, up to the data space */
- lseek (old, 0, 0);
- copy_file (old, new, auxhdr.exec_dfile);
-
- /* Skip the old data segment and write a new one */
- lseek (old, old_size, 1);
- save_data_space (new, &hdr, &auxhdr, new_size);
-
- /* Copy the rest of the file */
- copy_rest (old, new);
-
- /* Update file pointers since we probably changed size of data area */
- update_file_ptrs (new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size);
-
- /* Save the modified header */
- write_header (new, &hdr, &auxhdr);
-
- /* Close the binary file */
- close (old);
- close (new);
-}
-
/* Save current data space in the file, update header. */
-save_data_space (file, hdr, auxhdr, size)
- int file;
- struct header *hdr;
- struct som_exec_auxhdr *auxhdr;
- int size;
+static void
+save_data_space (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr,
+ int size)
{
/* Write the entire data space out to the file */
if (write (file, auxhdr->exec_dmem, size) != size)
@@ -154,12 +90,9 @@ save_data_space (file, hdr, auxhdr, size)
/* Update the values of file pointers when something is inserted. */
-update_file_ptrs (file, hdr, auxhdr, location, offset)
- int file;
- struct header *hdr;
- struct som_exec_auxhdr *auxhdr;
- unsigned int location;
- int offset;
+static void
+update_file_ptrs (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr,
+ unsigned int location, int offset)
{
struct subspace_dictionary_record subspace;
int i;
@@ -205,10 +138,8 @@ update_file_ptrs (file, hdr, auxhdr, location, offset)
/* Read in the header records from an a.out file. */
-read_header (file, hdr, auxhdr)
- int file;
- struct header *hdr;
- struct som_exec_auxhdr *auxhdr;
+static void
+read_header (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr)
{
/* Read the header in */
@@ -233,10 +164,8 @@ read_header (file, hdr, auxhdr)
/* Write out the header records into an a.out file. */
-write_header (file, hdr, auxhdr)
- int file;
- struct header *hdr;
- struct som_exec_auxhdr *auxhdr;
+static void
+write_header (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr)
{
/* Update the checksum */
hdr->checksum = calculate_checksum (hdr);
@@ -252,8 +181,8 @@ write_header (file, hdr, auxhdr)
/* Calculate the checksum of a SOM header record. */
-calculate_checksum (hdr)
- struct header *hdr;
+static int
+calculate_checksum (struct header *hdr)
{
int checksum, i, *ptr;
@@ -267,9 +196,8 @@ calculate_checksum (hdr)
/* Copy size bytes from the old file to the new one. */
-copy_file (old, new, size)
- int new, old;
- int size;
+static void
+copy_file (int old, int new, int size)
{
int len;
int buffer[8192]; /* word aligned will be faster */
@@ -286,8 +214,8 @@ copy_file (old, new, size)
/* Copy the rest of the file, up to EOF. */
-copy_rest (old, new)
- int new, old;
+static void
+copy_rest (int old, int new)
{
int buffer[4096];
int len;
@@ -301,9 +229,8 @@ copy_rest (old, new)
}
#ifdef DEBUG
-display_header (hdr, auxhdr)
- struct header *hdr;
- struct som_exec_auxhdr *auxhdr;
+static void
+display_header (struct header *hdr, struct som_exec_auxhdr *auxhdr)
{
/* Display the header information (debug) */
printf ("\n\nFILE HEADER\n");
@@ -320,3 +247,64 @@ display_header (hdr, auxhdr)
hdr->unloadable_sp_location, hdr->unloadable_sp_size);
}
#endif /* DEBUG */
+
+
+/* Create a new a.out file, same as old but with current data space */
+void
+unexec (const char *new_name, /* name of the new a.out file to be created */
+ const char *old_name) /* name of the old a.out file */
+{
+ int old, new;
+ int old_size, new_size;
+ struct header hdr;
+ struct som_exec_auxhdr auxhdr;
+ long i;
+
+ /* For the greatest flexibility, should create a temporary file in
+ the same directory as the new file. When everything is complete,
+ rename the temp file to the new name.
+ This way, a program could update its own a.out file even while
+ it is still executing. If problems occur, everything is still
+ intact. NOT implemented. */
+
+ /* Open the input and output a.out files */
+ old = open (old_name, O_RDONLY);
+ if (old < 0)
+ { perror (old_name); exit (1); }
+ new = open (new_name, O_CREAT|O_RDWR|O_TRUNC, 0777);
+ if (new < 0)
+ { perror (new_name); exit (1); }
+
+ /* Read the old headers */
+ read_header (old, &hdr, &auxhdr);
+
+ brk_on_dump = (long) sbrk (0);
+
+ /* Decide how large the new and old data areas are */
+ old_size = auxhdr.exec_dsize;
+ /* I suspect these two statements are separate
+ to avoid a compiler bug in hpux version 8. */
+ i = (long) sbrk (0);
+ new_size = i - auxhdr.exec_dmem;
+
+ /* Copy the old file to the new, up to the data space */
+ lseek (old, 0, 0);
+ copy_file (old, new, auxhdr.exec_dfile);
+
+ /* Skip the old data segment and write a new one */
+ lseek (old, old_size, 1);
+ save_data_space (new, &hdr, &auxhdr, new_size);
+
+ /* Copy the rest of the file */
+ copy_rest (old, new);
+
+ /* Update file pointers since we probably changed size of data area */
+ update_file_ptrs (new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size);
+
+ /* Save the modified header */
+ write_header (new, &hdr, &auxhdr);
+
+ /* Close the binary file */
+ close (old);
+ close (new);
+}
diff --git a/src/vm-limit.c b/src/vm-limit.c
index 4694608602f..846946b41c1 100644
--- a/src/vm-limit.c
+++ b/src/vm-limit.c
@@ -166,9 +166,9 @@ static void
check_memory_limits (void)
{
#ifdef REL_ALLOC
- extern POINTER (*real_morecore) (SIZE);
+ extern POINTER (*real_morecore) (long);
#endif
- extern POINTER (*__morecore) (SIZE);
+ extern POINTER (*__morecore) (long);
register POINTER cp;
unsigned long five_percent;
@@ -297,4 +297,3 @@ memory_warnings (POINTER start, void (*warnfun) (const char *))
/* Force data limit to be recalculated on each run. */
lim_data = 0;
}
-
diff --git a/src/w32.c b/src/w32.c
index d81fdf3305d..de72e180c62 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -1452,6 +1452,14 @@ sigprocmask (int how, const sigset_t *set, sigset_t *oset)
}
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;
@@ -5960,8 +5968,7 @@ globals_of_w32 (void)
get_process_times_fn = (GetProcessTimes_Proc)
GetProcAddress (kernel32, "GetProcessTimes");
- QCloaded_from = intern_c_string (":loaded-from");
- staticpro (&QCloaded_from);
+ DEFSYM (QCloaded_from, ":loaded-from");
Vlibrary_cache = Qnil;
staticpro (&Vlibrary_cache);
diff --git a/src/w32fns.c b/src/w32fns.c
index bdf9dce9411..f48e5764b4c 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -184,7 +184,7 @@ unsigned int msh_mousewheel = 0;
static unsigned menu_free_timer = 0;
#if GLYPH_DEBUG
-int image_cache_refcount, dpyinfo_refcount;
+static int image_cache_refcount, dpyinfo_refcount;
#endif
static HWND w32_visible_system_caret_hwnd;
@@ -1596,7 +1596,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
FRAME_TOOL_BAR_LINES (f) = nlines;
- change_window_heights (root_window, delta);
+ resize_frame_windows (f, FRAME_LINES (f), 0);
adjust_glyphs (f);
/* We also have to make sure that the internal border at the top of
@@ -1631,6 +1631,9 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
if (WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
}
+
+ run_window_configuration_change_hook (f);
+
}
@@ -3270,7 +3273,8 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
/* Free memory used by owner-drawn and help-echo strings. */
w32_free_menu_strings (hwnd);
- f->output_data.w32->menubar_active = 0;
+ if (f)
+ f->output_data.w32->menubar_active = 0;
menubar_in_use = 0;
}
}
@@ -3620,10 +3624,10 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
if (LOWORD (lParam) == HTCLIENT)
{
f = x_window_to_frame (dpyinfo, hwnd);
- if (f->output_data.w32->hourglass_p && !menubar_in_use
- && !current_popup_menu)
+ if (f && f->output_data.w32->hourglass_p
+ && !menubar_in_use && !current_popup_menu)
SetCursor (f->output_data.w32->hourglass_cursor);
- else
+ else if (f)
SetCursor (f->output_data.w32->current_cursor);
return 0;
}
@@ -5822,8 +5826,6 @@ Value is t if tooltip was open, nil otherwise. */)
UNGCPRO;
return unbind_to (count, deleted);
}
-
-
/***********************************************************************
File selection dialog
@@ -6804,10 +6806,6 @@ syms_of_w32fns (void)
DEFSYM (Qfont_param, "font-parameter");
/* This is the end of symbol initialization. */
- /* Text property `display' should be nonsticky by default. */
- Vtext_property_default_nonsticky
- = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
-
Fput (Qundefined_color, Qerror_conditions,
pure_cons (Qundefined_color, pure_cons (Qerror, Qnil)));
diff --git a/src/w32gui.h b/src/w32gui.h
index 936709af181..2ba9cb53e22 100644
--- a/src/w32gui.h
+++ b/src/w32gui.h
@@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define EMACS_W32GUI_H
#include <windows.h>
+#include "systime.h" /* for Time */
+
/* Local memory management for menus. */
#define local_heap (GetProcessHeap ())
#define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
@@ -47,7 +49,6 @@ typedef char * XrmDatabase;
typedef XGCValues * GC;
typedef COLORREF Color;
-typedef DWORD Time;
typedef HWND Window;
typedef HDC Display; /* HDC so it doesn't conflict with xpm lib. */
typedef HCURSOR Cursor;
@@ -147,4 +148,3 @@ typedef struct {
#endif /* EMACS_W32GUI_H */
-
diff --git a/src/w32inevt.c b/src/w32inevt.c
index 465f5ccb70f..fddde61663f 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -45,7 +45,7 @@ extern HANDLE keyboard_handle;
/* Info for last mouse motion */
static COORD movement_pos;
-static DWORD movement_time;
+static Time movement_time;
/* from w32fns.c */
extern unsigned int map_keypad_keys (unsigned int, unsigned int);
@@ -544,7 +544,7 @@ w32_console_mouse_position (FRAME_PTR *f,
enum scroll_bar_part *part,
Lisp_Object *x,
Lisp_Object *y,
- unsigned long *time)
+ Time *time)
{
BLOCK_INPUT;
@@ -756,4 +756,3 @@ w32_console_read_socket (struct terminal *terminal,
UNBLOCK_INPUT;
return ret;
}
-
diff --git a/src/w32menu.c b/src/w32menu.c
index ca763b553cf..c31a8c1fd96 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -33,7 +33,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "buffer.h"
#include "charset.h"
-#include "character.h"
#include "coding.h"
#include "menu.h"
@@ -146,7 +145,7 @@ otherwise it is "Question". */)
FRAME_PTR new_f = SELECTED_FRAME ();
Lisp_Object bar_window;
enum scroll_bar_part part;
- unsigned long time;
+ Time time;
Lisp_Object x, y;
(*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
diff --git a/src/w32proc.c b/src/w32proc.c
index e94d9aa3254..47cbf57d9ea 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -51,7 +51,6 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD);
#endif
#include "lisp.h"
-#include "character.h"
#include "w32.h"
#include "w32heap.h"
#include "systime.h"
diff --git a/src/w32select.c b/src/w32select.c
index ef0cb3adc24..e3225c3f996 100644
--- a/src/w32select.c
+++ b/src/w32select.c
@@ -80,7 +80,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "charset.h"
#include "coding.h"
-#include "character.h"
#include "composite.h"
diff --git a/src/w32term.c b/src/w32term.c
index f6a6ba3e82f..b7c0d61b633 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -715,22 +715,22 @@ w32_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
if (sb_width > 0)
{
- int left = WINDOW_SCROLL_BAR_AREA_X (w);
- int width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w)
- * FRAME_COLUMN_WIDTH (f));
+ 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 (left + width == p->x)
- bx = left + sb_width;
- else if (p->x + p->wd == left)
- bx = left;
+ 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 = width - sb_width;
+ nx = bar_area_width - sb_width;
by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
row->y));
ny = row->visible_height;
@@ -738,13 +738,13 @@ w32_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
}
else
{
- if (left + width == bx)
+ if (bar_area_x + bar_area_width == bx)
{
- bx = left + sb_width;
- nx += width - sb_width;
+ bx = bar_area_x + sb_width;
+ nx += bar_area_width - sb_width;
}
- else if (bx + nx == left)
- nx += width - sb_width;
+ else if (bx + nx == bar_area_x)
+ nx += bar_area_width - sb_width;
}
}
}
@@ -1002,7 +1002,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 inline void
x_set_mode_line_face_gc (struct glyph_string *s)
{
s->gc = s->face->gc;
@@ -1013,7 +1013,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 inline void
x_set_glyph_string_gc (struct glyph_string *s)
{
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
@@ -1058,7 +1058,7 @@ x_set_glyph_string_gc (struct glyph_string *s)
/* Set clipping for output of glyph string S. S may be part of a mode
line or menu if we don't have X toolkit support. */
-static INLINE void
+static inline void
x_set_glyph_string_clipping (struct glyph_string *s)
{
RECT *r = s->clip;
@@ -1128,7 +1128,7 @@ w32_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 inline void
x_clear_glyph_string_rect (struct glyph_string *s,
int x, int y, int w, int h)
{
@@ -2619,6 +2619,32 @@ x_scroll_run (struct window *w, struct run *run)
fringes of W. */
window_box (w, -1, &x, &y, &width, &height);
+ /* 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 (bar_area_x + bar_area_width == x)
+ {
+ x = bar_area_x + sb_width;
+ width += bar_area_width - sb_width;
+ }
+ else if (x + width == bar_area_x)
+ width += bar_area_width - sb_width;
+ }
+ }
+
from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y);
to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y);
bottom_y = y + height;
diff --git a/src/w32term.h b/src/w32term.h
index cf6751b7d63..24a2be7dca9 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -103,7 +103,7 @@ struct w32_display_info
/* Emacs bitmap-id of the default icon bitmap for this frame.
Or -1 if none has been allocated yet. */
- int icon_bitmap_id;
+ ptrdiff_t icon_bitmap_id;
/* The root window of this screen. */
Window root_window;
@@ -151,10 +151,10 @@ struct w32_display_info
struct w32_bitmap_record *bitmaps;
/* Allocated size of bitmaps field. */
- int bitmaps_size;
+ ptrdiff_t bitmaps_size;
/* Last used bitmap index. */
- int bitmaps_last;
+ ptrdiff_t bitmaps_last;
/* The frame (if any) which has the window that has keyboard focus.
Zero if none. This is examined by Ffocus_frame in w32fns.c. Note
diff --git a/src/widget.c b/src/widget.c
index 3053ceaea13..a09ec2631ad 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -78,7 +78,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2);
static void EmacsFrameDestroy (Widget widget);
static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs);
-void EmacsFrameResize (Widget widget);
+static void EmacsFrameResize (Widget widget);
static Boolean EmacsFrameSetValues (Widget cur_widget, Widget req_widget, Widget new_widget, ArgList dum1, Cardinal *dum2);
static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result);
@@ -137,7 +137,7 @@ emacsFrameTranslations [] = "\
";
*/
-EmacsFrameClassRec emacsFrameClassRec = {
+static EmacsFrameClassRec emacsFrameClassRec = {
{ /* core fields */
/* superclass */ &widgetClassRec,
/* class_name */ "EmacsFrame",
@@ -224,8 +224,7 @@ get_wm_shell (Widget w)
#if 0 /* Currently not used. */
static void
-mark_shell_size_user_specified (wmshell)
- Widget wmshell;
+mark_shell_size_user_specified (Widget wmshell)
{
if (! XtIsWMShell (wmshell)) abort ();
/* This is kind of sleazy, but I can't see how else to tell it to make it
@@ -463,10 +462,6 @@ set_frame_size (EmacsFrame ew)
}
}
-/* Nonzero tells update_wm_hints not to do anything
- (the caller should call update_wm_hints explicitly later.) */
-int update_hints_inhibit;
-
static void
update_wm_hints (EmacsFrame ew)
{
@@ -481,9 +476,6 @@ update_wm_hints (EmacsFrame ew)
int base_height;
int min_rows = 0, min_cols = 0;
- if (update_hints_inhibit)
- return;
-
#if 0
check_frame_size (ew->emacs_frame.frame, &min_rows, &min_cols);
#endif
@@ -517,20 +509,16 @@ update_wm_hints (EmacsFrame ew)
#if 0
static void
-create_frame_gcs (ew)
- EmacsFrame ew;
+create_frame_gcs (EmacsFrame ew)
{
struct frame *s = ew->emacs_frame.frame;
s->output_data.x->normal_gc
- = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)),
- (unsigned long)0, (XGCValues *)0);
+ = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), 0, 0);
s->output_data.x->reverse_gc
- = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)),
- (unsigned long)0, (XGCValues *)0);
+ = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), 0, 0);
s->output_data.x->cursor_gc
- = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)),
- (unsigned long)0, (XGCValues *)0);
+ = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), 0, 0);
s->output_data.x->black_relief.gc = 0;
s->output_data.x->white_relief.gc = 0;
}
@@ -589,8 +577,7 @@ setup_frame_gcs (EmacsFrame ew)
= XCreatePixmapFromBitmapData (XtDisplay(ew),
RootWindowOfScreen (XtScreen (ew)),
setup_frame_cursor_bits, 2, 2,
- (unsigned long)0, (unsigned long)1,
- ew->core.depth);
+ 0, 1, ew->core.depth);
/* Normal video */
gc_values.foreground = ew->emacs_frame.foreground_pixel;
@@ -703,7 +690,7 @@ EmacsFrameDestroy (Widget widget)
UNBLOCK_INPUT;
}
-void
+static void
EmacsFrameResize (Widget widget)
{
EmacsFrame ew = (EmacsFrame)widget;
diff --git a/src/widgetprv.h b/src/widgetprv.h
index 5df0976f879..997a70e026c 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -70,9 +70,4 @@ typedef struct _EmacsFrameClassRec { /* full class record declaration */
EmacsFrameClassPart emacs_frame_class;
} EmacsFrameClassRec;
-extern EmacsFrameClassRec emacsFrameClassRec; /* class pointer */
-
-
-
#endif /* _EmacsFrameP_h */
-
diff --git a/src/window.c b/src/window.c
index 094cfcfbda3..3f5a743f5c6 100644
--- a/src/window.c
+++ b/src/window.c
@@ -51,10 +51,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
Lisp_Object Qwindowp, Qwindow_live_p;
-static Lisp_Object Qwindow_configuration_p;
-static Lisp_Object Qdisplay_buffer;
+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 Qwindow_size_fixed;
+static Lisp_Object Qsafe, Qabove, Qbelow;
+static Lisp_Object Qauto_buffer_name;
static int displayed_window_lines (struct window *);
static struct window *decode_window (Lisp_Object);
@@ -63,13 +66,7 @@ static int get_leaf_windows (struct window *, struct window **, int);
static void window_scroll (Lisp_Object, 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 window_min_size_1 (struct window *, int, int);
-static int window_min_size_2 (struct window *, int, int);
-static int window_min_size (struct window *, int, int, int, int *);
-static void size_window (Lisp_Object, int, int, int, int, int);
static int freeze_window_start (struct window *, void *);
-static int window_fixed_size_p (struct window *, int, int);
-static void enlarge_window (Lisp_Object, int, int);
static Lisp_Object window_list (void);
static int add_window_to_list (struct window *, void *);
static int candidate_window_p (Lisp_Object, Lisp_Object, Lisp_Object,
@@ -85,6 +82,8 @@ static int foreach_window_1 (struct window *,
int (* fn) (struct window *, void *),
void *);
static Lisp_Object window_list_1 (Lisp_Object, Lisp_Object, Lisp_Object);
+static int window_resize_check (struct window *, int);
+static void window_resize_apply (struct window *, int);
static Lisp_Object select_window (Lisp_Object, Lisp_Object, int);
/* This is the window in which the terminal's cursor should
@@ -94,134 +93,108 @@ static Lisp_Object select_window (Lisp_Object, Lisp_Object, int);
This value is always the same as
FRAME_SELECTED_WINDOW (selected_frame). */
-
Lisp_Object selected_window;
/* A list of all windows for use by next_window and Fwindow_list.
Functions creating or deleting windows should invalidate this cache
by setting it to nil. */
-
Lisp_Object Vwindow_list;
/* The mini-buffer window of the selected frame.
Note that you cannot test for mini-bufferness of an arbitrary window
by comparing against this; but you can test for mini-bufferness of
the selected window. */
-
Lisp_Object minibuf_window;
/* Non-nil means it is the window whose mode line should be
shown as the selected window when the minibuffer is selected. */
-
Lisp_Object minibuf_selected_window;
/* Hook run at end of temp_output_buffer_show. */
-
static Lisp_Object Qtemp_buffer_show_hook;
/* Incremented for each window created. */
-
static int sequence_number;
/* Nonzero after init_window_once has finished. */
-
static int window_initialized;
/* Hook to run when window config changes. */
-
static Lisp_Object Qwindow_configuration_change_hook;
-/* Incremented by 1 whenever a window is deleted. */
-
-static int window_deletion_count;
/* Used by the function window_scroll_pixel_based */
-
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 struct window *
+decode_window (register Lisp_Object window)
+{
+ if (NILP (window))
+ return XWINDOW (selected_window);
-#if 0 /* This isn't used anywhere. */
-/* Nonzero means we can split a frame even if it is "unsplittable". */
-static int inhibit_frame_unsplittable;
-#endif
+ CHECK_LIVE_WINDOW (window);
+ return XWINDOW (window);
+}
+
+static struct window *
+decode_any_window (register Lisp_Object window)
+{
+ if (NILP (window))
+ return XWINDOW (selected_window);
+
+ CHECK_WINDOW (window);
+ return XWINDOW (window);
+}
-
DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
- doc: /* Return t if OBJECT is a window. */)
+ doc: /* Return t if OBJECT is a window and nil otherwise. */)
(Lisp_Object object)
{
return WINDOWP (object) ? Qt : Qnil;
}
DEFUN ("window-live-p", Fwindow_live_p, Swindow_live_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a window which is currently visible. */)
+ doc: /* Return t if OBJECT is a live window and nil otherwise.
+A live window is a window that displays a buffer. */)
(Lisp_Object object)
{
return WINDOW_LIVE_P (object) ? Qt : Qnil;
}
-
-Lisp_Object
-make_window (void)
+
+/* Frames and windows. */
+DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
+ doc: /* Return the frame that window WINDOW is on.
+WINDOW can be any window and defaults to the selected one. */)
+ (Lisp_Object window)
{
- Lisp_Object val;
- register struct window *p;
-
- p = allocate_window ();
- ++sequence_number;
- XSETFASTINT (p->sequence_number, sequence_number);
- XSETFASTINT (p->left_col, 0);
- XSETFASTINT (p->top_line, 0);
- XSETFASTINT (p->total_lines, 0);
- XSETFASTINT (p->total_cols, 0);
- XSETFASTINT (p->hscroll, 0);
- XSETFASTINT (p->min_hscroll, 0);
- p->orig_top_line = p->orig_total_lines = Qnil;
- p->start = Fmake_marker ();
- p->pointm = Fmake_marker ();
- XSETFASTINT (p->use_time, 0);
- p->frame = Qnil;
- p->display_table = Qnil;
- p->dedicated = Qnil;
- p->window_parameters = Qnil;
- p->pseudo_window_p = 0;
- memset (&p->cursor, 0, sizeof (p->cursor));
- memset (&p->last_cursor, 0, sizeof (p->last_cursor));
- memset (&p->phys_cursor, 0, sizeof (p->phys_cursor));
- p->desired_matrix = p->current_matrix = 0;
- p->nrows_scale_factor = p->ncols_scale_factor = 1;
- p->phys_cursor_type = -1;
- p->phys_cursor_width = -1;
- p->must_be_updated_p = 0;
- XSETFASTINT (p->window_end_vpos, 0);
- XSETFASTINT (p->window_end_pos, 0);
- p->window_end_valid = Qnil;
- p->vscroll = 0;
- XSETWINDOW (val, p);
- XSETFASTINT (p->last_point, 0);
- p->frozen_window_start_p = 0;
- p->last_cursor_off_p = p->cursor_off_p = 0;
- p->left_margin_cols = Qnil;
- p->right_margin_cols = Qnil;
- p->left_fringe_width = Qnil;
- p->right_fringe_width = Qnil;
- p->fringes_outside_margins = Qnil;
- p->scroll_bar_width = Qnil;
- p->vertical_scroll_bar_type = Qt;
- p->resize_proportionally = Qnil;
-
- Vwindow_list = Qnil;
- return val;
+ return decode_any_window (window)->frame;
}
-DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0,
- doc: /* Return the window that the cursor now appears in and commands apply to. */)
- (void)
+DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
+ doc: /* Return the root 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 root window of
+that window's frame. If FRAME_OR_WINDOW denotes a live frame, return
+the root window of that frame. */)
+ (Lisp_Object frame_or_window)
{
- return selected_window;
+ Lisp_Object window;
+
+ 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
+ {
+ CHECK_LIVE_FRAME (frame_or_window);
+ window = XFRAME (frame_or_window)->root_window;
+ }
+
+ return window;
}
DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 1, 0,
@@ -239,255 +212,470 @@ used by that frame. */)
DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p,
Swindow_minibuffer_p, 0, 1, 0,
doc: /* Return non-nil if WINDOW is a minibuffer window.
-WINDOW defaults to the selected window. */)
+WINDOW can be any window and defaults to the selected one. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
- return MINI_WINDOW_P (w) ? Qt : Qnil;
+ return MINI_WINDOW_P (decode_any_window (window)) ? Qt : Qnil;
}
-
-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.
-
-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]),
-where X and Y are the pixel coordinates relative to the top left corner
-of the window. The remaining elements are omitted if the character after
-POS is fully visible; otherwise, RTOP and RBOT are the number of pixels
-off-window at the top and bottom of the row, ROWH is the height of the
-display row, and VPOS is the row number (0-based) containing POS. */)
- (Lisp_Object pos, Lisp_Object window, Lisp_Object partially)
+/* 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
+the first window of that frame. */)
+ (Lisp_Object frame_or_window)
{
- register struct window *w;
- register EMACS_INT posint;
- register struct buffer *buf;
- struct text_pos top;
- Lisp_Object in_window = Qnil;
- int rtop, rbot, rowh, vpos, fully_p = 1;
- int x, y;
+ Lisp_Object window;
- w = decode_window (window);
- buf = XBUFFER (w->buffer);
- SET_TEXT_POS_FROM_MARKER (top, w->start);
+ 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
+ {
+ CHECK_LIVE_FRAME (frame_or_window);
+ window = XFRAME (frame_or_window)->root_window;
+ }
- if (EQ (pos, Qt))
- posint = -1;
- else if (!NILP (pos))
+ while (NILP (XWINDOW (window)->buffer))
{
- CHECK_NUMBER_COERCE_MARKER (pos);
- posint = XINT (pos);
+ if (! NILP (XWINDOW (window)->hchild))
+ window = XWINDOW (window)->hchild;
+ else if (! NILP (XWINDOW (window)->vchild))
+ window = XWINDOW (window)->vchild;
+ else
+ abort ();
}
- else if (w == XWINDOW (selected_window))
- posint = PT;
- else
- posint = XMARKER (w->pointm)->charpos;
- /* If position is above window start or outside buffer boundaries,
- or if window start is out of range, position is not visible. */
- if ((EQ (pos, Qt)
- || (posint >= CHARPOS (top) && posint <= BUF_ZV (buf)))
- && CHARPOS (top) >= BUF_BEGV (buf)
- && CHARPOS (top) <= BUF_ZV (buf)
- && pos_visible_p (w, posint, &x, &y, &rtop, &rbot, &rowh, &vpos)
- && (fully_p = !rtop && !rbot, (!NILP (partially) || fully_p)))
- in_window = Qt;
+ return window;
+}
- if (!NILP (in_window) && !NILP (partially))
+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. */)
+ (Lisp_Object frame_or_window)
+{
+ Lisp_Object window;
+
+ if (NILP (frame_or_window))
+ window = SELECTED_FRAME ()->selected_window;
+ else if (WINDOWP (frame_or_window))
+ window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->selected_window;
+ else
{
- Lisp_Object part = Qnil;
- if (!fully_p)
- part = list4 (make_number (rtop), make_number (rbot),
- make_number (rowh), make_number (vpos));
- in_window = Fcons (make_number (x),
- Fcons (make_number (y), part));
+ CHECK_LIVE_FRAME (frame_or_window);
+ window = XFRAME (frame_or_window)->selected_window;
}
- return in_window;
+ return window;
}
-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.
-If WINDOW is nil or omitted, use selected window.
+DEFUN ("set-frame-selected-window", Fset_frame_selected_window,
+ Sset_frame_selected_window, 2, 3, 0,
+ doc: /* Set selected window of FRAME to WINDOW.
+FRAME must be a live frame and defaults to the selected one. If FRAME
+is the selected frame, this makes WINDOW the selected window. Optional
+argument NORECORD non-nil means to neither change the order of recently
+selected windows nor the buffer list. WINDOW must denote a live window.
+Return WINDOW. */)
+ (Lisp_Object frame, Lisp_Object window, Lisp_Object norecord)
+{
+ if (NILP (frame))
+ frame = selected_frame;
-Return height of current line if LINE is omitted or nil. Return height of
-header or mode line if LINE is `header-line' and `mode-line'.
-Otherwise, LINE is a text line number starting from 0. A negative number
-counts from the end of the window.
+ CHECK_LIVE_FRAME (frame);
+ CHECK_LIVE_WINDOW (window);
-Value is a list (HEIGHT VPOS YPOS OFFBOT), where HEIGHT is the height
-in pixels of the visible part of the line, VPOS and YPOS are the
-vertical position in lines and pixels of the line, relative to the top
-of the first text line, and OFFBOT is the number of off-window pixels at
-the bottom of the text line. If there are off-window pixels at the top
-of the (first) text line, YPOS is negative.
+ if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
+ error ("In `set-frame-selected-window', WINDOW is not on FRAME");
-Return nil if window display is not up-to-date. In that case, use
-`pos-visible-in-window-p' to obtain the information. */)
- (Lisp_Object line, Lisp_Object window)
+ if (EQ (frame, selected_frame))
+ return Fselect_window (window, norecord);
+ else
+ return XFRAME (frame)->selected_window = window;
+}
+
+DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0,
+ doc: /* Return the selected window.
+The selected window is the window in which the standard cursor for
+selected windows appears and to which many commands apply. */)
+ (void)
{
- register struct window *w;
- register struct buffer *b;
- struct glyph_row *row, *end_row;
- int max_y, crop, i, n;
+ return selected_window;
+}
- w = decode_window (window);
+int window_select_count;
- if (noninteractive
- || w->pseudo_window_p)
- return Qnil;
+/* If select_window is called with inhibit_point_swap non-zero it will
+ not store point of the old selected window's buffer back into that
+ window's pointm slot. This is needed by Fset_window_configuration to
+ avoid that the display routine is called with selected_window set to
+ Qnil causing a subsequent crash. */
+static Lisp_Object
+select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
+{
+ register struct window *w;
+ register struct window *ow;
+ struct frame *sf;
- CHECK_BUFFER (w->buffer);
- b = XBUFFER (w->buffer);
+ CHECK_LIVE_WINDOW (window);
- /* Fail if current matrix is not up-to-date. */
- 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))
- return Qnil;
+ w = XWINDOW (window);
+ w->frozen_window_start_p = 0;
- if (NILP (line))
+ if (NILP (norecord))
{
- i = w->cursor.vpos;
- if (i < 0 || i >= w->current_matrix->nrows
- || (row = MATRIX_ROW (w->current_matrix, i), !row->enabled_p))
- return Qnil;
- max_y = window_text_bottom_y (w);
- goto found_row;
+ ++window_select_count;
+ XSETFASTINT (w->use_time, window_select_count);
+ record_buffer (w->buffer);
}
- if (EQ (line, Qheader_line))
+ if (EQ (window, selected_window) && !inhibit_point_swap)
+ return window;
+
+ sf = SELECTED_FRAME ();
+ if (XFRAME (WINDOW_FRAME (w)) != sf)
{
- 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));
+ XFRAME (WINDOW_FRAME (w))->selected_window = 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
+ frame is active. */
+ Fselect_frame (WINDOW_FRAME (w), norecord);
+ /* Fselect_frame called us back so we've done all the work already. */
+ eassert (EQ (window, selected_window));
+ return window;
}
+ else
+ sf->selected_window = window;
- if (EQ (line, Qmode_line))
+ /* 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. */
+ if (!inhibit_point_swap)
{
- 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));
+ ow = XWINDOW (selected_window);
+ if (! NILP (ow->buffer))
+ set_marker_both (ow->pointm, ow->buffer,
+ BUF_PT (XBUFFER (ow->buffer)),
+ BUF_PT_BYTE (XBUFFER (ow->buffer)));
}
- CHECK_NUMBER (line);
- n = XINT (line);
-
- row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- end_row = MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w);
- max_y = window_text_bottom_y (w);
- i = 0;
+ selected_window = window;
- while ((n < 0 || i < n)
- && row <= end_row && row->enabled_p
- && row->y + row->height < max_y)
- row++, i++;
+ Fset_buffer (w->buffer);
- if (row > end_row || !row->enabled_p)
- return Qnil;
+ BVAR (XBUFFER (w->buffer), last_selected_window) = window;
- if (++n < 0)
- {
- if (-n > i)
- return Qnil;
- row += n;
- i += n;
- }
+ /* Go to the point recorded in the window.
+ This is important when the buffer is in more
+ than one window. It also matters when
+ 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);
+ if (new_point < BEGV)
+ SET_PT (BEGV);
+ else if (new_point > ZV)
+ SET_PT (ZV);
+ else
+ SET_PT (new_point);
+ }
- 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));
+ windows_or_buffers_changed++;
+ return window;
}
+DEFUN ("select-window", Fselect_window, Sselect_window, 1, 2, 0,
+ doc: /* Select WINDOW. Most editing will apply to WINDOW's buffer.
+Also make WINDOW's buffer current and make WINDOW the frame's selected
+window. Return WINDOW.
+
+Optional second arg NORECORD non-nil means do not put this buffer at the
+front of the buffer list and do not make this window the most recently
+selected one.
+Note that the main editor command loop sets the current buffer to the
+buffer of the selected window before each command. */)
+ (register Lisp_Object window, Lisp_Object norecord)
+{
+ return select_window (window, norecord, 0);
+}
-static struct window *
-decode_window (register Lisp_Object window)
+DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0,
+ doc: /* Return the buffer that WINDOW is displaying.
+WINDOW can be any window and defaults to the selected one.
+If WINDOW is an internal window return nil. */)
+ (Lisp_Object window)
{
- if (NILP (window))
- return XWINDOW (selected_window);
+ return decode_any_window (window)->buffer;
+}
- CHECK_LIVE_WINDOW (window);
- return XWINDOW (window);
+DEFUN ("window-parent", Fwindow_parent, Swindow_parent, 0, 1, 0,
+ doc: /* Return WINDOW's parent window.
+WINDOW can be any window and defaults to the selected one.
+Return nil if WINDOW has no parent. */)
+ (Lisp_Object window)
+{
+ return decode_any_window (window)->parent;
}
-static struct window *
-decode_any_window (register Lisp_Object window)
+DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 0, 1, 0,
+ doc: /* Return WINDOW's topmost child window.
+WINDOW can be any window and defaults to the selected one.
+Return nil if WINDOW is not a vertical combination. */)
+ (Lisp_Object window)
{
- if (NILP (window))
- return XWINDOW (selected_window);
+ return decode_any_window (window)->vchild;
+}
- CHECK_WINDOW (window);
- return XWINDOW (window);
+DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 0, 1, 0,
+ doc: /* Return WINDOW's leftmost child window.
+WINDOW can be any window and defaults to the selected one.
+Return nil if WINDOW is not a horizontal combination. */)
+ (Lisp_Object window)
+{
+ return decode_any_window (window)->hchild;
}
-DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0,
- doc: /* Return the buffer that WINDOW is displaying.
-WINDOW defaults to the selected window. */)
+DEFUN ("window-next-sibling", Fwindow_next_sibling, Swindow_next_sibling, 0, 1, 0,
+ doc: /* Return WINDOW's next sibling window.
+WINDOW can be any window and defaults to the selected one.
+Return nil if WINDOW has no next sibling. */)
(Lisp_Object window)
{
- return decode_window (window)->buffer;
+ return decode_any_window (window)->next;
}
-DEFUN ("window-height", Fwindow_height, Swindow_height, 0, 1, 0,
- doc: /* Return the number of lines in WINDOW.
-WINDOW defaults to the selected window.
+DEFUN ("window-prev-sibling", Fwindow_prev_sibling, Swindow_prev_sibling, 0, 1, 0,
+ doc: /* Return WINDOW's previous sibling window.
+WINDOW can be any window and defaults to the selected one.
+Return nil if WINDOW has no previous sibling. */)
+ (Lisp_Object window)
+{
+ return decode_any_window (window)->prev;
+}
+
+DEFUN ("window-splits", Fwindow_splits, Swindow_splits, 0, 1, 0,
+ doc: /* Return splits status for WINDOW.
+WINDOW can be any window and defaults to the selected one.
-The return value includes WINDOW's mode line and header line, if any.
+If the value returned by this function is nil and WINDOW is resized, the
+corresponding space is preferably taken from (or given to) WINDOW's
+right sibling. When WINDOW is deleted, its space is given to its left
+sibling.
-Note: The function does not take into account the value of `line-spacing'
-when calculating the number of lines in WINDOW. */)
+If the value returned by this function is non-nil, resizing and deleting
+WINDOW may resize all windows in the same combination. */)
(Lisp_Object window)
{
- return decode_any_window (window)->total_lines;
+ return decode_any_window (window)->splits;
}
-DEFUN ("window-width", Fwindow_width, Swindow_width, 0, 1, 0,
- doc: /* Return the number of display columns in WINDOW.
-WINDOW defaults to the selected window.
+DEFUN ("set-window-splits", Fset_window_splits, Sset_window_splits, 2, 2, 0,
+ doc: /* Set splits status of WINDOW to STATUS.
+WINDOW can be any window and defaults to the selected one. Return
+STATUS.
+
+If STATUS is nil and WINDOW is later resized, the corresponding space is
+preferably taken from (or given to) WINDOW's right sibling. When WINDOW
+is deleted, its space is given to its left sibling.
+
+If STATUS is non-nil, resizing and deleting WINDOW may resize all
+windows in the same combination. */)
+ (Lisp_Object window, Lisp_Object status)
+{
+ register struct window *w = decode_any_window (window);
-Note: The return value is the number of columns available for text in
-WINDOW. If you want to find out how many columns WINDOW takes up, use
-(let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges))). */)
+ w->splits = status;
+
+ return w->splits;
+}
+
+DEFUN ("window-nest", Fwindow_nest, Swindow_nest, 0, 1, 0,
+ doc: /* Return nest status of WINDOW.
+WINDOW can be any window and defaults to the selected one.
+
+If the return value is nil, subwindows of WINDOW can be recombined with
+WINDOW's siblings. A return value of non-nil means that subwindows of
+WINDOW are never \(re-)combined with WINDOW's siblings. */)
(Lisp_Object window)
{
- return make_number (window_box_text_cols (decode_any_window (window)));
+ return decode_any_window (window)->nest;
}
-DEFUN ("window-full-width-p", Fwindow_full_width_p, Swindow_full_width_p, 0, 1, 0,
- doc: /* Return t if WINDOW is as wide as its frame.
-WINDOW defaults to the selected window. */)
+DEFUN ("set-window-nest", Fset_window_nest, Sset_window_nest, 2, 2, 0,
+ doc: /* Set nest status of WINDOW to STATUS.
+WINDOW can be any window and defaults to the selected one. Return
+STATUS.
+
+If STATUS is nil, subwindows of WINDOW can be recombined with WINDOW's
+siblings. STATUS non-nil means that subwindows of WINDOW are never
+\(re-)combined with WINDOW's siblings. */)
+ (Lisp_Object window, Lisp_Object status)
+{
+ register struct window *w = decode_any_window (window);
+
+ w->nest = status;
+
+ return w->nest;
+}
+
+DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0,
+ doc: /* Return WINDOW's use time.
+WINDOW defaults to the selected window. 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;
+}
+
+DEFUN ("window-total-size", Fwindow_total_size, Swindow_total_size, 0, 2, 0,
+ doc: /* Return the total number of lines of WINDOW.
+WINDOW can be any window and defaults to the selected one. The return
+value includes WINDOW's mode line and header line, if any. If WINDOW
+is internal, the return value is the sum of the total number of lines
+of WINDOW's child windows if these are vertically combined and the
+height of WINDOW's first child otherwise.
+
+Optional argument HORIZONTAL non-nil means return the total number of
+columns of WINDOW. In this case the return value includes any vertical
+dividers or scrollbars of WINDOW. If WINDOW is internal, the return
+value is the sum of the total number of columns of WINDOW's child
+windows if they are horizontally combined and the width of WINDOW's
+first child otherwise. */)
+ (Lisp_Object window, Lisp_Object horizontal)
+{
+ if (NILP (horizontal))
+ return decode_any_window (window)->total_lines;
+ else
+ return decode_any_window (window)->total_cols;
+}
+
+DEFUN ("window-new-total", Fwindow_new_total, Swindow_new_total, 0, 1, 0,
+ doc: /* Return new total size of WINDOW.
+WINDOW defaults to the selected window. */)
(Lisp_Object window)
{
- return WINDOW_FULL_WIDTH_P (decode_any_window (window)) ? Qt : Qnil;
+ return decode_any_window (window)->new_total;
+}
+
+DEFUN ("window-normal-size", Fwindow_normal_size, Swindow_normal_size, 0, 2, 0,
+ doc: /* Return normal height of WINDOW.
+WINDOW can be any window and defaults to the selected one. Optional
+argument HORIZONTAL non-nil means return 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;
+}
+
+DEFUN ("window-new-normal", Fwindow_new_normal, Swindow_new_normal, 0, 1, 0,
+ doc: /* Return new normal size of WINDOW.
+WINDOW can be any window and defaults to the selected one. */)
+ (Lisp_Object window)
+{
+ return decode_any_window (window)->new_normal;
+}
+
+DEFUN ("window-left-column", Fwindow_left_column, Swindow_left_column, 0, 1, 0,
+ doc: /* Return left column of WINDOW.
+WINDOW can be any window and defaults to the selected one. */)
+ (Lisp_Object window)
+{
+ return decode_any_window (window)->left_col;
+}
+
+DEFUN ("window-top-line", Fwindow_top_line, Swindow_top_line, 0, 1, 0,
+ doc: /* Return top line of WINDOW.
+WINDOW can be any window and defaults to the selected one. */)
+ (Lisp_Object window)
+{
+ return decode_any_window (window)->top_line;
+}
+
+/* Return the number of lines of W's body. Don't count any mode or
+ header line of W. */
+
+static int
+window_body_lines (struct window *w)
+{
+ int height = XFASTINT (w->total_lines);
+
+ if (!MINI_WINDOW_P (w))
+ {
+ if (WINDOW_WANTS_MODELINE_P (w))
+ --height;
+ if (WINDOW_WANTS_HEADER_LINE_P (w))
+ --height;
+ }
+
+ return height;
+}
+
+/* Return the number of columns of W's body. Don't count columns
+ occupied by the scroll bar or the vertical bar separating W from its
+ right sibling. On window-systems don't count fringes or display
+ margins either. */
+
+int
+window_body_cols (struct window *w)
+{
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ int width = XINT (w->total_cols);
+
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR (w))
+ /* Scroll bars occupy a few columns. */
+ width -= WINDOW_CONFIG_SCROLL_BAR_COLS (w);
+ else if (!FRAME_WINDOW_P (f)
+ && !WINDOW_RIGHTMOST_P (w) && !WINDOW_FULL_WIDTH_P (w))
+ /* The column of `|' characters separating side-by-side windows
+ occupies one column only. */
+ width -= 1;
+
+ if (FRAME_WINDOW_P (f))
+ /* On window-systems, fringes and display margins cannot be
+ used for normal text. */
+ width -= (WINDOW_FRINGE_COLS (w)
+ + WINDOW_LEFT_MARGIN_COLS (w)
+ + WINDOW_RIGHT_MARGIN_COLS (w));
+
+ return width;
+}
+
+DEFUN ("window-body-size", Fwindow_body_size, Swindow_body_size, 0, 2, 0,
+ doc: /* Return the number of lines of WINDOW's body.
+WINDOW must be a live window and defaults to the selected one. The
+return value does not include WINDOW's mode line and header line, if
+any.
+
+Optional argument HORIZONTAL non-nil means return the number of columns
+of WINDOW's body. In this case, the return value does not include any
+vertical dividers or scroll bars owned by WINDOW. On a window-system
+the return value does not include the number of columns used for
+WINDOW's fringes or display margins either. */)
+ (Lisp_Object window, Lisp_Object horizontal)
+{
+ struct window *w = decode_any_window (window);
+
+ if (NILP (horizontal))
+ return make_number (window_body_lines (w));
+ else
+ return make_number (window_body_cols (w));
}
DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0,
doc: /* Return the number of columns by which WINDOW is scrolled from left margin.
-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)->hscroll;
@@ -495,6 +683,7 @@ WINDOW defaults to the selected window. */)
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.
Note that if `automatic-hscrolling' is non-nil, you cannot scroll the
@@ -1057,7 +1246,7 @@ window_from_coordinates (struct frame *f, int x, int y,
DEFUN ("window-at", Fwindow_at, Swindow_at, 2, 3, 0,
doc: /* Return window containing coordinates X and Y on FRAME.
-If omitted, FRAME defaults to the currently selected frame.
+FRAME must be a live frame and defaults to the selected one.
The top left corner of the frame is considered to be row 0,
column 0. */)
(Lisp_Object x, Lisp_Object y, Lisp_Object frame)
@@ -1083,7 +1272,7 @@ column 0. */)
DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0,
doc: /* Return current value of point in WINDOW.
-WINDOW defaults to the selected 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.
@@ -1105,7 +1294,7 @@ But that is hard to define. */)
DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0,
doc: /* Return position at which display currently starts in WINDOW.
-WINDOW defaults to the selected window.
+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)
{
@@ -1125,7 +1314,7 @@ have been if redisplay had finished, do this:
DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 2, 0,
doc: /* Return position at which display currently ends in WINDOW.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
This is updated by redisplay, when it runs to completion.
Simply changing the buffer text or setting `window-start'
does not update this value.
@@ -1225,7 +1414,7 @@ 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.
-WINDOW defaults to the selected window. Return POS.
+If WINDOW is nil, the selected window is used. 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)
@@ -1247,6 +1436,179 @@ overriding motion of point in order to display at this exact start. */)
return pos;
}
+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.
+
+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]),
+where X and Y are the pixel coordinates relative to the top left corner
+of the window. The remaining elements are omitted if the character after
+POS is fully visible; otherwise, RTOP and RBOT are the number of pixels
+off-window at the top and bottom of the row, ROWH is the height of the
+display row, and VPOS is the row number (0-based) containing POS. */)
+ (Lisp_Object pos, Lisp_Object window, Lisp_Object partially)
+{
+ register struct window *w;
+ register EMACS_INT posint;
+ register struct buffer *buf;
+ struct text_pos top;
+ Lisp_Object in_window = Qnil;
+ int rtop, rbot, rowh, vpos, fully_p = 1;
+ int x, y;
+
+ w = decode_window (window);
+ buf = XBUFFER (w->buffer);
+ SET_TEXT_POS_FROM_MARKER (top, w->start);
+
+ if (EQ (pos, Qt))
+ posint = -1;
+ else if (!NILP (pos))
+ {
+ CHECK_NUMBER_COERCE_MARKER (pos);
+ posint = XINT (pos);
+ }
+ else if (w == XWINDOW (selected_window))
+ posint = PT;
+ else
+ posint = XMARKER (w->pointm)->charpos;
+
+ /* If position is above window start or outside buffer boundaries,
+ or if window start is out of range, position is not visible. */
+ if ((EQ (pos, Qt)
+ || (posint >= CHARPOS (top) && posint <= BUF_ZV (buf)))
+ && CHARPOS (top) >= BUF_BEGV (buf)
+ && CHARPOS (top) <= BUF_ZV (buf)
+ && pos_visible_p (w, posint, &x, &y, &rtop, &rbot, &rowh, &vpos)
+ && (fully_p = !rtop && !rbot, (!NILP (partially) || fully_p)))
+ in_window = Qt;
+
+ if (!NILP (in_window) && !NILP (partially))
+ {
+ Lisp_Object part = Qnil;
+ if (!fully_p)
+ part = list4 (make_number (rtop), make_number (rbot),
+ make_number (rowh), make_number (vpos));
+ in_window = Fcons (make_number (x),
+ Fcons (make_number (y), part));
+ }
+
+ return in_window;
+}
+
+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.
+
+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'.
+Otherwise, LINE is a text line number starting from 0. A negative number
+counts from the end of the window.
+
+Value is a list (HEIGHT VPOS YPOS OFFBOT), where HEIGHT is the height
+in pixels of the visible part of the line, VPOS and YPOS are the
+vertical position in lines and pixels of the line, relative to the top
+of the first text line, and OFFBOT is the number of off-window pixels at
+the bottom of the text line. If there are off-window pixels at the top
+of the (first) text line, YPOS is negative.
+
+Return nil if window display is not up-to-date. In that case, use
+`pos-visible-in-window-p' to obtain the information. */)
+ (Lisp_Object line, Lisp_Object window)
+{
+ register struct window *w;
+ register struct buffer *b;
+ struct glyph_row *row, *end_row;
+ int max_y, crop, i, n;
+
+ w = decode_window (window);
+
+ if (noninteractive || w->pseudo_window_p)
+ return Qnil;
+
+ CHECK_BUFFER (w->buffer);
+ b = XBUFFER (w->buffer);
+
+ /* Fail if current matrix is not up-to-date. */
+ 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))
+ return Qnil;
+
+ if (NILP (line))
+ {
+ i = w->cursor.vpos;
+ if (i < 0 || i >= w->current_matrix->nrows
+ || (row = MATRIX_ROW (w->current_matrix, i), !row->enabled_p))
+ return Qnil;
+ max_y = window_text_bottom_y (w);
+ goto found_row;
+ }
+
+ if (EQ (line, Qheader_line))
+ {
+ 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));
+ }
+
+ 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));
+ }
+
+ CHECK_NUMBER (line);
+ n = XINT (line);
+
+ row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
+ end_row = MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w);
+ max_y = window_text_bottom_y (w);
+ i = 0;
+
+ while ((n < 0 || i < n)
+ && row <= end_row && row->enabled_p
+ && row->y + row->height < max_y)
+ row++, i++;
+
+ if (row > end_row || !row->enabled_p)
+ return Qnil;
+
+ if (++n < 0)
+ {
+ if (-n > i)
+ return Qnil;
+ row += n;
+ i += n;
+ }
+
+ 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));
+}
DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
0, 1, 0,
@@ -1274,22 +1636,22 @@ is the value returned by `window-dedicated-p' is t. */)
DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p,
Sset_window_dedicated_p, 2, 2, 0,
doc: /* Mark WINDOW as dedicated according to FLAG.
-WINDOW defaults to the selected window. FLAG non-nil means mark WINDOW
-as dedicated to its buffer. FLAG nil means mark WINDOW as non-dedicated.
-Return FLAG.
+WINDOW must be a live window and defaults to the selected one. FLAG
+non-nil means mark WINDOW as dedicated to its buffer. FLAG nil means
+mark WINDOW as non-dedicated. Return FLAG.
When a window is dedicated to its buffer, `display-buffer' will refrain
from displaying another buffer in it. `get-lru-window' and
`get-largest-window' treat dedicated windows specially.
-`delete-windows-on', `replace-buffer-in-windows', `quit-window' and
-`kill-buffer' can delete a dedicated window and the containing
-frame.
+`delete-windows-on', `replace-buffer-in-windows', `quit-window',
+`quit-restore-window' and `kill-buffer' can delete a dedicated window
+and the containing frame.
As a special case, if FLAG is t, mark WINDOW as "strongly" dedicated to
its buffer. Functions like `set-window-buffer' may change the buffer
displayed by a window, unless that window is strongly dedicated to its
buffer. If and when `set-window-buffer' displays another buffer in a
-window, it also makes sure that the window is not marked as dedicated. */)
+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);
@@ -1298,6 +1660,52 @@ window, it also makes sure that the window is not marked as dedicated. */)
return w->dedicated;
}
+DEFUN ("window-prev-buffers", Fwindow_prev_buffers, Swindow_prev_buffers,
+ 0, 1, 0,
+ doc: /* Return buffers previously shown in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+The return value is either nil or a list of <buffer, window-start,
+window-point> triples where buffer was previously shown in WINDOW. */)
+ (Lisp_Object window)
+{
+ return decode_window (window)->prev_buffers;
+}
+
+DEFUN ("set-window-prev-buffers", Fset_window_prev_buffers,
+ Sset_window_prev_buffers, 2, 2, 0,
+ doc: /* Set WINDOW's previous buffers to PREV-BUFFERS.
+WINDOW must be a live window and defaults to the selected one. Return
+PREV-BUFFERS.
+
+PREV-BUFFERS should be either nil or a list of <buffer, window-start,
+window-point> triples where buffer was previously shown in WINDOW. */)
+ (Lisp_Object window, Lisp_Object prev_buffers)
+{
+ return decode_any_window (window)->prev_buffers = prev_buffers;
+}
+
+DEFUN ("window-next-buffers", Fwindow_next_buffers, Swindow_next_buffers,
+ 0, 1, 0,
+ doc: /* Return list of buffers recently re-shown in WINDOW.
+WINDOW must be a live window and defaults to the selected one. */)
+ (Lisp_Object window)
+{
+ return decode_window (window)->next_buffers;
+}
+
+DEFUN ("set-window-next-buffers", Fset_window_next_buffers,
+ Sset_window_next_buffers, 2, 2, 0,
+ doc: /* Set WINDOW's next buffers to NEXT-BUFFERS.
+WINDOW must be a live window and defaults to the selected one. Return
+NEXT-BUFFERS.
+
+NEXT-BUFFERS should be either nil or a list of buffers that have been
+recently re-shown in WINDOW. */)
+ (Lisp_Object window, Lisp_Object next_buffers)
+{
+ return decode_any_window (window)->next_buffers = next_buffers;
+}
DEFUN ("window-parameters", Fwindow_parameters, Swindow_parameters,
0, 1, 0,
@@ -1306,7 +1714,7 @@ WINDOW defaults to the selected window. The return value is a list of
elements of the form (PARAMETER . VALUE). */)
(Lisp_Object window)
{
- return Fcopy_alist (decode_window (window)->window_parameters);
+ return Fcopy_alist (decode_any_window (window)->window_parameters);
}
DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter,
@@ -1317,7 +1725,7 @@ WINDOW defaults to the selected window. */)
{
Lisp_Object result;
- result = Fassq (parameter, decode_window (window)->window_parameters);
+ result = Fassq (parameter, decode_any_window (window)->window_parameters);
return CDR_SAFE (result);
}
@@ -1327,7 +1735,7 @@ DEFUN ("set-window-parameter", Fset_window_parameter,
WINDOW defaults to the selected window. Return VALUE. */)
(Lisp_Object window, Lisp_Object parameter, Lisp_Object value)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_any_window (window);
Lisp_Object old_alist_elt;
old_alist_elt = Fassq (parameter, w->window_parameters);
@@ -1338,7 +1746,6 @@ WINDOW defaults to the selected window. Return VALUE. */)
return value;
}
-
DEFUN ("window-display-table", Fwindow_display_table, Swindow_display_table,
0, 1, 0,
doc: /* Return the display-table that WINDOW is using.
@@ -1384,9 +1791,7 @@ DEFUN ("set-window-display-table", Fset_window_display_table, Sset_window_displa
return table;
}
-static void delete_window (Lisp_Object);
-
-/* Record info on buffer window w is displaying
+/* Record info on buffer window W is displaying
when it is about to cease to display that buffer. */
static void
unshow_buffer (register struct window *w)
@@ -1435,285 +1840,144 @@ unshow_buffer (register struct window *w)
BVAR (b, last_selected_window) = Qnil;
}
-/* Put replacement into the window structure in place of old. */
+/* Put NEW into the window structure in place of OLD. SETFLAG zero
+ means change window structure only. Otherwise store geometry and
+ other settings as well. */
static void
-replace_window (Lisp_Object old, Lisp_Object replacement)
+replace_window (Lisp_Object old, Lisp_Object new, int setflag)
{
register Lisp_Object tem;
- register struct window *o = XWINDOW (old), *p = XWINDOW (replacement);
-
- /* If OLD is its frame's root_window, then replacement is the new
- root_window for that frame. */
+ register struct window *o = XWINDOW (old), *n = XWINDOW (new);
+ /* 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)) = replacement;
-
- p->left_col = o->left_col;
- p->top_line = o->top_line;
- p->total_cols = o->total_cols;
- p->total_lines = o->total_lines;
- p->desired_matrix = p->current_matrix = 0;
- p->vscroll = 0;
- memset (&p->cursor, 0, sizeof (p->cursor));
- memset (&p->last_cursor, 0, sizeof (p->last_cursor));
- memset (&p->phys_cursor, 0, sizeof (p->phys_cursor));
- p->phys_cursor_type = -1;
- p->phys_cursor_width = -1;
- p->must_be_updated_p = 0;
- p->pseudo_window_p = 0;
- XSETFASTINT (p->window_end_vpos, 0);
- XSETFASTINT (p->window_end_pos, 0);
- p->window_end_valid = Qnil;
- p->frozen_window_start_p = 0;
- p->orig_top_line = p->orig_total_lines = Qnil;
-
- p->next = tem = o->next;
+ 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);
+ n->desired_matrix = n->current_matrix = 0;
+ n->vscroll = 0;
+ memset (&n->cursor, 0, sizeof (n->cursor));
+ memset (&n->last_cursor, 0, sizeof (n->last_cursor));
+ memset (&n->phys_cursor, 0, sizeof (n->phys_cursor));
+ n->phys_cursor_type = -1;
+ 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;
+ n->frozen_window_start_p = 0;
+ }
+
+ n->next = tem = o->next;
if (!NILP (tem))
- XWINDOW (tem)->prev = replacement;
+ XWINDOW (tem)->prev = new;
- p->prev = tem = o->prev;
+ n->prev = tem = o->prev;
if (!NILP (tem))
- XWINDOW (tem)->next = replacement;
+ XWINDOW (tem)->next = new;
- p->parent = tem = o->parent;
+ n->parent = tem = o->parent;
if (!NILP (tem))
{
if (EQ (XWINDOW (tem)->vchild, old))
- XWINDOW (tem)->vchild = replacement;
+ XWINDOW (tem)->vchild = new;
if (EQ (XWINDOW (tem)->hchild, old))
- XWINDOW (tem)->hchild = replacement;
+ XWINDOW (tem)->hchild = new;
}
-
-/*** Here, if replacement is a vertical combination
-and so is its new parent, we should make replacement's
-children be children of that parent instead. ***/
}
-DEFUN ("delete-window", Fdelete_window, Sdelete_window, 0, 1, "",
- doc: /* Remove WINDOW from its frame.
-WINDOW defaults to the selected window. Return nil.
-Signal an error when WINDOW is the only window on its frame. */)
- (register Lisp_Object window)
-{
- struct frame *f;
- if (NILP (window))
- window = selected_window;
- else
- CHECK_LIVE_WINDOW (window);
-
- f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
- delete_window (window);
-
- run_window_configuration_change_hook (f);
-
- return Qnil;
-}
+/* If window WINDOW and its parent window are iso-combined, merge
+ WINDOW's children into those of its parent window and mark WINDOW as
+ deleted. */
static void
-delete_window (register Lisp_Object window)
+recombine_windows (Lisp_Object window)
{
- register Lisp_Object tem, parent, sib;
- register struct window *p;
- register struct window *par;
- struct frame *f;
-
- /* Because this function is called by other C code on non-leaf
- windows, the CHECK_LIVE_WINDOW macro would choke inappropriately,
- so we can't decode_window here. */
- CHECK_WINDOW (window);
- p = XWINDOW (window);
-
- /* It's a no-op to delete an already-deleted window. */
- if (NILP (p->buffer)
- && NILP (p->hchild)
- && NILP (p->vchild))
- return;
-
- parent = p->parent;
- if (NILP (parent))
- error ("Attempt to delete minibuffer or sole ordinary window");
- par = XWINDOW (parent);
-
- windows_or_buffers_changed++;
- Vwindow_list = Qnil;
- f = XFRAME (WINDOW_FRAME (p));
- FRAME_WINDOW_SIZES_CHANGED (f) = 1;
-
- /* Are we trying to delete any frame's selected window? */
- {
- Lisp_Object swindow, pwindow;
-
- /* See if the frame's selected window is either WINDOW
- or any subwindow of it, by finding all that window's parents
- and comparing each one with WINDOW. */
- swindow = FRAME_SELECTED_WINDOW (f);
-
- while (1)
- {
- pwindow = swindow;
- while (!NILP (pwindow))
- {
- if (EQ (window, pwindow))
- break;
- pwindow = XWINDOW (pwindow)->parent;
- }
-
- /* If the window being deleted is not a parent of SWINDOW,
- then SWINDOW is ok as the new selected window. */
- if (!EQ (window, pwindow))
- break;
- /* Otherwise, try another window for SWINDOW. */
- swindow = Fnext_window (swindow, Qlambda, Qnil);
-
- /* If we get back to the frame's selected window,
- it means there was no acceptable alternative,
- so we cannot delete. */
- if (EQ (swindow, FRAME_SELECTED_WINDOW (f)))
- error ("Cannot delete window");
- }
-
- /* If we need to change SWINDOW, do it. */
- if (! EQ (swindow, FRAME_SELECTED_WINDOW (f)))
- {
- /* If we're about to delete the selected window on the
- selected frame, then we should use Fselect_window to select
- the new window. On the other hand, if we're about to
- delete the selected window on any other frame, we shouldn't do
- anything but set the frame's selected_window slot. */
- if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
- Fselect_window (swindow, Qnil);
- else
- FRAME_SELECTED_WINDOW (f) = swindow;
- }
- }
-
- /* Now we know we can delete this one. */
- window_deletion_count++;
-
- tem = p->buffer;
- /* tem is null for dummy parent windows
- (which have inferiors but not any contents themselves) */
- if (!NILP (tem))
- {
- unshow_buffer (p);
- unchain_marker (XMARKER (p->pointm));
- unchain_marker (XMARKER (p->start));
- }
-
- /* Free window glyph matrices. It is sure that they are allocated
- again when ADJUST_GLYPHS is called. Block input so that expose
- events and other events that access glyph matrices are not
- processed while we are changing them. */
- BLOCK_INPUT;
- free_window_matrices (XWINDOW (FRAME_ROOT_WINDOW (f)));
-
- tem = p->next;
- if (!NILP (tem))
- XWINDOW (tem)->prev = p->prev;
-
- tem = p->prev;
- if (!NILP (tem))
- XWINDOW (tem)->next = p->next;
-
- if (EQ (window, par->hchild))
- par->hchild = p->next;
- if (EQ (window, par->vchild))
- par->vchild = p->next;
-
- /* Find one of our siblings to give our space to. */
- sib = p->prev;
- if (NILP (sib))
- {
- /* If p gives its space to its next sibling, that sibling needs
- to have its top/left side pulled back to where p's is.
- set_window_{height,width} will re-position the sibling's
- children. */
- sib = p->next;
- XWINDOW (sib)->top_line = p->top_line;
- XWINDOW (sib)->left_col = p->left_col;
- }
+ struct window *w, *p, *c;
+ Lisp_Object parent, child;
+ int horflag;
- /* Stretch that sibling. */
- if (!NILP (par->vchild))
- set_window_height (sib,
- XFASTINT (XWINDOW (sib)->total_lines) + XFASTINT (p->total_lines),
- 1);
- if (!NILP (par->hchild))
- set_window_width (sib,
- XFASTINT (XWINDOW (sib)->total_cols) + XFASTINT (p->total_cols),
- 1);
-
- /* If parent now has only one child,
- put the child into the parent's place. */
- tem = par->hchild;
- if (NILP (tem))
- tem = par->vchild;
- if (NILP (XWINDOW (tem)->next)) {
- replace_window (parent, tem);
- par = XWINDOW (tem);
- }
+ w = XWINDOW (window);
+ parent = w->parent;
+ if (!NILP (parent) && NILP (w->nest))
+ {
+ p = XWINDOW (parent);
+ if (((!NILP (p->vchild) && !NILP (w->vchild))
+ || (!NILP (p->hchild) && !NILP (w->hchild))))
+ /* WINDOW and PARENT are both either a vertical or a horizontal
+ combination. */
+ {
+ horflag = NILP (w->vchild);
+ child = horflag ? w->hchild : w->vchild;
+ c = XWINDOW (child);
- /* Since we may be deleting combination windows, we must make sure that
- not only p but all its children have been marked as deleted. */
- if (! NILP (p->hchild))
- delete_all_subwindows (XWINDOW (p->hchild));
- else if (! NILP (p->vchild))
- delete_all_subwindows (XWINDOW (p->vchild));
+ /* Splice WINDOW's children into its parent's children and
+ assign new normal sizes. */
+ if (NILP (w->prev))
+ if (horflag)
+ p->hchild = child;
+ else
+ p->vchild = child;
+ else
+ {
+ c->prev = w->prev;
+ XWINDOW (w->prev)->next = child;
+ }
- /* Mark this window as deleted. */
- p->buffer = p->hchild = p->vchild = Qnil;
+ while (c)
+ {
+ c->parent = parent;
- if (! NILP (par->parent))
- par = XWINDOW (par->parent);
+ if (horflag)
+ c->normal_cols
+ = make_float (XFLOATINT (c->total_cols)
+ / XFLOATINT (p->total_cols));
+ else
+ c->normal_lines
+ = make_float (XFLOATINT (c->total_lines)
+ / XFLOATINT (p->total_lines));
- /* Check if we have a v/hchild with a v/hchild. In that case remove
- one of them. */
+ if (NILP (c->next))
+ {
+ if (!NILP (w->next))
+ {
+ c->next = w->next;
+ XWINDOW (c->next)->prev = child;
+ }
- if (! NILP (par->vchild) && ! NILP (XWINDOW (par->vchild)->vchild))
- {
- p = XWINDOW (par->vchild);
- par->vchild = p->vchild;
- tem = p->vchild;
- }
- else if (! NILP (par->hchild) && ! NILP (XWINDOW (par->hchild)->hchild))
- {
- p = XWINDOW (par->hchild);
- par->hchild = p->hchild;
- tem = p->hchild;
- }
- else
- p = 0;
+ c = 0;
+ }
+ else
+ {
+ child = c->next;
+ c = XWINDOW (child);
+ }
+ }
- if (p)
- {
- while (! NILP (tem)) {
- XWINDOW (tem)->parent = p->parent;
- if (NILP (XWINDOW (tem)->next))
- break;
- tem = XWINDOW (tem)->next;
- }
- if (! NILP (tem)) {
- /* The next of the v/hchild we are removing is now the next of the
- last child for the v/hchild:
- Before v/hchild -> v/hchild -> next1 -> next2
- |
- -> next3
- After: v/hchild -> next1 -> next2 -> next3
- */
- XWINDOW (tem)->next = p->next;
- if (! NILP (p->next))
- XWINDOW (p->next)->prev = tem;
- }
- p->next = p->prev = p->vchild = p->hchild = p->buffer = Qnil;
+ /* WINDOW can be deleted now. */
+ w->vchild = w->hchild = Qnil;
+ }
}
-
-
- /* Adjust glyph matrices. */
- adjust_glyphs (f);
- UNBLOCK_INPUT;
}
-
+/* If WINDOW can be deleted, delete it. */
+static void
+delete_deletable_window (Lisp_Object window)
+{
+ if (!NILP (call1 (Qwindow_deletable_p, window)))
+ call1 (Qdelete_window, window);
+}
/***********************************************************************
Window List
@@ -1721,7 +1985,7 @@ delete_window (register Lisp_Object window)
/* Add window W to *USER_DATA. USER_DATA is actually a Lisp_Object
pointer. This is a callback function for foreach_window, used in
- function window_list. */
+ the window_list function. */
static int
add_window_to_list (struct window *w, void *user_data)
@@ -1952,35 +2216,32 @@ next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames, in
DEFUN ("next-window", Fnext_window, Snext_window, 0, 3, 0,
doc: /* Return window following WINDOW in cyclic ordering of windows.
-WINDOW defaults to the selected window. The optional arguments
-MINIBUF and ALL-FRAMES specify the set of windows to consider.
-
-MINIBUF t means consider the minibuffer window even if the
-minibuffer is not active. MINIBUF nil or omitted means consider
-the minibuffer window only if the minibuffer is active. Any
-other value means do not consider the minibuffer window even if
-the minibuffer is active.
-
-Several frames may share a single minibuffer; if the minibuffer
-is active, all windows on all frames that share that minibuffer
-are considered too. Therefore, if you are using a separate
-minibuffer frame and the minibuffer is active and MINIBUF says it
-counts, `next-window' considers the windows in the frame from
-which you entered the minibuffer, as well as the minibuffer
-window.
+WINDOW must be a live window and defaults to the selected one. The
+optional arguments MINIBUF and ALL-FRAMES specify the set of windows to
+consider.
+
+MINIBUF nil or omitted means consider the minibuffer window only if the
+minibuffer is active. MINIBUF t means consider the minibuffer window
+even if the minibuffer is not active. Any other value means do not
+consider the minibuffer window even if the minibuffer is active.
+
+ALL-FRAMES nil or omitted means consider all windows on WINDOW's frame,
+plus the minibuffer window if specified by the MINIBUF argument. If the
+minibuffer counts, consider all windows on all frames that share that
+minibuffer too. The following non-nil values of ALL-FRAMES have special
+meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames.
+
+- 0 (the number zero) means consider all windows on all visible and
+ iconified frames.
+
+- A frame means consider all windows on that frame only.
-ALL-FRAMES nil or omitted means consider all windows on WINDOW's
- frame, plus the minibuffer window if specified by the MINIBUF
- argument, see above. If the minibuffer counts, consider all
- windows on all frames that share that minibuffer too.
-ALL-FRAMES t means consider all windows on all existing frames.
-ALL-FRAMES `visible' means consider all windows on all visible
- frames on the current terminal.
-ALL-FRAMES 0 means consider all windows on all visible and
- iconified frames on the current terminal.
-ALL-FRAMES a frame means consider all windows on that frame only.
Anything else means consider all windows on WINDOW's frame and no
- others.
+others.
If you use consistent values for MINIBUF and ALL-FRAMES, you can use
`next-window' to iterate through the entire cycle of acceptable
@@ -1994,9 +2255,32 @@ windows, eventually ending up back at the window you started with.
DEFUN ("previous-window", Fprevious_window, Sprevious_window, 0, 3, 0,
doc: /* Return window preceding WINDOW in cyclic ordering of windows.
-WINDOW defaults to the selected window. The optional arguments
-MINIBUF and ALL-FRAMES specify the set of windows to consider.
-For the precise meaning of these arguments see `next-window'.
+WINDOW must be a live window and defaults to the selected one. The
+optional arguments MINIBUF and ALL-FRAMES specify the set of windows to
+consider.
+
+MINIBUF nil or omitted means consider the minibuffer window only if the
+minibuffer is active. MINIBUF t means consider the minibuffer window
+even if the minibuffer is not active. Any other value means do not
+consider the minibuffer window even if the minibuffer is active.
+
+ALL-FRAMES nil or omitted means consider all windows on WINDOW's frame,
+plus the minibuffer window if specified by the MINIBUF argument. If the
+minibuffer counts, consider all windows on all frames that share that
+minibuffer too. The following non-nil values of ALL-FRAMES have special
+meanings:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames.
+
+- 0 (the number zero) means consider all windows on all visible and
+ iconified frames.
+
+- A frame means consider all windows on that frame only.
+
+Anything else means consider all windows on WINDOW's frame and no
+others.
If you use consistent values for MINIBUF and ALL-FRAMES, you can
use `previous-window' to iterate through the entire cycle of
@@ -2009,34 +2293,32 @@ reverse order. */)
}
-DEFUN ("other-window", Fother_window, Sother_window, 1, 2, "p",
- doc: /* Select another window in cyclic ordering of windows.
-COUNT specifies the number of windows to skip, starting with the
-selected window, before making the selection. If COUNT is
-positive, skip COUNT windows forwards. If COUNT is negative,
-skip -COUNT windows backwards. COUNT zero means do not skip any
-window, so select the selected window. In an interactive call,
-COUNT is the numeric prefix argument. Return nil.
+/* Return a list of windows in cyclic ordering. Arguments are like
+ for `next-window'. */
-This function uses `next-window' for finding the window to select.
-The argument ALL-FRAMES has the same meaning as in `next-window',
-but the MINIBUF argument of `next-window' is always effectively
-nil. */)
- (Lisp_Object count, Lisp_Object all_frames)
+static Lisp_Object
+window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
{
- Lisp_Object window;
- int i;
+ Lisp_Object tail, list, rest;
- CHECK_NUMBER (count);
- window = selected_window;
+ decode_next_window_args (&window, &minibuf, &all_frames);
+ list = Qnil;
- for (i = XINT (count); i > 0; --i)
- window = Fnext_window (window, Qnil, all_frames);
- for (; i < 0; ++i)
- window = Fprevious_window (window, Qnil, all_frames);
+ for (tail = window_list (); CONSP (tail); tail = XCDR (tail))
+ if (candidate_window_p (XCAR (tail), window, minibuf, all_frames))
+ list = Fcons (XCAR (tail), list);
- Fselect_window (window, Qnil);
- return Qnil;
+ /* Rotate the list to start with WINDOW. */
+ list = Fnreverse (list);
+ rest = Fmemq (window, list);
+ if (!NILP (rest) && !EQ (rest, list))
+ {
+ for (tail = list; !EQ (XCDR (tail), rest); tail = XCDR (tail))
+ ;
+ XSETCDR (tail, Qnil);
+ list = nconc2 (rest, list);
+ }
+ return list;
}
@@ -2063,35 +2345,41 @@ MINIBUF neither nil nor t means never include the minibuffer window. */)
}
-/* Return a list of windows in cyclic ordering. Arguments are like
- for `next-window'. */
+DEFUN ("window-list-1", Fwindow_list_1, Swindow_list_1, 0, 3, 0,
+ doc: /* Return a list of all live windows.
+WINDOW specifies the first window to list and defaults to the selected
+window.
-static Lisp_Object
-window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
-{
- Lisp_Object tail, list, rest;
+Optional argument MINIBUF nil or omitted means consider the minibuffer
+window only if the minibuffer is active. MINIBUF t means consider the
+minibuffer window even if the minibuffer is not active. Any other value
+means do not consider the minibuffer window even if the minibuffer is
+active.
- decode_next_window_args (&window, &minibuf, &all_frames);
- list = Qnil;
+Optional argument ALL-FRAMES nil or omitted means consider all windows
+on WINDOW's frame, plus the minibuffer window if specified by the
+MINIBUF argument. If the minibuffer counts, consider all windows on all
+frames that share that minibuffer too. The following non-nil values of
+ALL-FRAMES have special meanings:
- for (tail = window_list (); CONSP (tail); tail = XCDR (tail))
- if (candidate_window_p (XCAR (tail), window, minibuf, all_frames))
- list = Fcons (XCAR (tail), list);
+- t means consider all windows on all existing frames.
- /* Rotate the list to start with WINDOW. */
- list = Fnreverse (list);
- rest = Fmemq (window, list);
- if (!NILP (rest) && !EQ (rest, list))
- {
- for (tail = list; !EQ (XCDR (tail), rest); tail = XCDR (tail))
- ;
- XSETCDR (tail, Qnil);
- list = nconc2 (rest, list);
- }
- return list;
-}
+- `visible' means consider all windows on all visible frames.
+
+- 0 (the number zero) means consider all windows on all visible and
+ iconified frames.
+- A frame means consider all windows on that frame only.
+
+Anything else means consider all windows on WINDOW's frame and no
+others.
+If WINDOW is not on the list of windows returned, some other window will
+be listed first but no error is signalled. */)
+ (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
+{
+ return window_list_1 (window, minibuf, all_frames);
+}
/* Look at all windows, performing an operation specified by TYPE
with argument OBJ.
@@ -2104,13 +2392,9 @@ window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
enum window_loop
{
WINDOW_LOOP_UNUSED,
- GET_BUFFER_WINDOW, /* Arg is buffer */
- GET_LRU_WINDOW, /* Arg is t for full-width windows only */
- DELETE_OTHER_WINDOWS, /* Arg is window not to delete */
- DELETE_BUFFER_WINDOWS, /* Arg is buffer */
- GET_LARGEST_WINDOW,
- UNSHOW_BUFFER, /* Arg is buffer */
- REDISPLAY_BUFFER_WINDOWS, /* Arg is buffer */
+ GET_BUFFER_WINDOW, /* Arg is buffer */
+ REPLACE_BUFFER_IN_WINDOWS_SAFELY, /* Arg is buffer */
+ REDISPLAY_BUFFER_WINDOWS, /* Arg is buffer */
CHECK_ALL_WINDOWS
};
@@ -2118,6 +2402,7 @@ static Lisp_Object
window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frames)
{
Lisp_Object window, windows, best_window, frame_arg;
+ int frame_best_window_flag = 0;
struct frame *f;
struct gcpro gcpro1;
@@ -2167,148 +2452,51 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame
is visible, since Fwindow_list skips non-visible frames if
that is desired, under the control of frame_arg. */
if (!MINI_WINDOW_P (w)
- /* For UNSHOW_BUFFER, we must always consider all windows. */
- || type == UNSHOW_BUFFER
+ /* For REPLACE_BUFFER_IN_WINDOWS_SAFELY, we must always
+ consider all windows. */
+ || type == REPLACE_BUFFER_IN_WINDOWS_SAFELY
|| (mini && minibuf_level > 0))
switch (type)
{
case GET_BUFFER_WINDOW:
if (EQ (w->buffer, obj)
- /* Don't find any minibuffer window
- except the one that is currently in use. */
- && (MINI_WINDOW_P (w)
- ? EQ (window, minibuf_window)
- : 1))
+ /* Don't find any minibuffer window except the one that
+ is currently in use. */
+ && (MINI_WINDOW_P (w) ? EQ (window, minibuf_window) : 1))
{
- if (NILP (best_window))
- best_window = window;
- else if (EQ (window, selected_window))
- /* Prefer to return selected-window. */
+ if (EQ (window, selected_window))
+ /* Preferably return the selected window. */
RETURN_UNGCPRO (window);
- else if (EQ (Fwindow_frame (window), selected_frame))
- /* Prefer windows on the current frame. */
- best_window = window;
- }
- break;
-
- case GET_LRU_WINDOW:
- /* `obj' is an integer encoding a bitvector.
- `obj & 1' means consider only full-width windows.
- `obj & 2' means consider also dedicated windows. */
- if (((XINT (obj) & 1) && !WINDOW_FULL_WIDTH_P (w))
- || (!(XINT (obj) & 2) && !NILP (w->dedicated))
- /* Minibuffer windows are always ignored. */
- || MINI_WINDOW_P (w))
- break;
- if (NILP (best_window)
- || (XFASTINT (XWINDOW (best_window)->use_time)
- > XFASTINT (w->use_time)))
- best_window = window;
- break;
-
- case DELETE_OTHER_WINDOWS:
- if (!EQ (window, obj))
- Fdelete_window (window);
- break;
-
- case DELETE_BUFFER_WINDOWS:
- if (EQ (w->buffer, obj))
- {
- struct frame *fr = XFRAME (WINDOW_FRAME (w));
-
- /* If this window is dedicated, and in a frame of its own,
- kill the frame. */
- if (EQ (window, FRAME_ROOT_WINDOW (fr))
- && !NILP (w->dedicated)
- && other_visible_frames (fr))
- {
- /* Skip the other windows on this frame.
- There might be one, the minibuffer! */
- while (CONSP (XCDR (windows))
- && EQ (XWINDOW (XCAR (windows))->frame,
- XWINDOW (XCAR (XCDR (windows)))->frame))
- windows = XCDR (windows);
-
- /* Now we can safely delete the frame. */
- delete_frame (w->frame, Qnil);
- }
- else if (NILP (w->parent))
+ else if (EQ (XWINDOW (window)->frame, selected_frame)
+ && !frame_best_window_flag)
+ /* Prefer windows on the current frame (but don't
+ choose another one if we have one already). */
{
- /* If we're deleting the buffer displayed in the
- only window on the frame, find a new buffer to
- display there. */
- Lisp_Object buffer;
- buffer = Fother_buffer (obj, Qnil, w->frame);
- /* Reset dedicated state of window. */
- w->dedicated = Qnil;
- Fset_window_buffer (window, buffer, Qnil);
- if (EQ (window, selected_window))
- Fset_buffer (w->buffer);
+ best_window = window;
+ frame_best_window_flag = 1;
}
- else
- Fdelete_window (window);
+ else if (NILP (best_window))
+ best_window = window;
}
break;
- case GET_LARGEST_WINDOW:
- { /* nil `obj' means to ignore dedicated windows. */
- /* Ignore dedicated windows and minibuffers. */
- if (MINI_WINDOW_P (w) || (NILP (obj) && !NILP (w->dedicated)))
- break;
-
- if (NILP (best_window))
- best_window = window;
- else
- {
- struct window *b = XWINDOW (best_window);
- if (XFASTINT (w->total_lines) * XFASTINT (w->total_cols)
- > XFASTINT (b->total_lines) * XFASTINT (b->total_cols))
- best_window = window;
- }
- }
- break;
-
- case UNSHOW_BUFFER:
+ case REPLACE_BUFFER_IN_WINDOWS_SAFELY:
+ /* We could simply check whether the buffer shown by window
+ is live, and show another buffer in case it isn't. */
if (EQ (w->buffer, obj))
{
- Lisp_Object buffer;
- struct frame *fr = XFRAME (w->frame);
-
- /* Find another buffer to show in this window. */
- buffer = Fother_buffer (obj, Qnil, w->frame);
-
- /* If this window is dedicated, and in a frame of its own,
- kill the frame. */
- if (EQ (window, FRAME_ROOT_WINDOW (fr))
- && !NILP (w->dedicated)
- && other_visible_frames (fr))
- {
- /* Skip the other windows on this frame.
- There might be one, the minibuffer! */
- while (CONSP (XCDR (windows))
- && EQ (XWINDOW (XCAR (windows))->frame,
- XWINDOW (XCAR (XCDR (windows)))->frame))
- windows = XCDR (windows);
-
- /* Now we can safely delete the frame. */
- delete_frame (w->frame, Qnil);
- }
- else if (!NILP (w->dedicated) && !NILP (w->parent))
- {
- Lisp_Object window_to_delete;
- XSETWINDOW (window_to_delete, w);
- /* If this window is dedicated and not the only window
- in its frame, then kill it. */
- Fdelete_window (window_to_delete);
- }
- else
- {
- /* Otherwise show a different buffer in the window. */
- w->dedicated = Qnil;
- Fset_window_buffer (window, buffer, Qnil);
- if (EQ (window, selected_window))
- Fset_buffer (w->buffer);
- }
+ /* Undedicate WINDOW. */
+ w->dedicated = Qnil;
+ /* Make WINDOW show the buffer returned by
+ other_buffer_safely, don't run any hooks. */
+ set_window_buffer
+ (window, other_buffer_safely (w->buffer), 0, 0);
+ /* If WINDOW is the selected window, make its buffer
+ current. But do so only if the window shows the
+ current buffer (Bug#6454). */
+ if (EQ (window, selected_window)
+ && XBUFFER (w->buffer) == current_buffer)
+ Fset_buffer (w->buffer);
}
break;
@@ -2348,70 +2536,25 @@ check_all_windows (void)
window_loop (CHECK_ALL_WINDOWS, Qnil, 1, Qt);
}
-DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0,
- doc: /* Return WINDOW's use time.
-WINDOW defaults to the selected window. 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;
-}
-
-DEFUN ("get-lru-window", Fget_lru_window, Sget_lru_window, 0, 2, 0,
- doc: /* Return the window least recently selected or used for display.
-\(LRU means Least Recently Used.)
-
-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.
-If optional argument FRAME is `visible', search all visible frames.
-If FRAME is 0, search all visible and iconified frames.
-If FRAME is t, search all frames.
-If FRAME is nil, search only the selected frame.
-If FRAME is a frame, search only that frame. */)
- (Lisp_Object frame, Lisp_Object dedicated)
-{
- register Lisp_Object w;
- /* First try for a window that is full-width */
- w = window_loop (GET_LRU_WINDOW,
- NILP (dedicated) ? make_number (1) : make_number (3),
- 0, frame);
- if (!NILP (w) && !EQ (w, selected_window))
- return w;
- /* If none of them, try the rest */
- return window_loop (GET_LRU_WINDOW,
- NILP (dedicated) ? make_number (0) : make_number (2),
- 0, frame);
-}
-
-DEFUN ("get-largest-window", Fget_largest_window, Sget_largest_window, 0, 2, 0,
- doc: /* Return the largest window in area.
-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.
-If optional argument FRAME is `visible', search all visible frames.
-If FRAME is 0, search all visible and iconified frames.
-If FRAME is t, search all frames.
-If FRAME is nil, search only the selected frame.
-If FRAME is a frame, search only that frame. */)
- (Lisp_Object frame, Lisp_Object dedicated)
-{
- return window_loop (GET_LARGEST_WINDOW, dedicated, 0,
- frame);
-}
-
DEFUN ("get-buffer-window", Fget_buffer_window, Sget_buffer_window, 0, 2, 0,
doc: /* Return a window currently displaying BUFFER-OR-NAME, or nil if none.
-BUFFER-OR-NAME may be a buffer or a buffer name and defaults to the
-current buffer.
-If optional argument FRAME is `visible', search all visible frames.
-If optional argument FRAME is 0, search all visible and iconified frames.
-If FRAME is t, search all frames.
-If FRAME is nil, search only the selected frame.
-If FRAME is a frame, search only that frame. */)
- (Lisp_Object buffer_or_name, Lisp_Object frame)
+BUFFER-OR-NAME may be a buffer or a buffer name and defaults to
+the current buffer.
+
+The optional argument ALL-FRAMES specifies the frames to consider:
+
+- t means consider all windows on all existing frames.
+
+- `visible' means consider all windows on all visible frames.
+
+- 0 (the number zero) means consider all windows on all visible
+ and iconified frames.
+
+- A frame means consider all windows on that frame only.
+
+Any other value of ALL-FRAMES means consider all windows on the
+selected frame and no others. */)
+ (Lisp_Object buffer_or_name, Lisp_Object all_frames)
{
Lisp_Object buffer;
@@ -2421,168 +2564,275 @@ If FRAME is a frame, search only that frame. */)
buffer = Fget_buffer (buffer_or_name);
if (BUFFERP (buffer))
- return window_loop (GET_BUFFER_WINDOW, buffer, 1, frame);
+ return window_loop (GET_BUFFER_WINDOW, buffer, 1, all_frames);
else
return Qnil;
}
-DEFUN ("delete-other-windows", Fdelete_other_windows, Sdelete_other_windows,
- 0, 1, "",
- doc: /* Make WINDOW (or the selected window) fill its frame.
-Only the frame WINDOW is on is affected.
-This function tries to reduce display jumps by keeping the text
+static Lisp_Object
+resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizontal, Lisp_Object ignore)
+{
+ return call4 (Qwindow_resize_root_window, window, delta, horizontal, ignore);
+}
+
+
+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.
+
+Optional argument ROOT, if non-nil, must specify an internal window
+containing WINDOW as a subwindow. If this is the case, replace ROOT by
+WINDOW and leave alone any windows not contained in ROOT.
+
+When WINDOW is live try to reduce display jumps by keeping the text
previously visible in WINDOW in the same place on the frame. Doing this
depends on the value of (window-start WINDOW), so if calling this
function in a program gives strange scrolling, make sure the
window-start value is reasonable when this function is called. */)
- (Lisp_Object window)
+ (Lisp_Object window, Lisp_Object root)
{
- struct window *w;
- EMACS_INT startpos;
- int top, new_top;
+ struct window *w, *r, *s;
+ struct frame *f;
+ Lisp_Object sibling, pwindow, swindow IF_LINT (= Qnil), delta;
+ EMACS_INT startpos IF_LINT (= 0);
+ int top IF_LINT (= 0), new_top, resize_failed;
- if (NILP (window))
- window = selected_window;
- else
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_any_window (window);
+ XSETWINDOW (window, w);
+ f = XFRAME (w->frame);
- startpos = marker_position (w->start);
- top = WINDOW_TOP_EDGE_LINE (w) - FRAME_TOP_MARGIN (XFRAME (WINDOW_FRAME (w)));
+ if (NILP (root))
+ /* ROOT is the frame's root window. */
+ {
+ root = FRAME_ROOT_WINDOW (f);
+ r = XWINDOW (root);
+ }
+ else
+ /* ROOT must be an ancestor of WINDOW. */
+ {
+ r = decode_any_window (root);
+ pwindow = XWINDOW (window)->parent;
+ while (!NILP (pwindow))
+ if (EQ (pwindow, root))
+ break;
+ else
+ pwindow = XWINDOW (pwindow)->parent;
+ if (!EQ (pwindow, root))
+ error ("Specified root is not an ancestor of specified window");
+ }
- if (MINI_WINDOW_P (w) && top > 0)
+ if (EQ (window, root))
+ /* A noop. */
+ return Qnil;
+ /* I don't understand the "top > 0" part below. If we deal with a
+ standalone minibuffer it would have been caught by the preceding
+ test. */
+ else if (MINI_WINDOW_P (w)) /* && top > 0) */
error ("Can't expand minibuffer to full frame");
- window_loop (DELETE_OTHER_WINDOWS, window, 0, WINDOW_FRAME (w));
-
- /* Try to minimize scrolling, by setting the window start to the point
- will cause the text at the old window start to be at the same place
- on the frame. But don't try to do this if the window start is
- outside the visible portion (as might happen when the display is
- not current, due to typeahead). */
- new_top = WINDOW_TOP_EDGE_LINE (w) - FRAME_TOP_MARGIN (XFRAME (WINDOW_FRAME (w)));
- if (new_top != top
- && startpos >= BUF_BEGV (XBUFFER (w->buffer))
- && startpos <= BUF_ZV (XBUFFER (w->buffer)))
+ if (!NILP (w->buffer))
{
- struct position pos;
- struct buffer *obuf = current_buffer;
+ startpos = marker_position (w->start);
+ top = WINDOW_TOP_EDGE_LINE (w)
+ - FRAME_TOP_MARGIN (XFRAME (WINDOW_FRAME (w)));
+ /* Make sure WINDOW is the frame's selected window. */
+ if (!EQ (window, FRAME_SELECTED_WINDOW (f)))
+ {
+ if (EQ (selected_frame, w->frame))
+ Fselect_window (window, Qnil);
+ else
+ FRAME_SELECTED_WINDOW (f) = window;
+ }
+ }
+ else
+ {
+ /* See if the frame's selected window is a subwindow of WINDOW, by
+ finding all the selected window's parents and comparing each
+ one with WINDOW. If it isn't we need a new selected window for
+ this frame. */
+ swindow = FRAME_SELECTED_WINDOW (f);
+ while (1)
+ {
+ pwindow = swindow;
+ while (!NILP (pwindow) && !EQ (window, pwindow))
+ pwindow = XWINDOW (pwindow)->parent;
- Fset_buffer (w->buffer);
- /* This computation used to temporarily move point, but that can
- have unwanted side effects due to text properties. */
- pos = *vmotion (startpos, -top, w);
+ if (EQ (window, pwindow))
+ /* If WINDOW is an ancestor of SWINDOW, then SWINDOW is ok
+ as the new selected window. */
+ break;
+ else
+ /* Else try the previous window of SWINDOW. */
+ swindow = Fprevious_window (swindow, Qlambda, Qnil);
+ }
- 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);
- /* We need to do this, so that the window-scroll-functions
- get called. */
- w->optional_new_start = Qt;
-
- set_buffer_internal (obuf);
+ if (!EQ (swindow, FRAME_SELECTED_WINDOW (f)))
+ {
+ if (EQ (selected_frame, w->frame))
+ Fselect_window (swindow, Qnil);
+ else
+ FRAME_SELECTED_WINDOW (f) = swindow;
+ }
}
- return Qnil;
-}
+ BLOCK_INPUT;
+ free_window_matrices (r);
-DEFUN ("delete-windows-on", Fdelete_windows_on, Sdelete_windows_on,
- 0, 2, "bDelete windows on (buffer): ",
- doc: /* Delete all windows showing BUFFER-OR-NAME.
-BUFFER-OR-NAME may be a buffer or the name of an existing buffer and
-defaults to the current buffer.
+ windows_or_buffers_changed++;
+ Vwindow_list = Qnil;
+ FRAME_WINDOW_SIZES_CHANGED (f) = 1;
+ resize_failed = 0;
-Optional second argument FRAME controls which frames are affected.
-If optional argument FRAME is `visible', search all visible frames.
-If FRAME is 0, search all visible and iconified frames.
-If FRAME is nil, search all frames.
-If FRAME is t, search only the selected frame.
-If FRAME is a frame, search only that frame.
-When a window showing BUFFER-OR-NAME is dedicated and the only window of
-its frame, that frame is deleted when there are other frames left. */)
- (Lisp_Object buffer_or_name, Lisp_Object frame)
-{
- Lisp_Object buffer;
+ if (NILP (w->buffer))
+ {
+ /* Resize subwindows vertically. */
+ XSETINT (delta, XINT (r->total_lines) - XINT (w->total_lines));
+ w->top_line = r->top_line;
+ resize_root_window (window, delta, Qnil, Qnil);
+ if (window_resize_check (w, 0))
+ window_resize_apply (w, 0);
+ else
+ {
+ resize_root_window (window, delta, Qnil, Qt);
+ if (window_resize_check (w, 0))
+ window_resize_apply (w, 0);
+ else
+ resize_failed = 1;
+ }
- /* FRAME uses t and nil to mean the opposite of what window_loop
- expects. */
- if (NILP (frame))
- frame = Qt;
- else if (EQ (frame, Qt))
- frame = Qnil;
+ /* Resize subwindows 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;
+ resize_root_window (window, delta, Qt, Qnil);
+ if (window_resize_check (w, 1))
+ window_resize_apply (w, 1);
+ else
+ {
+ resize_root_window (window, delta, Qt, Qt);
+ if (window_resize_check (w, 1))
+ window_resize_apply (w, 1);
+ else
+ resize_failed = 1;
+ }
+ }
- if (NILP (buffer_or_name))
- buffer = Fcurrent_buffer ();
+ if (resize_failed)
+ /* Play safe, if we still can ... */
+ {
+ window = swindow;
+ w = XWINDOW (window);
+ }
+ }
+
+ /* Cleanly unlink WINDOW from window-tree. */
+ if (!NILP (w->prev))
+ /* Get SIBLING above (on the left of) WINDOW. */
+ {
+ sibling = w->prev;
+ s = XWINDOW (sibling);
+ s->next = w->next;
+ if (!NILP (s->next))
+ XWINDOW (s->next)->prev = sibling;
+ }
else
+ /* Get SIBLING below (on the right of) WINDOW. */
{
- buffer = Fget_buffer (buffer_or_name);
- CHECK_BUFFER (buffer);
+ sibling = w->next;
+ s = XWINDOW (sibling);
+ s->prev = Qnil;
+ if (!NILP (XWINDOW (w->parent)->vchild))
+ XWINDOW (w->parent)->vchild = sibling;
+ else
+ XWINDOW (w->parent)->hchild = sibling;
}
- window_loop (DELETE_BUFFER_WINDOWS, buffer, 0, frame);
-
- return Qnil;
-}
+ /* Delete ROOT and all subwindows of ROOT. */
+ if (!NILP (r->vchild))
+ {
+ delete_all_subwindows (r->vchild);
+ r->vchild = Qnil;
+ }
+ else if (!NILP (r->hchild))
+ {
+ delete_all_subwindows (r->hchild);
+ r->hchild = Qnil;
+ }
-DEFUN ("replace-buffer-in-windows", Freplace_buffer_in_windows,
- Sreplace_buffer_in_windows,
- 0, 1, "bReplace buffer in windows: ",
- doc: /* Replace BUFFER-OR-NAME with some other buffer in all windows showing it.
-BUFFER-OR-NAME may be a buffer or the name of an existing buffer and
-defaults to the current buffer.
+ replace_window (root, window, 1);
-When a window showing BUFFER-OR-NAME is dedicated that window is
-deleted. If that window is the only window on its frame, that frame is
-deleted too when there are other frames left. If there are no other
-frames left, some other buffer is displayed in that window. */)
- (Lisp_Object buffer_or_name)
-{
- Lisp_Object buffer;
+ /* Reset WINDOW's splits status. */
+ w->splits = Qnil;
- if (NILP (buffer_or_name))
- buffer = Fcurrent_buffer ();
- else
+ /* This must become SWINDOW anyway ....... */
+ if (!NILP (w->buffer) && !resize_failed)
{
- buffer = Fget_buffer (buffer_or_name);
- CHECK_BUFFER (buffer);
+ /* Try to minimize scrolling, by setting the window start to the
+ point will cause the text at the old window start to be at the
+ same place on the frame. But don't try to do this if the
+ window start is outside the visible portion (as might happen
+ when the display is not current, due to typeahead). */
+ new_top = WINDOW_TOP_EDGE_LINE (w) - FRAME_TOP_MARGIN (XFRAME (WINDOW_FRAME (w)));
+ if (new_top != top
+ && startpos >= BUF_BEGV (XBUFFER (w->buffer))
+ && startpos <= BUF_ZV (XBUFFER (w->buffer)))
+ {
+ struct position pos;
+ struct buffer *obuf = current_buffer;
+
+ Fset_buffer (w->buffer);
+ /* This computation used to temporarily move point, but that
+ can have unwanted side effects due to text properties. */
+ 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);
+ /* We need to do this, so that the window-scroll-functions
+ get called. */
+ w->optional_new_start = Qt;
+
+ set_buffer_internal (obuf);
+ }
}
- window_loop (UNSHOW_BUFFER, buffer, 0, Qt);
+ adjust_glyphs (f);
+ UNBLOCK_INPUT;
+
+ run_window_configuration_change_hook (f);
return Qnil;
}
-/* Replace BUFFER with some other buffer in all windows
- of all frames, even those on other keyboards. */
void
-replace_buffer_in_all_windows (Lisp_Object buffer)
+replace_buffer_in_windows (Lisp_Object buffer)
{
- Lisp_Object tail, frame;
-
- /* A single call to window_loop won't do the job
- because it only considers frames on the current keyboard.
- So loop manually over frames, and handle each one. */
- FOR_EACH_FRAME (tail, frame)
- window_loop (UNSHOW_BUFFER, buffer, 1, frame);
+ call1 (Qreplace_buffer_in_windows, buffer);
}
-
-/* Set the height of WINDOW and all its inferiors. */
-
-/* The smallest acceptable dimensions for a window. Anything smaller
- might crash Emacs. */
-#define MIN_SAFE_WINDOW_WIDTH (2)
-#define MIN_SAFE_WINDOW_HEIGHT (1)
-/* For wp non-zero the total number of columns of window w. Otherwise
- the total number of lines of w. */
+/* Safely replace BUFFER with some other buffer in all windows of all
+ frames, even those on other keyboards. */
-#define WINDOW_TOTAL_SIZE(w, wp) \
- (wp ? WINDOW_TOTAL_COLS (w) : WINDOW_TOTAL_LINES (w))
+void
+replace_buffer_in_windows_safely (Lisp_Object buffer)
+{
+ Lisp_Object tail, frame;
+ /* A single call to window_loop won't do the job because it only
+ considers frames on the current keyboard. So loop manually over
+ frames, and handle each one. */
+ FOR_EACH_FRAME (tail, frame)
+ window_loop (REPLACE_BUFFER_IN_WINDOWS_SAFELY, buffer, 1, frame);
+}
+
/* If *ROWS or *COLS are too small a size for FRAME, set them to the
minimum allowable size. */
@@ -2606,243 +2856,6 @@ check_frame_size (FRAME_PTR frame, int *rows, int *cols)
*cols = MIN_SAFE_WINDOW_WIDTH;
}
-/* Value is non-zero if window W is fixed-size. WIDTH_P non-zero means
- check if W's width can be changed, otherwise check W's height.
- CHECK_SIBLINGS_P non-zero means check resizablity of WINDOW's
- siblings, too. If none of the siblings is resizable, WINDOW isn't
- either. */
-
-static int
-window_fixed_size_p (struct window *w, int width_p, int check_siblings_p)
-{
- int fixed_p;
- struct window *c;
-
- if (!NILP (w->hchild))
- {
- c = XWINDOW (w->hchild);
-
- if (width_p)
- {
- /* A horizontal combination is fixed-width if all of if its
- children are. */
- while (c && window_fixed_size_p (c, width_p, 0))
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- fixed_p = c == NULL;
- }
- else
- {
- /* A horizontal combination is fixed-height if one of if its
- children is. */
- while (c && !window_fixed_size_p (c, width_p, 0))
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- fixed_p = c != NULL;
- }
- }
- else if (!NILP (w->vchild))
- {
- c = XWINDOW (w->vchild);
-
- if (width_p)
- {
- /* A vertical combination is fixed-width if one of if its
- children is. */
- while (c && !window_fixed_size_p (c, width_p, 0))
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- fixed_p = c != NULL;
- }
- else
- {
- /* A vertical combination is fixed-height if all of if its
- children are. */
- while (c && window_fixed_size_p (c, width_p, 0))
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- fixed_p = c == NULL;
- }
- }
- else if (BUFFERP (w->buffer))
- {
- struct buffer *old = current_buffer;
- Lisp_Object val;
-
- current_buffer = XBUFFER (w->buffer);
- val = find_symbol_value (Qwindow_size_fixed);
- current_buffer = old;
-
- fixed_p = 0;
- if (!EQ (val, Qunbound))
- {
- fixed_p = !NILP (val);
-
- if (fixed_p
- && ((EQ (val, Qheight) && width_p)
- || (EQ (val, Qwidth) && !width_p)))
- fixed_p = 0;
- }
-
- /* Can't tell if this one is resizable without looking at
- siblings. If all siblings are fixed-size this one is too. */
- if (!fixed_p && check_siblings_p && WINDOWP (w->parent))
- {
- Lisp_Object child;
-
- for (child = w->prev; WINDOWP (child); child = XWINDOW (child)->prev)
- if (!window_fixed_size_p (XWINDOW (child), width_p, 0))
- break;
-
- if (NILP (child))
- for (child = w->next; WINDOWP (child); child = XWINDOW (child)->next)
- if (!window_fixed_size_p (XWINDOW (child), width_p, 0))
- break;
-
- if (NILP (child))
- fixed_p = 1;
- }
- }
- else
- fixed_p = 1;
-
- return fixed_p;
-}
-
-/* Return minimum size of leaf window W. WIDTH_P non-zero means return
- the minimum width of W, WIDTH_P zero means return the minimum height
- of W. SAFE_P non-zero means ignore window-min-height|width but just
- return values that won't crash Emacs and don't hide components like
- fringes, scrollbars, or modelines. If WIDTH_P is zero and W is the
- minibuffer window, always return 1. */
-
-static int
-window_min_size_2 (struct window *w, int width_p, int safe_p)
-{
- /* We should consider buffer-local values of window_min_height and
- window_min_width here. */
- if (width_p)
- {
- int safe_size = (MIN_SAFE_WINDOW_WIDTH
- + WINDOW_FRINGE_COLS (w)
- + WINDOW_SCROLL_BAR_COLS (w));
-
- return safe_p ? safe_size : max (window_min_width, safe_size);
- }
- else if (MINI_WINDOW_P (w))
- return 1;
- else
- {
- int safe_size = (MIN_SAFE_WINDOW_HEIGHT
- + ((BUFFERP (w->buffer)
- && !NILP (BVAR (XBUFFER (w->buffer), mode_line_format)))
- ? 1 : 0));
-
- return safe_p ? safe_size : max (window_min_height, safe_size);
- }
-}
-
-/* Return minimum size of window W, not taking fixed-width windows into
- account. WIDTH_P non-zero means return the minimum width, otherwise
- return the minimum height. SAFE_P non-zero means ignore
- window-min-height|width but just return values that won't crash Emacs
- and don't hide components like fringes, scrollbars, or modelines. If
- W is a combination window, compute the minimum size from the minimum
- sizes of W's children. */
-
-static int
-window_min_size_1 (struct window *w, int width_p, int safe_p)
-{
- struct window *c;
- int size;
-
- if (!NILP (w->hchild))
- {
- /* W is a horizontal combination. */
- c = XWINDOW (w->hchild);
- size = 0;
-
- if (width_p)
- {
- /* The minimum width of a horizontal combination is the sum of
- the minimum widths of its children. */
- while (c)
- {
- size += window_min_size_1 (c, 1, safe_p);
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- }
- }
- else
- {
- /* The minimum height of a horizontal combination is the
- maximum of the minimum heights of its children. */
- while (c)
- {
- size = max (window_min_size_1 (c, 0, safe_p), size);
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- }
- }
- }
- else if (!NILP (w->vchild))
- {
- /* W is a vertical combination. */
- c = XWINDOW (w->vchild);
- size = 0;
-
- if (width_p)
- {
- /* The minimum width of a vertical combination is the maximum
- of the minimum widths of its children. */
- while (c)
- {
- size = max (window_min_size_1 (c, 1, safe_p), size);
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- }
- }
- else
- {
- /* The minimum height of a vertical combination is the sum of
- the minimum height of its children. */
- while (c)
- {
- size += window_min_size_1 (c, 0, safe_p);
- c = WINDOWP (c->next) ? XWINDOW (c->next) : NULL;
- }
- }
- }
- else
- /* W is a leaf window. */
- size = window_min_size_2 (w, width_p, safe_p);
-
- return size;
-}
-
-/* Return the minimum size of window W, taking fixed-size windows into
- account. WIDTH_P non-zero means return the minimum width, otherwise
- return the minimum height. SAFE_P non-zero means ignore
- window-min-height|width but just return values that won't crash Emacs
- and don't hide components like fringes, scrollbars, or modelines.
- IGNORE_FIXED_P non-zero means ignore if W is fixed-size. Set *FIXED
- to 1 if W is fixed-size unless FIXED is null. */
-
-static int
-window_min_size (struct window *w, int width_p, int safe_p, int ignore_fixed_p, int *fixed)
-{
- int size, fixed_p;
-
- if (ignore_fixed_p)
- fixed_p = 0;
- else
- fixed_p = window_fixed_size_p (w, width_p, 1);
-
- if (fixed)
- *fixed = fixed_p;
-
- if (fixed_p)
- size = WINDOW_TOTAL_SIZE (w, width_p);
- else
- size = window_min_size_1 (w, width_p, safe_p);
-
- return size;
-}
-
-
/* Adjust the margins of window W if text area is too small.
Return 1 if window width is ok after adjustment; 0 if window
is still too narrow. */
@@ -2877,410 +2890,7 @@ adjust_window_margins (struct window *w)
w->left_margin_cols = make_number (margin_cols);
return 1;
}
-
-/* Calculate new sizes for windows in the list FORWARD when their
- compound size goes from TOTAL to SIZE. TOTAL must be greater than
- SIZE. The number of windows in FORWARD is NCHILDREN, and the number
- that can shrink is SHRINKABLE. Fixed-size windows may be shrunk if
- and only if RESIZE_FIXED_P is non-zero. WIDTH_P non-zero means
- shrink columns, otherwise shrink lines.
-
- SAFE_P zero means windows may be sized down to window-min-height
- lines (window-min-window columns for WIDTH_P non-zero). SAFE_P
- non-zero means windows may be sized down to their minimum safe sizes
- taking into account the space needed to display modelines, fringes,
- and scrollbars.
-
- This function returns an allocated array of new sizes that the caller
- must free. A size -1 means the window is fixed and RESIZE_FIXED_P is
- zero. A size zero means the window shall be deleted. Array index 0
- refers to the first window in FORWARD, 1 to the second, and so on.
-
- This function resizes windows proportionally to their size. It also
- tries to preserve smaller windows by resizing larger windows before
- resizing any window to zero. If resize_proportionally is non-nil for
- a specific window, it will attempt to strictly resize that window
- proportionally, even at the expense of deleting smaller windows. */
-static int *
-shrink_windows (int total, int size, int nchildren, int shrinkable,
- int resize_fixed_p, Lisp_Object forward, int width_p, int safe_p)
-{
- int available_resize = 0;
- int *new_sizes, *min_sizes;
- struct window *c;
- Lisp_Object child;
- int smallest = total;
- int total_removed = 0;
- int total_shrink = total - size;
- int i;
-
- new_sizes = xmalloc (sizeof (*new_sizes) * nchildren);
- min_sizes = xmalloc (sizeof (*min_sizes) * nchildren);
-
- for (i = 0, child = forward; !NILP (child); child = c->next, ++i)
- {
- int child_size;
-
- c = XWINDOW (child);
- child_size = WINDOW_TOTAL_SIZE (c, width_p);
-
- if (!resize_fixed_p && window_fixed_size_p (c, width_p, 0))
- new_sizes[i] = -1;
- else
- {
- new_sizes[i] = child_size;
- min_sizes[i] = window_min_size_1 (c, width_p, safe_p);
- if (child_size > min_sizes[i]
- && NILP (c->resize_proportionally))
- available_resize += child_size - min_sizes[i];
- }
- }
- /* We might need to shrink some windows to zero. Find the smallest
- windows and set them to 0 until we can fulfil the new size. */
-
- while (shrinkable > 1 && size + available_resize < total)
- {
- for (i = 0; i < nchildren; ++i)
- if (new_sizes[i] > 0 && smallest > new_sizes[i])
- smallest = new_sizes[i];
-
- for (i = 0; i < nchildren; ++i)
- if (new_sizes[i] == smallest)
- {
- /* Resize this window down to zero. */
- new_sizes[i] = 0;
- if (smallest > min_sizes[i])
- available_resize -= smallest - min_sizes[i];
- available_resize += smallest;
- --shrinkable;
- total_removed += smallest;
-
- /* We don't know what the smallest is now. */
- smallest = total;
-
- /* Out of for, just remove one window at the time and
- check again if we have enough space. */
- break;
- }
- }
-
- /* Now, calculate the new sizes. Try to shrink each window
- proportional to its size. */
- for (i = 0; i < nchildren; ++i)
- {
- if (new_sizes[i] > min_sizes[i])
- {
- int to_shrink = total_shrink * new_sizes[i] / total;
-
- if (new_sizes[i] - to_shrink < min_sizes[i])
- to_shrink = new_sizes[i] - min_sizes[i];
- new_sizes[i] -= to_shrink;
- total_removed += to_shrink;
- }
- }
-
- /* Any reminder due to rounding, we just subtract from windows
- that are left and still can be shrunk. */
- while (total_shrink > total_removed)
- {
- int nonzero_sizes = 0;
-
- for (i = 0; i < nchildren; ++i)
- if (new_sizes[i] > 0)
- ++nonzero_sizes;
-
- for (i = 0; i < nchildren; ++i)
- if (new_sizes[i] > min_sizes[i])
- {
- --new_sizes[i];
- ++total_removed;
-
- /* Out of for, just shrink one window at the time and
- check again if we have enough space. */
- break;
- }
-
- /* Special case, only one window left. */
- if (nonzero_sizes == 1)
- break;
- }
-
- /* Any surplus due to rounding, we add to windows that are left. */
- while (total_shrink < total_removed)
- {
- for (i = 0; i < nchildren; ++i)
- {
- if (new_sizes[i] != 0 && total_shrink < total_removed)
- {
- ++new_sizes[i];
- --total_removed;
- break;
- }
- }
- }
-
- xfree (min_sizes);
-
- return new_sizes;
-}
-
-/* Set WINDOW's height or width to SIZE. WIDTH_P non-zero means set
- WINDOW's width. Resize WINDOW's children, if any, so that they keep
- their proportionate size relative to WINDOW.
-
- If FIRST_ONLY is 1, change only the first of WINDOW's children when
- they are in series. If LAST_ONLY is 1, change only the last of
- WINDOW's children when they are in series.
-
- Propagate WINDOW's top or left edge position to children. Delete
- windows that become too small unless NODELETE_P is 1. When
- NODELETE_P equals 2 do not honor settings for window-min-height and
- window-min-width when resizing windows but use safe defaults instead.
- This should give better behavior when resizing frames. */
-
-static void
-size_window (Lisp_Object window, int size, int width_p, int nodelete_p, int first_only, int last_only)
-{
- struct window *w = XWINDOW (window);
- struct window *c;
- Lisp_Object child, *forward, *sideward;
- int old_size = WINDOW_TOTAL_SIZE (w, width_p);
-
- size = max (0, size);
-
- /* Delete WINDOW if it's too small. */
- if (nodelete_p != 1 && !NILP (w->parent)
- && size < window_min_size_1 (w, width_p, nodelete_p == 2))
- {
- delete_window (window);
- return;
- }
-
- /* Set redisplay hints. */
- w->last_modified = make_number (0);
- w->last_overlay_modified = make_number (0);
- windows_or_buffers_changed++;
- FRAME_WINDOW_SIZES_CHANGED (XFRAME (w->frame)) = 1;
-
- if (width_p)
- {
- sideward = &w->vchild;
- forward = &w->hchild;
- w->total_cols = make_number (size);
- adjust_window_margins (w);
- }
- else
- {
- sideward = &w->hchild;
- forward = &w->vchild;
- w->total_lines = make_number (size);
- w->orig_total_lines = Qnil;
- }
-
- if (!NILP (*sideward))
- {
- /* We have a chain of parallel siblings whose size should all change. */
- for (child = *sideward; !NILP (child); child = c->next)
- {
- c = XWINDOW (child);
- if (width_p)
- c->left_col = w->left_col;
- else
- c->top_line = w->top_line;
- size_window (child, size, width_p, nodelete_p,
- first_only, last_only);
- }
- }
- else if (!NILP (*forward) && last_only)
- {
- /* Change the last in a series of siblings. */
- Lisp_Object last_child;
- int child_size;
-
- for (child = *forward; !NILP (child); child = c->next)
- {
- c = XWINDOW (child);
- last_child = child;
- }
-
- child_size = WINDOW_TOTAL_SIZE (c, width_p);
- size_window (last_child, size - old_size + child_size,
- width_p, nodelete_p, first_only, last_only);
- }
- else if (!NILP (*forward) && first_only)
- {
- /* Change the first in a series of siblings. */
- int child_size;
-
- child = *forward;
- c = XWINDOW (child);
-
- if (width_p)
- c->left_col = w->left_col;
- else
- c->top_line = w->top_line;
-
- child_size = WINDOW_TOTAL_SIZE (c, width_p);
- size_window (child, size - old_size + child_size,
- width_p, nodelete_p, first_only, last_only);
- }
- else if (!NILP (*forward))
- {
- int fixed_size, each IF_LINT (= 0), extra IF_LINT (= 0), n;
- int resize_fixed_p, nfixed;
- int last_pos, first_pos, nchildren, total;
- int *new_sizes = NULL;
-
- /* Determine the fixed-size portion of this window, and the
- number of child windows. */
- fixed_size = nchildren = nfixed = total = 0;
- for (child = *forward; !NILP (child); child = c->next, ++nchildren)
- {
- int child_size;
-
- c = XWINDOW (child);
- child_size = WINDOW_TOTAL_SIZE (c, width_p);
- total += child_size;
-
- if (window_fixed_size_p (c, width_p, 0))
- {
- fixed_size += child_size;
- ++nfixed;
- }
- }
-
- /* If the new size is smaller than fixed_size, or if there
- aren't any resizable windows, allow resizing fixed-size
- windows. */
- resize_fixed_p = nfixed == nchildren || size < fixed_size;
-
- /* Compute how many lines/columns to add/remove to each child. The
- value of extra takes care of rounding errors. */
- n = resize_fixed_p ? nchildren : nchildren - nfixed;
- if (size < total && n > 1)
- new_sizes = shrink_windows (total, size, nchildren, n,
- resize_fixed_p, *forward, width_p,
- nodelete_p == 2);
- else
- {
- each = (size - total) / n;
- extra = (size - total) - n * each;
- }
-
- /* Compute new children heights and edge positions. */
- first_pos = width_p ? XINT (w->left_col) : XINT (w->top_line);
- last_pos = first_pos;
- for (n = 0, child = *forward; !NILP (child); child = c->next, ++n)
- {
- int new_child_size, old_child_size;
-
- c = XWINDOW (child);
- old_child_size = WINDOW_TOTAL_SIZE (c, width_p);
- new_child_size = old_child_size;
-
- /* The top or left edge position of this child equals the
- bottom or right edge of its predecessor. */
- if (width_p)
- c->left_col = make_number (last_pos);
- else
- c->top_line = make_number (last_pos);
-
- /* If this child can be resized, do it. */
- if (resize_fixed_p || !window_fixed_size_p (c, width_p, 0))
- {
- new_child_size =
- new_sizes ? new_sizes[n] : old_child_size + each + extra;
- extra = 0;
- }
-
- /* Set new size. Note that size_window also propagates
- edge positions to children, so it's not a no-op if we
- didn't change the child's size. */
- size_window (child, new_child_size, width_p, 1,
- first_only, last_only);
-
- /* Remember the bottom/right edge position of this child; it
- will be used to set the top/left edge of the next child. */
- last_pos += new_child_size;
- }
-
- xfree (new_sizes);
-
- /* We should have covered the parent exactly with child windows. */
- xassert (size == last_pos - first_pos);
-
- /* Now delete any children that became too small. */
- if (nodelete_p != 1)
- for (child = *forward; !NILP (child); child = c->next)
- {
- int child_size;
-
- c = XWINDOW (child);
- child_size = WINDOW_TOTAL_SIZE (c, width_p);
- size_window (child, child_size, width_p, nodelete_p,
- first_only, last_only);
- }
- }
-}
-
-/* Set WINDOW's height to HEIGHT, and recursively change the height of
- WINDOW's children. NODELETE zero means windows that have become
- smaller than window-min-height in the process may be deleted.
- NODELETE 1 means never delete windows that become too small in the
- process. (The caller should check later and do so if appropriate.)
- NODELETE 2 means delete only windows that have become too small to be
- displayed correctly. */
-
-void
-set_window_height (Lisp_Object window, int height, int nodelete)
-{
- size_window (window, height, 0, nodelete, 0, 0);
-}
-
-/* Set WINDOW's width to WIDTH, and recursively change the width of
- WINDOW's children. NODELETE zero means windows that have become
- smaller than window-min-width in the process may be deleted.
- NODELETE 1 means never delete windows that become too small in the
- process. (The caller should check later and do so if appropriate.)
- NODELETE 2 means delete only windows that have become too small to be
- displayed correctly. */
-
-void
-set_window_width (Lisp_Object window, int width, int nodelete)
-{
- size_window (window, width, 1, nodelete, 0, 0);
-}
-
-/* Change window heights in windows rooted in WINDOW by N lines. */
-
-void
-change_window_heights (Lisp_Object window, int n)
-{
- struct window *w = XWINDOW (window);
-
- XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
- XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
-
- if (INTEGERP (w->orig_top_line))
- XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
- if (INTEGERP (w->orig_total_lines))
- XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
-
- /* Handle just the top child in a vertical split. */
- if (!NILP (w->vchild))
- change_window_heights (w->vchild, n);
-
- /* Adjust all children in a horizontal split. */
- for (window = w->hchild; !NILP (window); window = w->next)
- {
- w = XWINDOW (window);
- change_window_heights (window, n);
- }
-}
-
-int window_select_count;
-
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);
@@ -3288,6 +2898,8 @@ 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
run_funs (Lisp_Object funs)
{
@@ -3296,8 +2908,19 @@ run_funs (Lisp_Object funs)
call0 (XCAR (funs));
}
-static Lisp_Object select_window_norecord (Lisp_Object window);
-static Lisp_Object select_frame_norecord (Lisp_Object frame);
+static Lisp_Object
+select_window_norecord (Lisp_Object window)
+{
+ return WINDOW_LIVE_P (window)
+ ? Fselect_window (window, Qt) : selected_window;
+}
+
+static Lisp_Object
+select_frame_norecord (Lisp_Object frame)
+{
+ return FRAME_LIVE_P (XFRAME (frame))
+ ? Fselect_frame (frame, Qt) : selected_frame;
+}
void
run_window_configuration_change_hook (struct frame *f)
@@ -3310,12 +2933,6 @@ run_window_configuration_change_hook (struct frame *f)
if (NILP (Vrun_hooks))
return;
- if (SELECTED_FRAME () != f)
- {
- record_unwind_protect (select_frame_norecord, Fselected_frame ());
- Fselect_frame (frame, Qt);
- }
-
/* Use the right buffer. Matters when running the local hooks. */
if (current_buffer != XBUFFER (Fwindow_buffer (Qnil)))
{
@@ -3323,6 +2940,12 @@ run_window_configuration_change_hook (struct frame *f)
Fset_buffer (Fwindow_buffer (Qnil));
}
+ if (SELECTED_FRAME () != f)
+ {
+ record_unwind_protect (select_frame_norecord, Fselected_frame ());
+ select_frame_norecord (frame);
+ }
+
/* Look for buffer-local values. */
{
Lisp_Object windows = Fwindow_list (frame, Qlambda, Qnil);
@@ -3333,12 +2956,12 @@ run_window_configuration_change_hook (struct frame *f)
if (!NILP (Flocal_variable_p (Qwindow_configuration_change_hook,
buffer)))
{
- int count1 = SPECPDL_INDEX ();
+ int 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,
buffer));
- unbind_to (count1, Qnil);
+ unbind_to (inner_count, Qnil);
}
}
}
@@ -3347,6 +2970,16 @@ run_window_configuration_change_hook (struct frame *f)
unbind_to (count, Qnil);
}
+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)
+{
+ CHECK_LIVE_FRAME (frame);
+ run_window_configuration_change_hook (XFRAME (frame));
+ return Qnil;
+}
+
/* Make WINDOW display BUFFER as its contents. RUN_HOOKS_P non-zero
means it's allowed to run hooks. See make_frame for a case where
it's not allowed. KEEP_MARGINS_P non-zero means that the current
@@ -3450,14 +3083,15 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
unbind_to (count, Qnil);
}
-
DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 3, 0,
doc: /* Make WINDOW display BUFFER-OR-NAME as its contents.
-WINDOW defaults to the selected window. 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 display margins, fringe widths, and
-scroll bar settings are preserved; the default is to reset these from
-the local settings for BUFFER-OR-NAME or the frame defaults. Return nil.
+WINDOW has to 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
+display margins, fringe widths, and scroll bar settings are preserved;
+the default is to reset these from the local settings for BUFFER-OR-NAME
+or the frame defaults. Return nil.
This function throws an error when WINDOW is strongly dedicated to its
buffer (that is `window-dedicated-p' returns t for WINDOW) and does not
@@ -3482,132 +3116,26 @@ This function runs `window-scroll-functions' before running
else if (!EQ (tem, Qt))
/* w->buffer is t when the window is first being set up. */
{
- if (EQ (tem, buffer))
- return Qnil;
- else if (EQ (w->dedicated, Qt))
- error ("Window is dedicated to `%s'", SDATA (BVAR (XBUFFER (tem), name)));
- else
- w->dedicated = Qnil;
+ if (!EQ (tem, buffer))
+ {
+ if (EQ (w->dedicated, Qt))
+ /* WINDOW is strongly dedicated to its buffer, signal an
+ error. */
+ error ("Window is dedicated to `%s'", SDATA (BVAR (XBUFFER (tem), name)));
+ else
+ /* WINDOW is weakly dedicated to its buffer, reset
+ dedicatedness. */
+ w->dedicated = Qnil;
+
+ call1 (Qrecord_window_buffer, window);
+ }
unshow_buffer (w);
}
set_window_buffer (window, buffer, 1, !NILP (keep_margins));
- return Qnil;
-}
-
-/* If select_window is called with inhibit_point_swap non-zero it will
- not store point of the old selected window's buffer back into that
- window's pointm slot. This is needed by Fset_window_configuration to
- avoid that the display routine is called with selected_window set to
- Qnil causing a subsequent crash. */
-
-static Lisp_Object
-select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
-{
- register struct window *w;
- register struct window *ow;
- struct frame *sf;
-
- CHECK_LIVE_WINDOW (window);
-
- w = XWINDOW (window);
- w->frozen_window_start_p = 0;
-
- if (NILP (norecord))
- {
- ++window_select_count;
- XSETFASTINT (w->use_time, window_select_count);
- record_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;
- /* 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
- frame is active. */
- Fselect_frame (WINDOW_FRAME (w), norecord);
- /* Fselect_frame called us back so we've done all the work already. */
- eassert (EQ (window, selected_window));
- return window;
- }
- else
- sf->selected_window = 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. */
- if (!inhibit_point_swap)
- {
- ow = XWINDOW (selected_window);
- if (! NILP (ow->buffer))
- set_marker_both (ow->pointm, ow->buffer,
- BUF_PT (XBUFFER (ow->buffer)),
- BUF_PT_BYTE (XBUFFER (ow->buffer)));
- }
-
- selected_window = window;
-
- Fset_buffer (w->buffer);
-
- BVAR (XBUFFER (w->buffer), last_selected_window) = window;
-
- /* Go to the point recorded in the window.
- This is important when the buffer is in more
- than one window. It also matters when
- 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);
- if (new_point < BEGV)
- SET_PT (BEGV);
- else if (new_point > ZV)
- SET_PT (ZV);
- else
- SET_PT (new_point);
- }
-
- windows_or_buffers_changed++;
- return window;
-}
-
-/* Note that selected_window can be nil when this is called from
- Fset_window_configuration. */
-
-DEFUN ("select-window", Fselect_window, Sselect_window, 1, 2, 0,
- doc: /* Select WINDOW. Most editing will apply to WINDOW's buffer.
-If WINDOW is not already selected, make WINDOW's buffer current
-and make WINDOW the frame's selected window. Return WINDOW.
-Optional second arg NORECORD non-nil means do not put this buffer
-at the front of the list of recently selected ones and do not
-make this window the most recently selected one.
-
-Note that the main editor command loop selects the buffer of the
-selected window before each command. */)
- (register Lisp_Object window, Lisp_Object norecord)
-{
- return select_window (window, norecord, 0);
-}
-
-static Lisp_Object
-select_window_norecord (Lisp_Object window)
-{
- return WINDOW_LIVE_P (window)
- ? Fselect_window (window, Qt) : selected_window;
-}
-
-static Lisp_Object
-select_frame_norecord (Lisp_Object frame)
-{
- return FRAME_LIVE_P (XFRAME (frame))
- ? Fselect_frame (frame, Qt) : selected_frame;
+ return Qnil;
}
static Lisp_Object
@@ -3680,7 +3208,10 @@ temp_output_buffer_show (register Lisp_Object buf)
call1 (Vtemp_buffer_show_function, buf);
else
{
- window = display_buffer (buf, Qnil, Qnil);
+ window = display_buffer (buf, Vtemp_buffer_show_specifiers, Qnil);
+ /* Reset Vtemp_buffer_show_specifiers immediately so it won't
+ affect subsequent calls. */
+ Vtemp_buffer_show_specifiers = Qnil;
if (!EQ (XWINDOW (window)->frame, selected_frame))
Fmake_frame_visible (WINDOW_FRAME (XWINDOW (window)));
@@ -3723,10 +3254,13 @@ DEFUN ("internal-temp-output-buffer-show",
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
+ horizontal child). */
static void
-make_dummy_parent (Lisp_Object window)
+make_parent_window (Lisp_Object window, int horflag)
{
- Lisp_Object new;
+ Lisp_Object parent;
register struct window *o, *p;
int i;
@@ -3734,892 +3268,891 @@ make_dummy_parent (Lisp_Object window)
p = allocate_window ();
for (i = 0; i < VECSIZE (struct window); ++i)
((struct Lisp_Vector *) p)->contents[i]
- = ((struct Lisp_Vector *)o)->contents[i];
- XSETWINDOW (new, p);
+ = ((struct Lisp_Vector *) o)->contents[i];
+ XSETWINDOW (parent, p);
++sequence_number;
XSETFASTINT (p->sequence_number, sequence_number);
- /* Put new into window structure in place of window */
- replace_window (window, new);
+ replace_window (window, parent, 1);
o->next = Qnil;
o->prev = Qnil;
- o->vchild = Qnil;
- o->hchild = Qnil;
- o->parent = new;
+ o->parent = parent;
+ p->hchild = horflag ? window : Qnil;
+ p->vchild = horflag ? Qnil : window;
p->start = Qnil;
p->pointm = Qnil;
p->buffer = Qnil;
+ p->splits = Qnil;
+ p->nest = Qnil;
+ p->window_parameters = Qnil;
}
-DEFUN ("split-window", Fsplit_window, Ssplit_window, 0, 3, "",
- doc: /* Split WINDOW, putting SIZE lines in the first of the pair.
-WINDOW defaults to selected one and SIZE to half its size.
-If optional third arg HORIZONTAL is non-nil, split side by side and put
-SIZE columns in the first of the pair. In that case, SIZE includes that
-window's scroll bar, or the divider column to its right.
-Interactively, all arguments are nil.
-Returns the newly created window (which is the lower or rightmost one).
-The upper or leftmost window is the original one, and remains selected
-if it was selected before.
-
-See Info node `(elisp)Splitting Windows' for more details and examples. */)
- (Lisp_Object window, Lisp_Object size, Lisp_Object horizontal)
+/* Make new window from scratch. */
+Lisp_Object
+make_window (void)
{
- register Lisp_Object new;
- register struct window *o, *p;
- FRAME_PTR fo;
- register int size_int;
-
- if (NILP (window))
- window = selected_window;
- else
- CHECK_LIVE_WINDOW (window);
-
- o = XWINDOW (window);
- fo = XFRAME (WINDOW_FRAME (o));
-
- if (NILP (size))
- {
- if (!NILP (horizontal))
- /* Calculate the size of the left-hand window, by dividing
- the usable space in columns by two.
- We round up, since the left-hand window may include
- a dividing line, while the right-hand may not. */
- size_int = (XFASTINT (o->total_cols) + 1) >> 1;
- else
- size_int = XFASTINT (o->total_lines) >> 1;
- }
- else
- {
- CHECK_NUMBER (size);
- size_int = XINT (size);
- }
-
- if (MINI_WINDOW_P (o))
- error ("Attempt to split minibuffer window");
- else if (window_fixed_size_p (o, !NILP (horizontal), 0))
- error ("Attempt to split fixed-size window");
-
- if (NILP (horizontal))
- {
- int window_safe_height = window_min_size_2 (o, 0, 0);
-
- if (size_int < window_safe_height)
- error ("Window height %d too small (after splitting)", size_int);
- if (size_int + window_safe_height > XFASTINT (o->total_lines))
- error ("Window height %d too small (after splitting)",
- (int) (XFASTINT (o->total_lines) - size_int));
- if (NILP (o->parent)
- || NILP (XWINDOW (o->parent)->vchild))
- {
- make_dummy_parent (window);
- new = o->parent;
- XWINDOW (new)->vchild = window;
- }
- }
- else
- {
- int window_safe_width = window_min_size_2 (o, 1, 0);
-
- if (size_int < window_safe_width)
- error ("Window width %d too small (after splitting)", size_int);
- if (size_int + window_safe_width > XFASTINT (o->total_cols))
- error ("Window width %d too small (after splitting)",
- (int) (XFASTINT (o->total_cols) - size_int));
- if (NILP (o->parent)
- || NILP (XWINDOW (o->parent)->hchild))
- {
- make_dummy_parent (window);
- new = o->parent;
- XWINDOW (new)->hchild = window;
- }
- }
-
- /* Now we know that window's parent is a vertical combination
- if we are dividing vertically, or a horizontal combination
- if we are making side-by-side windows */
-
- windows_or_buffers_changed++;
- FRAME_WINDOW_SIZES_CHANGED (fo) = 1;
- new = make_window ();
- p = XWINDOW (new);
-
- p->frame = o->frame;
- p->next = o->next;
- if (!NILP (p->next))
- XWINDOW (p->next)->prev = new;
- p->prev = window;
- o->next = new;
- p->parent = o->parent;
- p->buffer = Qt;
- p->window_end_valid = Qnil;
- memset (&p->last_cursor, 0, sizeof p->last_cursor);
-
- /* Duplicate special geometry settings. */
-
- p->left_margin_cols = o->left_margin_cols;
- p->right_margin_cols = o->right_margin_cols;
- p->left_fringe_width = o->left_fringe_width;
- p->right_fringe_width = o->right_fringe_width;
- p->fringes_outside_margins = o->fringes_outside_margins;
- p->scroll_bar_width = o->scroll_bar_width;
- p->vertical_scroll_bar_type = o->vertical_scroll_bar_type;
-
- /* Apportion the available frame space among the two new windows */
-
- if (!NILP (horizontal))
- {
- p->total_lines = o->total_lines;
- p->top_line = o->top_line;
- XSETFASTINT (p->total_cols, XFASTINT (o->total_cols) - size_int);
- XSETFASTINT (o->total_cols, size_int);
- XSETFASTINT (p->left_col, XFASTINT (o->left_col) + size_int);
- adjust_window_margins (p);
- adjust_window_margins (o);
- }
- else
- {
- p->left_col = o->left_col;
- p->total_cols = o->total_cols;
- XSETFASTINT (p->total_lines, XFASTINT (o->total_lines) - size_int);
- XSETFASTINT (o->total_lines, size_int);
- XSETFASTINT (p->top_line, XFASTINT (o->top_line) + size_int);
- }
-
- /* Adjust glyph matrices. */
- adjust_glyphs (fo);
+ Lisp_Object window;
+ register struct window *w;
- Fset_window_buffer (new, o->buffer, Qt);
- return new;
+ 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->splits = w->nest = w->window_parameters = Qnil;
+ w->prev_buffers = w->next_buffers = Qnil;
+ /* Initialize non-Lisp data. */
+ w->desired_matrix = w->current_matrix = 0;
+ 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->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;
+ /* Reset window_list. */
+ Vwindow_list = Qnil;
+ /* Return window. */
+ XSETWINDOW (window, w);
+ return window;
}
-DEFUN ("enlarge-window", Fenlarge_window, Senlarge_window, 1, 2, "p",
- doc: /* Make selected window SIZE 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 SIZE columns. If SIZE is negative, shrink the window by
--SIZE lines or columns. Return nil.
+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.
+Return SIZE.
-This function can delete windows if they get too small. The size of
-fixed size windows is not altered by this function. */)
- (Lisp_Object size, Lisp_Object horizontal)
+Optional argument ADD non-nil means add SIZE to the new total size of
+WINDOW and return the sum.
+
+Note: This function does not operate on any subwindows of WINDOW. */)
+ (Lisp_Object window, Lisp_Object size, Lisp_Object add)
{
- CHECK_NUMBER (size);
- enlarge_window (selected_window, XINT (size), !NILP (horizontal));
+ struct window *w = decode_any_window (window);
- run_window_configuration_change_hook (SELECTED_FRAME ());
+ CHECK_NUMBER (size);
+ if (NILP (add))
+ XSETINT (w->new_total, XINT (size));
+ else
+ XSETINT (w->new_total, XINT (w->new_total) + XINT (size));
- return Qnil;
+ return w->new_total;
}
-DEFUN ("shrink-window", Fshrink_window, Sshrink_window, 1, 2, "p",
- doc: /* Make selected window SIZE lines smaller.
-Interactively, if no argument is given, make the selected window one
-line smaller. If optional argument HORIZONTAL is non-nil, make the
-window narrower by SIZE columns. If SIZE is negative, enlarge selected
-window by -SIZE lines or columns. Return nil.
+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.
+Return SIZE.
-This function can delete windows if they get too small. The size of
-fixed size windows is not altered by this function. */)
- (Lisp_Object size, Lisp_Object horizontal)
+Note: This function does not operate on any subwindows of WINDOW. */)
+ (Lisp_Object window, Lisp_Object size)
{
- CHECK_NUMBER (size);
- enlarge_window (selected_window, -XINT (size), !NILP (horizontal));
-
- run_window_configuration_change_hook (SELECTED_FRAME ());
+ struct window *w = decode_any_window (window);
- return Qnil;
+ w->new_normal = size;
+ return w->new_normal;
}
-static int
-window_height (Lisp_Object window)
-{
- register struct window *p = XWINDOW (window);
- return WINDOW_TOTAL_LINES (p);
-}
+/* Return 1 if setting w->total_lines (w->total_cols if HORFLAG is
+ non-zero) to w->new_total would result in correct heights (widths)
+ for window W and recursively all subwindows of W.
+ Note: This function does not check any of `window-fixed-size-p',
+ `window-min-height' or `window-min-width'. It does check that window
+ sizes do not drop below one line (two columns). */
static int
-window_width (Lisp_Object window)
+window_resize_check (struct window *w, int horflag)
{
- register struct window *p = XWINDOW (window);
- return WINDOW_TOTAL_COLS (p);
-}
-
-
-#define CURBEG(w) \
- *(horiz_flag ? &(XWINDOW (w)->left_col) : &(XWINDOW (w)->top_line))
-
-#define CURSIZE(w) \
- *(horiz_flag ? &(XWINDOW (w)->total_cols) : &(XWINDOW (w)->total_lines))
-
-
-/* Enlarge WINDOW by DELTA. HORIZ_FLAG nonzero means enlarge it
- horizontally; zero means do it vertically.
-
- Siblings of the selected window are resized to fulfill the size
- request. If they become too small in the process, they may be
- deleted. */
+ struct window *c;
-static void
-enlarge_window (Lisp_Object window, int delta, int horiz_flag)
-{
- Lisp_Object parent, next, prev;
- struct window *p;
- Lisp_Object *sizep;
- int maximum;
- int (*sizefun) (Lisp_Object)
- = horiz_flag ? window_width : window_height;
- void (*setsizefun) (Lisp_Object, int, int)
- = (horiz_flag ? set_window_width : set_window_height);
-
- /* Give up if this window cannot be resized. */
- if (window_fixed_size_p (XWINDOW (window), horiz_flag, 1))
- error ("Window is not resizable");
-
- /* Find the parent of the selected window. */
- while (1)
+ if (!NILP (w->vchild))
+ /* W is a vertical combination. */
{
- p = XWINDOW (window);
- parent = p->parent;
-
- if (NILP (parent))
+ c = XWINDOW (w->vchild);
+ if (horflag)
+ /* All subwindows of W must have the same width as W. */
{
- if (horiz_flag)
- error ("No other window to side of this one");
- break;
+ while (c)
+ {
+ if ((XINT (c->new_total) != XINT (w->new_total))
+ || !window_resize_check (c, horflag))
+ return 0;
+ c = NILP (c->next) ? 0 : XWINDOW (c->next);
+ }
+ return 1;
+ }
+ else
+ /* The sum of the heights of the subwindows of W must equal W's
+ height. */
+ {
+ int sum_of_sizes = 0;
+ while (c)
+ {
+ if (!window_resize_check (c, horflag))
+ return 0;
+ sum_of_sizes = sum_of_sizes + XINT (c->new_total);
+ c = NILP (c->next) ? 0 : XWINDOW (c->next);
+ }
+ return (sum_of_sizes == XINT (w->new_total));
}
-
- if (horiz_flag
- ? !NILP (XWINDOW (parent)->hchild)
- : !NILP (XWINDOW (parent)->vchild))
- break;
-
- window = parent;
- }
-
- sizep = &CURSIZE (window);
-
- {
- register int maxdelta;
-
- /* Compute the maximum size increment this window can have. */
-
- maxdelta = (!NILP (parent) ? (*sizefun) (parent) - XINT (*sizep)
- /* This is a main window followed by a minibuffer. */
- : !NILP (p->next) ? ((*sizefun) (p->next)
- - window_min_size (XWINDOW (p->next),
- horiz_flag, 0, 0, 0))
- /* This is a minibuffer following a main window. */
- : !NILP (p->prev) ? ((*sizefun) (p->prev)
- - window_min_size (XWINDOW (p->prev),
- horiz_flag, 0, 0, 0))
- /* This is a frame with only one window, a minibuffer-only
- or a minibufferless frame. */
- : (delta = 0));
-
- if (delta > maxdelta)
- /* This case traps trying to make the minibuffer
- the full frame, or make the only window aside from the
- minibuffer the full frame. */
- delta = maxdelta;
- }
-
- if (XINT (*sizep) + delta < window_min_size (XWINDOW (window),
- horiz_flag, 0, 0, 0))
- {
- delete_window (window);
- return;
}
-
- if (delta == 0)
- return;
-
- /* Find the total we can get from other siblings without deleting them. */
- maximum = 0;
- for (next = p->next; WINDOWP (next); next = XWINDOW (next)->next)
- maximum += (*sizefun) (next) - window_min_size (XWINDOW (next),
- horiz_flag, 0, 0, 0);
- for (prev = p->prev; WINDOWP (prev); prev = XWINDOW (prev)->prev)
- maximum += (*sizefun) (prev) - window_min_size (XWINDOW (prev),
- horiz_flag, 0, 0, 0);
-
- /* If we can get it all from them without deleting them, do so. */
- if (delta <= maximum)
+ else if (!NILP (w->hchild))
+ /* W is a horizontal combination. */
{
- Lisp_Object first_unaffected;
- Lisp_Object first_affected;
- int fixed_p;
-
- next = p->next;
- prev = p->prev;
- first_affected = window;
- /* Look at one sibling at a time,
- moving away from this window in both directions alternately,
- and take as much as we can get without deleting that sibling. */
- while (delta != 0
- && (!NILP (next) || !NILP (prev)))
+ c = XWINDOW (w->hchild);
+ if (horflag)
+ /* The sum of the widths of the subwindows of W must equal W's
+ width. */
{
- if (! NILP (next))
+ int sum_of_sizes = 0;
+ while (c)
{
- int this_one = ((*sizefun) (next)
- - window_min_size (XWINDOW (next), horiz_flag,
- 0, 0, &fixed_p));
- if (!fixed_p)
- {
- if (this_one > delta)
- this_one = delta;
-
- (*setsizefun) (next, (*sizefun) (next) - this_one, 0);
- (*setsizefun) (window, XINT (*sizep) + this_one, 0);
-
- delta -= this_one;
- }
-
- next = XWINDOW (next)->next;
+ if (!window_resize_check (c, horflag))
+ return 0;
+ sum_of_sizes = sum_of_sizes + XINT (c->new_total);
+ c = NILP (c->next) ? 0 : XWINDOW (c->next);
}
-
- if (delta == 0)
- break;
-
- if (! NILP (prev))
+ return (sum_of_sizes == XINT (w->new_total));
+ }
+ else
+ /* All subwindows of W must have the same height as W. */
+ {
+ while (c)
{
- int this_one = ((*sizefun) (prev)
- - window_min_size (XWINDOW (prev), horiz_flag,
- 0, 0, &fixed_p));
- if (!fixed_p)
- {
- if (this_one > delta)
- this_one = delta;
-
- first_affected = prev;
-
- (*setsizefun) (prev, (*sizefun) (prev) - this_one, 0);
- (*setsizefun) (window, XINT (*sizep) + this_one, 0);
-
- delta -= this_one;
- }
-
- prev = XWINDOW (prev)->prev;
+ if ((XINT (c->new_total) != XINT (w->new_total))
+ || !window_resize_check (c, horflag))
+ return 0;
+ c = NILP (c->next) ? 0 : XWINDOW (c->next);
}
+ return 1;
}
+ }
+ else
+ /* A leaf window. Make sure it's not too small. The following
+ hardcodes the values of `window-safe-min-width' (2) and
+ `window-safe-min-height' (1) which are defined in window.el. */
+ return XINT (w->new_total) >= (horflag ? 2 : 1);
+}
- xassert (delta == 0);
+/* Set w->total_lines (w->total_cols if HORIZONTAL is non-zero) to
+ w->new_total for window W and recursively all subwindows of W. Also
+ calculate and assign the new vertical (horizontal) start positions of
+ each of these windows.
- /* Now recalculate the edge positions of all the windows affected,
- based on the new sizes. */
- first_unaffected = next;
- prev = first_affected;
- for (next = XWINDOW (prev)->next; ! EQ (next, first_unaffected);
- prev = next, next = XWINDOW (next)->next)
- {
- XSETINT (CURBEG (next), XINT (CURBEG (prev)) + (*sizefun) (prev));
- /* This does not change size of NEXT,
- but it propagates the new top edge to its children */
- (*setsizefun) (next, (*sizefun) (next), 0);
- }
+ This function does not perform any error checks. Make sure you have
+ run window_resize_check on W before applying this function. */
+static void
+window_resize_apply (struct window *w, int horflag)
+{
+ struct window *c;
+ int pos;
+
+ /* Note: Assigning new_normal requires that the new total size of the
+ parent window has been set *before*. */
+ if (horflag)
+ {
+ w->total_cols = w->new_total;
+ if (NUMBERP (w->new_normal))
+ w->normal_cols = w->new_normal;
+
+ pos = XINT (w->left_col);
}
else
{
- register int delta1;
- register int opht = (*sizefun) (parent);
+ w->total_lines = w->new_total;
+ if (NUMBERP (w->new_normal))
+ w->normal_lines = w->new_normal;
- if (opht <= XINT (*sizep) + delta)
- {
- /* If trying to grow this window to or beyond size of the parent,
- just delete all the sibling windows. */
- Lisp_Object start, tem;
-
- start = XWINDOW (parent)->vchild;
- if (NILP (start))
- start = XWINDOW (parent)->hchild;
-
- /* Delete any siblings that come after WINDOW. */
- tem = XWINDOW (window)->next;
- while (! NILP (tem))
- {
- Lisp_Object next1 = XWINDOW (tem)->next;
- delete_window (tem);
- tem = next1;
- }
+ pos = XINT (w->top_line);
+ }
- /* Delete any siblings that come after WINDOW.
- Note that if START is not WINDOW, then WINDOW still
- has siblings, so WINDOW has not yet replaced its parent. */
- tem = start;
- while (! EQ (tem, window))
- {
- Lisp_Object next1 = XWINDOW (tem)->next;
- delete_window (tem);
- tem = next1;
- }
+ if (!NILP (w->vchild))
+ /* W is a vertical combination. */
+ {
+ c = XWINDOW (w->vchild);
+ while (c)
+ {
+ if (horflag)
+ XSETFASTINT (c->left_col, pos);
+ else
+ XSETFASTINT (c->top_line, pos);
+ window_resize_apply (c, horflag);
+ if (!horflag)
+ pos = pos + XINT (c->total_lines);
+ c = NILP (c->next) ? 0 : XWINDOW (c->next);
}
- else
+ }
+ else if (!NILP (w->hchild))
+ /* W is a horizontal combination. */
+ {
+ c = XWINDOW (w->hchild);
+ while (c)
{
- /* Otherwise, make delta1 just right so that if we add
- delta1 lines to this window and to the parent, and then
- shrink the parent back to its original size, the new
- proportional size of this window will increase by delta.
-
- The function size_window will compute the new height h'
- of the window from delta1 as:
-
- e = delta1/n
- x = delta1 - delta1/n * n for the 1st resizable child
- h' = h + e + x
-
- where n is the number of children that can be resized.
- We can ignore x by choosing a delta1 that is a multiple of
- n. We want the height of this window to come out as
-
- h' = h + delta
-
- So, delta1 must be
-
- h + e = h + delta
- delta1/n = delta
- delta1 = n * delta.
-
- The number of children n equals the number of resizable
- children of this window + 1 because we know window itself
- is resizable (otherwise we would have signaled an error).
-
- This reasoning is not correct when other windows become too
- small and shrink_windows refuses to delete them. Below we
- use resize_proportionally to work around this problem. */
-
- struct window *w = XWINDOW (window);
- Lisp_Object s;
- int n = 1;
-
- for (s = w->next; WINDOWP (s); s = XWINDOW (s)->next)
- if (!window_fixed_size_p (XWINDOW (s), horiz_flag, 0))
- ++n;
- for (s = w->prev; WINDOWP (s); s = XWINDOW (s)->prev)
- if (!window_fixed_size_p (XWINDOW (s), horiz_flag, 0))
- ++n;
-
- delta1 = n * delta;
-
- /* Add delta1 lines or columns to this window, and to the parent,
- keeping things consistent while not affecting siblings. */
- XSETINT (CURSIZE (parent), opht + delta1);
- (*setsizefun) (window, XINT (*sizep) + delta1, 0);
-
- /* Squeeze out delta1 lines or columns from our parent,
- shrinking this window and siblings proportionately. This
- brings parent back to correct size. Delta1 was calculated
- so this makes this window the desired size, taking it all
- out of the siblings.
-
- Temporarily set resize_proportionally to Qt to assure that,
- if necessary, shrink_windows deletes smaller windows rather
- than shrink this window. */
- w->resize_proportionally = Qt;
- (*setsizefun) (parent, opht, 0);
- w->resize_proportionally = Qnil;
+ if (horflag)
+ XSETFASTINT (c->left_col, pos);
+ else
+ XSETFASTINT (c->top_line, pos);
+ window_resize_apply (c, horflag);
+ if (horflag)
+ pos = pos + XINT (c->total_cols);
+ c = NILP (c->next) ? 0 : XWINDOW (c->next);
}
}
- XSETFASTINT (p->last_modified, 0);
- XSETFASTINT (p->last_overlay_modified, 0);
-
- /* Adjust glyph matrices. */
- adjust_glyphs (XFRAME (WINDOW_FRAME (XWINDOW (window))));
+ /* Clear out some redisplay caches. */
+ XSETFASTINT (w->last_modified, 0);
+ XSETFASTINT (w->last_overlay_modified, 0);
}
-/* Adjust the size of WINDOW by DELTA, moving only its trailing edge.
- HORIZ_FLAG nonzero means adjust the width, moving the right edge.
- zero means adjust the height, moving the bottom edge.
+DEFUN ("window-resize-apply", Fwindow_resize_apply, Swindow_resize_apply, 1, 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.
- Following siblings of the selected window are resized to fulfill
- the size request. If they become too small in the process, they
- are not deleted; instead, we signal an error. */
+This function checks whether the requested values sum up to a valid
+window layout, recursively assigns the new sizes of all subwindows and
+calculates and assigns the new start positions of these windows.
-static void
-adjust_window_trailing_edge (Lisp_Object window, int delta, int horiz_flag)
+Note: This function does not check any of `window-fixed-size-p',
+`window-min-height' or `window-min-width'. All these checks have to
+be applied on the Elisp level. */)
+ (Lisp_Object frame, Lisp_Object horizontal)
{
- Lisp_Object parent, child;
- struct window *p;
- Lisp_Object old_config = Fcurrent_window_configuration (Qnil);
- int delcount = window_deletion_count;
+ struct frame *f;
+ struct window *r;
+ int horflag = !NILP (horizontal);
- CHECK_WINDOW (window);
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
- /* Give up if this window cannot be resized. */
- if (window_fixed_size_p (XWINDOW (window), horiz_flag, 1))
- error ("Window is not resizable");
+ f = XFRAME (frame);
+ r = XWINDOW (FRAME_ROOT_WINDOW (f));
- while (1)
- {
- Lisp_Object first_parallel = Qnil;
+ if (!window_resize_check (r, horflag)
+ || ! EQ (r->new_total, (horflag ? r->total_cols : r->total_lines)))
+ return Qnil;
- if (NILP (window))
- {
- /* This happens if WINDOW on the previous iteration was
- at top level of the window tree. */
- Fset_window_configuration (old_config);
- error ("Specified window edge is fixed");
- }
+ BLOCK_INPUT;
+ window_resize_apply (r, horflag);
- p = XWINDOW (window);
- parent = p->parent;
+ windows_or_buffers_changed++;
+ FRAME_WINDOW_SIZES_CHANGED (f) = 1;
- /* See if this level has windows in parallel in the specified
- direction. If so, set FIRST_PARALLEL to the first one. */
- if (horiz_flag)
- {
- if (! NILP (parent) && !NILP (XWINDOW (parent)->vchild))
- first_parallel = XWINDOW (parent)->vchild;
- else if (NILP (parent) && !NILP (p->next))
- {
- /* Handle the vertical chain of main window and minibuffer
- which has no parent. */
- first_parallel = window;
- while (! NILP (XWINDOW (first_parallel)->prev))
- first_parallel = XWINDOW (first_parallel)->prev;
- }
- }
- else
- {
- if (! NILP (parent) && !NILP (XWINDOW (parent)->hchild))
- first_parallel = XWINDOW (parent)->hchild;
- }
+ adjust_glyphs (f);
+ UNBLOCK_INPUT;
- /* If this level's succession is in the desired dimension,
- and this window is the last one, and there is no higher level,
- its trailing edge is fixed. */
- if (NILP (XWINDOW (window)->next) && NILP (first_parallel)
- && NILP (parent))
- {
- Fset_window_configuration (old_config);
- error ("Specified window edge is fixed");
- }
+ run_window_configuration_change_hook (f);
- /* Don't make this window too small. */
- if (XINT (CURSIZE (window)) + delta
- < window_min_size_2 (XWINDOW (window), horiz_flag, 0))
- {
- Fset_window_configuration (old_config);
- error ("Cannot adjust window size as specified");
- }
+ return Qt;
+}
- /* Clear out some redisplay caches. */
- XSETFASTINT (p->last_modified, 0);
- XSETFASTINT (p->last_overlay_modified, 0);
- /* Adjust this window's edge. */
- XSETINT (CURSIZE (window),
- XINT (CURSIZE (window)) + delta);
+/* Resize frame F's windows when number of lines of F is set to SIZE.
+ HORFLAG 1 means resize windows when number of columns of F is set to
+ SIZE.
- /* If this window has following siblings in the desired dimension,
- make them smaller, and exit the loop.
+ This function can delete all windows but the selected one in order to
+ satisfy the request. The result will be meaningful if and only if
+ F's windows have meaningful sizes when you call this. */
+void
+resize_frame_windows (struct frame *f, int size, int horflag)
+{
+ Lisp_Object root = f->root_window;
+ struct window *r = XWINDOW (root);
+ Lisp_Object mini = f->minibuffer_window;
+ struct window *m;
+ /* new_size is the new size of the frame's root window. */
+ int new_size = (horflag
+ ? size
+ : (size
+ - FRAME_TOP_MARGIN (f)
+ - ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
+ ? 1 : 0)));
+
+ XSETFASTINT (r->top_line, 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);
+ else
+ XSETFASTINT (r->total_lines, 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);
+ Lisp_Object delta;
- (If we reach the top of the tree and can never do this,
- we will fail and report an error, above.) */
- if (NILP (first_parallel))
+ 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))
+ window_resize_apply (r, horflag);
+ else
{
- if (!NILP (p->next))
+ /* Try with "reasonable" minimum sizes next. */
+ resize_root_window (root, delta, horflag ? Qt : Qnil, Qt);
+ if (window_resize_check (r, horflag)
+ && new_size == XINT (r->new_total))
+ window_resize_apply (r, horflag);
+ else
{
- /* This may happen for the minibuffer. In that case
- the window_deletion_count check below does not work. */
- if (XINT (CURSIZE (p->next)) - delta <= 0)
- {
- Fset_window_configuration (old_config);
- error ("Cannot adjust window size as specified");
- }
-
- XSETINT (CURBEG (p->next),
- XINT (CURBEG (p->next)) + delta);
- size_window (p->next, XINT (CURSIZE (p->next)) - delta,
- horiz_flag, 0, 1, 0);
- break;
+ /* Finally, try with "safe" minimum sizes. */
+ resize_root_window (root, delta, horflag ? Qt : Qnil, Qsafe);
+ if (window_resize_check (r, horflag)
+ && new_size == XINT (r->new_total))
+ window_resize_apply (r, horflag);
+ else
+ {
+ /* We lost. Delete all windows but the frame's
+ selected one. */
+ root = f->selected_window;
+ Fdelete_other_windows_internal (root, Qnil);
+ if (horflag)
+ XSETFASTINT (XWINDOW (root)->total_cols, new_size);
+ else
+ XSETFASTINT (XWINDOW (root)->total_lines, new_size);
+ }
}
}
- else
- /* Here we have a chain of parallel siblings, in the other dimension.
- Change the size of the other siblings. */
- for (child = first_parallel;
- ! NILP (child);
- child = XWINDOW (child)->next)
- if (! EQ (child, window))
- size_window (child, XINT (CURSIZE (child)) + delta,
- horiz_flag, 0, 0, 1);
-
- window = parent;
}
- /* If we made a window so small it got deleted,
- we failed. Report failure. */
- if (delcount != window_deletion_count)
+ if (FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
{
- Fset_window_configuration (old_config);
- error ("Cannot adjust window size as specified");
+ m = XWINDOW (mini);
+ if (horflag)
+ XSETFASTINT (m->total_cols, 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));
+ }
}
-
- /* Adjust glyph matrices. */
- adjust_glyphs (XFRAME (WINDOW_FRAME (XWINDOW (window))));
}
-#undef CURBEG
-#undef CURSIZE
-
-DEFUN ("adjust-window-trailing-edge", Fadjust_window_trailing_edge,
- Sadjust_window_trailing_edge, 3, 3, 0,
- doc: /* Adjust the bottom or right edge of WINDOW by DELTA.
-If HORIZONTAL is non-nil, that means adjust the width, moving the right edge.
-Otherwise, adjust the height, moving the bottom edge.
-Following siblings of the selected window are resized to fulfill
-the size request. If they become too small in the process, they
-are not deleted; instead, we signal an error. */)
- (Lisp_Object window, Lisp_Object delta, Lisp_Object horizontal)
-{
- CHECK_NUMBER (delta);
- if (NILP (window))
- window = selected_window;
- adjust_window_trailing_edge (window, XINT (delta), !NILP (horizontal));
+DEFUN ("split-window-internal", Fsplit_window_internal, Ssplit_window_internal, 4, 4, 0,
+ doc: /* Split window OLD.
+Second argument TOTAL-SIZE specifies the number of lines or columns of the
+new window. In any case TOTAL-SIZE must be a positive integer.
- run_window_configuration_change_hook
- (XFRAME (WINDOW_FRAME (XWINDOW (window))));
+Third argument SIDE nil (or `below') specifies that the new window shall
+be located below WINDOW. SIDE `above' means the new window shall be
+located above WINDOW. In both cases TOTAL-SIZE specifies the number of
+lines of the new window including space reserved for the mode and/or
+header line.
- return Qnil;
-}
+SIDE t (or `right') specifies that the new window shall be located on
+the right side of WINDOW. SIDE `left' means the new window shall be
+located on the left of WINDOW. In both cases TOTAL-SIZE specifies the
+number of columns of the new window including space reserved for fringes
+and the scrollbar or a divider column.
+Fourth argument NORMAL-SIZE specifies the normal size of the new window
+according to the SIDE argument.
-
-/***********************************************************************
- Resizing Mini-Windows
- ***********************************************************************/
-
-static void shrink_window_lowest_first (struct window *, int);
-
-enum save_restore_action
+The new total and normal sizes of all involved windows must have been
+set correctly. See the code of `split-window' for how this is done. */)
+ (Lisp_Object old, Lisp_Object total_size, Lisp_Object side, Lisp_Object normal_size)
{
- CHECK_ORIG_SIZES,
- SAVE_ORIG_SIZES,
- RESTORE_ORIG_SIZES
-};
-
-static int save_restore_orig_size (struct window *,
- enum save_restore_action);
-
-/* Shrink windows rooted in window W to HEIGHT. Take the space needed
- from lowest windows first. */
+ /* OLD (*o) is the window we have to split. (*p) is either OLD's
+ parent window or an internal window we have to install as OLD's new
+ parent. REFERENCE (*r) must denote a live window, or is set to OLD
+ provided OLD is a leaf window, or to the frame's selected window.
+ NEW (*n) is the new window created with some parameters taken from
+ REFERENCE (*r). */
+ register Lisp_Object new, frame, reference;
+ register struct window *o, *p, *n, *r;
+ struct frame *f;
+ int horflag
+ /* HORFLAG is 1 when we split side-by-side, 0 otherwise. */
+ = EQ (side, Qt) || EQ (side, Qleft) || EQ (side, Qright);
+ int do_nest = 0;
+
+ CHECK_WINDOW (old);
+ o = XWINDOW (old);
+ frame = WINDOW_FRAME (o);
+ f = XFRAME (frame);
-static void
-shrink_window_lowest_first (struct window *w, int height)
-{
- struct window *c;
- Lisp_Object child;
- int old_height;
+ CHECK_NUMBER (total_size);
+
+ /* Set do_nest to 1 if we have to make a new parent window. We do
+ that if either `window-nest' is non-nil, or OLD has no parent, or
+ OLD is ortho-combined. */
+ do_nest =
+ !NILP (Vwindow_nest)
+ || NILP (o->parent)
+ || NILP (horflag
+ ? (XWINDOW (o->parent)->hchild)
+ : (XWINDOW (o->parent)->vchild));
+
+ /* We need a live reference window to initialize some parameters. */
+ if (WINDOW_LIVE_P (old))
+ /* OLD is live, use it as reference window. */
+ reference = old;
+ else
+ /* Use the frame's selected window as reference window. */
+ reference = FRAME_SELECTED_WINDOW (f);
+ r = XWINDOW (reference);
- xassert (!MINI_WINDOW_P (w));
+ /* The following bugs are caught by `split-window'. */
+ if (MINI_WINDOW_P (o))
+ error ("Attempt to split minibuffer window");
+ else if (XINT (total_size) < (horflag ? 2 : 1))
+ error ("Size of new window too small (after split)");
+ else if (!do_nest && !NILP (Vwindow_splits))
+ /* `window-splits' non-nil means try to resize OLD's siblings
+ proportionally. */
+ {
+ 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));
+ 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;
+ }
+ else
+ {
+ if (!window_resize_check (o, horflag))
+ error ("Resizing old window failed");
+ else if (XINT (total_size) + XINT (o->new_total)
+ != XINT (horflag ? o->total_cols : o->total_lines))
+ error ("Sum of sizes of old and new window don't fit");
+ }
+
+ /* This is our point of no return. */
+ if (do_nest)
+ {
+ /* 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;
+
+ make_parent_window (old, horflag);
+ p = XWINDOW (o->parent);
+ /* Store value of `window-nest' in new parent's nest slot. */
+ p->nest = Vwindow_nest;
+ /* Have PARENT inherit splits slot value from OLD. */
+ p->splits = o->splits;
+ /* Store value of `window-splits' in OLD's splits slot. */
+ o->splits = Vwindow_splits;
+ /* These get applied below. */
+ p->new_total = horflag ? o->total_cols : o->total_lines;
+ p->new_normal = new_normal;
+ }
+ else
+ p = XWINDOW (o->parent);
- /* Set redisplay hints. */
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
windows_or_buffers_changed++;
- FRAME_WINDOW_SIZES_CHANGED (XFRAME (WINDOW_FRAME (w))) = 1;
-
- old_height = XFASTINT (w->total_lines);
- XSETFASTINT (w->total_lines, height);
+ FRAME_WINDOW_SIZES_CHANGED (f) = 1;
+ new = make_window ();
+ n = XWINDOW (new);
+ n->frame = frame;
+ n->parent = o->parent;
+ n->vchild = n->hchild = Qnil;
- if (!NILP (w->hchild))
+ if (EQ (side, Qabove) || EQ (side, Qleft))
{
- for (child = w->hchild; !NILP (child); child = c->next)
- {
- c = XWINDOW (child);
- c->top_line = w->top_line;
- shrink_window_lowest_first (c, height);
- }
+ n->prev = o->prev;
+ if (NILP (n->prev))
+ if (horflag)
+ p->hchild = new;
+ else
+ p->vchild = new;
+ else
+ XWINDOW (n->prev)->next = new;
+ n->next = old;
+ o->prev = new;
}
- else if (!NILP (w->vchild))
+ else
{
- Lisp_Object last_child;
- int delta = old_height - height;
- int last_top;
+ n->next = o->next;
+ if (!NILP (n->next))
+ XWINDOW (n->next)->prev = new;
+ n->prev = old;
+ o->next = new;
+ }
- last_child = Qnil;
+ n->buffer = Qt;
+ n->window_end_valid = Qnil;
+ memset (&n->last_cursor, 0, sizeof n->last_cursor);
- /* Find the last child. We are taking space from lowest windows
- first, so we iterate over children from the last child
- backwards. */
- for (child = w->vchild; WINDOWP (child); child = XWINDOW (child)->next)
- last_child = child;
+ /* 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;
+ 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;
- /* Size children down to their safe heights. */
- for (child = last_child; delta && !NILP (child); child = c->prev)
- {
- int this_one;
+ /* Store `window-splits' in NEW's splits slot. */
+ n->splits = Vwindow_splits;
- c = XWINDOW (child);
- this_one = XFASTINT (c->total_lines) - window_min_size_1 (c, 0, 1);
+ /* Directly assign orthogonal coordinates and sizes. */
+ if (horflag)
+ {
+ n->top_line = o->top_line;
+ n->total_lines = o->total_lines;
+ }
+ else
+ {
+ n->left_col = o->left_col;
+ n->total_cols = o->total_cols;
+ }
- if (this_one > delta)
- this_one = delta;
+ /* Iso-coordinates and sizes are assigned by window_resize_apply,
+ get them ready here. */
+ n->new_total = total_size;
+ n->new_normal = normal_size;
- shrink_window_lowest_first (c, XFASTINT (c->total_lines) - this_one);
- delta -= this_one;
- }
+ 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;
- /* Compute new positions. */
- last_top = XINT (w->top_line);
- for (child = w->vchild; !NILP (child); child = c->next)
- {
- c = XWINDOW (child);
- c->top_line = make_number (last_top);
- shrink_window_lowest_first (c, XFASTINT (c->total_lines));
- last_top += XFASTINT (c->total_lines);
- }
- }
+ /* Maybe we should run the scroll functions in Elisp (which already
+ runs the configuration change hook). */
+ if (! NILP (Vwindow_scroll_functions))
+ run_hook_with_args_2 (Qwindow_scroll_functions, new,
+ Fmarker_position (n->start));
+ /* Return NEW. */
+ return new;
}
-/* Save, restore, or check positions and sizes in the window tree
- rooted at W. ACTION says what to do.
+DEFUN ("delete-window-internal", Fdelete_window_internal, Sdelete_window_internal, 1, 1, 0,
+ doc: /* Remove WINDOW from its frame.
+WINDOW defaults to the selected window. Return nil. Signal an error
+when WINDOW is the only window on its frame. */)
+ (register Lisp_Object window)
+{
+ register Lisp_Object parent, sibling, frame, root;
+ struct window *w, *p, *s, *r;
+ struct frame *f;
+ int horflag;
+ int before_sibling = 0;
- If ACTION is CHECK_ORIG_SIZES, check if orig_top_line and
- orig_total_lines members are valid for all windows in the window
- tree. Value is non-zero if they are valid.
+ w = decode_any_window (window);
+ XSETWINDOW (window, w);
+ if (NILP (w->buffer) && NILP (w->hchild) && NILP (w->vchild))
+ /* It's a no-op to delete an already deleted window. */
+ return Qnil;
+
+ parent = w->parent;
+ if (NILP (parent))
+ /* Never delete a minibuffer or frame root window. */
+ error ("Attempt to delete minibuffer or sole ordinary window");
+ else if (NILP (w->prev) && NILP (w->next))
+ /* Rather bow out here, this case should be handled on the Elisp
+ level. */
+ error ("Attempt to delete sole window of parent");
- If ACTION is SAVE_ORIG_SIZES, save members top and height in
- orig_top_line and orig_total_lines for all windows in the tree.
+ p = XWINDOW (parent);
+ horflag = NILP (p->vchild);
- If ACTION is RESTORE_ORIG_SIZES, restore top and height from values
- stored in orig_top_line and orig_total_lines for all windows. */
+ frame = WINDOW_FRAME (w);
+ f = XFRAME (frame);
-static int
-save_restore_orig_size (struct window *w, enum save_restore_action action)
-{
- int success_p = 1;
+ root = FRAME_ROOT_WINDOW (f);
+ r = XWINDOW (root);
+
+ /* Unlink WINDOW from window tree. */
+ if (NILP (w->prev))
+ /* Get SIBLING below (on the right of) WINDOW. */
+ {
+ /* before_sibling 1 means WINDOW is the first child of its
+ parent and thus before the sibling. */
+ before_sibling = 1;
+ sibling = w->next;
+ s = XWINDOW (sibling);
+ s->prev = Qnil;
+ if (horflag)
+ p->hchild = sibling;
+ else
+ p->vchild = sibling;
+ }
+ else
+ /* Get SIBLING above (on the left of) WINDOW. */
+ {
+ sibling = w->prev;
+ s = XWINDOW (sibling);
+ s->next = w->next;
+ if (!NILP (s->next))
+ XWINDOW (s->next)->prev = sibling;
+ }
- while (w)
+ if (window_resize_check (r, horflag)
+ && EQ (r->new_total, (horflag ? r->total_cols : r->total_lines)))
+ /* We can delete WINDOW now. */
{
- if (!NILP (w->hchild))
+ /* Block input. */
+ BLOCK_INPUT;
+ window_resize_apply (p, horflag);
+
+ windows_or_buffers_changed++;
+ Vwindow_list = Qnil;
+ FRAME_WINDOW_SIZES_CHANGED (f) = 1;
+
+ w->next = Qnil; /* Don't delete w->next too. */
+ free_window_matrices (w);
+
+ if (!NILP (w->vchild))
{
- if (!save_restore_orig_size (XWINDOW (w->hchild), action))
- success_p = 0;
+ delete_all_subwindows (w->vchild);
+ w->vchild = Qnil;
}
- else if (!NILP (w->vchild))
+ else if (!NILP (w->hchild))
+ {
+ delete_all_subwindows (w->hchild);
+ w->hchild = Qnil;
+ }
+ else if (!NILP (w->buffer))
{
- if (!save_restore_orig_size (XWINDOW (w->vchild), action))
- success_p = 0;
+ unshow_buffer (w);
+ unchain_marker (XMARKER (w->pointm));
+ unchain_marker (XMARKER (w->start));
+ w->buffer = Qnil;
}
- switch (action)
+ if (NILP (s->prev) && NILP (s->next))
+ /* A matrjoshka where SIBLING has become the only child of
+ PARENT. */
{
- case CHECK_ORIG_SIZES:
- if (!INTEGERP (w->orig_top_line) || !INTEGERP (w->orig_total_lines))
- return 0;
- break;
+ /* Put SIBLING into PARENT's place. */
+ replace_window (parent, sibling, 0);
+ /* Have SIBLING inherit the following three slot values from
+ PARENT (the nest slot is not inherited). */
+ s->normal_cols = p->normal_cols;
+ s->normal_lines = p->normal_lines;
+ s->splits = p->splits;
+ /* Mark PARENT as deleted. */
+ p->vchild = p->hchild = Qnil;
+ /* Try to merge SIBLING into its new parent. */
+ recombine_windows (sibling);
+ }
- case SAVE_ORIG_SIZES:
- w->orig_top_line = w->top_line;
- w->orig_total_lines = w->total_lines;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
- break;
+ adjust_glyphs (f);
- case RESTORE_ORIG_SIZES:
- xassert (INTEGERP (w->orig_top_line) && INTEGERP (w->orig_total_lines));
- w->top_line = w->orig_top_line;
- w->total_lines = w->orig_total_lines;
- w->orig_total_lines = w->orig_top_line = Qnil;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
- break;
+ if (!WINDOW_LIVE_P (FRAME_SELECTED_WINDOW (f)))
+ /* We deleted the frame's selected window. */
+ {
+ /* Use the frame's first window as fallback ... */
+ Lisp_Object new_selected_window = Fframe_first_window (frame);
+ /* ... but preferably use its most recently used window. */
+ Lisp_Object mru_window;
+
+ /* `get-mru-window' might fail for some reason so play it safe
+ - promote the first window _without recording it_ first. */
+ if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
+ Fselect_window (new_selected_window, Qt);
+ else
+ FRAME_SELECTED_WINDOW (f) = new_selected_window;
+
+ UNBLOCK_INPUT;
- default:
- abort ();
+ /* Now look whether `get-mru-window' gets us something. */
+ mru_window = call1 (Qget_mru_window, frame);
+ if (WINDOW_LIVE_P (mru_window)
+ && EQ (XWINDOW (mru_window)->frame, frame))
+ new_selected_window = mru_window;
+
+ /* If all ended up well, we now promote the mru window. */
+ if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
+ Fselect_window (new_selected_window, Qnil);
+ else
+ FRAME_SELECTED_WINDOW (f) = new_selected_window;
}
+ else
+ UNBLOCK_INPUT;
- w = NILP (w->next) ? NULL : XWINDOW (w->next);
+ /* Must be run by the caller:
+ run_window_configuration_change_hook (f); */
+ }
+ else
+ /* We failed: Relink WINDOW into window tree. */
+ {
+ if (before_sibling)
+ {
+ s->prev = window;
+ if (horflag)
+ p->hchild = window;
+ else
+ p->vchild = window;
+ }
+ else
+ {
+ s->next = window;
+ if (!NILP (w->next))
+ XWINDOW (w->next)->prev = window;
+ }
+ error ("Deletion failed");
}
- return success_p;
+ return Qnil;
}
+
+/***********************************************************************
+ Resizing Mini-Windows
+ ***********************************************************************/
-
-/* Grow mini-window W by DELTA lines, DELTA >= 0, or as much as we can
- without deleting other windows. */
-
+/* Grow mini-window W by DELTA lines, DELTA >= 0, or as much as we
+ can. */
void
grow_mini_window (struct window *w, int delta)
{
struct frame *f = XFRAME (w->frame);
- struct window *root;
+ struct window *r;
+ Lisp_Object root, value;
xassert (MINI_WINDOW_P (w));
- /* Commenting out the following assertion goes against the stated interface
- of the function, but it currently does not seem to do anything useful.
- See discussion of this issue in the thread for bug#4534.
- xassert (delta >= 0); */
-
- /* Compute how much we can enlarge the mini-window without deleting
- other windows. */
- root = XWINDOW (FRAME_ROOT_WINDOW (f));
- if (delta > 0)
- {
- int min_height = window_min_size (root, 0, 0, 0, 0);
- if (XFASTINT (root->total_lines) - delta < min_height)
- /* Note that the root window may already be smaller than
- min_height. */
- delta = max (0, XFASTINT (root->total_lines) - min_height);
- }
+ xassert (delta >= 0);
- if (delta)
+ root = FRAME_ROOT_WINDOW (f);
+ r = XWINDOW (root);
+ value = call2 (Qwindow_resize_root_window_vertically,
+ root, make_number (- delta));
+ if (INTEGERP (value) && window_resize_check (r, 0))
{
- /* Save original window sizes and positions, if not already done. */
- if (!save_restore_orig_size (root, CHECK_ORIG_SIZES))
- save_restore_orig_size (root, SAVE_ORIG_SIZES);
-
- /* Shrink other windows. */
- shrink_window_lowest_first (root, XFASTINT (root->total_lines) - delta);
+ BLOCK_INPUT;
+ window_resize_apply (r, 0);
/* Grow the mini-window. */
- w->top_line = make_number (XFASTINT (root->top_line) + XFASTINT (root->total_lines));
- w->total_lines = make_number (XFASTINT (w->total_lines) + delta);
+ 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);
adjust_glyphs (f);
+ UNBLOCK_INPUT;
}
}
-/* Shrink mini-window W. If there is recorded info about window sizes
- before a call to grow_mini_window, restore recorded window sizes.
- Otherwise, if the mini-window is higher than 1 line, resize it to 1
- line. */
-
+/* Shrink mini-window W. */
void
shrink_mini_window (struct window *w)
{
struct frame *f = XFRAME (w->frame);
- struct window *root = XWINDOW (FRAME_ROOT_WINDOW (f));
+ struct window *r;
+ Lisp_Object root, value;
+ EMACS_INT size;
- if (save_restore_orig_size (root, CHECK_ORIG_SIZES))
- {
- save_restore_orig_size (root, RESTORE_ORIG_SIZES);
- adjust_glyphs (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = 1;
- windows_or_buffers_changed = 1;
- }
- else if (XFASTINT (w->total_lines) > 1)
+ xassert (MINI_WINDOW_P (w));
+
+ size = XINT (w->total_lines);
+ if (size > 1)
{
- /* Distribute the additional lines of the mini-window
- among the other windows. */
- Lisp_Object window;
- XSETWINDOW (window, w);
- enlarge_window (window, 1 - XFASTINT (w->total_lines), 0);
+ root = FRAME_ROOT_WINDOW (f);
+ r = XWINDOW (root);
+ value = call2 (Qwindow_resize_root_window_vertically,
+ root, make_number (size - 1));
+ if (INTEGERP (value) && window_resize_check (r, 0))
+ {
+ 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);
+
+ XSETFASTINT (w->last_modified, 0);
+ XSETFASTINT (w->last_overlay_modified, 0);
+
+ adjust_glyphs (f);
+ 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
+ shrinking the frame (and probably when making the initial
+ *scratch* window). For the moment leave things as they are. */
}
}
+DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini_window_internal, 1, 1, 0,
+ doc: /* Resize minibuffer window WINDOW. */)
+ (Lisp_Object window)
+{
+ struct window *w = XWINDOW (window);
+ struct window *r;
+ struct frame *f;
+ int height;
+
+ CHECK_WINDOW (window);
+ f = XFRAME (w->frame);
+
+ if (!EQ (FRAME_MINIBUF_WINDOW (XFRAME (w->frame)), window))
+ error ("Not a valid minibuffer window");
+ else if (FRAME_MINIBUF_ONLY_P (f))
+ error ("Cannot resize a minibuffer-only frame");
+
+ r = XWINDOW (FRAME_ROOT_WINDOW (f));
+ height = XINT (r->total_lines) + XINT (w->total_lines);
+ if (window_resize_check (r, 0)
+ && XINT (w->new_total) > 0
+ && height == XINT (r->new_total) + XINT (w->new_total))
+ {
+ 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));
+
+ windows_or_buffers_changed++;
+ FRAME_WINDOW_SIZES_CHANGED (f) = 1;
+ adjust_glyphs (f);
+ UNBLOCK_INPUT;
+ run_window_configuration_change_hook (f);
+ return Qt;
+ }
+ else error ("Failed to resize minibuffer window");
+}
/* Mark window cursors off for all windows in the window tree rooted
at W by setting their phys_cursor_on_p flag to zero. Called from
@@ -4666,37 +4199,6 @@ window_internal_height (struct window *w)
return ht;
}
-
-
-/* Return the number of columns in W.
- Don't count columns occupied by scroll bars or the vertical bar
- separating W from the sibling to its right. */
-
-int
-window_box_text_cols (struct window *w)
-{
- struct frame *f = XFRAME (WINDOW_FRAME (w));
- int width = XINT (w->total_cols);
-
- if (WINDOW_HAS_VERTICAL_SCROLL_BAR (w))
- /* Scroll bars occupy a few columns. */
- width -= WINDOW_CONFIG_SCROLL_BAR_COLS (w);
- else if (!FRAME_WINDOW_P (f)
- && !WINDOW_RIGHTMOST_P (w) && !WINDOW_FULL_WIDTH_P (w))
- /* The column of `|' characters separating side-by-side windows
- occupies one column only. */
- width -= 1;
-
- if (FRAME_WINDOW_P (f))
- /* On window-systems, fringes and display margins cannot be
- used for normal text. */
- width -= (WINDOW_FRINGE_COLS (w)
- + WINDOW_LEFT_MARGIN_COLS (w)
- + WINDOW_RIGHT_MARGIN_COLS (w));
-
- return width;
-}
-
/************************************************************************
Window Scrolling
@@ -5418,7 +4920,7 @@ by this function. This happens in an interactive call. */)
struct window *w = XWINDOW (selected_window);
if (NILP (arg))
- XSETFASTINT (arg, window_box_text_cols (w) - 2);
+ XSETFASTINT (arg, window_body_cols (w) - 2);
else
arg = Fprefix_numeric_value (arg);
@@ -5447,7 +4949,7 @@ by this function. This happens in an interactive call. */)
struct window *w = XWINDOW (selected_window);
if (NILP (arg))
- XSETFASTINT (arg, window_box_text_cols (w) - 2);
+ XSETFASTINT (arg, window_body_cols (w) - 2);
else
arg = Fprefix_numeric_value (arg);
@@ -5732,7 +5234,6 @@ and redisplay normally--don't erase and redraw the frame. */)
return Qnil;
}
-
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.
@@ -5852,18 +5353,18 @@ struct save_window_data
struct saved_window
{
struct vectorlike_header header;
- Lisp_Object window;
- Lisp_Object buffer, start, pointm, mark;
+
+ Lisp_Object window, buffer, start, pointm, mark;
Lisp_Object left_col, top_line, total_cols, total_lines;
+ Lisp_Object normal_cols, normal_lines;
Lisp_Object hscroll, min_hscroll;
Lisp_Object parent, prev;
Lisp_Object start_at_line_beg;
Lisp_Object display_table;
- Lisp_Object orig_top_line, orig_total_lines;
Lisp_Object left_margin_cols, right_margin_cols;
Lisp_Object left_fringe_width, right_fringe_width, fringes_outside_margins;
- Lisp_Object scroll_bar_width, vertical_scroll_bar_type;
- Lisp_Object dedicated, resize_proportionally;
+ Lisp_Object scroll_bar_width, vertical_scroll_bar_type, dedicated;
+ Lisp_Object splits, nest, window_parameters;
};
#define SAVED_WINDOW_N(swv,n) \
@@ -5904,6 +5405,7 @@ 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;
@@ -5959,6 +5461,8 @@ the return value is nil. Otherwise the value is t. */)
However, there is other stuff we should still try to do below. */
if (FRAME_LIVE_P (f))
{
+ Lisp_Object window;
+ Lisp_Object dead_windows = Qnil;
register struct window *w;
register struct saved_window *p;
struct window *root_window;
@@ -6030,12 +5534,13 @@ the return value is nil. Otherwise the value is t. */)
Save their current buffers in their height fields, since we may
need it later, if a buffer saved in the configuration is now
dead. */
- delete_all_subwindows (XWINDOW (FRAME_ROOT_WINDOW (f)));
+ delete_all_subwindows (FRAME_ROOT_WINDOW (f));
for (k = 0; k < saved_windows->header.size; k++)
{
p = SAVED_WINDOW_N (saved_windows, k);
- w = XWINDOW (p->window);
+ window = p->window;
+ w = XWINDOW (window);
w->next = Qnil;
if (!NILP (p->parent))
@@ -6076,11 +5581,11 @@ the return value is nil. Otherwise the value is t. */)
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->orig_top_line = p->orig_top_line;
- w->orig_total_lines = p->orig_total_lines;
w->left_margin_cols = p->left_margin_cols;
w->right_margin_cols = p->right_margin_cols;
w->left_fringe_width = p->left_fringe_width;
@@ -6089,61 +5594,78 @@ the return value is nil. Otherwise the value is t. */)
w->scroll_bar_width = p->scroll_bar_width;
w->vertical_scroll_bar_type = p->vertical_scroll_bar_type;
w->dedicated = p->dedicated;
- w->resize_proportionally = p->resize_proportionally;
+ w->splits = p->splits;
+ w->nest = p->nest;
+ w->window_parameters = p->window_parameters;
XSETFASTINT (w->last_modified, 0);
XSETFASTINT (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)))
+ /* If saved buffer is alive, install it. */
+ {
+ w->buffer = p->buffer;
+ w->start_at_line_beg = p->start_at_line_beg;
+ set_marker_restricted (w->start, p->start, w->buffer);
+ set_marker_restricted (w->pointm, p->pointm, w->buffer);
+ Fset_marker (BVAR (XBUFFER (w->buffer), mark),
+ p->mark, w->buffer);
+
+ /* As documented in Fcurrent_window_configuration, don't
+ restore the location of point in the buffer which was
+ current when the window configuration was recorded. */
+ 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
+ /* Window has no live buffer, get one. */
{
- if (!NILP (BVAR (XBUFFER (p->buffer), name)))
- /* If saved buffer is alive, install it. */
- {
- w->buffer = p->buffer;
- w->start_at_line_beg = p->start_at_line_beg;
- set_marker_restricted (w->start, p->start, w->buffer);
- set_marker_restricted (w->pointm, p->pointm, w->buffer);
- Fset_marker (BVAR (XBUFFER (w->buffer), mark),
- p->mark, w->buffer);
-
- /* As documented in Fcurrent_window_configuration, don't
- restore the location of point in the buffer which was
- current when the window configuration was recorded. */
- 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)))
- /* Else unless window has a live buffer, get one. */
- {
- w->buffer = Fcdr (Fcar (Vbuffer_alist));
- /* 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;
- }
- else
- /* Keeping 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;
- }
+ /* Get the buffer via other_buffer_safely in order to
+ 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 ());
+ /* 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;
+ 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;
}
}
FRAME_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))
@@ -6151,10 +5673,10 @@ the return value is nil. Otherwise the value is t. */)
make_number (old_point),
XWINDOW (data->current_window)->buffer);
- /* In the following call to `select-window, prevent "swapping
- out point" in the old selected window using the buffer that
- has been restored into it. We already swapped out that point
- from that window's old buffer. */
+ /* In the following call to `select-window', prevent "swapping out
+ point" in the old selected window using the buffer that has
+ been restored into it. We already swapped out that point from
+ that window's old buffer. */
select_window (data->current_window, Qnil, 1);
BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window)
= selected_window;
@@ -6195,9 +5717,16 @@ the return value is nil. Otherwise the value is t. */)
}
adjust_glyphs (f);
-
UNBLOCK_INPUT;
+ /* Scan dead buffer windows. */
+ for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
+ {
+ window = XCAR (dead_windows);
+ if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f)))
+ delete_deletable_window (window);
+ }
+
/* Fselect_window will have made f the selected frame, so we
reselect the proper frame here. Fhandle_switch_frame will change the
selected window too, but that doesn't make the call to
@@ -6218,31 +5747,39 @@ the return value is nil. Otherwise the value is t. */)
return (FRAME_LIVE_P (f) ? Qt : Qnil);
}
-/* Mark all windows now on frame as deleted
- by setting their buffers to nil. */
+/* Delete all subwindows reachable via the next, vchild, and hchild
+ slots of WINDOW. */
void
-delete_all_subwindows (register struct window *w)
+delete_all_subwindows (Lisp_Object window)
{
+ register struct window *w;
+
+ w = XWINDOW (window);
+
if (!NILP (w->next))
- delete_all_subwindows (XWINDOW (w->next));
- if (!NILP (w->vchild))
- delete_all_subwindows (XWINDOW (w->vchild));
- if (!NILP (w->hchild))
- delete_all_subwindows (XWINDOW (w->hchild));
+ /* Delete WINDOW's siblings (we traverse postorderly). */
+ delete_all_subwindows (w->next);
w->total_lines = w->buffer; /* See Fset_window_configuration for excuse. */
- if (!NILP (w->buffer))
- unshow_buffer (w);
-
- /* We set all three of these fields to nil, to make sure that we can
- distinguish this dead window from any live window. Live leaf
- windows will have buffer set, and combination windows will have
- vchild or hchild set. */
- w->buffer = Qnil;
- w->vchild = Qnil;
- w->hchild = Qnil;
+ if (!NILP (w->vchild))
+ {
+ delete_all_subwindows (w->vchild);
+ w->vchild = Qnil;
+ }
+ else if (!NILP (w->hchild))
+ {
+ delete_all_subwindows (w->hchild);
+ w->hchild = Qnil;
+ }
+ else if (!NILP (w->buffer))
+ {
+ unshow_buffer (w);
+ unchain_marker (XMARKER (w->pointm));
+ unchain_marker (XMARKER (w->start));
+ w->buffer = Qnil;
+ }
Vwindow_list = Qnil;
}
@@ -6263,7 +5800,6 @@ count_windows (register struct window *window)
/* Fill vector FLAT with leaf windows under W, starting at index I.
Value is last index + 1. */
-
static int
get_leaf_windows (struct window *w, struct window **flat, int i)
{
@@ -6286,7 +5822,6 @@ get_leaf_windows (struct window *w, struct window **flat, int i)
/* Return a pointer to the glyph W's physical cursor is on. Value is
null if W's current matrix is invalid, so that no meaningfull glyph
can be returned. */
-
struct glyph *
get_phys_cursor_glyph (struct window *w)
{
@@ -6325,11 +5860,11 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i)
p->top_line = w->top_line;
p->total_cols = w->total_cols;
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;
p->display_table = w->display_table;
- p->orig_top_line = w->orig_top_line;
- p->orig_total_lines = w->orig_total_lines;
p->left_margin_cols = w->left_margin_cols;
p->right_margin_cols = w->right_margin_cols;
p->left_fringe_width = w->left_fringe_width;
@@ -6338,7 +5873,9 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i)
p->scroll_bar_width = w->scroll_bar_width;
p->vertical_scroll_bar_type = w->vertical_scroll_bar_type;
p->dedicated = w->dedicated;
- p->resize_proportionally = w->resize_proportionally;
+ p->splits = w->splits;
+ p->nest = w->nest;
+ p->window_parameters = w->window_parameters;
if (!NILP (w->buffer))
{
/* Save w's value of point in the window configuration.
@@ -6434,82 +5971,6 @@ redirection (see `redirect-frame-focus'). */)
XSETWINDOW_CONFIGURATION (tem, data);
return (tem);
}
-
-
-/***********************************************************************
- Window Split Tree
- ***********************************************************************/
-
-static Lisp_Object
-window_tree (struct window *w)
-{
- Lisp_Object tail = Qnil;
- Lisp_Object result = Qnil;
-
- while (w)
- {
- Lisp_Object wn;
-
- XSETWINDOW (wn, w);
- if (!NILP (w->hchild))
- wn = Fcons (Qnil, Fcons (Fwindow_edges (wn),
- window_tree (XWINDOW (w->hchild))));
- else if (!NILP (w->vchild))
- wn = Fcons (Qt, Fcons (Fwindow_edges (wn),
- window_tree (XWINDOW (w->vchild))));
-
- if (NILP (result))
- {
- result = tail = Fcons (wn, Qnil);
- }
- else
- {
- XSETCDR (tail, Fcons (wn, Qnil));
- tail = XCDR (tail);
- }
-
- w = NILP (w->next) ? 0 : XWINDOW (w->next);
- }
-
- return result;
-}
-
-
-
-DEFUN ("window-tree", Fwindow_tree, Swindow_tree,
- 0, 1, 0,
- doc: /* Return the window tree for frame FRAME.
-
-The return value is a list of the form (ROOT MINI), where ROOT
-represents the window tree of the frame's root window, and MINI
-is the frame's minibuffer window.
-
-If the root window is not split, ROOT is the root window itself.
-Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil for a
-horizontal split, and t for a vertical split, EDGES gives the combined
-size and position of the subwindows in the split, and the rest of the
-elements are the subwindows in the split. Each of the subwindows may
-again be a window or a list representing a window split, and so on.
-EDGES is a list \(LEFT TOP RIGHT BOTTOM) as returned by `window-edges'.
-
-If FRAME is nil or omitted, return information on the currently
-selected frame. */)
- (Lisp_Object frame)
-{
- FRAME_PTR f;
-
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
- if (!FRAME_LIVE_P (f))
- return Qnil;
-
- return window_tree (XWINDOW (FRAME_ROOT_WINDOW (f)));
-}
-
/***********************************************************************
Marginal Areas
@@ -6869,116 +6330,81 @@ freeze_window_starts (struct frame *f, int freeze_p)
Initialization
***********************************************************************/
-/* Return 1 if window configurations C1 and C2
- describe the same state of affairs. This is used by Fequal. */
+/* 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
+ and the like.
+
+ This ignores a couple of things like the dedicatedness status of
+ window, splits, nest and the like. This might have to be fixed. */
int
-compare_window_configurations (Lisp_Object c1, Lisp_Object c2, int ignore_positions)
+compare_window_configurations (Lisp_Object configuration1, Lisp_Object configuration2, int ignore_positions)
{
register struct save_window_data *d1, *d2;
- struct Lisp_Vector *sw1, *sw2;
+ struct Lisp_Vector *sws1, *sws2;
int i;
- CHECK_WINDOW_CONFIGURATION (c1);
- CHECK_WINDOW_CONFIGURATION (c2);
-
- d1 = (struct save_window_data *) XVECTOR (c1);
- d2 = (struct save_window_data *) XVECTOR (c2);
- sw1 = XVECTOR (d1->saved_windows);
- sw2 = XVECTOR (d2->saved_windows);
-
- if (d1->frame_cols != d2->frame_cols)
- return 0;
- if (d1->frame_lines != d2->frame_lines)
- return 0;
- if (d1->frame_menu_bar_lines != d2->frame_menu_bar_lines)
- return 0;
- if (! EQ (d1->selected_frame, d2->selected_frame))
- return 0;
- /* Don't compare the current_window field directly.
- Instead see w1_is_current and w2_is_current, below. */
- if (! EQ (d1->current_buffer, d2->current_buffer))
- return 0;
- if (! ignore_positions)
- {
- if (! EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window))
- return 0;
- if (! EQ (d1->minibuf_selected_window, d2->minibuf_selected_window))
- return 0;
- }
- /* Don't compare the root_window field.
- We don't require the two configurations
- to use the same window object,
- and the two root windows must be equivalent
- if everything else compares equal. */
- if (! EQ (d1->focus_frame, d2->focus_frame))
- return 0;
-
- /* Verify that the two confis have the same number of windows. */
- if (sw1->header.size != sw2->header.size)
+ CHECK_WINDOW_CONFIGURATION (configuration1);
+ CHECK_WINDOW_CONFIGURATION (configuration2);
+
+ d1 = (struct save_window_data *) XVECTOR (configuration1);
+ d2 = (struct save_window_data *) XVECTOR (configuration2);
+ sws1 = XVECTOR (d1->saved_windows);
+ sws2 = XVECTOR (d2->saved_windows);
+
+ /* Frame settings must match. */
+ if (d1->frame_cols != d2->frame_cols
+ || d1->frame_lines != d2->frame_lines
+ || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
+ || !EQ (d1->selected_frame, d2->selected_frame)
+ || !EQ (d1->current_buffer, d2->current_buffer)
+ || (!ignore_positions
+ && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
+ || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
+ || !EQ (d1->focus_frame, d2->focus_frame)
+ /* Verify that the two configurations have the same number of windows. */
+ || sws1->header.size != sws2->header.size)
return 0;
- for (i = 0; i < sw1->header.size; i++)
- {
- struct saved_window *p1, *p2;
- int w1_is_current, w2_is_current;
-
- p1 = SAVED_WINDOW_N (sw1, i);
- p2 = SAVED_WINDOW_N (sw2, i);
-
- /* Verify that the current windows in the two
- configurations correspond to each other. */
- w1_is_current = EQ (d1->current_window, p1->window);
- w2_is_current = EQ (d2->current_window, p2->window);
-
- if (w1_is_current != w2_is_current)
- return 0;
-
- /* Verify that the corresponding windows do match. */
- if (! EQ (p1->buffer, p2->buffer))
- return 0;
- if (! EQ (p1->left_col, p2->left_col))
- return 0;
- if (! EQ (p1->top_line, p2->top_line))
- return 0;
- if (! EQ (p1->total_cols, p2->total_cols))
- return 0;
- if (! EQ (p1->total_lines, p2->total_lines))
- return 0;
- if (! EQ (p1->display_table, p2->display_table))
- return 0;
- if (! EQ (p1->parent, p2->parent))
- return 0;
- if (! EQ (p1->prev, p2->prev))
- return 0;
- if (! ignore_positions)
- {
- if (! EQ (p1->hscroll, p2->hscroll))
- return 0;
- if (!EQ (p1->min_hscroll, p2->min_hscroll))
- return 0;
- if (! EQ (p1->start_at_line_beg, p2->start_at_line_beg))
- return 0;
- if (NILP (Fequal (p1->start, p2->start)))
- return 0;
- if (NILP (Fequal (p1->pointm, p2->pointm)))
- return 0;
- if (NILP (Fequal (p1->mark, p2->mark)))
- return 0;
- }
- if (! EQ (p1->left_margin_cols, p2->left_margin_cols))
- return 0;
- if (! EQ (p1->right_margin_cols, p2->right_margin_cols))
- return 0;
- if (! EQ (p1->left_fringe_width, p2->left_fringe_width))
- return 0;
- if (! EQ (p1->right_fringe_width, p2->right_fringe_width))
- return 0;
- if (! EQ (p1->fringes_outside_margins, p2->fringes_outside_margins))
- return 0;
- if (! EQ (p1->scroll_bar_width, p2->scroll_bar_width))
- return 0;
- if (! EQ (p1->vertical_scroll_bar_type, p2->vertical_scroll_bar_type))
+ for (i = 0; i < sws1->header.size; i++)
+ {
+ struct saved_window *sw1, *sw2;
+
+ sw1 = SAVED_WINDOW_N (sws1, i);
+ sw2 = SAVED_WINDOW_N (sws2, i);
+
+ if (
+ /* The "current" windows in the two configurations must
+ correspond to each other. */
+ EQ (d1->current_window, sw1->window)
+ != EQ (d2->current_window, sw2->window)
+ /* Windows' buffers must match. */
+ || !EQ (sw1->buffer, sw2->buffer)
+ || !EQ (sw1->left_col, sw2->left_col)
+ || !EQ (sw1->top_line, sw2->top_line)
+ || !EQ (sw1->total_cols, sw2->total_cols)
+ || !EQ (sw1->total_lines, sw2->total_lines)
+ || !EQ (sw1->display_table, sw2->display_table)
+ /* The next two disjuncts check the window structure for
+ equality. */
+ || !EQ (sw1->parent, sw2->parent)
+ || !EQ (sw1->prev, sw2->prev)
+ || (!ignore_positions
+ && (!EQ (sw1->hscroll, sw2->hscroll)
+ || !EQ (sw1->min_hscroll, sw2->min_hscroll)
+ || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg)
+ || NILP (Fequal (sw1->start, sw2->start))
+ || NILP (Fequal (sw1->pointm, sw2->pointm))
+ || NILP (Fequal (sw1->mark, sw2->mark))))
+ || !EQ (sw1->left_margin_cols, sw2->left_margin_cols)
+ || !EQ (sw1->right_margin_cols, sw2->right_margin_cols)
+ || !EQ (sw1->left_fringe_width, sw2->left_fringe_width)
+ || !EQ (sw1->right_fringe_width, sw2->right_fringe_width)
+ || !EQ (sw1->fringes_outside_margins, sw2->fringes_outside_margins)
+ || !EQ (sw1->scroll_bar_width, sw2->scroll_bar_width)
+ || !EQ (sw1->vertical_scroll_bar_type, sw2->vertical_scroll_bar_type))
return 0;
}
@@ -7019,40 +6445,30 @@ init_window (void)
void
syms_of_window (void)
{
- Qscroll_up = intern_c_string ("scroll-up");
- staticpro (&Qscroll_up);
-
- Qscroll_down = intern_c_string ("scroll-down");
- staticpro (&Qscroll_down);
-
- Qscroll_command = intern_c_string ("scroll-command");
- staticpro (&Qscroll_command);
+ DEFSYM (Qscroll_up, "scroll-up");
+ DEFSYM (Qscroll_down, "scroll-down");
+ DEFSYM (Qscroll_command, "scroll-command");
Fput (Qscroll_up, Qscroll_command, Qt);
Fput (Qscroll_down, Qscroll_command, Qt);
- Qwindow_size_fixed = intern_c_string ("window-size-fixed");
- staticpro (&Qwindow_size_fixed);
- Fset (Qwindow_size_fixed, Qnil);
-
- staticpro (&Qwindow_configuration_change_hook);
- Qwindow_configuration_change_hook
- = intern_c_string ("window-configuration-change-hook");
-
- Qwindowp = intern_c_string ("windowp");
- staticpro (&Qwindowp);
-
- Qwindow_configuration_p = intern_c_string ("window-configuration-p");
- staticpro (&Qwindow_configuration_p);
-
- Qwindow_live_p = intern_c_string ("window-live-p");
- staticpro (&Qwindow_live_p);
-
- Qdisplay_buffer = intern_c_string ("display-buffer");
- staticpro (&Qdisplay_buffer);
-
- Qtemp_buffer_show_hook = intern_c_string ("temp-buffer-show-hook");
- staticpro (&Qtemp_buffer_show_hook);
+ DEFSYM (Qwindow_configuration_change_hook, "window-configuration-change-hook");
+ DEFSYM (Qwindowp, "windowp");
+ DEFSYM (Qwindow_configuration_p, "window-configuration-p");
+ DEFSYM (Qwindow_live_p, "window-live-p");
+ DEFSYM (Qwindow_deletable_p, "window-deletable-p");
+ DEFSYM (Qdelete_window, "delete-window");
+ DEFSYM (Qwindow_resize_root_window, "window--resize-root-window");
+ DEFSYM (Qwindow_resize_root_window_vertically, "window--resize-root-window-vertically");
+ DEFSYM (Qsafe, "safe");
+ DEFSYM (Qdisplay_buffer, "display-buffer");
+ DEFSYM (Qreplace_buffer_in_windows, "replace-buffer-in-windows");
+ DEFSYM (Qrecord_window_buffer, "record-window-buffer");
+ DEFSYM (Qget_mru_window, "get-mru-window");
+ DEFSYM (Qtemp_buffer_show_hook, "temp-buffer-show-hook");
+ DEFSYM (Qabove, "above");
+ DEFSYM (Qbelow, "below");
+ DEFSYM (Qauto_buffer_name, "auto-buffer-name");
staticpro (&Vwindow_list);
@@ -7072,6 +6488,16 @@ If this function is used, then it must do the entire job of showing
the buffer; `temp-buffer-show-hook' is not run unless this function runs it. */);
Vtemp_buffer_show_function = Qnil;
+ DEFVAR_LISP ("temp-buffer-show-specifiers", Vtemp_buffer_show_specifiers,
+ doc: /* Buffer display specifiers used by `with-output-to-temp-buffer'.
+These specifiers are passed by `with-output-to-temp-buffer' as second
+argument to `display-buffer'. Applications should only let-bind this
+around a call to `with-output-to-temp-buffer'.
+
+For a description of buffer display specifiers see the variable
+`display-buffer-alist'. */);
+ Vtemp_buffer_show_specifiers = Qnil;
+
DEFVAR_LISP ("minibuffer-scroll-window", Vminibuf_scroll_window,
doc: /* Non-nil means it is the window that C-M-v in minibuffer should scroll. */);
Vminibuf_scroll_window = Qnil;
@@ -7087,34 +6513,16 @@ is displayed in the `mode-line' face. */);
Vother_window_scroll_buffer = Qnil;
DEFVAR_BOOL ("auto-window-vscroll", auto_window_vscroll_p,
- doc: /* *Non-nil means to automatically adjust `window-vscroll' to view tall lines. */);
+ doc: /* Non-nil means to automatically adjust `window-vscroll' to view tall lines. */);
auto_window_vscroll_p = 1;
DEFVAR_INT ("next-screen-context-lines", next_screen_context_lines,
- doc: /* *Number of lines of continuity when scrolling by screenfuls. */);
+ doc: /* Number of lines of continuity when scrolling by screenfuls. */);
next_screen_context_lines = 2;
- DEFVAR_INT ("window-min-height", window_min_height,
- doc: /* Allow deleting windows less than this tall.
-The value is measured in line units. If a window wants a modeline it
-is counted as one line.
-
-Emacs honors settings of this variable when enlarging or shrinking
-windows vertically. A value less than 1 is invalid. */);
- window_min_height = 4;
-
- DEFVAR_INT ("window-min-width", window_min_width,
- doc: /* Allow deleting windows less than this wide.
-The value is measured in characters and includes any fringes or
-the scrollbar.
-
-Emacs honors settings of this variable when enlarging or shrinking
-windows horizontally. A value less than 2 is invalid. */);
- window_min_width = 10;
-
DEFVAR_LISP ("scroll-preserve-screen-position",
Vscroll_preserve_screen_position,
- doc: /* *Controls if scroll commands move point to keep its screen position unchanged.
+ doc: /* Controls if scroll commands move point to keep its screen position unchanged.
A value of nil means point does not keep its screen position except
at the scroll margin or window boundary respectively.
A value of t means point keeps its screen position if the scroll
@@ -7143,18 +6551,75 @@ will redraw the entire frame; the special value `tty' causes the
frame to be redrawn only if it is a tty frame. */);
Vrecenter_redisplay = Qtty;
+ DEFVAR_LISP ("window-splits", Vwindow_splits,
+ doc: /* Non-nil means splitting windows is handled specially.
+If this variable is nil, splitting a window gets the entire screen space
+for displaying the new window from the window to split. If this
+variable is non-nil, splitting a window may resize all windows in the
+same combination. This also allows to split a window that is otherwise
+too small or of fixed size.
+
+The value of this variable is also assigned to the split status of the
+new window and, provided the old and new window form a new combination,
+to the window that was split as well. The split status of a window can
+be retrieved with the function `window-splits' and altered by the
+function `set-window-splits'.
+
+If the value of the variable `window-nest' is non-nil, the space for the
+new window is exclusively taken from the window that shall be split, but
+the split status of the window that is split as well as that of the new
+window are still set to the value of this variable. */);
+ Vwindow_splits = Qnil;
+
+ DEFVAR_LISP ("window-nest", Vwindow_nest,
+ doc: /* Non-nil means 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 it is part of.
+
+If this variable is non-nil, 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.
+
+The value of this variable is also assigned to the nest status of the
+new parent window. The nest status of a window can be retrieved via the
+function `window-nest' and altered by the function `set-window-nest'. */);
+ Vwindow_nest = Qnil;
defsubr (&Sselected_window);
defsubr (&Sminibuffer_window);
defsubr (&Swindow_minibuffer_p);
defsubr (&Swindowp);
defsubr (&Swindow_live_p);
+ defsubr (&Swindow_frame);
+ defsubr (&Sframe_root_window);
+ defsubr (&Sframe_first_window);
+ defsubr (&Sframe_selected_window);
+ defsubr (&Sset_frame_selected_window);
defsubr (&Spos_visible_in_window_p);
defsubr (&Swindow_line_height);
defsubr (&Swindow_buffer);
- defsubr (&Swindow_height);
- defsubr (&Swindow_width);
- defsubr (&Swindow_full_width_p);
+ defsubr (&Swindow_parent);
+ defsubr (&Swindow_top_child);
+ defsubr (&Swindow_left_child);
+ defsubr (&Swindow_next_sibling);
+ defsubr (&Swindow_prev_sibling);
+ defsubr (&Swindow_splits);
+ defsubr (&Sset_window_splits);
+ defsubr (&Swindow_nest);
+ defsubr (&Sset_window_nest);
+ defsubr (&Swindow_use_time);
+ defsubr (&Swindow_top_line);
+ defsubr (&Swindow_left_column);
+ defsubr (&Swindow_total_size);
+ defsubr (&Swindow_normal_size);
+ defsubr (&Swindow_new_total);
+ defsubr (&Swindow_new_normal);
+ defsubr (&Sset_window_new_total);
+ defsubr (&Sset_window_new_normal);
+ defsubr (&Swindow_resize_apply);
+ defsubr (&Swindow_body_size);
defsubr (&Swindow_hscroll);
defsubr (&Sset_window_hscroll);
defsubr (&Swindow_redisplay_end_trigger);
@@ -7178,23 +6643,16 @@ frame to be redrawn only if it is a tty frame. */);
defsubr (&Sset_window_display_table);
defsubr (&Snext_window);
defsubr (&Sprevious_window);
- defsubr (&Sother_window);
- defsubr (&Sget_lru_window);
- defsubr (&Swindow_use_time);
- defsubr (&Sget_largest_window);
defsubr (&Sget_buffer_window);
- defsubr (&Sdelete_other_windows);
- defsubr (&Sdelete_windows_on);
- defsubr (&Sreplace_buffer_in_windows);
- defsubr (&Sdelete_window);
+ defsubr (&Sdelete_other_windows_internal);
+ defsubr (&Sdelete_window_internal);
+ defsubr (&Sresize_mini_window_internal);
defsubr (&Sset_window_buffer);
+ defsubr (&Srun_window_configuration_change_hook);
defsubr (&Sselect_window);
defsubr (&Sforce_window_update);
defsubr (&Stemp_output_buffer_show);
- defsubr (&Ssplit_window);
- defsubr (&Senlarge_window);
- defsubr (&Sshrink_window);
- defsubr (&Sadjust_window_trailing_edge);
+ defsubr (&Ssplit_window_internal);
defsubr (&Sscroll_up);
defsubr (&Sscroll_down);
defsubr (&Sscroll_left);
@@ -7209,7 +6667,6 @@ frame to be redrawn only if it is a tty frame. */);
defsubr (&Swindow_configuration_frame);
defsubr (&Sset_window_configuration);
defsubr (&Scurrent_window_configuration);
- defsubr (&Swindow_tree);
defsubr (&Sset_window_margins);
defsubr (&Swindow_margins);
defsubr (&Sset_window_fringes);
@@ -7220,20 +6677,19 @@ frame to be redrawn only if it is a tty frame. */);
defsubr (&Sset_window_vscroll);
defsubr (&Scompare_window_configurations);
defsubr (&Swindow_list);
+ defsubr (&Swindow_list_1);
+ defsubr (&Swindow_prev_buffers);
+ defsubr (&Sset_window_prev_buffers);
+ defsubr (&Swindow_next_buffers);
+ defsubr (&Sset_window_next_buffers);
defsubr (&Swindow_parameters);
defsubr (&Swindow_parameter);
defsubr (&Sset_window_parameter);
-
}
void
keys_of_window (void)
{
- initial_define_key (control_x_map, '1', "delete-other-windows");
- initial_define_key (control_x_map, '2', "split-window");
- initial_define_key (control_x_map, '0', "delete-window");
- initial_define_key (control_x_map, 'o', "other-window");
- initial_define_key (control_x_map, '^', "enlarge-window");
initial_define_key (control_x_map, '<', "scroll-left");
initial_define_key (control_x_map, '>', "scroll-right");
diff --git a/src/window.h b/src/window.h
index b1f6560445e..485734e907e 100644
--- a/src/window.h
+++ b/src/window.h
@@ -93,38 +93,57 @@ struct window
/* The frame this window is on. */
Lisp_Object frame;
+
/* t if this window is a minibuffer window. */
Lisp_Object mini_p;
- /* Following child (to right or down) at same level of tree */
- Lisp_Object next;
- /* Preceding child (to left or up) at same level of tree */
- Lisp_Object prev;
- /* First child of this window. */
- /* vchild is used if this is a vertical combination,
- hchild if this is a horizontal combination. */
+
+ /* Following (to right or down) and preceding (to left or up) child
+ at same level of tree. */
+ Lisp_Object next, 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;
- /* The window this one is a child of. */
+
+ /* The window this one is a child of. */
Lisp_Object parent;
- /* The upper left corner coordinates of this window,
- as integers relative to upper left corner of frame = 0, 0 */
+
+ /* The upper left corner coordinates of this window, as integers
+ relative to upper left corner of frame = 0, 0. */
Lisp_Object left_col;
Lisp_Object top_line;
- /* The size of the window */
+
+ /* The size of the window. */
Lisp_Object total_lines;
Lisp_Object total_cols;
- /* The buffer displayed in this window */
- /* Of the fields vchild, hchild and buffer, only one is non-nil. */
+
+ /* The normal size of the window. */
+ Lisp_Object normal_lines;
+ Lisp_Object normal_cols;
+
+ /* New sizes of the window. */
+ Lisp_Object new_total;
+ Lisp_Object new_normal;
+
+ /* The buffer displayed in this window. Of the fields vchild,
+ hchild and buffer, one and only one is non-nil unless the window
+ is dead. */
Lisp_Object buffer;
+
/* A marker pointing to where in the text to start displaying.
BIDI Note: This is the _logical-order_ start, i.e. the smallest
buffer position visible in the window, not necessarily the
character displayed in the top left corner of the window. */
Lisp_Object start;
+
/* A marker pointing to where in the text point is in this window,
used only when the window is not selected.
This exists so that when multiple windows show one buffer
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;
@@ -133,26 +152,34 @@ struct window
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 */
+
+ /* Number saying how recently window was selected. */
Lisp_Object use_time;
- /* Unique number of window assigned when it was created */
+
+ /* Unique number of window assigned when it was created. */
Lisp_Object sequence_number;
- /* No permanent meaning; used by save-window-excursion's bookkeeping */
+
+ /* No permanent meaning; used by save-window-excursion's
+ bookkeeping. */
Lisp_Object temslot;
- /* text.modified of displayed buffer as of last time display completed */
+
+ /* 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 */
+ /* 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
@@ -167,14 +194,14 @@ struct window
/* 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. */
+ /* Non-nil means fringes are drawn outside display margins;
+ othersize draw them between margin areas and text. */
Lisp_Object fringes_outside_margins;
/* Pixel width of scroll bars.
A value of nil or t means use frame values. */
Lisp_Object scroll_bar_width;
+
/* Type of vertical scroll bar. A value of nil means
no scroll bar. A value of t means use frame value. */
Lisp_Object vertical_scroll_bar_type;
@@ -183,6 +210,7 @@ struct window
/* 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;
@@ -194,39 +222,56 @@ struct window
since in that case the frame image that window_end_pos
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. */
Lisp_Object dedicated;
- /* Line number and position of a line somewhere above the
- top of the screen. */
- /* If this field is nil, it means we don't have a base line. */
+
+ /* Line number and position of a line somewhere above the top of the
+ screen. If this field is nil, it means we don't have a base
+ line. */
Lisp_Object base_line_number;
/* If this field is nil, it means we don't have a base line.
If it is a buffer, it means don't display the line number
as long as the window shows that buffer. */
Lisp_Object base_line_pos;
+
/* If we have highlighted the region (or any part of it),
this is the mark position that we used, as an integer. */
Lisp_Object region_showing;
+
/* The column number currently displayed in this window's mode line,
or nil if column numbers are not being displayed. */
Lisp_Object column_number_displayed;
+
/* If redisplay in this window goes beyond this buffer position,
must run the redisplay-end-trigger-hook. */
Lisp_Object redisplay_end_trigger;
- /* Non-nil means resizing windows will attempt to resize this window
- proportionally. */
- Lisp_Object resize_proportionally;
- /* Original window height and top before mini-window was enlarged. */
- Lisp_Object orig_total_lines, orig_top_line;
+ /* Non-nil means deleting or resizing this window distributes
+ space among all windows in the same combination. */
+ Lisp_Object splits;
+
+ /* Non-nil means this window's child windows are never
+ (re-)combined. */
+ Lisp_Object nest;
+
+ /* 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 parameteres. */
Lisp_Object window_parameters;
@@ -361,6 +406,17 @@ struct window
#define WINDOW_TOTAL_HEIGHT(W) \
(WINDOW_TOTAL_LINES (W) * WINDOW_FRAME_LINE_HEIGHT (W))
+/* For HORFLAG non-zero the total number of columns of window W. Otherwise
+ the total number of lines of W. */
+
+#define WINDOW_TOTAL_SIZE(w, horflag) \
+ (horflag ? WINDOW_TOTAL_COLS (w) : WINDOW_TOTAL_LINES (w))
+
+/* The smallest acceptable dimensions for a window. Anything smaller
+ might crash Emacs. */
+
+#define MIN_SAFE_WINDOW_WIDTH (2)
+#define MIN_SAFE_WINDOW_HEIGHT (1)
/* Return the canonical frame column at which window W starts.
This includes a left-hand scroll bar, if any. */
@@ -767,10 +823,8 @@ 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 set_window_height (Lisp_Object, int, int);
-extern void set_window_width (Lisp_Object, int, int);
-extern void change_window_heights (Lisp_Object, int);
-extern void delete_all_subwindows (struct window *);
+extern void resize_frame_windows (struct frame *, int, int);
+extern void delete_all_subwindows (Lisp_Object);
extern void freeze_window_starts (struct frame *, int);
extern void grow_mini_window (struct window *, int);
extern void shrink_mini_window (struct window *);
@@ -844,25 +898,27 @@ struct glyph *get_phys_cursor_glyph (struct window *w);
extern Lisp_Object Qwindowp, Qwindow_live_p;
extern Lisp_Object Vwindow_list;
-EXFUN (Fselected_window, 0);
-EXFUN (Fwindow_minibuffer_p, 1);
-EXFUN (Fdelete_window, 1);
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 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_all_windows (Lisp_Object);
+extern void replace_buffer_in_windows (Lisp_Object);
+extern void replace_buffer_in_windows_safely (Lisp_Object);
extern void init_window_once (void);
extern void init_window (void);
extern void syms_of_window (void);
extern void keys_of_window (void);
-extern int window_box_text_cols (struct window *w);
-
#endif /* not WINDOW_H_INCLUDED */
diff --git a/src/xdisp.c b/src/xdisp.c
index cef2fe6df7b..f8b4e65a7e5 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -258,7 +258,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
still left to right, i.e. the iterator "thinks" the first character
is at the leftmost pixel position. The iterator does not know that
PRODUCE_GLYPHS reverses the order of the glyphs that the iterator
- delivers. This is important when functions from the the move_it_*
+ delivers. This is important when functions from the move_it_*
family are used to get to certain screen position or to match
screen coordinates with buffer coordinates: these functions use the
iterator geometry, which is left to right even in R2L paragraphs.
@@ -837,7 +837,7 @@ 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_cursor_movement (Lisp_Object, struct text_pos, int *);
static int trailing_whitespace_p (EMACS_INT);
-static unsigned long int message_log_check_duplicate (EMACS_INT, EMACS_INT);
+static intmax_t message_log_check_duplicate (EMACS_INT, EMACS_INT);
static void push_it (struct it *, struct text_pos *);
static void pop_it (struct it *);
static void sync_frame_with_window_matrix_rows (struct window *);
@@ -954,7 +954,7 @@ static int coords_in_mouse_face_p (struct window *, int, int);
This is the height of W minus the height of a mode line, if any. */
-INLINE int
+inline int
window_text_bottom_y (struct window *w)
{
int height = WINDOW_TOTAL_HEIGHT (w);
@@ -968,7 +968,7 @@ window_text_bottom_y (struct window *w)
means return the total width of W, not including fringes to
the left and right of the window. */
-INLINE int
+inline int
window_box_width (struct window *w, int area)
{
int cols = XFASTINT (w->total_cols);
@@ -1007,7 +1007,7 @@ window_box_width (struct window *w, int area)
/* Return the pixel height of the display area of window W, not
including mode lines of W, if any. */
-INLINE int
+inline int
window_box_height (struct window *w)
{
struct frame *f = XFRAME (w->frame);
@@ -1054,7 +1054,7 @@ window_box_height (struct window *w)
area AREA of window W. AREA < 0 means return the left edge of the
whole window, to the right of the left fringe of W. */
-INLINE int
+inline int
window_box_left_offset (struct window *w, int area)
{
int x;
@@ -1086,7 +1086,7 @@ window_box_left_offset (struct window *w, int area)
area AREA of window W. AREA < 0 means return the right edge of the
whole window, to the left of the right fringe of W. */
-INLINE int
+inline int
window_box_right_offset (struct window *w, int area)
{
return window_box_left_offset (w, area) + window_box_width (w, area);
@@ -1096,7 +1096,7 @@ window_box_right_offset (struct window *w, int area)
area AREA of window W. AREA < 0 means return the left edge of the
whole window, to the right of the left fringe of W. */
-INLINE int
+inline int
window_box_left (struct window *w, int area)
{
struct frame *f = XFRAME (w->frame);
@@ -1116,7 +1116,7 @@ window_box_left (struct window *w, int area)
area AREA of window W. AREA < 0 means return the right edge of the
whole window, to the left of the right fringe of W. */
-INLINE int
+inline int
window_box_right (struct window *w, int area)
{
return window_box_left (w, area) + window_box_width (w, area);
@@ -1129,7 +1129,7 @@ window_box_right (struct window *w, int area)
coordinates of the upper-left corner of the box. Return in
*BOX_WIDTH, and *BOX_HEIGHT the pixel width and height of the box. */
-INLINE void
+inline void
window_box (struct window *w, int area, int *box_x, int *box_y,
int *box_width, int *box_height)
{
@@ -1156,7 +1156,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 inline 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)
{
@@ -1371,13 +1371,13 @@ 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 inline int
string_char_and_length (const unsigned char *str, int *len)
{
int c;
c = STRING_CHAR_AND_LENGTH (str, *len);
- if (!CHAR_VALID_P (c, 1))
+ if (!CHAR_VALID_P (c))
/* We may not change the length here because other places in Emacs
don't use this function, i.e. they silently accept invalid
characters. */
@@ -1419,7 +1419,7 @@ 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
+static inline struct text_pos
string_pos (EMACS_INT charpos, Lisp_Object string)
{
struct text_pos pos;
@@ -2180,7 +2180,7 @@ safe_eval_handler (Lisp_Object arg)
redisplay during the evaluation. */
Lisp_Object
-safe_call (size_t nargs, Lisp_Object *args)
+safe_call (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object val;
@@ -2251,8 +2251,7 @@ safe_call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
This is for debugging. It is too slow to do unconditionally. */
static void
-check_it (it)
- struct it *it;
+check_it (struct it *it)
{
if (it->method == GET_FROM_STRING)
{
@@ -2284,14 +2283,13 @@ check_it (it)
#endif /* not 0 */
-#if GLYPH_DEBUG
+#if GLYPH_DEBUG && XASSERTS
/* Check that the window end of window W is what we expect it
to be---the last row in the current matrix displaying text. */
static void
-check_window_end (w)
- struct window *w;
+check_window_end (struct window *w)
{
if (!MINI_WINDOW_P (w)
&& !NILP (w->window_end_valid))
@@ -2307,11 +2305,11 @@ check_window_end (w)
#define CHECK_WINDOW_END(W) check_window_end ((W))
-#else /* not GLYPH_DEBUG */
+#else
#define CHECK_WINDOW_END(W) (void) 0
-#endif /* not GLYPH_DEBUG */
+#endif
@@ -2431,7 +2429,7 @@ 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))
- ? XFASTINT (BVAR (current_buffer, selective_display))
+ ? XINT (BVAR (current_buffer, selective_display))
: (!NILP (BVAR (current_buffer, selective_display))
? -1 : 0));
it->selective_display_ellipsis_p
@@ -3114,10 +3112,9 @@ compute_stop_pos (struct it *it)
static EMACS_INT
next_overlay_change (EMACS_INT pos)
{
- int noverlays;
+ ptrdiff_t i, noverlays;
EMACS_INT endpos;
Lisp_Object *overlays;
- int i;
/* Get all overlays at the given position. */
GET_OVERLAYS_AT (pos, overlays, noverlays, &endpos, 1);
@@ -4800,6 +4797,11 @@ handle_composition_prop (struct it *it)
&& COMPOSITION_VALID_P (start, end, prop)
&& (STRINGP (it->string) || (PT <= start || PT >= end)))
{
+ if (start < pos)
+ /* As we can't handle this situation (perhaps font-lock added
+ a new composition), we just return here hoping that next
+ redisplay will detect this composition much earlier. */
+ return HANDLED_NORMALLY;
if (start != pos)
{
if (STRINGP (it->string))
@@ -5459,7 +5461,8 @@ back_to_previous_line_start (struct it *it)
static int
forward_to_next_line_start (struct it *it, int *skipped_p)
{
- int old_selective, newline_found_p, n;
+ EMACS_INT old_selective;
+ int newline_found_p, n;
const int MAX_NEWLINE_DISTANCE = 500;
/* If already on a newline, just consume it to avoid unintended
@@ -5552,7 +5555,7 @@ back_to_previous_visible_line_start (struct it *it)
invisible. */
if (it->selective > 0
&& indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it),
- (double) it->selective)) /* iftc */
+ it->selective))
continue;
/* Check the newline before point for invisibility. */
@@ -5654,7 +5657,7 @@ reseat_at_next_visible_line_start (struct it *it, int on_newline_p)
if (it->selective > 0)
while (IT_CHARPOS (*it) < ZV
&& indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it),
- (double) it->selective)) /* iftc */
+ it->selective))
{
xassert (IT_BYTEPOS (*it) == BEGV
|| FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
@@ -6170,7 +6173,8 @@ get_next_display_element (struct it *it)
display. Then, set IT->dpvec to these glyphs. */
Lisp_Object gc;
int ctl_len;
- int face_id, lface_id = 0 ;
+ int face_id;
+ EMACS_INT lface_id = 0;
int escape_glyph;
/* Handle control characters with ^. */
@@ -6340,11 +6344,23 @@ get_next_display_element (struct it *it)
else
{
EMACS_INT pos = (it->s ? -1
- : STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
- : IT_CHARPOS (*it));
+ : STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
+ : IT_CHARPOS (*it));
+ int c;
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display, pos,
- it->string);
+ if (it->what == IT_CHARACTER)
+ c = it->char_to_display;
+ else
+ {
+ struct composition *cmp = composition_table[it->cmp_it.id];
+ int i;
+
+ c = ' ';
+ for (i = 0; i < cmp->glyph_len; i++)
+ if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
+ break;
+ }
+ it->face_id = FACE_FOR_CHAR (it->f, face, c, pos, it->string);
}
}
@@ -6799,7 +6815,7 @@ next_element_from_display_vector (struct it *it)
it->face_id = it->dpvec_face_id;
else
{
- int lface_id = GLYPH_CODE_FACE (gc);
+ EMACS_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);
@@ -7378,7 +7394,7 @@ next_element_from_buffer (struct it *it)
&& IT_CHARPOS (*it) + 1 < ZV
&& indented_beyond_p (IT_CHARPOS (*it) + 1,
IT_BYTEPOS (*it) + 1,
- (double) it->selective)) /* iftc */
+ it->selective))
{
success_p = next_element_from_ellipsis (it);
it->dpvec_char_len = -1;
@@ -8678,7 +8694,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;
- unsigned long int dups;
+ intmax_t dups;
insert_1 ("\n", 1, 1, 0, 0);
scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, 0);
@@ -8701,12 +8717,13 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
this_bol, this_bol_byte, 0);
if (dups > 1)
{
- char dupstr[40];
+ char dupstr[sizeof " [ times]"
+ + INT_STRLEN_BOUND (intmax_t)];
int duplen;
/* If you change this format, don't forget to also
change message_log_check_duplicate. */
- sprintf (dupstr, " [%lu times]", dups);
+ sprintf (dupstr, " [%"PRIdMAX" times]", dups);
duplen = strlen (dupstr);
TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1);
insert_1 (dupstr, duplen, 1, 0, 1);
@@ -8768,7 +8785,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
Return 0 if different, 1 if the new one should just replace it, or a
value N > 1 if we should also append " [N times]". */
-static unsigned long int
+static intmax_t
message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte)
{
EMACS_INT i;
@@ -8790,8 +8807,8 @@ message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte)
if (*p1++ == ' ' && *p1++ == '[')
{
char *pend;
- unsigned long int n = strtoul ((char *) p1, &pend, 10);
- if (strncmp (pend, " times]\n", 8) == 0)
+ intmax_t n = strtoimax ((char *) p1, &pend, 10);
+ if (0 < n && n < INTMAX_MAX && strncmp (pend, " times]\n", 8) == 0)
return n+1;
}
return 0;
@@ -11120,7 +11137,7 @@ DEFUN ("tool-bar-lines-needed", Ftool_bar_lines_needed, Stool_bar_lines_needed,
f = XFRAME (frame);
if (WINDOWP (f->tool_bar_window)
- || (w = XWINDOW (f->tool_bar_window),
+ && (w = XWINDOW (f->tool_bar_window),
WINDOW_TOTAL_LINES (w) > 0))
{
update_tool_bar (f, 1);
@@ -11724,40 +11741,42 @@ hscroll_windows (Lisp_Object window)
/* First and last unchanged row for try_window_id. */
-int debug_first_unchanged_at_end_vpos;
-int debug_last_unchanged_at_beg_vpos;
+static int debug_first_unchanged_at_end_vpos;
+static int debug_last_unchanged_at_beg_vpos;
/* Delta vpos and y. */
-int debug_dvpos, debug_dy;
+static int debug_dvpos, debug_dy;
/* Delta in characters and bytes for try_window_id. */
-EMACS_INT debug_delta, debug_delta_bytes;
+static EMACS_INT debug_delta, debug_delta_bytes;
/* Values of window_end_pos and window_end_vpos at the end of
try_window_id. */
-EMACS_INT debug_end_vpos;
+static EMACS_INT debug_end_vpos;
/* Append a string to W->desired_matrix->method. FMT is a printf
- format string. A1...A9 are a supplement for a variable-length
- argument list. If trace_redisplay_p is non-zero also printf the
+ format string. If trace_redisplay_p is non-zero also printf the
resulting string to stderr. */
+static void debug_method_add (struct window *, char const *, ...)
+ ATTRIBUTE_FORMAT_PRINTF (2, 3);
+
static void
-debug_method_add (w, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9)
- struct window *w;
- char *fmt;
- int a1, a2, a3, a4, a5, a6, a7, a8, a9;
+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;
- sprintf (buffer, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9);
+ va_start (ap, fmt);
+ vsprintf (buffer, fmt, ap);
+ va_end (ap);
if (len && remaining)
{
method[len] = '|';
@@ -11770,8 +11789,8 @@ debug_method_add (w, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9)
fprintf (stderr, "%p (%s): %s\n",
w,
((BUFFERP (w->buffer)
- && STRINGP (XBUFFER (w->buffer)->name))
- ? SSDATA (XBUFFER (w->buffer)->name)
+ && STRINGP (BVAR (XBUFFER (w->buffer), name)))
+ ? SSDATA (BVAR (XBUFFER (w->buffer), name))
: "no buffer"),
buffer);
}
@@ -11784,7 +11803,7 @@ debug_method_add (w, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9)
buffer position, END is given as a distance from Z. Used in
redisplay_internal for display optimization. */
-static INLINE int
+static inline int
text_outside_line_unchanged_p (struct window *w,
EMACS_INT start, EMACS_INT end)
{
@@ -12045,7 +12064,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 inline void
reconsider_clip_changes (struct window *w, struct buffer *b)
{
if (b->clip_changed
@@ -13625,7 +13644,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
We assume that the window's buffer is really current. */
-static INLINE struct text_pos
+static inline struct text_pos
run_window_scroll_functions (Lisp_Object window, struct text_pos startp)
{
struct window *w = XWINDOW (window);
@@ -15578,7 +15597,8 @@ try_window_reusing_current_matrix (struct window *w)
row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y;
- row->redraw_fringe_bitmaps_p = 1;
+ if (row->fringe_bitmap_periodic_p)
+ row->redraw_fringe_bitmaps_p = 1;
it.current_y += row->height;
@@ -15740,7 +15760,8 @@ try_window_reusing_current_matrix (struct window *w)
row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y;
- row->redraw_fringe_bitmaps_p = 1;
+ if (row->fringe_bitmap_periodic_p)
+ row->redraw_fringe_bitmaps_p = 1;
}
/* Scroll the current matrix. */
@@ -16893,9 +16914,9 @@ try_window_id (struct window *w)
#if GLYPH_DEBUG
-void dump_glyph_row (struct glyph_row *, int, int);
-void dump_glyph_matrix (struct glyph_matrix *, int);
-void dump_glyph (struct glyph_row *, struct glyph *, int);
+void dump_glyph_row (struct glyph_row *, int, int) EXTERNALLY_VISIBLE;
+void dump_glyph_matrix (struct glyph_matrix *, int) EXTERNALLY_VISIBLE;
+void dump_glyph (struct glyph_row *, struct glyph *, int) EXTERNALLY_VISIBLE;
/* Dump the contents of glyph matrix MATRIX on stderr.
@@ -16905,9 +16926,7 @@ void dump_glyph (struct glyph_row *, struct glyph *, int);
GLYPHS > 1 means show glyphs in long form. */
void
-dump_glyph_matrix (matrix, glyphs)
- struct glyph_matrix *matrix;
- int glyphs;
+dump_glyph_matrix (struct glyph_matrix *matrix, int glyphs)
{
int i;
for (i = 0; i < matrix->nrows; ++i)
@@ -16919,15 +16938,12 @@ dump_glyph_matrix (matrix, glyphs)
the glyph row and area where the glyph comes from. */
void
-dump_glyph (row, glyph, area)
- struct glyph_row *row;
- struct glyph *glyph;
- int area;
+dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
{
if (glyph->type == CHAR_GLYPH)
{
fprintf (stderr,
- " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
+ " %5td %4c %6"pI"d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'C',
glyph->charpos,
@@ -16948,7 +16964,7 @@ dump_glyph (row, glyph, area)
else if (glyph->type == STRETCH_GLYPH)
{
fprintf (stderr,
- " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
+ " %5td %4c %6"pI"d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'S',
glyph->charpos,
@@ -16967,7 +16983,7 @@ dump_glyph (row, glyph, area)
else if (glyph->type == IMAGE_GLYPH)
{
fprintf (stderr,
- " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
+ " %5td %4c %6"pI"d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'I',
glyph->charpos,
@@ -16986,7 +17002,7 @@ dump_glyph (row, glyph, area)
else if (glyph->type == COMPOSITE_GLYPH)
{
fprintf (stderr,
- " %5d %4c %6d %c %3d 0x%05x",
+ " %5td %4c %6"pI"d %c %3d 0x%05x",
glyph - row->glyphs[TEXT_AREA],
'+',
glyph->charpos,
@@ -17015,16 +17031,14 @@ dump_glyph (row, glyph, area)
GLYPHS > 1 means show glyphs in long form. */
void
-dump_glyph_row (row, vpos, glyphs)
- struct glyph_row *row;
- int vpos, glyphs;
+dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
{
if (glyphs != 1)
{
fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n");
fprintf (stderr, "======================================================================\n");
- fprintf (stderr, "%3d %5d %5d %4d %1.1d%1.1d%1.1d%1.1d\
+ fprintf (stderr, "%3d %5"pI"d %5"pI"d %4d %1.1d%1.1d%1.1d%1.1d\
%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n",
vpos,
MATRIX_ROW_START_CHARPOS (row),
@@ -17052,7 +17066,7 @@ dump_glyph_row (row, vpos, glyphs)
fprintf (stderr, "%9d %5d\t%5d\n", row->start.overlay_string_index,
row->end.overlay_string_index,
row->continuation_lines_width);
- fprintf (stderr, "%9d %5d\n",
+ fprintf (stderr, "%9"pI"d %5"pI"d\n",
CHARPOS (row->start.string_pos),
CHARPOS (row->end.string_pos));
fprintf (stderr, "%9d %5d\n", row->start.dpvec_index,
@@ -17117,7 +17131,7 @@ glyphs in short form, otherwise show glyphs in long form. */)
struct window *w = XWINDOW (selected_window);
struct buffer *buffer = XBUFFER (w->buffer);
- fprintf (stderr, "PT = %d, BEGV = %d. ZV = %d\n",
+ fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n",
BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer));
fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n",
w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos);
@@ -17199,7 +17213,7 @@ With ARG, turn tracing on if and only if ARG is positive. */)
DEFUN ("trace-to-stderr", Ftrace_to_stderr, Strace_to_stderr, 1, MANY, "",
doc: /* Like `format', but print result to stderr.
usage: (trace-to-stderr STRING &rest OBJECTS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object s = Fformat (nargs, args);
fprintf (stderr, "%s", SDATA (s));
@@ -19404,8 +19418,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
break;
case MODE_LINE_STRING:
{
- int len = strlen (spec);
- Lisp_Object tem = make_string (spec, len);
+ Lisp_Object tem = build_string (spec);
props = Ftext_properties_at (make_number (charpos), elt);
/* Should only keep face property in props */
n += store_mode_line_string (NULL, tem, 0, field, prec, props);
@@ -20048,7 +20061,8 @@ 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);
- eol_str_len = CHAR_STRING (XINT (eoltype), tmp);
+ int c = XFASTINT (eoltype);
+ eol_str_len = CHAR_STRING (c, tmp);
eol_str = tmp;
}
else
@@ -21164,8 +21178,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
#if GLYPH_DEBUG
void
-dump_glyph_string (s)
- struct glyph_string *s;
+dump_glyph_string (struct glyph_string *s)
{
fprintf (stderr, "glyph string\n");
fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n",
@@ -21233,7 +21246,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 inline void
append_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail,
struct glyph_string *h, struct glyph_string *t)
{
@@ -21253,7 +21266,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 inline void
prepend_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail,
struct glyph_string *h, struct glyph_string *t)
{
@@ -21272,7 +21285,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 inline void
append_glyph_string (struct glyph_string **head, struct glyph_string **tail,
struct glyph_string *s)
{
@@ -21287,7 +21300,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 inline struct face *
get_char_face_and_encoding (struct frame *f, int c, int face_id,
XChar2b *char2b, int display_p)
{
@@ -21320,7 +21333,7 @@ get_char_face_and_encoding (struct frame *f, int c, int face_id,
The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is
a pointer to a realized face that is ready for display. */
-static INLINE struct face *
+static inline struct face *
get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph,
XChar2b *char2b, int *two_byte_p)
{
@@ -21357,7 +21370,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.
Retunr 1 if FONT has a glyph for C, otherwise return 0. */
-static INLINE int
+static inline int
get_char_glyph_code (int c, struct font *font, XChar2b *char2b)
{
unsigned code;
@@ -21821,7 +21834,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 inline 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
@@ -22383,7 +22396,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row,
/* Store one glyph for IT->char_to_display in IT->glyph_row.
Called from x_produce_glyphs when IT->glyph_row is non-null. */
-static INLINE void
+static inline void
append_glyph (struct it *it)
{
struct glyph *glyph;
@@ -22457,7 +22470,7 @@ append_glyph (struct it *it)
IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is
non-null. */
-static INLINE void
+static inline void
append_composite_glyph (struct it *it)
{
struct glyph *glyph;
@@ -22526,7 +22539,7 @@ append_composite_glyph (struct it *it)
/* Change IT->ascent and IT->height according to the setting of
IT->voffset. */
-static INLINE void
+static inline void
take_vertical_position_into_account (struct it *it)
{
if (it->voffset)
@@ -26155,13 +26168,13 @@ note_mouse_highlight (struct frame *f, int x, int y)
&& XFASTINT (w->last_modified) == BUF_MODIFF (b)
&& XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b))
{
- int hpos, vpos, i, dx, dy, area;
+ int hpos, vpos, dx, dy, area;
EMACS_INT pos;
struct glyph *glyph;
Lisp_Object object;
Lisp_Object mouse_face = Qnil, position;
Lisp_Object *overlay_vec = NULL;
- int noverlays;
+ ptrdiff_t i, noverlays;
struct buffer *obuf;
EMACS_INT obegv, ozv;
int same_region;
@@ -27084,7 +27097,7 @@ x_intersect_rectangles (XRectangle *r1, XRectangle *r2, XRectangle *result)
{
result->x = right->x;
- /* The right end of the intersection is the minimum of the
+ /* The right end of the intersection is the minimum of
the right ends of left and right. */
result->width = (min (left->x + left->width, right->x + right->width)
- result->x);
@@ -27129,8 +27142,7 @@ syms_of_xdisp (void)
Vmessage_stack = Qnil;
staticpro (&Vmessage_stack);
- Qinhibit_redisplay = intern_c_string ("inhibit-redisplay");
- staticpro (&Qinhibit_redisplay);
+ DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
message_dolog_marker1 = Fmake_marker ();
staticpro (&message_dolog_marker1);
@@ -27155,141 +27167,72 @@ syms_of_xdisp (void)
defsubr (&Sinvisible_p);
defsubr (&Scurrent_bidi_paragraph_direction);
- staticpro (&Qmenu_bar_update_hook);
- Qmenu_bar_update_hook = intern_c_string ("menu-bar-update-hook");
-
- staticpro (&Qoverriding_terminal_local_map);
- Qoverriding_terminal_local_map = intern_c_string ("overriding-terminal-local-map");
-
- staticpro (&Qoverriding_local_map);
- Qoverriding_local_map = intern_c_string ("overriding-local-map");
-
- staticpro (&Qwindow_scroll_functions);
- Qwindow_scroll_functions = intern_c_string ("window-scroll-functions");
-
- staticpro (&Qwindow_text_change_functions);
- Qwindow_text_change_functions = intern_c_string ("window-text-change-functions");
-
- staticpro (&Qredisplay_end_trigger_functions);
- Qredisplay_end_trigger_functions = intern_c_string ("redisplay-end-trigger-functions");
-
- staticpro (&Qinhibit_point_motion_hooks);
- Qinhibit_point_motion_hooks = intern_c_string ("inhibit-point-motion-hooks");
-
- Qeval = intern_c_string ("eval");
- staticpro (&Qeval);
-
- QCdata = intern_c_string (":data");
- staticpro (&QCdata);
- Qdisplay = intern_c_string ("display");
- staticpro (&Qdisplay);
- Qspace_width = intern_c_string ("space-width");
- staticpro (&Qspace_width);
- Qraise = intern_c_string ("raise");
- staticpro (&Qraise);
- Qslice = intern_c_string ("slice");
- staticpro (&Qslice);
- Qspace = intern_c_string ("space");
- staticpro (&Qspace);
- Qmargin = intern_c_string ("margin");
- staticpro (&Qmargin);
- Qpointer = intern_c_string ("pointer");
- staticpro (&Qpointer);
- Qleft_margin = intern_c_string ("left-margin");
- staticpro (&Qleft_margin);
- Qright_margin = intern_c_string ("right-margin");
- staticpro (&Qright_margin);
- Qcenter = intern_c_string ("center");
- staticpro (&Qcenter);
- Qline_height = intern_c_string ("line-height");
- staticpro (&Qline_height);
- QCalign_to = intern_c_string (":align-to");
- staticpro (&QCalign_to);
- QCrelative_width = intern_c_string (":relative-width");
- staticpro (&QCrelative_width);
- QCrelative_height = intern_c_string (":relative-height");
- staticpro (&QCrelative_height);
- QCeval = intern_c_string (":eval");
- staticpro (&QCeval);
- QCpropertize = intern_c_string (":propertize");
- staticpro (&QCpropertize);
- QCfile = intern_c_string (":file");
- staticpro (&QCfile);
- Qfontified = intern_c_string ("fontified");
- staticpro (&Qfontified);
- Qfontification_functions = intern_c_string ("fontification-functions");
- staticpro (&Qfontification_functions);
- Qtrailing_whitespace = intern_c_string ("trailing-whitespace");
- staticpro (&Qtrailing_whitespace);
- Qescape_glyph = intern_c_string ("escape-glyph");
- staticpro (&Qescape_glyph);
- Qnobreak_space = intern_c_string ("nobreak-space");
- staticpro (&Qnobreak_space);
- Qimage = intern_c_string ("image");
- staticpro (&Qimage);
- Qtext = intern_c_string ("text");
- staticpro (&Qtext);
- Qboth = intern_c_string ("both");
- staticpro (&Qboth);
- Qboth_horiz = intern_c_string ("both-horiz");
- staticpro (&Qboth_horiz);
- Qtext_image_horiz = intern_c_string ("text-image-horiz");
- staticpro (&Qtext_image_horiz);
- QCmap = intern_c_string (":map");
- staticpro (&QCmap);
- QCpointer = intern_c_string (":pointer");
- staticpro (&QCpointer);
- Qrect = intern_c_string ("rect");
- staticpro (&Qrect);
- Qcircle = intern_c_string ("circle");
- staticpro (&Qcircle);
- Qpoly = intern_c_string ("poly");
- staticpro (&Qpoly);
- Qmessage_truncate_lines = intern_c_string ("message-truncate-lines");
- staticpro (&Qmessage_truncate_lines);
- Qgrow_only = intern_c_string ("grow-only");
- staticpro (&Qgrow_only);
- Qinhibit_menubar_update = intern_c_string ("inhibit-menubar-update");
- staticpro (&Qinhibit_menubar_update);
- Qinhibit_eval_during_redisplay = intern_c_string ("inhibit-eval-during-redisplay");
- staticpro (&Qinhibit_eval_during_redisplay);
- Qposition = intern_c_string ("position");
- staticpro (&Qposition);
- Qbuffer_position = intern_c_string ("buffer-position");
- staticpro (&Qbuffer_position);
- Qobject = intern_c_string ("object");
- staticpro (&Qobject);
- Qbar = intern_c_string ("bar");
- staticpro (&Qbar);
- Qhbar = intern_c_string ("hbar");
- staticpro (&Qhbar);
- Qbox = intern_c_string ("box");
- staticpro (&Qbox);
- Qhollow = intern_c_string ("hollow");
- staticpro (&Qhollow);
- Qhand = intern_c_string ("hand");
- staticpro (&Qhand);
- Qarrow = intern_c_string ("arrow");
- staticpro (&Qarrow);
- Qtext = intern_c_string ("text");
- staticpro (&Qtext);
- Qinhibit_free_realized_faces = intern_c_string ("inhibit-free-realized-faces");
- staticpro (&Qinhibit_free_realized_faces);
+ DEFSYM (Qmenu_bar_update_hook, "menu-bar-update-hook");
+ DEFSYM (Qoverriding_terminal_local_map, "overriding-terminal-local-map");
+ DEFSYM (Qoverriding_local_map, "overriding-local-map");
+ DEFSYM (Qwindow_scroll_functions, "window-scroll-functions");
+ DEFSYM (Qwindow_text_change_functions, "window-text-change-functions");
+ DEFSYM (Qredisplay_end_trigger_functions, "redisplay-end-trigger-functions");
+ DEFSYM (Qinhibit_point_motion_hooks, "inhibit-point-motion-hooks");
+ DEFSYM (Qeval, "eval");
+ DEFSYM (QCdata, ":data");
+ DEFSYM (Qdisplay, "display");
+ DEFSYM (Qspace_width, "space-width");
+ DEFSYM (Qraise, "raise");
+ DEFSYM (Qslice, "slice");
+ DEFSYM (Qspace, "space");
+ DEFSYM (Qmargin, "margin");
+ DEFSYM (Qpointer, "pointer");
+ DEFSYM (Qleft_margin, "left-margin");
+ DEFSYM (Qright_margin, "right-margin");
+ DEFSYM (Qcenter, "center");
+ DEFSYM (Qline_height, "line-height");
+ DEFSYM (QCalign_to, ":align-to");
+ DEFSYM (QCrelative_width, ":relative-width");
+ DEFSYM (QCrelative_height, ":relative-height");
+ DEFSYM (QCeval, ":eval");
+ DEFSYM (QCpropertize, ":propertize");
+ DEFSYM (QCfile, ":file");
+ DEFSYM (Qfontified, "fontified");
+ DEFSYM (Qfontification_functions, "fontification-functions");
+ DEFSYM (Qtrailing_whitespace, "trailing-whitespace");
+ DEFSYM (Qescape_glyph, "escape-glyph");
+ DEFSYM (Qnobreak_space, "nobreak-space");
+ DEFSYM (Qimage, "image");
+ DEFSYM (Qtext, "text");
+ DEFSYM (Qboth, "both");
+ DEFSYM (Qboth_horiz, "both-horiz");
+ DEFSYM (Qtext_image_horiz, "text-image-horiz");
+ DEFSYM (QCmap, ":map");
+ DEFSYM (QCpointer, ":pointer");
+ DEFSYM (Qrect, "rect");
+ DEFSYM (Qcircle, "circle");
+ DEFSYM (Qpoly, "poly");
+ DEFSYM (Qmessage_truncate_lines, "message-truncate-lines");
+ DEFSYM (Qgrow_only, "grow-only");
+ DEFSYM (Qinhibit_menubar_update, "inhibit-menubar-update");
+ DEFSYM (Qinhibit_eval_during_redisplay, "inhibit-eval-during-redisplay");
+ DEFSYM (Qposition, "position");
+ DEFSYM (Qbuffer_position, "buffer-position");
+ DEFSYM (Qobject, "object");
+ DEFSYM (Qbar, "bar");
+ DEFSYM (Qhbar, "hbar");
+ DEFSYM (Qbox, "box");
+ DEFSYM (Qhollow, "hollow");
+ DEFSYM (Qhand, "hand");
+ DEFSYM (Qarrow, "arrow");
+ DEFSYM (Qtext, "text");
+ DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces");
list_of_error = Fcons (Fcons (intern_c_string ("error"),
Fcons (intern_c_string ("void-variable"), Qnil)),
Qnil);
staticpro (&list_of_error);
- Qlast_arrow_position = intern_c_string ("last-arrow-position");
- staticpro (&Qlast_arrow_position);
- Qlast_arrow_string = intern_c_string ("last-arrow-string");
- staticpro (&Qlast_arrow_string);
-
- Qoverlay_arrow_string = intern_c_string ("overlay-arrow-string");
- staticpro (&Qoverlay_arrow_string);
- Qoverlay_arrow_bitmap = intern_c_string ("overlay-arrow-bitmap");
- staticpro (&Qoverlay_arrow_bitmap);
+ DEFSYM (Qlast_arrow_position, "last-arrow-position");
+ DEFSYM (Qlast_arrow_string, "last-arrow-string");
+ DEFSYM (Qoverlay_arrow_string, "overlay-arrow-string");
+ DEFSYM (Qoverlay_arrow_bitmap, "overlay-arrow-bitmap");
echo_buffer[0] = echo_buffer[1] = Qnil;
staticpro (&echo_buffer[0]);
@@ -27323,10 +27266,8 @@ syms_of_xdisp (void)
staticpro (&previous_help_echo_string);
help_echo_pos = -1;
- Qright_to_left = intern_c_string ("right-to-left");
- staticpro (&Qright_to_left);
- Qleft_to_right = intern_c_string ("left-to-right");
- staticpro (&Qleft_to_right);
+ DEFSYM (Qright_to_left, "right-to-left");
+ DEFSYM (Qleft_to_right, "left-to-right");
#ifdef HAVE_WINDOW_SYSTEM
DEFVAR_BOOL ("x-stretch-cursor", x_stretch_cursor_p,
@@ -27615,18 +27556,18 @@ 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.
+ 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);
DEFVAR_LISP ("resize-mini-windows", Vresize_mini_windows,
- doc: /* *How to resize mini-windows.
+ doc: /* How to resize mini-windows (the minibuffer and the echo area).
A value of nil means don't automatically resize mini-windows.
A value of t means resize them to fit the text displayed in them.
-A value of `grow-only', the default, means let mini-windows grow
-only, until their display becomes empty, at which point the windows
-go back to their normal size. */);
+A value of `grow-only', the default, means let mini-windows grow only;
+they return to their normal size when the minibuffer is closed, or the
+echo area becomes empty. */);
Vresize_mini_windows = Qgrow_only;
DEFVAR_LISP ("blink-cursor-alist", Vblink_cursor_alist,
@@ -27646,8 +27587,7 @@ the frame's other specifications determine how to blink the cursor off. */);
If non-nil, windows are automatically scrolled horizontally to make
point visible. */);
automatic_hscrolling_p = 1;
- Qauto_hscroll_mode = intern_c_string ("auto-hscroll-mode");
- staticpro (&Qauto_hscroll_mode);
+ 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
@@ -27703,8 +27643,7 @@ property.
To add a prefix to non-continuation lines, use `line-prefix'. */);
Vwrap_prefix = Qnil;
- staticpro (&Qwrap_prefix);
- Qwrap_prefix = intern_c_string ("wrap-prefix");
+ DEFSYM (Qwrap_prefix, "wrap-prefix");
Fmake_variable_buffer_local (Qwrap_prefix);
DEFVAR_LISP ("line-prefix", Vline_prefix,
@@ -27717,8 +27656,7 @@ property.
To add a prefix to continuation lines, use `wrap-prefix'. */);
Vline_prefix = Qnil;
- staticpro (&Qline_prefix);
- Qline_prefix = intern_c_string ("line-prefix");
+ DEFSYM (Qline_prefix, "line-prefix");
Fmake_variable_buffer_local (Qline_prefix);
DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay,
@@ -27811,31 +27749,27 @@ Its value should be an ASCII acronym string, `hex-code', `empty-box', or
void
init_xdisp (void)
{
- Lisp_Object root_window;
- struct window *mini_w;
-
current_header_line_height = current_mode_line_height = -1;
CHARPOS (this_line_start_pos) = 0;
- mini_w = XWINDOW (minibuf_window);
- root_window = FRAME_ROOT_WINDOW (XFRAME (WINDOW_FRAME (mini_w)));
- echo_area_window = minibuf_window;
-
if (!noninteractive)
{
- struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (root_window)));
+ struct window *m = XWINDOW (minibuf_window);
+ Lisp_Object frame = m->frame;
+ struct frame *f = XFRAME (frame);
+ Lisp_Object root = FRAME_ROOT_WINDOW (f);
+ struct window *r = XWINDOW (root);
int i;
- XWINDOW (root_window)->top_line = make_number (FRAME_TOP_MARGIN (f));
- set_window_height (root_window,
- FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f),
- 0);
- mini_w->top_line = make_number (FRAME_LINES (f) - 1);
- set_window_height (minibuf_window, 1, 0);
+ echo_area_window = minibuf_window;
- XWINDOW (root_window)->total_cols = make_number (FRAME_COLS (f));
- mini_w->total_cols = make_number (FRAME_COLS (f));
+ 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));
scratch_glyph_row.glyphs[TEXT_AREA] = scratch_glyphs;
scratch_glyph_row.glyphs[TEXT_AREA + 1]
diff --git a/src/xfaces.c b/src/xfaces.c
index a26289e8a88..c1e75ab3e59 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -463,7 +463,8 @@ 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 int load_pixmap (struct frame *, Lisp_Object, unsigned *, unsigned *);
+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 *);
@@ -535,8 +536,7 @@ int color_count[256];
/* Register color PIXEL as allocated. */
void
-register_color (pixel)
- unsigned long pixel;
+register_color (unsigned long pixel)
{
xassert (pixel < 256);
++color_count[pixel];
@@ -546,8 +546,7 @@ register_color (pixel)
/* Register color PIXEL as deallocated. */
void
-unregister_color (pixel)
- unsigned long pixel;
+unregister_color (unsigned long pixel)
{
xassert (pixel < 256);
if (color_count[pixel] > 0)
@@ -560,9 +559,7 @@ unregister_color (pixel)
/* Register N colors from PIXELS as deallocated. */
void
-unregister_colors (pixels, n)
- unsigned long *pixels;
- int n;
+unregister_colors (unsigned long *pixels, int n)
{
int i;
for (i = 0; i < n; ++i)
@@ -646,7 +643,7 @@ x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap, long unsigned in
/* Create and return a GC for use on frame F. GC values and mask
are given by XGCV and MASK. */
-static INLINE GC
+static inline GC
x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
{
GC gc;
@@ -660,7 +657,7 @@ x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
/* Free GC which was used on frame F. */
-static INLINE void
+static inline void
x_free_gc (struct frame *f, GC gc)
{
eassert (interrupt_input_blocked);
@@ -673,7 +670,7 @@ x_free_gc (struct frame *f, GC gc)
#ifdef WINDOWSNT
/* W32 emulation of GCs */
-static INLINE GC
+static inline GC
x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
{
GC gc;
@@ -687,7 +684,7 @@ x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
/* Free GC which was used on frame F. */
-static INLINE void
+static inline void
x_free_gc (struct frame *f, GC gc)
{
IF_DEBUG (xassert (--ngcs >= 0));
@@ -699,7 +696,7 @@ x_free_gc (struct frame *f, GC gc)
#ifdef HAVE_NS
/* NS emulation of GCs */
-static INLINE GC
+static inline GC
x_create_gc (struct frame *f,
unsigned long mask,
XGCValues *xgcv)
@@ -710,7 +707,7 @@ x_create_gc (struct frame *f,
return gc;
}
-static INLINE void
+static inline void
x_free_gc (struct frame *f, GC gc)
{
xfree (gc);
@@ -746,7 +743,7 @@ xstrcasecmp (const char *s1, const char *s2)
CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
Lisp function definitions. */
-static INLINE struct frame *
+static inline struct frame *
frame_or_selected_frame (Lisp_Object frame, int nparam)
{
if (NILP (frame))
@@ -963,10 +960,10 @@ the pixmap. Bits are stored row by row, each row occupies
zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
if these pointers are not null. */
-static int
+static ptrdiff_t
load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr, unsigned int *h_ptr)
{
- int bitmap_id;
+ ptrdiff_t bitmap_id;
if (NILP (name))
return 0;
@@ -1858,8 +1855,7 @@ the WIDTH times as wide as FACE on FRAME. */)
/* Check consistency of Lisp face attribute vector ATTRS. */
static void
-check_lface_attrs (attrs)
- Lisp_Object *attrs;
+check_lface_attrs (Lisp_Object *attrs)
{
xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
@@ -1930,8 +1926,7 @@ check_lface_attrs (attrs)
/* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
static void
-check_lface (lface)
- Lisp_Object lface;
+check_lface (Lisp_Object lface)
{
if (!NILP (lface))
{
@@ -1976,7 +1971,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 inline 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,
@@ -2008,24 +2003,6 @@ push_named_merge_point (struct named_merge_point *new_named_merge_point,
}
-
-#if 0 /* Seems to be unused. */
-static Lisp_Object
-internal_resolve_face_name (nargs, args)
- int nargs;
- Lisp_Object *args;
-{
- return Fget (args[0], args[1]);
-}
-
-static Lisp_Object
-resolve_face_name_error (ignore)
- Lisp_Object ignore;
-{
- return Qnil;
-}
-#endif
-
/* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
to make it a symbol. If FACE_NAME is an alias for another face,
return that face's name.
@@ -2078,7 +2055,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 inline Lisp_Object
lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, int signal_p)
{
Lisp_Object lface;
@@ -2106,7 +2083,7 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, int sig
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 inline 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);
@@ -2120,7 +2097,7 @@ lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p)
is non-zero, signal an error if FACE_NAME does not name a face.
Otherwise, value is zero if FACE_NAME is not a face. */
-static INLINE int
+static inline int
get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p)
{
Lisp_Object lface;
@@ -2141,7 +2118,7 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, Lisp_Obje
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 inline int
get_lface_attributes (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p, struct named_merge_point *named_merge_points)
{
Lisp_Object face_remapping;
@@ -2307,7 +2284,7 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
loops in face inheritance/remapping; it should be 0 when called from
other places. */
-static INLINE void
+static inline void
merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to, struct named_merge_point *named_merge_points)
{
int i;
@@ -3832,6 +3809,18 @@ Default face attributes override any local face attributes. */)
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name),
Qnil));
}
+
+ if (STRINGP (gvec[LFACE_FOREGROUND_INDEX]))
+ Fmodify_frame_parameters (frame,
+ Fcons (Fcons (Qforeground_color,
+ gvec[LFACE_FOREGROUND_INDEX]),
+ Qnil));
+
+ if (STRINGP (gvec[LFACE_BACKGROUND_INDEX]))
+ Fmodify_frame_parameters (frame,
+ Fcons (Fcons (Qbackground_color,
+ gvec[LFACE_BACKGROUND_INDEX]),
+ Qnil));
}
}
@@ -3903,7 +3892,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 inline int
face_attr_equal_p (Lisp_Object v1, Lisp_Object v2)
{
/* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
@@ -3936,7 +3925,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 inline int
lface_equal_p (Lisp_Object *v1, Lisp_Object *v2)
{
int i, equal_p = 1;
@@ -4021,7 +4010,7 @@ For internal use only. */)
/* Return a hash code for Lisp string STRING with case ignored. Used
below in computing a hash value for a Lisp face. */
-static INLINE unsigned
+static inline unsigned
hash_string_case_insensitive (Lisp_Object string)
{
const unsigned char *s;
@@ -4035,7 +4024,7 @@ hash_string_case_insensitive (Lisp_Object string)
/* Return a hash code for face attribute vector V. */
-static INLINE unsigned
+static inline unsigned
lface_hash (Lisp_Object *v)
{
return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
@@ -4054,7 +4043,7 @@ lface_hash (Lisp_Object *v)
family, point size, weight, width, slant, and font. Both
LFACE1 and LFACE2 must be fully-specified. */
-static INLINE int
+static inline int
lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2)
{
xassert (lface_fully_specified_p (lface1)
@@ -4399,6 +4388,21 @@ cache_face (struct face_cache *c, struct face *face, unsigned int hash)
break;
face->id = i;
+#if GLYPH_DEBUG
+ /* Check that FACE got a unique id. */
+ {
+ int j, n;
+ struct face *face1;
+
+ for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
+ for (face1 = c->buckets[j]; face1; face1 = face1->next)
+ if (face1->id == i)
+ ++n;
+
+ xassert (n == 1);
+ }
+#endif /* GLYPH_DEBUG */
+
/* Maybe enlarge C->faces_by_id. */
if (i == c->used)
{
@@ -4415,21 +4419,6 @@ cache_face (struct face_cache *c, struct face *face, unsigned int hash)
c->used++;
}
-#if GLYPH_DEBUG
- /* Check that FACE got a unique id. */
- {
- int j, n;
- struct face *face;
-
- for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
- for (face = c->buckets[j]; face; face = face->next)
- if (face->id == i)
- ++n;
-
- xassert (n == 1);
- }
-#endif /* GLYPH_DEBUG */
-
c->faces_by_id[i] = face;
}
@@ -4460,7 +4449,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 inline int
lookup_face (struct frame *f, Lisp_Object *attr)
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
@@ -5954,7 +5943,7 @@ face_at_buffer_position (struct window *w, EMACS_INT pos,
struct frame *f = XFRAME (w->frame);
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object prop, position;
- int i, noverlays;
+ ptrdiff_t i, noverlays;
Lisp_Object *overlay_vec;
Lisp_Object frame;
EMACS_INT endpos;
@@ -6223,7 +6212,8 @@ face_at_string_position (struct window *w, Lisp_Object string,
*/
int
-merge_faces (struct frame *f, Lisp_Object face_name, int face_id, int base_face_id)
+merge_faces (struct frame *f, Lisp_Object face_name, EMACS_INT face_id,
+ int base_face_id)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
struct face *base_face;
@@ -6330,8 +6320,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
/* Print the contents of the realized face FACE to stderr. */
static void
-dump_realized_face (face)
- struct face *face;
+dump_realized_face (struct face *face)
{
fprintf (stderr, "ID: %d\n", face->id);
#ifdef HAVE_X_WINDOWS
@@ -6412,153 +6401,82 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
void
syms_of_xfaces (void)
{
- Qface = intern_c_string ("face");
- staticpro (&Qface);
- Qface_no_inherit = intern_c_string ("face-no-inherit");
- staticpro (&Qface_no_inherit);
- Qbitmap_spec_p = intern_c_string ("bitmap-spec-p");
- staticpro (&Qbitmap_spec_p);
- Qframe_set_background_mode = intern_c_string ("frame-set-background-mode");
- staticpro (&Qframe_set_background_mode);
+ DEFSYM (Qface, "face");
+ DEFSYM (Qface_no_inherit, "face-no-inherit");
+ DEFSYM (Qbitmap_spec_p, "bitmap-spec-p");
+ DEFSYM (Qframe_set_background_mode, "frame-set-background-mode");
/* Lisp face attribute keywords. */
- QCfamily = intern_c_string (":family");
- staticpro (&QCfamily);
- QCheight = intern_c_string (":height");
- staticpro (&QCheight);
- QCweight = intern_c_string (":weight");
- staticpro (&QCweight);
- QCslant = intern_c_string (":slant");
- staticpro (&QCslant);
- QCunderline = intern_c_string (":underline");
- staticpro (&QCunderline);
- QCinverse_video = intern_c_string (":inverse-video");
- staticpro (&QCinverse_video);
- QCreverse_video = intern_c_string (":reverse-video");
- staticpro (&QCreverse_video);
- QCforeground = intern_c_string (":foreground");
- staticpro (&QCforeground);
- QCbackground = intern_c_string (":background");
- staticpro (&QCbackground);
- QCstipple = intern_c_string (":stipple");
- staticpro (&QCstipple);
- QCwidth = intern_c_string (":width");
- staticpro (&QCwidth);
- QCfont = intern_c_string (":font");
- staticpro (&QCfont);
- QCfontset = intern_c_string (":fontset");
- staticpro (&QCfontset);
- QCbold = intern_c_string (":bold");
- staticpro (&QCbold);
- QCitalic = intern_c_string (":italic");
- staticpro (&QCitalic);
- QCoverline = intern_c_string (":overline");
- staticpro (&QCoverline);
- QCstrike_through = intern_c_string (":strike-through");
- staticpro (&QCstrike_through);
- QCbox = intern_c_string (":box");
- staticpro (&QCbox);
- QCinherit = intern_c_string (":inherit");
- staticpro (&QCinherit);
+ DEFSYM (QCfamily, ":family");
+ DEFSYM (QCheight, ":height");
+ DEFSYM (QCweight, ":weight");
+ DEFSYM (QCslant, ":slant");
+ DEFSYM (QCunderline, ":underline");
+ DEFSYM (QCinverse_video, ":inverse-video");
+ DEFSYM (QCreverse_video, ":reverse-video");
+ DEFSYM (QCforeground, ":foreground");
+ DEFSYM (QCbackground, ":background");
+ DEFSYM (QCstipple, ":stipple");
+ DEFSYM (QCwidth, ":width");
+ DEFSYM (QCfont, ":font");
+ DEFSYM (QCfontset, ":fontset");
+ DEFSYM (QCbold, ":bold");
+ DEFSYM (QCitalic, ":italic");
+ DEFSYM (QCoverline, ":overline");
+ DEFSYM (QCstrike_through, ":strike-through");
+ DEFSYM (QCbox, ":box");
+ DEFSYM (QCinherit, ":inherit");
/* Symbols used for Lisp face attribute values. */
- QCcolor = intern_c_string (":color");
- staticpro (&QCcolor);
- QCline_width = intern_c_string (":line-width");
- staticpro (&QCline_width);
- QCstyle = intern_c_string (":style");
- staticpro (&QCstyle);
- Qreleased_button = intern_c_string ("released-button");
- staticpro (&Qreleased_button);
- Qpressed_button = intern_c_string ("pressed-button");
- staticpro (&Qpressed_button);
- Qnormal = intern_c_string ("normal");
- staticpro (&Qnormal);
- Qultra_light = intern_c_string ("ultra-light");
- staticpro (&Qultra_light);
- Qextra_light = intern_c_string ("extra-light");
- staticpro (&Qextra_light);
- Qlight = intern_c_string ("light");
- staticpro (&Qlight);
- Qsemi_light = intern_c_string ("semi-light");
- staticpro (&Qsemi_light);
- Qsemi_bold = intern_c_string ("semi-bold");
- staticpro (&Qsemi_bold);
- Qbold = intern_c_string ("bold");
- staticpro (&Qbold);
- Qextra_bold = intern_c_string ("extra-bold");
- staticpro (&Qextra_bold);
- Qultra_bold = intern_c_string ("ultra-bold");
- staticpro (&Qultra_bold);
- Qoblique = intern_c_string ("oblique");
- staticpro (&Qoblique);
- Qitalic = intern_c_string ("italic");
- staticpro (&Qitalic);
- Qreverse_oblique = intern_c_string ("reverse-oblique");
- staticpro (&Qreverse_oblique);
- Qreverse_italic = intern_c_string ("reverse-italic");
- staticpro (&Qreverse_italic);
- Qultra_condensed = intern_c_string ("ultra-condensed");
- staticpro (&Qultra_condensed);
- Qextra_condensed = intern_c_string ("extra-condensed");
- staticpro (&Qextra_condensed);
- Qcondensed = intern_c_string ("condensed");
- staticpro (&Qcondensed);
- Qsemi_condensed = intern_c_string ("semi-condensed");
- staticpro (&Qsemi_condensed);
- Qsemi_expanded = intern_c_string ("semi-expanded");
- staticpro (&Qsemi_expanded);
- Qexpanded = intern_c_string ("expanded");
- staticpro (&Qexpanded);
- Qextra_expanded = intern_c_string ("extra-expanded");
- staticpro (&Qextra_expanded);
- Qultra_expanded = intern_c_string ("ultra-expanded");
- staticpro (&Qultra_expanded);
- Qbackground_color = intern_c_string ("background-color");
- staticpro (&Qbackground_color);
- Qforeground_color = intern_c_string ("foreground-color");
- staticpro (&Qforeground_color);
- Qunspecified = intern_c_string ("unspecified");
- staticpro (&Qunspecified);
- Qignore_defface = intern_c_string (":ignore-defface");
- staticpro (&Qignore_defface);
-
- Qface_alias = intern_c_string ("face-alias");
- staticpro (&Qface_alias);
- Qdefault = intern_c_string ("default");
- staticpro (&Qdefault);
- Qtool_bar = intern_c_string ("tool-bar");
- staticpro (&Qtool_bar);
- Qregion = intern_c_string ("region");
- staticpro (&Qregion);
- Qfringe = intern_c_string ("fringe");
- staticpro (&Qfringe);
- Qheader_line = intern_c_string ("header-line");
- staticpro (&Qheader_line);
- Qscroll_bar = intern_c_string ("scroll-bar");
- staticpro (&Qscroll_bar);
- Qmenu = intern_c_string ("menu");
- staticpro (&Qmenu);
- Qcursor = intern_c_string ("cursor");
- staticpro (&Qcursor);
- Qborder = intern_c_string ("border");
- staticpro (&Qborder);
- Qmouse = intern_c_string ("mouse");
- staticpro (&Qmouse);
- Qmode_line_inactive = intern_c_string ("mode-line-inactive");
- staticpro (&Qmode_line_inactive);
- Qvertical_border = intern_c_string ("vertical-border");
- staticpro (&Qvertical_border);
- Qtty_color_desc = intern_c_string ("tty-color-desc");
- staticpro (&Qtty_color_desc);
- Qtty_color_standard_values = intern_c_string ("tty-color-standard-values");
- staticpro (&Qtty_color_standard_values);
- Qtty_color_by_index = intern_c_string ("tty-color-by-index");
- staticpro (&Qtty_color_by_index);
- Qtty_color_alist = intern_c_string ("tty-color-alist");
- staticpro (&Qtty_color_alist);
- Qscalable_fonts_allowed = intern_c_string ("scalable-fonts-allowed");
- staticpro (&Qscalable_fonts_allowed);
+ DEFSYM (QCcolor, ":color");
+ DEFSYM (QCline_width, ":line-width");
+ DEFSYM (QCstyle, ":style");
+ 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");
+ DEFSYM (Qsemi_bold, "semi-bold");
+ DEFSYM (Qbold, "bold");
+ DEFSYM (Qextra_bold, "extra-bold");
+ 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");
+ DEFSYM (Qignore_defface, ":ignore-defface");
+
+ DEFSYM (Qface_alias, "face-alias");
+ DEFSYM (Qdefault, "default");
+ DEFSYM (Qtool_bar, "tool-bar");
+ DEFSYM (Qregion, "region");
+ DEFSYM (Qfringe, "fringe");
+ DEFSYM (Qheader_line, "header-line");
+ DEFSYM (Qscroll_bar, "scroll-bar");
+ DEFSYM (Qmenu, "menu");
+ DEFSYM (Qcursor, "cursor");
+ DEFSYM (Qborder, "border");
+ DEFSYM (Qmouse, "mouse");
+ DEFSYM (Qmode_line_inactive, "mode-line-inactive");
+ DEFSYM (Qvertical_border, "vertical-border");
+ DEFSYM (Qtty_color_desc, "tty-color-desc");
+ DEFSYM (Qtty_color_standard_values, "tty-color-standard-values");
+ DEFSYM (Qtty_color_by_index, "tty-color-by-index");
+ DEFSYM (Qtty_color_alist, "tty-color-alist");
+ DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed");
Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
staticpro (&Vparam_value_alist);
diff --git a/src/xfns.c b/src/xfns.c
index f3dc493ff85..0d1e4a1bb5e 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -145,7 +145,7 @@ static Lisp_Object Qcompound_text, Qcancel_timer;
Lisp_Object Qfont_param;
#if GLYPH_DEBUG
-int image_cache_refcount, dpyinfo_refcount;
+static int image_cache_refcount, dpyinfo_refcount;
#endif
#if defined (USE_GTK) && defined (HAVE_FREETYPE)
@@ -1074,8 +1074,7 @@ x_set_border_pixel (struct frame *f, int pix)
if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
{
BLOCK_INPUT;
- XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- (unsigned long)pix);
+ XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), pix);
UNBLOCK_INPUT;
if (FRAME_VISIBLE_P (f))
@@ -1227,7 +1226,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
#else /* not USE_X_TOOLKIT && not USE_GTK */
FRAME_MENU_BAR_LINES (f) = nlines;
- change_window_heights (f->root_window, nlines - olines);
+ resize_frame_windows (f, FRAME_LINES (f), 0);
/* If the menu bar height gets changed, the internal border below
the top margin has to be cleared. Also, if the menu bar gets
@@ -1266,6 +1265,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
#endif /* not USE_X_TOOLKIT && not USE_GTK */
adjust_glyphs (f);
+ run_window_configuration_change_hook (f);
}
@@ -1326,7 +1326,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
FRAME_TOOL_BAR_LINES (f) = nlines;
- change_window_heights (root_window, delta);
+ resize_frame_windows (f, FRAME_LINES (f), 0);
adjust_glyphs (f);
/* We also have to make sure that the internal border at the top of
@@ -1362,6 +1362,9 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
if (WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
}
+
+ run_window_configuration_change_hook (f);
+
}
@@ -1695,10 +1698,14 @@ void
x_set_scroll_bar_default_width (struct frame *f)
{
int wid = FRAME_COLUMN_WIDTH (f);
-
#ifdef USE_TOOLKIT_SCROLL_BARS
+#ifdef USE_GTK
+ int minw = xg_get_default_scrollbar_width ();
+#else
+ int minw = 16;
+#endif
/* A minimum width of 14 doesn't look good for toolkit scroll bars. */
- int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
+ int width = minw + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
#else
@@ -1876,7 +1883,7 @@ xic_create_fontsetname (const char *base_fontname, int motif)
/* Make a fontset name from the base font name. */
if (xic_defaut_fontset == base_fontname)
{ /* There is no base font name, use the default. */
- int len = strlen (base_fontname) + 2;
+ ptrdiff_t len = strlen (base_fontname) + 2;
fontsetname = xmalloc (len);
memset (fontsetname, 0, len);
strcpy (fontsetname, base_fontname);
@@ -1889,7 +1896,7 @@ xic_create_fontsetname (const char *base_fontname, int motif)
- the base font where the charset spec is replaced by -*-*.
- the same but with the family also replaced with -*-*-. */
const char *p = base_fontname;
- int i;
+ ptrdiff_t i;
for (i = 0; *p; p++)
if (*p == '-') i++;
@@ -1897,7 +1904,8 @@ xic_create_fontsetname (const char *base_fontname, int motif)
{ /* 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. */
- int len = strlen (base_fontname) + strlen (xic_defaut_fontset) + 3;
+ ptrdiff_t len =
+ strlen (base_fontname) + strlen (xic_defaut_fontset) + 3;
fontsetname = xmalloc (len);
memset (fontsetname, 0, len);
strcpy (fontsetname, base_fontname);
@@ -1906,7 +1914,7 @@ xic_create_fontsetname (const char *base_fontname, int motif)
}
else
{
- int len;
+ ptrdiff_t len;
const char *p1 = NULL, *p2 = NULL, *p3 = NULL;
char *font_allcs = NULL;
char *font_allfamilies = NULL;
@@ -1933,7 +1941,7 @@ xic_create_fontsetname (const char *base_fontname, int motif)
wildcard. */
if (*p3 != '*')
{
- int diff = (p2 - p3) - 2;
+ ptrdiff_t diff = (p2 - p3) - 2;
base = alloca (strlen (base_fontname) + 1);
memcpy (base, base_fontname, p3 - base_fontname);
@@ -1993,11 +2001,8 @@ xic_create_fontsetname (const char *base_fontname, int motif)
#ifdef DEBUG_XIC_FONTSET
static void
-print_fontset_result (xfs, name, missing_list, missing_count)
- XFontSet xfs;
- char *name;
- char **missing_list;
- int missing_count;
+print_fontset_result (XFontSet xfs, char *name, char **missing_list,
+ int missing_count)
{
if (xfs)
fprintf (stderr, "XIC Fontset created: %s\n", name);
@@ -2427,7 +2432,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
/* Do some needed geometry management. */
{
- int len;
+ ptrdiff_t len;
char *tem, shell_position[32];
Arg gal[10];
int gac = 0;
@@ -2919,7 +2924,7 @@ unwind_create_frame (Lisp_Object frame)
/* If frame is ``official'', nothing to do. */
if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
{
-#if GLYPH_DEBUG
+#if GLYPH_DEBUG && XASSERTS
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
@@ -3149,10 +3154,6 @@ This function is an internal primitive--use `make-frame' instead. */)
/* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
record_unwind_protect (unwind_create_frame, frame);
-#if GLYPH_DEBUG
- image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
- dpyinfo_refcount = dpyinfo->reference_count;
-#endif /* GLYPH_DEBUG */
/* These colors will be set anyway later, but it's important
to get the color reference counts right, so initialize them! */
@@ -3307,6 +3308,11 @@ This function is an internal primitive--use `make-frame' instead. */)
happen. */
init_frame_faces (f);
+#if GLYPH_DEBUG
+ image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
+ dpyinfo_refcount = dpyinfo->reference_count;
+#endif /* GLYPH_DEBUG */
+
/* The X resources controlling the menu-bar and tool-bar are
processed specially at startup, and reflected in the mode
variables; ignore them here. */
@@ -4295,18 +4301,9 @@ no value of TYPE (always string in the MS Windows case). */)
if (! NILP (source))
{
- if (NUMBERP (source))
- {
- if (FLOATP (source))
- target_window = (Window) XFLOAT (source);
- else
- target_window = XFASTINT (source);
-
- if (target_window == 0)
- target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
- }
- else if (CONSP (source))
- target_window = cons_to_long (source);
+ CONS_TO_INTEGER (source, Window, target_window);
+ if (! target_window)
+ target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
}
BLOCK_INPUT;
@@ -4608,10 +4605,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
#endif /* USE_TOOLKIT_SCROLL_BARS */
f->icon_name = Qnil;
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
-#if GLYPH_DEBUG
- image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
- dpyinfo_refcount = dpyinfo->reference_count;
-#endif /* GLYPH_DEBUG */
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
f->output_data.x->explicit_parent = 0;
@@ -4723,6 +4716,11 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
happen. */
init_frame_faces (f);
+#if GLYPH_DEBUG
+ image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
+ dpyinfo_refcount = dpyinfo->reference_count;
+#endif /* GLYPH_DEBUG */
+
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
x_figure_window_size (f, parms, 0);
@@ -5796,25 +5794,14 @@ 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 &&&*/
- Qnone = intern_c_string ("none");
- staticpro (&Qnone);
- Qsuppress_icon = intern_c_string ("suppress-icon");
- staticpro (&Qsuppress_icon);
- Qundefined_color = intern_c_string ("undefined-color");
- staticpro (&Qundefined_color);
- Qcompound_text = intern_c_string ("compound-text");
- staticpro (&Qcompound_text);
- Qcancel_timer = intern_c_string ("cancel-timer");
- staticpro (&Qcancel_timer);
- Qfont_param = intern_c_string ("font-parameter");
- staticpro (&Qfont_param);
+ DEFSYM (Qnone, "none");
+ DEFSYM (Qsuppress_icon, "suppress-icon");
+ DEFSYM (Qundefined_color, "undefined-color");
+ DEFSYM (Qcompound_text, "compound-text");
+ DEFSYM (Qcancel_timer, "cancel-timer");
+ DEFSYM (Qfont_param, "font-parameter");
/* This is the end of symbol initialization. */
- /* Text property `display' should be nonsticky by default. */
- Vtext_property_default_nonsticky
- = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
-
-
Fput (Qundefined_color, Qerror_conditions,
pure_cons (Qundefined_color, pure_cons (Qerror, Qnil)));
Fput (Qundefined_color, Qerror_message,
diff --git a/src/xfont.c b/src/xfont.c
index 5dd6aae3846..2c3ca911623 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -594,16 +594,14 @@ xfont_match (Lisp_Object frame, Lisp_Object spec)
{
if (XGetFontProperty (xfont, XA_FONT, &value))
{
- int len;
char *s;
s = (char *) XGetAtomName (display, (Atom) value);
- len = strlen (s);
/* If DXPC (a Differential X Protocol Compressor)
Ver.3.7 is running, XGetAtomName will return null
string. We must avoid such a name. */
- if (len > 0)
+ if (*s)
{
entity = font_make_entity ();
ASET (entity, FONT_TYPE_INDEX, Qx);
diff --git a/src/xgselect.c b/src/xgselect.c
index 0d154f6496a..9ccdd37489f 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -15,14 +15,14 @@ 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/>. */
+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)
+#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
#include <glib.h>
#include <errno.h>
@@ -149,13 +149,13 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
return retval;
}
-#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
+#endif /* USE_GTK || HAVE_GCONF || HAVE_GSETTINGS */
void
xgselect_initialize (void)
{
-#if defined (USE_GTK) || defined (HAVE_GCONF)
+#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
gfds_size = 128;
gfds = xmalloc (sizeof (*gfds)*gfds_size);
-#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
+#endif
}
diff --git a/src/xmenu.c b/src/xmenu.c
index 2a4359fa84a..b4338c1d653 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -240,7 +240,7 @@ for instance using the window manager, then this produces a quit and
FRAME_PTR new_f = SELECTED_FRAME ();
Lisp_Object bar_window;
enum scroll_bar_part part;
- unsigned long time;
+ Time time;
Lisp_Object x, y;
(*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
@@ -347,6 +347,8 @@ for instance using the window manager, then this produces a quit and
#ifndef MSDOS
+#if defined USE_GTK || defined USE_MOTIF
+
/* Set menu_items_inuse so no other popup menu or dialog is created. */
void
@@ -360,6 +362,8 @@ x_menu_set_in_use (int in_use)
#endif
}
+#endif
+
/* Wait for an X event to arrive or for a timer to expire. */
#ifndef USE_MOTIF
@@ -736,10 +740,13 @@ menu_highlight_callback (GtkWidget *widget, gpointer call_data)
help = call_data ? cb_data->help : Qnil;
/* If popup_activated_flag is greater than 1 we are in a popup menu.
- Don't show help for them, they won't appear before the
- popup is popped down. */
- if (popup_activated_flag <= 1)
- show_help_event (cb_data->cl_data->f, widget, help);
+ Don't pass the frame to show_help_event for those.
+ Passing frame creates an Emacs event. As we are looping in
+ popup_widget_loop, it won't be handeled. Passing NULL shows the tip
+ directly without using an Emacs event. This is what the Lucid code
+ does below. */
+ show_help_event (popup_activated_flag <= 1 ? cb_data->cl_data->f : NULL,
+ widget, help);
}
#else
static void
@@ -922,7 +929,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
#endif
Lisp_Object items;
widget_value *wv, *first_wv, *prev_wv = 0;
- EMACS_UINT i, last_i = 0;
+ int i;
int *submenu_start, *submenu_end;
int *submenu_top_level_items, *submenu_n_panes;
@@ -966,7 +973,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
Lisp_Object *previous_items
= (Lisp_Object *) alloca (previous_menu_items_used
* sizeof (Lisp_Object));
- EMACS_UINT subitems;
+ int subitems;
/* If we are making a new widget, its contents are empty,
do always reinitialize them. */
@@ -1012,7 +1019,7 @@ 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 * sizeof (int));
+ 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));
@@ -1021,8 +1028,6 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
{
Lisp_Object key, string, maps;
- last_i = i;
-
key = XVECTOR (items)->contents[4 * i];
string = XVECTOR (items)->contents[4 * i + 1];
maps = XVECTOR (items)->contents[4 * i + 2];
@@ -1039,6 +1044,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
submenu_end[i] = menu_items_used;
}
+ submenu_start[i] = -1;
finish_menu_items ();
/* Convert menu_items into widget_value trees
@@ -1052,7 +1058,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
wv->help = Qnil;
first_wv = wv;
- for (i = 0; i < last_i; i++)
+ for (i = 0; 0 <= submenu_start[i]; i++)
{
menu_items_n_panes = submenu_n_panes[i];
wv = digest_single_submenu (submenu_start[i], submenu_end[i],
@@ -1421,7 +1427,8 @@ pop_down_menu (Lisp_Object arg)
menu pops down.
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, EMACS_UINT timestamp)
+create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y,
+ int for_click, Time timestamp)
{
int i;
GtkWidget *menu;
@@ -1465,7 +1472,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y, i
gtk_widget_show_all (menu);
gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i,
- timestamp > 0 ? timestamp : gtk_get_current_event_time());
+ timestamp ? timestamp : gtk_get_current_event_time ());
record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
@@ -1525,7 +1532,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, EMACS_UINT timestamp)
+ int x, int y, int for_click, Time timestamp)
{
int i;
Arg av[2];
@@ -1599,7 +1606,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
Lisp_Object
xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
- Lisp_Object title, const char **error_name, EMACS_UINT timestamp)
+ Lisp_Object title, const char **error_name, Time timestamp)
{
int i;
widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
@@ -1919,9 +1926,9 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
static void
dialog_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
{
- /* The EMACS_INT cast avoids a warning. There's no problem
+ /* Treat the pointer as an integer. There's no problem
as long as pointers have enough bits to hold small integers. */
- if ((int) (EMACS_INT) client_data != -1)
+ if ((intptr_t) client_data != -1)
menu_item_selection = (Lisp_Object *) client_data;
BLOCK_INPUT;
@@ -2242,7 +2249,7 @@ pop_down_menu (Lisp_Object arg)
Lisp_Object
xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
- Lisp_Object title, const char **error_name, EMACS_UINT timestamp)
+ Lisp_Object title, const char **error_name, Time timestamp)
{
Window root;
XMenu *menu;
@@ -2555,8 +2562,7 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_
void
syms_of_xmenu (void)
{
- Qdebug_on_next_call = intern_c_string ("debug-on-next-call");
- staticpro (&Qdebug_on_next_call);
+ DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
#ifdef USE_X_TOOLKIT
widget_id_tick = (1<<16);
diff --git a/src/xrdb.c b/src/xrdb.c
index b490afdabaa..6a16e3260bd 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -120,20 +120,20 @@ x_get_customization_string (XrmDatabase db, const char *name,
refers to %L only when the LANG environment variable is set, or
otherwise provided by X.
- ESCAPED_SUFFIX and SUFFIX are postpended to STRING if they are
- non-zero. %-escapes in ESCAPED_SUFFIX are expanded; STRING is left
- alone.
+ ESCAPED_SUFFIX is postpended to STRING if it is non-zero.
+ %-escapes in ESCAPED_SUFFIX are expanded.
Return NULL otherwise. */
static char *
-magic_file_p (const char *string, EMACS_INT string_len, const char *class, const char *escaped_suffix, const char *suffix)
+magic_file_p (const char *string, EMACS_INT string_len, const char *class,
+ const char *escaped_suffix)
{
char *lang = getenv ("LANG");
- int path_size = 100;
+ ptrdiff_t path_size = 100;
char *path = (char *) xmalloc (path_size);
- int path_len = 0;
+ ptrdiff_t path_len = 0;
const char *p = string;
@@ -141,7 +141,7 @@ magic_file_p (const char *string, EMACS_INT string_len, const char *class, const
{
/* The chunk we're about to stick on the end of result. */
const char *next = NULL;
- int next_len;
+ ptrdiff_t next_len;
if (*p == '%')
{
@@ -201,8 +201,10 @@ magic_file_p (const char *string, EMACS_INT string_len, const char *class, const
next = p, next_len = 1;
/* Do we have room for this component followed by a '\0' ? */
- if (path_len + next_len + 1 > path_size)
+ if (path_size - path_len <= next_len)
{
+ 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);
}
@@ -222,21 +224,6 @@ magic_file_p (const char *string, EMACS_INT string_len, const char *class, const
}
}
- /* Perhaps we should add the SUFFIX now. */
- if (suffix)
- {
- int suffix_len = strlen (suffix);
-
- if (path_len + suffix_len + 1 > path_size)
- {
- path_size = (path_len + suffix_len + 1);
- path = (char *) xrealloc (path, path_size);
- }
-
- memcpy (path + path_len, suffix, suffix_len);
- path_len += suffix_len;
- }
-
path[path_len] = '\0';
if (! file_p (path))
@@ -295,7 +282,8 @@ file_p (const char *filename)
the path name of the one we found otherwise. */
static char *
-search_magic_path (const char *search_path, const char *class, const char *escaped_suffix, const char *suffix)
+search_magic_path (const char *search_path, const char *class,
+ const char *escaped_suffix)
{
const char *s, *p;
@@ -306,8 +294,7 @@ search_magic_path (const char *search_path, const char *class, const char *escap
if (p > s)
{
- char *path = magic_file_p (s, p - s, class, escaped_suffix,
- suffix);
+ char *path = magic_file_p (s, p - s, class, escaped_suffix);
if (path)
return path;
}
@@ -316,7 +303,7 @@ search_magic_path (const char *search_path, const char *class, const char *escap
char *path;
s = "%N%S";
- path = magic_file_p (s, strlen (s), class, escaped_suffix, suffix);
+ path = magic_file_p (s, strlen (s), class, escaped_suffix);
if (path)
return path;
}
@@ -340,7 +327,7 @@ get_system_app (const char *class)
path = getenv ("XFILESEARCHPATH");
if (! path) path = PATH_X_DEFAULTS;
- p = search_magic_path (path, class, 0, 0);
+ p = search_magic_path (path, class, 0);
if (p)
{
db = XrmGetFileDatabase (p);
@@ -368,19 +355,19 @@ get_user_app (const char *class)
/* Check for XUSERFILESEARCHPATH. It is a path of complete file
names, not directories. */
if (((path = getenv ("XUSERFILESEARCHPATH"))
- && (file = search_magic_path (path, class, 0, 0)))
+ && (file = search_magic_path (path, class, 0)))
/* 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", 0))
- || (file = search_magic_path (path, class, "/%N", 0))))
+ && ((file = search_magic_path (path, class, "/%L/%N"))
+ || (file = search_magic_path (path, class, "/%N"))))
/* 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", 0))
- || (file = search_magic_path (free_it, class, "%N", 0)))))
+ ((file = search_magic_path (free_it, class, "%L/%N"))
+ || (file = search_magic_path (free_it, class, "%N")))))
{
XrmDatabase db = XrmGetFileDatabase (file);
xfree (file);
@@ -664,9 +651,7 @@ typedef char **List;
#define free_arglist(list)
static List
-member (elt, list)
- char *elt;
- List list;
+member (char *elt, List list)
{
List p;
@@ -678,20 +663,17 @@ member (elt, list)
}
static void
-fatal (msg, prog, x1, x2, x3, x4, x5)
- char *msg, *prog;
- int x1, x2, x3, x4, x5;
+fatal (char *msg, char *prog)
{
- if (errno)
- perror (prog);
+ if (errno)
+ perror (prog);
- (void) fprintf (stderr, msg, prog, x1, x2, x3, x4, x5);
- exit (1);
+ (void) fprintf (stderr, msg, prog);
+ exit (1);
}
-main (argc, argv)
- int argc;
- char **argv;
+int
+main (int argc, char **argv)
{
Display *display;
char *displayname, *resource_string, *class, *name;
@@ -762,5 +744,7 @@ main (argc, argv)
printf ("\tExit.\n\n");
XCloseDisplay (display);
+
+ return 0;
}
#endif /* TESTRM */
diff --git a/src/xselect.c b/src/xselect.c
index f11fc40fce8..5e5bdb55eca 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Rewritten by jwz */
#include <config.h>
+#include <limits.h>
#include <stdio.h> /* termhooks.h needs this */
#include <setjmp.h>
@@ -38,32 +39,33 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "process.h"
#include "termhooks.h"
#include "keyboard.h"
+#include "character.h"
#include <X11/Xproto.h>
struct prop_location;
+struct selection_data;
static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
-static Atom symbol_to_x_atom (struct x_display_info *, Display *,
- Lisp_Object);
-static void x_own_selection (Lisp_Object, Lisp_Object);
-static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int);
+static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object);
+static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object);
+static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int,
+ struct x_display_info *);
static void x_decline_selection_request (struct input_event *);
static Lisp_Object x_selection_request_lisp_error (Lisp_Object);
static Lisp_Object queue_selection_requests_unwind (Lisp_Object);
-static Lisp_Object some_frame_on_display (struct x_display_info *);
static Lisp_Object x_catch_errors_unwind (Lisp_Object);
-static void x_reply_selection_request (struct input_event *, int,
- unsigned char *, int, Atom);
+static void x_reply_selection_request (struct input_event *, struct x_display_info *);
+static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
+ Atom, int, struct x_display_info *);
static int waiting_for_other_props_on_window (Display *, Window);
static struct prop_location *expect_property_change (Display *, Window,
Atom, int);
static void unexpect_property_change (struct prop_location *);
static Lisp_Object wait_for_property_change_unwind (Lisp_Object);
static void wait_for_property_change (struct prop_location *);
-static Lisp_Object x_get_foreign_selection (Lisp_Object,
- Lisp_Object,
- Lisp_Object);
+static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
static void x_get_window_property (Display *, Window, Atom,
unsigned char **, int *,
Atom *, int *, unsigned long *, int);
@@ -102,7 +104,7 @@ static Lisp_Object clean_local_selection_data (Lisp_Object);
static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
- QATOM_PAIR;
+ QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS;
static Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
static Lisp_Object QUTF8_STRING; /* This is a type of selection. */
@@ -110,6 +112,7 @@ static Lisp_Object QUTF8_STRING; /* This is a type of selection. */
static Lisp_Object Qcompound_text_with_extensions;
static Lisp_Object Qforeign_selection;
+static Lisp_Object Qx_lost_selection_functions, Qx_sent_selection_functions;
/* If this is a smaller number than the max-request-size of the display,
emacs will use INCR selection transfer when the selection is larger
@@ -121,24 +124,8 @@ static Lisp_Object Qforeign_selection;
#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
-/* The timestamp of the last input event Emacs received from the X server. */
-/* Defined in keyboard.c. */
-extern unsigned long last_event_timestamp;
-
-/* This is an association list whose elements are of the form
- ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
- SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
- SELECTION-VALUE is the value that emacs owns for that selection.
- It may be any kind of Lisp object.
- SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
- as a cons of two 16-bit numbers (making a 32 bit time.)
- FRAME is the frame for which we made the selection.
- If there is an entry in this alist, then it can be assumed that Emacs owns
- that selection.
- The only (eq) parts of this list that are visible from Lisp are the
- selection-values. */
-static Lisp_Object Vselection_alist;
-
+#define LOCAL_SELECTION(selection_symbol,dpyinfo) \
+ assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
@@ -225,7 +212,7 @@ x_stop_queuing_selection_requests (void)
roundtrip whenever possible. */
static Atom
-symbol_to_x_atom (struct x_display_info *dpyinfo, Display *display, Lisp_Object sym)
+symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
{
Atom val;
if (NILP (sym)) return 0;
@@ -249,7 +236,7 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Display *display, Lisp_Object
TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
BLOCK_INPUT;
- val = XInternAtom (display, SSDATA (SYMBOL_NAME (sym)), False);
+ val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
UNBLOCK_INPUT;
return val;
}
@@ -283,6 +270,8 @@ x_atom_to_symbol (Display *dpy, Atom atom)
}
dpyinfo = x_display_info_for_display (dpy);
+ if (dpyinfo == NULL)
+ return Qnil;
if (atom == dpyinfo->Xatom_CLIPBOARD)
return QCLIPBOARD;
if (atom == dpyinfo->Xatom_TIMESTAMP)
@@ -320,28 +309,20 @@ x_atom_to_symbol (Display *dpy, Atom atom)
}
/* Do protocol to assert ourself as a selection owner.
+ FRAME shall be the owner; it must be a valid X frame.
Update the Vselection_alist so that we can reply to later requests for
our selection. */
static void
-x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
+x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
+ Lisp_Object frame)
{
- struct frame *sf = SELECTED_FRAME ();
- Window selecting_window;
- Display *display;
+ struct frame *f = XFRAME (frame);
+ Window selecting_window = FRAME_X_WINDOW (f);
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Display *display = dpyinfo->display;
Time timestamp = last_event_timestamp;
- Atom selection_atom;
- struct x_display_info *dpyinfo;
-
- if (! FRAME_X_P (sf))
- return;
-
- selecting_window = FRAME_X_WINDOW (sf);
- display = FRAME_X_DISPLAY (sf);
- dpyinfo = FRAME_X_DISPLAY_INFO (sf);
-
- CHECK_SYMBOL (selection_name);
- selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
+ Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
BLOCK_INPUT;
x_catch_errors (display);
@@ -352,27 +333,26 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
/* Now update the local cache */
{
- Lisp_Object selection_time;
Lisp_Object selection_data;
Lisp_Object prev_value;
- selection_time = long_to_cons ((unsigned long) timestamp);
selection_data = list4 (selection_name, selection_value,
- selection_time, selected_frame);
- prev_value = assq_no_quit (selection_name, Vselection_alist);
+ INTEGER_TO_CONS (timestamp), frame);
+ prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
- Vselection_alist = Fcons (selection_data, Vselection_alist);
+ dpyinfo->terminal->Vselection_alist
+ = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);
- /* If we already owned the selection, remove the old selection data.
- Perhaps we should destructively modify it instead.
- Don't use Fdelq as that may QUIT. */
+ /* If we already owned the selection, remove the old selection
+ data. Don't use Fdelq as that may QUIT. */
if (!NILP (prev_value))
{
- Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
- for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
+ /* We know it's not the CAR, so it's easy. */
+ Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
+ for (; CONSP (rest); rest = XCDR (rest))
if (EQ (prev_value, Fcar (XCDR (rest))))
{
- XSETCDR (rest, Fcdr (XCDR (rest)));
+ XSETCDR (rest, XCDR (XCDR (rest)));
break;
}
}
@@ -388,59 +368,23 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
This calls random Lisp code, and may signal or gc. */
static Lisp_Object
-x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, int local_request)
+x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
+ int local_request, struct x_display_info *dpyinfo)
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, check;
int count;
- local_value = assq_no_quit (selection_symbol, Vselection_alist);
+ local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
if (NILP (local_value)) return Qnil;
- /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
+ /* TIMESTAMP is a special case. */
if (EQ (target_type, QTIMESTAMP))
{
handler_fn = Qnil;
value = XCAR (XCDR (XCDR (local_value)));
}
-#if 0
- else if (EQ (target_type, QDELETE))
- {
- handler_fn = Qnil;
- Fx_disown_selection_internal
- (selection_symbol,
- XCAR (XCDR (XCDR (local_value))));
- value = QNULL;
- }
-#endif
-
-#if 0 /* #### MULTIPLE doesn't work yet */
- else if (CONSP (target_type)
- && XCAR (target_type) == QMULTIPLE)
- {
- Lisp_Object pairs;
- int size;
- int i;
- pairs = XCDR (target_type);
- size = ASIZE (pairs);
- /* If the target is MULTIPLE, then target_type looks like
- (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
- We modify the second element of each pair in the vector and
- return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
- */
- for (i = 0; i < size; i++)
- {
- Lisp_Object pair;
- pair = XVECTOR (pairs)->contents [i];
- XVECTOR (pair)->contents [1]
- = x_get_local_selection (XVECTOR (pair)->contents [0],
- XVECTOR (pair)->contents [1],
- local_request);
- }
- return pairs;
- }
-#endif
else
{
/* Don't allow a quit within the converter.
@@ -477,7 +421,7 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, in
|| INTEGERP (check)
|| NILP (value))
return value;
- /* Check for a value that cons_to_long could handle. */
+ /* Check for a value that CONS_TO_INTEGER could handle. */
else if (CONSP (check)
&& INTEGERP (XCAR (check))
&& (INTEGERP (XCDR (check))
@@ -528,6 +472,30 @@ static struct input_event *x_selection_current_request;
static struct x_display_info *selection_request_dpyinfo;
+/* Raw selection data, for sending to a requestor window. */
+
+struct selection_data
+{
+ unsigned char *data;
+ unsigned int size;
+ int format;
+ Atom type;
+ int nofree;
+ Atom property;
+ /* This can be set to non-NULL during x_reply_selection_request, if
+ the selection is waiting for an INCR transfer to complete. Don't
+ free these; that's done by unexpect_property_change. */
+ struct prop_location *wait_object;
+ struct selection_data *next;
+};
+
+/* Linked list of the above (in support of MULTIPLE targets). */
+
+static struct selection_data *converted_selections;
+
+/* "Data" to send a requestor for a failed MULTIPLE subtarget. */
+static Atom conversion_fail_tag;
+
/* Used as an unwind-protect clause so that, if a selection-converter signals
an error, we tell the requester that we were unable to do what they wanted
before we throw to top-level or go into the debugger or whatever. */
@@ -535,6 +503,17 @@ static struct x_display_info *selection_request_dpyinfo;
static Lisp_Object
x_selection_request_lisp_error (Lisp_Object ignore)
{
+ struct selection_data *cs, *next;
+
+ for (cs = converted_selections; cs; cs = next)
+ {
+ next = cs->next;
+ if (cs->nofree == 0 && cs->data)
+ xfree (cs->data);
+ xfree (cs);
+ }
+ converted_selections = NULL;
+
if (x_selection_current_request != 0
&& selection_request_dpyinfo->display)
x_decline_selection_request (x_selection_current_request);
@@ -588,45 +567,24 @@ queue_selection_requests_unwind (Lisp_Object tem)
return Qnil;
}
-/* Return some frame whose display info is DPYINFO.
- Return nil if there is none. */
-
-static Lisp_Object
-some_frame_on_display (struct x_display_info *dpyinfo)
-{
- Lisp_Object list, frame;
-
- FOR_EACH_FRAME (list, frame)
- {
- if (FRAME_X_P (XFRAME (frame))
- && FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
- return frame;
- }
-
- return Qnil;
-}
-/* Send the reply to a selection request event EVENT.
- TYPE is the type of selection data requested.
- DATA and SIZE describe the data to send, already converted.
- FORMAT is the unit-size (in bits) of the data to be transmitted. */
+/* Send the reply to a selection request event EVENT. */
#ifdef TRACE_SELECTION
static int x_reply_selection_request_cnt;
#endif /* TRACE_SELECTION */
static void
-x_reply_selection_request (struct input_event *event, int format, unsigned char *data, int size, Atom type)
+x_reply_selection_request (struct input_event *event, struct x_display_info *dpyinfo)
{
XEvent reply_base;
XSelectionEvent *reply = &(reply_base.xselection);
Display *display = SELECTION_EVENT_DISPLAY (event);
Window window = SELECTION_EVENT_REQUESTOR (event);
int bytes_remaining;
- int format_bytes = format/8;
int max_bytes = SELECTION_QUANTUM (display);
- struct x_display_info *dpyinfo = x_display_info_for_display (display);
int count = SPECPDL_INDEX ();
+ struct selection_data *cs;
if (max_bytes > MAX_SELECTION_QUANTUM)
max_bytes = MAX_SELECTION_QUANTUM;
@@ -648,142 +606,133 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
record_unwind_protect (x_catch_errors_unwind, Qnil);
x_catch_errors (display);
+ /* Loop over converted selections, storing them in the requested
+ properties. If data is large, only store the first N bytes
+ (section 2.7.2 of ICCCM). Note that we store the data for a
+ MULTIPLE request in the opposite order; the ICCM says only that
+ the conversion itself must be done in the same order. */
+ for (cs = converted_selections; cs; cs = cs->next)
+ {
+ if (cs->property == None)
+ continue;
+
+ bytes_remaining = cs->size * (cs->format / 8);
+ if (bytes_remaining <= max_bytes)
+ {
+ /* Send all the data at once, with minimal handshaking. */
+ TRACE1 ("Sending all %d bytes", bytes_remaining);
+ XChangeProperty (display, window, cs->property,
+ cs->type, cs->format, PropModeReplace,
+ cs->data, cs->size);
+ }
+ else
+ {
+ /* Send an INCR tag to initiate incremental transfer. */
+ long value[1];
+
+ TRACE2 ("Start sending %d bytes incrementally (%s)",
+ bytes_remaining, XGetAtomName (display, cs->property));
+ cs->wait_object
+ = expect_property_change (display, window, cs->property,
+ PropertyDelete);
+
+ /* XChangeProperty expects an array of long even if long is
+ more than 32 bits. */
+ value[0] = bytes_remaining;
+ XChangeProperty (display, window, cs->property,
+ dpyinfo->Xatom_INCR, 32, PropModeReplace,
+ (unsigned char *) value, 1);
+ XSelectInput (display, window, PropertyChangeMask);
+ }
+ }
+
+ /* Now issue the SelectionNotify event. */
+ XSendEvent (display, window, False, 0L, &reply_base);
+ XFlush (display);
+
#ifdef TRACE_SELECTION
{
char *sel = XGetAtomName (display, reply->selection);
char *tgt = XGetAtomName (display, reply->target);
- TRACE3 ("%s, target %s (%d)", sel, tgt, ++x_reply_selection_request_cnt);
+ TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
+ sel, tgt, ++x_reply_selection_request_cnt);
if (sel) XFree (sel);
if (tgt) XFree (tgt);
}
#endif /* TRACE_SELECTION */
- /* Store the data on the requested property.
- If the selection is large, only store the first N bytes of it.
- */
- bytes_remaining = size * format_bytes;
- if (bytes_remaining <= max_bytes)
- {
- /* Send all the data at once, with minimal handshaking. */
- TRACE1 ("Sending all %d bytes", bytes_remaining);
- XChangeProperty (display, window, reply->property, type, format,
- PropModeReplace, data, size);
- /* At this point, the selection was successfully stored; ack it. */
- XSendEvent (display, window, False, 0L, &reply_base);
- }
- else
- {
- /* Send an INCR selection. */
- struct prop_location *wait_object;
- int had_errors;
- Lisp_Object frame;
-
- frame = some_frame_on_display (dpyinfo);
-
- /* If the display no longer has frames, we can't expect
- to get many more selection requests from it, so don't
- bother trying to queue them. */
- if (!NILP (frame))
- {
- x_start_queuing_selection_requests ();
-
- record_unwind_protect (queue_selection_requests_unwind,
- Qnil);
- }
-
- if (x_window_to_frame (dpyinfo, window)) /* #### debug */
- error ("Attempt to transfer an INCR to ourself!");
-
- TRACE2 ("Start sending %d bytes incrementally (%s)",
- bytes_remaining, XGetAtomName (display, reply->property));
- wait_object = expect_property_change (display, window, reply->property,
- PropertyDelete);
-
- TRACE1 ("Set %s to number of bytes to send",
- XGetAtomName (display, reply->property));
+ /* Finish sending the rest of each of the INCR values. This should
+ be improved; there's a chance of deadlock if more than one
+ subtarget in a MULTIPLE selection requires an INCR transfer, and
+ the requestor and Emacs loop waiting on different transfers. */
+ for (cs = converted_selections; cs; cs = cs->next)
+ if (cs->wait_object)
{
- /* XChangeProperty expects an array of long even if long is more than
- 32 bits. */
- long value[1];
-
- value[0] = bytes_remaining;
- XChangeProperty (display, window, reply->property, dpyinfo->Xatom_INCR,
- 32, PropModeReplace,
- (unsigned char *) value, 1);
- }
-
- XSelectInput (display, window, PropertyChangeMask);
-
- /* Tell 'em the INCR data is there... */
- TRACE0 ("Send SelectionNotify event");
- XSendEvent (display, window, False, 0L, &reply_base);
- XFlush (display);
-
- had_errors = x_had_errors_p (display);
- UNBLOCK_INPUT;
-
- /* First, wait for the requester to ack by deleting the property.
- This can run random lisp code (process handlers) or signal. */
- if (! had_errors)
- {
- TRACE1 ("Waiting for ACK (deletion of %s)",
- XGetAtomName (display, reply->property));
- wait_for_property_change (wait_object);
- }
- else
- unexpect_property_change (wait_object);
-
- TRACE0 ("Got ACK");
- while (bytes_remaining)
- {
- int i = ((bytes_remaining < max_bytes)
- ? bytes_remaining
- : max_bytes) / format_bytes;
-
- BLOCK_INPUT;
+ int format_bytes = cs->format / 8;
+ int had_errors = x_had_errors_p (display);
+ UNBLOCK_INPUT;
- wait_object
- = expect_property_change (display, window, reply->property,
- PropertyDelete);
+ bytes_remaining = cs->size * format_bytes;
- TRACE1 ("Sending increment of %d elements", i);
- TRACE1 ("Set %s to increment data",
- XGetAtomName (display, reply->property));
+ /* Wait for the requester to ack by deleting the property.
+ This can run Lisp code (process handlers) or signal. */
+ if (! had_errors)
+ {
+ TRACE1 ("Waiting for ACK (deletion of %s)",
+ XGetAtomName (display, cs->property));
+ wait_for_property_change (cs->wait_object);
+ }
+ else
+ unexpect_property_change (cs->wait_object);
- /* Append the next chunk of data to the property. */
- XChangeProperty (display, window, reply->property, type, format,
- PropModeAppend, data, i);
- bytes_remaining -= i * format_bytes;
- if (format == 32)
- data += i * sizeof (long);
- else
- data += i * format_bytes;
- XFlush (display);
- had_errors = x_had_errors_p (display);
- UNBLOCK_INPUT;
+ while (bytes_remaining)
+ {
+ int i = ((bytes_remaining < max_bytes)
+ ? bytes_remaining
+ : max_bytes) / format_bytes;
+ BLOCK_INPUT;
+
+ cs->wait_object
+ = expect_property_change (display, window, cs->property,
+ PropertyDelete);
+
+ TRACE1 ("Sending increment of %d elements", i);
+ TRACE1 ("Set %s to increment data",
+ XGetAtomName (display, cs->property));
+
+ /* Append the next chunk of data to the property. */
+ XChangeProperty (display, window, cs->property,
+ cs->type, cs->format, PropModeAppend,
+ cs->data, i);
+ bytes_remaining -= i * format_bytes;
+ cs->data += i * ((cs->format == 32) ? sizeof (long)
+ : format_bytes);
+ XFlush (display);
+ had_errors = x_had_errors_p (display);
+ UNBLOCK_INPUT;
- if (had_errors)
- break;
+ if (had_errors) break;
- /* Now wait for the requester to ack this chunk by deleting the
- property. This can run random lisp code or signal. */
- TRACE1 ("Waiting for increment ACK (deletion of %s)",
- XGetAtomName (display, reply->property));
- wait_for_property_change (wait_object);
- }
+ /* Wait for the requester to ack this chunk by deleting
+ the property. This can run Lisp code or signal. */
+ TRACE1 ("Waiting for increment ACK (deletion of %s)",
+ XGetAtomName (display, cs->property));
+ wait_for_property_change (cs->wait_object);
+ }
- /* Now write a zero-length chunk to the property to tell the
- requester that we're done. */
- BLOCK_INPUT;
- if (! waiting_for_other_props_on_window (display, window))
- XSelectInput (display, window, 0L);
-
- TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
- XGetAtomName (display, reply->property));
- XChangeProperty (display, window, reply->property, type, format,
- PropModeReplace, data, 0);
- TRACE0 ("Done sending incrementally");
- }
+ /* Now write a zero-length chunk to the property to tell the
+ requester that we're done. */
+ BLOCK_INPUT;
+ if (! waiting_for_other_props_on_window (display, window))
+ XSelectInput (display, window, 0L);
+
+ TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
+ XGetAtomName (display, cs->property));
+ XChangeProperty (display, window, cs->property,
+ cs->type, cs->format, PropModeReplace,
+ cs->data, 0);
+ TRACE0 ("Done sending incrementally");
+ }
/* rms, 2003-01-03: I think I have fixed this bug. */
/* The window we're communicating with may have been deleted
@@ -812,117 +761,169 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
static void
x_handle_selection_request (struct input_event *event)
{
- struct gcpro gcpro1, gcpro2, gcpro3;
- Lisp_Object local_selection_data;
- Lisp_Object selection_symbol;
- Lisp_Object target_symbol;
- Lisp_Object converted_selection;
+ struct gcpro gcpro1, gcpro2;
Time local_selection_time;
- Lisp_Object successful_p;
- int count;
- struct x_display_info *dpyinfo
- = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
-
- TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
- (unsigned long) SELECTION_EVENT_REQUESTOR (event),
- (unsigned long) SELECTION_EVENT_TIME (event));
-
- local_selection_data = Qnil;
- target_symbol = Qnil;
- converted_selection = Qnil;
- successful_p = Qnil;
- GCPRO3 (local_selection_data, converted_selection, target_symbol);
-
- selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
- SELECTION_EVENT_SELECTION (event));
+ Display *display = SELECTION_EVENT_DISPLAY (event);
+ struct x_display_info *dpyinfo = x_display_info_for_display (display);
+ Atom selection = SELECTION_EVENT_SELECTION (event);
+ Lisp_Object selection_symbol = x_atom_to_symbol (display, selection);
+ Atom target = SELECTION_EVENT_TARGET (event);
+ Lisp_Object target_symbol = x_atom_to_symbol (display, target);
+ Atom property = SELECTION_EVENT_PROPERTY (event);
+ Lisp_Object local_selection_data;
+ int success = 0;
+ int count = SPECPDL_INDEX ();
+ GCPRO2 (local_selection_data, target_symbol);
- local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
+ if (!dpyinfo) goto DONE;
- if (NILP (local_selection_data))
- {
- /* Someone asked for the selection, but we don't have it any more.
- */
- x_decline_selection_request (event);
- goto DONE;
- }
+ local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
- local_selection_time = (Time)
- cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
+ /* Decline if we don't own any selections. */
+ if (NILP (local_selection_data)) goto DONE;
+ /* Decline requests issued prior to our acquiring the selection. */
+ CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
+ Time, local_selection_time);
if (SELECTION_EVENT_TIME (event) != CurrentTime
&& local_selection_time > SELECTION_EVENT_TIME (event))
- {
- /* Someone asked for the selection, and we have one, but not the one
- they're looking for.
- */
- x_decline_selection_request (event);
- goto DONE;
- }
+ goto DONE;
x_selection_current_request = event;
- count = SPECPDL_INDEX ();
selection_request_dpyinfo = dpyinfo;
record_unwind_protect (x_selection_request_lisp_error, Qnil);
- target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
- SELECTION_EVENT_TARGET (event));
-
-#if 0 /* #### MULTIPLE doesn't work yet */
- if (EQ (target_symbol, QMULTIPLE))
- target_symbol = fetch_multiple_target (event);
-#endif
-
- /* Convert lisp objects back into binary data */
+ /* We might be able to handle nested x_handle_selection_requests,
+ but this is difficult to test, and seems unimportant. */
+ x_start_queuing_selection_requests ();
+ record_unwind_protect (queue_selection_requests_unwind, Qnil);
- converted_selection
- = x_get_local_selection (selection_symbol, target_symbol, 0);
+ TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
+ SDATA (SYMBOL_NAME (selection_symbol)),
+ SDATA (SYMBOL_NAME (target_symbol)));
- if (! NILP (converted_selection))
+ if (EQ (target_symbol, QMULTIPLE))
{
- unsigned char *data;
- unsigned int size;
- int format;
- Atom type;
- int nofree;
-
- if (CONSP (converted_selection) && NILP (XCDR (converted_selection)))
- {
- x_decline_selection_request (event);
- goto DONE2;
- }
+ /* For MULTIPLE targets, the event property names a list of atom
+ pairs; the first atom names a target and the second names a
+ non-None property. */
+ Window requestor = SELECTION_EVENT_REQUESTOR (event);
+ Lisp_Object multprop;
+ int j, nselections;
+
+ if (property == None) goto DONE;
+ multprop
+ = x_get_window_property_as_lisp_data (display, requestor, property,
+ QMULTIPLE, selection);
+
+ if (!VECTORP (multprop) || ASIZE (multprop) % 2)
+ goto DONE;
+
+ nselections = ASIZE (multprop) / 2;
+ /* Perform conversions. This can signal. */
+ for (j = 0; j < nselections; j++)
+ {
+ Lisp_Object subtarget = AREF (multprop, 2*j);
+ Atom subproperty = symbol_to_x_atom (dpyinfo,
+ AREF (multprop, 2*j+1));
- lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
- converted_selection,
- &data, &type, &size, &format, &nofree);
+ if (subproperty != None)
+ x_convert_selection (event, selection_symbol, subtarget,
+ subproperty, 1, dpyinfo);
+ }
+ success = 1;
+ }
+ else
+ {
+ if (property == None)
+ property = SELECTION_EVENT_TARGET (event);
+ success = x_convert_selection (event, selection_symbol,
+ target_symbol, property,
+ 0, dpyinfo);
+ }
- x_reply_selection_request (event, format, data, size, type);
- successful_p = Qt;
+ DONE:
- /* Indicate we have successfully processed this event. */
- x_selection_current_request = 0;
+ if (success)
+ x_reply_selection_request (event, dpyinfo);
+ else
+ x_decline_selection_request (event);
+ x_selection_current_request = 0;
- /* Use xfree, not XFree, because lisp_data_to_selection_data
- calls xmalloc itself. */
- if (!nofree)
- xfree (data);
+ /* Run the `x-sent-selection-functions' abnormal hook. */
+ if (!NILP (Vx_sent_selection_functions)
+ && !EQ (Vx_sent_selection_functions, Qunbound))
+ {
+ Lisp_Object args[4];
+ args[0] = Qx_sent_selection_functions;
+ args[1] = selection_symbol;
+ args[2] = target_symbol;
+ args[3] = success ? Qt : Qnil;
+ Frun_hook_with_args (4, args);
}
- DONE2:
unbind_to (count, Qnil);
+ UNGCPRO;
+}
- DONE:
+/* Perform the requested selection conversion, and write the data to
+ the converted_selections linked list, where it can be accessed by
+ x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
+ the data even if conversion fails, using conversion_fail_tag.
- /* Let random lisp code notice that the selection has been asked for. */
- {
- Lisp_Object rest;
- rest = Vx_sent_selection_functions;
- if (!EQ (rest, Qunbound))
- for (; CONSP (rest); rest = Fcdr (rest))
- call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
- }
+ Return 0 if the selection failed to convert, 1 otherwise. */
+
+static int
+x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
+ Lisp_Object target_symbol, Atom property,
+ int for_multiple, struct x_display_info *dpyinfo)
+{
+ struct gcpro gcpro1;
+ Lisp_Object lisp_selection;
+ struct selection_data *cs;
+ GCPRO1 (lisp_selection);
+
+ lisp_selection
+ = x_get_local_selection (selection_symbol, target_symbol,
+ 0, dpyinfo);
+
+ /* A nil return value means we can't perform the conversion. */
+ if (NILP (lisp_selection)
+ || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection))))
+ {
+ if (for_multiple)
+ {
+ cs = xmalloc (sizeof (struct selection_data));
+ cs->data = (unsigned char *) &conversion_fail_tag;
+ cs->size = 1;
+ cs->format = 32;
+ cs->type = XA_ATOM;
+ cs->nofree = 1;
+ cs->property = property;
+ cs->wait_object = NULL;
+ cs->next = converted_selections;
+ converted_selections = cs;
+ }
+ UNGCPRO;
+ return 0;
+ }
+
+ /* Otherwise, record the converted selection to binary. */
+ cs = xmalloc (sizeof (struct selection_data));
+ cs->nofree = 1;
+ cs->property = property;
+ cs->wait_object = NULL;
+ cs->next = converted_selections;
+ converted_selections = cs;
+ lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
+ lisp_selection,
+ &(cs->data), &(cs->type),
+ &(cs->size), &(cs->format),
+ &(cs->nofree));
UNGCPRO;
+ return 1;
}
/* Handle a SelectionClear event EVENT, which indicates that some
@@ -939,92 +940,65 @@ x_handle_selection_clear (struct input_event *event)
Lisp_Object selection_symbol, local_selection_data;
Time local_selection_time;
struct x_display_info *dpyinfo = x_display_info_for_display (display);
- struct x_display_info *t_dpyinfo;
+ Lisp_Object Vselection_alist;
TRACE0 ("x_handle_selection_clear");
- /* If the new selection owner is also Emacs,
- don't clear the new selection. */
- BLOCK_INPUT;
- /* Check each display on the same terminal,
- to see if this Emacs job now owns the selection
- through that display. */
- for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
- if (t_dpyinfo->terminal->kboard == dpyinfo->terminal->kboard)
- {
- Window owner_window
- = XGetSelectionOwner (t_dpyinfo->display, selection);
- if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
- {
- UNBLOCK_INPUT;
- return;
- }
- }
- UNBLOCK_INPUT;
+ if (!dpyinfo) return;
selection_symbol = x_atom_to_symbol (display, selection);
-
- local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
+ local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
/* Well, we already believe that we don't own it, so that's just fine. */
if (NILP (local_selection_data)) return;
- local_selection_time = (Time)
- cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
-
- /* This SelectionClear is for a selection that we no longer own, so we can
- disregard it. (That is, we have reasserted the selection since this
- request was generated.) */
+ CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
+ Time, local_selection_time);
+ /* We have reasserted the selection since this SelectionClear was
+ generated, so we can disregard it. */
if (changed_owner_time != CurrentTime
&& local_selection_time > changed_owner_time)
return;
- /* Otherwise, we're really honest and truly being told to drop it.
- Don't use Fdelq as that may QUIT;. */
-
- if (EQ (local_selection_data, Fcar (Vselection_alist)))
- Vselection_alist = Fcdr (Vselection_alist);
+ /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
+ Vselection_alist = dpyinfo->terminal->Vselection_alist;
+ if (EQ (local_selection_data, CAR (Vselection_alist)))
+ Vselection_alist = XCDR (Vselection_alist);
else
{
Lisp_Object rest;
for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
- if (EQ (local_selection_data, Fcar (XCDR (rest))))
+ if (EQ (local_selection_data, CAR (XCDR (rest))))
{
- XSETCDR (rest, Fcdr (XCDR (rest)));
+ XSETCDR (rest, XCDR (XCDR (rest)));
break;
}
}
+ dpyinfo->terminal->Vselection_alist = Vselection_alist;
- /* Let random lisp code notice that the selection has been stolen. */
-
+ /* Run the `x-lost-selection-functions' abnormal hook. */
{
- Lisp_Object rest;
- rest = Vx_lost_selection_functions;
- if (!EQ (rest, Qunbound))
- {
- for (; CONSP (rest); rest = Fcdr (rest))
- call1 (Fcar (rest), selection_symbol);
- prepare_menu_bars ();
- redisplay_preserve_echo_area (20);
- }
+ Lisp_Object args[2];
+ args[0] = Qx_lost_selection_functions;
+ args[1] = selection_symbol;
+ Frun_hook_with_args (2, args);
}
+
+ prepare_menu_bars ();
+ redisplay_preserve_echo_area (20);
}
void
x_handle_selection_event (struct input_event *event)
{
TRACE0 ("x_handle_selection_event");
-
- if (event->kind == SELECTION_REQUEST_EVENT)
- {
- if (x_queue_selection_requests)
- x_queue_event (event);
- else
- x_handle_selection_request (event);
- }
- else
+ if (event->kind != SELECTION_REQUEST_EVENT)
x_handle_selection_clear (event);
+ else if (x_queue_selection_requests)
+ x_queue_event (event);
+ else
+ x_handle_selection_request (event);
}
@@ -1036,55 +1010,34 @@ x_clear_frame_selections (FRAME_PTR f)
{
Lisp_Object frame;
Lisp_Object rest;
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ struct terminal *t = dpyinfo->terminal;
XSETFRAME (frame, f);
- /* Otherwise, we're really honest and truly being told to drop it.
- Don't use Fdelq as that may QUIT;. */
-
/* Delete elements from the beginning of Vselection_alist. */
- while (!NILP (Vselection_alist)
- && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
+ while (CONSP (t->Vselection_alist)
+ && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist)))))))
{
- /* Let random Lisp code notice that the selection has been stolen. */
- Lisp_Object hooks, selection_symbol;
-
- hooks = Vx_lost_selection_functions;
- selection_symbol = Fcar (Fcar (Vselection_alist));
-
- if (!EQ (hooks, Qunbound))
- {
- for (; CONSP (hooks); hooks = Fcdr (hooks))
- call1 (Fcar (hooks), selection_symbol);
-#if 0 /* This can crash when deleting a frame
- from x_connection_closed. Anyway, it seems unnecessary;
- something else should cause a redisplay. */
- redisplay_preserve_echo_area (21);
-#endif
- }
+ /* Run the `x-lost-selection-functions' abnormal hook. */
+ Lisp_Object args[2];
+ args[0] = Qx_lost_selection_functions;
+ args[1] = Fcar (Fcar (t->Vselection_alist));
+ Frun_hook_with_args (2, args);
- Vselection_alist = Fcdr (Vselection_alist);
+ t->Vselection_alist = XCDR (t->Vselection_alist);
}
/* Delete elements after the beginning of Vselection_alist. */
- for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
- if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
+ for (rest = t->Vselection_alist; CONSP (rest); rest = XCDR (rest))
+ if (CONSP (XCDR (rest))
+ && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest))))))))
{
- /* Let random Lisp code notice that the selection has been stolen. */
- Lisp_Object hooks, selection_symbol;
-
- hooks = Vx_lost_selection_functions;
- selection_symbol = Fcar (Fcar (XCDR (rest)));
-
- if (!EQ (hooks, Qunbound))
- {
- for (; CONSP (hooks); hooks = Fcdr (hooks))
- call1 (Fcar (hooks), selection_symbol);
-#if 0 /* See above */
- redisplay_preserve_echo_area (22);
-#endif
- }
- XSETCDR (rest, Fcdr (XCDR (rest)));
+ Lisp_Object args[2];
+ args[0] = Qx_lost_selection_functions;
+ args[1] = XCAR (XCAR (XCDR (rest)));
+ Frun_hook_with_args (2, args);
+ XSETCDR (rest, XCDR (XCDR (rest)));
break;
}
}
@@ -1232,137 +1185,62 @@ x_handle_property_notify (XPropertyEvent *event)
-#if 0 /* #### MULTIPLE doesn't work yet */
-
-static Lisp_Object
-fetch_multiple_target (event)
- XSelectionRequestEvent *event;
-{
- Display *display = event->display;
- Window window = event->requestor;
- Atom target = event->target;
- Atom selection_atom = event->selection;
- int result;
-
- return
- Fcons (QMULTIPLE,
- x_get_window_property_as_lisp_data (display, window, target,
- QMULTIPLE, selection_atom));
-}
-
-static Lisp_Object
-copy_multiple_data (obj)
- Lisp_Object obj;
-{
- Lisp_Object vec;
- int i;
- int size;
- if (CONSP (obj))
- return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
-
- CHECK_VECTOR (obj);
- vec = Fmake_vector (size = ASIZE (obj), Qnil);
- for (i = 0; i < size; i++)
- {
- Lisp_Object vec2 = XVECTOR (obj)->contents [i];
- CHECK_VECTOR (vec2);
- if (ASIZE (vec2) != 2)
- /* ??? Confusing error message */
- signal_error ("Vectors must be of length 2", vec2);
- XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
- XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
- = XVECTOR (vec2)->contents [0];
- XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
- = XVECTOR (vec2)->contents [1];
- }
- return vec;
-}
-
-#endif
-
-
/* Variables for communication with x_handle_selection_notify. */
static Atom reading_which_selection;
static Lisp_Object reading_selection_reply;
static Window reading_selection_window;
/* Do protocol to read selection-data from the server.
- Converts this to Lisp data and returns it. */
+ Converts this to Lisp data and returns it.
+ FRAME is the frame whose X window shall request the selection. */
static Lisp_Object
-x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, Lisp_Object time_stamp)
+x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
+ Lisp_Object time_stamp, Lisp_Object frame)
{
- struct frame *sf = SELECTED_FRAME ();
- Window requestor_window;
- Display *display;
- struct x_display_info *dpyinfo;
+ struct frame *f = XFRAME (frame);
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Display *display = dpyinfo->display;
+ Window requestor_window = FRAME_X_WINDOW (f);
Time requestor_time = last_event_timestamp;
- Atom target_property;
- Atom selection_atom;
- Atom type_atom;
+ Atom target_property = dpyinfo->Xatom_EMACS_TMP;
+ Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_symbol);
+ Atom type_atom = (CONSP (target_type)
+ ? symbol_to_x_atom (dpyinfo, XCAR (target_type))
+ : symbol_to_x_atom (dpyinfo, target_type));
int secs, usecs;
- int count = SPECPDL_INDEX ();
- Lisp_Object frame;
- if (! FRAME_X_P (sf))
+ if (!FRAME_LIVE_P (f))
return Qnil;
- requestor_window = FRAME_X_WINDOW (sf);
- display = FRAME_X_DISPLAY (sf);
- dpyinfo = FRAME_X_DISPLAY_INFO (sf);
- target_property = dpyinfo->Xatom_EMACS_TMP;
- selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
-
- if (CONSP (target_type))
- type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
- else
- type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
-
if (! NILP (time_stamp))
- {
- if (CONSP (time_stamp))
- requestor_time = (Time) cons_to_long (time_stamp);
- else if (INTEGERP (time_stamp))
- requestor_time = (Time) XUINT (time_stamp);
- else if (FLOATP (time_stamp))
- requestor_time = (Time) XFLOAT_DATA (time_stamp);
- else
- error ("TIME_STAMP must be cons or number");
- }
+ CONS_TO_INTEGER (time_stamp, Time, requestor_time);
BLOCK_INPUT;
-
- /* The protected block contains wait_reading_process_output, which
- can run random lisp code (process handlers) or signal.
- Therefore, we put the x_uncatch_errors call in an unwind. */
- record_unwind_protect (x_catch_errors_unwind, Qnil);
- x_catch_errors (display);
-
TRACE2 ("Get selection %s, type %s",
XGetAtomName (display, type_atom),
XGetAtomName (display, target_property));
+ x_catch_errors (display);
XConvertSelection (display, selection_atom, type_atom, target_property,
requestor_window, requestor_time);
- XFlush (display);
+ x_check_errors (display, "Can't convert selection: %s");
+ x_uncatch_errors ();
/* Prepare to block until the reply has been read. */
reading_selection_window = requestor_window;
reading_which_selection = selection_atom;
XSETCAR (reading_selection_reply, Qnil);
- frame = some_frame_on_display (dpyinfo);
-
- /* If the display no longer has frames, we can't expect
- to get many more selection requests from it, so don't
- bother trying to queue them. */
- if (!NILP (frame))
- {
- x_start_queuing_selection_requests ();
+ /* It should not be necessary to stop handling selection requests
+ during this time. In fact, the SAVE_TARGETS mechanism requires
+ us to handle a clipboard manager's requests before it returns
+ SelectionNotify. */
+#if 0
+ x_start_queuing_selection_requests ();
+ record_unwind_protect (queue_selection_requests_unwind, Qnil);
+#endif
- record_unwind_protect (queue_selection_requests_unwind,
- Qnil);
- }
UNBLOCK_INPUT;
/* This allows quits. Also, don't wait forever. */
@@ -1373,13 +1251,6 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
reading_selection_reply, NULL, 0);
TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
- BLOCK_INPUT;
- if (x_had_errors_p (display))
- error ("Cannot get selection");
- /* This calls x_uncatch_errors. */
- unbind_to (count, Qnil);
- UNBLOCK_INPUT;
-
if (NILP (XCAR (reading_selection_reply)))
error ("Timed out waiting for reply from selection owner");
if (EQ (XCAR (reading_selection_reply), Qlambda))
@@ -1597,9 +1468,9 @@ receive_incremental_selection (Display *display, Window window, Atom property,
}
-/* Once a requested selection is "ready" (we got a SelectionNotify event),
- fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
- TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
+/* Fetch a value from property PROPERTY of X window WINDOW on display
+ DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
+ if this fails. */
static Lisp_Object
x_get_window_property_as_lisp_data (Display *display, Window window,
@@ -1731,9 +1602,10 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
return str;
}
/* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
- a vector of symbols.
- */
- else if (type == XA_ATOM)
+ a vector of symbols. */
+ else if (type == XA_ATOM
+ /* Treat ATOM_PAIR type similar to list of atoms. */
+ || type == dpyinfo->Xatom_ATOM_PAIR)
{
int i;
/* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
@@ -1760,7 +1632,7 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
convert it to a cons of integers, 16 bits in each half.
*/
else if (format == 32 && size == sizeof (int))
- return long_to_cons (((unsigned int *) data) [0]);
+ return INTEGER_TO_CONS (((unsigned int *) data) [0]);
else if (format == 16 && size == sizeof (short))
return make_number ((int) (((unsigned short *) data) [0]));
@@ -1786,7 +1658,7 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
for (i = 0; i < size / 4; i++)
{
unsigned int j = ((unsigned int *) data) [i];
- Faset (v, make_number (i), long_to_cons (j));
+ Faset (v, make_number (i), INTEGER_TO_CONS (j));
}
return v;
}
@@ -1839,7 +1711,7 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
*size_ret = 1;
*data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
(*data_ret) [sizeof (Atom)] = 0;
- (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
+ (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, obj);
if (NILP (type)) type = QATOM;
}
else if (INTEGERP (obj)
@@ -1863,7 +1735,7 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
*size_ret = 1;
*data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
(*data_ret) [sizeof (long)] = 0;
- (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
+ (*(unsigned long **) data_ret) [0] = cons_to_unsigned (obj, ULONG_MAX);
if (NILP (type)) type = QINTEGER;
}
else if (VECTORP (obj))
@@ -1880,45 +1752,15 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
if (NILP (type)) type = QATOM;
*size_ret = ASIZE (obj);
*format_ret = 32;
- *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
for (i = 0; i < *size_ret; i++)
- if (SYMBOLP (XVECTOR (obj)->contents [i]))
- (*(Atom **) data_ret) [i]
- = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
- else
+ if (!SYMBOLP (XVECTOR (obj)->contents [i]))
signal_error ("All elements of selection vector must have same type", obj);
- }
-#if 0 /* #### MULTIPLE doesn't work yet */
- else if (VECTORP (XVECTOR (obj)->contents [0]))
- /* This vector is an ATOM_PAIR set */
- {
- if (NILP (type)) type = QATOM_PAIR;
- *size_ret = ASIZE (obj);
- *format_ret = 32;
- *data_ret = (unsigned char *)
- xmalloc ((*size_ret) * sizeof (Atom) * 2);
- for (i = 0; i < *size_ret; i++)
- if (VECTORP (XVECTOR (obj)->contents [i]))
- {
- Lisp_Object pair = XVECTOR (obj)->contents [i];
- if (ASIZE (pair) != 2)
- signal_error (
- "Elements of the vector must be vectors of exactly two elements",
- pair);
-
- (*(Atom **) data_ret) [i * 2]
- = symbol_to_x_atom (dpyinfo, display,
- XVECTOR (pair)->contents [0]);
- (*(Atom **) data_ret) [(i * 2) + 1]
- = symbol_to_x_atom (dpyinfo, display,
- XVECTOR (pair)->contents [1]);
- }
- else
- signal_error ("All elements of the vector must be of the same type",
- obj);
+ *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
+ for (i = 0; i < *size_ret; i++)
+ (*(Atom **) data_ret) [i]
+ = symbol_to_x_atom (dpyinfo, XVECTOR (obj)->contents [i]);
}
-#endif
else
/* This vector is an INTEGER set, or something like it */
{
@@ -1941,17 +1783,17 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
*data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
for (i = 0; i < *size_ret; i++)
if (*format_ret == 32)
- (*((unsigned long **) data_ret)) [i]
- = cons_to_long (XVECTOR (obj)->contents [i]);
+ (*((unsigned long **) data_ret)) [i] =
+ cons_to_unsigned (XVECTOR (obj)->contents [i], ULONG_MAX);
else
- (*((unsigned short **) data_ret)) [i]
- = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
+ (*((unsigned short **) data_ret)) [i] =
+ cons_to_unsigned (XVECTOR (obj)->contents [i], USHRT_MAX);
}
}
else
signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
- *type_ret = symbol_to_x_atom (dpyinfo, display, type);
+ *type_ret = symbol_to_x_atom (dpyinfo, type);
}
static Lisp_Object
@@ -2008,20 +1850,75 @@ x_handle_selection_notify (XSelectionEvent *event)
}
+/* From a Lisp_Object, return a suitable frame for selection
+ operations. OBJECT may be a frame, a terminal object, or nil
+ (which stands for the selected frame--or, if that is not an X
+ frame, the first X display on the list). If no suitable frame can
+ be found, return NULL. */
+
+static struct frame *
+frame_for_x_selection (Lisp_Object object)
+{
+ Lisp_Object tail;
+ struct frame *f;
+
+ if (NILP (object))
+ {
+ f = XFRAME (selected_frame);
+ if (FRAME_X_P (f) && FRAME_LIVE_P (f))
+ return f;
+
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ {
+ f = XFRAME (XCAR (tail));
+ if (FRAME_X_P (f) && FRAME_LIVE_P (f))
+ return f;
+ }
+ }
+ 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;
+ }
+ }
+ }
+ else if (FRAMEP (object))
+ {
+ f = XFRAME (object);
+ if (FRAME_X_P (f) && FRAME_LIVE_P (f))
+ return f;
+ }
+
+ return NULL;
+}
+
+
DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
- Sx_own_selection_internal, 2, 2, 0,
- doc: /* Assert an X selection of the given TYPE with the given VALUE.
-TYPE 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. */)
+ (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
{
- check_x ();
- CHECK_SYMBOL (selection_name);
- if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
- x_own_selection (selection_name, selection_value);
- return selection_value;
+ if (NILP (frame)) frame = selected_frame;
+ if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_X_P (XFRAME (frame)))
+ error ("X selection unavailable for this frame");
+
+ CHECK_SYMBOL (selection);
+ if (NILP (value)) error ("VALUE may not be nil");
+ x_own_selection (selection, value, frame);
+ return value;
}
@@ -2030,59 +1927,61 @@ anything that the functions on `selection-converter-alist' know about. */)
will block until all of the data has arrived. */
DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
- Sx_get_selection_internal, 2, 3, 0,
+ Sx_get_selection_internal, 2, 4, 0,
doc: /* Return text selected from some X window.
SELECTION is a symbol, 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. */)
- (Lisp_Object selection_symbol, Lisp_Object target_type, Lisp_Object time_stamp)
+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. */)
+ (Lisp_Object selection_symbol, Lisp_Object target_type,
+ Lisp_Object time_stamp, Lisp_Object terminal)
{
Lisp_Object val = Qnil;
struct gcpro gcpro1, gcpro2;
+ struct frame *f = frame_for_x_selection (terminal);
GCPRO2 (target_type, val); /* we store newly consed data into these */
- check_x ();
- CHECK_SYMBOL (selection_symbol);
-#if 0 /* #### MULTIPLE doesn't work yet */
- if (CONSP (target_type)
- && XCAR (target_type) == QMULTIPLE)
- {
- CHECK_VECTOR (XCDR (target_type));
- /* So we don't destructively modify this... */
- target_type = copy_multiple_data (target_type);
- }
- else
-#endif
- CHECK_SYMBOL (target_type);
+ CHECK_SYMBOL (selection_symbol);
+ CHECK_SYMBOL (target_type);
+ if (EQ (target_type, QMULTIPLE))
+ error ("Retrieving MULTIPLE selections is currently unimplemented");
+ if (!f)
+ error ("X selection unavailable for this frame");
- val = x_get_local_selection (selection_symbol, target_type, 1);
+ val = x_get_local_selection (selection_symbol, target_type, 1,
+ FRAME_X_DISPLAY_INFO (f));
- if (NILP (val))
+ if (NILP (val) && FRAME_LIVE_P (f))
{
- val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
- goto DONE;
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+ RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, target_type,
+ time_stamp, frame));
}
- if (CONSP (val)
- && SYMBOLP (XCAR (val)))
+ if (CONSP (val) && SYMBOLP (XCAR (val)))
{
val = XCDR (val);
if (CONSP (val) && NILP (XCDR (val)))
val = XCAR (val);
}
- val = clean_local_selection_data (val);
- DONE:
- UNGCPRO;
- return val;
+ RETURN_UNGCPRO (clean_local_selection_data (val));
}
DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
- Sx_disown_selection_internal, 1, 2, 0,
+ Sx_disown_selection_internal, 1, 3, 0,
doc: /* If we own the selection SELECTION, disown it.
-Disowning it means there is no such selection. */)
- (Lisp_Object selection, Lisp_Object time_object)
+Disowning it means there is no such selection.
+
+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 time_object, Lisp_Object terminal)
{
Time timestamp;
Atom selection_atom;
@@ -2090,29 +1989,27 @@ Disowning it means there is no such selection. */)
struct selection_input_event sie;
struct input_event ie;
} event;
- Display *display;
+ struct frame *f = frame_for_x_selection (terminal);
struct x_display_info *dpyinfo;
- struct frame *sf = SELECTED_FRAME ();
- check_x ();
- if (! FRAME_X_P (sf))
+ if (!f)
return Qnil;
- display = FRAME_X_DISPLAY (sf);
- dpyinfo = FRAME_X_DISPLAY_INFO (sf);
+ dpyinfo = FRAME_X_DISPLAY_INFO (f);
CHECK_SYMBOL (selection);
- if (NILP (time_object))
- timestamp = last_event_timestamp;
- else
- timestamp = cons_to_long (time_object);
- if (NILP (assq_no_quit (selection, Vselection_alist)))
- return Qnil; /* Don't disown the selection when we're not the owner. */
+ /* Don't disown the selection when we're not the owner. */
+ if (NILP (LOCAL_SELECTION (selection, dpyinfo)))
+ return Qnil;
- selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
+ selection_atom = symbol_to_x_atom (dpyinfo, selection);
BLOCK_INPUT;
- XSetSelectionOwner (display, selection_atom, None, timestamp);
+ 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;
/* It doesn't seem to be guaranteed that a SelectionClear event will be
@@ -2120,7 +2017,7 @@ Disowning it means there is no such selection. */)
the selection owner to None. The NCD server does, the MIT Sun4 server
doesn't. So we synthesize one; this means we might get two, but
that's ok, because the second one won't have any effect. */
- SELECTION_EVENT_DISPLAY (&event.sie) = display;
+ SELECTION_EVENT_DISPLAY (&event.sie) = dpyinfo->display;
SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
SELECTION_EVENT_TIME (&event.sie) = timestamp;
x_handle_selection_clear (&event.ie);
@@ -2129,60 +2026,170 @@ Disowning it means there is no such selection. */)
}
DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
- 0, 1, 0,
+ 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, 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. */)
+ (Lisp_Object selection, Lisp_Object terminal)
{
- check_x ();
+ struct frame *f = frame_for_x_selection (terminal);
+
CHECK_SYMBOL (selection);
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
- if (NILP (Fassq (selection, Vselection_alist)))
+ if (f && !NILP (LOCAL_SELECTION (selection, FRAME_X_DISPLAY_INFO (f))))
+ return Qt;
+ else
return Qnil;
- 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 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)
{
Window owner;
Atom atom;
- Display *dpy;
- struct frame *sf = SELECTED_FRAME ();
-
- /* It should be safe to call this before we have an X frame. */
- if (! FRAME_X_P (sf))
- return Qnil;
+ struct frame *f = frame_for_x_selection (terminal);
+ struct x_display_info *dpyinfo;
- dpy = FRAME_X_DISPLAY (sf);
CHECK_SYMBOL (selection);
- if (!NILP (Fx_selection_owner_p (selection)))
- return Qt;
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
- atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
- if (atom == 0)
+
+ if (!f)
return Qnil;
+
+ dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+ if (!NILP (LOCAL_SELECTION (selection, dpyinfo)))
+ return Qt;
+
+ atom = symbol_to_x_atom (dpyinfo, selection);
+ if (atom == 0) return Qnil;
BLOCK_INPUT;
- owner = XGetSelectionOwner (dpy, atom);
+ owner = XGetSelectionOwner (dpyinfo->display, atom);
UNBLOCK_INPUT;
return (owner ? Qt : Qnil);
}
+/* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
+ property (http://www.freedesktop.org/wiki/ClipboardManager). */
+
+static Lisp_Object
+x_clipboard_manager_save (Lisp_Object frame)
+{
+ struct frame *f = XFRAME (frame);
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Atom data = dpyinfo->Xatom_UTF8_STRING;
+
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ dpyinfo->Xatom_EMACS_TMP,
+ dpyinfo->Xatom_ATOM, 32, PropModeReplace,
+ (unsigned char *) &data, 1);
+ x_get_foreign_selection (QCLIPBOARD_MANAGER, QSAVE_TARGETS,
+ Qnil, frame);
+ return Qt;
+}
+
+/* Error handler for x_clipboard_manager_save_frame. */
+
+static Lisp_Object
+x_clipboard_manager_error_1 (Lisp_Object err)
+{
+ Lisp_Object args[2];
+ args[0] = build_string ("X clipboard manager error: %s\n\
+If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
+ args[1] = CAR (CDR (err));
+ Fmessage (2, args);
+ return Qnil;
+}
+
+/* Error handler for x_clipboard_manager_save_all. */
+
+static Lisp_Object
+x_clipboard_manager_error_2 (Lisp_Object err)
+{
+ fprintf (stderr, "Error saving to X clipboard manager.\n\
+If the problem persists, set `x-select-enable-clipboard-manager' \
+to nil.\n");
+ return Qnil;
+}
+
+/* Called from delete_frame: save any clipboard owned by FRAME to the
+ clipboard manager. Do nothing if FRAME does not own the clipboard,
+ or if no clipboard manager is present. */
+
+void
+x_clipboard_manager_save_frame (Lisp_Object frame)
+{
+ struct frame *f;
+
+ if (!NILP (Vx_select_enable_clipboard_manager)
+ && FRAMEP (frame)
+ && (f = XFRAME (frame), FRAME_X_P (f))
+ && FRAME_LIVE_P (f))
+ {
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Lisp_Object local_selection
+ = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
+
+ if (!NILP (local_selection)
+ && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection)))))
+ && XGetSelectionOwner (dpyinfo->display,
+ dpyinfo->Xatom_CLIPBOARD_MANAGER))
+ internal_condition_case_1 (x_clipboard_manager_save, frame, Qt,
+ x_clipboard_manager_error_1);
+ }
+}
+
+/* Called from Fkill_emacs: save any clipboard owned by FRAME to the
+ clipboard manager. Do nothing if FRAME does not own the clipboard,
+ or if no clipboard manager is present. */
+
+void
+x_clipboard_manager_save_all (void)
+{
+ /* Loop through all X displays, saving owned clipboards. */
+ struct x_display_info *dpyinfo;
+ Lisp_Object local_selection, local_frame;
+
+ if (NILP (Vx_select_enable_clipboard_manager))
+ return;
+
+ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ {
+ local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
+ if (NILP (local_selection)
+ || !XGetSelectionOwner (dpyinfo->display,
+ dpyinfo->Xatom_CLIPBOARD_MANAGER))
+ continue;
+
+ 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);
+ }
+}
+
+
/***********************************************************************
Drag and drop support
***********************************************************************/
@@ -2238,12 +2245,8 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
{
Lisp_Object o = XCAR (iter);
- if (INTEGERP (o))
- val = (long) XFASTINT (o);
- else if (FLOATP (o))
- val = (long) XFLOAT_DATA (o);
- else if (CONSP (o))
- val = (long) cons_to_long (o);
+ if (INTEGERP (o) || FLOATP (o) || CONSP (o))
+ val = cons_to_signed (o, LONG_MIN, LONG_MAX);
else if (STRINGP (o))
{
BLOCK_INPUT;
@@ -2254,9 +2257,19 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
error ("Wrong type, must be string, number or cons");
if (format == 8)
- *d08++ = (char) val;
+ {
+ if (CHAR_MIN <= val && val <= CHAR_MAX)
+ *d08++ = val;
+ else
+ error ("Out of 'char' range");
+ }
else if (format == 16)
- *d16++ = (short) val;
+ {
+ if (SHRT_MIN <= val && val <= SHRT_MAX)
+ *d16++ = val;
+ else
+ error ("Out of 'short' range");
+ }
else
*d32++ = val;
}
@@ -2340,14 +2353,7 @@ If the value is 0 or the atom is not known, return the empty string. */)
Atom atom;
int had_errors;
- if (INTEGERP (value))
- atom = (Atom) XUINT (value);
- else if (FLOATP (value))
- atom = (Atom) XFLOAT_DATA (value);
- else if (CONSP (value))
- atom = (Atom) cons_to_long (value);
- else
- error ("Wrong type, value must be number or cons");
+ CONS_TO_INTEGER (value, Atom, atom);
BLOCK_INPUT;
x_catch_errors (dpy);
@@ -2356,7 +2362,7 @@ If the value is 0 or the atom is not known, return the empty string. */)
x_uncatch_errors ();
if (!had_errors)
- ret = make_string (name, strlen (name));
+ ret = build_string (name);
if (atom && name) XFree (name);
if (NILP (ret)) ret = empty_unibyte_string;
@@ -2380,7 +2386,7 @@ FRAME is on. If FRAME is nil, the selected frame is used. */)
if (SYMBOLP (atom))
- x_atom = symbol_to_x_atom (dpyinfo, FRAME_X_DISPLAY (f), atom);
+ x_atom = symbol_to_x_atom (dpyinfo, atom);
else if (STRINGP (atom))
{
BLOCK_INPUT;
@@ -2537,17 +2543,8 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, At
else
error ("DEST as a string must be one of PointerWindow or InputFocus");
}
- else if (INTEGERP (dest))
- wdest = (Window) XFASTINT (dest);
- else if (FLOATP (dest))
- wdest = (Window) XFLOAT_DATA (dest);
- else if (CONSP (dest))
- {
- if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
- error ("Both car and cdr for DEST must be numbers");
- else
- wdest = (Window) cons_to_long (dest);
- }
+ else if (INTEGERP (dest) || FLOATP (dest) || CONSP (dest))
+ CONS_TO_INTEGER (dest, Window, wdest);
else
error ("DEST must be a frame, nil, string, number or cons");
@@ -2607,8 +2604,8 @@ syms_of_xselect (void)
property_change_reply = Fcons (Qnil, Qnil);
staticpro (&property_change_reply);
- Vselection_alist = Qnil;
- staticpro (&Vselection_alist);
+ converted_selections = NULL;
+ conversion_fail_tag = None;
DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
doc: /* An alist associating X Windows selection-types with functions.
@@ -2635,7 +2632,7 @@ The functions are called with one argument, the selection type
DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions,
doc: /* A list of functions to be called when Emacs answers a selection request.
-The functions are called with four arguments:
+The functions are called with three arguments:
- the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
- the selection-type which Emacs was asked to convert the
selection into before sending (for example, `STRING' or `LENGTH');
@@ -2647,6 +2644,14 @@ This hook doesn't let you change the behavior of Emacs's selection replies,
it merely informs you that they have happened. */);
Vx_sent_selection_functions = Qnil;
+ DEFVAR_LISP ("x-select-enable-clipboard-manager",
+ Vx_select_enable_clipboard_manager,
+ doc: /* Whether to enable X clipboard manager support.
+If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
+while owning the X clipboard, the clipboard contents are saved to the
+clipboard manager if one is present. */);
+ Vx_select_enable_clipboard_manager = Qt;
+
DEFVAR_INT ("x-selection-timeout", x_selection_timeout,
doc: /* Number of milliseconds to wait for a selection reply.
If the selection owner doesn't reply in this time, we give up.
@@ -2655,25 +2660,26 @@ A value of 0 means wait as long as necessary. This is initialized from the
x_selection_timeout = 0;
/* QPRIMARY is defined in keyboard.c. */
- QSECONDARY = intern_c_string ("SECONDARY"); staticpro (&QSECONDARY);
- QSTRING = intern_c_string ("STRING"); staticpro (&QSTRING);
- QINTEGER = intern_c_string ("INTEGER"); staticpro (&QINTEGER);
- QCLIPBOARD = intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD);
- QTIMESTAMP = intern_c_string ("TIMESTAMP"); staticpro (&QTIMESTAMP);
- QTEXT = intern_c_string ("TEXT"); staticpro (&QTEXT);
- QCOMPOUND_TEXT = intern_c_string ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
- QUTF8_STRING = intern_c_string ("UTF8_STRING"); staticpro (&QUTF8_STRING);
- QDELETE = intern_c_string ("DELETE"); staticpro (&QDELETE);
- QMULTIPLE = intern_c_string ("MULTIPLE"); staticpro (&QMULTIPLE);
- QINCR = intern_c_string ("INCR"); staticpro (&QINCR);
- QEMACS_TMP = intern_c_string ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
- QTARGETS = intern_c_string ("TARGETS"); staticpro (&QTARGETS);
- QATOM = intern_c_string ("ATOM"); staticpro (&QATOM);
- QATOM_PAIR = intern_c_string ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
- QNULL = intern_c_string ("NULL"); staticpro (&QNULL);
- Qcompound_text_with_extensions = intern_c_string ("compound-text-with-extensions");
- staticpro (&Qcompound_text_with_extensions);
-
- Qforeign_selection = intern_c_string ("foreign-selection");
- staticpro (&Qforeign_selection);
+ DEFSYM (QSECONDARY, "SECONDARY");
+ DEFSYM (QSTRING, "STRING");
+ DEFSYM (QINTEGER, "INTEGER");
+ DEFSYM (QCLIPBOARD, "CLIPBOARD");
+ DEFSYM (QTIMESTAMP, "TIMESTAMP");
+ DEFSYM (QTEXT, "TEXT");
+ DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT");
+ DEFSYM (QUTF8_STRING, "UTF8_STRING");
+ DEFSYM (QDELETE, "DELETE");
+ DEFSYM (QMULTIPLE, "MULTIPLE");
+ DEFSYM (QINCR, "INCR");
+ DEFSYM (QEMACS_TMP, "_EMACS_TMP_");
+ DEFSYM (QTARGETS, "TARGETS");
+ DEFSYM (QATOM, "ATOM");
+ DEFSYM (QATOM_PAIR, "ATOM_PAIR");
+ DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER");
+ DEFSYM (QSAVE_TARGETS, "SAVE_TARGETS");
+ DEFSYM (QNULL, "NULL");
+ DEFSYM (Qcompound_text_with_extensions, "compound-text-with-extensions");
+ DEFSYM (Qforeign_selection, "foreign-selection");
+ DEFSYM (Qx_lost_selection_functions, "x-lost-selection-functions");
+ DEFSYM (Qx_sent_selection_functions, "x-sent-selection-functions");
}
diff --git a/src/xsettings.c b/src/xsettings.c
index 2513bcc5aa8..dadbe68b4cb 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -18,6 +18,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 <float.h>
#include <limits.h>
#include <setjmp.h>
#include <fcntl.h>
@@ -32,9 +34,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <X11/Xproto.h>
+#ifdef HAVE_GSETTINGS
+#include <glib-object.h>
+#include <gio/gio.h>
+#endif
+
#ifdef HAVE_GCONF
#include <gconf/gconf-client.h>
#endif
+
#ifdef HAVE_XFT
#include <X11/Xft/Xft.h>
#endif
@@ -46,10 +54,7 @@ static Lisp_Object Qmonospace_font_name, Qfont_name, Qfont_render,
Qtool_bar_style;
static Lisp_Object current_tool_bar_style;
-#ifdef HAVE_GCONF
-static GConfClient *gconf_client;
-#endif
-
+/* Store an config changed event in to the event queue. */
static void
store_config_changed_event (Lisp_Object arg, Lisp_Object display_name)
@@ -62,6 +67,99 @@ store_config_changed_event (Lisp_Object arg, Lisp_Object display_name)
kbd_buffer_store_event (&event);
}
+/* Return non-zero if DPYINFO is still valid. */
+static int
+dpyinfo_valid (struct x_display_info *dpyinfo)
+{
+ int found = 0;
+ if (dpyinfo != NULL)
+ {
+ struct x_display_info *d;
+ for (d = x_display_list; !found && d; d = d->next)
+ found = d == dpyinfo && d->display == dpyinfo->display;
+ }
+ return found;
+}
+
+/* Store a monospace font change event if the monospaced font changed. */
+
+#if defined HAVE_XFT && (defined HAVE_GSETTINGS || defined HAVE_GCONF)
+static void
+store_monospaced_changed (const char *newfont)
+{
+ if (current_mono_font != NULL && strcmp (newfont, current_mono_font) == 0)
+ return; /* No change. */
+
+ xfree (current_mono_font);
+ current_mono_font = xstrdup (newfont);
+
+ if (dpyinfo_valid (first_dpyinfo) && use_system_font)
+ {
+ store_config_changed_event (Qmonospace_font_name,
+ XCAR (first_dpyinfo->name_list_element));
+ }
+}
+#endif
+
+/* Store a font name change event if the font name changed. */
+
+#ifdef HAVE_XFT
+static void
+store_font_name_changed (const char *newfont)
+{
+ if (current_font != NULL && strcmp (newfont, current_font) == 0)
+ return; /* No change. */
+
+ xfree (current_font);
+ current_font = xstrdup (newfont);
+
+ if (dpyinfo_valid (first_dpyinfo))
+ {
+ store_config_changed_event (Qfont_name,
+ XCAR (first_dpyinfo->name_list_element));
+ }
+}
+#endif /* HAVE_XFT */
+
+/* Map TOOL_BAR_STYLE from a string to its correspinding Lisp value.
+ Return Qnil if TOOL_BAR_STYLE is not known. */
+
+static Lisp_Object
+map_tool_bar_style (const char *tool_bar_style)
+{
+ Lisp_Object style = Qnil;
+ if (tool_bar_style)
+ {
+ if (strcmp (tool_bar_style, "both") == 0)
+ style = Qboth;
+ else if (strcmp (tool_bar_style, "both-horiz") == 0)
+ style = Qboth_horiz;
+ else if (strcmp (tool_bar_style, "icons") == 0)
+ style = Qimage;
+ else if (strcmp (tool_bar_style, "text") == 0)
+ style = Qtext;
+ }
+
+ return style;
+}
+
+/* Store a tool bar style change event if the tool bar style changed. */
+
+static void
+store_tool_bar_style_changed (const char *newstyle,
+ struct x_display_info *dpyinfo)
+{
+ Lisp_Object style = map_tool_bar_style (newstyle);
+ if (EQ (current_tool_bar_style, style))
+ return; /* No change. */
+
+ current_tool_bar_style = style;
+ if (dpyinfo_valid (dpyinfo))
+ store_config_changed_event (Qtool_bar_style,
+ XCAR (dpyinfo->name_list_element));
+}
+
+
#define XSETTINGS_FONT_NAME "Gtk/FontName"
#define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle"
@@ -81,55 +179,128 @@ struct xsettings
FcBool aa, hinting;
int rgba, lcdfilter, hintstyle;
double dpi;
-#endif
char *font;
+#endif
+
char *tb_style;
unsigned seen;
};
+#ifdef HAVE_GSETTINGS
+#define GSETTINGS_SCHEMA "org.gnome.desktop.interface"
+#define GSETTINGS_TOOL_BAR_STYLE "toolbar-style"
+
+#ifdef HAVE_XFT
+#define GSETTINGS_MONO_FONT "monospace-font-name"
+#define GSETTINGS_FONT_NAME "font-name"
+#endif
+
+
+/* The single GSettings instance, or NULL if not connected to GSettings. */
+
+static GSettings *gsettings_client;
+
+/* Callback called when something changed in GSettings. */
+
+static void
+something_changed_gsettingsCB (GSettings *settings,
+ gchar *key,
+ gpointer user_data)
+{
+ GVariant *val;
+
+ if (strcmp (key, GSETTINGS_TOOL_BAR_STYLE) == 0)
+ {
+ val = g_settings_get_value (settings, GSETTINGS_TOOL_BAR_STYLE);
+ if (val)
+ {
+ g_variant_ref_sink (val);
+ if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING))
+ {
+ const gchar *newstyle = g_variant_get_string (val, NULL);
+ store_tool_bar_style_changed (newstyle, first_dpyinfo);
+ }
+ g_variant_unref (val);
+ }
+ }
+#ifdef HAVE_XFT
+ else if (strcmp (key, GSETTINGS_MONO_FONT) == 0)
+ {
+ val = g_settings_get_value (settings, GSETTINGS_MONO_FONT);
+ if (val)
+ {
+ g_variant_ref_sink (val);
+ if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING))
+ {
+ const gchar *newfont = g_variant_get_string (val, NULL);
+ store_monospaced_changed (newfont);
+ }
+ g_variant_unref (val);
+ }
+ }
+ else if (strcmp (key, GSETTINGS_FONT_NAME) == 0)
+ {
+ val = g_settings_get_value (settings, GSETTINGS_FONT_NAME);
+ if (val)
+ {
+ g_variant_ref_sink (val);
+ if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING))
+ {
+ const gchar *newfont = g_variant_get_string (val, NULL);
+ store_font_name_changed (newfont);
+ }
+ g_variant_unref (val);
+ }
+ }
+#endif /* HAVE_XFT */
+}
+
+#endif /* HAVE_GSETTINGS */
+
#ifdef HAVE_GCONF
+#define GCONF_TOOL_BAR_STYLE "/desktop/gnome/interface/toolbar_style"
+#ifdef HAVE_XFT
+#define GCONF_MONO_FONT "/desktop/gnome/interface/monospace_font_name"
+#define GCONF_FONT_NAME "/desktop/gnome/interface/font_name"
+#endif
-#define SYSTEM_MONO_FONT "/desktop/gnome/interface/monospace_font_name"
-#define SYSTEM_FONT "/desktop/gnome/interface/font_name"
+/* The single GConf instance, or NULL if not connected to GConf. */
+
+static GConfClient *gconf_client;
-/* Callback called when something changed in GConf that we care about,
- that is SYSTEM_MONO_FONT. */
+/* Callback called when something changed in GConf that we care about. */
static void
-something_changedCB (GConfClient *client,
- guint cnxn_id,
- GConfEntry *entry,
- gpointer user_data)
+something_changed_gconfCB (GConfClient *client,
+ guint cnxn_id,
+ GConfEntry *entry,
+ gpointer user_data)
{
GConfValue *v = gconf_entry_get_value (entry);
+ const char *key = gconf_entry_get_key (entry);
- if (!v) return;
- if (v->type == GCONF_VALUE_STRING)
+ if (!v || v->type != GCONF_VALUE_STRING || ! key) return;
+ if (strcmp (key, GCONF_TOOL_BAR_STYLE) == 0)
{
const char *value = gconf_value_get_string (v);
- if (current_mono_font != NULL && strcmp (value, current_mono_font) == 0)
- return; /* No change. */
-
- xfree (current_mono_font);
- current_mono_font = xstrdup (value);
+ store_tool_bar_style_changed (value, first_dpyinfo);
}
-
-
- if (first_dpyinfo != NULL)
+#ifdef HAVE_XFT
+ else if (strcmp (key, GCONF_MONO_FONT) == 0)
+ {
+ const char *value = gconf_value_get_string (v);
+ store_monospaced_changed (value);
+ }
+ else if (strcmp (key, GCONF_FONT_NAME) == 0)
{
- /* Check if display still open */
- struct x_display_info *dpyinfo;
- int found = 0;
- for (dpyinfo = x_display_list; !found && dpyinfo; dpyinfo = dpyinfo->next)
- found = dpyinfo == first_dpyinfo;
-
- if (found && use_system_font)
- store_config_changed_event (Qmonospace_font_name,
- XCAR (first_dpyinfo->name_list_element));
+ const char *value = gconf_value_get_string (v);
+ store_font_name_changed (value);
}
+#endif /* HAVE_XFT */
}
+
#endif /* HAVE_GCONF */
#ifdef HAVE_XFT
@@ -275,10 +446,10 @@ parse_settings (unsigned char *prop,
want_this =
#ifdef HAVE_XFT
(nlen > 6 && strncmp (name, "Xft/", 4) == 0)
+ || strcmp (XSETTINGS_FONT_NAME, name) == 0
||
#endif
- (strcmp (XSETTINGS_FONT_NAME, name) == 0)
- || (strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0);
+ strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0;
switch (type)
{
@@ -320,17 +491,17 @@ parse_settings (unsigned char *prop,
if (want_this)
{
++settings_seen;
- if (strcmp (name, XSETTINGS_FONT_NAME) == 0)
- {
- settings->font = xstrdup (sval);
- settings->seen |= SEEN_FONT;
- }
- else if (strcmp (name, XSETTINGS_TOOL_BAR_STYLE) == 0)
+ if (strcmp (name, XSETTINGS_TOOL_BAR_STYLE) == 0)
{
settings->tb_style = xstrdup (sval);
settings->seen |= SEEN_TB_STYLE;
}
#ifdef HAVE_XFT
+ else if (strcmp (name, XSETTINGS_FONT_NAME) == 0)
+ {
+ settings->font = xstrdup (sval);
+ settings->seen |= SEEN_FONT;
+ }
else if (strcmp (name, "Xft/Antialias") == 0)
{
settings->seen |= SEEN_AA;
@@ -395,6 +566,10 @@ parse_settings (unsigned char *prop,
return settings_seen;
}
+/* Read settings from the XSettings property window on display for DPYINFO.
+ Store settings read in SETTINGS.
+ Return non-zero if successful, zero if not. */
+
static int
read_settings (struct x_display_info *dpyinfo, struct xsettings *settings)
{
@@ -424,6 +599,8 @@ read_settings (struct x_display_info *dpyinfo, struct xsettings *settings)
return rc != 0;
}
+/* Apply Xft settings in SETTINGS to the Xft library.
+ If SEND_EVENT_P is non-zero store a Lisp event that Xft settings changed. */
static void
apply_xft_settings (struct x_display_info *dpyinfo,
@@ -434,19 +611,17 @@ apply_xft_settings (struct x_display_info *dpyinfo,
FcPattern *pat;
struct xsettings oldsettings;
int changed = 0;
- char buf[256];
memset (&oldsettings, 0, sizeof (oldsettings));
- buf[0] = '\0';
pat = FcPatternCreate ();
XftDefaultSubstitute (dpyinfo->display,
XScreenNumberOfScreen (dpyinfo->screen),
pat);
FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa);
FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting);
-# ifdef FC_HINT_STYLE
+#ifdef FC_HINT_STYLE
FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &oldsettings.hintstyle);
-# endif
+#endif
FcPatternGetInteger (pat, FC_LCD_FILTER, 0, &oldsettings.lcdfilter);
FcPatternGetInteger (pat, FC_RGBA, 0, &oldsettings.rgba);
FcPatternGetDouble (pat, FC_DPI, 0, &oldsettings.dpi);
@@ -458,7 +633,6 @@ apply_xft_settings (struct x_display_info *dpyinfo,
++changed;
oldsettings.aa = settings->aa;
}
- sprintf (buf, "Antialias: %d", oldsettings.aa);
if ((settings->seen & SEEN_HINTING) != 0
&& oldsettings.hinting != settings->hinting)
@@ -468,8 +642,6 @@ apply_xft_settings (struct x_display_info *dpyinfo,
++changed;
oldsettings.hinting = settings->hinting;
}
- if (strlen (buf) > 0) strcat (buf, ", ");
- sprintf (buf+strlen (buf), "Hinting: %d", oldsettings.hinting);
if ((settings->seen & SEEN_RGBA) != 0 && oldsettings.rgba != settings->rgba)
{
FcPatternDel (pat, FC_RGBA);
@@ -477,8 +649,6 @@ apply_xft_settings (struct x_display_info *dpyinfo,
oldsettings.rgba = settings->rgba;
++changed;
}
- if (strlen (buf) > 0) strcat (buf, ", ");
- sprintf (buf+strlen (buf), "RGBA: %d", oldsettings.rgba);
/* Older fontconfig versions don't have FC_LCD_FILTER. */
if ((settings->seen & SEEN_LCDFILTER) != 0
@@ -489,10 +659,8 @@ apply_xft_settings (struct x_display_info *dpyinfo,
++changed;
oldsettings.lcdfilter = settings->lcdfilter;
}
- if (strlen (buf) > 0) strcat (buf, ", ");
- sprintf (buf+strlen (buf), "LCDFilter: %d", oldsettings.lcdfilter);
-# ifdef FC_HINT_STYLE
+#ifdef FC_HINT_STYLE
if ((settings->seen & SEEN_HINTSTYLE) != 0
&& oldsettings.hintstyle != settings->hintstyle)
{
@@ -501,9 +669,7 @@ apply_xft_settings (struct x_display_info *dpyinfo,
++changed;
oldsettings.hintstyle = settings->hintstyle;
}
-# endif
- if (strlen (buf) > 0) strcat (buf, ", ");
- sprintf (buf+strlen (buf), "Hintstyle: %d", oldsettings.hintstyle);
+#endif
if ((settings->seen & SEEN_DPI) != 0 && oldsettings.dpi != settings->dpi
&& settings->dpi > 0)
@@ -523,27 +689,44 @@ apply_xft_settings (struct x_display_info *dpyinfo,
XFRAME (frame)->resy = XFRAME (frame)->resx = settings->dpi;
}
- if (strlen (buf) > 0) strcat (buf, ", ");
- sprintf (buf+strlen (buf), "DPI: %lf", oldsettings.dpi);
-
if (changed)
{
+ static char const format[] =
+ "Antialias: %d, Hinting: %d, RGBA: %d, LCDFilter: %d, "
+ "Hintstyle: %d, DPI: %lf";
+ enum
+ {
+ d_formats = 5,
+ d_growth = INT_BUFSIZE_BOUND (int) - sizeof "%d",
+ lf_formats = 1,
+ max_f_integer_digits = DBL_MAX_10_EXP + 1,
+ f_precision = 6,
+ lf_growth = (sizeof "-." + max_f_integer_digits + f_precision
+ - sizeof "%lf")
+ };
+ char buf[sizeof format + d_formats * d_growth + lf_formats * lf_growth];
+
XftDefaultSet (dpyinfo->display, pat);
if (send_event_p)
store_config_changed_event (Qfont_render,
XCAR (dpyinfo->name_list_element));
- Vxft_settings = make_string (buf, strlen (buf));
+ sprintf (buf, format, oldsettings.aa, oldsettings.hinting,
+ oldsettings.rgba, oldsettings.lcdfilter,
+ oldsettings.hintstyle, oldsettings.dpi);
+ Vxft_settings = build_string (buf);
}
else
FcPatternDestroy (pat);
#endif /* HAVE_XFT */
}
+/* Read XSettings from the display for DPYINFO.
+ If SEND_EVENT_P is non-zero store a Lisp event settings that changed. */
+
static void
read_and_apply_settings (struct x_display_info *dpyinfo, int send_event_p)
{
struct xsettings settings;
- Lisp_Object dpyname = XCAR (dpyinfo->name_list_element);
if (!read_settings (dpyinfo, &settings))
return;
@@ -551,38 +734,29 @@ read_and_apply_settings (struct x_display_info *dpyinfo, int send_event_p)
apply_xft_settings (dpyinfo, True, &settings);
if (settings.seen & SEEN_TB_STYLE)
{
- Lisp_Object style = Qnil;
- if (strcmp (settings.tb_style, "both") == 0)
- style = Qboth;
- else if (strcmp (settings.tb_style, "both-horiz") == 0)
- style = Qboth_horiz;
- else if (strcmp (settings.tb_style, "icons") == 0)
- style = Qimage;
- else if (strcmp (settings.tb_style, "text") == 0)
- style = Qtext;
- if (!NILP (style) && !EQ (style, current_tool_bar_style))
- {
- current_tool_bar_style = style;
- if (send_event_p)
- store_config_changed_event (Qtool_bar_style, dpyname);
- }
+ if (send_event_p)
+ store_tool_bar_style_changed (settings.tb_style, dpyinfo);
+ else
+ current_tool_bar_style = map_tool_bar_style (settings.tb_style);
xfree (settings.tb_style);
}
-
+#ifdef HAVE_XFT
if (settings.seen & SEEN_FONT)
{
- if (!current_font || strcmp (current_font, settings.font) != 0)
+ if (send_event_p)
+ store_font_name_changed (settings.font);
+ else
{
xfree (current_font);
- current_font = settings.font;
- if (send_event_p)
- store_config_changed_event (Qfont_name, dpyname);
+ current_font = xstrdup (settings.font);
}
- else
- xfree (settings.font);
+ xfree (settings.font);
}
+#endif
}
+/* Check if EVENT for the display in DPYINFO is XSettings related. */
+
void
xft_settings_event (struct x_display_info *dpyinfo, XEvent *event)
{
@@ -624,41 +798,130 @@ xft_settings_event (struct x_display_info *dpyinfo, XEvent *event)
read_and_apply_settings (dpyinfo, True);
}
+/* Initialize GSettings and read startup values. */
+
+static void
+init_gsettings (void)
+{
+#ifdef HAVE_GSETTINGS
+ GVariant *val;
+ const gchar *const *schemas;
+ int schema_found = 0;
+
+#ifdef HAVE_G_TYPE_INIT
+ g_type_init ();
+#endif
+
+ schemas = g_settings_list_schemas();
+ if (schemas == NULL) return;
+ while (! schema_found && *schemas != NULL)
+ schema_found = strcmp (*schemas++, GSETTINGS_SCHEMA) == 0;
+ if (!schema_found) return;
+
+ gsettings_client = g_settings_new (GSETTINGS_SCHEMA);
+ if (!gsettings_client) return;
+ g_object_ref_sink (G_OBJECT (gsettings_client));
+ g_signal_connect (G_OBJECT (gsettings_client), "changed",
+ G_CALLBACK (something_changed_gsettingsCB), NULL);
+
+ val = g_settings_get_value (gsettings_client, GSETTINGS_TOOL_BAR_STYLE);
+ if (val)
+ {
+ g_variant_ref_sink (val);
+ if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING))
+ current_tool_bar_style
+ = map_tool_bar_style (g_variant_get_string (val, NULL));
+ g_variant_unref (val);
+ }
+
+#ifdef HAVE_XFT
+ val = g_settings_get_value (gsettings_client, GSETTINGS_MONO_FONT);
+ if (val)
+ {
+ g_variant_ref_sink (val);
+ if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING))
+ current_mono_font = xstrdup (g_variant_get_string (val, NULL));
+ g_variant_unref (val);
+ }
+
+ val = g_settings_get_value (gsettings_client, GSETTINGS_FONT_NAME);
+ if (val)
+ {
+ g_variant_ref_sink (val);
+ if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING))
+ current_font = xstrdup (g_variant_get_string (val, NULL));
+ g_variant_unref (val);
+ }
+#endif /* HAVE_XFT */
+
+#endif /* HAVE_GSETTINGS */
+}
+
+/* Init GConf and read startup values. */
static void
init_gconf (void)
{
-#if defined (HAVE_GCONF) && defined (HAVE_XFT)
+#if defined (HAVE_GCONF)
char *s;
#ifdef HAVE_G_TYPE_INIT
g_type_init ();
#endif
+
gconf_client = gconf_client_get_default ();
- s = gconf_client_get_string (gconf_client, SYSTEM_MONO_FONT, NULL);
+ gconf_client_set_error_handling (gconf_client, GCONF_CLIENT_HANDLE_NONE);
+ gconf_client_add_dir (gconf_client,
+ GCONF_TOOL_BAR_STYLE,
+ GCONF_CLIENT_PRELOAD_ONELEVEL,
+ NULL);
+ gconf_client_notify_add (gconf_client,
+ GCONF_TOOL_BAR_STYLE,
+ something_changed_gconfCB,
+ NULL, NULL, NULL);
+
+ s = gconf_client_get_string (gconf_client, GCONF_TOOL_BAR_STYLE, NULL);
+ if (s)
+ {
+ current_tool_bar_style = map_tool_bar_style (s);
+ g_free (s);
+ }
+
+#ifdef HAVE_XFT
+ s = gconf_client_get_string (gconf_client, GCONF_MONO_FONT, NULL);
if (s)
{
current_mono_font = xstrdup (s);
g_free (s);
}
- s = gconf_client_get_string (gconf_client, SYSTEM_FONT, NULL);
+ s = gconf_client_get_string (gconf_client, GCONF_FONT_NAME, NULL);
if (s)
{
current_font = xstrdup (s);
g_free (s);
}
- gconf_client_set_error_handling (gconf_client, GCONF_CLIENT_HANDLE_NONE);
gconf_client_add_dir (gconf_client,
- SYSTEM_MONO_FONT,
+ GCONF_MONO_FONT,
GCONF_CLIENT_PRELOAD_ONELEVEL,
NULL);
gconf_client_notify_add (gconf_client,
- SYSTEM_MONO_FONT,
- something_changedCB,
+ GCONF_MONO_FONT,
+ something_changed_gconfCB,
NULL, NULL, NULL);
-#endif /* HAVE_GCONF && HAVE_XFT */
+ gconf_client_add_dir (gconf_client,
+ GCONF_FONT_NAME,
+ GCONF_CLIENT_PRELOAD_ONELEVEL,
+ NULL);
+ gconf_client_notify_add (gconf_client,
+ GCONF_FONT_NAME,
+ something_changed_gconfCB,
+ NULL, NULL, NULL);
+#endif /* HAVE_XFT */
+#endif /* HAVE_GCONF */
}
+/* Init Xsettings and read startup values. */
+
static void
init_xsettings (struct x_display_info *dpyinfo)
{
@@ -683,8 +946,12 @@ xsettings_initialize (struct x_display_info *dpyinfo)
if (first_dpyinfo == NULL) first_dpyinfo = dpyinfo;
init_gconf ();
init_xsettings (dpyinfo);
+ init_gsettings ();
}
+/* Return the system monospaced font.
+ May be NULL if not known. */
+
const char *
xsettings_get_system_font (void)
{
@@ -692,6 +959,9 @@ xsettings_get_system_font (void)
}
#ifdef USE_LUCID
+/* Return the system font.
+ May be NULL if not known. */
+
const char *
xsettings_get_system_normal_font (void)
{
@@ -705,9 +975,7 @@ DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font,
doc: /* Get the system default application font. */)
(void)
{
- return current_font
- ? make_string (current_font, strlen (current_font))
- : Qnil;
+ return current_font ? build_string (current_font) : Qnil;
}
DEFUN ("font-get-system-font", Ffont_get_system_font, Sfont_get_system_font,
@@ -715,9 +983,7 @@ DEFUN ("font-get-system-font", Ffont_get_system_font, Sfont_get_system_font,
doc: /* Get the system default fixed width font. */)
(void)
{
- return current_mono_font
- ? make_string (current_mono_font, strlen (current_mono_font))
- : Qnil;
+ return current_mono_font ? build_string (current_mono_font) : Qnil;
}
DEFUN ("tool-bar-get-system-style", Ftool_bar_get_system_style,
@@ -744,16 +1010,16 @@ syms_of_xsettings (void)
current_mono_font = NULL;
current_font = NULL;
first_dpyinfo = NULL;
+#ifdef HAVE_GSETTINGS
+ gsettings_client = NULL;
+#endif
#ifdef HAVE_GCONF
gconf_client = NULL;
#endif
- Qmonospace_font_name = intern_c_string ("monospace-font-name");
- staticpro (&Qmonospace_font_name);
- Qfont_name = intern_c_string ("font-name");
- staticpro (&Qfont_name);
- Qfont_render = intern_c_string ("font-render");
- staticpro (&Qfont_render);
+ DEFSYM (Qmonospace_font_name, "monospace-font-name");
+ DEFSYM (Qfont_name, "font-name");
+ DEFSYM (Qfont_render, "font-render");
defsubr (&Sfont_get_system_font);
defsubr (&Sfont_get_system_normal_font);
@@ -770,14 +1036,13 @@ If this variable is nil, Emacs ignores system font changes. */);
#ifdef HAVE_XFT
Fprovide (intern_c_string ("font-render-setting"), Qnil);
-#ifdef HAVE_GCONF
+#if defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
Fprovide (intern_c_string ("system-font-setting"), Qnil);
#endif
#endif
current_tool_bar_style = Qnil;
- Qtool_bar_style = intern_c_string ("tool-bar-style");
- staticpro (&Qtool_bar_style);
+ DEFSYM (Qtool_bar_style, "tool-bar-style");
defsubr (&Stool_bar_get_system_style);
Fprovide (intern_c_string ("dynamic-setting"), Qnil);
diff --git a/src/xsmfns.c b/src/xsmfns.c
index c199036587f..cb56ae648d1 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -190,7 +190,7 @@ smc_save_yourself_CB (SmcConn smcConn,
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
- props[props_idx]->vals[0].length = strlen (SSDATA (Vinvocation_name));
+ props[props_idx]->vals[0].length = SBYTES (Vinvocation_name);
props[props_idx]->vals[0].value = SDATA (Vinvocation_name);
++props_idx;
@@ -200,7 +200,7 @@ smc_save_yourself_CB (SmcConn smcConn,
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
- props[props_idx]->vals[0].length = strlen (SSDATA (Vuser_login_name));
+ props[props_idx]->vals[0].length = SBYTES (Vuser_login_name);
props[props_idx]->vals[0].value = SDATA (Vuser_login_name);
++props_idx;
@@ -398,7 +398,7 @@ x_session_initialize (struct x_display_info *dpyinfo)
char errorstring[SM_ERRORSTRING_LEN];
char* previous_id = NULL;
SmcCallbacks callbacks;
- int name_len = 0;
+ ptrdiff_t name_len = 0;
ice_fd = -1;
doing_interact = False;
@@ -410,8 +410,8 @@ x_session_initialize (struct x_display_info *dpyinfo)
/* Construct the path to the Emacs program. */
if (! EQ (Vinvocation_directory, Qnil))
- name_len += strlen (SSDATA (Vinvocation_directory));
- name_len += strlen (SSDATA (Vinvocation_name));
+ name_len += SBYTES (Vinvocation_directory);
+ name_len += SBYTES (Vinvocation_name);
/* This malloc will not be freed, but it is only done once, and hopefully
not very large */
@@ -457,7 +457,7 @@ x_session_initialize (struct x_display_info *dpyinfo)
if (smc_conn != 0)
{
- Vx_session_id = make_string (client_id, strlen (client_id));
+ Vx_session_id = build_string (client_id);
#ifdef USE_GTK
/* GTK creats a leader window by itself, but we need to tell
diff --git a/src/xterm.c b/src/xterm.c
index 20259b7ab2e..20516ee9d6f 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -342,7 +342,7 @@ static struct scroll_bar *x_window_to_scroll_bar (Display *, Window);
static void x_scroll_bar_report_motion (struct frame **, Lisp_Object *,
enum scroll_bar_part *,
Lisp_Object *, Lisp_Object *,
- unsigned long *);
+ Time *);
static void x_handle_net_wm_state (struct frame *, XPropertyEvent *);
static void x_check_fullscreen (struct frame *);
static void x_check_expected_move (struct frame *, int, int);
@@ -356,7 +356,7 @@ static int x_dispatch_event (XEvent *, Display *);
interference with debugging failing X calls. */
static void x_connection_closed (Display *, const char *);
static void x_wm_set_window_state (struct frame *, int);
-static void x_wm_set_icon_pixmap (struct frame *, int);
+static void x_wm_set_icon_pixmap (struct frame *, ptrdiff_t);
static void x_initialize (void);
@@ -753,22 +753,22 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring
if (sb_width > 0)
{
- int left = WINDOW_SCROLL_BAR_AREA_X (w);
- int width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w)
- * FRAME_COLUMN_WIDTH (f));
+ 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 (left + width == p->x)
- bx = left + sb_width;
- else if (p->x + p->wd == left)
- bx = left;
+ 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 = width - sb_width;
+ nx = bar_area_width - sb_width;
by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
row->y));
ny = row->visible_height;
@@ -776,13 +776,13 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring
}
else
{
- if (left + width == bx)
+ if (bar_area_x + bar_area_width == bx)
{
- bx = left + sb_width;
- nx += width - sb_width;
+ bx = bar_area_x + sb_width;
+ nx += bar_area_width - sb_width;
}
- else if (bx + nx == left)
- nx += width - sb_width;
+ else if (bx + nx == bar_area_x)
+ nx += bar_area_width - sb_width;
}
}
}
@@ -1010,7 +1010,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 inline void
x_set_mode_line_face_gc (struct glyph_string *s)
{
s->gc = s->face->gc;
@@ -1021,7 +1021,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 inline void
x_set_glyph_string_gc (struct glyph_string *s)
{
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
@@ -1066,7 +1066,7 @@ x_set_glyph_string_gc (struct glyph_string *s)
/* Set clipping for output of glyph string S. S may be part of a mode
line or menu if we don't have X toolkit support. */
-static INLINE void
+static inline void
x_set_glyph_string_clipping (struct glyph_string *s)
{
XRectangle *r = s->clip;
@@ -1139,7 +1139,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 inline void
x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h)
{
XGCValues xgcv;
@@ -1446,6 +1446,8 @@ x_frame_of_widget (Widget widget)
}
+#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
@@ -1461,6 +1463,8 @@ x_alloc_lighter_color_for_widget (Widget widget, Display *display, Colormap cmap
return x_alloc_lighter_color (f, display, cmap, pixel, factor, delta);
}
+#endif
+
/* Structure specifying which arguments should be passed by Xt to
cvt_string_to_pixel. We want the widget's screen and colormap. */
@@ -1693,16 +1697,18 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
a least-squares matching, which is what X uses for closest
color matching with StaticColor visuals. */
int nearest, i;
- unsigned long nearest_delta = ~ (unsigned long) 0;
+ int max_color_delta = 255;
+ int max_delta = 3 * max_color_delta;
+ int nearest_delta = max_delta + 1;
int ncells;
const XColor *cells = x_color_cells (dpy, &ncells);
for (nearest = i = 0; i < ncells; ++i)
{
- long dred = (color->red >> 8) - (cells[i].red >> 8);
- long dgreen = (color->green >> 8) - (cells[i].green >> 8);
- long dblue = (color->blue >> 8) - (cells[i].blue >> 8);
- unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue;
+ int dred = (color->red >> 8) - (cells[i].red >> 8);
+ int dgreen = (color->green >> 8) - (cells[i].green >> 8);
+ int dblue = (color->blue >> 8) - (cells[i].blue >> 8);
+ int delta = dred * dred + dgreen * dgreen + dblue * dblue;
if (delta < nearest_delta)
{
@@ -3232,6 +3238,34 @@ x_scroll_run (struct window *w, struct run *run)
fringe of W. */
window_box (w, -1, &x, &y, &width, &height);
+#ifdef USE_TOOLKIT_SCROLL_BARS
+ /* 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 (bar_area_x + bar_area_width == x)
+ {
+ x = bar_area_x + sb_width;
+ width += bar_area_width - sb_width;
+ }
+ else if (x + width == bar_area_x)
+ width += bar_area_width - sb_width;
+ }
+ }
+#endif
+
from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y);
to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y);
bottom_y = y + height;
@@ -3609,23 +3643,23 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo)
/* Convert between the modifier bits X uses and the modifier bits
Emacs uses. */
-unsigned int
-x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, unsigned int state)
+EMACS_INT
+x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
{
- EMACS_UINT mod_meta = meta_modifier;
- EMACS_UINT mod_alt = alt_modifier;
- EMACS_UINT mod_hyper = hyper_modifier;
- EMACS_UINT 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;
tem = Fget (Vx_alt_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_alt = XUINT (tem);
+ if (INTEGERP (tem)) mod_alt = XINT (tem);
tem = Fget (Vx_meta_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_meta = XUINT (tem);
+ if (INTEGERP (tem)) mod_meta = XINT (tem);
tem = Fget (Vx_hyper_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_hyper = XUINT (tem);
+ if (INTEGERP (tem)) mod_hyper = XINT (tem);
tem = Fget (Vx_super_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_super = XUINT (tem);
+ if (INTEGERP (tem)) mod_super = XINT (tem);
return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0)
@@ -3636,24 +3670,24 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, unsigned int state)
| ((state & dpyinfo->hyper_mod_mask) ? mod_hyper : 0));
}
-static unsigned int
-x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, unsigned int state)
+static int
+x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state)
{
- EMACS_UINT mod_meta = meta_modifier;
- EMACS_UINT mod_alt = alt_modifier;
- EMACS_UINT mod_hyper = hyper_modifier;
- EMACS_UINT 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 (! EQ (tem, Qnil)) mod_alt = XUINT (tem);
+ if (INTEGERP (tem)) mod_alt = XINT (tem);
tem = Fget (Vx_meta_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_meta = XUINT (tem);
+ if (INTEGERP (tem)) mod_meta = XINT (tem);
tem = Fget (Vx_hyper_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_hyper = XUINT (tem);
+ if (INTEGERP (tem)) mod_hyper = XINT (tem);
tem = Fget (Vx_super_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_super = XUINT (tem);
+ if (INTEGERP (tem)) mod_super = XINT (tem);
return ( ((state & mod_alt) ? dpyinfo->alt_mod_mask : 0)
@@ -3799,7 +3833,7 @@ redo_mouse_highlight (void)
static void
XTmouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y,
- long unsigned int *timestamp)
+ Time *timestamp)
{
FRAME_PTR f1;
@@ -4197,7 +4231,7 @@ x_send_scroll_bar_event (Lisp_Object window, int part, int portion, int whole)
size_t old_nbytes = scroll_bar_windows_size * sizeof *scroll_bar_windows;
if ((size_t) -1 / sizeof *scroll_bar_windows < new_size)
- memory_full ();
+ memory_full (SIZE_MAX);
scroll_bar_windows = (struct window **) xrealloc (scroll_bar_windows,
nbytes);
memset (&scroll_bar_windows[i], 0, nbytes - old_nbytes);
@@ -5534,7 +5568,7 @@ x_scroll_bar_note_movement (struct scroll_bar *bar, XEvent *event)
static void
x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window,
enum scroll_bar_part *part, Lisp_Object *x,
- Lisp_Object *y, long unsigned int *timestamp)
+ Lisp_Object *y, Time *timestamp)
{
struct scroll_bar *bar = XSCROLL_BAR (last_mouse_scroll_bar);
Window w = bar->x_window;
@@ -6410,8 +6444,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
keys". It seems there's no cleaner way.
Test IsModifierKey to avoid handling
mode_switch incorrectly. */
- || ((unsigned) (keysym) >= XK_Select
- && (unsigned)(keysym) < XK_KP_Space)
+ || (XK_Select <= keysym && keysym < XK_KP_Space)
#endif
#ifdef XK_dead_circumflex
|| orig_keysym == XK_dead_circumflex
@@ -6464,10 +6497,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
should be treated similarly to
Mode_switch by Emacs. */
#if defined XK_ISO_Lock && defined XK_ISO_Last_Group_Lock
- || ((unsigned)(orig_keysym)
- >= XK_ISO_Lock
- && (unsigned)(orig_keysym)
- <= XK_ISO_Last_Group_Lock)
+ || (XK_ISO_Lock <= orig_keysym
+ && orig_keysym <= XK_ISO_Last_Group_Lock)
#endif
))
{
@@ -7396,7 +7427,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, int
int
x_bitmap_icon (struct frame *f, Lisp_Object file)
{
- int bitmap_id;
+ ptrdiff_t bitmap_id;
if (FRAME_X_WINDOW (f) == 0)
return 1;
@@ -7422,7 +7453,7 @@ x_bitmap_icon (struct frame *f, Lisp_Object file)
/* Create the GNU bitmap and mask if necessary. */
if (FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id < 0)
{
- int rc = -1;
+ ptrdiff_t rc = -1;
#ifdef USE_GTK
@@ -8053,7 +8084,7 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name)
{
#ifdef HAVE_X11R6_XIM
struct xim_inst_t *xim_inst;
- int len;
+ ptrdiff_t len;
xim_inst = (struct xim_inst_t *) xmalloc (sizeof (struct xim_inst_t));
dpyinfo->xim_callback_data = xim_inst;
@@ -9570,7 +9601,7 @@ x_wm_set_window_state (struct frame *f, int state)
}
static void
-x_wm_set_icon_pixmap (struct frame *f, int pixmap_id)
+x_wm_set_icon_pixmap (struct frame *f, ptrdiff_t pixmap_id)
{
Pixmap icon_pixmap, icon_mask;
@@ -9642,8 +9673,6 @@ 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)
{
- Lisp_Object frame;
-
xassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
if (font->driver->check)
xassert (font->driver->check (f, font) == 0);
@@ -9689,8 +9718,8 @@ same_x_server (const char *name1, const char *name2)
{
int seen_colon = 0;
const char *system_name = SSDATA (Vsystem_name);
- int system_name_length = strlen (system_name);
- int length_until_period = 0;
+ ptrdiff_t system_name_length = SBYTES (Vsystem_name);
+ ptrdiff_t length_until_period = 0;
while (system_name[length_until_period] != 0
&& system_name[length_until_period] != '.')
@@ -10158,7 +10187,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
{ "_EMACS_TMP_", &dpyinfo->Xatom_EMACS_TMP },
{ "TARGETS", &dpyinfo->Xatom_TARGETS },
{ "NULL", &dpyinfo->Xatom_NULL },
+ { "ATOM", &dpyinfo->Xatom_ATOM },
{ "ATOM_PAIR", &dpyinfo->Xatom_ATOM_PAIR },
+ { "CLIPBOARD_MANAGER", &dpyinfo->Xatom_CLIPBOARD_MANAGER },
{ "_XEMBED_INFO", &dpyinfo->Xatom_XEMBED_INFO },
/* For properties of font. */
{ "PIXEL_SIZE", &dpyinfo->Xatom_PIXEL_SIZE },
@@ -10241,7 +10272,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
= XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
gray_bitmap_bits,
gray_bitmap_width, gray_bitmap_height,
- (unsigned long) 1, (unsigned long) 0, 1);
+ 1, 0, 1);
}
#ifdef HAVE_X_I18N
@@ -10667,11 +10698,8 @@ syms_of_xterm (void)
staticpro (&last_mouse_scroll_bar);
last_mouse_scroll_bar = Qnil;
- staticpro (&Qvendor_specific_keysyms);
- Qvendor_specific_keysyms = intern_c_string ("vendor-specific-keysyms");
-
- staticpro (&Qlatin_1);
- Qlatin_1 = intern_c_string ("latin-1");
+ DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms");
+ DEFSYM (Qlatin_1, "latin-1");
staticpro (&last_mouse_press_frame);
last_mouse_press_frame = Qnil;
@@ -10680,8 +10708,7 @@ syms_of_xterm (void)
xg_default_icon_file = make_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
staticpro (&xg_default_icon_file);
- Qx_gtk_map_stock = intern_c_string ("x-gtk-map-stock");
- staticpro (&Qx_gtk_map_stock);
+ DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock");
#endif
DEFVAR_BOOL ("x-use-underline-position-properties",
diff --git a/src/xterm.h b/src/xterm.h
index fbd638fe73b..a4767361bb3 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -158,7 +158,7 @@ struct x_display_info
/* Emacs bitmap-id of the default icon bitmap for this frame.
Or -1 if none has been allocated yet. */
- int icon_bitmap_id;
+ ptrdiff_t icon_bitmap_id;
/* The root window of this screen. */
Window root_window;
@@ -202,10 +202,10 @@ struct x_display_info
struct x_bitmap_record *bitmaps;
/* Allocated size of bitmaps field. */
- int bitmaps_size;
+ ptrdiff_t bitmaps_size;
/* Last used bitmap index. */
- int bitmaps_last;
+ ptrdiff_t bitmaps_last;
/* Which modifier keys are on which modifier bits?
@@ -254,7 +254,7 @@ struct x_display_info
Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE,
Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING,
Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL,
- Xatom_ATOM_PAIR;
+ Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER;
/* More atoms for font properties. The last three are private
properties, see the comments in src/fontset.h. */
@@ -490,7 +490,7 @@ struct x_output
/* If >=0, a bitmap index. The indicated bitmap is used for the
icon. */
- int icon_bitmap;
+ ptrdiff_t icon_bitmap;
/* Default ASCII font of this frame. */
struct font *font;
@@ -973,10 +973,12 @@ extern void x_delete_terminal (struct terminal *terminal);
extern unsigned long x_copy_color (struct frame *, unsigned long);
#ifdef USE_X_TOOLKIT
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 void x_activate_timeout_atimer (void);
#endif
extern int x_alloc_nearest_color (struct frame *, Colormap, XColor *);
extern void x_query_colors (struct frame *f, XColor *, int);
@@ -989,8 +991,7 @@ extern void x_mouse_leave (struct x_display_info *);
#ifdef USE_X_TOOLKIT
extern int x_dispatch_event (XEvent *, Display *);
#endif
-extern unsigned int x_x_to_emacs_modifiers (struct x_display_info *,
- unsigned);
+extern EMACS_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 *);
@@ -1025,10 +1026,12 @@ extern Lisp_Object x_property_data_to_lisp (struct frame *,
Atom,
int,
unsigned long);
+extern void x_clipboard_manager_save_frame (Lisp_Object);
+extern void x_clipboard_manager_save_all (void);
/* Defined in xfns.c */
-extern struct x_display_info * check_x_display_info (Lisp_Object frame);
+extern struct x_display_info * check_x_display_info (Lisp_Object);
extern Lisp_Object x_get_focus_frame (struct frame *);
#ifdef USE_GTK
@@ -1068,7 +1071,9 @@ extern void x_free_dpy_colors (Display *, Screen *, Colormap,
/* Defined in xmenu.c */
+#if defined USE_GTK || defined USE_MOTIF
extern void x_menu_set_in_use (int);
+#endif
#ifdef USE_MOTIF
extern void x_menu_wait_for_event (void *data);
#endif
diff --git a/test/ChangeLog b/test/ChangeLog
index 1311d66e280..add4d9c7664 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,8 @@
+2011-05-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * automated/gnus-tests.el: Add wrapper for Gnus tests.
+ Require CL.
+
2011-05-09 Juri Linkov <juri@jurta.org>
* automated/occur-tests.el: Move from test/occur-testsuite.el.
diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el
index f6f6f74b681..ff056b40b36 100644
--- a/test/automated/ert-x-tests.el
+++ b/test/automated/ert-x-tests.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2008, 2010-2011 Free Software Foundation, Inc.
;; Author: Phil Hagelberg
-;; Author: Christian Ohler <ohler@gnu.org>
+;; Christian Ohler <ohler@gnu.org>
;; This file is part of GNU Emacs.
diff --git a/test/automated/gnus-tests.el b/test/automated/gnus-tests.el
new file mode 100644
index 00000000000..f5742261d5b
--- /dev/null
+++ b/test/automated/gnus-tests.el
@@ -0,0 +1,35 @@
+;;; gnus-tests.el --- Wrapper for the Gnus tests
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.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/>.
+
+;;; Commentary:
+
+;; This file should contain nothing but requires for all the Gnus
+;; tests that are not standalone.
+
+;;; Code:
+;; registry.el is required by gnus-registry.el but this way we're explicit.
+(eval-when-compile (require 'cl))
+
+(require 'registry)
+(require 'gnus-registry)
+
+(provide 'gnus-tests)
+;;; gnus-tests.el ends here
diff --git a/test/eshell.el b/test/eshell.el
index 3b392e84c24..8a9e62a759a 100644
--- a/test/eshell.el
+++ b/test/eshell.el
@@ -396,7 +396,7 @@
(eshell-command-result-p "+ ${+ 1 2} 3" "6\n"))
(eshell-deftest var interp-lisp
- "Interpolate Lisp form evalution"
+ "Interpolate Lisp form evaluation"
(eshell-command-result-p "+ $(+ 1 2) 3" "6\n"))
(eshell-deftest var interp-concat