Mercurial > hg > xemacs-beta
changeset 20:859a2309aef8 r19-15b93
Import from CVS: tag r19-15b93
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 08:49:44 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 08:50:05 2007 +0200 @@ -1,4 +1,12 @@ -*- indented-text -*- +to 19.15 beta93 +-- VM-6.13 Courtesy of Kyle Jones +-- Custom-1.30 +-- Replicating extents are history +-- tm-7.103.5 +-- Miscellaneous bug fixes +-- Synch to 20.0 patches + to 19.15 beta92 -- gnus-5.4.11 -- tm-7.103.1
--- a/configure Mon Aug 13 08:49:44 2007 +0200 +++ b/configure Mon Aug 13 08:50:05 2007 +0200 @@ -1688,6 +1688,9 @@ ;; ## Data General AViiON Machines + i586-dg-dgux5.4R4* | i586-dg-dgux5.4.4* ) + machine=aviion opsys=dgux5-4r4 + ;; m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) machine=aviion opsys=dgux5-4r3 ;;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-group-subscribe-up.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,12 @@ +#define noname_width 32 +#define noname_height 32 +static char noname_bits[] = { + 0x08,0x04,0x00,0x40,0x22,0x51,0x55,0x15,0x88,0x04,0x00,0x20,0x22,0xa0,0xaa, + 0x4a,0xc4,0xff,0x3f,0x00,0x61,0x80,0x60,0x55,0x54,0x8a,0xa0,0x80,0x42,0x84, + 0x20,0x2b,0x68,0x8a,0xe0,0x83,0x42,0x80,0x00,0x2a,0xd4,0xff,0x00,0x42,0x41, + 0x80,0x00,0x16,0x54,0x8a,0x00,0x42,0x41,0x84,0x00,0x2a,0x54,0x8a,0x00,0x82, + 0x41,0x80,0x00,0x2a,0xd4,0xff,0x00,0x82,0x42,0x80,0x00,0x2a,0x68,0x8a,0x00, + 0x82,0x44,0x84,0x00,0x2a,0x52,0x8a,0x00,0x42,0x40,0x80,0x00,0x16,0xea,0xff, + 0x00,0x22,0x40,0x80,0x00,0x4a,0x4a,0x80,0x00,0x02,0x61,0x80,0x00,0x56,0x44, + 0x80,0x00,0x02,0x51,0x80,0x00,0x52,0xc4,0xff,0xff,0x0b,0xa1,0x04,0x00,0x42, + 0x14,0xa8,0xaa,0x88,0x82,0x02,0x00,0x22};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-group-subscribe-up.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,38 @@ +/* XPM */ +static char * icon-unsubscribe_xpm[] = { +"32 32 3 1", +" c #BFBFBFBFBFBF s backgroundToolBarColor", +". c #000000000000", +"X c #FFFFFFFFFFFF", +" ", +" ", +" ", +" ", +" ................ ", +" .XXXXXXXX.XXXXX.. ", +" .XX.X.XXX.XXXXX.X. ", +" .XXX.XXXX.XXXXX.XX. ", +" .XX.X.XXX.XXXXX..... ", +" .XXXXXXXX.XXXXXXXXX. ", +" ..........XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XX.X.XXX.XXXXXXXXX. ", +" .XXX.XXXX.XXXXXXXXX. ", +" .XX.X.XXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" ..........XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XX.X.XXX.XXXXXXXXX. ", +" .XXX.XXXX.XXXXXXXXX. ", +" .XX.X.XXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" ..........XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .................... ", +" ", +" ", +" "};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-group-unsubscribe-up.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,12 @@ +#define noname_width 32 +#define noname_height 32 +static char noname_bits[] = { + 0x08,0x04,0x00,0x40,0x22,0x51,0x55,0x15,0x88,0x04,0x00,0x20,0x22,0xa0,0xaa, + 0x4a,0xc4,0xff,0x3f,0x00,0x61,0x80,0x60,0x55,0x54,0xa0,0xa0,0x80,0x42,0x90, + 0x20,0x2b,0x68,0x8a,0xe0,0x83,0x42,0x84,0x00,0x2a,0xd4,0xff,0x00,0x42,0x41, + 0x80,0x00,0x16,0x54,0xa0,0x00,0x42,0x41,0x90,0x00,0x2a,0x54,0x8a,0x00,0x82, + 0x41,0x84,0x00,0x2a,0xd4,0xff,0x00,0x82,0x42,0x80,0x00,0x2a,0x68,0xa0,0x00, + 0x82,0x44,0x90,0x00,0x2a,0x52,0x8a,0x00,0x42,0x40,0x84,0x00,0x16,0xea,0xff, + 0x00,0x22,0x40,0x80,0x00,0x4a,0x4a,0x80,0x00,0x02,0x61,0x80,0x00,0x56,0x44, + 0x80,0x00,0x02,0x51,0x80,0x00,0x52,0xc4,0xff,0xff,0x0b,0xa1,0x04,0x00,0x42, + 0x14,0xa8,0xaa,0x88,0x82,0x02,0x00,0x22};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-group-unsubscribe-up.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,38 @@ +/* XPM */ +static char * icon-subscribe_xpm[] = { +"32 32 3 1", +" c #BFBFBFBFBFBF s backgroundToolBarColor", +". c #000000000000", +"X c #FFFFFFFFFFFF", +" ", +" ", +" ", +" ", +" ................ ", +" .XXXXXXXX.XXXXX.. ", +" .XXXXXX.X.XXXXX.X. ", +" .XXXXX.XX.XXXXX.XX. ", +" .XX.X.XXX.XXXXX..... ", +" .XXX.XXXX.XXXXXXXXX. ", +" ..........XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXX.X.XXXXXXXXX. ", +" .XXXXX.XX.XXXXXXXXX. ", +" .XX.X.XXX.XXXXXXXXX. ", +" .XXX.XXXX.XXXXXXXXX. ", +" ..........XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXX.X.XXXXXXXXX. ", +" .XXXXX.XX.XXXXXXXXX. ", +" .XX.X.XXX.XXXXXXXXX. ", +" .XXX.XXXX.XXXXXXXXX. ", +" ..........XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .XXXXXXXX.XXXXXXXXX. ", +" .................... ", +" ", +" ", +" "};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-pointer.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,6 @@ +#define noname_width 18 +#define noname_height 13 +static char noname_bits[] = { + 0x00,0x00,0x00,0xc0,0x0c,0x00,0xe0,0x1f,0x00,0x92,0x39,0x00,0x0e,0x71,0x02, + 0x46,0xe0,0x03,0x20,0xc0,0x01,0x00,0x08,0x00,0x10,0x0d,0x00,0xc4,0x08,0x00, + 0x78,0x08,0x00,0x18,0x89,0x00,0x00,0x08,0x00};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-summary-catchup-up.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,12 @@ +#define noname_width 32 +#define noname_height 32 +static char noname_bits[] = { + 0x11,0x91,0x11,0x95,0x54,0x25,0x54,0x21,0x02,0x90,0x00,0x84,0xa0,0x0a,0x54, + 0x29,0x1b,0xb1,0x11,0x91,0x40,0x0a,0x4a,0x25,0x8a,0xa0,0x20,0x88,0x20,0x14, + 0x0e,0x22,0x9b,0x51,0xb7,0x99,0x20,0x14,0x0b,0x02,0x42,0xc1,0x22,0x28,0x14, + 0x92,0x48,0x45,0x51,0x19,0x11,0x11,0x14,0x42,0xaa,0x54,0x42,0x88,0x00,0x02, + 0x90,0x72,0xaa,0x56,0x15,0x71,0x11,0x17,0x42,0x3a,0x49,0x4b,0x28,0x49,0xa4, + 0x22,0x04,0x30,0x02,0x09,0xb1,0xdb,0x59,0xb5,0x15,0xa0,0xd3,0xff,0x40,0x05, + 0xbf,0x02,0x2a,0xd3,0x08,0x54,0x91,0x53,0x77,0x7f,0xc8,0xa9,0xd4,0x8a,0x62, + 0x22,0x86,0x35,0xc8,0x5b,0x4b,0x67,0x93,0xfd,0x91,0x39,0x24,0x18,0xff,0x7a, + 0x90,0x46,0xc5,0xcf,0x25,0x94,0x21,0xf1};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-summary-catchup-up.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,37 @@ +/* XPM */ +static char * icon-catchup2_xpm[] = { +"32 32 2 1", +" c #000000000000", +". c #BFBFBFBFBFBF s backgroundToolBarColor", +" ... ... ... ... ... ... ... ...", +"................................", +"................................", +"................................", +" ... ... ... ... ... ... ... ...", +"................................", +"................................", +"................. .............", +" ... ... ... ... . ... ... ...", +"................ ..............", +"............... ................", +"................................", +" ... ... ... ... ... ... ... ...", +"................................", +"................................", +"............. .......... .....", +" ... ... ... . ... ... . ...", +"............ .......... ......", +"........... ........... ........", +"............ .......... .......", +" ... ... ... . . ... ... ... ...", +"............... ..... ", +"................ ... ......", +"........ ..... ... ...... .....", +" ... .. .. . . . . .. . .", +"....... .... .... ... .. . ... ", +"...... ...... ... ..... ... ...", +"...... .. .... ...... .. ..", +" ... ... . ... .. .. ..", +"........... .... . .... .", +".......... ..... ..... .. .", +".......... ..... ....... ... "};
--- a/etc/vm/help-up.xpm Mon Aug 13 08:49:44 2007 +0200 +++ b/etc/vm/help-up.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -3,7 +3,7 @@ "64 42 6 1", "X c Gray75 s backgroundToolBarColor", "i c Gray20", -"@ c yellow", +"@ c rgb:00/df/ff", "T c red", "t c pink", "o c black",
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-colorful-dn.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,137 @@ +/* XPM */ +static char *mime-colorful-dn[] = { +/* width height num_colors chars_per_pixel */ +" 64 42 88 2", +/* colors */ +".. c #878787", +".# c #818181", +".a c #7f7f7f", +".b c #939393", +".c c #969696", +".d c #979797", +".e c #9f9f9f", +".f c #a7a7a7", +".g c #a1a1a1", +".h c #a5a5a5", +".i c #aeaeae", +".j c #adadad", +".k c #959595", +".l c #9a9a9a", +".m c #939393", +".n c #868686", +".o c #828282", +".p c #8b8b8b", +".q c #a3a3a3", +".r c #838383", +".s c #8e8e8e", +".t c #a2a2a2", +".u c #7d7d7d", +".v c #7b7b7b", +".w c #797979", +".x c #767676", +".y c #757575", +".z c #757575", +".A c #777777", +".B c #727272", +".C c #6f6f6f", +".D c #6a6a6a", +".E c #636363", +".F c #6b6b6b", +".G c #8a8a8a", +".H c #8e8e8e", +".I c #676767", +".J c #6e6e6e", +".K c #7a7a7a", +".L c #626262", +".M c #7e7e7e", +".N c #8d8d8d", +".O c #565656", +".P c #505050", +".Q c #4d4d4d", +".R c #494949", +".S c #434343", +".T c #404040", +".U c #575757", +".V c #393939", +".W c #3d3d3d", +".X c #3f3f3f", +".Y c #4f4f4f", +".Z c #585858", +".0 c #5b5b5b", +".1 c #5a5a5a", +".2 c #858585", +".3 c #5e5e5e", +".4 c #4b4b4b", +".5 c #7b7b7b", +".6 c #3a3a3a", +".7 c #636363", +".8 c #444444", +".9 c #3c3c3c", +"#. c #353535", +"## c #515151", +"#a c #323232", +"#b c #6c6c6c", +"#c c #6a6a6a", +"#d c #6f6f6f", +"#e c #2a2a2a", +"#f c #666666", +"#g c #838383", +"#h c #2d2d2d", +"#i c #737373", +"#j c #8f8f8f", +"#k c #6c6c6c", +"#l c #a3a3a3", +"#m c #9f9f9f", +"#n c Gray60", +"#o c #969696", +"#p c #b0b0b0", +"#q c #ababab", +"#r c #9e9e9e", +"#s c #9a9a9a", +"#t c #8a8a8a", +"#u c Gray60", +"#v c #a7a7a7", +/* pixels */ +"...#.#.......a.a.#.....b.b.c.d.d.d.e.d.e.e.e.e.e.e.f.g.g.h.h.e.f.h.i.h.h.f.h.h.f.h.j.j.f.h.f.j.f.h.j.h.j.h.g.e.e.e.d.d.k.c.l.b.m", +".b.n...........o...p.b.b.b.b.c.d.d.e.c.d.e.e.e.d.g.e.e.e.g.l.g.e.e.g.g.e.g.q.f.h.h.h.g.h.h.h.j.i.h.h.h.h.e.e.e.e.l.e.c.d.e.c.m.c", +".r.r...#...........b.b.b.s.b.m.d.d.c.l.e.d.l.e.d.e.m.d.l.d.e.e.e.e.e.e.e.e.d.g.d.e.e.e.h.g.f.h.h.h.h.f.h.g.t.e.e.d.e.d.c.c.d.c.c", +".#.o.a.#.#.#...#.......p...b.b.b.m.k.d.b.d.d.m.b.b.d.d.b.b.b.m.k.d.d.d.d.d.b.m.k.d.d.d.d.g.g.g.e.e.g.e.g.e.e.d.d.d.d.d.b.k.b.b.d", +".s.......#.#.#...#.o.#.....#.....p.....p.......#.a.#.#.......#.............b.b.b...b.b.k.e.c.e.d.e.d.e.d.e.e.d.d.k.c.b.b.m.b.m.d", +".#.#.o.r.a.u.a.u.o.u.u.u.a.#.o.u.u.r.u.u.u.v.u.w.w.x.u.u.u.u.u.u.a.#.o.#.o.............s.s.b.k.k.k.b.k.b.m.b.b.s.......s...b.s.b", +"...a.u.u.w.u.u.y.w.z.z.u.u.u.z.u.w.z.y.z.z.u.z.z.z.z.z.y.u.w.u.z.#.a.u.#.a.#.#.#...#.....#...........p.b.b...#.o.o.a.o.o.#.s.s.s", +".a.w.z.u.w.z.w.w.w.z.A.u.z.z.z.B.z.z.A.z.A.z.A.y.z.C.A.z.z.y.w.w.w.a.o.a.#.#.o.a.o...o...#...#.#.#.#.r.#.#...o.a.a.o.u.a.o.o.#..", +".#.o.u.z.z.z.z.B.B.z.y.B.z.B.B.B.B.B.B.B.B.B.B.B.C.B.B.w.w.w.w.x.u.w.u.u.o...a...#.....#.#...n.#.#.#.n...#.#.o.#.#.....#.o.r.#.#", +".w.a.w.w.B.B.B.z.B.B.z.B.B.D.C.B.C.B.B.C.D.C.E.C.C.F.z.B.B.B.w.B.u.u.u.u.u.#.#.#.....G.......H...#.#.#.........#.....H..........", +".w.x.z.z.B.B.z.C.z.B.B.B.C.C.D.C.E.I.C.E.E.D.D.C.B.F.B.B.F.z.w.w.w.u.#.v.o.a...........G...G...b.s.H.s.H.....G.s.H...G.b.s......", +".w.x.z.B.B.z.A.z.B.B.B.F.C.B.F.E.C.E.E.C.E.F.E.B.J.B.B.B.w.w.w.w.w.o.u.#.o.#.#...n.#.....s...p.s.b...b.b...G.b...G.b...p.b...G..", +".w.w.w.x.B.#.B.w.B.F.B.B.F.D.B.D.B.D.D.I.F.E.C.D.B.B.F.z.z.z.B.w.z.w.o.K.u.#.o.w.o.n...#.G.....H.b...s.G.b.b.s.H.p.b.b.s...G...#", +".u.w.w.w.w.w.w.K.u.z.B.B.B.F.B.B.C.D.C.E.F.L.E.L.L.I.E.F.C.C.B.F.B.C.C.z.z.u.M.w.a.o.a.#.....H...s.G.b.b.N...b.....p...s.G.N...#", +".a.w.a.w.a.o.a.u.y.w.B.B.B.B.C.E.L.O.P.P.Q.R.S.S.T.Q.R.R.R.P.P.U.O.L.L.L.E.B.F.B.B.x.w.M.w.#.o.o.#.#.......s.....s.s.G...s......", +".#...o...o.r.a.#.u.u.B.C.F.E.P.U.R.V.P.R.V.W.T.V.V.X.S.S.T.Q.R.P.Y.Z.0.1.Z.1.L.1.E.L.B.B.B.x.w.w.o.2...#...G...#.n.s...G.....#..", +".....#...#.o.r.a.w.w.B.F.3.P.Z.4.R.R.Q.V.S.S.T.W.V.S.V.S.V.S.S.W.R.P.Z.U.L.0.0.L.0.U.L.E.F.C.z.w.a.5.#.#.o.#...#...n.o.#...o....", +".........#.o.a.o.x.x.C.O.Z.U.R.Y.R.R.R.W.W.S.S.W.W.V.6.6.W.S.W.W.R.S.W.R.S.R.P.Z.L.L.L.0.0.0.7.F.B.x.w.w.K.o.o.o.o...n.....n....", +".s.H.......o.a.w.x.F.U.Z.U.Y.P.R.Y.R.S.S.8.R.6.S.S.6.S.W.6.9.9.9.9#..9#..6.S.R.Y.U.Z.P##.L.L.0.L.0.F.F.B.x.x.M.o.5...n.n.o...G..", +".b.s.H...#.n.K.x.F.1.L.L.P.P.4.Y.R.8.Z.Y.L.Z.V.W.R.S.W#..9#.#..6.S.8.8.W.6.W.R.R.R.R.R.Z.L.L.F.L.L.U.0.F.F.M.w.M.o.n.2...o......", +".s.s...n.#.o.w.F.L.L.L.1.L.L.U.Z.Z.Z.Z.5.7.R.S.S.R.S.9#a.9#.#.#b#b#c.Z.R.W.S.S.Y.R.Y.R.Y.Y.U.7.L.L.F.L.E.F.F.M.M.w.M.o.n.....G.s", +".s.G.....o.K.M.1.F.F.E.F.L.L.Z#d.o.K.n.n.7.Z.Z.Y.S.W#a#e#a#e.6#d#d.5#b.R.8.S.Y#d.Z.R.R.R.8.Z.Z.U.7.F.B#d.C.B.x.A.#.o.a...G.H.b.k", +".s.N.G...o.5.B.F.C.C.3.F.F#f#d.n.K.o.n#g#c.Z.Z.Z.S.6#.#e#h#..8#d.5#g.5.Z.8.Y.U.5.5#c.Y.Y.Y.R.Y.L.L.F.F.B.x.F.A.x.5..#g.....b.k.k", +".H.s...n.o.w.C.F.B.C.C.F#f.M.o#g.n.n.H.G.5#d.U.Y.Y.6#.#a#.#..6#d#b.5#d.Z.Y.Z.7#g.n.5#d.Z.R.Y.Y.P.L.7.F.F.B.o.K.#.o.n...G.H.b.H.d", +".s.H.....#.w.B.B#i.F#d.B.o.n.n.H.H.n.H#j.5.Z.Z.Z.L.U.Z.Y.6#..W.7#d.7#d.Z.7.7#d.H#j.H.G.5.Z.U.4.Z.Z.L.L#k.A.w.5.o.....G.m.b.k.b.k", +".s.H...n.#.w.w.x.B.z.B.5.5.n#g.n.n.H#j.H#g#c.L.L#d#d#d.7.Y.R.W.Y.7#d.7.Y.Z#c.n#l#m.G#m.H.A.7.F.L.0.L.C.A.B.F.o.....G.b.H.k.d.d.g", +".k.H.....n.#.o.w#n#n#n#n#n.n.n.n.H#m.k#o.H.5#c#c#b#b#c#d#d#d#d.7#b#b#d#c#d#d#p#q#l#n#n.5.A.x.M.M.A.A#d.F#d.#.N.G.b.k.k.k.d.g.k.g", +".b.H.G...n.#.o.5#n#n.B.x#n#n.n.H.k#r.k.t.t.H#d#c#b#b#d#d#c.5#d#d#d#d#d#b#d#l#p.t#q#n#n.M.M.M.M.M.M.o.G.H.G.H.b.k.k.k.d.g#s.d.g#m", +".H.k.H.H...o.n#n#n.B.B.B#n#n.n.G#n#n#n#n.t#m#g#n#n#n#n#d#d#d#n#n#n#n#d#d#r#n#n#l#n#n.5.5#n#n#n#n.M.5.n.b.k.k.k.k.g.b#m.b.g.g.g.k", +".d#m.b.k.#.o.o#n#n.x.B.B#n#n.n#n#n.k#l#n#n#p#n#n#d#d#n#n#d#n#n#d#b#n#n.k#n#n#q#n#n#n.n#n#n.M.M#n.o.n.s.G.b.k.g.k.b#m.k.g.g#r.g.k", +".b.k.b.k...o#n#n.o.w.B.B#n#n#n#n.G.k#r#n#n#n#n#r.5.5#b#d#n#n#b#d#d#n#n#n#n#p#r.H#n#n#n#n.M.A#g#n.o.n.H.H.d#m.d.g.g.g.g.g.e.g.g.g", +".k.d.g.k.H.o#n#n.w.B.w#n#n.M#n#n#n#n#n#n#r#n#n#l.t#m.H#g#n#n.5.H#n#n#p#n#n#m.G#n#n#t#n#n#n#n#n#n.H.k.H.k.d.g#m.g.g.g.g.g.h.g.g.g", +".g.e.d.d.H.o#n#n.x.w.w#n#n#n#n.o#g.n.o#g#n#n.s#m#r#n#n#n#n#m#m#u#u#n#n#n#m.G#u#u#n#u#u.n#u#u.n.n.H.H.k#u#u.e#u#u#u#u#u.g.h.h.f.h", +".e.k.g.k.b#n#n.M.M.M#n#n.5#n#n.a.o#n#n.n#n#n.G.H#n#n.s#n#n.H.H#u#u#u#n#n.N#u#u#u#j#u#u.N#u#u#u.H.H.b#u#u#u.g#u#u.h.h.g#q.h#q.h.h", +".e#m.d.d.b#n#n#n#n#n#n.o.w.M#n#n#n#n.w.5.##n#n#n#n.H.H.G#n#n#n#u#u#u.G#n#n#u#u#u.H#u#u#n#u#u#u.k.k.H#u#u#u.g#u#u.g.h.h.h.h.i.h.g", +".d.g.g.k.d.k.p.s...#...n.5.5.#.5.M.A.M.#.5.o...5.n.G...n#g.G#g#u#u#u#u.n#u#u#u#u.k#u#u.b#u#u#u#u.g#u#u#u#u.h#u#u#u#u#u.h#v.f.f#q", +".g.g.g.g.d.d.b.G.H...G.....n.o.o.A.o.s.M.#.n.5.o.o.n.o#g.x.n.n#u#u.b#u.G#u.k#u#u.H#u#u.g#u#u.g#u.g#u.h#u#u.i#u#u.i.g.i.f.i.g.h.i", +".g.t.g.g.d.e.k.b.H.H.G.H.G.....5.o.n.o.5...5.G.o.n.....G.M.G..#u#u.d#u#u#u#m#u#u.k#u#u.g#u#u.g#u#u#u.h#u#u.h#u#u.h#q.f#q.h.i.h.j", +".t.h.h.g.g#r.d.d.H.s.H.b.H.H.G.G.......n.G...G.n.G.H.H.H.n.H.H#u#u.g#m#u.g#m#u#u#r#u#u#r#u#u.h#q#u#q.h#u#u.i#u#u#q.h#q.h.i#q.i.h", +".g.t.h.g.g.g.k.d.k.b.H.b.H.k.b.H.G.s.n.H.G.H.H.s.H.k.d.k.s.H.H#u#u#m#m#u#s#m#u#u#m#u#u#m#u#u#q.g#u.g#q#u#u.i#u#u#u#u#u#q.h.i.h#q", +".h.h#v.h.g.g.g#m.d.d.k.d.k.k.k.d.H.k.G.s.H.b.b.k.b.d.b.H.e#m.H.k.g#m#m.g#r.g.g#q.g.h#q.h#q.g#q.h#q#q.h.i.i.h.i.i.i.i.h.i.h.i.h.f", +".g.g.h.f.h.g.g.e.d.g.b.k.d.k.b.k.k.k.d.b.b.k.k.k.d.d.d.g.k.g.k.g#r.g.g.g.t.g.h#q#m.h#v#q.h#q.h#q#q#q.i#q.i.h.h#q.h.i.h.i.h.f.i.h" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-colorful-up.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,133 @@ +/* XPM */ +static char * mime-fancy-up_xpm[] = { +"64 42 88 1", +" c #B8B878785050", +". c #B0B070705050", +"X c #B0B070704848", +"o c #C8C880806060", +"O c #C8C888885858", +"+ c #C8C888886060", +"@ c #D0D090906868", +"# c #D8D898987070", +"$ c #D0D090907070", +"% c #D0D098987070", +"& c #D8D8A0A08080", +"* c #D8D8A0A07878", +"= c #C0C088886060", +"- c #D0D088886060", +"; c #C0C088885858", +": c #B0B078785858", +"> c #B0B070705858", +", c #C0C078785858", +"< c #D0D098986868", +"1 c #B8B870705050", +"2 c #C0C080805050", +"3 c #C8C898987070", +"4 c #A8A870704848", +"5 c #B0B068684848", +"6 c #A8A868684848", +"7 c #A0A068684848", +"8 c #A8A860604848", +"9 c #A0A068684040", +"0 c #A0A068685050", +"q c #A0A060604848", +"w c #989860604848", +"e c #989858584040", +"r c #909050504040", +"t c #909060604040", +"y c #B8B878786060", +"u c #B8B880806060", +"i c #909058584040", +"p c #989860604040", +"a c #A0A070704848", +"s c #808058584040", +"d c #A8A870705050", +"f c #B8B880805858", +"g c #787848483838", +"h c #686848483838", +"j c #686840404040", +"k c #606040403838", +"l c #585838383838", +"z c #505038383838", +"x c #787848484040", +"c c #484830303838", +"v c #484838383838", +"b c #505038383030", +"n c #606048484040", +"m c #707050504040", +"M c #787850504040", +"N c #808048484040", +"B c #B0B078785050", +"V c #808050504040", +"C c #606040404040", +"Z c #A0A070705050", +"A c #404038383838", +"S c #808058584848", +"D c #505040403838", +"F c #484838383030", +"G c #404030303030", +"H c #686848484040", +"J c #383830303030", +"K c #808068685050", +"L c #888860604848", +"P c #888868685050", +"I c #303028282828", +"U c #888858584848", +"Y c #A8A878785858", +"T c #383828282828", +"R c #989868684848", +"E c #B8B880806868", +"W c #909060604848", +"Q c #C8C898987878", +"! c #C8C890907878", +"~ c #FFFFFFFFFFFF", +"^ c #C0C088886868", +"/ c #D0D0A8A88888", +"( c #D0D0A0A08080", +") c #C8C890907070", +"_ c #C8C888887070", +"` c #B0B080805858", +"' c #000000000000", +"] c #D0D098988080", +" .. XX. ooO+++@+@@@@@@#$$%%@#%&%%#%%#%**#%#*#%*%*%$@@@++=O-o;", +"o: > ,ooooO++@O+@@@+$@@@$-$@@$$@$<#%%%$%%%*&%%%%@@@@-@O+@O;O", +"11 . ooo2o;++O-@+-@+@;+-+@@@@@@@@+$+@@@%$#%%%%#%$3@@+@+OO+OO", +".>X... . , ooo;=+o++;oo++ooo;=+++++o;=++++$$$@@$@$@@+++++o=oo+", +"2 ... .>. . , , .X.. . ooo oo=@O@+@+@+@@++=Ooo;o;+", +"..>1X4X4>444X.>44144454667444444X.>.> 22o===o=o;oo2 2 o2o", +" X446448699444946989949999984649.X4.X... . . ,oo .>>X>>.222", +"X69469666904999q990909089w0998666X>X..>X> > . ....1.. >XX>4X>>. ", +".>49999qq98q9qqqqqqqqqqqwqq666674644> X . .. :...: ..>.. .>1..", +"6X66qqq9qq9qqewqwqqwewrwwt9qqq6q44444... y u ... . u ", +"6799qq9w9qqqwwewriwrreewqtqqt96664.5>X y y o2u2u y2u yo2 ", +"679qq909qqqtwqtrwrrwrtrqpqqq66666>4.>.. :. 2 ,2o oo yo yo ,o y ", +"6667q.q6qtqqteqeqeeitrweqqt999q696>a4.>6>: .y uo 2yoo2u,oo2 y .", +"4666666a49qqqtqqwewrtsrssirtwwqtqww994d6X>X. u 2yoof o , 2yf .", +"X6X6X>X486qqqqwrsghhjkllzjkkkhhxgsssrqtqq76d6.>>.. 2 22y 2 ", +". > >1X.44qwtrhxkchkcvzccbllzjkhnmMNmNsNrsqqq766>B . y .:2 y . ", +" . .>1X66qtVhmCkkjcllzvclclcllvkhmxsMMsMxsrtw96XZ..>. . :>. > ", +" .>X>77wgmxknkkkvvllvvcAAvlvvklvklkhmsssMMMStq766a>>>> : : ", +"2u >X67txmxnhknkllDkAllAlvAFFFFGFGAlknxmhHssMsMttq77d>Z ::> y ", +"o2u .:a7tNsshhCnkDmnsmcvklvGFGGAlDDvAvkkkkkmsstssxMttd6d>:B > ", +"22 :.>6tsssNssxmmmmZSkllklFJFGGKKLmkvllnknknnxSsstsrttdd6d>: y2", +"2y >adNttrtssmP>a::SmmnlvJIJIAPPZKkDlnPmkkkDmmxStqPwq70.>X yuo=", +"2fy >ZqtwwVttUP:a>:YLmmmlAGITGDPZYZmDnxZZLnnnknssttq7t07Z Y o==", +"u2 :>6wtqwwtUd>Y::uyZPxnnAGJGGAPKZPmnmSY:ZPmknnhsSttq>a.>: yuou+", +"2u .6qqRtPq>::uu:uEZmmmsxmnAGvSPSPmSSPuEuyZmxCmmssW06Z> y;o=o=", +"2u :.667q9qZZ:Y::uEuYLssPPPSnkvnSPSnmL:Q!y!u0StsMsw0qt> you=++$", +"=u :.>6~~~~~:::u!=^uZLLKKLPPPPSKKPLPP/(Q~~Z07dd00PtP.fyo===+$=$", +"ouy :.>Z~~q7~~:u=)=33uPLKKPPLZPPPPPKPQ/3(~~dddddd>yuyuo===+$_+$!", +"u=uu >:~~qqq~~:y~~~~3!Y~~~~PPP~~~~PP)~~Q~~ZZ~~~~dZ:o====$o!o$$$=", +"+!o=.>>~~7qq~~:~~=Q~~/~~PP~~P~~PK~~=~~(~~~:~~dd~>:2yo=$=o!=$$)$=", +"o=o= >~~>6qq~~~~y=)~~~~)ZZKP~~KPP~~~~/)u~~~~d0Y~>:uu+!+$$$$$@$$$", +"=+$=u>~~6q6~~d~~~~~~)~~Q3!uY~~Zu~~/~~!y~~`~~~~~~u=u=+$!$$$$$%$$$", +"$@++u>~~766~~~~>Y:>Y~~2!)~~~~!!''~~~!y''~'':''::uu=''@'''''$%%#%", +"@=$=o~~ddd~~Z~~X>~~:~~yu~~2~~uu'''~~f'''E''f'''uuo'''$''%%$(%(%%", +"@!++o~~~~~~>6d~~~~6Z.~~~~uuy~~~'''y~~'''u''~'''==u'''$''$%%%%&%$", +"+$$=+=,2 . :ZZ.Zd0d.Z> Z:y :YyY'''':''''=''o''''$''''%'''''%]##(", +"$$$$++oyu y :>>0>2d.:Z>>:>Y7::''o'y'=''u''$''$'$'%''&''&$&#&$%&", +"$3$$+@=ouuyuy Z>:>Z Zy>: ydy ''+'''!''=''$''$'''%''%''%(#(%&%*", +"3%%$$)++u2uouuyy :y y:yuuu:uu''$!'$!'')'')''%('(%''&''(%(%&(&%", +"$3%$$$=+=ouou=ouy2:uyuu2u=+=2uu''!!'_!''!''!''($'$(''&'''''(%&%(", +"%%]%$$$!++=+===+u=y2uoo=o+ou@!u=$!!$)$$($%(%($(%((%&&%&&&&%&%&%#", +"$$%#%$$@+$o=+=o===+oo===+++$=$=$)$$$3$%(!%](%(%(((&(&%%(%&%&%#&%"};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-colorful-xx.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,134 @@ +/* XPM */ +static char * mime-fancy-up_xpm[] = { +"64 42 89 1", +" c #B8B878785050", +". c #B0B070705050", +"X c #B0B070704848", +"o c #C8C880806060", +"O c #C8C888885858", +"+ c #C8C888886060", +"@ c #D0D090906868", +"# c #D8D898987070", +"$ c #D0D090907070", +"% c #D0D098987070", +"& c #D8D8A0A08080", +"* c #D8D8A0A07878", +"= c #C0C088886060", +"- c #D0D088886060", +"; c #C0C088885858", +": c #B0B078785858", +"> c #B0B070705858", +", c #C0C078785858", +"< c #D0D098986868", +"1 c #B8B870705050", +"2 c #C0C080805050", +"3 c #C8C898987070", +"4 c #A8A870704848", +"5 c #B0B068684848", +"6 c #A8A868684848", +"7 c #A0A068684848", +"8 c #A8A860604848", +"9 c #A0A068684040", +"0 c #A0A068685050", +"q c #A0A060604848", +"w c #989860604848", +"e c #989858584040", +"r c #909050504040", +"t c #909060604040", +"y c #B8B878786060", +"u c #B8B880806060", +"i c #909058584040", +"p c #989860604040", +"a c #A0A070704848", +"s c #808058584040", +"d c #A8A870705050", +"f c #B8B880805858", +"g c #787848483838", +"h c #686848483838", +"j c #686840404040", +"k c #606040403838", +"l c #585838383838", +"z c #505038383838", +"x c #787848484040", +"c c #484830303838", +"v c #484838383838", +"b c #505038383030", +"n c #606048484040", +"m c #707050504040", +"M c #787850504040", +"N c #808048484040", +"B c #B0B078785050", +"V c #808050504040", +"C c #606040404040", +"Z c #A0A070705050", +"A c #404038383838", +"S c #808058584848", +"D c #505040403838", +"F c #484838383030", +"G c #404030303030", +"H c #686848484040", +"J c #383830303030", +"K c #808068685050", +"L c #888860604848", +"P c #888868685050", +"I c #303028282828", +"U c #888858584848", +"Y c #A8A878785858", +"T c #383828282828", +"R c #989868684848", +"E c #B8B880806868", +"W c #909060604848", +"Q c #C8C898987878", +"! c #C8C890907878", +"~ c Gray60", +"^ c #C0C088886868", +"/ c #D0D0A8A88888", +"( c #D0D0A0A08080", +") c #C8C890907070", +"_ c #C8C888887070", +"` c #B0B080805858", +"' c Gray60", +"] c #D0D098988080", +"[ c black s backgroundToolBarColor", +" [.[ [X[.[ [o[+[+[+[@[@[@[$[%[@[%[%[#[%[%[*[%[*[%[%[%[@[@[+[O[o[", +"[:[ [ [>[,[o[o[+[@[+[@[+[@[@[-[@[$[@[<[%[%[%[%[&[%[%[@[@[@[+[O[O", +"1[ [ [ [ [o[2[;[+[-[+[@[@[+[+[@[@[@[@[$[@[@[$[%[%[#[$[@[+[+[O[O[", +"[>[.[.[.[ [,[o[o[=[o[+[o[+[o[o[=[+[+[o[=[+[+[$[@[$[$[@[+[+[o[o[+", +"2[ [.[.[.[.[ [ [,[ [ [ [X[.[ [.[ [ [ [o[ [o[@[@[@[@[@[+[=[o[;[;[", +"[.[1[4[4[4[4[.[4[1[4[5[6[7[4[4[4[.[.[ [ [ [2[o[=[o[o[o[2[ [2[o[o", +" [4[6[4[6[9[4[9[6[8[9[9[9[9[4[4[.[4[X[.[ [ [.[ [ [,[o[.[>[>[.[2[", +"[6[4[9[6[9[4[9[q[9[9[9[8[w[9[8[6[X[X[.[X[ [ [ [.[.[.[ [X[>[X[>[ ", +".[4[9[9[q[8[9[q[q[q[q[q[w[q[6[6[4[4[>[X[.[ [.[:[.[:[.[>[.[ [>[.[", +"[X[6[q[9[q[q[e[q[q[w[w[w[t[q[q[q[4[4[.[.[ [ [ [ [.[ [ [.[ [ [ [ ", +"6[9[q[9[9[q[w[e[r[w[r[e[q[q[t[6[6[.[>[ [ [ [ [ [2[2[ [y[u[y[2[ [", +"[7[q[9[9[q[t[q[r[r[w[t[q[q[q[6[6[>[.[.[ [.[ [ [2[ [o[y[ [o[,[ [ ", +"6[6[q[q[q[q[t[q[q[e[t[w[q[t[9[q[9[>[4[>[>[ [y[ [o[2[o[2[,[o[ [ [", +"[6[6[6[a[9[q[t[q[e[r[s[s[i[t[w[t[w[9[4[6[>[.[ [ [y[o[ [ [,[2[f[.", +"X[X[X[X[8[q[q[w[s[h[j[l[z[k[k[h[g[s[r[t[q[6[6[>[.[ [ [ [2[y[2[ [", +"[ [ [1[.[4[w[r[x[c[k[v[c[b[l[j[h[m[N[N[N[s[q[7[6[B[.[y[.[2[y[ [ ", +" [.[.[1[6[q[V[m[k[j[l[z[c[c[c[l[k[m[s[M[M[s[t[9[X[.[>[ [ [>[ [ [", +"[ [ [>[>[7[g[x[n[k[v[l[v[c[A[l[v[l[k[k[m[s[M[M[t[7[6[>[>[ [ [:[ ", +"2[ [ [X[7[x[x[h[n[l[D[A[l[l[A[F[F[F[A[k[x[h[s[M[M[t[7[d[Z[:[>[y[", +"[2[ [:[7[N[s[h[n[D[n[m[v[l[G[G[A[D[v[v[k[k[m[s[s[x[t[d[d[:[ [ [ ", +"2[ [.[6[s[s[s[x[m[m[S[l[k[F[F[G[K[m[v[l[k[k[n[S[s[s[t[d[6[>[ [y[", +"[y[ [a[N[t[t[s[P[a[:[m[n[v[I[I[P[Z[k[l[P[k[k[m[x[t[P[q[0[>[ [u[=", +"2[y[>[q[w[V[t[P[a[:[L[m[l[G[T[D[Z[Z[D[x[Z[n[n[n[s[t[7[0[Z[Y[ [=[", +"[2[:[6[t[w[t[d[Y[:[y[P[n[A[J[G[P[Z[m[m[Y[Z[m[n[h[S[t[>[.[:[y[o[+", +"2[ [.[q[R[P[>[:[u[u[Z[m[s[m[A[v[P[P[S[P[E[y[m[C[m[s[0[Z[ [y[o[o[", +"[u[:[6[7[9[Z[:[:[u[u[L[s[P[S[k[n[P[n[L[Q[y[u[S[s[s[0[t[ [y[u[+[$", +"=[ [:[>[~[~[~[:[u[=[u[L[K[L[P[P[K[P[P[/[Q[~[0[d[0[P[P[f[o[=[+[=[", +"[u[ [.[Z[~[7[~[u[)[3[u[L[K[P[Z[P[P[K[Q[3[~[d[d[d[>[u[u[=[=[$[+[!", +"u[u[ [:[~[q[~[:[~[~[3[Y[~[~[P[~[~[P[)[~[~[Z[~[~[d[:[=[=[$[![$[$[", +"[![=[>[~[7[q[~[~[=[~[/[~[P[~[~[P[~[=[~[~[~[~[d[~[:[y[=[=[![$[)[=", +"o[o[ [~[>[q[~[~[y[)[~[~[Z[K[~[K[P[~[~[)[~[~[d[Y[>[u[+[+[$[$[@[$[", +"[+[=[>[~[q[~[d[~[~[~[~[Q[![Y[~[u[~[~[![~[`[~[~[~[=[=[$[$[$[$[$[$", +"$[+[u[~[7[6[~[~[Y[>[~[2[)[~[~[!['[~[!['[~['['[:[u[=['['['['[%[#[", +"[=[=[~[d[d[~[~[X[~[:[~[u[~[~[u['['[~['['['[f['[u[o['[$['[%[([([%", +"@[+[o[~[~[~[6[~[~[6[.[~[~[u[~[~['[y[~['[u['['['[=['['['[$[%[%[%[", +"[$[=[=[2[.[:[Z[Z[0[.[>[Z[y[:[y['['[:['['['[o['['['['[%['['[%[#[(", +"$[$[+[o[u[y[ [>[0[2[.[Z[>[>[7[:['['['['[u['['[$[$[%['['[&[&[&[%[", +"[3[$[@[o[u[u[ [Z[:[Z[Z[>[ [y[y['[+['[!['['[$['['['['[%['[([([&[*", +"3[%[$[+[u[u[u[y[ [ [y[y[y[u[:[u['[![$['[)['['[%['[%['['[([([&[&[", +"[3[$[$[+[o[o[=[u[2[u[u[2[=[=[u['[!['[!['['[!['[$[$['[&['['[([&[(", +"%[][$[$[+[=[=[=[u[y[u[o[o[o[@[u[$[![)[$[$[([([([([%[&[&[&[%[%[%[", +"[$[#[$[@[$[=[=[=[=[o[=[=[+[$[$[$[$[$[$[([%[([([([([([%[([&[&[#[%"};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-dn.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,26 @@ +#define e_width 64 +#define e_height 42 +static char e_bits[] = { + 0x39,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xf7,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x42,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x8f,0xda,0x7f,0xb8,0xff,0xff,0xff,0xff,0x0c,0x41,0x02,0x00,0xf4, + 0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0xed,0xbf,0xed,0x00,0x00,0x00,0x00, + 0x44,0x2f,0x64,0xb2,0x02,0x00,0x00,0x00,0xb0,0x66,0x4c,0x36,0x00,0x00,0x00, + 0x00,0x00,0xff,0x78,0xff,0x00,0x00,0x00,0x00,0xd0,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x92,0xfd,0xff,0xff,0x00,0x00,0x00,0x00,0x44,0xf7,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0xf2,0xff,0x7f,0x20,0x00,0x00,0x00,0x00,0xc0,0xfc,0xff, + 0x3e,0x00,0x00,0x00,0x00,0x00,0x77,0xbf,0x6b,0x00,0x00,0x00,0x00,0x00,0x50, + 0xf7,0xaf,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0x3f,0x00,0x00,0x00,0x0a,0x00, + 0x80,0xfe,0x2f,0x00,0x00,0x68,0x00,0x00,0x00,0xff,0x2f,0x00,0x00,0x68,0x00, + 0x00,0x00,0xfc,0x1f,0x00,0x0d,0x3c,0x00,0x00,0x00,0xfa,0x1f,0x80,0x0e,0x3c, + 0x02,0x00,0x00,0xfe,0x1f,0xc0,0x0f,0x3c,0x80,0x01,0x20,0xff,0x0f,0xf0,0x0f, + 0x20,0x80,0x07,0x80,0xff,0x0f,0xe0,0x1f,0x00,0xc0,0x0f,0xc0,0xff,0x5f,0xff, + 0x1f,0x00,0xc0,0x07,0xc0,0xff,0x5f,0xf3,0x3f,0x00,0xe0,0x07,0xfe,0xff,0xff, + 0xf1,0xff,0xc7,0xf3,0xf3,0xfc,0xff,0xef,0xf1,0xff,0x6c,0xfe,0x9f,0xff,0xff, + 0xff,0xf1,0xff,0x30,0xfe,0xcf,0xff,0xff,0xff,0xd8,0xff,0xbf,0xff,0xff,0xff, + 0xff,0xff,0xf8,0xff,0x7f,0x3e,0xc9,0x27,0xf8,0x7f,0x6c,0xff,0x7f,0x1c,0x89, + 0x23,0xff,0xff,0xcf,0xe3,0x7f,0x1c,0x89,0x23,0xff,0xff,0x0d,0x60,0x7f,0x08, + 0x09,0x21,0xf8,0xff,0xff,0xa6,0x6f,0x2a,0x49,0x25,0xff,0xff,0x7f,0xd7,0x6f, + 0x22,0x49,0x24,0xff,0xff,0xff,0xff,0x7f,0x36,0xc9,0x26,0xff,0xff,0xff,0xff, + 0x7f,0x36,0xc9,0x26,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-simple-dn.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,57 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"64 42 8 1", +/* colors */ +"` c Gray60", +"a c #666666666666", +"b c #9A9A9A9A9A9A", +"c c #B0B0B0B0B0B0", +"d c #2A2A2A2A2A2A", +"e c #878787878787", +"f c Gray60", +"g c #434343434343", +/* pixels */ +"eeeeeeeeeeebbbbbbbbbbbbbbcbbccbccccccccccccccccccccccbbbbbbbbbbb", +"beeeeeeeeebbbbbbbbbbbbbbbbbbbbbbbbbbbbccccbcccccccccbbbbbbbbbbbb", +"eeeeeeeeebbbebbbbbbbbbbbbbbbbbbbbbbbbbbbbbbcbcccccccbbbbbbbbbbbb", +"eeeeeeeeeeeeebbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeebbbebbbbbbbbbbbbbbbbbbbbbbb", +"eeeeeeeeeeeeeeeeeeeeeeeeeaeeeeeeeeeeeeeeeeeeebbbbbbbbbbeeeeeebeb", +"eeeeeeeaeaaeeeaeeaaaaeaaaaaaeeeaeeeeeeeeeeeeeeeeeeebbeeeeeeeeeee", +"eeaeeaeeeaeeaaaaaaeaeaeaaaeaaaeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee", +"eeeaaaaaaaaaaaaaaaaaaaaaaaaeeeeaeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee", +"eeeeaaaaaaaaaaaaaaaaaaaaaaaaaaeaeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee", +"eaaaaaaaaaaaaaaaaaaaaaaaaaaaaaeeeeeeeeeeeeeeeeebeeeeeeeeeeebeeee", +"eaaaaaeaaaaaaaaaaaaaaaaaaaaaeeeeeeeeeeeeeeeeeeeebebbeebeebeebeee", +"eeeaaeaeaaaaaaaaaaaaaaaaaaaaaaaeaeeeeeeeeeeeeeeebeeebbeeebbeeeee", +"eeeeeeeeeaaaaaaaaaaaaaaaaaaaaaaaaaaaaeeeeeeeeeeeeebbeebeeeeeeeee", +"eeeeeeeeaeaaaaaaaagggggggggggggaaaaaaaaaaaeeeeeeeeeeeeeeeeeeeeee", +"eeeeeeeeeeaaaagagggggggggggggggggaaaaaaaaaaaaaeeeeeeeeeeeeeeeeee", +"eeeeeeeeeeaaagagggggggggggggggggggaaaaaaaaaaaaaeeeeeeeeeeeeeeeee", +"eeeeeeeeaaaaaagggggggggggggggggggggggggaaaaaaaaaaaeeeeeeeeeeeeee", +"eeeeeeeeaaaaaggggggggggggggggggggdgdggggaaggaaaaaaaaaaeeeeeeeeee", +"beeeeeeaaaaaggggggagaagggggdgddggggggggggggaaaaaaaaaaeeeeeeeeeee", +"eeeeeeeaaaaaaaaaaaaeaggggggdgddaaaaggggggggggaaaaaaaaaeeeeeeeeee", +"eeeeeeeaaaaaaaaaeeeeaaagggddddgaaeaggggaaggggaaaaaaaaaaeeeeeeebb", +"eeeeeeaaaaaaaaaeeeeeaaaaggddddgaeeeaggaeeagggggaaaaaaaeaeeeeebbb", +"eeeeeeaaaaaaaeeeeeeeeaagggddddgaaeaagaaeeeaaggggaaaaaeeeeeeeebeb", +"eeeeeeaaaaaaeeeeeeeeeaaaaaaggdgaaaaaaaaeeeeeaagaaaaaeeeeeeebbbbb", +"eeeeeeeaaaaeeeeeeeeeeaaaaaaaggggaaagaaebbebeeaaaaaaeaaeeeebebbbb", +"beeeeeeefffffeeeebbbeeaaaaaaaaaaaaaaaaccbffeeaeeeeaaaeeebbbbbbbb", +"beeeeeeeffaaffeebbbbbeaaaaaaaeaaaaaaabcbcffeeeeeeeeeeebbbbbbbbbb", +"ebeeeeeffaaaffeeffffbbeffffaaaffffaabffbffeeffffeeebbbbbbbbbbbbb", +"bbbbeeeffaaaffeffbbffcffaaffaffaaffbffcfffeffeefeeeebbbbbbbbbbbb", +"bbbbeeffeeaaffffebbffffbeeaaffaaaffffcbeffffeeefeeeebbbbbbbbbbbb", +"bbbbeeffeaeffeffffffbffbbbeeffeeffcffbeffeffffffebebbbbbbbbbcbbb", +"bbbbeeffaeeffffeeeeeffebbffffbb``fffbe``f``e``eeeeb``b`````bcccc", +"bbbbbffeeeffeffeeffeffeeffeffee```ffe```e``e```eeb```b``ccbccccc", +"bbbbbffffffeeeffffeeeffffeeefff```eff```e``f```bbe```b``bccccccb", +"bbbbbbeeeeeeeeeeeeeeeeeeeeeeeee````e````b``b````b````c`````ccccc", +"bbbbbbbeeeeeeeeeeeeeeeeeeeeeaee``b`e`b``e``b``b`b`c``c``cbcccbcc", +"bbbbbbbbeeeeeeeeeeeeeeeeeeeeeee``b```b``b``b``b```c``c``cccccccc", +"bccbbbbbeeebeeeeeeeeeeeeeeeeeee``bb`bb``b``b``cc`cc``c``cccccccc", +"bbcbbbbbbbebebbeeeeeeeeeebbbeee``bb`bb``b``b``cb`bc``c`````ccccc", +"ccccbbbbbbbbbbbbebeeebbbbbbebbebbbbbbbbcbccccbcccccccccccccccccc", +"bbcccbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbccbccccccccccccccccccccccc" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-simple-up.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,57 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"64 42 8 1", +/* colors */ +"` c #000000000000", +"a c #B8B878785050", +"b c #D0D0A8A88888", +"c c #585838383838", +"d c #303028282828", +"e c #FFFFFFFFFFFF", +"f c #D0D090906868", +"g c #909050504040", +/* pixels */ +"aaaaaaaaaaaffffffffffffffffffffffbfffffffbbfffbffbfbfffffffffffa", +"faaaaaaaaaffffffffffffffffffffffffffffffffffffbbffffffffffffffaf", +"aaaaaaaaafffafaffffffffffaffffffffffffffffffffffffffffffffffffff", +"aaaaaaaaaaaaafffafffffafffffffafffffffafffffffffffffffffffffffff", +"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafffafffffffffffffffffffafaf", +"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafffffffaffaaaaaafaf", +"aaaaaaaaaggaaagaagaggagggggaaaagaaaaaaaaaaaaaaaaaaaffaaaaaaaaaaa", +"aagaagaaagaaggggggagagaaggaggaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", +"aaagggggggaggggggggggggggggaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", +"aaaaggggggggggggggggggggggggggagaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", +"aaggggggggggggggggggggggggggggaaaaaaaaaaaaaaaaafaaaaaaaaaaafaaaa", +"aaggggagggggggggggggggggggggaaaaaaaaaaaaaaaaaaaafaffaafaafaafaaa", +"aaaagagagggggggggggggggggggggggagaaaaaaaaaaaaaaafaaaffaaaffaaaaa", +"aaaaaaaaaggggggggggggggggggggggggggggaaaaaaaaaaaaaffaafaaaaaaaaa", +"aaaaaaaaaaggggggggcccccccccccccggggggggggaaaaaaaaaaaaaaaaaaaaaaa", +"aaaaaaaaaaggggcgcccccccccccccccccggggggggggggaaaaaaaaaaaaaaaaaaa", +"aaaaaaaaaagggcgcccccccccccccccccccgggggggggggggaaaaaaaaaaaaaaaaa", +"aaaaaaaaaaggggcccccccccccccccccccccccccggggggggggaaaaaaaaaaaaaaa", +"aaaaaaaaaggggccccccccccccccccccccdcdccccggccggggggggaaaaaaaaaaaa", +"faaaaaaaggggccccccgcggcccccdcddccccccccccccggggggggggaaaaaaaaaaa", +"aaaaaaaggggggggggggagccccccdcddggggccccccccccgggggggggaaaaaaaaaa", +"aaaaaaagggggggggaaaagggcccddddcggagccccggccccgggggggggaaaaaaaaff", +"aaaaaagggggggggaaaaaggggccddddcgaaagccgaagcccccgggggagaaaaaaafff", +"aaaaaagggggggaaaaaaaaggcccddddcggaggcggaaaggccccgggggaaaaaaaafaf", +"aaaaaaggggggaaaaaaaaaggggggccdcggggggggaaaaaggcgggggaaaaaaaaffff", +"aaaaaaaagggaaaaaaaaaagggggggccccgggcggaffafaaggggggaggaaaafaffff", +"faaaaaaaeeeeeaaaafffaaggggggggggggggggbbfeeaaaaaaagggaaaffffffff", +"faaaaaaaeegaeeaafffffagggggggagggggggfbfbeeaaaaaaaaaaaffffffffff", +"afaaaaaeegggeeaaeeeeffaeeeegggeeeeggfeefeeaaeeeeaaafffffffffffff", +"ffffaaaeeaggeeaeeffeebeeggeegeeggeefeebeeeaeeaaeaaaaffffffffffff", +"ffffaaeeaaggeeeeaffeeeefaaggeegggeeeebfaeeeeaaaeaaaaffffffffffff", +"ffffaaeeagaeeaeeeeeefeefffaaeeaaeebeefaeeaeeeeeeafafffffffffffff", +"ffffaaeeaaaeeeeaaaaaeeaffeeeeff``eeefa``e``a``aaaaf``f`````fffff", +"fffffeeaaaeeaeeaaeeaeeaaeeaeeaa```eea```a``a```aaf```f``fffbfbff", +"fffffeeeeeeaaaeeeeaaaeeeeaaaeee```aee```a``e```ffa```f``fffffbff", +"ffffffaaaaaaaaaaaaaaaaaaaaaaaaa````a````f``f````f````f`````fbffb", +"fffffffaaaaaaaaaaaaaaaaaaaaaaaa``f`a`f``a``f``f`f`f``b``bfbfbffb", +"ffffffffaaaaaaaaaaaaaaaaaaaaaaa``f```f``f``f``f```f``f``fbfbfbfb", +"ffffffffaaafaaaaaaaaaaaaaaaaaaa``ff`ff``f``f``fb`bf``b``bfbfbbbf", +"ffffffffffafaffaaaaaaaaaafffaaa``ff`ff``f``f``bf`fb``b`````bfbfb", +"ffbfffffffffffffafaaaffffffaffaffffffffbffbfbfbfbbfbbfbbbbfbfbff", +"fffffffffffffffffffffffffffffffffffffffbffbbfbfbbbbbbffbfbfbffbf" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-simple-xx.xpm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,57 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"64 42 8 1", +/* colors */ +"` c #000000000000", +"a c #D0D0A8A88888", +"b c #B8B870705050", +"c c #888868685050", +"d c #999999999999", +"e c #505040403838", +"f c #303028282828", +"g c #787848483838", +/* pixels */ +"b`b`b`b`b`b`b`b`b`b`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`b`b`b`", +"`b`b`b`b`b`b`b`b`a`b`a`b`a`a`b`a`a`a`a`a`a`a`a`a`a`a`a`a`a`b`b`b", +"b`b`b`b`b`b`b`b`b`b`b`a`a`b`b`a`a`a`a`a`a`a`a`a`a`a`a`a`b`b`b`b`", +"`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`a`a`a`a`a`b`b`b`b`b", +"b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`a`a`a`a`a`b`b`b`b`b`", +"`b`b`b`b`b`b`b`b`b`b`b`b`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b", +"b`b`b`b`b`c`b`c`b`b`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`", +"`b`b`c`b`c`b`c`c`c`c`c`b`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b", +"b`b`c`c`c`b`c`c`c`c`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`", +"`b`b`c`c`c`c`c`c`c`c`c`c`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b", +"b`c`c`c`c`c`c`c`g`c`g`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`", +"`c`c`c`c`c`c`c`g`g`c`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b", +"b`b`c`c`c`c`c`c`c`c`c`c`c`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`", +"`b`b`b`b`c`c`c`c`c`g`g`g`c`c`c`c`c`c`b`b`b`b`b`b`b`b`b`b`b`b`b`b", +"b`b`b`b`b`c`c`c`g`g`g`e`e`e`e`g`g`g`g`c`c`b`b`b`b`b`b`b`b`b`b`b`", +"`b`b`b`b`b`c`g`g`e`e`e`e`e`e`g`g`g`g`g`g`g`c`c`b`b`b`b`b`b`b`b`b", +"b`b`b`b`b`c`g`g`e`g`e`e`e`e`e`e`e`g`g`g`g`g`c`c`b`b`b`b`b`b`b`b`", +"`b`b`b`b`c`g`g`e`e`e`e`e`e`e`e`e`e`e`e`g`g`g`g`c`c`b`b`b`b`b`b`b", +"b`b`b`b`c`g`g`g`e`e`e`e`e`e`e`e`e`e`e`e`g`g`g`g`g`c`c`b`b`b`b`b`", +"`b`b`b`c`g`g`g`e`e`e`g`e`e`f`f`e`e`e`e`e`e`g`g`g`g`c`b`b`b`b`b`b", +"b`b`b`b`g`g`g`g`g`g`c`e`e`e`e`f`c`g`e`e`e`e`e`c`g`g`c`b`b`b`b`b`", +"`b`b`b`g`c`c`g`c`b`b`g`e`e`f`f`c`b`e`e`c`e`e`g`g`c`c`c`c`b`b`b`b", +"b`b`b`c`c`g`c`c`b`b`c`g`e`f`f`e`b`b`e`g`b`e`e`e`g`c`c`c`b`b`b`b`", +"`b`b`b`c`c`c`b`b`b`b`c`e`e`f`f`c`b`g`g`b`b`g`e`g`c`c`b`b`b`b`b`b", +"b`b`b`c`c`c`b`b`b`b`b`g`g`g`e`e`c`c`c`c`b`b`g`e`g`g`c`b`b`b`b`b`", +"`b`b`b`c`c`b`b`b`b`b`c`g`c`c`e`e`c`e`c`a`b`b`c`g`g`c`c`b`b`b`b`a", +"b`b`b`b`d`d`d`b`b`b`b`c`c`c`c`c`c`c`c`a`a`d`c`b`c`c`c`b`b`b`b`b`", +"`b`b`b`b`d`c`d`b`a`a`b`c`c`c`b`c`c`c`a`a`d`b`b`b`b`b`b`b`b`a`b`a", +"b`b`b`b`d`c`d`b`d`d`a`b`d`d`c`d`d`c`a`d`d`b`d`d`b`b`b`b`a`a`a`a`", +"`a`b`b`d`c`c`d`d`b`d`a`d`c`d`d`c`d`b`d`d`d`d`b`d`b`b`b`b`a`a`a`b", +"b`b`b`d`b`c`d`d`b`a`d`d`b`c`d`c`c`d`d`a`d`d`b`b`b`b`b`b`a`a`a`a`", +"`b`b`b`d`c`d`b`d`d`d`d`a`a`b`d`b`d`d`a`d`b`d`d`d`b`b`a`a`a`a`a`a", +"a`b`b`d`c`b`d`d`b`b`d`b`a`d`d`a`d`d`a`d`d`d`d`b`b`b`d`d`d`d`a`a`", +"`b`b`d`b`b`d`d`b`d`b`d`b`d`d`b`d`d`d`d`d`d`b`d`b`b`d`a`d`a`a`a`a", +"a`b`b`d`d`d`b`d`d`b`b`d`d`b`d`d`d`b`d`d`b`d`d`d`b`d`d`d`a`a`a`a`", +"`a`b`b`b`b`b`b`b`c`b`b`b`b`b`b`d`d`b`d`d`d`b`d`d`d`d`a`d`d`a`a`a", +"a`a`b`b`b`b`b`b`c`b`b`b`b`b`c`b`d`d`d`d`b`d`d`a`a`a`d`d`a`a`a`a`", +"`a`a`a`b`b`b`b`b`b`b`b`b`b`b`b`d`b`d`a`d`d`a`d`d`d`d`a`d`a`a`a`a", +"a`a`a`b`b`b`b`b`b`b`b`b`b`b`b`b`d`a`a`d`a`d`d`a`d`a`d`d`a`a`a`a`", +"`a`a`a`b`b`b`b`b`b`b`b`b`b`b`b`d`a`d`a`d`d`a`d`a`a`d`a`d`d`a`a`a", +"a`a`a`a`b`b`b`b`b`b`b`b`b`b`a`b`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`", +"`a`a`a`a`a`b`b`b`b`b`b`b`b`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a`a" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-up.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,32 @@ +#define e_width 64 +#define e_height 42 +static unsigned char e_bits[] = { + 0xc6, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0xbd, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x70, 0x25, 0x80, 0x47, + 0x00, 0x00, 0x00, 0x00, 0xf3, 0xbe, 0xfd, 0xff, 0x0b, 0x00, 0x00, 0x00, + 0xfe, 0xff, 0xff, 0xff, 0xff, 0x12, 0x40, 0x12, 0xff, 0xff, 0xff, 0xff, + 0xbb, 0xd0, 0x9b, 0x4d, 0xfd, 0xff, 0xff, 0xff, 0x4f, 0x99, 0xb3, 0xc9, + 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0x87, 0x00, 0xff, 0xff, 0xff, 0xff, + 0x2f, 0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0x6d, 0x02, 0x00, 0x00, + 0xff, 0xff, 0xff, 0xff, 0xbb, 0x08, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, + 0xff, 0x0d, 0x00, 0x80, 0xdf, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x03, 0x00, + 0xc1, 0xff, 0xff, 0xff, 0xff, 0xff, 0x88, 0x40, 0x94, 0xff, 0xff, 0xff, + 0xff, 0xff, 0xaf, 0x08, 0x50, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00, + 0xc0, 0xff, 0xff, 0xff, 0xf5, 0xff, 0x7f, 0x01, 0xd0, 0xff, 0xff, 0x97, + 0xff, 0xff, 0xff, 0x00, 0xd0, 0xff, 0xff, 0x97, 0xff, 0xff, 0xff, 0x03, + 0xe0, 0xff, 0xf2, 0xc3, 0xff, 0xff, 0xff, 0x05, 0xe0, 0x7f, 0xf1, 0xc3, + 0xfd, 0xff, 0xff, 0x01, 0xe0, 0x3f, 0xf0, 0xc3, 0x7f, 0xfe, 0xdf, 0x00, + 0xf0, 0x0f, 0xf0, 0xdf, 0x7f, 0xf8, 0x7f, 0x00, 0xf0, 0x1f, 0xe0, 0xff, + 0x3f, 0xf0, 0x3f, 0x00, 0xa0, 0x00, 0xe0, 0xff, 0x3f, 0xf8, 0x3f, 0x00, + 0xa0, 0x0c, 0xc0, 0xff, 0x1f, 0xf8, 0x01, 0x00, 0x00, 0x0e, 0x00, 0x38, + 0x0c, 0x0c, 0x03, 0x00, 0x10, 0x0e, 0x00, 0x93, 0x01, 0x60, 0x00, 0x00, + 0x00, 0x0e, 0x00, 0xcf, 0x01, 0x30, 0x00, 0x00, 0x00, 0x27, 0x00, 0x40, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x80, 0xc1, 0x36, 0xd8, 0x07, + 0x80, 0x93, 0x00, 0x80, 0xe3, 0x76, 0xdc, 0x00, 0x00, 0x30, 0x1c, 0x80, + 0xe3, 0x76, 0xdc, 0x00, 0x00, 0xf2, 0x9f, 0x80, 0xf7, 0xf6, 0xde, 0x07, + 0x00, 0x00, 0x59, 0x90, 0xd5, 0xb6, 0xda, 0x00, 0x00, 0x80, 0x28, 0x90, + 0xdd, 0xb6, 0xdb, 0x00, 0x00, 0x00, 0x00, 0x80, 0xc9, 0x36, 0xd9, 0x00, + 0x00, 0x00, 0x00, 0x80, 0xc9, 0x36, 0xd9, 0x07, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + };
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/vm/mime-xx.xbm Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,26 @@ +#define ee_width 64 +#define ee_height 42 +static char ee_bits[] = { + 0xc6,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x70,0x25,0x80,0x47,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0x12,0x40,0x12,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfd,0xff,0xff,0xff,0x4f,0x99,0xb3,0xc9,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0x2f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xbb,0x08,0x00,0x80,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xdf,0xff,0xff,0xff,0xff,0x3f,0x03,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x94,0xff,0xff,0xff,0xff,0xff,0xaf, + 0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xf5,0xff, + 0x7f,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xd0,0xff,0xff,0x97,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x7f,0xf1,0xc3, + 0xfd,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x0f,0xf0, + 0xdf,0x7f,0xf8,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x00, + 0xe0,0xff,0x3f,0xf8,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x0e,0x00,0x38,0x0c,0x0c,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x0e,0x00,0xcf,0x01,0x30,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x07,0x00,0x80,0xc1,0x36,0xd8,0x07,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x30,0x1c,0x80,0xe3,0x76,0xdc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x59,0x90,0xd5,0xb6,0xda,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xc9,0x36,0xd9,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00};
--- a/etc/w3/stylesheet Mon Aug 13 08:49:44 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 08:50:05 2007 +0200 @@ -47,7 +47,6 @@ ** Since Emacs-19 doesn't handle mixed-sized fonts very well just yet, ** we only use them under XEmacs. Hopefully, this will change soon. */ - @media xemacs { h1 { font-size : +12pt } h2 { font-size : +6pt } @@ -72,7 +71,6 @@ @media emacs { h1,h2,h3, h4,h5,h6 { - font-style: small-caps; text-decoration: underline; color: blue; } @@ -88,6 +86,21 @@ blockquote{ display: block; margin-left: 5; margin-right: 5; } /* +** How to draw form elements. +** This is an extension in Emacs-W3 (and perhaps soon E-Scape) +** Since there are so many different types of input fields, you should be +** able to control formatting based on that. Enter pseudo-classes. +** +** This functionality will be removed as soon as the W3C comes up with +** the standard way to do this, perhaps in CSS level 2. +*/ +input { text-decoration: underline; } +input:submit { color: green; text-decoration: none; } +input:reset { color: red; text-decoration: none; } +input:button { color: yellow; text-decoration: none; } +input:image { text-decoration: none; } + +/* ** List formatting instructions */ @@ -136,7 +149,6 @@ ** Hypertext link coloring */ -a { cursor: hand2 } a:link { color: #FF0000 } a:visited { color: #B22222 } a:active { color: #FF0000 }
--- a/lib-src/make-docfile.c Mon Aug 13 08:49:44 2007 +0200 +++ b/lib-src/make-docfile.c Mon Aug 13 08:50:05 2007 +0200 @@ -91,6 +91,12 @@ static void read_lisp_symbol (FILE *, char *); static int scan_lisp_file (CONST char *filename, CONST char *mode); +#define C_IDENTIFIER_CHAR_P(c) \ + (('A' <= c && c <= 'Z') || \ + ('a' <= c && c <= 'z') || \ + ('0' <= c && c <= '9') || \ + (c == '_')) + /* Name this program was invoked with. */ char *progname; @@ -338,24 +344,31 @@ char c = *p; int ident_start = 0; + /* Add support for ANSI prototypes. Hop over + "Lisp_Object" string (the only C type allowed in DEFUNs) */ + static char lo[] = "Lisp_Object"; + if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && + (strncmp (p, lo, sizeof (lo) - 1) == 0) && + isspace(*(p + sizeof (lo) - 1))) + { + p += (sizeof (lo) - 1); + while (isspace (*p)) + p++; + c = *p; + } + /* Notice when we start printing a new identifier. */ - if ((('A' <= c && c <= 'Z') - || ('a' <= c && c <= 'z') - || ('0' <= c && c <= '9') - || c == '_') - != in_ident) + if (C_IDENTIFIER_CHAR_P (c) != in_ident) { if (!in_ident) { in_ident = 1; ident_start = 1; - #if 0 /* XEmacs - This goes along with the change above. */ if (need_space) putc (' ', out); -#endif - +#endif if (minargs == 0 && maxargs > 0) fprintf (out, "&optional "); just_spaced = 1; @@ -377,10 +390,7 @@ `defalt'; unmangle that here. */ if (ident_start && strncmp (p, "defalt", 6) == 0 - && ! (('A' <= p[6] && p[6] <= 'Z') - || ('a' <= p[6] && p[6] <= 'z') - || ('0' <= p[6] && p[6] <= '9') - || p[6] == '_')) + && ! C_IDENTIFIER_CHAR_P (p[6])) { fprintf (out, "DEFAULT"); p += 5; @@ -496,8 +506,9 @@ if (c != 'F') continue; c = getc (infile); - defunflag = c == 'U'; + defunflag = (c == 'U'); defvarflag = 0; + c = getc (infile); } else continue; @@ -514,7 +525,7 @@ c = read_c_string (infile, -1, 0); if (defunflag) - commas = 5; + commas = 4; else if (defvarperbufferflag) commas = 2; else if (defvarflag) @@ -531,7 +542,8 @@ { do c = getc (infile); - while (c == ' ' || c == '\n' || c == '\t'); + while (c == ' ' || c == '\n' || c == '\t') + ; if (c < 0) goto eof; ungetc (c, infile); @@ -585,12 +597,14 @@ if (defunflag && maxargs != -1) { char argbuf[1024], *p = argbuf; +#if 0 /* For old DEFUN's only */ while (c != ')') { if (c < 0) goto eof; c = getc (infile); } +#endif /* Skip into arguments. */ while (c != '(') { @@ -813,8 +827,17 @@ /* Skip until the first newline; remember the two previous chars. */ while (c != '\n' && c >= 0) { + /* ### Kludge -- Ignore any ESC x x ISO2022 sequences */ + if (c == 27) + { + getc (infile); + getc (infile); + goto nextchar; + } + c2 = c1; c1 = c; + nextchar: c = getc (infile); } @@ -933,7 +956,7 @@ { /* If the next three characters aren't `dquote bslash newline' then we're not reading a docstring. */ - if ((c = getc (infile)) != '"' || + if ((c = getc (infile)) != '"' || (c = getc (infile)) != '\\' || (c = getc (infile)) != '\n') { @@ -946,7 +969,7 @@ } } -#ifdef DEBUG +#if 0 /* causes crash */ else if (! strcmp (buffer, "if") || ! strcmp (buffer, "byte-code")) ;
--- a/lisp/bytecomp/bytecomp.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/bytecomp/bytecomp.el Mon Aug 13 08:50:05 2007 +0200 @@ -2,7 +2,7 @@ ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc. -;; Author: Jamie Zawinski <jwz@lucid.com> +;; Author: Jamie Zawinski <jwz@netscape.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> ;; Keywords: internal @@ -1226,18 +1226,20 @@ (not (eq (car rest) 'new-scope))) (setq cell (car rest)) (if (and (= 0 (logand byte-compile-referenced-bit (cdr cell))) - ;; Don't warn about declared-but-unused arguments, for two - ;; reasons: first, the arglist structure might be imposed by - ;; external forces, and we don't have (declare (ignore x)) yet; - ;; and second, inline expansion produces forms like + ;; Don't warn about declared-but-unused arguments, + ;; for two reasons: first, the arglist structure + ;; might be imposed by external forces, and we don't + ;; have (declare (ignore x)) yet; and second, inline + ;; expansion produces forms like ;; ((lambda (arg) (byte-code "..." [arg])) x) - ;; which we can't (ok, well, don't) recognise as containing a - ;; reference to arg, so every inline expansion would generate - ;; a warning. (If we had `ignore' then inline expansion could - ;; emit an ignore declaration.) + ;; which we can't (ok, well, don't) recognise as + ;; containing a reference to arg, so every inline + ;; expansion would generate a warning. (If we had + ;; `ignore' then inline expansion could emit an + ;; ignore declaration.) (= 0 (logand byte-compile-arglist-bit (cdr cell))) - ;; Don't warn about defvars because this is a legitimate special - ;; binding. + ;; Don't warn about defvars because this is a + ;; legitimate special binding. (not (byte-compile-defvar-p (car cell)))) (setq unreferenced (cons (car cell) unreferenced))) (setq rest (cdr rest)))
--- a/lisp/cl/cl-macs.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/cl/cl-macs.el Mon Aug 13 08:50:05 2007 +0200 @@ -1399,7 +1399,10 @@ (cond ((eq (car-safe spec) 'special) (if (boundp 'byte-compile-bound-variables) (setq byte-compile-bound-variables - (append (cdr spec) byte-compile-bound-variables)))) + ;; todo: this should compute correct binding bits vs. 0 + (append (mapcar #'(lambda (v) (cons v 0)) + (cdr spec)) + byte-compile-bound-variables)))) ((eq (car-safe spec) 'inline) (while (setq spec (cdr spec))
--- a/lisp/custom/custom-edit.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/custom/custom-edit.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.24 +;; Version: 1.30 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/custom.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.24 +;; Version: 1.30 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -22,14 +22,15 @@ (define-widget-keywords :prefix :tag :load :link :options :type :group) ;; These autoloads should be deleted when the file is added to Emacs -(autoload 'customize "custom-edit" nil t) -(autoload 'customize-variable "custom-edit" nil t) -(autoload 'customize-face "custom-edit" nil t) -(autoload 'customize-apropos "custom-edit" nil t) -(autoload 'customize-customized "custom-edit" nil t) -(autoload 'custom-buffer-create "custom-edit") -(autoload 'custom-menu-update "custom-edit") -(autoload 'custom-make-dependencies "custom-edit") +(unless (fboundp 'load-gc) + (autoload 'customize "custom-edit" nil t) + (autoload 'customize-variable "custom-edit" nil t) + (autoload 'customize-face "custom-edit" nil t) + (autoload 'customize-apropos "custom-edit" nil t) + (autoload 'customize-customized "custom-edit" nil t) + (autoload 'custom-buffer-create "custom-edit") + (autoload 'custom-menu-update "custom-edit") + (autoload 'custom-make-dependencies "custom-edit")) ;;; Compatibility. @@ -92,7 +93,7 @@ ;;; The `defcustom' Macro. -;;;###autoload +;;; Don't ;;;###autoload (defun custom-declare-variable (symbol value doc &rest args) "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments." (unless (and (default-boundp symbol) @@ -129,7 +130,7 @@ (run-hooks 'custom-define-hook) symbol) -;;;###autoload +;;; Don't ;;;###autoload (defmacro defcustom (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. DOC is the variable documentation. @@ -154,7 +155,7 @@ ;;; The `defface' Macro. -;;;###autoload +;;; Don't ;;;###autoload (defun custom-declare-face (face spec doc &rest args) "Like `defface', but FACE is evaluated as a normal argument." (put face 'factory-face spec) @@ -170,7 +171,7 @@ (run-hooks 'custom-define-hook) face) -;;;###autoload +;;; Don't ;;;###autoload (defmacro defface (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. FACE does not need to be quoted. @@ -220,7 +221,7 @@ ;;; The `defgroup' Macro. -;;;###autoload +;;; Don't ;;;###autoload (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." (put symbol 'custom-group (nconc members (get symbol 'custom-group))) @@ -244,7 +245,7 @@ (run-hooks 'custom-define-hook) symbol) -;;;###autoload +;;; Don't ;;;###autoload (defmacro defgroup (symbol members doc &rest args) "Declare SYMBOL as a customization group containing MEMBERS. SYMBOL does not need to be quoted. @@ -269,7 +270,7 @@ information." `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) -;;;###autoload +;;; Don't ;;;###autoload (defun custom-add-to-group (group option widget) "To existing GROUP add a new OPTION of type WIDGET, If there already is an entry for that option, overwrite it." @@ -396,10 +397,10 @@ match))) (defconst custom-face-attributes - '((:bold (toggle :format "Bold: %v") custom-set-face-bold) - (:italic (toggle :format "Italic: %v") custom-set-face-italic) + '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold) + (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic) (:underline - (toggle :format "Underline: %v") set-face-underline-p) + (toggle :format "Underline: %[%v%]\n") set-face-underline-p) (:foreground (color :tag "Foreground") set-face-foreground) (:background (color :tag "Background") set-face-background) (:stipple (editable-field :format "Stipple: %v") set-face-stipple)) @@ -467,7 +468,7 @@ (make-face-italic face frame) (make-face-unitalic face frame))) -;;;###autoload +;;; Don't ;;;###autoload (defun custom-initialize-faces (&optional frame) "Initialize all custom faces for FRAME. If FRAME is nil or omitted, initialize them for all frames." @@ -479,7 +480,7 @@ ;;; Initializing. -;;;###autoload +;;; Don't ;;;###autoload (defun custom-set-variables (&rest args) "Initialize variables according to user preferences. @@ -507,7 +508,7 @@ (put symbol 'saved-value (list value))) (setq args (cdr (cdr args))))))) -;;;###autoload +;;; Don't ;;;###autoload (defun custom-set-faces (&rest args) "Initialize faces according to user preferences. The arguments should be a list where each entry has the form: @@ -581,7 +582,8 @@ (easy-menu-create-keymaps (car custom-help-menu) (cdr custom-help-menu))))))) -; (custom-menu-reset) +(unless (fboundp 'load-gc) + (custom-menu-reset)) ;;; The End.
--- a/lisp/custom/widget-edit.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/custom/widget-edit.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.24 +;; Version: 1.30 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -190,6 +190,20 @@ items nil t) items))))) +(defun widget-get-sibling (widget) + "Get the item WIDGET is assumed to toggle. +This is only meaningful for radio buttons or checkboxes in a list." + (let* ((parent (widget-get widget :parent)) + (children (widget-get parent :children)) + child) + (catch 'child + (while children + (setq child (car children) + children (cdr children)) + (when (eq (widget-get child :button) widget) + (throw 'child child))) + nil))) + ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. @@ -288,9 +302,9 @@ (unless (widget-get widget :size) (add-text-properties to (1+ to) (list 'field widget - 'face face - 'local-map map - 'keymap map))))) + 'face face))) + (add-text-properties to (1+ to) (list 'local-map map + 'keymap map)))) (defun widget-specify-button (widget from to) ;; Specify button for WIDGET between FROM and TO. @@ -332,6 +346,10 @@ ;;; Widget Properties. +(defsubst widget-name (widget) + "Return the name of WIDGET, asymbol." + (car widget)) + (defun widget-put (widget property value) "In WIDGET set PROPERTY to VALUE. The value can later be retrived with `widget-get'." @@ -491,6 +509,7 @@ (unless widget-keymap (setq widget-keymap (make-sparse-keymap)) + (define-key widget-keymap "\C-k" 'widget-kill-line) (define-key widget-keymap "\t" 'widget-forward) (define-key widget-keymap "\M-\t" 'widget-backward) (define-key widget-keymap [(shift tab)] 'widget-backward) @@ -512,6 +531,8 @@ (unless widget-field-keymap (setq widget-field-keymap (copy-keymap widget-keymap)) (define-key widget-field-keymap "\C-m" 'widget-field-activate) + (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line) + (define-key widget-field-keymap "\C-e" 'widget-end-of-line) (set-keymap-parent widget-field-keymap global-map)) (defvar widget-text-keymap nil @@ -519,6 +540,8 @@ (unless widget-text-keymap (setq widget-text-keymap (copy-keymap widget-keymap)) + (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line) + (define-key widget-text-keymap "\C-e" 'widget-end-of-line) (set-keymap-parent widget-text-keymap global-map)) (defun widget-field-activate (pos &optional event) @@ -625,6 +648,61 @@ (run-hooks 'widget-backward-hook) (widget-move (- arg))) +(defun widget-beginning-of-line () + "Go to beginning of field or beginning of line, whichever is first." + (interactive) + (let ((bol (save-excursion (beginning-of-line) (point))) + (prev (previous-single-property-change (point) 'field))) + (goto-char (max bol (or prev bol))))) + +(defun widget-end-of-line () + "Go to end of field or end of line, whichever is first." + (interactive) + (let ((bol (save-excursion (end-of-line) (point))) + (prev (next-single-property-change (point) 'field))) + (goto-char (min bol (or prev bol))))) + +(defun widget-kill-line () + "Kill to end of field or end of line, whichever is first." + (interactive) + (let ((field (get-text-property (point) 'field)) + (newline (save-excursion (search-forward "\n"))) + (next (next-single-property-change (point) 'field))) + (if (and field (> newline next)) + (kill-region (point) next) + (call-interactively 'kill-line)))) + +(defun widget-identify (pos) + "Identify the widget under point." + (interactive "d") + (let* ((field (get-text-property pos 'field)) + (button (get-text-property pos 'button)) + (doc (get-text-property pos 'widget-doc)) + (widget (or field button doc))) + (with-output-to-temp-buffer "*Widget Identity*" + (princ (cond (field "This is an editable text area.\n") + (button "This is an active area.\n") + (doc "This is documentation text.\n") + (t "This is unidentified text.\n"))) + (while widget + (princ "It is part of a `") + (princ (car widget)) + (princ "' widget (value: ") + (prin1 (condition-case nil + (widget-value widget) + (error 'error))) + (princ ").\n") + (when (eq (car widget) 'radio-button) + (let ((sibling (widget-get-sibling widget))) + (if (not sibling) + (princ "It doesn't seem to control anything.\n") + (princ "The value of its sibling is: ") + (prin1 (condition-case nil + (widget-value sibling) + (error 'error))) + (princ ".\n")))) + (setq widget (widget-get widget :parent)))))) + ;;; Setting up the buffer. (defvar widget-field-new nil) @@ -1231,36 +1309,33 @@ ;;; The `toggle' Widget. -(define-widget 'toggle 'menu-choice +(define-widget 'toggle 'item "Toggle between two states." - :convert-widget 'widget-toggle-convert-widget - :format "%v" + :format "%[%v%]\n" + :value-create 'widget-toggle-value-create + :action 'widget-toggle-action + :match (lambda (widget value) t) :on "on" :off "off") -(defun widget-toggle-convert-widget (widget) - ;; Create the types representing the `on' and `off' states. - (let ((on-type (widget-get widget :on-type)) - (off-type (widget-get widget :off-type))) - (unless on-type - (setq on-type - (list 'choice-item - :value t - :match (lambda (widget value) value) - :tag (widget-get widget :on)))) - (unless off-type - (setq off-type - (list 'choice-item :value nil :tag (widget-get widget :off)))) - (widget-put widget :args (list on-type off-type))) - widget) +(defun widget-toggle-value-create (widget) + ;; Insert text representing the `on' and `off' states. + (if (widget-value widget) + (insert (widget-get widget :on)) + (insert (widget-get widget :off)))) +(defun widget-toggle-action (widget &optional event) + ;; Toggle value. + (widget-value-set widget (not (widget-value widget))) + (widget-apply widget :notify widget event)) + ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle "A checkbox toggle." - :convert-widget 'widget-item-convert-widget - :on-type '(choice-item :format "%[[X]%]" t) - :off-type '(choice-item :format "%[[ ]%]" nil)) + :format "%[%v%]" + :on "[X]" + :off "[ ]") ;;; The `checklist' Widget. @@ -1427,11 +1502,12 @@ (define-widget 'radio-button 'toggle "A radio button for use in the `radio' widget." :notify 'widget-radio-button-notify - :on-type '(choice-item :format "%[(*)%]" t) - :off-type '(choice-item :format "%[( )%]" nil)) + :format "%[%v%]" + :on "(*)" + :off "( )") (defun widget-radio-button-notify (widget child &optional event) - ;; Notify the parent. + ;; Tell daddy. (widget-apply (widget-get widget :parent) :action widget event)) ;;; The `radio-button-choice' Widget. @@ -2074,7 +2150,7 @@ (define-widget 'boolean 'toggle "To be nil or non-nil, that is the question." :tag "Boolean" - :format "%{%t%}: %v") + :format "%{%t%}: %[%v%]") ;;; The `color' Widget.
--- a/lisp/custom/widget-example.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.24 +;; Version: 1.30 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.24 +;; Version: 1.30 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/custom-opt.el Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,45 @@ +;;; custom-opt.el --- An option group. +;; +;; Copyright (C) 1996 Free Software Foundation, Inc. +;; +;; Author: Per Abrahamsen <abraham@dina.kvl.dk> +;; Keywords: help, faces +;; Version: 1.24 +;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ + +;;; Code: + +(require 'custom) + +(defgroup options nil + "This group contains often used customization options." + :group 'emacs) + +(defvar custom-options + '((line-number-mode boolean) + (column-number-mode boolean) + (debug-on-error boolean) + (debug-on-quit boolean) + (case-fold-search boolean) + (case-replace boolean) + (transient-mark-mode boolean)) + "Alist of customization options. +The first element of each entry should be a variable name, the second +a widget type.") + +(let ((options custom-options) + option name type) + (while options + (setq option (car options) + options (cdr options) + name (nth 0 option) + type (nth 1 option)) + (put name 'custom-type type) + (custom-add-to-group 'options name 'custom-variable)) + (run-hooks 'custom-define-hook)) + +;;; The End. + +(provide 'custom-opt) + +;; custom-edit.el ends here
--- a/lisp/iso/iso-acc.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/iso/iso-acc.el Mon Aug 13 08:50:05 2007 +0200 @@ -3,11 +3,11 @@ ;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc. ;; Author: Johan Vromans <jv@mh.nl> -;; Version: 1.8 -;; Maintainer: FSF +;; Maintainer: Alexandre Oliva <oliva@dcc.unicamp.br> ;; Keywords: i18n ;; Adapted to XEmacs 19.14 by Alexandre Oliva <oliva@dcc.unicamp.br> -;; Last update: Jan 25, 1997 +;; $Revision: 1.3 $ +;; $Date: 1997/02/09 23:51:31 $ ;; This file is part of GNU Emacs. @@ -41,15 +41,16 @@ ;; " (second) -> diaeresis ;; ^ (caret) -> circumflex ;; ~ (tilde) -> tilde over the character -;; / (slash) -> slash through the character. -;; , (cedilla) -> cedilla under the character (except on default mode). -;; Also: /A is A-with-ring and /E is AE ligature. +;; / (slash) -> slash through the character +;; . (dot) -> dot over the character +;; , (cedilla) -> cedilla under the character (except on default mode) +;; Also: /A is A-with-ring and /E is AE ligature. ;; ;; The action taken depends on the key that follows the pseudo accent. ;; In general: ;; ;; pseudo-accent + appropriate letter -> accented letter -;; pseudo-accent + space -> pseudo-accent (except for comma) +;; pseudo-accent + space -> pseudo-accent (except comma) ;; pseudo-accent + pseudo-accent -> accent (if available) ;; pseudo-accent + other -> pseudo-accent + other ;; @@ -72,10 +73,13 @@ (if (fboundp 'read-event) () (defun read-event () (event-key (next-command-event)))) -;; needed to work on GNU Emacs (had to use this function on XEmacs) -(if (fboundp 'character-to-event) () - (defun character-to-event (ch &optional event console meta) - (if (listp ch) (car ch) ch))) +(if (fboundp 'character-to-event) + (defun iso-char-to-event (ch) + "returns an event containing the given character" + (character-to-event (list ch))) + (defun iso-char-to-event (ch) + "returns the character itself" + ch)) ;; needed for compatibility with XEmacs 19.14 and GNU Emacs 19.30 (if (fboundp 'this-single-command-keys) () @@ -85,6 +89,8 @@ (this-command-keys)) (defun this-single-command-keys () (this-command-keys)))) +;; end of compatibility modules + (defvar iso-languages '(("portuguese" (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) @@ -94,7 +100,8 @@ (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352) (?o . ?\364) (?\ . ?^) (space . ?^)) (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) - (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~)) + (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) + (space . ?\~)) (?, (?c . ?\347) (?C . ?\307))) ("irish" @@ -103,17 +110,44 @@ (?\ . ?') (space . ?'))) ("french" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?c . ?\347) (?\ . ?') (space . ?')) - (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`) (space . ?`)) + (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) (?\ . ?') + (space . ?')) + (?` (?A . ?\300) (?E . ?\310) (?a . ?\340) (?e . ?\350) (?\ . ?`) + (space . ?`)) (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) (?\ . ?^) (space . ?^)) - (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\") (space . ?\")) - (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\ . ?\~) (space . ?\~)) + (?\" (?E . ?\313) (?I . ?\317) + (?e . ?\353) (?i . ?\357) (?\ . ?\") (space . ?\")) + (?\~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) (?\ . ?\~) + (space . ?\~)) (?, (?c . ?\347) (?C . ?\307))) + ;;; ISO-8859-3, developed by D. Dale Gulledge <ddg@cci.com> + ("latin-3" + (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) + (?U . ?\332) (?a . ?\341) (?e . ?\351) (?i . ?\355) + (?o . ?\363) (?u . ?\372) (?\ . ?') (space . ?')) + (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257) + (?c . ?\345) (?g . ?\365) (?z . ?\277)) + (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) + (?U . ?\334) (?a . ?\344) (?e . ?\353) (?i . ?\357) + (?o ?\366) (?u ?\374) (?\ . ?\") (space . ?\")) + (?\/ (?\/ . ?\260) (?\ . ?/) (space . ?/)) + (?\~ (?C . ?\307) (?G . ?\253) (?N . ?\321) (?S . ?\252) + (?U . ?\335) (?\~ . ?\270) (?c . ?\347) (?g . ?\273) + (?h . ?\261) (?n . ?\361) (?u . ?\375) + (?\ . ?~) (space . ?~)) + (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) + (?H . ?\246) (?I . ?\316) (?J . ?\254) (?O . ?\324) + (?S . ?\336) (?U . ?\333) (?a . ?\342) (?c . ?\346) + (?e . ?\352) (?g . ?\370) (?h . ?\266) (?i . ?\356) + (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373) + (?\ . ?^) (space . \^)) + (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) + (?U . ?\331) (?a . ?\340) (?e . ?\350) (?i . ?\354) + (?o . ?\362) (?u . ?\371) (?\ . ?`) (space . ?`))) + ("latin-2" (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) @@ -190,9 +224,9 @@ See the function `iso-accents-mode'.") (make-variable-buffer-local 'iso-accents-mode) -(defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?,) +(defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?, ?.) "*List of accent keys that become prefixes in ISO Accents mode. -The default is (?' ?` ?^ ?\" ?~ ?/ ?,), which contains all the supported +The default is (?' ?` ?^ ?\" ?~ ?/ ?, ?.), which contains all the supported accent keys. If you set this variable to a list in which some of those characters are missing, the missing ones do not act as accents. @@ -229,15 +263,12 @@ (delete-region (1- (point)) (point))))) (entry (cdr (assq second-char list)))) (if entry - ;; Found it: insert the accented character and - ;; return a do-nothing key - (vector (character-to-event (list entry))) + ;; Found it: return the mapped char + (vector (iso-char-to-event entry)) ;; Otherwise, advance and schedule the second key for execution. - (setq unread-command-events (append - (list - (character-to-event (list second-char))) - unread-command-events)) - (vector (character-to-event (list first-char)))))) + (setq unread-command-events (cons (iso-char-to-event second-char) + unread-command-events)) + (vector (iso-char-to-event first-char))))) ;; It is a matter of taste if you want the minor mode indicated ;; in the mode line... @@ -283,14 +314,13 @@ ;; Enable electric accents. (setq iso-accents-mode t))) -(defvar iso-accents-mode-map nil) - (defun iso-accents-customize (language) "Customize the ISO accents machinery for a particular language. It selects the customization based on the specifications in the `iso-languages' variable." (interactive (list (completing-read "Language: " iso-languages nil t))) - (let ((table (assoc language iso-languages)) tail acc) + (let ((table (assoc language iso-languages)) + tail) (if (not table) (error "Unknown language '%s'" language) (setq iso-language language @@ -299,57 +329,15 @@ (substitute-key-definition 'iso-accents-accent-key nil key-translation-map) (setq key-translation-map (make-sparse-keymap))) - (setq iso-accents-mode-map (make-sparse-keymap)) - (let ((pair (assoc 'iso-accents-mode minor-mode-map-alist))) - (if pair - (setcdr pair iso-accents-mode-map) - (let ((l minor-mode-map-alist)) - (while (cdr l) - (setq l (cdr l))) - (setcdr l (list (cons 'iso-accents-mode iso-accents-mode-map)))))) ;; Set up translations for all the characters that are used as ;; accent prefixes in this language. (setq tail iso-accents-list) (while tail - (define-key key-translation-map - (vector (character-to-event (list (car (car tail))))) + (define-key key-translation-map (vector (iso-char-to-event + (car (car tail)))) 'iso-accents-accent-key) - (setq acc (cdr (car tail))) - (while acc - (define-key iso-accents-mode-map - (vector (character-to-event (list (cdr (car acc))))) - 'iso-accents-self-insert-unless-redefined) - (setq acc (cdr acc))) (setq tail (cdr tail)))))) -(defun iso-accents-self-insert-unless-redefined (prompt) - "Temporarily disables iso-accents-mode, and checks for additional bindings of the keys that produced its invocation. If no such binding is found, 'self-insert-command is returned" - (interactive "p") - (let* ((iso-accents-mode nil) - (bind (key-binding (this-command-keys))) - (repeat t) result) - (while repeat - (setq result - (cond ((or (null bind) - (eq bind 'self-insert-command)) - (setq repeat nil) - (self-insert-command prompt)) - ((commandp bind) - (setq repeat nil) - (call-interactively bind)) - ((or (stringp bind) - (keymapp bind)) - (setq repeat nil) - bind) - ((and (consp bind) - (stringp (car bind))) - (setq bind (cdr bind))) - ((and (consp bind) - (keymapp (car bind))) - (setq bind (lookup-key (car bind) (cdr bind)))) - (t (error "Invalid key binding"))))) - result)) - (defun iso-accentuate (start end) "Convert two-character sequences in region into accented characters. Noninteractively, this operates on text from START to END.
--- a/lisp/modes/cperl-mode.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/modes/cperl-mode.el Mon Aug 13 08:50:05 2007 +0200 @@ -32,7 +32,7 @@ ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de -;; $Id: cperl-mode.el,v 1.1.1.3 1996/12/18 03:53:13 steve Exp $ +;; $Id: cperl-mode.el,v 1.2 1997/02/09 23:51:33 steve Exp $ ;;; To use this mode put the following into your .emacs file: @@ -4526,3 +4526,7 @@ (cperl-get-help) (setq cperl-help-shown t)))) (cperl-lazy-install))) + +(provide 'cperl-mode) + +;;; cperl-mode.el ends here
--- a/lisp/modes/make-mode.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/modes/make-mode.el Mon Aug 13 08:50:05 2007 +0200 @@ -1107,7 +1107,9 @@ (setq makefile-browser-client (current-buffer)) (makefile-pickup-targets) (makefile-pickup-macros) - (makefile-browse makefile-target-table makefile-macro-table)) + (makefile-browse makefile-target-table + ;; take out the runtime macros which were added for completion sake -gk + (set-difference makefile-macro-table makefile-runtime-macros-list)))
--- a/lisp/packages/font-lock.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/packages/font-lock.el Mon Aug 13 08:50:05 2007 +0200 @@ -1158,9 +1158,10 @@ ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) (goto-char start) - (while (if (stringp matcher) - (re-search-forward matcher end t) - (funcall matcher end)) + (while (and (< (point) end) + (if (stringp matcher) + (re-search-forward matcher end t) + (funcall matcher end))) ;; Apply each highlight to this instance of `matcher', which may be ;; specific highlights or more keywords anchored to `matcher'. (setq highlights (cdr keyword))
--- a/lisp/packages/ps-print.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/packages/ps-print.el Mon Aug 13 08:50:05 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Jim Thompson (was <thompson@wg2.waii.com>) -;; Maintainer: Jacques Duthen <duthen@cegelec-red.fr> +;; Maintainer: Jacques Duthen <duthen@club-internet.fr> ;; Keywords: print, PostScript ;; Time-stamp: <97/01/29 23:21:25 tjchol01> ;; Version: 3.05 @@ -2445,15 +2445,16 @@ (/ x-color-value ps-print-color-scale)) (defun ps-color-values (x-color) - (cond ((fboundp 'x-color-values) + (cond ((fboundp 'color-instance-rgb-components) + (if (ps-color-device) + (color-instance-rgb-components + (if (color-instance-p x-color) x-color + (if (color-specifier-p x-color) + (make-color-instance (color-name x-color)) + (make-color-instance x-color)))) + (error "No available function to determine X color values."))) + ((fboundp 'x-color-values) (x-color-values x-color)) - ((and (fboundp 'color-instance-rgb-components) - (ps-color-device)) - (color-instance-rgb-components - (if (color-instance-p x-color) x-color - (if (color-specifier-p x-color) - (make-color-instance (color-name x-color)) - (make-color-instance x-color))))) (t (error "No available function to determine X color values.")))) (defun ps-face-attributes (face)
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 08:50:05 2007 +0200 @@ -889,135 +889,7 @@ ;;;*** -;;;### (autoloads (custom-set-faces custom-set-variables custom-initialize-faces custom-add-to-group defgroup custom-declare-group defface custom-declare-face defcustom custom-declare-variable) "custom" "custom/custom.el") - -(autoload 'custom-declare-variable "custom" "\ -Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments." nil nil) - -(autoload 'defcustom "custom" "\ -Declare SYMBOL as a customizable variable that defaults to VALUE. -DOC is the variable documentation. - -Neither SYMBOL nor VALUE needs to be quoted. -If SYMBOL is not already bound, initialize it to VALUE. -The remaining arguments should have the form - - [KEYWORD VALUE]... - -The following KEYWORD's are defined: - -:type VALUE should be a widget type. -:options VALUE should be a list of valid members of the widget type. -:group VALUE should be a customization group. - Add SYMBOL to that group. - -Read the section about customization in the emacs lisp manual for more -information." nil 'macro) - -(autoload 'custom-declare-face "custom" "\ -Like `defface', but FACE is evaluated as a normal argument." nil nil) - -(autoload 'defface "custom" "\ -Declare FACE as a customizable face that defaults to SPEC. -FACE does not need to be quoted. - -Third argument DOC is the face documentation. - -If FACE has been set with `custom-set-face', set the face attributes -as specified by that function, otherwise set the face attributes -according to SPEC. - -The remaining arguments should have the form - - [KEYWORD VALUE]... - -The following KEYWORD's are defined: - -:group VALUE should be a customization group. - Add FACE to that group. - -SPEC should be an alist of the form ((DISPLAY ATTS)...). - -ATTS is a list of face attributes and their values. The possible -attributes are defined in the variable `custom-face-attributes'. -Alternatively, ATTS can be a face in which case the attributes of that -face is used. - -The ATTS of the first entry in SPEC where the DISPLAY matches the -frame should take effect in that frame. DISPLAY can either be the -symbol `t', which will match all frames, or an alist of the form -\((REQ ITEM...)...) - -For the DISPLAY to match a FRAME, the REQ property of the frame must -match one of the ITEM. The following REQ are defined: - -`type' (the value of (window-system)) - Should be one of `x' or `tty'. - -`class' (the frame's color support) - Should be one of `color', `grayscale', or `mono'. - -`background' (what color is used for the background text) - Should be one of `light' or `dark'. - -Read the section about customization in the emacs lisp manual for more -information." nil 'macro) - -(autoload 'custom-declare-group "custom" "\ -Like `defgroup', but SYMBOL is evaluated as a normal argument." nil nil) - -(autoload 'defgroup "custom" "\ -Declare SYMBOL as a customization group containing MEMBERS. -SYMBOL does not need to be quoted. - -Third arg DOC is the group documentation. - -MEMBERS should be an alist of the form ((NAME WIDGET)...) where -NAME is a symbol and WIDGET is a widget is a widget for editing that -symbol. Useful widgets are `custom-variable' for editing variables, -`custom-face' for edit faces, and `custom-group' for editing groups. - -The remaining arguments should have the form - - [KEYWORD VALUE]... - -The following KEYWORD's are defined: - -:group VALUE should be a customization group. - Add SYMBOL to that group. - -Read the section about customization in the emacs lisp manual for more -information." nil 'macro) - -(autoload 'custom-add-to-group "custom" "\ -To existing GROUP add a new OPTION of type WIDGET, -If there already is an entry for that option, overwrite it." nil nil) - -(autoload 'custom-initialize-faces "custom" "\ -Initialize all custom faces for FRAME. -If FRAME is nil or omitted, initialize them for all frames." nil nil) - -(autoload 'custom-set-variables "custom" "\ -Initialize variables according to user preferences. - -The arguments should be a list where each entry has the form: - - (SYMBOL VALUE [NOW]) - -The unevaluated VALUE is stored as the saved value for SYMBOL. -If NOW is present and non-nil, VALUE is also evaluated and bound as -the default value for the SYMBOL." nil nil) - -(autoload 'custom-set-faces "custom" "\ -Initialize faces according to user preferences. -The arguments should be a list where each entry has the form: - - (FACE SPEC [NOW]) - -SPEC will be stored as the saved value for FACE. If NOW is present -and non-nil, FACE will also be created according to SPEC. - -See `defface' for the format of SPEC." nil nil) +;;;### (autoloads nil "custom" "custom/custom.el") ;;;*** @@ -3674,7 +3546,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.5 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.6 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4891,7 +4763,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.5 $ +vhdl-mode $Revision: 1.6 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the
--- a/lisp/prim/loadup.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/prim/loadup.el Mon Aug 13 08:50:05 2007 +0200 @@ -105,7 +105,7 @@ ; defined there. (load-gc "help") (load-gc "buff-menu") - (load-gc "w3-sysdp") + ;; (load-gc "w3-sysdp") (load-gc "font") ; required by widget (load-gc "widget") (load-gc "custom") ; Before loaddefs so that defcustom exists.
--- a/lisp/prim/minibuf.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/prim/minibuf.el Mon Aug 13 08:50:05 2007 +0200 @@ -162,7 +162,7 @@ map) "Minibuffer keymap used by shell-command and related commands.") -(defvar should-use-dialog-box t +(defvar use-dialog-box t "Variable controlling usage of the dialog box. If nil, the dialog box will never be used, even in response to mouse events.") @@ -2011,12 +2011,14 @@ event, and checks whether dialog-support exists and the current device supports dialog boxes. -The dialog box is totally disabled if the variable `should-use-dialog-box' +The dialog box is totally disabled if the variable `use-dialog-box' is set to nil." (and (featurep 'dialog) (device-on-window-system-p) - should-use-dialog-box + use-dialog-box (or force-dialog-box-use (button-press-event-p last-command-event) (button-release-event-p last-command-event) (misc-user-event-p last-command-event)))) + +;;; minibuf.el ends here
--- a/lisp/tm/tm-image.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/tm/tm-image.el Mon Aug 13 08:50:05 2007 +0200 @@ -7,7 +7,7 @@ ;; Dan Rich <drich@morpheus.corp.sgi.com> ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1995/12/15 -;; Version: $Id: tm-image.el,v 1.3 1996/12/29 00:15:14 steve Exp $ +;; Version: $Id: tm-image.el,v 1.4 1997/02/09 23:51:47 steve Exp $ ;; Keywords: mail, news, MIME, multimedia, image, picture, X-Face @@ -224,14 +224,15 @@ (mime-decode-region beg end encoding) (let ((data (buffer-string)) (minor (assoc-value ctype mime-viewer/image-converter-alist)) - gl) + gl e) (delete-region (point-min)(point-max)) (while (progn (setq gl (make-glyph (vector minor :data data))) (eq (image-instance-type (glyph-image-instance gl)) 'text) )) - (make-annotation gl (point) 'text) + (setq e (make-extent (point) (point))) + (set-extent-end-glyph e gl) ) (insert "\n") ))
--- a/lisp/tm/tm-play.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/tm/tm-play.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1995/9/26 (separated from tm-view.el) -;; Version: $Id: tm-play.el,v 1.3 1997/02/04 02:36:07 steve Exp $ +;; Version: $Id: tm-play.el,v 1.4 1997/02/09 23:51:47 steve Exp $ ;; Keywords: mail, news, MIME, multimedia ;; This file is part of tm (Tools for MIME). @@ -355,10 +355,11 @@ (progn (or (file-exists-p total-file) (save-excursion - (set-buffer (find-file-noselect total-file)) + (set-buffer + (get-buffer-create mime/temp-buffer-name)) (erase-buffer) (insert total) - (save-buffer) + (write-file total-file) (kill-buffer (current-buffer)) )) (string-to-number total) @@ -366,13 +367,14 @@ (and (file-exists-p total-file) (save-excursion (set-buffer (find-file-noselect total-file)) - (and (re-search-forward "[0-9]+" nil t) - (string-to-number - (buffer-substring (match-beginning 0) - (match-end 0))) - ) - (kill-buffer (current-buffer)) - )) + (prog1 + (and (re-search-forward "[0-9]+" nil t) + (string-to-number + (buffer-substring (match-beginning 0) + (match-end 0))) + ) + (kill-buffer (current-buffer)) + ))) ))) (if (and total (> total 0)) (catch 'tag @@ -383,9 +385,9 @@ (let ((i 1)) (while (<= i total) (setq file (concat root-dir "/" (int-to-string i))) - (if (not (file-exists-p file)) + (or (file-exists-p file) (throw 'tag nil) - ) + ) (as-binary-input-file (insert-file-contents file)) (goto-char (point-max)) (setq i (1+ i)) @@ -422,6 +424,25 @@ ;;; @ rot13-47 ;;; +(require 'view) + +(defconst mime-view-text/plain-mode-map (copy-keymap view-mode-map)) +(define-key mime-view-text/plain-mode-map + "q" (function mime-view-text/plain-exit)) + +(defun mime-view-text/plain-mode () + "\\{mime-view-text/plain-mode-map}" + (setq buffer-read-only t) + (setq major-mode 'mime-view-text/plain-mode) + (setq mode-name "MIME-View text/plain") + (use-local-map mime-view-text/plain-mode-map) + ) + +(defun mime-view-text/plain-exit () + (interactive) + (kill-buffer (current-buffer)) + ) + (defun mime-article/decode-caesar (beg end cal) (let* ((cnum (mime-article/point-content-number beg)) (cur-buf (current-buffer)) @@ -432,7 +453,14 @@ (mode major-mode) str) (setq str (buffer-substring beg end)) - (switch-to-buffer new-name) + (let ((pwin (or (get-buffer-window mother) + (get-largest-window))) + (buf (get-buffer-create new-name)) + ) + (set-window-buffer pwin buf) + (set-buffer buf) + (select-window pwin) + ) (setq buffer-read-only nil) (erase-buffer) (insert str) @@ -450,7 +478,8 @@ (goto-char (point-max)) (tm:caesar-region) ) - (view-mode) + (set-buffer-modified-p nil) + (mime-view-text/plain-mode) ))
--- a/lisp/tm/tm-vm.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/tm/tm-vm.el Mon Aug 13 08:50:05 2007 +0200 @@ -9,7 +9,7 @@ ;; Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Created: 1994/10/29 -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;; This file is part of tm (Tools for MIME). @@ -36,13 +36,16 @@ ;;; Code: (eval-when-compile - (require 'tm-edit) (require 'tm-mail) (require 'vm) (require 'vm-window)) +(require 'tm-edit) (require 'tm-view) +(require 'vm-reply) +(require 'vm-summary) (require 'vm-menu) +(require 'vm-toolbar) ;;; @ Variables @@ -60,7 +63,9 @@ (defvar tm-vm/use-original-url-button nil "*If it is t, use original URL button instead of tm's.") -(defvar tm-vm/automatic-mime-preview t +(defvar tm-vm/automatic-mime-preview (or (and (boundp 'vm-display-using-mime) + vm-display-using-mime) + t) "*If non-nil, automatically process and show MIME messages.") (defvar tm-vm/strict-mime t @@ -91,13 +96,55 @@ If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook instead of `vm-send-digest-hook'.") +(defvar tm-vm/build-mime-preview-buffer-hook nil + "*List of functions called each time a MIME Preview buffer is built. +These hooks are run in the MIME-Preview buffer.") ;;; @@ System/Information variables (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 1.3 1997/02/02 05:06:20 steve Exp $") + "$Id: tm-vm.el,v 1.4 1997/02/09 23:51:48 steve Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) +; Ensure vm-menu-mail-menu gets properly defined *before* tm-vm/vm-emulation-map +; since it contains a call to vm-menu-initialize-vm-mode-menu-map +(setq vm-menu-mail-menu + (let ((title (if (vm-menu-fsfemacs-menus-p) + (list "Mail Commands" + "Mail Commands" + "---" + "---") + (list "Mail Commands")))) + (append + title + (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)] + ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)] + ["Cancel" kill-buffer t] + "----" + "Go to Field:" + "----" + [" To:" mail-to t] + [" Subject:" mail-subject t] + [" CC:" mail-cc t] + [" BCC:" mail-bcc t] + [" Reply-To:" mail-replyto t] + [" Text" mail-text t] + "----" + ["Yank Original" vm-menu-yank-original vm-reply-list] + ["Fill Yanked Message" mail-fill-yanked-message t] + ["Insert Signature" mail-signature t] + ["Insert File..." insert-file t] + ["Insert Buffer..." insert-buffer t]) + (if tm-vm/attach-to-popup-menus + (list "----" + (cons "MIME Commands" + (mapcar (function (lambda (item) + (vector (nth 1 item) + (nth 2 item) + t))) + mime-editor/menu-list)))) + ))) + (defvar tm-vm/vm-emulation-map (let ((map (make-sparse-keymap))) (define-key map "h" 'vm-summarize) @@ -111,16 +158,16 @@ ;(define-key map "\C-\M-p" 'vm-move-message-backward) ;(define-key map "\t" 'vm-goto-message-last-seen) ;(define-key map "\r" 'vm-goto-message) - ;(define-key map "^" 'vm-goto-parent-message) + (define-key map "^" 'vm-goto-parent-message) (define-key map "t" 'vm-expose-hidden-headers) (define-key map " " 'vm-scroll-forward) (define-key map "b" 'vm-scroll-backward) (define-key map "\C-?" 'vm-scroll-backward) - ;(define-key map "d" 'vm-delete-message) - ;(define-key map "\C-d" 'vm-delete-message-backward) - ;(define-key map "u" 'vm-undelete-message) - ;(define-key map "U" 'vm-unread-message) - ;(define-key map "e" 'vm-edit-message) + (define-key map "d" 'vm-delete-message) + (define-key map "\C-d" 'vm-delete-message-backward) + (define-key map "u" 'vm-undelete-message) + (define-key map "U" 'vm-unread-message) + (define-key map "e" 'vm-edit-message) ;(define-key map "a" 'vm-set-message-attributes) ;(define-key map "j" 'vm-discard-cached-data) ;(define-key map "k" 'vm-kill-subject) @@ -138,12 +185,12 @@ (define-key map "g" 'vm-get-new-mail) ;(define-key map "G" 'vm-sort-messages) (define-key map "v" 'vm-visit-folder) - ;(define-key map "s" 'vm-save-message) + (define-key map "s" 'vm-save-message) ;(define-key map "w" 'vm-save-message-sans-headers) ;(define-key map "A" 'vm-auto-archive-messages) - ;(define-key map "S" 'vm-save-folder) + (define-key map "S" 'vm-save-folder) ;(define-key map "|" 'vm-pipe-message-to-command) - ;(define-key map "#" 'vm-expunge-folder) + (define-key map "#" 'vm-expunge-folder) (define-key map "q" 'vm-quit) (define-key map "x" 'vm-quit-no-change) (define-key map "i" 'vm-iconify-frame) @@ -155,7 +202,7 @@ (define-key map ">" 'vm-end-of-message) ;(define-key map "\M-s" 'vm-isearch-forward) (define-key map "=" 'vm-summarize) - ;(define-key map "L" 'vm-load-init-file) + (define-key map "L" 'vm-load-init-file) ;(define-key map "l" (make-sparse-keymap)) ;(define-key map "la" 'vm-add-message-labels) ;(define-key map "ld" 'vm-delete-message-labels) @@ -186,13 +233,13 @@ ;(define-key map "WS" 'vm-save-window-configuration) ;(define-key map "WD" 'vm-delete-window-configuration) ;(define-key map "W?" 'vm-window-help) - ;(define-key map "\C-t" 'vm-toggle-threads-display) - ;(define-key map "\C-x\C-s" 'vm-save-buffer) - ;(define-key map "\C-x\C-w" 'vm-write-file) - ;(define-key map "\C-x\C-q" 'vm-toggle-read-only) + (define-key map "\C-t" 'vm-toggle-threads-display) + (define-key map "\C-x\C-s" 'vm-save-buffer) + (define-key map "\C-x\C-w" 'vm-write-file) + (define-key map "\C-x\C-q" 'vm-toggle-read-only) ;(define-key map "%" 'vm-change-folder-type) - ;(define-key map "\M-C" 'vm-show-copying-restrictions) - ;(define-key map "\M-W" 'vm-show-no-warranty) + (define-key map "\M-C" 'vm-show-copying-restrictions) + (define-key map "\M-W" 'vm-show-no-warranty) ;; suppress-keymap provides these, but now that we don't use ;; suppress-keymap anymore... (define-key map "0" 'digit-argument) @@ -232,10 +279,15 @@ fsfmenu)) "VM's popup menu + MIME specific commands") + + (define-key vm-mode-map "Z" 'tm-vm/view-message) (define-key vm-mode-map "T" 'tm-vm/decode-message-header) (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode) +; Disable VM 6 built-in MIME handling +(setq vm-display-using-mime nil) +(setq vm-send-using-mime nil) ;;; @ MIME encoded-words @@ -259,7 +311,6 @@ (cdr ret)) ret))) -(require 'vm-summary) (or (fboundp 'tm:vm-su-subject) (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject)) ) @@ -413,7 +464,9 @@ vm-use-menus (vm-menu-support-possible-p)) (progn (vm-energize-urls) - (vm-energize-headers))))))) + (vm-energize-headers))) + (run-hooks 'tm-vm/build-mime-preview-buffer-hook) + )))) (defun tm-vm/sync-preview-buffer () "Ensure that the MIME preview buffer, if it exists, actually corresponds to the current message. @@ -968,7 +1021,6 @@ ;;; @@ vm-yank-message -(require 'vm-reply) (defvar tm-vm/yank:message-to-restore nil "For internal use by tm-vm only.") @@ -1237,19 +1289,6 @@ ;;; @@@ Menus -;;; modified by Steven L. Baur <steve@miranova.com> -;;; 1995/12/6 (c.f. [tm-en:209]) -(defun mime-editor/attach-to-vm-mode-menu () - "Arrange to attach MIME editor's popup menu to VM's" - (if (boundp 'vm-menu-mail-menu) - (progn - (setq vm-menu-mail-menu - (append vm-menu-mail-menu - (list "----" - mime-editor/popup-menu-for-xemacs))) - (remove-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu) - )) -) (call-after-loaded 'tm-edit @@ -1264,10 +1303,6 @@ (interactive) (funcall send-mail-function) ))) - (if (and (string-match "XEmacs\\|Lucid" emacs-version) - tm-vm/attach-to-popup-menus) - (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu) - ) ))) @@ -1312,11 +1347,91 @@ (vm-menu-popup-mode-menu event)))) ) +(defadvice vm-save-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) +(defadvice vm-expunge-folder (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-save-folder (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-goto-parent-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-delete-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (interactive "p") + (if (interactive-p) + (vm-follow-summary-cursor)) + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-delete-message-backward (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (interactive "p") + (if (interactive-p) + (vm-follow-summary-cursor)) + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-undelete-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (interactive "p") + (if (interactive-p) + (vm-follow-summary-cursor)) + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-unread-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-edit-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + + + ;;; @@ VM Toolbar Integration -(require 'vm-toolbar) - ;;; based on vm-toolbar-any-messages-p [vm-toolbar.el] (defun tm-vm/check-for-toolbar () "Install VM toolbar if necessary."
--- a/lisp/utils/skeleton.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/utils/skeleton.el Mon Aug 13 08:50:05 2007 +0200 @@ -391,7 +391,8 @@ (defun skeleton-internal-1 (element &optional literal) - (cond ((char-or-string-p element) + (cond ((or (integerp element) + (char-or-string-p element)) (if (and (integerp element) ; -num (< element 0)) (if skeleton-untabify
--- a/lisp/version.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/version.el Mon Aug 13 08:50:05 2007 +0200 @@ -26,7 +26,7 @@ (defconst emacs-version "19.15" "\ Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta92)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta93)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/vm/Makefile Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/Makefile Mon Aug 13 08:50:05 2007 +0200 @@ -1,9 +1,13 @@ # what Emacs version to build VM for. # Allowed values are 18 and 19. +# Version 18 of Emacs is UNSUPPORTED. +# In fact all versions of Emacs prior to 19.34 for Emacs and +# prior to 19.14 for XEmacs are unsupported. # -# Currently only vm-isearch-forward depends on this being -# correct. You can use the same VM .elc files under v18 and v19 -# Emacs if you don't care about vm-isearch-forward. +# Currently only vm-isearch-forward depends on the EMACS_VERSION +# setting being correct. You can use the same VM .elc files +# under v18 and v19 Emacs if you don't care about +# vm-isearch-forward. # # Note that .elc files compiled with the v19 byte compiler won't # work under v18 Emacs, but v18 .elcs will work under v19. So @@ -50,7 +54,7 @@ OBJECTS = \ vm-delete.elc vm-digest.elc vm-easymenu.elc vm-edit.elc vm-folder.elc \ vm-license.elc vm-mark.elc vm-menu.elc vm-message.elc \ - vm-minibuf.elc vm-misc.elc vm-mouse.elc \ + vm-mime.elc vm-minibuf.elc vm-misc.elc vm-mouse.elc \ vm-motion.elc vm-page.elc vm-pop.elc vm-reply.elc \ vm-save.elc \ vm-search.elc vm-sort.elc vm-summary.elc vm-startup.elc vm-thread.elc \ @@ -60,7 +64,7 @@ SOURCES = \ vm-delete.el vm-digest.el vm-easymenu.el vm-edit.el vm-folder.el \ vm-license.el vm-mark.el vm-menu.el vm-message.el \ - vm-minibuf.el vm-misc.el vm-mouse.el \ + vm-mime.el vm-minibuf.el vm-misc.el vm-mouse.el \ vm-motion.el vm-page.el vm-pop.el vm-reply.el vm-save.el \ vm-search.el vm-sort.el vm-startup.el vm-summary.el vm-thread.el \ vm-toolbar.el \ @@ -142,6 +146,10 @@ @echo compiling vm-minibuf.el... @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-minibuf.el +vm-mime.elc: vm-mime.el $(CORE) + @echo compiling vm-mime.el... + @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-mime.el + vm-misc.elc: vm-misc.el $(CORE) @echo compiling vm-misc.el... @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-misc.el
--- a/lisp/vm/README Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/README Mon Aug 13 08:50:05 2007 +0200 @@ -5,7 +5,8 @@ system, change them. Note that version 18 of Emacs is no longer supported. VM may - or may not work under v18. + or may not work under v18. The old v18 support code has been left + in place for those hardy souls who want to attempt it anyway. 1) Do one of these: `make'. @@ -16,7 +17,7 @@ 2) Put all the .elc files into a Lisp directory that Emacs knows about. (see load-path). -3) If you're using XEmacs 19.12 and you want toolbar support, +3) If you're using XEmacs 19.14 and you want toolbar support, make a directory called `vm' in the XEmacs `etc' directory. Copy the files in pixmaps directory into the directory you just created. VM will look for the pixmap there by default.
--- a/lisp/vm/tapestry.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/tapestry.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Tools to configure your GNU Emacs windows -;;; Copyright (C) 1991, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1991, 1993, 1994, 1995, 1997 Kyle E. Jones ;;; ;;; 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 @@ -20,7 +20,12 @@ (provide 'tapestry) -(defvar tapestry-version "1.07") +(defvar tapestry-version "1.08") + +;; Pass state information between the tapestry-set-window-map +;; and tapestry-set-buffer-map stages. UGH. The reason for this +;; is explained in tapestry-set-buffer-map. +(defvar tapestry-windows-changed nil) (defun tapestry (&optional frame-list) "Returns a list containing complete information about the current @@ -69,6 +74,7 @@ coordinates can be found, the window with the greatest overlap of ROOT-WINDOW-EDGES will be used." (let ((sf (tapestry-selected-frame)) + (tapestry-windows-changed nil) frame-list frame-map other-maps other-map) (setq frame-map (nth 0 map) other-maps (nth 1 map)) @@ -195,12 +201,14 @@ (delete-window inside-w))) (t (setq root-window overlap-w)))) (tapestry-apply-window-map map map-width map-height root-window) + (setq tapestry-windows-changed t) root-window ) (if (tapestry-windows-match-map map map-width map-height) (tapestry-first-window) (delete-other-windows) (setq root-window (selected-window)) (tapestry-apply-window-map map map-width map-height root-window) + (setq tapestry-windows-changed t) root-window )))) (defun tapestry-buffer-map () @@ -214,16 +222,50 @@ w-list (cdr w-list))) (nreverse list))) +;; This version of tapestry-set-buffer-map unconditionally set +;; the window buffer. This confused XEmacs 19.14's scroll-up +;; function when scrolling VM presentation buffers. +;; end-of-buffer was never signaled after a scroll. You can +;; duplicate this by creating a buffer that can be displayed +;; fully in the current window and then run +;; +;; (progn +;; (set-window-buffer (selected-window) (current-buffer)) +;; (scroll-up nil)) +;;;;;;;;;;; +;;(defun tapestry-set-buffer-map (buffer-map &optional first-window) +;; (let ((w-list (tapestry-window-list first-window)) wb) +;; (while (and w-list buffer-map) +;; (setq wb (car buffer-map)) +;; (set-window-buffer +;; (car w-list) +;; (if (car wb) +;; (or (get-file-buffer (car wb)) +;; (find-file-noselect (car wb))) +;; (get-buffer-create (nth 1 wb)))) +;; (setq w-list (cdr w-list) +;; buffer-map (cdr buffer-map))))) + (defun tapestry-set-buffer-map (buffer-map &optional first-window) - (let ((w-list (tapestry-window-list first-window)) wb) + (let ((w-list (tapestry-window-list first-window)) + current-wb proposed-wb cell) (while (and w-list buffer-map) - (setq wb (car buffer-map)) - (set-window-buffer - (car w-list) - (if (car wb) - (or (get-file-buffer (car wb)) - (find-file-noselect (car wb))) - (get-buffer-create (nth 1 wb)))) + (setq cell (car buffer-map) + proposed-wb (if (car cell) + (or (get-file-buffer (car cell)) + (find-file-noselect (car cell))) + (get-buffer-create (nth 1 cell))) + current-wb (window-buffer (car w-list))) + ;; Setting the window buffer to the same value it already + ;; has seems to confuse XEmacs' scroll-up function. But + ;; _not_ setting after windows torn down seem to cause + ;; window point to sometimes drift away from point at + ;; redisplay time. The solution (hopefully!) is to track + ;; when windows have been rearranged and unconditionally do + ;; the set-window-buffer, otherwise do it only if the + ;; window buffer and the prosed window buffer differ. + (if (or tapestry-windows-changed (not (eq proposed-wb current-wb))) + (set-window-buffer (car w-list) proposed-wb)) (setq w-list (cdr w-list) buffer-map (cdr buffer-map)))))
--- a/lisp/vm/vm-autoload.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-autoload.el Mon Aug 13 08:50:05 2007 +0200 @@ -6,7 +6,7 @@ time the current folder is expunged. With a prefix argument COUNT, the current message and the next -COUNT - 1 messages are deleted. A negative argument means the +COUNT - 1 messages are deleted. A negative argument means the current message and the previous |COUNT| - 1 messages are deleted. @@ -18,7 +18,7 @@ (autoload (quote vm-undelete-message) "vm-delete" "Remove the `deleted' attribute from the current message. With a prefix argument COUNT, the current message and the next -COUNT - 1 messages are undeleted. A negative argument means the +COUNT - 1 messages are undeleted. A negative argument means the current message and the previous |COUNT| - 1 messages are deleted. @@ -27,7 +27,13 @@ (autoload (quote vm-kill-subject) "vm-delete" "Delete all messages with the same subject as the current message. Message subjects are compared after ignoring parts matched by -the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix." t nil) +the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix. + +The optional prefix argument ARG specifies the direction to move +if vm-move-after-killing is non-nil. The default direction is +forward. A positive prefix argument means move forward, a +negative arugment means move backward, a zero argument means +don't move at all." t nil) (autoload (quote vm-expunge-folder) "vm-delete" "Expunge messages with the `deleted' attribute. For normal folders this means that the deleted messages are @@ -56,6 +62,28 @@ to be forwarded. See the docs for vm-reorder-message-headers to find out how KEEP-LIST and DISCARD-REGEXP are used." nil nil) +(autoload (quote vm-mime-encapsulate-messages) "vm-digest" "Encapsulate the messages in MESSAGE-LIST as per the MIME spec. +The resulting digest is inserted at point in the current buffer. +Point is not moved. + +MESSAGE-LIST should be a list of message structs (real or virtual). +These are the messages that will be encapsulated. +KEEP-LIST should be a list of regexps matching headers to keep. +DISCARD-REGEXP should be a regexp that matches headers to be discarded. +KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers +to be forwarded. See the docs for vm-reorder-message-headers +to find out how KEEP-LIST and DISCARD-REGEXP are used. + +Returns the multipart boundary parameter (string) that should be used +in the Content-Type header." nil nil) + +(autoload (quote vm-mime-burst-message) "vm-digest" "Burst messages from the digest message M. +M should be a message struct for a real message. +MIME encoding is expected. The message content type +must be either message/* or multipart/digest." nil nil) + +(autoload (quote vm-mime-burst-layout) "vm-digest" nil nil nil) + (autoload (quote vm-rfc934-char-stuff-region) "vm-digest" "Quote RFC 934 message separators between START and END. START and END are buffer positions in the current buffer. Lines beginning with `-' in the region have `- ' prepended to them." nil nil) @@ -126,9 +154,11 @@ (autoload (quote vm-burst-rfc1153-digest) "vm-digest" "Burst an RFC 1153 style digest" t nil) +(autoload (quote vm-burst-mime-digest) "vm-digest" "Burst a MIME digest" t nil) + (autoload (quote vm-guess-digest-type) "vm-digest" "Guess the digest type of the message M. M should be the message struct of a real message. -Returns either \"rfc934\" or \"rfc1153\"." nil nil) +Returns either \"rfc934\", \"rfc1153\" or \"mime\"." nil nil) (autoload (quote vm-easy-menu-define) "vm-easymenu" "Define a menu bar submenu in maps MAPS, according to MENU. The menu keymap is stored in symbol SYMBOL, both as its value @@ -295,8 +325,8 @@ START-POINT should be a cons in vm-message-list or just t. (t means start from the beginning of vm-message-list.) If START-POINT is closer to the head of vm-message-list than -vm-numbering-redo-start-point or is equal to t, then -vm-numbering-redo-start-point is set to match it." nil nil) +vm-summary-redo-start-point or is equal to t, then +vm-summary-redo-start-point is set to match it." nil nil) (autoload (quote vm-mark-for-summary-update) "vm-folder" "Mark message M for a summary update. Also mark M's buffer as needing a display update. Any virtual @@ -316,11 +346,14 @@ (autoload (quote vm-do-needed-mode-line-update) "vm-folder" "Do a modeline update for the current folder buffer. This means setting up all the various vm-ml attribute variables in the folder buffer and copying necessary variables to the -folder buffer's summary buffer, and then forcing Emacs to update -all modelines. - -Also if a virtual folder being updated has no messages, -erase-buffer is called on its buffer." nil nil) +folder buffer's summary and presentation buffers, and then +forcing Emacs to update all modelines. + +If a virtual folder being updated has no messages, then +erase-buffer is called on its buffer. + +If any type of folder is empty, erase-buffer is called +on its presentation buffer, if any." nil nil) (autoload (quote vm-update-summary-and-mode-line) "vm-folder" "Update summary and mode line for all VM folder and summary buffers. Really this updates all the visible status indicators. @@ -385,7 +418,7 @@ This function works by examining the beginning of a folder. If optional arg FILE is present the type of FILE is returned instead. If optional second and third arg START and END are provided, -vm-get-folder-type will examine the the text between those buffer +vm-get-folder-type will examine the text between those buffer positions. START and END default to 1 and (buffer-size) + 1. Returns @@ -514,6 +547,8 @@ (autoload (quote vm-stuff-attributes) "vm-folder" nil nil nil) +(autoload (quote vm-stuff-folder-attributes) "vm-folder" nil nil nil) + (autoload (quote vm-stuff-babyl-attributes) "vm-folder" nil nil nil) (autoload (quote vm-babyl-attributes-string) "vm-folder" nil nil nil) @@ -645,6 +680,10 @@ Interactively TYPE will be read from the minibuffer." t nil) +(autoload (quote vm-garbage-collect-folder) "vm-folder" nil nil nil) + +(autoload (quote vm-garbage-collect-message) "vm-folder" nil nil nil) + (autoload (quote vm-show-copying-restrictions) "vm-license" nil t nil) (autoload (quote vm-show-no-warranty) "vm-license" "Display \"NO WARRANTY\" section of the GNU General Public License." t nil) @@ -663,6 +702,12 @@ N-1 messages. A negative N means unmark the current message and the previous N-1 messages." t nil) +(autoload (quote vm-mark-summary-region) "vm-mark" "Mark all messages with summary lines contained in the region." t nil) + +(autoload (quote vm-unmark-summary-region) "vm-mark" "Remove marks from messages with summary lines contained in the region." t nil) + +(autoload (quote vm-mark-or-unmark-summary-region) "vm-mark" nil nil nil) + (autoload (quote vm-mark-or-unmark-messages-with-selector) "vm-mark" nil nil nil) (autoload (quote vm-mark-matching-messages) "vm-mark" "Mark messages matching some criterion. @@ -720,6 +765,8 @@ (autoload (quote vm-menu-can-undo-p) "vm-menu" nil nil nil) +(autoload (quote vm-menu-can-decode-mime-p) "vm-menu" nil nil nil) + (autoload (quote vm-menu-yank-original) "vm-menu" nil t nil) (autoload (quote vm-menu-can-send-mail-p) "vm-menu" nil nil nil) @@ -742,6 +789,8 @@ (autoload (quote vm-menu-popup-url-browser-menu) "vm-menu" nil t nil) +(autoload (quote vm-menu-popup-mime-dispose-menu) "vm-menu" nil t nil) + (autoload (quote vm-menu-popup-fsfemacs-menu) "vm-menu" nil t nil) (autoload (quote vm-menu-mode-menu) "vm-menu" nil nil nil) @@ -846,6 +895,10 @@ (autoload (quote vm-virtual-summary-of) "vm-message" nil nil (quote macro)) +(autoload (quote vm-mime-layout-of) "vm-message" nil nil (quote macro)) + +(autoload (quote vm-mime-encoded-header-flag-of) "vm-message" nil nil (quote macro)) + (autoload (quote vm-attributes-of) "vm-message" nil nil (quote macro)) (autoload (quote vm-new-flag) "vm-message" nil nil (quote macro)) @@ -970,6 +1023,10 @@ (autoload (quote vm-set-virtual-summary-of) "vm-message" nil nil (quote macro)) +(autoload (quote vm-set-mime-layout-of) "vm-message" nil nil (quote macro)) + +(autoload (quote vm-set-mime-encoded-header-flag-of) "vm-message" nil nil (quote macro)) + (autoload (quote vm-set-attributes-of) "vm-message" nil nil (quote macro)) (autoload (quote vm-set-edited-flag-of) "vm-message" nil nil nil) @@ -1036,6 +1093,280 @@ (autoload (quote vm-virtual-message-p) "vm-message" nil nil nil) +(autoload (quote vm-mime-error) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-type) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-encoding) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-id) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-description) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-disposition) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-header-start) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-body-start) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-body-end) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-parts) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout-cache) "vm-mime" nil nil nil) + +(autoload (quote vm-set-mm-layout-cache) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-layout) "vm-mime" nil nil nil) + +(autoload (quote vm-mm-encoded-header) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-Q-decode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-Q-encode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-Q-decode-string) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-B-decode-string) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-Q-encode-string) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-B-encode-string) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-crlf-to-lf-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-lf-to-crlf-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-charset-decode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-transfer-decode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-base64-decode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-base64-encode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-qp-decode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-qp-encode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-decode-mime-message-headers) "vm-mime" nil nil nil) + +(autoload (quote vm-decode-mime-encoded-words) "vm-mime" nil nil nil) + +(autoload (quote vm-decode-mime-encoded-words-maybe) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-parse-content-header) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-get-header-contents) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-parse-entity) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-parse-entity-safe) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-get-xxx-parameter) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-get-parameter) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-get-disposition-parameter) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-insert-mime-body) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-insert-mime-headers) "vm-mime" nil nil nil) + +(autoload (quote vm-make-presentation-copy) "vm-mime" nil nil nil) + +(autoload (quote vm-determine-proper-charset) "vm-mime" nil nil nil) + +(autoload (quote vm-determine-proper-content-transfer-encoding) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-types-match) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-can-display-internal) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-can-convert) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-convert-undisplayable-layout) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-should-display-button) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-should-display-internal) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-find-external-viewer) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-delete-button-maybe) "vm-mime" nil nil nil) + +(autoload (quote vm-decode-mime-message) "vm-mime" "Decode the MIME objects in the current message. + +The first time this command is run on a message, decoding is done. +The second time, buttons for all the objects are displayed instead. +The third time, the raw, undecoded data is displayed. + +If decoding, the decoded objects might be displayed immediately, or +buttons might be displayed that you need to activate to view the +object. See the documentation for the variables + + vm-auto-displayed-mime-content-types + vm-mime-internal-content-types + vm-mime-external-content-types-alist + +to see how to control whether you see buttons or objects. + +If the variable vm-mime-display-function is set, then its value +is called as a function with no arguments, and none of the +actions mentioned in the preceding paragraphs are done. At the +time of the call, the current buffer will be the presentation +buffer for the folder and a copy of the current message will be +in the buffer. The function is expected to make the message +`MIME presentable' to the user in whatever manner it sees fit." t nil) + +(autoload (quote vm-decode-mime-layout) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-text) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-text/html) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-text/plain) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-text/enriched) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-external-generic) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-application/octet-stream) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-image) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-audio) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-video) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-message) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-multipart) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-multipart/mixed) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-multipart/alternative) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-multipart/parallel) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-multipart/digest) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-message/rfc822) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-message/partial) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-image-xxxx) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-image/gif) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-image/jpeg) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-image/png) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-image/tiff) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-internal-audio/basic) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-display-button-xxxx) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-run-display-function-at-point) "vm-mime" nil t nil) + +(autoload (quote vm-mime-insert-button) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-send-body-to-file) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-pipe-body-to-command) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-pipe-body-to-command-discard-output) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-scrub-description) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-layout-description) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-layout-contains-type) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-plain-message-p) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-text-type-p) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-charset-internally-displayable-p) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-find-message/partials) "vm-mime" nil nil nil) + +(autoload (quote vm-message-at-point) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-make-multipart-boundary) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-attach-file) "vm-mime" "Attach a file to a VM composition buffer to be sent along with the message. +The file is not inserted into the buffer and MIME encoded until +you execute vm-mail-send or vm-mail-send-and-exit. A visible tag +indicating the existence of the attachment is placed in the +composition buffer. You can move the attachment around or remove +it entirely with normal text editing commands. If you remove the +attachment tag, the attachment will not be sent. + +First argument, FILE, is the name of the file to attach. Second +argument, TYPE, is the MIME Content-Type of the file. Optional +third argument CHARSET is the character set of the attached +document. This argument is only used for text types, and it +is ignored for other types. + +When called interactively all arguments are read from the +minibuffer. + +This command is for attaching files that do not have a MIME +header section at the top. For files with MIME headers, you +should use vm-mime-attach-mime-file to attach such a file. VM +will extract the content type information from the headers in +this case and not prompt you for it in the minibuffer." t nil) + +(autoload (quote vm-mime-attach-mime-file) "vm-mime" "Attach a MIME encoded file to a VM composition buffer to be sent +along with the message. + +The file is not inserted into the buffer until you execute +vm-mail-send or vm-mail-send-and-exit. A visible tag indicating +the existence of the attachment is placed in the composition +buffer. You can move the attachment around or remove it entirely +with normal text editing commands. If you remove the attachment +tag, the attachment will not be sent. + +The sole argument, FILE, is the name of the file to attach. +When called interactively the FILE argument is read from the +minibuffer. + +This command is for attaching files that have a MIME +header section at the top. For files without MIME headers, you +should use vm-mime-attach-file to attach such a file. VM +will interactively query you for the file type information." t nil) + +(autoload (quote vm-mime-attach-object) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-default-type-from-filename) "vm-mime" nil nil nil) + +(autoload (quote vm-remove-mail-mode-header-separator) "vm-mime" nil nil nil) + +(autoload (quote vm-add-mail-mode-header-separator) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-transfer-encode-region) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-transfer-encode-layout) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-encode-composition) "vm-mime" "MIME encode the current buffer. +Attachment tags added to the buffer with vm-mime-attach-file are expanded +and the approriate content-type and boundary markup information is added." t nil) + +(autoload (quote vm-mime-fragment-composition) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-preview-composition) "vm-mime" "Show how the current composition buffer might be displayed +in a MIME-aware mail reader. VM copies and encodes the current +mail composition buffer and displays it as a mail folder. +Type `q' to quit this temp folder and return to composing your +message." t nil) + +(autoload (quote vm-mime-composite-type-p) "vm-mime" nil nil nil) + +(autoload (quote vm-mime-map-atomic-layouts) "vm-mime" nil nil nil) + (autoload (quote vm-minibuffer-complete-word) "vm-minibuf" nil t nil) (autoload (quote vm-minibuffer-complete-word-and-exit) "vm-minibuf" nil t nil) @@ -1111,6 +1442,8 @@ (autoload (quote vm-check-for-killed-summary) "vm-misc" nil nil nil) +(autoload (quote vm-check-for-killed-presentation) "vm-misc" nil nil nil) + (autoload (quote vm-check-for-killed-folder) "vm-misc" nil nil nil) (autoload (quote vm-error-if-folder-read-only) "vm-misc" nil nil (quote macro)) @@ -1139,6 +1472,12 @@ (autoload (quote vm-delete) "vm-misc" nil nil nil) +(autoload (quote vm-delete-directory-file-names) "vm-misc" nil nil nil) + +(autoload (quote vm-delete-backup-file-names) "vm-misc" nil nil nil) + +(autoload (quote vm-delete-auto-save-file-names) "vm-misc" nil nil nil) + (autoload (quote vm-delete-duplicates) "vm-misc" "Delete duplicate equivalent strings from the list. If ALL is t, then if there is more than one occurrence of a string in the list, then all occurrences of it are removed instead of just the subsequent ones. @@ -1158,6 +1497,8 @@ (autoload (quote vm-xemacs-p) "vm-misc" nil nil nil) +(autoload (quote vm-xemacs-mule-p) "vm-misc" nil nil nil) + (autoload (quote vm-fsfemacs-19-p) "vm-misc" nil nil nil) (autoload (quote vm-multiple-frames-possible-p) "vm-misc" nil nil nil) @@ -1192,6 +1533,20 @@ (autoload (quote vm-buffer-string-no-properties) "vm-misc" nil nil nil) +(autoload (quote vm-insert-region-from-buffer) "vm-misc" nil nil nil) + +(autoload (quote vm-copy-extent) "vm-misc" nil nil nil) + +(autoload (quote vm-make-tempfile-name) "vm-misc" nil nil nil) + +(autoload (quote vm-insert-char) "vm-misc" nil nil nil) + +(autoload (quote vm-xemacs-compatible-insert-char) "vm-misc" nil nil nil) + +(autoload (quote vm-symbol-lists-intersect-p) "vm-misc" nil nil nil) + +(autoload (quote vm-set-buffer-variable) "vm-misc" nil nil nil) + (autoload (quote vm-mouse-fsfemacs-mouse-p) "vm-mouse" nil nil nil) (autoload (quote vm-mouse-xemacs-mouse-p) "vm-mouse" nil nil nil) @@ -1202,7 +1557,7 @@ (autoload (quote vm-mouse-button-3) "vm-mouse" nil t nil) -(autoload (quote vm-mouse-3-help) "vm-mouse" "Use mouse button 3 to see a menu of options." nil nil) +(autoload (quote vm-mouse-3-help) "vm-mouse" nil nil nil) (autoload (quote vm-mouse-get-mouse-track-string) "vm-mouse" nil nil nil) @@ -1224,6 +1579,8 @@ (autoload (quote vm-run-command) "vm-mouse" nil nil nil) +(autoload (quote vm-run-command-on-region) "vm-mouse" nil nil nil) + (autoload (quote vm-mouse-read-file-name) "vm-mouse" "Like read-file-name, except uses a mouse driven interface. HISTORY argument is ignored." nil nil) @@ -1320,6 +1677,14 @@ (autoload (quote vm-url-help) "vm-page" nil nil nil) +(autoload (quote vm-energize-urls-in-message-region) "vm-page" nil nil nil) + +(autoload (quote vm-highlight-headers-maybe) "vm-page" nil nil nil) + +(autoload (quote vm-energize-headers-and-xfaces) "vm-page" nil nil nil) + +(autoload (quote vm-narrow-for-preview) "vm-page" nil nil nil) + (autoload (quote vm-preview-current-message) "vm-page" nil nil nil) (autoload (quote vm-show-current-message) "vm-page" nil nil nil) @@ -1397,6 +1762,8 @@ (autoload (quote vm-mail-send) "vm-reply" "Just like mail-send except that VM flags the appropriate message(s) as replied to, forwarded, etc, if appropriate." t nil) +(autoload (quote vm-mail-mode-get-header-contents) "vm-reply" nil nil nil) + (autoload (quote vm-rename-current-mail-buffer) "vm-reply" nil nil nil) (autoload (quote vm-mail-mark-replied) "vm-reply" nil nil nil) @@ -1471,6 +1838,8 @@ (autoload (quote vm-send-rfc1153-digest) "vm-reply" "Like vm-send-digest but always sends an RFC 1153 digest." t nil) +(autoload (quote vm-send-mime-digest) "vm-reply" "Like vm-send-digest but always sends an MIME (multipart/digest) digest." t nil) + (autoload (quote vm-continue-composing-message) "vm-reply" "Find and select the most recently used mail composition buffer. If the selected buffer is already a Mail mode buffer then it is buried before beginning the search. Non Mail mode buffers and @@ -1478,6 +1847,8 @@ Mail mode buffers are not skipped. If no suitable buffer is found, the current buffer remains selected." t nil) +(autoload (quote vm-mail-to-mailto-url) "vm-reply" nil nil nil) + (autoload (quote vm-mail-internal) "vm-reply" nil nil nil) (autoload (quote vm-reply-other-frame) "vm-reply" "Like vm-reply, but run in a newly created frame." t nil) @@ -1502,6 +1873,8 @@ (autoload (quote vm-send-rfc1153-digest-other-frame) "vm-reply" "Like vm-send-rfc1153-digest, but run in a newly created frame." t nil) +(autoload (quote vm-send-mime-digest-other-frame) "vm-reply" "Like vm-send-mime-digest, but run in a newly created frame." t nil) + (autoload (quote vm-match-data) "vm-save" nil nil nil) (autoload (quote vm-auto-select-folder) "vm-save" nil nil nil) @@ -1695,7 +2068,7 @@ (autoload (quote vm-mode) "vm-startup" "Major mode for reading mail. -This is VM 5.96 (beta). +This is VM 6.13. Commands: h - summarize folder contents @@ -1735,7 +2108,7 @@ @ - digestify and mail entire folder contents (the folder is not modified) * - burst a digest into individual messages, and append and assimilate these - message into the current folder. + messages into the current folder. G - sort messages by various keys @@ -1764,14 +2137,16 @@ M U - unmark the current message M m - mark all messages M u - unmark all messages - M C - mark messages matches by a virtual folder selector - M c - unmark messages matches by a virtual folder selector + M C - mark messages matched by a virtual folder selector + M c - unmark messages matched by a virtual folder selector M T - mark thread tree rooted at the current message M t - unmark thread tree rooted at the current message M S - mark messages with the same subject as the current message M s - unmark messages with the same subject as the current message M A - mark messages with the same author as the current message M a - unmark messages with the same author as the current message + M R - mark messages within the point/mark region in the summary + M r - unmark messages within the point/mark region in the summary M ? - partial help for mark commands @@ -1818,17 +2193,21 @@ vm-arrived-message-hook vm-arrived-messages-hook vm-auto-center-summary + vm-auto-decode-mime-messages + vm-auto-displayed-mime-content-types vm-auto-folder-alist vm-auto-folder-case-fold-search vm-auto-get-new-mail vm-auto-next-message vm-berkeley-mail-compatibility + vm-burst-digest-messages-inherit-labels vm-check-folder-types - vm-convert-folder-types vm-circular-folders vm-confirm-new-folders vm-confirm-quit + vm-convert-folder-types vm-crash-box + vm-crash-box-suffix vm-default-folder-type vm-delete-after-archiving vm-delete-after-bursting @@ -1839,6 +2218,7 @@ vm-digest-preamble-format vm-digest-send-type vm-display-buffer-hook + vm-display-using-mime vm-edit-message-hook vm-folder-directory vm-folder-read-only @@ -1848,8 +2228,11 @@ vm-forwarding-digest-type vm-forwarding-subject-format vm-frame-parameter-alist + vm-frame-per-completion vm-frame-per-composition + vm-frame-per-edit vm-frame-per-folder + vm-frame-per-summary vm-highlighted-header-face vm-highlighted-header-regexp vm-honor-page-delimiters @@ -1858,32 +2241,52 @@ vm-included-text-discard-header-regexp vm-included-text-headers vm-included-text-prefix - vm-inhibit-startup-message vm-invisible-header-regexp vm-jump-to-new-messages vm-jump-to-unread-messages + vm-keep-crash-boxes vm-keep-sent-messages - vm-keep-crash-boxes vm-mail-header-from vm-mail-mode-hook + vm-make-crash-box-name + vm-make-spool-file-name + vm-mime-8bit-composition-charset + vm-mime-8bit-text-transfer-encoding + vm-mime-alternative-select-method + vm-mime-attachment-auto-type-alist + vm-mime-attachment-save-directory + vm-mime-avoid-folding-content-type + vm-mime-base64-decoder-program + vm-mime-base64-decoder-switches + vm-mime-base64-encoder-program + vm-mime-base64-encoder-switches + vm-mime-button-face + vm-mime-digest-discard-header-regexp + vm-mime-digest-headers + vm-mime-display-function + vm-mime-external-content-types-alist + vm-mime-internal-content-types + vm-mime-max-message-size vm-mode-hook vm-mosaic-program vm-move-after-deleting + vm-move-after-killing vm-move-after-undeleting vm-move-messages-physically + vm-mutable-frames vm-mutable-windows - vm-mutable-frames vm-netscape-program - vm-options-file vm-pop-md5-program + vm-popup-menu-on-mouse-3 + vm-preferences-file vm-preview-lines vm-preview-read-messages vm-primary-inbox vm-quit-hook vm-recognize-pop-maildrops vm-reply-hook + vm-reply-ignored-addresses vm-reply-ignored-reply-tos - vm-reply-ignored-addresses vm-reply-subject-prefix vm-resend-bounced-discard-header-regexp vm-resend-bounced-headers @@ -1901,9 +2304,11 @@ vm-select-new-message-hook vm-select-unread-message-hook vm-send-digest-hook + vm-send-using-mime vm-skip-deleted-messages vm-skip-read-messages vm-spool-files + vm-spool-file-suffixes vm-startup-with-summary vm-strip-reply-headers vm-summary-arrow @@ -1912,14 +2317,16 @@ vm-summary-mode-hook vm-summary-redo-hook vm-summary-show-threads - vm-summary-subject-no-newlines vm-summary-thread-indent-level + vm-temp-file-directory + vm-tale-is-an-idiot vm-trust-From_-with-Content-Length vm-undisplay-buffer-hook vm-unforwarded-header-regexp vm-url-browser vm-url-search-limit vm-use-menus + vm-use-toolbar vm-virtual-folder-alist vm-virtual-mirror vm-visible-headers @@ -1971,6 +2378,8 @@ (autoload (quote vm-load-init-file) "vm-startup" nil t nil) +(autoload (quote vm-check-emacs-version) "vm-startup" nil nil nil) + (autoload (quote vm-session-initialization) "vm-startup" nil nil nil) (autoload (quote vm-summary-mode-internal) "vm-summary" nil nil nil) @@ -2109,6 +2518,10 @@ (autoload (quote vm-toolbar-can-recover-p) "vm-toolbar" nil nil nil) +(autoload (quote vm-toolbar-can-decode-mime-p) "vm-toolbar" nil nil nil) + +(autoload (quote vm-toolbar-can-quit-p) "vm-toolbar" nil nil nil) + (autoload (quote vm-toolbar-update-toolbar) "vm-toolbar" nil nil nil) (autoload (quote vm-toolbar-install-toolbar) "vm-toolbar" nil nil nil) @@ -2243,12 +2656,6 @@ (autoload (quote vm-virtual-help) "vm-virtual" nil t nil) -(autoload (quote vm-delete-directory-file-names) "vm-virtual" nil nil nil) - -(autoload (quote vm-delete-backup-file-names) "vm-virtual" nil nil nil) - -(autoload (quote vm-delete-auto-save-file-names) "vm-virtual" nil nil nil) - (autoload (quote vm-vs-or) "vm-virtual" nil nil nil) (autoload (quote vm-vs-and) "vm-virtual" nil nil nil) @@ -2380,10 +2787,18 @@ (autoload (quote vm-set-hooks-for-frame-deletion) "vm-window" nil nil nil) +(autoload (quote vm-created-this-frame-p) "vm-window" nil nil nil) + (autoload (quote vm-delete-buffer-frame) "vm-window" nil nil nil) +(autoload (quote vm-register-frame) "vm-window" nil nil nil) + (autoload (quote vm-goto-new-frame) "vm-window" nil nil nil) +(autoload (quote vm-goto-new-summary-frame-maybe) "vm-window" nil nil nil) + +(autoload (quote vm-goto-new-folder-frame-maybe) "vm-window" nil nil nil) + (autoload (quote vm-warp-mouse-to-frame-maybe) "vm-window" nil nil nil) (autoload (quote vm-iconify-frame-xxx) "vm-window" nil nil nil)
--- a/lisp/vm/vm-delete.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-delete.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Delete and expunge commands for VM. -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -24,7 +24,7 @@ time the current folder is expunged. With a prefix argument COUNT, the current message and the next -COUNT - 1 messages are deleted. A negative argument means the +COUNT - 1 messages are deleted. A negative argument means the current message and the previous |COUNT| - 1 messages are deleted. @@ -71,7 +71,7 @@ "Remove the `deleted' attribute from the current message. With a prefix argument COUNT, the current message and the next -COUNT - 1 messages are undeleted. A negative argument means the +COUNT - 1 messages are undeleted. A negative argument means the current message and the previous |COUNT| - 1 messages are deleted. @@ -107,11 +107,17 @@ (eq vm-move-after-undeleting t)))) (vm-next-message count t executing-kbd-macro))))) -(defun vm-kill-subject () +(defun vm-kill-subject (&optional arg) "Delete all messages with the same subject as the current message. Message subjects are compared after ignoring parts matched by -the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix." - (interactive) +the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix. + +The optional prefix argument ARG specifies the direction to move +if vm-move-after-killing is non-nil. The default direction is +forward. A positive prefix argument means move forward, a +negative arugment means move backward, a zero argument means +don't move at all." + (interactive "p") (vm-follow-summary-cursor) (vm-select-folder-buffer) (vm-check-for-killed-summary) @@ -133,7 +139,16 @@ (message "No messages deleted.") (message "%d message%s deleted" n (if (= n 1) "" "s"))))) (vm-display nil nil '(vm-kill-subject) '(vm-kill-subject)) - (vm-update-summary-and-mode-line)) + (vm-update-summary-and-mode-line) + (cond ((or (not (numberp arg)) (> arg 0)) + (setq arg 1)) + ((< arg 0) + (setq arg -1)) + (t (setq arg 0))) + (if vm-move-after-killing + (let ((vm-circular-folders (and vm-circular-folders + (eq vm-move-after-deleting t)))) + (vm-next-message arg t executing-kbd-macro)))) (defun vm-expunge-folder (&optional shaddap) "Expunge messages with the `deleted' attribute. @@ -273,11 +288,13 @@ (lambda (buffer) (set-buffer (symbol-name buffer)) (if (null vm-system-state) - (if (null vm-message-pointer) - ;; folder is now empty - (progn (setq vm-folder-type nil) - (vm-update-summary-and-mode-line)) - (vm-preview-current-message)) + (progn + (vm-garbage-collect-message) + (if (null vm-message-pointer) + ;; folder is now empty + (progn (setq vm-folder-type nil) + (vm-update-summary-and-mode-line)) + (vm-preview-current-message))) (vm-update-summary-and-mode-line)) (if (not (eq major-mode 'vm-virtual-mode)) (setq vm-message-order-changed
--- a/lisp/vm/vm-digest.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-digest.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Message encapsulation -;;; Copyright (C) 1989, 1990, 1993, 1994 Kyle E. Jones +;;; Copyright (C) 1989, 1990, 1993, 1994, 1997 Kyle E. Jones ;;; ;;; 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 @@ -54,6 +54,149 @@ (goto-char (point-max)) (insert "------- end of forwarded message -------\n")))) +(defun vm-mime-encapsulate-messages (message-list keep-list discard-regexp) + "Encapsulate the messages in MESSAGE-LIST as per the MIME spec. +The resulting digest is inserted at point in the current buffer. +Point is not moved. + +MESSAGE-LIST should be a list of message structs (real or virtual). +These are the messages that will be encapsulated. +KEEP-LIST should be a list of regexps matching headers to keep. +DISCARD-REGEXP should be a regexp that matches headers to be discarded. +KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers +to be forwarded. See the docs for vm-reorder-message-headers +to find out how KEEP-LIST and DISCARD-REGEXP are used. + +Returns the multipart boundary parameter (string) that should be used +in the Content-Type header." + (if message-list + (let ((target-buffer (current-buffer)) + (boundary-positions nil) + (mlist message-list) + (mime-keep-list (append keep-list vm-mime-header-list)) + boundary source-buffer m start n beg) + (save-restriction + ;; narrow to a zero length region to avoid interacting + ;; with anything that might have already been inserted + ;; into the buffer. + (narrow-to-region (point) (point)) + (setq start (point)) + (while mlist + (setq boundary-positions (cons (point-marker) boundary-positions)) + (setq m (vm-real-message-of (car mlist)) + source-buffer (vm-buffer-of m)) + (setq beg (point)) + (vm-insert-region-from-buffer source-buffer (vm-headers-of m) + (vm-text-end-of m)) + (goto-char beg) + (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)") + (vm-reorder-message-headers + nil (if (vm-mime-plain-message-p m) + keep-list + mime-keep-list) + discard-regexp) + (goto-char (point-max)) + (setq mlist (cdr mlist))) + (goto-char start) + (setq boundary (vm-mime-make-multipart-boundary)) + (while (re-search-forward (concat "^--" + (regexp-quote boundary) + "\\(--\\)?$") + nil t) + (setq boundary (vm-mime-make-multipart-boundary)) + (goto-char start)) + (goto-char (point-max)) + (insert "\n--" boundary "--\n") + (while boundary-positions + (goto-char (car boundary-positions)) + (insert "\n--" boundary "\n\n") + (setq boundary-positions (cdr boundary-positions))) + (goto-char start) + (setq n (length message-list)) + (insert (format "This is a %s%sMIME encapsulation.\n" + (if (cdr message-list) + "digest, " + "forwarded message, ") + (if (cdr message-list) + (format "%d messages, " n) + ""))) + (goto-char start)) + boundary ))) + +(defun vm-mime-burst-message (m) + "Burst messages from the digest message M. +M should be a message struct for a real message. +MIME encoding is expected. The message content type +must be either message/* or multipart/digest." + (let ((ident-header nil) + (layout (vm-mm-layout m))) + (if vm-digest-identifier-header-format + (setq ident-header (vm-sprintf 'vm-digest-identifier-header-format m))) + (vm-mime-burst-layout layout ident-header))) + +(defun vm-mime-burst-layout (layout ident-header) + (let ((work-buffer nil) + (folder-buffer (current-buffer)) + start part-list + (folder-type vm-folder-type)) + (unwind-protect + (vm-save-restriction + (save-excursion + (widen) + (setq work-buffer (generate-new-buffer "*vm-work*")) + (buffer-disable-undo work-buffer) + (set-buffer work-buffer) + (cond ((not (vectorp layout)) + (error "Not a MIME message")) + ((vm-mime-types-match "message" + (car (vm-mm-layout-type layout))) + (insert (vm-leading-message-separator folder-type)) + (and ident-header (insert ident-header)) + (setq start (point)) + (vm-mime-insert-mime-body layout) + (vm-munge-message-separators folder-type start (point)) + (insert (vm-trailing-message-separator folder-type))) + ((vm-mime-types-match "multipart/digest" + (car (vm-mm-layout-type layout))) + (setq part-list (vm-mm-layout-parts layout)) + (while part-list + ;; Maybe we should verify that each part is + ;; of type message/rfc822 in here. But it + ;; seems more useful to just copy whatever + ;; the contents are and let teh user see the + ;; goop, whatever type it really is. + (insert (vm-leading-message-separator folder-type)) + (and ident-header (insert ident-header)) + (setq start (point)) + (vm-mime-insert-mime-body (car part-list)) + (vm-munge-message-separators folder-type start (point)) + (insert (vm-trailing-message-separator folder-type)) + (setq part-list (cdr part-list)))) + (t (error + "MIME type is not multipart/digest or message/rfc822"))) + ;; do header conversions. + (let ((vm-folder-type folder-type)) + (goto-char (point-min)) + (while (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (vm-convert-folder-type-headers folder-type folder-type) + (vm-find-trailing-message-separator) + (vm-skip-past-trailing-message-separator))) + ;; now insert the messages into the folder buffer + (cond ((not (zerop (buffer-size))) + (set-buffer folder-buffer) + (let ((old-buffer-modified-p (buffer-modified-p)) + (buffer-read-only nil) + (inhibit-quit t)) + (goto-char (point-max)) + (insert-buffer-substring work-buffer) + (set-buffer-modified-p old-buffer-modified-p) + ;; return non-nil so caller knows we found some messages + t )) + ;; return nil so the caller knows we didn't find anything + (t nil)))) + (and work-buffer (kill-buffer work-buffer))))) + (defun vm-rfc934-char-stuff-region (start end) "Quote RFC 934 message separators between START and END. START and END are buffer positions in the current buffer. @@ -92,6 +235,7 @@ to find out how KEEP-LIST and DISCARD-REGEXP are used." (if message-list (let ((target-buffer (current-buffer)) + (mime-keep-list (append keep-list vm-mime-header-list)) (mlist message-list) source-buffer m start n) (save-restriction @@ -116,7 +260,11 @@ (goto-char beg) (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)") - (vm-reorder-message-headers nil keep-list discard-regexp) + (vm-reorder-message-headers + nil (if (vm-mime-plain-message-p m) + keep-list + mime-keep-list) + discard-regexp) (vm-rfc934-char-stuff-region beg (point-max)))))) (goto-char (point-max)) (insert "---------------") @@ -175,6 +323,7 @@ to find out how KEEP-LIST and DISCARD-REGEXP are used." (if message-list (let ((target-buffer (current-buffer)) + (mime-keep-list (append keep-list vm-mime-header-list)) (mlist message-list) source-buffer m start) (save-restriction @@ -199,7 +348,11 @@ (goto-char beg) (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)") - (vm-reorder-message-headers nil keep-list discard-regexp) + (vm-reorder-message-headers + nil (if (vm-mime-plain-message-p m) + keep-list + mime-keep-list) + discard-regexp) (vm-rfc1153-char-stuff-region beg (point-max)))))) (goto-char (point-max)) (insert "\n---------------") @@ -228,12 +381,13 @@ separator-regexp "^------------------------------\n") (setq prologue-separator-regexp "^-[^ ].*\n" separator-regexp "^-[^ ].*\n")) - (save-excursion - (vm-save-restriction + (vm-save-restriction + (save-excursion (widen) (unwind-protect (catch 'done (setq work-buffer (generate-new-buffer "*vm-work*")) + (buffer-disable-undo work-buffer) (set-buffer work-buffer) (insert-buffer-substring (vm-buffer-of m) (vm-text-of m) @@ -367,7 +521,9 @@ (error "Couldn't guess digest type.")))) (vm-unsaved-message "Bursting %s digest..." digest-type) (cond - ((cond ((equal digest-type "rfc934") + ((cond ((equal digest-type "mime") + (vm-mime-burst-message m)) + ((equal digest-type "rfc934") (vm-rfc934-burst-message m)) ((equal digest-type "rfc1153") (vm-rfc1153-burst-message m)) @@ -381,8 +537,10 @@ ;; buffer. switch back. (save-excursion (set-buffer start-buffer) - (vm-delete-message 1))) - (vm-assimilate-new-messages t) + ;; don't move message pointer when deleting the message + (let ((vm-move-after-deleting nil)) + (vm-delete-message 1)))) + (vm-assimilate-new-messages t nil (vm-labels-of (car mlist))) ;; do this now so if we error later in another iteration ;; of the loop the summary and mode line will be correct. (vm-update-summary-and-mode-line))) @@ -392,6 +550,7 @@ ;; themselves. (setq totals-blurb (vm-emit-totals-blurb)) (vm-display nil nil '(vm-burst-digest + vm-burst-mime-digest vm-burst-rfc934-digest vm-burst-rfc1153-digest) (list this-command)) @@ -410,16 +569,29 @@ (interactive) (vm-burst-digest "rfc1153")) +(defun vm-burst-mime-digest () + "Burst a MIME digest" + (interactive) + (vm-burst-digest "mime")) + (defun vm-guess-digest-type (m) "Guess the digest type of the message M. M should be the message struct of a real message. -Returns either \"rfc934\" or \"rfc1153\"." - (save-excursion - (set-buffer (vm-buffer-of m)) +Returns either \"rfc934\", \"rfc1153\" or \"mime\"." + (catch 'return-value + (save-excursion + (set-buffer (vm-buffer-of m)) + (let ((layout (vm-mm-layout m))) + (if (and (vectorp layout) + (or (vm-mime-types-match "multipart/digest" + (car (vm-mm-layout-type layout))) + (vm-mime-types-match "message/rfc822" + (car (vm-mm-layout-type layout))))) + (throw 'return-value "mime")))) (save-excursion (save-restriction (widen) (goto-char (vm-text-of m)) - (if (search-forward "\n----------------------------------------------------------------------\n" nil t) - "rfc1153" - "rfc934"))))) + (cond ((search-forward "\n----------------------------------------------------------------------\n" (vm-text-end-of m) t) + "rfc1153") + (t "rfc934"))))))
--- a/lisp/vm/vm-edit.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-edit.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Editing VM messages -;;; Copyright (C) 1990, 1991, 1993, 1994 Kyle E. Jones +;;; Copyright (C) 1990, 1991, 1993, 1994, 1997 Kyle E. Jones ;;; ;;; 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 @@ -33,6 +33,7 @@ (vm-follow-summary-cursor) (vm-select-folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-error-if-folder-read-only) (vm-error-if-folder-empty) (if (and (vm-virtual-message-p (car vm-message-pointer)) @@ -44,7 +45,10 @@ (vm-set-edited-flag-of (car vm-message-pointer) nil) (vm-update-summary-and-mode-line))) (let ((mp vm-message-pointer) - (offset (- (point) (vm-headers-of (car vm-message-pointer)))) + (offset (save-excursion + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (- (point) (vm-headers-of (car vm-message-pointer))))) (edit-buf (vm-edit-buffer-of (car vm-message-pointer))) (folder-buffer (current-buffer))) (if (not (and edit-buf (buffer-name edit-buf))) @@ -124,6 +128,7 @@ (vm-follow-summary-cursor) (vm-select-folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-error-if-folder-empty) (let ((mlist (vm-select-marked-or-prefixed-messages count)) m) (while mlist @@ -134,6 +139,9 @@ (vm-set-vheaders-of m nil) (vm-set-vheaders-regexp-of m nil) (vm-set-text-of m nil) + (vm-set-mime-layout-of m nil) + (if (and vm-presentation-buffer (eq (car vm-message-pointer) m)) + (save-excursion (vm-preview-current-message))) (if vm-thread-obarray (vm-build-threads (list m))) (if vm-summary-show-threads @@ -142,6 +150,9 @@ (save-excursion (while v-list (set-buffer (vm-buffer-of (car v-list))) + (if (and vm-presentation-buffer + (eq (car vm-message-pointer) (car v-list))) + (save-excursion (vm-preview-current-message))) (if vm-thread-obarray (vm-build-threads (list (car v-list)))) (if vm-summary-show-threads
--- a/lisp/vm/vm-folder.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; VM folder related functions -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995, 1996 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; 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 @@ -59,17 +59,18 @@ vm-numbering-redo-start-point or is equal to t, then vm-numbering-redo-start-point is set to match it." (intern (buffer-name) vm-buffers-needing-display-update) - (if (and (consp start-point) (consp vm-numbering-redo-start-point) - (not (eq vm-numbering-redo-start-point t))) - (let ((mp vm-message-list)) - (while (and mp (not (or (eq mp start-point) - (eq mp vm-numbering-redo-start-point)))) - (setq mp (cdr mp))) - (if (null mp) - (error "Something is wrong in vm-set-numbering-redo-start-point")) - (if (eq mp start-point) - (setq vm-numbering-redo-start-point start-point))) - (setq vm-numbering-redo-start-point start-point))) + (if (eq vm-numbering-redo-start-point t) + nil + (if (and (consp start-point) (consp vm-numbering-redo-start-point)) + (let ((mp vm-message-list)) + (while (and mp (not (or (eq mp start-point) + (eq mp vm-numbering-redo-start-point)))) + (setq mp (cdr mp))) + (if (null mp) + (error "Something is wrong in vm-set-numbering-redo-start-point")) + (if (eq mp start-point) + (setq vm-numbering-redo-start-point start-point))) + (setq vm-numbering-redo-start-point start-point)))) (defun vm-set-numbering-redo-end-point (end-point) "Set vm-numbering-redo-end-point to END-POINT if appropriate. @@ -122,20 +123,21 @@ START-POINT should be a cons in vm-message-list or just t. (t means start from the beginning of vm-message-list.) If START-POINT is closer to the head of vm-message-list than -vm-numbering-redo-start-point or is equal to t, then -vm-numbering-redo-start-point is set to match it." +vm-summary-redo-start-point or is equal to t, then +vm-summary-redo-start-point is set to match it." (intern (buffer-name) vm-buffers-needing-display-update) - (if (and (consp start-point) (consp vm-summary-redo-start-point) - (not (eq vm-summary-redo-start-point t))) - (let ((mp vm-message-list)) - (while (and mp (not (or (eq mp start-point) - (eq mp vm-summary-redo-start-point)))) - (setq mp (cdr mp))) - (if (null mp) - (error "Something is wrong in vm-set-summary-redo-start-point")) - (if (eq mp start-point) - (setq vm-summary-redo-start-point start-point))) - (setq vm-summary-redo-start-point start-point))) + (if (eq vm-summary-redo-start-point t) + nil + (if (and (consp start-point) (consp vm-summary-redo-start-point)) + (let ((mp vm-message-list)) + (while (and mp (not (or (eq mp start-point) + (eq mp vm-summary-redo-start-point)))) + (setq mp (cdr mp))) + (if (null mp) + (error "Something is wrong in vm-set-summary-redo-start-point")) + (if (eq mp start-point) + (setq vm-summary-redo-start-point start-point))) + (setq vm-summary-redo-start-point start-point)))) (defun vm-mark-for-summary-update (m &optional dont-kill-cache) "Mark message M for a summary update. @@ -235,22 +237,34 @@ "Do a modeline update for the current folder buffer. This means setting up all the various vm-ml attribute variables in the folder buffer and copying necessary variables to the -folder buffer's summary buffer, and then forcing Emacs to update -all modelines. +folder buffer's summary and presentation buffers, and then +forcing Emacs to update all modelines. -Also if a virtual folder being updated has no messages, -erase-buffer is called on its buffer." +If a virtual folder being updated has no messages, then +erase-buffer is called on its buffer. + +If any type of folder is empty, erase-buffer is called +on its presentation buffer, if any." ;; XXX This last bit should probably should be moved to ;; XXX vm-expunge-folder. (if (null vm-message-pointer) - ;; erase the leftover message if the folder is really empty. - (if (eq major-mode 'vm-virtual-mode) - (let ((buffer-read-only nil) - (omodified (buffer-modified-p))) - (unwind-protect - (erase-buffer) - (set-buffer-modified-p omodified)))) + (progn + ;; erase the leftover message if the folder is really empty. + (if (eq major-mode 'vm-virtual-mode) + (let ((buffer-read-only nil) + (omodified (buffer-modified-p))) + (unwind-protect + (erase-buffer) + (set-buffer-modified-p omodified)))) + (if vm-presentation-buffer + (let ((omodified (buffer-modified-p))) + (unwind-protect + (save-excursion + (set-buffer vm-presentation-buffer) + (let ((buffer-read-only nil)) + (erase-buffer))) + (set-buffer-modified-p omodified))))) ;; try to avoid calling vm-su-labels if possible so as to ;; avoid loading vm-summary.el. (if (vm-labels-of (car vm-message-pointer)) @@ -295,6 +309,30 @@ 'vm-message-list) (set-buffer vm-summary-buffer) (set-buffer-modified-p modified)))) + (if vm-presentation-buffer + (let ((modified (buffer-modified-p))) + (save-excursion + (vm-copy-local-variables vm-presentation-buffer + 'vm-ml-message-new + 'vm-ml-message-unread + 'vm-ml-message-read + 'vm-ml-message-edited + 'vm-ml-message-replied + 'vm-ml-message-forwarded + 'vm-ml-message-filed + 'vm-ml-message-written + 'vm-ml-message-deleted + 'vm-ml-message-marked + 'vm-ml-message-number + 'vm-ml-highest-message-number + 'vm-folder-read-only + 'vm-folder-type + 'vm-virtual-folder-definition + 'vm-virtual-mirror + 'vm-ml-labels + 'vm-message-list) + (set-buffer vm-presentation-buffer) + (set-buffer-modified-p modified)))) (vm-force-mode-line-update)) (defun vm-update-summary-and-mode-line () @@ -440,7 +478,7 @@ This function works by examining the beginning of a folder. If optional arg FILE is present the type of FILE is returned instead. If optional second and third arg START and END are provided, -vm-get-folder-type will examine the the text between those buffer +vm-get-folder-type will examine the text between those buffer positions. START and END default to 1 and (buffer-size) + 1. Returns @@ -939,15 +977,17 @@ ;; ;; header-alist will contain an assoc list version of ;; keep-list. For messages associated with a folder - ;; buffer: when a matching header is found, the header - ;; is stuffed into its corresponding assoc cell and the - ;; header text is deleted from the buffer. After all - ;; the visible headers have been collected, they are - ;; inserted into the buffer in a clump at the end of - ;; the header section. Unmatched headers are skipped over. + ;; buffer: when a matching header is found, the + ;; header's start and end positions are added to its + ;; corresponding assoc cell. The positions of unwanted + ;; headers are remember also so that they can be copied + ;; to the top of the message, to be out of sight after + ;; narrowing. Once the positions have all been + ;; recorded a new copy of the headers is inserted in + ;; the proper order and the old headers are deleted. ;; - ;; For free standing messages, unmatched headers are - ;; stripped from the message. + ;; For free standing messages, unwanted headers are + ;; stripped from the message, unremembered. (vm-save-restriction (let ((header-alist (vm-build-header-order-alist keep-list)) (buffer-read-only nil) @@ -961,6 +1001,10 @@ ;; in a mail context reordering headers is harmless. (buffer-file-name nil) (case-fold-search t) + (unwanted-list nil) + unwanted-tail + new-header-start + old-header-start (old-buffer-modified-p (buffer-modified-p))) (unwind-protect (progn @@ -987,6 +1031,7 @@ (vm-headers-of message) (vm-text-of message)) (goto-char (point-min)))) + (setq old-header-start (point)) (while (and (not (= (following-char) ?\n)) (vm-match-header)) (setq end-of-header (vm-matched-header-end) @@ -998,50 +1043,69 @@ ;; discard-regexp is matched (if (or (and (null list) (null discard-regexp)) (and discard-regexp (looking-at discard-regexp))) - ;; skip the unwanted header if doing + ;; delete the unwanted header if not doing ;; work for a folder buffer, otherwise - ;; discard the header. - (if message - (goto-char end-of-header) - (delete-region (point) end-of-header)) + ;; remember the start and end of the + ;; unwanted header so we can copy it + ;; later. + (if (not message) + (delete-region (point) end-of-header) + (if (null unwanted-list) + (setq unwanted-list + (cons (point) (cons end-of-header nil)) + unwanted-tail unwanted-list) + (if (= (point) (car (cdr unwanted-tail))) + (setcar (cdr unwanted-tail) + end-of-header) + (setcdr (cdr unwanted-tail) + (cons (point) + (cons end-of-header nil))) + (setq unwanted-tail (cdr (cdr unwanted-tail))))) + (goto-char end-of-header)) ;; got a match - ;; stuff the header into the cdr of the - ;; returned alist element + ;; stuff the start and end of the header + ;; into the cdr of the returned alist + ;; element. (if list - (if (cdr list) - (setcdr list - (concat - (cdr list) - (buffer-substring (point) - end-of-header))) - (setcdr list (buffer-substring (point) - end-of-header))) + ;; reverse point and end-of-header. + ;; list will be nreversed later. + (setcdr list (cons end-of-header + (cons (point) + (cdr list)))) + ;; reverse point and end-of-header. + ;; list will be nreversed later. (setq extras - (cons (buffer-substring (point) end-of-header) - extras))) - (delete-region (point) end-of-header))) + (cons end-of-header + (cons (point) extras)))) + (goto-char end-of-header))) + (setq new-header-start (point)) + (while unwanted-list + (insert-buffer-substring (current-buffer) + (car unwanted-list) + (car (cdr unwanted-list))) + (setq unwanted-list (cdr (cdr unwanted-list)))) ;; remember the offset of where the visible ;; header start so we can initialize the ;; vm-vheaders-of field later. (if message - (setq vheader-offset (1- (point)))) - ;; now dump out the headers we saved. - ;; the keep-list headers go first. - (setq list header-alist) - (while list - (if (cdr (car list)) - (progn - (insert (cdr (car list))) - (setcdr (car list) nil))) - (setq list (cdr list))) + (setq vheader-offset (- (point) new-header-start))) + (while header-alist + (setq list (nreverse (cdr (car header-alist)))) + (while list + (insert-buffer-substring (current-buffer) + (car list) + (car (cdr list))) + (setq list (cdr (cdr list)))) + (setq header-alist (cdr header-alist))) ;; now the headers that were not explicitly ;; undesirable, if any. - (if extras - (progn - (setq extras (nreverse extras)) - (while extras - (insert (car extras)) - (setq extras (cdr extras))))) + (setq extras (nreverse extras)) + (while extras + (insert-buffer-substring (current-buffer) + (car extras) + (car (cdr extras))) + (setq extras (cdr (cdr extras)))) + (delete-region old-header-start new-header-start) ;; update the folder buffer if we're supposed to. ;; lock out interrupts. (if message @@ -1473,8 +1537,6 @@ attributes cache (case-fold-search t) (buffer-read-only nil) - ;; don't truncate the printing of large Lisp objects - (print-length nil) opoint ;; This prevents file locking from occuring. Disabling ;; locking can speed things noticeably if the lock @@ -1533,6 +1595,28 @@ (vm-set-modflag-of m nil)) (set-buffer-modified-p old-buffer-modified-p)))))) +(defun vm-stuff-folder-attributes (&optional abort-if-input-pending) + (let ((newlist nil) mp) + ;; stuff the attributes of messages that need it. + ;; build a list of messages that need their attributes stuffed + (setq mp vm-message-list) + (while mp + (if (vm-modflag-of (car mp)) + (setq newlist (cons (car mp) newlist))) + (setq mp (cdr mp))) + ;; now sort the list by physical order so that we + ;; reduce the amount of gap motion induced by modifying + ;; the buffer. what we want to avoid is updating + ;; message 3, then 234, then 10, then 500, thus causing + ;; large chunks of memory to be copied repeatedly as + ;; the gap moves to accomodate the insertions. + (let ((vm-key-functions '(vm-sort-compare-physical-order-r))) + (setq mp (sort newlist 'vm-sort-compare-xxxxxx))) + (while (and mp (or (not abort-if-input-pending) (not (input-pending-p)))) + (vm-stuff-attributes (car mp)) + (setq mp (cdr mp))) + (if mp nil t))) + ;; we can be a bit lazy in this function since it's only called ;; from within vm-stuff-attributes. we don't worry about ;; restoring the modified flag, setting buffer-read-only, or @@ -1655,8 +1739,6 @@ ;; oh well, no way around this. (insert vm-labels-header " " (let ((print-escape-newlines t) - ;; don't truncate the printing of large Lisp objects - (print-length nil) (list nil)) (mapatoms (function (lambda (sym) @@ -1717,8 +1799,6 @@ (widen) (let ((old-buffer-modified-p (buffer-modified-p)) (case-fold-search t) - ;; don't truncate the printing of large Lisp objects - (print-length nil) ;; This prevents file locking from occuring. Disabling ;; locking can speed things noticeably if the lock ;; directory is on a slow device. We don't need locking @@ -1765,8 +1845,6 @@ (case-fold-search t) (print-escape-newlines t) lim - ;; don't truncate the printing of large Lisp objects - (print-length nil) (buffer-read-only nil) ;; This prevents file locking from occuring. Disabling ;; locking can speed things noticeably if the lock @@ -1810,8 +1888,6 @@ (widen) (let ((old-buffer-modified-p (buffer-modified-p)) (case-fold-search t) - ;; don't truncate the printing of large Lisp objects - (print-length nil) ;; This prevents file locking from occuring. Disabling ;; locking can speed things noticeably if the lock ;; directory is on a slow device. We don't need locking @@ -1937,8 +2013,11 @@ (if (not (memq major-mode '(vm-mode vm-virtual-mode))) (error "%s must be invoked from a VM buffer." this-command)) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) - (run-hooks 'vm-quit-hook) + (save-excursion (run-hooks 'vm-quit-hook)) + + (vm-garbage-collect-message) (vm-display nil nil '(vm-quit-just-bury) '(vm-quit-just-bury quitting)) @@ -1946,6 +2025,10 @@ (vm-display vm-summary-buffer nil nil nil)) (if vm-summary-buffer (vm-bury-buffer vm-summary-buffer)) + (if vm-presentation-buffer-handle + (vm-display vm-presentation-buffer-handle nil nil nil)) + (if vm-presentation-buffer-handle + (vm-bury-buffer vm-presentation-buffer-handle)) (vm-display (current-buffer) nil nil nil) (vm-bury-buffer (current-buffer))) @@ -1957,15 +2040,22 @@ (if (not (memq major-mode '(vm-mode vm-virtual-mode))) (error "%s must be invoked from a VM buffer." this-command)) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) - (run-hooks 'vm-quit-hook) + (save-excursion (run-hooks 'vm-quit-hook)) + + (vm-garbage-collect-message) (vm-display nil nil '(vm-quit-just-iconify) '(vm-quit-just-iconify quitting)) - (vm-bury-buffer (current-buffer)) - (if vm-summary-buffer - (vm-bury-buffer vm-summary-buffer)) - (vm-iconify-frame)) + (let ((summary-buffer vm-summary-buffer) + (pres-buffer vm-presentation-buffer-handle)) + (vm-bury-buffer (current-buffer)) + (if summary-buffer + (vm-bury-buffer summary-buffer)) + (if pres-buffer + (vm-bury-buffer pres-buffer)) + (vm-iconify-frame))) (defun vm-quit-no-change () "Quit visiting the current folder without saving changes made to the folder." @@ -1979,11 +2069,13 @@ (if (not (memq major-mode '(vm-mode vm-virtual-mode))) (error "%s must be invoked from a VM buffer." this-command)) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-display nil nil '(vm-quit vm-quit-no-change) (list this-command 'quitting)) (let ((virtual (eq major-mode 'vm-virtual-mode))) (cond ((and (not virtual) no-change (buffer-modified-p) + (or buffer-file-name buffer-offer-save) (not (zerop vm-messages-not-on-disk)) ;; Folder may have been saved with C-x C-s and attributes may have ;; been changed after that; in that case vm-messages-not-on-disk @@ -2000,14 +2092,20 @@ (if (= 1 vm-messages-not-on-disk) "" "s"))))) (error "Aborted")) ((and (not virtual) - no-change (buffer-modified-p) vm-confirm-quit + no-change + (or buffer-file-name buffer-offer-save) + (buffer-modified-p) + vm-confirm-quit (not (y-or-n-p "There are unsaved changes, quit anyway? "))) (error "Aborted")) ((and (eq vm-confirm-quit t) (not (y-or-n-p "Do you really want to quit? "))) (error "Aborted"))) - (run-hooks 'vm-quit-hook) + (save-excursion (run-hooks 'vm-quit-hook)) + + (vm-garbage-collect-message) + (vm-garbage-collect-folder) (vm-virtual-quit) (if (and (not no-change) (not virtual)) @@ -2016,45 +2114,71 @@ (vm-unsaved-message "Quitting...") (or vm-folder-read-only (eq major-mode 'vm-virtual-mode) (vm-change-all-new-to-unread)))) - (if (and (buffer-modified-p) (not no-change) (not virtual)) + (if (and (buffer-modified-p) + (or buffer-file-name buffer-offer-save) + (not no-change) + (not virtual)) (vm-save-folder)) (vm-unsaved-message "") (let ((summary-buffer vm-summary-buffer) + (pres-buffer vm-presentation-buffer-handle) (mail-buffer (current-buffer))) (if summary-buffer (progn - (vm-display vm-summary-buffer nil nil nil) + (vm-display summary-buffer nil nil nil) (kill-buffer summary-buffer))) + (if pres-buffer + (progn + (vm-display pres-buffer nil nil nil) + (kill-buffer pres-buffer))) (set-buffer mail-buffer) (vm-display mail-buffer nil nil nil) ;; vm-display is not supposed to change the current buffer. - ;; still better to be safe here. + ;; still it's better to be safe here. (set-buffer mail-buffer) (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (vm-update-summary-and-mode-line))) (defun vm-start-itimers-if-needed () - (if (or (natnump vm-flush-interval) - (natnump vm-auto-get-new-mail)) - (progn - (if (null - (condition-case data - (progn (require 'itimer) t) - (error nil))) - (setq vm-flush-interval t - vm-auto-get-new-mail t) - (and (natnump vm-flush-interval) (not (get-itimer "vm-flush")) - (start-itimer "vm-flush" 'vm-flush-itimer-function - vm-flush-interval nil)) - (and (natnump vm-auto-get-new-mail) (not (get-itimer "vm-get-mail")) - (start-itimer "vm-get-mail" 'vm-get-mail-itimer-function - vm-auto-get-new-mail nil)))))) + (cond ((and (not (natnump vm-flush-interval)) + (not (natnump vm-auto-get-new-mail)))) + ((condition-case data + (progn (require 'itimer) t) + (error nil)) + (and (natnump vm-flush-interval) (not (get-itimer "vm-flush")) + (start-itimer "vm-flush" 'vm-flush-itimer-function + vm-flush-interval nil)) + (and (natnump vm-auto-get-new-mail) (not (get-itimer "vm-get-mail")) + (start-itimer "vm-get-mail" 'vm-get-mail-itimer-function + vm-auto-get-new-mail nil))) + ((condition-case data + (progn (require 'timer) t) + (error nil)) + (let (timer) + (and (natnump vm-flush-interval) + (setq timer (run-at-time vm-flush-interval vm-flush-interval + 'vm-flush-itimer-function nil)) + (timer-set-function timer 'vm-flush-itimer-function + (list timer))) + (and (natnump vm-auto-get-new-mail) + (setq timer (run-at-time vm-auto-get-new-mail + vm-auto-get-new-mail + 'vm-get-mail-itimer-function nil)) + (timer-set-function timer 'vm-get-mail-itimer-function + (list timer))))) + (t + (setq vm-flush-interval t + vm-auto-get-new-mail t)))) ;; support for numeric vm-auto-get-new-mail -(defun vm-get-mail-itimer-function () +;; if timer argument is present, this means we're using the Emacs +;; 'timer package rather than the 'itimer package. +(defun vm-get-mail-itimer-function (&optional timer) (if (integerp vm-auto-get-new-mail) - (set-itimer-restart current-itimer vm-auto-get-new-mail)) + (if timer + (timer-set-time timer (current-time) vm-auto-get-new-mail) + (set-itimer-restart current-itimer vm-auto-get-new-mail))) (let ((b-list (buffer-list))) (while (and (not (input-pending-p)) b-list) (save-excursion @@ -2079,13 +2203,19 @@ (setq b-list (cdr b-list))))) ;; support for numeric vm-flush-interval -(defun vm-flush-itimer-function () +;; if timer argument is present, this means we're using the Emacs +;; 'timer package rather than the 'itimer package. +(defun vm-flush-itimer-function (&optional timer) (if (integerp vm-flush-interval) - (set-itimer-restart current-itimer vm-flush-interval)) + (if timer + (timer-set-time timer (current-time) vm-flush-interval) + (set-itimer-restart current-itimer vm-flush-interval))) ;; if no vm-mode buffers are found, we might as well shut down the ;; flush itimer. (if (not (vm-flush-cached-data)) - (set-itimer-restart current-itimer nil))) + (if timer + (cancel-timer timer) + (set-itimer-restart current-itimer nil)))) ;; flush cached data in all vm-mode buffers. ;; returns non-nil if any vm-mode buffers were found. @@ -2099,16 +2229,12 @@ (setq found-one t) (if (not (eq vm-modification-counter vm-flushed-modification-counter)) - (let ((mp vm-message-list)) + (progn (vm-stuff-summary) (vm-stuff-labels) (and vm-message-order-changed (vm-stuff-message-order)) - (while (and mp (not (input-pending-p))) - (if (vm-modflag-of (car mp)) - (vm-stuff-attributes (car mp))) - (setq mp (cdr mp))) - (and (null mp) + (and (vm-stuff-folder-attributes t) (setq vm-flushed-modification-counter vm-modification-counter)))))) (setq buf-list (cdr buf-list))) @@ -2124,23 +2250,19 @@ ;; the stuff routines clean up after themselves, but should remain ;; as a safeguard against the time when other stuff is added here. (vm-save-restriction - (let ((mp vm-message-list) - (buffer-read-only)) - (while mp - (if (vm-modflag-of (car mp)) - (vm-stuff-attributes (car mp))) - (setq mp (cdr mp))) - (if vm-message-list - (progn - ;; get summary cache up-to-date - (vm-update-summary-and-mode-line) - (vm-stuff-bookmark) - (vm-stuff-header-variables) - (vm-stuff-labels) - (vm-stuff-summary) - (and vm-message-order-changed - (vm-stuff-message-order)))) - nil )))) + (let ((buffer-read-only)) + (vm-stuff-folder-attributes nil) + (if vm-message-list + (progn + ;; get summary cache up-to-date + (vm-update-summary-and-mode-line) + (vm-stuff-bookmark) + (vm-stuff-header-variables) + (vm-stuff-labels) + (vm-stuff-summary) + (and vm-message-order-changed + (vm-stuff-message-order)))) + nil )))) (defun vm-save-buffer (prefix) (interactive "P") @@ -2177,14 +2299,10 @@ (if (eq major-mode 'vm-virtual-mode) (vm-virtual-save-folder prefix) (if (buffer-modified-p) - (let (mp) + (let (mp (newlist nil)) ;; stuff the attributes of messages that need it. (vm-unsaved-message "Stuffing attributes...") - (setq mp vm-message-list) - (while mp - (if (vm-modflag-of (car mp)) - (vm-stuff-attributes (car mp))) - (setq mp (cdr mp))) + (vm-stuff-folder-attributes nil) ;; stuff bookmark and header variable values (if vm-message-list (progn @@ -2435,8 +2553,31 @@ ;; a timer process might try to start retrieving mail ;; before we finish. block these attempts. (vm-block-new-mail t) + (fallback-triples nil) crash in maildrop popdrop (got-mail nil)) + (cond ((and buffer-file-name + (consp vm-spool-file-suffixes) + (stringp vm-crash-box-suffix)) + (setq fallback-triples + (mapcar (function + (lambda (suffix) + (list buffer-file-name + (concat buffer-file-name suffix) + (concat buffer-file-name + vm-crash-box-suffix)))) + vm-spool-file-suffixes)))) + (cond ((and buffer-file-name + vm-make-spool-file-name vm-make-crash-box-name) + (setq fallback-triples + (ncons fallback-triples + (list (list buffer-file-name + (save-excursion + (funcall vm-make-spool-file-name + buffer-file-name)) + (save-excursion + (funcall vm-make-crash-box-name + buffer-file-name)))))))) (cond ((null (vm-spool-files)) (setq triples (list (list vm-primary-inbox @@ -2449,6 +2590,7 @@ (vm-spool-files)))) ((consp (car (vm-spool-files))) (setq triples (vm-spool-files)))) + (setq triples (append triples fallback-triples)) (while triples (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) maildrop (nth 1 (car triples)) @@ -2573,7 +2715,10 @@ (message "No messages gathered.")))))) ;; returns non-nil if there were any new messages -(defun vm-assimilate-new-messages (&optional dont-read-attributes gobble-order) +(defun vm-assimilate-new-messages (&optional + dont-read-attributes + gobble-order + labels) (let ((tail-cons (vm-last vm-message-list)) b-list new-messages) (save-excursion @@ -2606,6 +2751,12 @@ ;; vm-assimilate-new-messages returns this value so it must ;; not be mangled. (setq new-messages (copy-sequence new-messages)) + ;; add the labels + (if (and labels vm-burst-digest-messages-inherit-labels) + (let ((mp new-messages)) + (while mp + (vm-set-labels-of (car mp) (copy-sequence labels)) + (setq mp (cdr mp))))) (if vm-summary-show-threads (progn ;; get numbering and summary of new messages done now @@ -2688,7 +2839,7 @@ (defun vm-display-startup-message () (if (sit-for 5) (let ((lines vm-startup-message-lines)) - (message "VM %s, Copyright (C) 1996 Kyle E. Jones; type ? for help" + (message "VM %s, Copyright (C) 1997 Kyle E. Jones; type ? for help" vm-version) (setq vm-startup-message-displayed t) (while (and (sit-for 4) lines) @@ -2702,7 +2853,7 @@ (progn (and vm-init-file (load vm-init-file (not interactive) (not interactive) t)) - (and vm-options-file (load vm-options-file t t t)))) + (and vm-preferences-file (load vm-preferences-file t t t)))) (setq vm-init-file-loaded t) (vm-display nil nil '(vm-load-init-file) '(vm-load-init-file))) @@ -2744,10 +2895,16 @@ mode-line-format vm-mode-line-format mode-name "VM" ;; must come after the setting of major-mode - mode-popup-menu (and vm-use-menus + mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3 (vm-menu-support-possible-p) (vm-menu-mode-menu)) buffer-read-only t + ;; If the user quits a vm-mode buffer, the default action is + ;; to kill the buffer. Make a note that we should offer to + ;; save this buffer even if it has no file associated with it. + ;; We have no idea of the value of the data in the buffer + ;; before it was put into vm-mode. + buffer-offer-save t require-final-newline nil vm-thread-obarray nil vm-thread-subject-obarray nil @@ -2767,6 +2924,15 @@ (use-local-map vm-mode-map) (and (vm-menu-support-possible-p) (vm-menu-install-menus)) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-folder) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-message) + ;; avoid the XEmacs file dialog box. + (defvar should-use-dialog-box) + (make-local-variable 'should-use-dialog-box) + (setq should-use-dialog-box nil) + ;; mail folders are precious. protect them by default. + (make-local-variable 'file-precious-flag) + (setq file-precious-flag t) (run-hooks 'vm-mode-hook) ;; compatibility (run-hooks 'vm-mode-hooks)) @@ -2881,6 +3047,24 @@ (narrow-to-region (point-min) (vm-text-end-of (car vm-message-pointer)))) (vm-display nil nil '(vm-change-folder-type) '(vm-change-folder-type))) +(defun vm-garbage-collect-folder () + (save-excursion + (while vm-folder-garbage-alist + (condition-case nil + (funcall (cdr (car vm-folder-garbage-alist)) + (car (car vm-folder-garbage-alist))) + (error nil)) + (setq vm-folder-garbage-alist (cdr vm-folder-garbage-alist))))) + +(defun vm-garbage-collect-message () + (save-excursion + (while vm-message-garbage-alist + (condition-case nil + (funcall (cdr (car vm-message-garbage-alist)) + (car (car vm-message-garbage-alist))) + (error nil)) + (setq vm-message-garbage-alist (cdr vm-message-garbage-alist))))) + (if (not (memq 'vm-write-file-hook write-file-hooks)) (setq write-file-hooks (cons 'vm-write-file-hook write-file-hooks)))
--- a/lisp/vm/vm-mark.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-mark.el Mon Aug 13 08:50:05 2007 +0200 @@ -98,6 +98,61 @@ '(vm-unmark-message marking-message)) (vm-update-summary-and-mode-line)) +(defun vm-mark-summary-region () + "Mark all messages with summary lines contained in the region." + (interactive) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (if (null vm-summary-buffer) + (error "No summary.")) + (set-buffer vm-summary-buffer) + (if (not (mark)) + (error "The region is not active now")) + (vm-mark-or-unmark-summary-region t) + (vm-display nil nil '(vm-mark-summary-region) + '(vm-mark-summary-region marking-message)) + (vm-update-summary-and-mode-line)) + +(defun vm-unmark-summary-region () + "Remove marks from messages with summary lines contained in the region." + (interactive) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (if (null vm-summary-buffer) + (error "No summary.")) + (set-buffer vm-summary-buffer) + (if (not (mark)) + (error "The region is not active now")) + (vm-mark-or-unmark-summary-region nil) + (vm-display nil nil '(vm-unmark-summary-region) + '(vm-unmark-summary-region marking-message)) + (vm-update-summary-and-mode-line)) + +(defun vm-mark-or-unmark-summary-region (markit) + ;; The folder buffers copy of vm-message-list has already been + ;; propagated to the summary buffer. + (let ((mp vm-message-list) + (beg (point)) + (end (mark)) + tmp m) + (if (> beg end) + (setq tmp beg beg end end tmp)) + (while mp + (setq m (car mp)) + (if (not (eq (not markit) (not (vm-mark-of m)))) + (if (or (and (> (vm-su-end-of m) beg) + (< (vm-su-end-of m) end)) + (and (>= (vm-su-start-of m) beg) + (< (vm-su-start-of m) end)) + (and (>= beg (vm-su-start-of m)) + (< beg (vm-su-end-of m)))) + (progn + (vm-set-mark-of m markit) + (vm-mark-for-summary-update m t)))) + (setq mp (cdr mp))))) + (defun vm-mark-or-unmark-messages-with-selector (val selector arg) (let ((mlist vm-message-list) (virtual (eq major-mode 'vm-virtual-mode))
--- a/lisp/vm/vm-menu.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-menu.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Menu related functions and commands -;;; Copyright (C) 1995 Kyle E. Jones +;;; Copyright (C) 1995, 1997 Kyle E. Jones ;;; ;;; Folders menu derived from ;;; vm-folder-menu.el @@ -123,6 +123,7 @@ ["Pipe to Command" vm-pipe-message-to-command vm-message-list] "---" ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list] + ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)] )))) (defconst vm-menu-motion-menu @@ -178,6 +179,7 @@ ["Retry Bounced Message" vm-resend-bounced-message vm-message-list] ["Send Digest (RFC934)" vm-send-rfc934-digest vm-message-list] ["Send Digest (RFC1153)" vm-send-rfc1153-digest vm-message-list] + ["Send MIME Digest" vm-send-mime-digest vm-message-list] )) (defconst vm-menu-mark-menu @@ -281,8 +283,36 @@ ["Insert Signature" mail-signature t] ["Insert File..." insert-file t] ["Insert Buffer..." insert-buffer t] + "----" + "MIME:" + "----" + [" Attach File..." vm-mime-attach-file vm-send-using-mime] + [" Attach MIME File..." vm-mime-attach-mime-file vm-send-using-mime] + [" Encode MIME, But Don't Send" vm-mime-encode-composition + (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:")))] + [" Preview MIME Before Sending" vm-mime-preview-composition + vm-send-using-mime] )))) +(defconst vm-menu-mime-dispose-menu + (let ((title (if (vm-menu-fsfemacs-menus-p) + (list "Send MIME body to ..." + "Send MIME body to ..." + "---" + "---") + (list "Send MIME body to ...")))) + (append + title + (list ["File" (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-file) t] + ["Shell Pipeline (display output)" + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-command) t] + ["Shell Pipeline (discard output)" + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-command-discard-output) t])))) + (defconst vm-menu-url-browser-menu (let ((title (if (vm-menu-fsfemacs-menus-p) (list "Send URL to ..." @@ -369,7 +399,7 @@ vm-menu-label-menu vm-menu-sort-menu vm-menu-virtual-menu - vm-menu-undo-menu +;; vm-menu-undo-menu vm-menu-dispose-menu "---" "---" @@ -420,6 +450,16 @@ (vm-select-folder-buffer) vm-undo-record-list)) +(defun vm-menu-can-decode-mime-p () + (save-excursion + (vm-check-for-killed-folder) + (vm-select-folder-buffer) + (and vm-display-using-mime + vm-message-pointer + vm-presentation-buffer + (not vm-mime-decoded) + (not (vm-mime-plain-message-p (car vm-message-pointer)))))) + (defun vm-menu-yank-original () (interactive) (save-excursion @@ -508,6 +548,10 @@ ;; url browser menu (vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil vm-menu-url-browser-menu) + ;; mime dispose menu + (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu + (list dummy) nil + vm-menu-mime-dispose-menu) ;; block the global menubar entries in the map so that VM ;; can take over the menubar if necessary. (define-key map [rootmenu] (make-sparse-keymap)) @@ -553,7 +597,7 @@ (menu-list (if (consp vm-use-menus) (reverse vm-use-menus) - (list 'help nil 'dispose 'undo 'virtual 'sort + (list 'help nil 'dispose 'virtual 'sort 'label 'mark 'send 'motion 'folder)))) (while menu-list (if (null (car menu-list)) @@ -624,12 +668,16 @@ (vm-menu-popup-url-browser-menu event)) ((setq menu (overlay-get (car o-list) 'vm-header)) (setq found t) - (vm-menu-popup-fsfemacs-menu event menu))) + (vm-menu-popup-fsfemacs-menu event menu)) + ((overlay-get (car o-list) 'vm-mime-layout) + (setq found t) + (vm-menu-popup-mime-dispose-menu event))) (setq o-list (cdr o-list))) (and (not found) (vm-menu-popup-fsfemacs-menu event)))))) ;; to quiet the byte-compiler (defvar vm-menu-fsfemacs-url-browser-menu) +(defvar vm-menu-fsfemacs-mime-dispose-menu) (defun vm-menu-popup-url-browser-menu (event) (interactive "e") @@ -647,6 +695,22 @@ (vm-menu-popup-fsfemacs-menu event vm-menu-fsfemacs-url-browser-menu)))) +(defun vm-menu-popup-mime-dispose-menu (event) + (interactive "e") + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + ;; Must select window instead of just set-buffer because + ;; popup-menu returns before the user has made a + ;; selection. This will cause the command loop to + ;; resume which might undo what set-buffer does. + (select-window (event-window event)) + (and (event-point event) (goto-char (event-point event))) + (popup-menu vm-menu-mime-dispose-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-mime-dispose-menu)))) + ;; to quiet the byte-compiler (defvar vm-menu-fsfemacs-mail-menu) (defvar vm-menu-fsfemacs-dispose-popup-menu) @@ -696,6 +760,9 @@ (cond ((vm-menu-xemacs-menus-p) (if (null (car (find-menu-item current-menubar '("XEmacs")))) (set-buffer-menubar vm-menu-vm-menubar) + ;; copy the current menubar in case it has been changed. + (make-local-variable 'vm-menu-vm-menubar) + (setq vm-menu-vm-menubar (copy-sequence current-menubar)) (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar))) (condition-case nil (add-menu-button nil vm-menu-vm-button nil) @@ -704,7 +771,12 @@ (vm-menu-set-menubar-dirty-flag) (vm-check-for-killed-summary) (and vm-summary-buffer - (vm-menu-toggle-menubar vm-summary-buffer))) + (save-excursion + (vm-menu-toggle-menubar vm-summary-buffer))) + (vm-check-for-killed-presentation) + (and vm-presentation-buffer-handle + (save-excursion + (vm-menu-toggle-menubar vm-presentation-buffer-handle)))) ((vm-menu-fsfemacs-menus-p) (if (not (eq (lookup-key vm-mode-map [menu-bar]) (lookup-key vm-mode-menu-map [rootmenu vm]))) @@ -719,7 +791,9 @@ (defun vm-menu-install-menubar () (cond ((vm-menu-xemacs-menus-p) (setq vm-menu-vm-menubar (vm-menu-make-xemacs-menubar)) - (set-buffer-menubar vm-menu-vm-menubar)) + (set-buffer-menubar vm-menu-vm-menubar) + (run-hooks 'vm-menu-setup-hook) + (setq vm-menu-vm-menubar current-menubar)) ((and (vm-menu-fsfemacs-menus-p) ;; menus only need to be installed once for FSF Emacs (not (fboundp 'vm-menu-undo-menu))) @@ -750,7 +824,8 @@ (cond ((vm-menu-xemacs-menus-p) ;; mail-mode doesn't have mode-popup-menu bound to ;; mouse-3 by default. fix that. - (define-key vm-mail-mode-map 'button3 'popup-mode-menu) + (if vm-popup-menu-on-mouse-3 + (define-key vm-mail-mode-map 'button3 'popup-mode-menu)) ;; put menu on menubar also. (if (vm-menu-xemacs-global-menubar) (progn @@ -764,8 +839,9 @@ ;; Poorly. ;;(define-key vm-mail-mode-map [menu-bar mail] ;; (cons "Mail" vm-menu-fsfemacs-mail-menu)) - (define-key vm-mail-mode-map [down-mouse-3] - 'vm-menu-popup-mode-menu)))) + (if vm-popup-menu-on-mouse-3 + (define-key vm-mail-mode-map [down-mouse-3] + 'vm-menu-popup-mode-menu))))) (defun vm-menu-install-menus () (cond ((consp vm-use-menus)
--- a/lisp/vm/vm-message.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-message.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Macros and functions dealing with accessing VM message struct fields -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; 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 @@ -81,6 +81,11 @@ ;; summary for unmirrored virtual message (defmacro vm-virtual-summary-of (message) (list 'aref (list 'aref message 1) 15)) +;; MIME layout information; types, ids, positions, etc. of all MIME entities +(defmacro vm-mime-layout-of (message) + (list 'aref (list 'aref message 1) 16)) +(defmacro vm-mime-encoded-header-flag-of (message) + (list 'aref (list 'aref message 1) 17)) ;; message attribute vector (defmacro vm-attributes-of (message) (list 'aref message 2)) (defmacro vm-new-flag (message) (list 'aref (list 'aref message 2) 0)) @@ -202,6 +207,10 @@ (list 'aset (list 'aref message 1) 14 data)) (defmacro vm-set-virtual-summary-of (message summ) (list 'aset (list 'aref message 1) 15 summ)) +(defmacro vm-set-mime-layout-of (message layout) + (list 'aset (list 'aref message 1) 16 layout)) +(defmacro vm-set-mime-encoded-header-flag-of (message flag) + (list 'aset (list 'aref message 1) 17 flag)) (defmacro vm-set-attributes-of (message attrs) (list 'aset message 2 attrs)) ;; The other routines in attributes group are part of the undo system. (defun vm-set-edited-flag-of (message flag)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/vm/vm-mime.el Mon Aug 13 08:50:05 2007 +0200 @@ -0,0 +1,2495 @@ +;;; MIME support functions +;;; Copyright (C) 1997 Kyle E. Jones +;;; +;;; 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 1, 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., 675 Mass Ave, Cambridge, MA 02139, USA. + +(provide 'vm-mime) + +(defun vm-mime-error (&rest args) + (signal 'vm-mime-error (list (apply 'format args))) + (error "can't return from vm-mime-error")) + +(if (fboundp 'define-error) + (define-error 'vm-mime-error "MIME error") + (put 'vm-mime-error 'error-conditions '(vm-mime-error error)) + (put 'vm-mime-error 'error-message "MIME error")) + +(defun vm-mm-layout-type (e) (aref e 0)) +(defun vm-mm-layout-encoding (e) (aref e 1)) +(defun vm-mm-layout-id (e) (aref e 2)) +(defun vm-mm-layout-description (e) (aref e 3)) +(defun vm-mm-layout-disposition (e) (aref e 4)) +(defun vm-mm-layout-header-start (e) (aref e 5)) +(defun vm-mm-layout-body-start (e) (aref e 6)) +(defun vm-mm-layout-body-end (e) (aref e 7)) +(defun vm-mm-layout-parts (e) (aref e 8)) +(defun vm-mm-layout-cache (e) (aref e 9)) + +(defun vm-set-mm-layout-cache (e c) (aset e 8 c)) + +(defun vm-mm-layout (m) + (or (vm-mime-layout-of m) + (progn (vm-set-mime-layout-of + m + (condition-case data + (vm-mime-parse-entity m) + (vm-mime-error (apply 'message (cdr data))))) + (vm-mime-layout-of m)))) + +(defun vm-mm-encoded-header (m) + (or (vm-mime-encoded-header-flag-of m) + (progn (setq m (vm-real-message-of m)) + (vm-set-mime-encoded-header-flag-of + m + (save-excursion + (set-buffer (vm-buffer-of m)) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-headers-of m)) + (or (re-search-forward vm-mime-encoded-word-regexp + (vm-text-of m) t) + 'none))))) + (vm-mime-encoded-header-flag-of m)))) + +(defun vm-mime-Q-decode-region (start end) + (let ((buffer-read-only nil)) + (subst-char-in-region start end ?_ (string-to-char " ") t) + (vm-mime-qp-decode-region start end))) + +(fset 'vm-mime-B-decode-region 'vm-mime-base64-decode-region) + +(defun vm-mime-Q-encode-region (start end) + (let ((buffer-read-only nil)) + (subst-char-in-region start end (string-to-char " ") ?_ t) + (vm-mime-qp-encode-region start end))) + +(fset 'vm-mime-B-encode-region 'vm-mime-base64-encode-region) + +(defun vm-mime-Q-decode-string (string) + (vm-with-string-as-region string 'vm-mime-Q-decode-region)) + +(defun vm-mime-B-decode-string (string) + (vm-with-string-as-region string 'vm-mime-B-decode-region)) + +(defun vm-mime-Q-encode-string (string) + (vm-with-string-as-region string 'vm-mime-Q-encode-region)) + +(defun vm-mime-B-encode-string (string) + (vm-with-string-as-region string 'vm-mime-B-encode-region)) + +(defun vm-mime-crlf-to-lf-region (start end) + (let ((buffer-read-only nil)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (while (search-forward "\r\n" nil t) + (delete-char -2) + (insert "\n")))))) + +(defun vm-mime-lf-to-crlf-region (start end) + (let ((buffer-read-only nil)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (while (search-forward "\n" nil t) + (delete-char -1) + (insert "\r\n")))))) + +(defun vm-mime-charset-decode-region (charset start end) + (let ((buffer-read-only nil) + (cell (vm-mime-charset-internally-displayable-p charset)) + (opoint (point))) + (cond ((and cell (vm-xemacs-mule-p) (eq (device-type) 'x)) + (decode-coding-region start end (car cell)))) + ;; In XEmacs 20.0 beta93 decode-coding-region moves point. + (goto-char opoint))) + +(defun vm-mime-transfer-decode-region (layout start end) + (let ((case-fold-search t) (crlf nil)) + (cond ((string-match "^base64$" (vm-mm-layout-encoding layout)) + (cond ((vm-mime-types-match "text" + (car (vm-mm-layout-type layout))) + (setq crlf t)) + ((vm-mime-types-match "message" + (car (vm-mm-layout-type layout))) + (setq crlf t))) + (vm-mime-base64-decode-region start end crlf)) + ((string-match "^quoted-printable$" + (vm-mm-layout-encoding layout)) + (vm-mime-qp-decode-region start end))))) + +(defun vm-mime-base64-decode-region (start end &optional crlf) + (vm-unsaved-message "Decoding base64...") + (let ((work-buffer nil) + (done nil) + (counter 0) + (bits 0) + (lim 0) inputpos + (non-data-chars (concat "^=" vm-mime-base64-alphabet))) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (if vm-mime-base64-decoder-program + (let* ((binary-process-output t) ; any text already has CRLFs + (status (apply 'vm-run-command-on-region + start end work-buffer + vm-mime-base64-decoder-program + vm-mime-base64-decoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status)))) + (goto-char start) + (skip-chars-forward non-data-chars end) + (while (not done) + (setq inputpos (point)) + (cond + ((> (skip-chars-forward vm-mime-base64-alphabet end) 0) + (setq lim (point)) + (while (< inputpos lim) + (setq bits (+ bits + (aref vm-mime-base64-alphabet-decoding-vector + (char-after inputpos)))) + (vm-increment counter) + (vm-increment inputpos) + (cond ((= counter 4) + (vm-insert-char (lsh bits -16) 1 nil work-buffer) + (vm-insert-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (vm-insert-char (logand bits 255) 1 nil work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))))) + (cond + ((= (point) end) + (if (not (zerop counter)) + (vm-mime-error "at least %d bits missing at end of base64 encoding" + (* (- 4 counter) 6))) + (setq done t)) + ((= (char-after (point)) 61) ; 61 is ASCII equals + (setq done t) + (cond ((= counter 1) + (vm-mime-error "at least 2 bits missing at end of base64 encoding")) + ((= counter 2) + (vm-insert-char (lsh bits -10) 1 nil work-buffer)) + ((= counter 3) + (vm-insert-char (lsh bits -16) 1 nil work-buffer) + (vm-insert-char (logand (lsh bits -8) 255) + 1 nil work-buffer)) + ((= counter 0) t))) + (t (skip-chars-forward non-data-chars end))))) + (and crlf + (save-excursion + (set-buffer work-buffer) + (vm-mime-crlf-to-lf-region (point-min) (point-max)))) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (vm-unsaved-message "Decoding base64... done")) + +(defun vm-mime-base64-encode-region (start end &optional crlf) + (vm-unsaved-message "Encoding base64...") + (let ((work-buffer nil) + (counter 0) + (cols 0) + (bits 0) + (alphabet vm-mime-base64-alphabet) + inputpos) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (if crlf + (progn + (or (markerp end) (setq end (vm-marker end))) + (vm-mime-lf-to-crlf-region start end))) + (if vm-mime-base64-encoder-program + (let ((status (apply 'vm-run-command-on-region + start end work-buffer + vm-mime-base64-encoder-program + vm-mime-base64-encoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status)))) + (setq inputpos start) + (while (< inputpos end) + (setq bits (+ bits (char-after inputpos))) + (vm-increment counter) + (cond ((= counter 3) + (vm-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (vm-insert-char (aref alphabet (logand bits 63)) 1 nil + work-buffer) + (setq cols (+ cols 4)) + (cond ((= cols 72) + (vm-insert-char ?\n 1 nil work-buffer) + (setq cols 0))) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 8)))) + (vm-increment inputpos)) + ;; write out any remaining bits with appropriate padding + (if (= counter 0) + nil + (setq bits (lsh bits (- 16 (* 8 counter)))) + (vm-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (if (= counter 1) + (vm-insert-char ?= 2 nil work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (vm-insert-char ?= 1 nil work-buffer))) + (if (> cols 0) + (vm-insert-char ?\n 1 nil work-buffer))) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (vm-unsaved-message "Encoding base64... done")) + +(defun vm-mime-qp-decode-region (start end) + (vm-unsaved-message "Decoding quoted-printable...") + (let ((work-buffer nil) + (buf (current-buffer)) + (case-fold-search nil) + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15))) + inputpos stop-point copy-point) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (goto-char start) + (setq inputpos start) + (while (< inputpos end) + (skip-chars-forward "^=\n" end) + (setq stop-point (point)) + (cond ((looking-at "\n") + ;; spaces or tabs before a hard line break must be ignored + (skip-chars-backward " \t") + (setq copy-point (point)) + (goto-char stop-point)) + (t (setq copy-point stop-point))) + (save-excursion + (set-buffer work-buffer) + (insert-buffer-substring buf inputpos copy-point)) + (cond ((= (point) end) t) + ((looking-at "\n") + (vm-insert-char ?\n 1 nil work-buffer) + (forward-char)) + (t ;; looking at = + (forward-char) + (cond ((looking-at "[0-9A-F][0-9A-F]") + (vm-insert-char (+ (* (cdr (assq (char-after (point)) + hex-digit-alist)) + 16) + (cdr (assq (char-after + (1+ (point))) + hex-digit-alist))) + 1 nil work-buffer) + (forward-char 2)) + ((looking-at "\n") ; soft line break + (forward-char)) + ((looking-at "\r") + ;; assume the user's goatfucking + ;; delivery software didn't convert + ;; from Internet's CRLF newline + ;; convention to the local LF + ;; convention. + (forward-char)) + ((looking-at "[ \t]") + ;; garbage added in transit + (skip-chars-forward " \t" end)) + (t (vm-mime-error "something other than line break or hex digits after = in quoted-printable encoding"))))) + (setq inputpos (point))) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (vm-unsaved-message "Decoding quoted-printable... done")) + +(defun vm-mime-qp-encode-region (start end) + (vm-unsaved-message "Encoding quoted-printable...") + (let ((work-buffer nil) + (buf (current-buffer)) + (cols 0) + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15))) + char inputpos) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (setq inputpos start) + (while (< inputpos end) + (setq char (char-after inputpos)) + (cond ((= char ?\n) + (vm-insert-char char 1 nil work-buffer) + (setq cols 0)) + ((and (= char 32) (not (= ?\n (char-after (1+ inputpos))))) + (vm-insert-char char 1 nil work-buffer) + (vm-increment cols)) + ((or (< char 33) (> char 126) (= char 61)) + (vm-insert-char ?= 1 nil work-buffer) + (vm-insert-char (car (rassq (lsh char -4) hex-digit-alist)) + 1 nil work-buffer) + (vm-insert-char (car (rassq (logand char 15) + hex-digit-alist)) + 1 nil work-buffer) + (setq cols (+ cols 3))) + (t (vm-insert-char char 1 nil work-buffer) + (vm-increment cols))) + (cond ((> cols 70) + (vm-insert-char ?= 1 nil work-buffer) + (vm-insert-char ?\n 1 nil work-buffer) + (setq cols 0))) + (vm-increment inputpos)) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (vm-unsaved-message "Encoding quoted-printable... done")) + +(defun vm-decode-mime-message-headers (m) + (let ((case-fold-search t) + (buffer-read-only nil) + charset encoding match-start match-end start end) + (save-excursion + (goto-char (vm-headers-of m)) + (while (re-search-forward vm-mime-encoded-word-regexp (vm-text-of m) t) + (setq match-start (match-beginning 0) + match-end (match-end 0) + charset (match-string 1) + encoding (match-string 2) + start (match-beginning 3) + end (vm-marker (match-end 3))) + ;; don't change anything if we can't display the + ;; character set properly. + (if (not (vm-mime-charset-internally-displayable-p charset)) + nil + (delete-region end match-end) + (cond ((string-match "B" encoding) + (vm-mime-B-decode-region start end)) + ((string-match "Q" encoding) + (vm-mime-Q-decode-region start end)) + (t (vm-mime-error "unknown encoded word encoding, %s" + encoding))) + (vm-mime-charset-decode-region charset start end) + (delete-region match-start start)))))) + +(defun vm-decode-mime-encoded-words () + (let ((case-fold-search t) + (buffer-read-only nil) + charset encoding match-start match-end start end) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward vm-mime-encoded-word-regexp nil t) + (setq match-start (match-beginning 0) + match-end (match-end 0) + charset (match-string 1) + encoding (match-string 2) + start (match-beginning 3) + end (vm-marker (match-end 3))) + ;; don't change anything if we can't display the + ;; character set properly. + (if (not (vm-mime-charset-internally-displayable-p charset)) + nil + (delete-region end match-end) + (cond ((string-match "B" encoding) + (vm-mime-B-decode-region start end)) + ((string-match "Q" encoding) + (vm-mime-Q-decode-region start end)) + (t (vm-mime-error "unknown encoded word encoding, %s" + encoding))) + (vm-mime-charset-decode-region charset start end) + (delete-region match-start start)))))) + +(defun vm-decode-mime-encoded-words-maybe (string) + (if (and vm-display-using-mime + (string-match vm-mime-encoded-word-regexp string)) + (vm-with-string-as-temp-buffer string 'vm-decode-mime-encoded-words) + string )) + +(defun vm-mime-parse-content-header (string &optional sepchar) + (if (null string) + () + (let ((work-buffer nil)) + (save-excursion + (unwind-protect + (let ((list nil) + (nonspecials "^\"\\( \t\n\r\f") + start s char sp+sepchar) + (if sepchar + (setq nonspecials (concat nonspecials (list sepchar)) + sp+sepchar (concat "\t\f\n\r " (list sepchar)))) + (setq work-buffer (generate-new-buffer "*vm-work*")) + (buffer-disable-undo work-buffer) + (set-buffer work-buffer) + (insert string) + (goto-char (point-min)) + (skip-chars-forward "\t\f\n\r ") + (setq start (point)) + (while (not (eobp)) + (skip-chars-forward nonspecials) + (setq char (following-char)) + (cond ((looking-at "[ \t\n\r\f]") + (delete-char 1)) + ((= char ?\\) + (forward-char 1) + (if (not (eobp)) + (forward-char 1))) + ((and sepchar (= char sepchar)) + (setq s (buffer-substring start (point))) + (if (or (null (string-match "^[\t\f\n\r ]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (skip-chars-forward sp+sepchar) + (setq start (point))) + ((looking-at " \t\n\r\f") + (skip-chars-forward " \t\n\r\f")) + ((= char ?\") + (delete-char 1) + (cond ((= (char-after (point)) ?\") + (delete-char 1)) + ((re-search-forward "[^\\]\"" nil 0) + (delete-char -1)))) + ((= char ?\() + (let ((parens 1) + (pos (point))) + (forward-char 1) + (while (and (not (eobp)) (not (zerop parens))) + (re-search-forward "[()]" nil 0) + (cond ((or (eobp) + (= (char-after (- (point) 2)) ?\\))) + ((= (preceding-char) ?\() + (setq parens (1+ parens))) + (t + (setq parens (1- parens))))) + (delete-region pos (point)))))) + (setq s (buffer-substring start (point))) + (if (and (null (string-match "^[\t\f\n\r ]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (nreverse list)) + (and work-buffer (kill-buffer work-buffer))))))) + +(defun vm-mime-get-header-contents (header-name-regexp) + (let ((contents nil) + regexp) + (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^$\\)")) + (save-excursion + (let ((case-fold-search t)) + (if (and (re-search-forward regexp nil t) + (match-beginning 1) + (progn (goto-char (match-beginning 0)) + (vm-match-header))) + (vm-matched-header-contents) + nil ))))) + +(defun vm-mime-parse-entity (&optional m default-type default-encoding) + (let ((case-fold-search t) version type encoding id description + disposition boundary boundary-regexp start + multipart-list c-t c-t-e done p returnval) + (and m (vm-unsaved-message "Parsing MIME message...")) + (prog1 + (catch 'return-value + (save-excursion + (if m + (progn + (setq m (vm-real-message-of m)) + (set-buffer (vm-buffer-of m)))) + (save-excursion + (save-restriction + (if m + (progn + (setq version (vm-get-header-contents m "MIME-Version:") + version (car (vm-mime-parse-content-header version)) + type (vm-get-header-contents m "Content-Type:") + type (vm-mime-parse-content-header type ?\;) + encoding (or (vm-get-header-contents + m "Content-Transfer-Encoding:") + "7bit") + encoding (car (vm-mime-parse-content-header encoding)) + id (vm-get-header-contents m "Content-ID:") + id (car (vm-mime-parse-content-header id)) + description (vm-get-header-contents + m "Content-Description:") + description (and description + (if (string-match "^[ \t\n]$" + description) + nil + description)) + disposition (vm-get-header-contents + m "Content-Disposition:") + disposition (and disposition + (vm-mime-parse-content-header + disposition ?\;))) + (widen) + (narrow-to-region (vm-headers-of m) (vm-text-end-of m))) + (goto-char (point-min)) + (setq type (vm-mime-get-header-contents "Content-Type:") + type (or (vm-mime-parse-content-header type ?\;) + default-type) + encoding (or (vm-mime-get-header-contents + "Content-Transfer-Encoding:") + default-encoding) + encoding (car (vm-mime-parse-content-header encoding)) + id (vm-mime-get-header-contents "Content-ID:") + id (car (vm-mime-parse-content-header id)) + description (vm-mime-get-header-contents + "Content-Description:") + description (and description (if (string-match "^[ \t\n]+$" + description) + nil + description)) + disposition (vm-mime-get-header-contents + "Content-Disposition:") + disposition (and disposition + (vm-mime-parse-content-header + disposition ?\;)))) + (cond ((null m) t) + ((null version) + (throw 'return-value 'none)) + ((string= version "1.0") t) + (t (vm-mime-error "Unsupported MIME version: %s" version))) + (cond ((and m (null type)) + (throw 'return-value + (vector '("text/plain" "charset=us-ascii") + encoding id description disposition + (vm-headers-of m) + (vm-text-of m) + (vm-text-end-of m) + nil nil nil ))) + ((null type) + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (vector default-type encoding id description disposition + (vm-marker (point-min)) + (vm-marker (point)) + (vm-marker (point-max)) + nil nil nil )) + ((null (string-match "[^/ ]+/[^/ ]+" (car type))) + (vm-mime-error "Malformed MIME content type: %s" (car type))) + ((and (string-match "^multipart/\\|^message/" (car type)) + (null (string-match "^\\(7bit\\|8bit\\|binary\\)$" + encoding))) + (vm-mime-error "Opaque transfer encoding used with multipart or message type: %s, %s" (car type) encoding)) + ((and (string-match "^message/partial$" (car type)) + (null (string-match "^7bit$" encoding))) + (vm-mime-error "Non-7BIT transfer encoding used with message/partial message: %s" encoding)) + ((string-match "^multipart/digest" (car type)) + (setq c-t '("message/rfc822") + c-t-e "7bit")) + ((string-match "^multipart/" (car type)) + (setq c-t '("text/plain" "charset=us-ascii") + c-t-e "7bit")) ; below + ((string-match "^message/rfc822" (car type)) + (setq c-t '("text/plain" "charset=us-ascii") + c-t-e "7bit") + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (throw 'return-value + (vector type encoding id description disposition + (vm-marker (point-min)) + (vm-marker (point)) + (vm-marker (point-max)) + (list + (save-restriction + (narrow-to-region (point) (point-max)) + (vm-mime-parse-entity nil c-t c-t-e))) + nil ))) + (t + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (throw 'return-value + (vector type encoding id description disposition + (vm-marker (point-min)) + (vm-marker (point)) + (vm-marker (point-max)) + nil nil )))) + (setq p (cdr type) + boundary nil) + (while p + (if (string-match "^boundary=" (car p)) + (setq boundary (car (vm-parse (car p) "=\\(.+\\)")) + p nil) + (setq p (cdr p)))) + (or boundary + (vm-mime-error + "Boundary parameter missing in %s type specification" + (car type))) + (setq boundary-regexp (regexp-quote boundary) + boundary-regexp (concat "^--" boundary-regexp "\\(--\\)?\n")) + (goto-char (point-min)) + (setq start nil + multipart-list nil + done nil) + (while (and (not done) (re-search-forward boundary-regexp nil t)) + (cond ((null start) + (setq start (match-end 0))) + (t + (and (match-beginning 1) + (setq done t)) + (save-excursion + (save-restriction + (narrow-to-region start (1- (match-beginning 0))) + (setq start (match-end 0)) + (setq multipart-list + (cons (vm-mime-parse-entity-safe nil c-t c-t-e) + multipart-list))))))) + (if (not done) + (vm-mime-error "final %s boundary missing" boundary)) + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (vector type encoding id description disposition + (vm-marker (point-min)) + (vm-marker (point)) + (vm-marker (point-max)) + (nreverse multipart-list) + nil ))))) + (and m (vm-unsaved-message "Parsing MIME message... done")) + ))) + +(defun vm-mime-parse-entity-safe (&optional m c-t c-t-e) + (or c-t (setq c-t '("text/plain" "charset=us-ascii"))) + ;; don't let subpart parse errors make the whole parse fail. use default + ;; type if the parse fails. + (condition-case error-data + (vm-mime-parse-entity nil c-t c-t-e) + (vm-mime-error + (let ((header (if m + (vm-headers-of m) + (vm-marker (point-min)))) + (text (if m + (vm-text-of m) + (save-excursion + (re-search-forward "^\n\\|\n\\'" + nil 0) + (vm-marker (point))))) + (text-end (if m + (vm-text-end-of m) + (vm-marker (point-max))))) + (vector c-t + (vm-determine-proper-content-transfer-encoding text text-end) + nil + ;; cram the error message into the description slot + (car error-data) + ;; mark as an attachment to improve the chance that the user + ;; will see the description. + '("attachment") + header + text + text-end))))) + +(defun vm-mime-get-xxx-parameter (layout name param-list) + (let ((match-end (1+ (length name))) + (name-regexp (concat (regexp-quote name) "=")) + (case-fold-search t) + (done nil)) + (while (and param-list (not done)) + (if (and (string-match name-regexp (car param-list)) + (= (match-end 0) match-end)) + (setq done t) + (setq param-list (cdr param-list)))) + (and (car param-list) (car (vm-parse (car param-list) "=\\(.*\\)"))))) + +(defun vm-mime-get-parameter (layout name) + (vm-mime-get-xxx-parameter layout name (cdr (vm-mm-layout-type layout)))) + +(defun vm-mime-get-disposition-parameter (layout name) + (vm-mime-get-xxx-parameter layout name + (cdr (vm-mm-layout-disposition layout)))) + +(defun vm-mime-insert-mime-body (layout) + (vm-insert-region-from-buffer (marker-buffer (vm-mm-layout-body-start layout)) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout))) + +(defun vm-mime-insert-mime-headers (layout) + (vm-insert-region-from-buffer (marker-buffer (vm-mm-layout-body-start layout)) + (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout)) + (if (and (not (bobp)) (char-equal (char-after (1- (point))) ?\n)) + (delete-char -1))) + +(defun vm-make-presentation-copy (m) + (let ((mail-buffer (current-buffer)) + b mm + (real-m (vm-real-message-of m)) + (modified (buffer-modified-p))) + (cond ((or (null vm-presentation-buffer-handle) + (null (buffer-name vm-presentation-buffer-handle))) + (setq b (generate-new-buffer (concat (buffer-name) + " Presentation"))) + (save-excursion + (set-buffer b) + (if (fboundp 'buffer-disable-undo) + (buffer-disable-undo (current-buffer)) + ;; obfuscation to make the v19 compiler not whine + ;; about obsolete functions. + (let ((x 'buffer-flush-undo)) + (funcall x (current-buffer)))) + (setq mode-name "VM Presentation" + major-mode 'vm-presentation-mode + vm-message-pointer (list nil) + vm-mail-buffer mail-buffer + mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3 + (vm-menu-support-possible-p) + (vm-menu-mode-menu)) + buffer-read-only t + mode-line-format vm-mode-line-format) + (cond ((vm-fsfemacs-19-p) + ;; need to do this outside the let because + ;; loading disp-table initializes + ;; standard-display-table. + (require 'disp-table) + (let* ((standard-display-table + (copy-sequence standard-display-table))) + (standard-display-european t) + (setq buffer-display-table standard-display-table)))) + (if vm-frame-per-folder + (vm-set-hooks-for-frame-deletion)) + (use-local-map vm-mode-map) + (and (vm-toolbar-support-possible-p) vm-use-toolbar + (vm-toolbar-install-toolbar)) + (and (vm-menu-support-possible-p) + (vm-menu-install-menus))) + (setq vm-presentation-buffer-handle b))) + ;; do this (widen) outside save-restricton intentionally. since + ;; we're using the presentation buffer, make the folder + ;; buffer unpretty so maybe the user gets the idea. + ;;(widen) + ;; widening isn't enough. users just complain that "I'm + ;; looking at the wrong message." Curse their miserable hides. + ;; bury the buffer so they'll have a tough time finding it. + (bury-buffer (current-buffer)) + (setq b vm-presentation-buffer-handle + vm-presentation-buffer vm-presentation-buffer-handle + vm-mime-decoded nil) + (save-excursion + (set-buffer (vm-buffer-of real-m)) + (save-restriction + (widen) + ;; must reference this now so that headers will be in + ;; their final position before the message is copied. + ;; otherwise the vheader offset computed below will be + ;; wrong. + (vm-vheaders-of real-m) + (set-buffer b) + (widen) + (let ((buffer-read-only nil) + (modified (buffer-modified-p))) + (unwind-protect + (progn + (erase-buffer) + (insert-buffer-substring (vm-buffer-of real-m) + (vm-start-of real-m) + (vm-end-of real-m))) + (set-buffer-modified-p modified))) + (setq mm (copy-sequence m)) + (vm-set-location-data-of mm (vm-copy (vm-location-data-of m))) + (set-marker (vm-start-of mm) (point-min)) + (set-marker (vm-headers-of mm) (+ (vm-start-of mm) + (- (vm-headers-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-vheaders-of mm) (+ (vm-start-of mm) + (- (vm-vheaders-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-text-of mm) (+ (vm-start-of mm) + (- (vm-text-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-text-end-of mm) (+ (vm-start-of mm) + (- (vm-text-end-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-end-of mm) (+ (vm-start-of mm) + (- (vm-end-of real-m) + (vm-start-of real-m)))) + (setcar vm-message-pointer mm))))) + +(fset 'vm-presentation-mode 'vm-mode) +(put 'vm-presentation-mode 'mode-class 'special) + +(defun vm-determine-proper-charset (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (catch 'done + (goto-char (point-min)) + (and (re-search-forward "[^\000-\177]" nil t) + (throw 'done (or vm-mime-8bit-composition-charset "iso-8859-1"))) + (throw 'done "us-ascii"))))) + +(defun vm-determine-proper-content-transfer-encoding (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (catch 'done + (goto-char (point-min)) + (and (re-search-forward "[\000\015]" nil t) + (throw 'done "binary")) + + (let ((toolong nil) bol) + (goto-char (point-min)) + (setq bol (point)) + (while (and (not (eobp)) (not toolong)) + (forward-line) + (setq toolong (> (- (point) bol) 998) + bol (point))) + (and toolong (throw 'done "binary"))) + + (goto-char (point-min)) + (and (re-search-forward "[\200-\377]" nil t) + (throw 'done "8bit")) + + "7bit")))) + +(defun vm-mime-types-match (type type/subtype) + (let ((case-fold-search t)) + (cond ((string-match "/" type) + (if (and (string-match (regexp-quote type) type/subtype) + (equal 0 (match-beginning 0)) + (equal (length type/subtype) (match-end 0))) + t + nil )) + ((and (string-match (regexp-quote type) type/subtype) + (equal 0 (match-beginning 0)) + (equal (save-match-data + (string-match "/" type/subtype (match-end 0))) + (match-end 0))))))) + +(defvar native-sound-only-on-console) + +(defun vm-mime-can-display-internal (layout) + (let ((type (car (vm-mm-layout-type layout)))) + (cond ((vm-mime-types-match "image/jpeg" type) + (and (vm-xemacs-p) + (featurep 'jpeg) + (eq (device-type) 'x))) + ((vm-mime-types-match "image/gif" type) + (and (vm-xemacs-p) + (featurep 'gif) + (eq (device-type) 'x))) + ((vm-mime-types-match "image/png" type) + (and (vm-xemacs-p) + (featurep 'png) + (eq (device-type) 'x))) + ((vm-mime-types-match "image/tiff" type) + (and (vm-xemacs-p) + (featurep 'tiff) + (eq (device-type) 'x))) + ((vm-mime-types-match "audio/basic" type) + (and (vm-xemacs-p) + (or (featurep 'native-sound) + (featurep 'nas-sound)) + (or (device-sound-enabled-p) + (and (featurep 'native-sound) + (not native-sound-only-on-console) + (eq (device-type) 'x))))) + ((vm-mime-types-match "multipart" type) t) + ((vm-mime-types-match "message/external-body" type) nil) + ((vm-mime-types-match "message" type) t) + ((or (vm-mime-types-match "text/plain" type) + (vm-mime-types-match "text/enriched" type)) + (let ((charset (or (vm-mime-get-parameter layout "charset") + "us-ascii"))) + (vm-mime-charset-internally-displayable-p charset))) + ((vm-mime-types-match "text/html" type) + (condition-case () + (progn (require 'w3) + (fboundp 'w3-region)) + (error nil))) + (t nil)))) + +(defun vm-mime-can-convert (type) + (let ((alist vm-mime-type-converter-alist) + ;; fake layout. make it the wrong length so an error will + ;; be signaled if vm-mime-can-display-internal ever asks + ;; for one of the other fields + (fake-layout (make-vector 1 (list nil))) + (done nil)) + (while (and alist (not done)) + (cond ((and (vm-mime-types-match (car (car alist)) type) + (or (progn + (setcar (aref fake-layout 0) (nth 1 (car alist))) + (vm-mime-can-display-internal fake-layout)) + (vm-mime-find-external-viewer (nth 1 (car alist))))) + (setq done t)) + (t (setq alist (cdr alist))))) + (and alist (car alist)))) + +(defun vm-mime-convert-undisplayable-layout (layout) + (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout))))) + (vm-unsaved-message "Converting %s to %s..." + (car (vm-mm-layout-type layout)) + (nth 1 ooo)) + (save-excursion + (set-buffer (generate-new-buffer " *mime object*")) + (setq vm-message-garbage-alist + (cons (cons (current-buffer) 'kill-buffer) + vm-message-garbage-alist)) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (call-process-region (point-min) (point-max) shell-file-name + t t nil shell-command-switch (nth 2 ooo)) + (goto-char (point-min)) + (insert "Content-Type: " (nth 1 ooo) "\n") + (insert "Content-Transfer-Encoding: binary\n\n") + (set-buffer-modified-p nil) + (vm-unsaved-message "Converting %s to %s... done" + (car (vm-mm-layout-type layout)) + (nth 1 ooo)) + (vector (list (nth 1 ooo)) + "binary" + (vm-mm-layout-id layout) + (vm-mm-layout-description layout) + (vm-mm-layout-disposition layout) + (vm-marker (point-min)) + (vm-marker (point)) + (vm-marker (point-max)) + nil + nil )))) + +(defun vm-mime-should-display-button (layout dont-honor-content-disposition) + (if (and vm-honor-mime-content-disposition + (not dont-honor-content-disposition) + (vm-mm-layout-disposition layout)) + (let ((case-fold-search t)) + (string-match "^attachment$" (car (vm-mm-layout-disposition layout)))) + (let ((i-list vm-auto-displayed-mime-content-types) + (type (car (vm-mm-layout-type layout))) + (matched nil)) + (if (eq i-list t) + nil + (while (and i-list (not matched)) + (if (vm-mime-types-match (car i-list) type) + (setq matched t) + (setq i-list (cdr i-list)))) + (not matched) )))) + +(defun vm-mime-should-display-internal (layout dont-honor-content-disposition) + (if (and vm-honor-mime-content-disposition + (not dont-honor-content-disposition) + (vm-mm-layout-disposition layout)) + (let ((case-fold-search t)) + (string-match "^inline$" (car (vm-mm-layout-disposition layout)))) + (let ((i-list vm-mime-internal-content-types) + (type (car (vm-mm-layout-type layout))) + (matched nil)) + (if (eq i-list t) + t + (while (and i-list (not matched)) + (if (vm-mime-types-match (car i-list) type) + (setq matched t) + (setq i-list (cdr i-list)))) + matched )))) + +(defun vm-mime-find-external-viewer (type) + (let ((e-alist vm-mime-external-content-types-alist) + (matched nil)) + (while (and e-alist (not matched)) + (if (and (vm-mime-types-match (car (car e-alist)) type) + (cdr (car e-alist))) + (setq matched (cdr (car e-alist))) + (setq e-alist (cdr e-alist)))) + matched )) +(fset 'vm-mime-should-display-external 'vm-mime-find-external-viewer) + +(defun vm-mime-delete-button-maybe (extent) + (let ((buffer-read-only)) + ;; if displayed MIME object should replace the button + ;; remove the button now. + (cond ((vm-extent-property extent 'vm-mime-disposable) + (delete-region (vm-extent-start-position extent) + (vm-extent-end-position extent)) + (vm-detach-extent extent))))) + +(defun vm-decode-mime-message () + "Decode the MIME objects in the current message. + +The first time this command is run on a message, decoding is done. +The second time, buttons for all the objects are displayed instead. +The third time, the raw, undecoded data is displayed. + +If decoding, the decoded objects might be displayed immediately, or +buttons might be displayed that you need to activate to view the +object. See the documentation for the variables + + vm-auto-displayed-mime-content-types + vm-mime-internal-content-types + vm-mime-external-content-types-alist + +to see how to control whether you see buttons or objects. + +If the variable vm-mime-display-function is set, then its value +is called as a function with no arguments, and none of the +actions mentioned in the preceding paragraphs are done. At the +time of the call, the current buffer will be the presentation +buffer for the folder and a copy of the current message will be +in the buffer. The function is expected to make the message +`MIME presentable' to the user in whatever manner it sees fit." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) + (vm-error-if-folder-empty) + (if (and (not vm-display-using-mime) + (null vm-mime-display-function)) + (error "MIME display disabled, set vm-display-using-mime non-nil to enable.")) + (if vm-mime-display-function + (progn + (vm-make-presentation-copy (car vm-message-pointer)) + (set-buffer vm-presentation-buffer) + (funcall vm-mime-display-function)) + (if vm-mime-decoded + (if (eq vm-mime-decoded 'decoded) + (let ((vm-preview-read-messages nil) + (vm-auto-decode-mime-messages t) + (vm-honor-mime-content-disposition nil) + (vm-auto-displayed-mime-content-types '("multipart"))) + (setq vm-mime-decoded nil) + (intern (buffer-name) vm-buffers-needing-display-update) + (save-excursion + (vm-preview-current-message)) + (setq vm-mime-decoded 'buttons)) + (let ((vm-preview-read-messages nil) + (vm-auto-decode-mime-messages nil)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-preview-current-message))) + (let ((layout (vm-mm-layout (car vm-message-pointer))) + (m (car vm-message-pointer))) + (vm-unsaved-message "Decoding MIME message...") + (cond ((stringp layout) + (error "Invalid MIME message: %s" layout))) + (if (vm-mime-plain-message-p m) + (error "Message needs no decoding.")) + (or vm-presentation-buffer + ;; maybe user killed it + (error "No presentation buffer.")) + (set-buffer vm-presentation-buffer) + (setq m (car vm-message-pointer)) + (vm-save-restriction + (widen) + (goto-char (vm-text-of m)) + (let ((buffer-read-only nil) + (modified (buffer-modified-p))) + (unwind-protect + (save-excursion + (and (not (eq (vm-mm-encoded-header m) 'none)) + (vm-decode-mime-message-headers m)) + (if (vectorp layout) + (progn + (vm-decode-mime-layout layout) + (delete-region (point) (point-max))))) + (set-buffer-modified-p modified)))) + (save-excursion (set-buffer vm-mail-buffer) + (setq vm-mime-decoded 'decoded)) + (intern (buffer-name vm-mail-buffer) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (vm-unsaved-message "Decoding MIME message... done")))) + (vm-display nil nil '(vm-decode-mime-message) + '(vm-decode-mime-message reading-message))) + +(defun vm-decode-mime-layout (layout &optional dont-honor-c-d) + (let ((modified (buffer-modified-p)) type type-no-subtype (extent nil)) + (unwind-protect + (progn + (if (not (vectorp layout)) + (progn + (setq extent layout + layout (vm-extent-property extent 'vm-mime-layout)) + (goto-char (vm-extent-start-position extent)))) + (setq type (downcase (car (vm-mm-layout-type layout))) + type-no-subtype (car (vm-parse type "\\([^/]+\\)"))) + (cond ((and (vm-mime-should-display-button layout dont-honor-c-d) + (or (condition-case nil + (funcall (intern + (concat "vm-mime-display-button-" + type)) + layout) + (void-function nil)) + (condition-case nil + (funcall (intern + (concat "vm-mime-display-button-" + type-no-subtype)) + layout) + (void-function nil))))) + ((and (vm-mime-should-display-internal layout dont-honor-c-d) + (condition-case nil + (funcall (intern + (concat "vm-mime-display-internal-" + type)) + layout) + (void-function nil)))) + ((vm-mime-types-match "multipart" type) + (or (condition-case nil + (funcall (intern + (concat "vm-mime-display-internal-" + type)) + layout) + (void-function nil)) + (vm-mime-display-internal-multipart/mixed layout))) + ((and (vm-mime-should-display-external type) + (vm-mime-display-external-generic layout)) + (and extent (vm-set-extent-property + extent 'vm-mime-disposable nil))) + ((vm-mime-can-convert type) + (vm-decode-mime-layout + (vm-mime-convert-undisplayable-layout layout))) + ((and (or (vm-mime-types-match "message" type) + (vm-mime-types-match "text" type)) + ;; display unmatched message and text types as + ;; text/plain. + (vm-mime-display-internal-text/plain layout))) + (t (vm-mime-display-internal-application/octet-stream + (or extent layout)))) + (and extent (vm-mime-delete-button-maybe extent))) + (set-buffer-modified-p modified))) + t ) + +(defun vm-mime-display-button-text (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-internal-text/html (layout) + (let ((buffer-read-only nil) + (work-buffer nil)) + (vm-unsaved-message "Inlining text/html, be patient...") + ;; w3-region is not as tame as we would like. + ;; make sure the yoke is firmly attached. + (unwind-protect + (progn + (save-excursion + (set-buffer (setq work-buffer + (generate-new-buffer " *workbuf*"))) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (save-excursion + (save-window-excursion + (w3-region (point-min) (point-max))))) + (insert-buffer-substring work-buffer)) + (and work-buffer (kill-buffer work-buffer))) + (vm-unsaved-message "Inlining text/html... done") + t )) + +(defun vm-mime-display-internal-text/plain (layout &optional ignore-urls) + (let ((start (point)) end + (buffer-read-only nil) + (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) + (if (not (vm-mime-charset-internally-displayable-p charset)) + nil + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (vm-mime-charset-decode-region charset start end) + (or ignore-urls (vm-energize-urls-in-message-region start end)) + t ))) + +(defun vm-mime-display-internal-text/enriched (layout) + (require 'enriched) + (let ((start (point)) end + (buffer-read-only nil) + (enriched-verbose t)) + (vm-unsaved-message "Decoding text/enriched, be patient...") + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + ;; enriched-decode expects a couple of headers at the top of + ;; the region and will remove anything that looks like a + ;; header. Put a header section here for it to eat so it + ;; won't eat message text instead. + (goto-char start) + (insert "Comment: You should not see this header\n\n") + (enriched-decode start end) + (vm-energize-urls-in-message-region start end) + (goto-char end) + (vm-unsaved-message "Decoding text/enriched... done") + t )) + +(defun vm-mime-display-external-generic (layout) + (let ((program-list (vm-mime-find-external-viewer + (car (vm-mm-layout-type layout)))) + (process (nth 0 (vm-mm-layout-cache layout))) + (tempfile (nth 1 (vm-mm-layout-cache layout))) + (buffer-read-only nil) + (start (point)) + end) + (if (and (processp process) (eq (process-status process) 'run)) + nil + (cond ((or (null tempfile) (null (file-exists-p tempfile))) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile-name)) + ;; Tell DOS/Windows NT whether the file is binary + (setq buffer-file-type (not (vm-mime-text-type-p layout))) + (write-region start end tempfile nil 0) + (delete-region start end) + (save-excursion + (vm-select-folder-buffer) + (setq vm-folder-garbage-alist + (cons (cons tempfile 'delete-file) + vm-folder-garbage-alist))))) + (vm-unsaved-message "Launching %s..." (mapconcat 'identity + program-list + " ")) + (setq process + (apply 'start-process + (format "view %25s" (vm-mime-layout-description layout)) + nil (append program-list (list tempfile)))) + (process-kill-without-query process t) + (vm-unsaved-message "Launching %s... done" (mapconcat 'identity + program-list + " ")) + (save-excursion + (vm-select-folder-buffer) + (setq vm-message-garbage-alist + (cons (cons process 'delete-process) + vm-message-garbage-alist))) + (vm-set-mm-layout-cache layout (list process tempfile)))) + t ) + +(defun vm-mime-display-internal-application/octet-stream (layout) + (if (vectorp layout) + (let ((buffer-read-only nil) + (description (vm-mm-layout-description layout))) + (vm-mime-insert-button + (format "%-35s [%s to save to a file]" + (vm-mime-layout-description layout) + (if (vm-mouse-support-possible-p) + "Click mouse-2" + "Press RETURN")) + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-application/octet-stream layout)))) + layout nil)) + (goto-char (vm-extent-start-position layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout)) + ;; support old "name" paramater for application/octet-stream + ;; but don't override the "filename" parameter extracted from + ;; Content-Disposition, if any. + (let ((default-filename + (if (vm-mime-get-disposition-parameter layout "filename") + nil + (vm-mime-get-parameter layout "name")))) + (vm-mime-send-body-to-file layout default-filename))) + t ) +(fset 'vm-mime-display-button-application + 'vm-mime-display-internal-application/octet-stream) + +(defun vm-mime-display-button-image (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-button-audio (layout) + (vm-mime-display-button-xxxx layout nil)) + +(defun vm-mime-display-button-video (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-button-message (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-button-multipart (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-internal-multipart/mixed (layout) + (let ((part-list (vm-mm-layout-parts layout))) + (while part-list + (vm-decode-mime-layout (car part-list)) + (setq part-list (cdr part-list))) + t )) + +(defun vm-mime-display-internal-multipart/alternative (layout) + (let (best-layout) + (cond ((eq vm-mime-alternative-select-method 'best) + (let ((done nil) + (best nil) + part-list type) + (setq part-list (vm-mm-layout-parts layout) + part-list (nreverse (copy-sequence part-list))) + (while (and part-list (not done)) + (setq type (car (vm-mm-layout-type (car part-list)))) + (if (or (vm-mime-can-display-internal (car part-list)) + (vm-mime-find-external-viewer type)) + (setq best (car part-list) + done t) + (setq part-list (cdr part-list)))) + (setq best-layout (or best (car (vm-mm-layout-parts layout)))))) + ((eq vm-mime-alternative-select-method 'best-internal) + (let ((done nil) + (best nil) + (second-best nil) + part-list type) + (setq part-list (vm-mm-layout-parts layout) + part-list (nreverse (copy-sequence part-list))) + (while (and part-list (not done)) + (setq type (car (vm-mm-layout-type (car part-list)))) + (cond ((vm-mime-can-display-internal (car part-list)) + (setq best (car part-list) + done t)) + ((and (null second-best) + (vm-mime-find-external-viewer type)) + (setq second-best (car part-list)))) + (setq part-list (cdr part-list))) + (setq best-layout (or best second-best + (car (vm-mm-layout-parts layout))))))) + (vm-decode-mime-layout best-layout))) + +(defun vm-mime-display-button-multipart/parallel (layout) + (vm-mime-insert-button + (format "%-35s [%s to display in parallel]" + (vm-mime-layout-description layout) + (if (vm-mouse-support-possible-p) + "Click mouse-2" + "Press RETURN")) + (function + (lambda (layout) + (save-excursion + (let ((vm-auto-displayed-mime-content-types t)) + (vm-decode-mime-layout layout t))))) + layout t)) + +(fset 'vm-mime-display-internal-multipart/parallel + 'vm-mime-display-internal-multipart/mixed) + +(defun vm-mime-display-internal-multipart/digest (layout) + (if (vectorp layout) + (let ((buffer-read-only nil)) + (vm-mime-insert-button + (format "%-35s [%s to display]" + (vm-mime-layout-description layout) + (if (vm-mouse-support-possible-p) + "Click mouse-2" + "Press RETURN")) + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-multipart/digest layout)))) + layout nil)) + (goto-char (vm-extent-start-position layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout)) + (set-buffer (generate-new-buffer (format "digest from %s/%s" + (buffer-name vm-mail-buffer) + (vm-number-of + (car vm-message-pointer))))) + (setq vm-folder-type vm-default-folder-type) + (vm-mime-burst-layout layout nil) + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode)) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display nil nil (list this-command) '(vm-mode startup))) + t ) +(fset 'vm-mime-display-button-multipart/digest + 'vm-mime-display-internal-multipart/digest) + +(defun vm-mime-display-internal-message/rfc822 (layout) + (if (vectorp layout) + (let ((buffer-read-only nil)) + (vm-mime-insert-button + (format "%-35s [%s to display]" + (vm-mime-layout-description layout) + (if (vm-mouse-support-possible-p) + "Click mouse-2" + "Press RETURN")) + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-message/rfc822 layout)))) + layout nil)) + (goto-char (vm-extent-start-position layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout)) + (set-buffer (generate-new-buffer + (format "message from %s/%s" + (buffer-name vm-mail-buffer) + (vm-number-of + (car vm-message-pointer))))) + (setq vm-folder-type vm-default-folder-type) + (vm-mime-burst-layout layout nil) + (set-buffer-modified-p nil) + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode)) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + t ) +(fset 'vm-mime-display-button-message/rfc822 + 'vm-mime-display-internal-message/rfc822) + +(defun vm-mime-display-internal-message/partial (layout) + (if (vectorp layout) + (let ((buffer-read-only nil) + (number (vm-mime-get-parameter layout "number")) + (total (vm-mime-get-parameter layout "total"))) + (vm-mime-insert-button + (format "%-35s [%s to attempt assembly]" + (concat (vm-mime-layout-description layout) + (and number (concat ", part " number)) + (and number total (concat " of " total))) + (if (vm-mouse-support-possible-p) + "Click mouse-2" + "Press RETURN")) + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-message/partial layout)))) + layout nil)) + (vm-unsaved-message "Assembling message...") + (let ((parts nil) + (missing nil) + (work-buffer nil) + extent id o number total m i prev part-header-pos + p-id p-number p-total p-list) + (setq extent layout + layout (vm-extent-property extent 'vm-mime-layout) + id (vm-mime-get-parameter layout "id")) + (if (null id) + (vm-mime-error + "message/partial message missing id parameter")) + (save-excursion + (set-buffer (marker-buffer (vm-mm-layout-body-start layout))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (and (search-forward id nil t) + (setq m (vm-message-at-point))) + (setq o (vm-mm-layout m)) + (if (not (vectorp o)) + nil + (setq p-list (vm-mime-find-message/partials o id)) + (while p-list + (setq p-id (vm-mime-get-parameter (car p-list) "id")) + (setq p-total (vm-mime-get-parameter (car p-list) "total")) + (if (null p-total) + nil + (setq p-total (string-to-int p-total)) + (if (< p-total 1) + (vm-mime-error "message/partial specified part total < 0, %d" p-total)) + (if total + (if (not (= total p-total)) + (vm-mime-error "message/partial speificed total differs between parts, (%d != %d)" p-total total)) + (setq total p-total))) + (setq p-number (vm-mime-get-parameter (car p-list) "number")) + (if (null p-number) + (vm-mime-error + "message/partial message missing number parameter")) + (setq p-number (string-to-int p-number)) + (if (< p-number 1) + (vm-mime-error "message/partial part number < 0, %d" + p-number)) + (if (and total (> p-number total)) + (vm-mime-error "message/partial part number greater than expected number of parts, (%d > %d)" p-number total)) + (setq parts (cons (list p-number (car p-list)) parts) + p-list (cdr p-list)))) + (goto-char (vm-mm-layout-body-end o)))))) + (if (null total) + (vm-mime-error "total number of parts not specified in any message/partial part")) + (setq parts (sort parts + (function + (lambda (p q) + (< (car p) + (car q)))))) + (setq i 0 + p-list parts) + (while p-list + (cond ((< i (car (car p-list))) + (vm-increment i) + (cond ((not (= i (car (car p-list)))) + (setq missing (cons i missing))) + (t (setq prev p-list + p-list (cdr p-list))))) + (t + ;; remove duplicate part + (setcdr prev (cdr p-list)) + (setq p-list (cdr p-list))))) + (while (< i total) + (vm-increment i) + (setq missing (cons i missing))) + (if missing + (vm-mime-error "part%s %s%s missing" + (if (cdr missing) "s" "") + (mapconcat + (function identity) + (nreverse (mapcar 'int-to-string + (or (cdr missing) missing))) + ", ") + (if (cdr missing) + (concat " and " (car missing)) + ""))) + (set-buffer (generate-new-buffer "assembled message")) + (setq vm-folder-type vm-default-folder-type) + (vm-mime-insert-mime-headers (car (cdr (car parts)))) + (goto-char (point-min)) + (vm-reorder-message-headers + nil nil +"\\(Encrypted\\|Content-\\|MIME-Version\\|Message-ID\\|Subject\\|X-VM-\\|Status\\)") + (goto-char (point-max)) + (setq part-header-pos (point)) + (while parts + (vm-mime-insert-mime-body (car (cdr (car parts)))) + (setq parts (cdr parts))) + (goto-char part-header-pos) + (vm-reorder-message-headers + nil '("Subject" "MIME-Version" "Content-" "Message-ID" "Encrypted") nil) + (vm-munge-message-separators vm-folder-type (point-min) (point-max)) + (goto-char (point-min)) + (insert (vm-leading-message-separator)) + (goto-char (point-max)) + (insert (vm-trailing-message-separator)) + (set-buffer-modified-p nil) + (vm-unsaved-message "Assembling message... done") + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode)) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + t )) +(fset 'vm-mime-display-button-message/partial + 'vm-mime-display-internal-message/partial) + +(defun vm-mime-display-internal-image-xxxx (layout feature name) + (if (and (vm-xemacs-p) + (featurep feature) + (eq (device-type) 'x)) + (let ((start (point)) end tempfile g e + (buffer-read-only nil)) + (if (vm-mm-layout-cache layout) + (setq g (vm-mm-layout-cache layout)) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile-name)) + (write-region start end tempfile nil 0) + (vm-unsaved-message "Creating %s glyph..." name) + (setq g (make-glyph + (list (vector feature ':file tempfile) + (vector 'string + ':data + (format "[Unknown %s image encoding]\n" + name))))) + (vm-unsaved-message "") + (vm-set-mm-layout-cache layout g) + (save-excursion + (vm-select-folder-buffer) + (setq vm-folder-garbage-alist + (cons (cons tempfile 'delete-file) + vm-folder-garbage-alist))) + (delete-region start end)) + (if (not (bolp)) + (insert-char ?\n 2) + (insert-char ?\n 1)) + (setq e (vm-make-extent (1- (point)) (point))) + (vm-set-extent-property e 'begin-glyph g) + t ))) + +(defun vm-mime-display-internal-image/gif (layout) + (vm-mime-display-internal-image-xxxx layout 'gif "GIF")) + +(defun vm-mime-display-internal-image/jpeg (layout) + (vm-mime-display-internal-image-xxxx layout 'jpeg "JPEG")) + +(defun vm-mime-display-internal-image/png (layout) + (vm-mime-display-internal-image-xxxx layout 'png "PNG")) + +(defun vm-mime-display-internal-image/tiff (layout) + (vm-mime-display-internal-image-xxxx layout 'tiff "TIFF")) + +(defun vm-mime-display-internal-audio/basic (layout) + (if (and (vm-xemacs-p) + (or (featurep 'native-sound) + (featurep 'nas-sound)) + (or (device-sound-enabled-p) + (and (featurep 'native-sound) + (not native-sound-only-on-console) + (eq (device-type) 'x)))) + (let ((start (point)) end tempfile + (buffer-read-only nil)) + (if (vm-mm-layout-cache layout) + (setq tempfile (vm-mm-layout-cache layout)) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile-name)) + (write-region start end tempfile nil 0) + (vm-set-mm-layout-cache layout tempfile) + (save-excursion + (vm-select-folder-buffer) + (setq vm-folder-garbage-alist + (cons (cons tempfile 'delete-file) + vm-folder-garbage-alist))) + (delete-region start end)) + (start-itimer "audioplayer" + (list 'lambda nil (list 'play-sound-file tempfile)) + 1) + t ) + nil )) + +(defun vm-mime-display-button-xxxx (layout disposable) + (let ((description (vm-mime-layout-description layout))) + (vm-mime-insert-button + (format "%-35s [%s to display]" + description + (if (vm-mouse-support-possible-p) "Click mouse-2" "Press RETURN")) + (function + (lambda (layout) + (save-excursion + (let ((vm-auto-displayed-mime-content-types t)) + (vm-decode-mime-layout layout t))))) + layout disposable) + t )) + +(defun vm-mime-run-display-function-at-point (&optional function) + (interactive) + ;; save excursion to keep point from moving. its motion would + ;; drag window point along, to a place arbitrarily far from + ;; where it was when the user triggered the button. + (save-excursion + (cond ((vm-fsfemacs-19-p) + (let (o-list o (found nil)) + (setq o-list (overlays-at (point))) + (while (and o-list (not found)) + (cond ((overlay-get (car o-list) 'vm-mime-layout) + (setq found t) + (funcall (or function (overlay-get (car o-list) + 'vm-mime-function)) + (car o-list)))) + (setq o-list (cdr o-list))))) + ((vm-xemacs-p) + (let ((e (extent-at (point) nil 'vm-mime-layout))) + (funcall (or function (extent-property e 'vm-mime-function)) + e)))))) + +;; for the karking compiler +(defvar vm-menu-mime-dispose-menu) + +(defun vm-mime-insert-button (caption action layout disposable) + (let ((start (point)) e + (keymap (make-sparse-keymap)) + (buffer-read-only nil)) + (if (fboundp 'set-keymap-parents) + (set-keymap-parents keymap (list (current-local-map))) + (setq keymap (nconc keymap (current-local-map)))) + (define-key keymap "\r" 'vm-mime-run-display-function-at-point) + (if (and (vm-mouse-xemacs-mouse-p) vm-popup-menu-on-mouse-3) + (define-key keymap 'button3 'vm-menu-popup-mime-dispose-menu)) + (if (not (bolp)) + (insert "\n")) + (insert caption "\n") + ;; we MUST have the five arg make-overlay. overlays must + ;; advance when text is inserted at their start position or + ;; inline text and graphics will seep into the button + ;; overlay and then be removed when the button is removed. + (if (fboundp 'make-overlay) + (setq e (make-overlay start (point) nil t nil)) + (setq e (make-extent start (point))) + (set-extent-property e 'start-open t) + (set-extent-property e 'end-open t)) + ;; for emacs + (vm-set-extent-property e 'mouse-face 'highlight) + (vm-set-extent-property e 'local-map keymap) + ;; for xemacs + (vm-set-extent-property e 'highlight t) + (vm-set-extent-property e 'keymap keymap) + (vm-set-extent-property e 'balloon-help 'vm-mouse-3-help) + ;; for all + (vm-set-extent-property e 'vm-mime-disposable disposable) + (vm-set-extent-property e 'face vm-mime-button-face) + (vm-set-extent-property e 'vm-mime-layout layout) + (vm-set-extent-property e 'vm-mime-function action))) + +(defun vm-mime-send-body-to-file (layout &optional default-filename) + (if (not (vectorp layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + (or default-filename + (setq default-filename + (vm-mime-get-disposition-parameter layout "filename"))) + (and default-filename + (setq default-filename (file-name-nondirectory default-filename))) + (let ((work-buffer nil) + ;; evade the XEmacs dialox box, yeccch. + (should-use-dialog-box nil) + file) + (setq file + (read-file-name + (if default-filename + (format "Write MIME body to file (default %s): " + default-filename) + "Write MIME body to file: ") + vm-mime-attachment-save-directory default-filename) + file (expand-file-name file vm-mime-attachment-save-directory)) + (save-excursion + (unwind-protect + (progn + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (set-buffer work-buffer) + ;; Tell DOS/Windows NT whether the file is binary + (setq buffer-file-type (not (vm-mime-text-type-p layout))) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (or (not (file-exists-p file)) + (y-or-n-p "File exists, overwrite? ") + (error "Aborted")) + (write-region (point-min) (point-max) file nil nil)) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-mime-pipe-body-to-command (layout &optional discard-output) + (if (not (vectorp layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + (let ((command-line (read-string "Pipe to command: ")) + (output-buffer (if discard-output + 0 + (get-buffer-create "*Shell Command Output*"))) + (work-buffer nil)) + (save-excursion + (if (bufferp output-buffer) + (progn + (set-buffer output-buffer) + (erase-buffer))) + (unwind-protect + (progn + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (set-buffer work-buffer) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-windows t))) + ;; Tell DOS/Windows NT whether the input is binary + (binary-process-input (not (vm-mime-text-type-p layout)))) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil output-buffer nil + shell-command-switch command-line))) + (and work-buffer (kill-buffer work-buffer))) + (if (bufferp output-buffer) + (progn + (set-buffer output-buffer) + (if (not (zerop (buffer-size))) + (vm-display output-buffer t (list this-command) + '(vm-pipe-message-to-command)) + (vm-display nil nil (list this-command) + '(vm-pipe-message-to-command))))))) + t ) + +(defun vm-mime-pipe-body-to-command-discard-output (layout) + (vm-mime-pipe-body-to-command layout t)) + +(defun vm-mime-scrub-description (string) + (let ((work-buffer nil)) + (save-excursion + (unwind-protect + (progn + (setq work-buffer (generate-new-buffer " *vm-work*")) + (buffer-disable-undo work-buffer) + (set-buffer work-buffer) + (insert string) + (while (re-search-forward "[ \t\n]+" nil t) + (replace-match " ")) + (buffer-string)) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-mime-layout-description (layout) + (if (vm-mm-layout-description layout) + (vm-mime-scrub-description (vm-mm-layout-description layout)) + (let ((type (car (vm-mm-layout-type layout))) + name) + (cond ((vm-mime-types-match "multipart/digest" type) + (let ((n (length (vm-mm-layout-parts layout)))) + (format "digest (%d message%s)" n (if (= n 1) "" "s")))) + ((vm-mime-types-match "multipart/alternative" type) + "multipart alternative") + ((vm-mime-types-match "multipart" type) + (let ((n (length (vm-mm-layout-parts layout)))) + (format "multipart message (%d part%s)" n (if (= n 1) "" "s")))) + ((vm-mime-types-match "text/plain" type) + (format "plain text%s" + (let ((charset (vm-mime-get-parameter layout "charset"))) + (if charset + (concat ", " charset) + "")))) + ((vm-mime-types-match "text/enriched" type) + "enriched text") + ((vm-mime-types-match "text/html" type) + "HTML") + ((vm-mime-types-match "image/gif" type) + "GIF image") + ((vm-mime-types-match "image/jpeg" type) + "JPEG image") + ((and (vm-mime-types-match "application/octet-stream" type) + (setq name (vm-mime-get-parameter layout "name")) + (save-match-data (not (string-match "^[ \t]*$" name)))) + name) + (t type))))) + +(defun vm-mime-layout-contains-type (layout type) + (if (vm-mime-types-match type (car (vm-mm-layout-type layout))) + layout + (let ((p (vm-mm-layout-parts layout)) + (result nil) + (done nil)) + (while (and p (not done)) + (if (setq result (vm-mime-layout-contains-type (car p) type)) + (setq done t) + (setq p (cdr p)))) + result ))) + +(defun vm-mime-plain-message-p (m) + (save-match-data + (let ((o (vm-mm-layout m)) + (case-fold-search t)) + (and (eq (vm-mm-encoded-header m) 'none) + (or (not (vectorp o)) + (and (vm-mime-types-match "text/plain" + (car (vm-mm-layout-type o))) + (string-match "^\\(us-ascii\\|iso-8859-1\\)$" + (or (vm-mime-get-parameter o "charset") + "us-ascii")) + (string-match "^\\(7bit\\|8bit\\|binary\\)$" + (vm-mm-layout-encoding o)))))))) + +(defun vm-mime-text-type-p (layout) + (or (vm-mime-types-match "text" (car (vm-mm-layout-type layout))) + (vm-mime-types-match "message" (car (vm-mm-layout-type layout))))) + +(defun vm-mime-charset-internally-displayable-p (name) + (cond ((and (vm-xemacs-mule-p) (eq (device-type) 'x)) + (cdr (assoc (downcase name) vm-mime-xemacs-mule-charset-alist))) + ((vm-xemacs-p) + (vm-member (downcase name) '("us-ascii" "iso-8859-1"))) + ((vm-fsfemacs-19-p) + (vm-member (downcase name) '("us-ascii" "iso-8859-1"))))) + +(defun vm-mime-find-message/partials (layout id) + (let ((list nil) + (type (vm-mm-layout-type layout))) + (cond ((vm-mime-types-match "multipart" (car type)) + (let ((parts (vm-mm-layout-parts layout)) o) + (while parts + (setq o (vm-mime-find-message/partials (car parts) id)) + (if o + (setq list (nconc o list))) + (setq parts (cdr parts))))) + ((vm-mime-types-match "message/partial" (car type)) + (if (equal (vm-mime-get-parameter layout "id") id) + (setq list (cons layout list))))) + list )) + +(defun vm-message-at-point () + (let ((mp vm-message-list) + (point (point)) + (done nil)) + (while (and mp (not done)) + (if (and (>= point (vm-start-of (car mp))) + (<= point (vm-end-of (car mp)))) + (setq done t) + (setq mp (cdr mp)))) + (car mp))) + +(defun vm-mime-make-multipart-boundary () + (let ((boundary (make-string 40 ?a)) + (i 0)) + (random t) + (while (< i (length boundary)) + (aset boundary i (aref vm-mime-base64-alphabet + (% (vm-abs (lsh (random) -8)) + (length vm-mime-base64-alphabet)))) + (vm-increment i)) + boundary )) + +(defun vm-mime-attach-file (file type &optional charset) + "Attach a file to a VM composition buffer to be sent along with the message. +The file is not inserted into the buffer and MIME encoded until +you execute vm-mail-send or vm-mail-send-and-exit. A visible tag +indicating the existence of the attachment is placed in the +composition buffer. You can move the attachment around or remove +it entirely with normal text editing commands. If you remove the +attachment tag, the attachment will not be sent. + +First argument, FILE, is the name of the file to attach. Second +argument, TYPE, is the MIME Content-Type of the file. Optional +third argument CHARSET is the character set of the attached +document. This argument is only used for text types, and it +is ignored for other types. + +When called interactively all arguments are read from the +minibuffer. + +This command is for attaching files that do not have a MIME +header section at the top. For files with MIME headers, you +should use vm-mime-attach-mime-file to attach such a file. VM +will extract the content type information from the headers in +this case and not prompt you for it in the minibuffer." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + (charset nil) + file default-type type) + (if (null vm-send-using-mime) + (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable.")) + (setq file (vm-read-file-name "Attach file: " nil nil t) + default-type (or (vm-mime-default-type-from-filename file) + "application/octet-stream") + type (completing-read + (format "Content type (default %s): " + default-type) + vm-mime-type-completion-alist) + type (if (> (length type) 0) type default-type)) + (if (vm-mime-types-match "text" type) + (setq charset (completing-read "Character set (default US-ASCII): " + vm-mime-charset-completion-alist) + charset (if (> (length charset) 0) charset))) + (list file type charset))) + (if (null vm-send-using-mime) + (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable.")) + (if (file-directory-p file) + (error "%s is a directory, cannot attach" file)) + (if (not (file-exists-p file)) + (error "No such file: %s" file)) + (if (not (file-readable-p file)) + (error "You don't have permission to read %s" file)) + (and charset (setq charset (list (concat "charset=" charset)))) + (vm-mime-attach-object file type charset nil)) + +(defun vm-mime-attach-mime-file (file) + "Attach a MIME encoded file to a VM composition buffer to be sent +along with the message. + +The file is not inserted into the buffer until you execute +vm-mail-send or vm-mail-send-and-exit. A visible tag indicating +the existence of the attachment is placed in the composition +buffer. You can move the attachment around or remove it entirely +with normal text editing commands. If you remove the attachment +tag, the attachment will not be sent. + +The sole argument, FILE, is the name of the file to attach. +When called interactively the FILE argument is read from the +minibuffer. + +This command is for attaching files that have a MIME +header section at the top. For files without MIME headers, you +should use vm-mime-attach-file to attach such a file. VM +will interactively query you for the file type information." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + file) + (if (null vm-send-using-mime) + (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable.")) + (setq file (vm-read-file-name "Attach file: " nil nil t)) + (list file))) + (if (null vm-send-using-mime) + (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable.")) + (if (file-directory-p file) + (error "%s is a directory, cannot attach" file)) + (if (not (file-exists-p file)) + (error "No such file: %s" file)) + (if (not (file-readable-p file)) + (error "You don't have permission to read %s" file)) + (vm-mime-attach-object file "MIME file" nil t)) + +(defun vm-mime-attach-object (object type params mimed) + (if (not (eq major-mode 'mail-mode)) + (error "Command must be used in a VM Mail mode buffer.")) + (let ((start (point)) + e tag-string) + (setq tag-string (format "[ATTACHMENT %s, %s]" object type)) + (insert tag-string "\n") + (cond ((fboundp 'make-overlay) + (setq e (make-overlay start (point) nil t nil)) + (overlay-put e 'face vm-mime-button-face)) + ((fboundp 'make-extent) + (setq e (make-extent start (1- (point)))) + (set-extent-property e 'start-open t) + (set-extent-property e 'face vm-mime-button-face))) + (vm-set-extent-property e 'duplicable t) +;; crashes XEmacs +;; (vm-set-extent-property e 'replicating t) + (vm-set-extent-property e 'vm-mime-type type) + (vm-set-extent-property e 'vm-mime-object object) + (vm-set-extent-property e 'vm-mime-params params) + (vm-set-extent-property e 'vm-mime-encoded mimed))) + +(defun vm-mime-default-type-from-filename (file) + (let ((alist vm-mime-attachment-auto-type-alist) + (case-fold-search t) + (done nil)) + (while (and alist (not done)) + (if (string-match (car (car alist)) file) + (setq done t) + (setq alist (cdr alist)))) + (and alist (cdr (car alist))))) + +(defun vm-remove-mail-mode-header-separator () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" mail-header-separator "$") nil t) + (progn + (delete-region (match-beginning 0) (match-end 0)) + t ) + nil ))) + +(defun vm-add-mail-mode-header-separator () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (replace-match mail-header-separator t t)))) + +(defun vm-mime-transfer-encode-region (encoding beg end crlf) + (let ((case-fold-search t)) + (cond ((string-match "^binary$" encoding) + (vm-mime-base64-encode-region beg end crlf) + (setq encoding "base64")) + ((string-match "^7bit$" encoding) t) + ((string-match "^base64$" encoding) t) + ((string-match "^quoted-printable$" encoding) t) + ;; must be 8bit + ((eq vm-mime-8bit-text-transfer-encoding 'quoted-printable) + (vm-mime-qp-encode-region beg end) + (setq encoding "quoted-printable")) + ((eq vm-mime-8bit-text-transfer-encoding 'base64) + (vm-mime-base64-encode-region beg end crlf) + (setq encoding "base64")) + ((eq vm-mime-8bit-text-transfer-encoding 'send) t)) + encoding )) + +(defun vm-mime-transfer-encode-layout (layout) + (if (vm-mime-text-type-p layout) + (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout) + t) + (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout) + nil))) +(defun vm-mime-encode-composition () + "MIME encode the current buffer. +Attachment tags added to the buffer with vm-mime-attach-file are expanded +and the approriate content-type and boundary markup information is added." + (interactive) + (save-restriction + (widen) + (if (not (eq major-mode 'mail-mode)) + (error "Command must be used in a VM Mail mode buffer.")) + (or (null (vm-mail-mode-get-header-contents "MIME-Version:")) + (error "Message is already MIME encoded.")) + (let ((8bit nil) + (just-one nil) + (boundary-positions nil) + already-mimed layout e e-list boundary + type encoding charset params object opoint-min) + (mail-text) + (setq e-list (if (fboundp 'extent-list) + (extent-list nil (point) (point-max)) + (overlays-in (point) (point-max))) + e-list (vm-delete (function + (lambda (e) + (vm-extent-property e 'vm-mime-object))) + e-list t) + e-list (sort e-list (function + (lambda (e1 e2) + (< (vm-extent-end-position e1) + (vm-extent-end-position e2)))))) + ;; If there's just one attachment and no other readable + ;; text in the buffer then make the message type just be + ;; the attachment type rather than sending a multipart + ;; message with one attachment + (setq just-one (and (= (length e-list) 1) + (looking-at "[ \t\n]*") + (= (match-end 0) + (vm-extent-start-position (car e-list))) + (save-excursion + (goto-char (vm-extent-end-position (car e-list))) + (looking-at "[ \t\n]*\\'")))) + (if (null e-list) + (progn + (narrow-to-region (point) (point-max)) + (setq charset (vm-determine-proper-charset (point-min) + (point-max))) + (setq encoding (vm-determine-proper-content-transfer-encoding + (point-min) + (point-max)) + encoding (vm-mime-transfer-encode-region encoding + (point-min) + (point-max) + t)) + (widen) + (vm-remove-mail-mode-header-separator) + (goto-char (point-min)) + (vm-reorder-message-headers + nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)") + (insert "MIME-Version: 1.0\n") + (insert "Content-Type: text/plain; charset=" charset "\n") + (insert "Content-Transfer-Encoding: " encoding "\n") + (vm-add-mail-mode-header-separator)) + (while e-list + (setq e (car e-list)) + (if (or just-one (= (point) (vm-extent-start-position e))) + nil + (narrow-to-region (point) (vm-extent-start-position e)) + (setq charset (vm-determine-proper-charset (point-min) + (point-max))) + (setq encoding (vm-determine-proper-content-transfer-encoding + (point-min) + (point-max)) + encoding (vm-mime-transfer-encode-region encoding + (point-min) + (point-max) + t)) + (setq boundary-positions (cons (point-marker) boundary-positions)) + (insert "Content-Type: text/plain; charset=" charset "\n") + (insert "Content-Transfer-Encoding: " encoding "\n\n") + (widen)) + (goto-char (vm-extent-end-position e)) + (narrow-to-region (point) (point)) + (setq object (vm-extent-property e 'vm-mime-object)) + (cond ((bufferp object) + (insert-buffer-substring object)) + ((stringp object) + (insert-file-contents-literally object))) + (if (setq already-mimed (vm-extent-property e 'vm-mime-encoded)) + (setq layout (vm-mime-parse-entity + nil (list "text/plain" "charset=us-ascii") + "7bit") + type (car (vm-mm-layout-type layout)) + params (cdr (vm-mm-layout-type layout))) + (setq type (vm-extent-property e 'vm-mime-type) + params (vm-extent-property e 'vm-mime-parameters))) + (cond ((vm-mime-types-match "text" type) + (setq encoding + (vm-determine-proper-content-transfer-encoding + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max)) + encoding (vm-mime-transfer-encode-region + encoding + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max) + t)) + (setq 8bit (or 8bit (equal encoding "8bit")))) + ((or (vm-mime-types-match "message/rfc822" type) + (vm-mime-types-match "multipart" type)) + (setq opoint-min (point-min)) + (if (not already-mimed) + (setq layout (vm-mime-parse-entity + nil (list "text/plain" "charset=us-ascii") + "7bit"))) + ;; MIME messages of type "message" and + ;; "multipart" are required to have a non-opaque + ;; content transfer encoding. This means that + ;; if the user only wants to send out 7bit data, + ;; then any subpart that contains 8bit data must + ;; have an opaque (qp or base64) 8->7bit + ;; conversion performed on it so that the + ;; enclosing entity can use an non-opqaue + ;; encoding. + ;; + ;; message/partial requires a "7bit" encoding so + ;; force 8->7 conversion in that case. + (let ((vm-mime-8bit-text-transfer-encoding + (if (vm-mime-types-match "message/partial" type) + 'quoted-printable + vm-mime-8bit-text-transfer-encoding))) + (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout + (vm-mm-layout-parts layout))) + ;; now figure out a proper content trasnfer + ;; encoding value for the enclosing entity. + (re-search-forward "^\n" nil t) + (save-restriction + (narrow-to-region (point) (point-max)) + (setq encoding + (vm-determine-proper-content-transfer-encoding + (point-min) + (point-max)))) + (setq 8bit (or 8bit (equal encoding "8bit"))) + (goto-char (point-max)) + (widen) + (narrow-to-region opoint-min (point))) + (t + (vm-mime-base64-encode-region + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max)) + (setq encoding "base64"))) + (if just-one + nil + (goto-char (point-min)) + (setq boundary-positions (cons (point-marker) boundary-positions)) + (if (not already-mimed) + nil + ;; trim headers + (vm-reorder-message-headers + nil '("Content-Description:" "Content-ID:") nil) + ;; remove header/text separator + (goto-char (1- (vm-mm-layout-body-start layout))) + (if (looking-at "\n") + (delete-char 1))) + (insert "Content-Type: " type) + (if params + (if vm-mime-avoid-folding-content-type + (insert "; " (mapconcat 'identity params "; ") "\n") + (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) + (insert "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n\n")) + (goto-char (point-max)) + (widen) + (delete-region (vm-extent-start-position e) + (vm-extent-end-position e)) + (vm-detach-extent e) + (setq e-list (cdr e-list))) + ;; handle the remaining chunk of text after the last + ;; extent, if any. + (if (or just-one (= (point) (point-max))) + nil + (setq charset (vm-determine-proper-charset (point) + (point-max))) + (setq encoding (vm-determine-proper-content-transfer-encoding + (point) + (point-max)) + encoding (vm-mime-transfer-encode-region encoding + (point) + (point-max) + t)) + (setq 8bit (or 8bit (equal encoding "8bit"))) + (setq boundary-positions (cons (point-marker) boundary-positions)) + (insert "Content-Type: text/plain; charset=" charset "\n") + (insert "Content-Transfer-Encoding: " encoding "\n\n") + (goto-char (point-max))) + (setq boundary (vm-mime-make-multipart-boundary)) + (mail-text) + (while (re-search-forward (concat "^--" + (regexp-quote boundary) + "\\(--\\)?$") + nil t) + (setq boundary (vm-mime-make-multipart-boundary)) + (mail-text)) + (goto-char (point-max)) + (or just-one (insert "\n--" boundary "--\n")) + (while boundary-positions + (goto-char (car boundary-positions)) + (insert "\n--" boundary "\n") + (setq boundary-positions (cdr boundary-positions))) + (if (and just-one already-mimed) + (progn + (goto-char (vm-mm-layout-header-start layout)) + ;; trim headers + (vm-reorder-message-headers + nil '("Content-Description:" "Content-ID:") nil) + ;; remove header/text separator + (goto-char (1- (vm-mm-layout-body-start layout))) + (if (looking-at "\n") + (delete-char 1)) + ;; copy remainder to enclosing entity's header section + (insert-buffer-substring (current-buffer) + (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout)) + (delete-region (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout)))) + (goto-char (point-min)) + (vm-remove-mail-mode-header-separator) + (vm-reorder-message-headers + nil nil "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") + (vm-add-mail-mode-header-separator) + (insert "MIME-Version: 1.0\n") + (if (not just-one) + (insert (if vm-mime-avoid-folding-content-type + "Content-Type: multipart/mixed; boundary=\"" + "Content-Type: multipart/mixed;\n\tboundary=\"") + boundary "\"\n") + (insert "Content-Type: " type) + (if params + (if vm-mime-avoid-folding-content-type + (insert "; " (mapconcat 'identity params "; ") "\n") + (insert ";\n\t" (mapconcat 'identity params ";\n\t")))) + (insert "\n")) + (if just-one + (insert "Content-Transfer-Encoding: " encoding "\n") + (if 8bit + (insert "Content-Transfer-Encoding: 8bit\n") + (insert "Content-Transfer-Encoding: 7bit\n"))))))) + +(defun vm-mime-fragment-composition (size) + (save-restriction + (widen) + (vm-unsaved-message "Fragmenting message...") + (let ((buffers nil) + (id (vm-mime-make-multipart-boundary)) + (n 1) + (the-end nil) + b header-start header-end master-buffer start end) + (vm-remove-mail-mode-header-separator) + ;; message/partial must have "7bit" content transfer + ;; encoding, so verify that everything has been encoded for + ;; 7bit transmission. + (let ((vm-mime-8bit-text-transfer-encoding + (if (eq vm-mime-8bit-text-transfer-encoding 'send) + 'quoted-printable + vm-mime-8bit-text-transfer-encoding))) + (vm-mime-map-atomic-layouts + 'vm-mime-transfer-encode-layout + (list (vm-mime-parse-entity nil (list "text/plain" "charset=us-ascii") + "7bit")))) + (goto-char (point-min)) + (setq header-start (point)) + (search-forward "\n\n") + (setq header-end (1- (point))) + (setq master-buffer (current-buffer)) + (goto-char (point-min)) + (setq start (point)) + (while (not (eobp)) + (condition-case nil + (progn + (forward-char (max (- size 150) 2000)) + (beginning-of-line)) + (end-of-buffer (setq the-end t))) + (setq end (point)) + (setq b (generate-new-buffer (concat (buffer-name) " part " + (int-to-string n)))) + (setq buffers (cons b buffers)) + (set-buffer b) + (make-local-variable 'vm-send-using-mime) + (setq vm-send-using-mime nil) + (insert-buffer-substring master-buffer header-start header-end) + (goto-char (point-min)) + (vm-reorder-message-headers nil nil + "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") + (insert "MIME-Version: 1.0\n") + (insert (format + (if vm-mime-avoid-folding-content-type + "Content-Type: message/partial; id=%s; number=%d" + "Content-Type: message/partial;\n\tid=%s;\n\tnumber=%d") + id n)) + (if the-end + (if vm-mime-avoid-folding-content-type + (insert (format "; total=%d\n" n)) + (insert (format ";\n\ttotal=%d\n" n))) + (insert "\n")) + (insert "Content-Transfer-Encoding: 7bit\n") + (goto-char (point-max)) + (insert mail-header-separator "\n") + (insert-buffer-substring master-buffer start end) + (vm-increment n) + (set-buffer master-buffer) + (setq start (point))) + (vm-unsaved-message "Fragmenting message... done") + (nreverse buffers)))) + +(defun vm-mime-preview-composition () + "Show how the current composition buffer might be displayed +in a MIME-aware mail reader. VM copies and encodes the current +mail composition buffer and displays it as a mail folder. +Type `q' to quit this temp folder and return to composing your +message." + (interactive) + (if (not (eq major-mode 'mail-mode)) + (error "Command must be used in a VM Mail mode buffer.")) + (let ((temp-buffer nil) + (mail-buffer (current-buffer)) + e-list) + (unwind-protect + (progn + (mail-text) + (setq e-list (if (fboundp 'extent-list) + (extent-list nil (point) (point-max)) + (overlays-in (point) (point-max))) + e-list (vm-delete (function + (lambda (e) + (vm-extent-property e 'vm-mime-object))) + e-list t) + e-list (sort e-list (function + (lambda (e1 e2) + (< (vm-extent-end-position e1) + (vm-extent-end-position e2)))))) + (setq temp-buffer (generate-new-buffer "composition preview")) + (set-buffer temp-buffer) + ;; so vm-mime-encode-composition won't complain + (setq major-mode 'mail-mode) + (vm-insert-region-from-buffer mail-buffer) + (mapcar 'vm-copy-extent e-list) + (goto-char (point-min)) + (or (vm-mail-mode-get-header-contents "From") + (insert "From: " (or user-mail-address (user-login-name)) "\n")) + (or (vm-mail-mode-get-header-contents "Message-ID") + (insert "Message-ID: <fake@fake.com>\n")) + (or (vm-mail-mode-get-header-contents "Date") + (insert "Date: " + (format-time-string "%a, %d %b %Y %H%M%S %Z" + (current-time)) + "\n")) + (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:")) + (vm-mime-encode-composition)) + (goto-char (point-min)) + (insert (vm-leading-message-separator 'From_)) + (goto-char (point-max)) + (insert (vm-trailing-message-separator 'From_)) + (set-buffer-modified-p nil) + ;; point of no return, don't kill it if the user quits + (setq temp-buffer nil) + (let ((vm-auto-decode-mime-messages t) + (vm-auto-displayed-mime-content-types t)) + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode))) + (message + (substitute-command-keys + "Type \\[vm-quit] to continue composing your message")) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + (and temp-buffer (kill-buffer temp-buffer))))) + +(defun vm-mime-composite-type-p (type) + (or (vm-mime-types-match "message" type) + (vm-mime-types-match "multipart" type))) + +(defun vm-mime-map-atomic-layouts (function list) + (while list + (if (vm-mime-composite-type-p (car (vm-mm-layout-type (car list)))) + (vm-mime-map-atomic-layouts function (vm-mm-layout-parts (car list))) + (funcall function (car list))) + (setq list (cdr list))))
--- a/lisp/vm/vm-minibuf.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-minibuf.el Mon Aug 13 08:50:05 2007 +0200 @@ -182,18 +182,14 @@ (setq keymap (car keymaps)) (cond ((vm-mouse-xemacs-mouse-p) (define-key keymap 'button1 command) - (define-key keymap 'button2 command) - (define-key keymap 'button3 command)) + (define-key keymap 'button2 command)) ((vm-mouse-fsfemacs-mouse-p) (define-key keymap [down-mouse-1] 'ignore) (define-key keymap [drag-mouse-1] 'ignore) (define-key keymap [mouse-1] command) (define-key keymap [drag-mouse-2] 'ignore) (define-key keymap [down-mouse-2] 'ignore) - (define-key keymap [mouse-2] command) - (define-key keymap [drag-mouse-3] 'ignore) - (define-key keymap [down-mouse-3] 'ignore) - (define-key keymap [mouse-3] command))) + (define-key keymap [mouse-2] command))) (setq keymaps (cdr keymaps))))) (setq w (vm-get-buffer-window (current-buffer))) (setq q list @@ -266,7 +262,9 @@ (if (not multi-word) (define-key minibuffer-local-map "\r" 'vm-minibuffer-complete-word-and-exit)) - (read-string prompt))) + ;; evade the XEmacs dialox box, yeccch. + (let ((should-use-dialog-box nil)) + (read-string prompt)))) (defvar last-nonmenu-event) @@ -362,7 +360,9 @@ (defun vm-keyboard-read-file-name (prompt &optional dir default must-match initial history) "Like read-file-name, except HISTORY's value is unaltered." - (let ((oldvalue (symbol-value history))) + (let ((oldvalue (symbol-value history)) + ;; evade the XEmacs dialox box, yeccch. + (should-use-dialog-box nil)) (unwind-protect (condition-case nil (read-file-name prompt dir default must-match initial history)
--- a/lisp/vm/vm-misc.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-misc.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Miscellaneous functions for VM -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; 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 @@ -131,6 +131,13 @@ (vm-set-su-end-of (car mp) nil) (setq mp (cdr mp)))))) +(defun vm-check-for-killed-presentation () + (and (bufferp vm-presentation-buffer-handle) + (null (buffer-name vm-presentation-buffer-handle)) + (progn + (setq vm-presentation-buffer-handle nil + vm-presentation-buffer nil)))) + (defun vm-check-for-killed-folder () (and (bufferp vm-mail-buffer) (null (buffer-name vm-mail-buffer)) (setq vm-mail-buffer nil))) @@ -237,6 +244,15 @@ (setq prev p p (cdr p)))) list )) +(defun vm-delete-directory-file-names (list) + (vm-delete 'file-directory-p list)) + +(defun vm-delete-backup-file-names (list) + (vm-delete 'backup-file-name-p list)) + +(defun vm-delete-auto-save-file-names (list) + (vm-delete 'auto-save-file-name-p list)) + (defun vm-delete-duplicates (list &optional all hack-addresses) "Delete duplicate equivalent strings from the list. If ALL is t, then if there is more than one occurrence of a string in the list, @@ -317,12 +333,18 @@ return-value )) ((vectorp object) (apply 'vector (mapcar 'vm-copy object))) ((stringp object) (copy-sequence object)) + ((markerp object) (copy-marker object)) (t object))) (defun vm-xemacs-p () (let ((case-fold-search nil)) (string-match "XEmacs" emacs-version))) +(defun vm-xemacs-mule-p () + (and (vm-xemacs-p) + (fboundp 'set-file-coding-system) + (fboundp 'decode-coding-region))) + (defun vm-fsfemacs-19-p () (and (string-match "^19" emacs-version) (not (string-match "XEmacs\\|Lucid" emacs-version)))) @@ -490,3 +512,100 @@ (defun vm-buffer-string-no-properties () (vm-buffer-substring-no-properties (point-min) (point-max))) + +(defun vm-insert-region-from-buffer (buffer &optional start end) + (let ((target-buffer (current-buffer))) + (set-buffer buffer) + (save-restriction + (widen) + (or start (setq start (point-min))) + (or end (setq end (point-max))) + (set-buffer target-buffer) + (insert-buffer-substring buffer start end) + (set-buffer buffer)) + (set-buffer target-buffer))) + +(if (fboundp 'overlay-get) + (fset 'vm-extent-property 'overlay-get) + (fset 'vm-extent-property 'extent-property)) + +(if (fboundp 'overlay-put) + (fset 'vm-set-extent-property 'overlay-put) + (fset 'vm-set-extent-property 'set-extent-property)) + +(if (fboundp 'make-overlay) + (fset 'vm-make-extent 'make-overlay) + (fset 'vm-make-extent 'make-extent)) + +(if (fboundp 'overlay-end) + (fset 'vm-extent-end-position 'overlay-end) + (fset 'vm-extent-end-position 'extent-end-position)) + +(if (fboundp 'overlay-start) + (fset 'vm-extent-start-position 'overlay-start) + (fset 'vm-extent-start-position 'extent-start-position)) + +(if (fboundp 'delete-overlay) + (fset 'vm-detach-extent 'delete-overlay) + (fset 'vm-detach-extent 'detach-extent)) + +(if (fboundp 'overlay-properties) + (fset 'vm-extent-properties 'overlay-properties) + (fset 'vm-extent-properties 'extent-properties)) + +(defun vm-copy-extent (e) + (let ((props (vm-extent-properties e)) + (ee (vm-make-extent (vm-extent-start-position e) + (vm-extent-end-position e)))) + (while props + (vm-set-extent-property ee (car props) (car (cdr props))) + (setq props (cdr props))))) + +(defun vm-make-tempfile-name () + (let ((done nil) (pid (emacs-pid)) filename) + (while (not done) + (setq filename (format "%s/vm%d.%d" vm-temp-file-directory pid + vm-tempfile-counter) + vm-tempfile-counter (1+ vm-tempfile-counter) + done (not (file-exists-p filename)))) + filename )) + +(defun vm-insert-char (char &optional count ignored buffer) + (condition-case nil + (progn + (insert-char char count ignored buffer) + (fset 'vm-insert-char 'insert-char)) + (wrong-number-of-arguments + (fset 'vm-insert-char 'vm-xemacs-compatible-insert-char) + (vm-insert-char char count ignored buffer)))) + +(defun vm-xemacs-compatible-insert-char (char &optional count ignored buffer) + (if (and buffer (eq buffer (current-buffer))) + (insert-char char count) + (save-excursion + (set-buffer buffer) + (insert-char char count)))) + +(defun vm-symbol-lists-intersect-p (list1 list2) + (catch 'done + (while list1 + (and (memq (car list1) list2) + (throw 'done t)) + (setq list1 (cdr list1))) + nil )) + +(defun vm-set-buffer-variable (buffer var value) + (save-excursion + (set-buffer buffer) + (set var value))) + +(defsubst vm-with-string-as-temp-buffer (string function) + (let ((work-buffer nil)) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *work*")) + (set-buffer work-buffer) + (insert string) + (funcall function) + (buffer-string)) + (and work-buffer (kill-buffer work-buffer)))))
--- a/lisp/vm/vm-motion.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-motion.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Commands to move around in a VM folder -;;; Copyright (C) 1989, 1990, 1993, 1994 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -19,6 +19,7 @@ (defun vm-record-and-change-message-pointer (old new) (intern (buffer-name) vm-buffers-needing-display-update) + (vm-garbage-collect-message) (setq vm-last-message-pointer old vm-message-pointer new vm-need-summary-pointer-update t)) @@ -275,7 +276,8 @@ (if (interactive-p) (vm-follow-summary-cursor)) (vm-select-folder-buffer) - (vm-display nil nil '(vm-Next-message) '(vm-Next-message)) + (vm-display nil nil '(vm-next-message-no-skip) + '(vm-next-message-no-skip)) (let ((vm-skip-deleted-messages nil) (vm-skip-read-messages nil)) (vm-next-message count nil t))) @@ -288,7 +290,8 @@ (if (interactive-p) (vm-follow-summary-cursor)) (vm-select-folder-buffer) - (vm-display nil nil '(vm-Previous-message) '(vm-Previous-message)) + (vm-display nil nil '(vm-previous-message-no-skip) + '(vm-previous-message-no-skip)) (let ((vm-skip-deleted-messages nil) (vm-skip-read-messages nil)) (vm-previous-message count)))
--- a/lisp/vm/vm-mouse.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-mouse.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Mouse related functions and commands -;;; Copyright (C) 1995 Kyle E. Jones +;;; Copyright (C) 1995-1997 Kyle E. Jones ;;; ;;; 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 @@ -48,14 +48,11 @@ (beginning-of-line) (if (let ((vm-follow-summary-cursor t)) (vm-follow-summary-cursor)) - (progn - (vm-select-folder-buffer) - (vm-preview-current-message)) + nil (setq this-command 'vm-scroll-forward) (call-interactively 'vm-scroll-forward))) - ((memq major-mode '(vm-mode vm-virtual-mode)) - (cond ((and (vm-mouse-fsfemacs-mouse-p) vm-url-browser) - (vm-mouse-popup-or-select event)))))) + ((memq major-mode '(vm-mode vm-virtual-mode vm-presentation-mode)) + (vm-mouse-popup-or-select event)))) (defun vm-mouse-button-3 (event) (interactive "e") @@ -73,12 +70,15 @@ (vm-menu-popup-mode-menu event)) ((eq major-mode 'vm-mode) (vm-menu-popup-context-menu event)) + ((eq major-mode 'vm-presentation-mode) + (vm-menu-popup-context-menu event)) ((eq major-mode 'vm-virtual-mode) (vm-menu-popup-context-menu event)) ((eq major-mode 'mail-mode) (vm-menu-popup-mode-menu event)))))) (defun vm-mouse-3-help (object) + nil "Use mouse button 3 to see a menu of options.") (defun vm-mouse-get-mouse-track-string (event) @@ -114,25 +114,33 @@ (cond ((vm-mouse-fsfemacs-mouse-p) (set-buffer (window-buffer (posn-window (event-start event)))) (goto-char (posn-point (event-start event))) - (let (o-list o menu (found nil)) + (let (o-list (found nil)) (setq o-list (overlays-at (point))) (while (and o-list (not found)) (cond ((overlay-get (car o-list) 'vm-url) (setq found t) - (vm-mouse-send-url-at-event event))) + (vm-mouse-send-url-at-event event)) + ((overlay-get (car o-list) 'vm-mime-function) + (setq found t) + (funcall (overlay-get (car o-list) 'vm-mime-function) + (car o-list)))) (setq o-list (cdr o-list))) (and (not found) (vm-menu-popup-context-menu event)))) ;; The XEmacs code is not actually used now, since all ;; selectable objects are handled by an extent keymap ;; binding that points to a more specific function. But ;; this might come in handy later if I want selectable - ;; objects that don't have an extent attached. + ;; objects that don't have an extent or extent keymap + ;; attached. ((vm-mouse-xemacs-mouse-p) (set-buffer (window-buffer (event-window event))) (and (event-point event) (goto-char (event-point event))) - (if (extent-at (point) (current-buffer) 'vm-url) - (vm-mouse-send-url-at-event event) - (vm-menu-popup-context-menu event))))) + (let (e) + (cond ((extent-at (point) (current-buffer) 'vm-url) + (vm-mouse-send-url-at-event event)) + ((setq e (extent-at (point) nil 'vm-mime-function)) + (funcall (extent-property e 'vm-mime-function) e)) + (t (vm-menu-popup-context-menu event))))))) (defun vm-mouse-send-url-at-event (event) (interactive "e") @@ -146,35 +154,39 @@ (vm-mouse-send-url-at-position (posn-point (event-start event)))))) (defun vm-mouse-send-url-at-position (pos &optional browser) - (cond ((vm-mouse-xemacs-mouse-p) - (let ((e (extent-at pos (current-buffer) 'vm-url)) - url) - (if (null e) - nil - (setq url (buffer-substring (extent-start-position e) - (extent-end-position e))) - (vm-mouse-send-url url browser)))) - ((vm-mouse-fsfemacs-mouse-p) - (let (o-list url o) - (setq o-list (overlays-at pos)) - (while (and o-list (null (overlay-get (car o-list) 'vm-url))) - (setq o-list (cdr o-list))) - (if (null o-list) - nil - (setq o (car o-list)) - (setq url (vm-buffer-substring-no-properties - (overlay-start o) - (overlay-end o))) - (vm-mouse-send-url url browser)))))) + (save-restriction + (widen) + (cond ((vm-mouse-xemacs-mouse-p) + (let ((e (extent-at pos (current-buffer) 'vm-url)) + url) + (if (null e) + nil + (setq url (buffer-substring (extent-start-position e) + (extent-end-position e))) + (vm-mouse-send-url url browser)))) + ((vm-mouse-fsfemacs-mouse-p) + (let (o-list url o) + (setq o-list (overlays-at pos)) + (while (and o-list (null (overlay-get (car o-list) 'vm-url))) + (setq o-list (cdr o-list))) + (if (null o-list) + nil + (setq o (car o-list)) + (setq url (vm-buffer-substring-no-properties + (overlay-start o) + (overlay-end o))) + (vm-mouse-send-url url browser))))))) (defun vm-mouse-send-url (url &optional browser) - (let ((browser (or browser vm-url-browser))) - (cond ((symbolp browser) - (funcall browser url)) - ((stringp browser) - (vm-unsaved-message "Sending URL to %s..." browser) - (vm-run-background-command browser url) - (vm-unsaved-message "Sending URL to %s... done" browser))))) + (if (string-match "^mailto:" url) + (vm-mail-to-mailto-url url) + (let ((browser (or browser vm-url-browser))) + (cond ((symbolp browser) + (funcall browser url)) + ((stringp browser) + (vm-unsaved-message "Sending URL to %s..." browser) + (vm-run-background-command browser url) + (vm-unsaved-message "Sending URL to %s... done" browser)))))) (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window) (vm-unsaved-message "Sending URL to Netscape...") @@ -221,7 +233,7 @@ ((vm-mouse-fsfemacs-mouse-p) (if (null (lookup-key vm-mode-map [mouse-2])) (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2)) - (if (null (lookup-key vm-mode-map [down-mouse-3])) + (if vm-popup-menu-on-mouse-3 (progn (define-key vm-mode-map [mouse-3] 'ignore) (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3)))))) @@ -232,6 +244,31 @@ (defun vm-run-command (command &rest arg-list) (apply (function call-process) command nil nil nil arg-list)) +;; return t on zero exit status +;; return (exit-status . stderr-string) on nonzero exit status +(defun vm-run-command-on-region (start end output-buffer command + &rest arg-list) + (let ((tempfile nil) status errstring) + (unwind-protect + (progn + (setq tempfile (vm-make-tempfile-name)) + (setq status + (apply 'call-process-region + start end command nil + (list output-buffer tempfile) + nil arg-list)) + (cond ((equal status 0) t) + ((zerop (save-excursion + (set-buffer (find-file-noselect tempfile)) + (buffer-size))) + t) + (t (save-excursion + (set-buffer (find-file-noselect tempfile)) + (setq errstring (buffer-string)) + (kill-buffer nil) + (cons status errstring))))) + (vm-error-free-call 'delete-file tempfile)))) + ;; stupid yammering compiler (defvar vm-mouse-read-file-name-prompt) (defvar vm-mouse-read-file-name-dir) @@ -266,8 +303,9 @@ (setq vm-mouse-read-file-name-history history) (setq vm-mouse-read-file-name-prompt prompt) (setq vm-mouse-read-file-name-return-value nil) - (save-excursion - (vm-goto-new-frame 'completion)) + (if (and vm-frame-per-completion (vm-multiple-frames-possible-p)) + (save-excursion + (vm-goto-new-frame 'completion))) (switch-to-buffer (current-buffer)) (vm-mouse-read-file-name-event-handler) (save-excursion @@ -321,7 +359,9 @@ (vm-mouse-set-mouse-track-highlight start (point)) (vm-set-region-face start (point) 'italic) (insert ?\n ?\n) - (setq list (directory-files default-directory)) + (setq list (vm-delete-backup-file-names + (vm-delete-auto-save-file-names + (directory-files default-directory)))) (vm-show-list list 'vm-mouse-read-file-name-event-handler) (setq buffer-read-only t))) @@ -351,8 +391,9 @@ (setq vm-mouse-read-string-completion-list completion-list) (setq vm-mouse-read-string-multi-word multi-word) (setq vm-mouse-read-string-return-value nil) - (save-excursion - (vm-goto-new-frame 'completion)) + (if (and vm-frame-per-completion (vm-multiple-frames-possible-p)) + (save-excursion + (vm-goto-new-frame 'completion))) (switch-to-buffer (current-buffer)) (vm-mouse-read-string-event-handler) (save-excursion @@ -369,7 +410,7 @@ (defun vm-mouse-read-string-event-handler (&optional string) (let ((key-doc "Click here for keyboard interface.") (bs-doc " .... to go back one word.") - (done-doc " .... to when you're done.") + (done-doc " .... when you're done.") start list) (if string (cond ((equal string key-doc)
--- a/lisp/vm/vm-page.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-page.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Commands to move around within a VM message -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -28,18 +28,24 @@ (was-invisible nil)) (vm-select-folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-error-if-folder-empty) - (if (null (vm-get-visible-buffer-window (current-buffer))) - (let ((point (point))) - (vm-display (current-buffer) t - '(vm-scroll-forward vm-scroll-backward) - (list this-command 'reading-message)) - ;; window start sticks to end of clip region when clip - ;; region moves back past it in the buffer. fix it. - (let ((w (vm-get-visible-buffer-window (current-buffer)))) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (let ((point (point)) + (w (vm-get-visible-buffer-window (current-buffer)))) + (if (or (null w) + (not (vm-frame-totally-visible-p (vm-window-frame w)))) + (progn + (vm-display (current-buffer) t + '(vm-scroll-forward vm-scroll-backward) + (list this-command 'reading-message)) + ;; window start sticks to end of clip region when clip + ;; region moves back past it in the buffer. fix it. + (setq w (vm-get-visible-buffer-window (current-buffer))) (if (= (window-start w) (point-max)) - (set-window-start w (point-min)))) - (setq was-invisible t))) + (set-window-start w (point-min))) + (setq was-invisible t)))) (if (or mp-changed was-invisible (and (eq vm-system-state 'previewing) (pos-visible-in-window-p @@ -103,14 +109,20 @@ (t (and (> (prefix-numeric-value arg) 0) (vm-howl-if-eom))))))) - (if (not (or vm-startup-message-displayed vm-inhibit-startup-message)) + (if (not vm-startup-message-displayed) (vm-display-startup-message))) (defun vm-scroll-forward-internal (arg) (let ((direction (prefix-numeric-value arg)) (w (selected-window))) (condition-case error-data - (progn (scroll-up arg) nil) + (progn + (if (and (> direction 0) + (pos-visible-in-window-p + (vm-text-end-of (car vm-message-pointer)))) + (signal 'end-of-buffer nil) + (scroll-up arg)) + nil ) (error (if (or (and (< direction 0) (> (point-min) (vm-text-of (car vm-message-pointer)))) @@ -237,7 +249,7 @@ ;; large, search just the head and the tail of the region since ;; they tend to contain the interesting text. (let ((search-limit vm-url-search-limit) - (search-pairs)) + search-pairs n) (if (and search-limit (> (- (point-max) (point-min)) search-limit)) (setq search-pairs (list (cons (point-min) (+ (point-min) (/ search-limit 2))) @@ -256,14 +268,18 @@ (while search-pairs (goto-char (car (car search-pairs))) (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t) - (setq e (make-extent (match-beginning 0) (match-end 0))) + (setq n 1) + (while (null (match-beginning n)) + (vm-increment n)) + (setq e (make-extent (match-beginning n) (match-end n))) (set-extent-property e 'vm-url t) (if vm-highlight-url-face (set-extent-property e 'face vm-highlight-url-face)) (if vm-url-browser (let ((keymap (make-sparse-keymap))) (define-key keymap 'button2 'vm-mouse-send-url-at-event) - (define-key keymap 'button3 'vm-menu-popup-url-browser-menu) + (if vm-popup-menu-on-mouse-3 + (define-key keymap 'button3 'vm-menu-popup-url-browser-menu)) (define-key keymap "\r" (function (lambda () (interactive) (vm-mouse-send-url-at-position (point))))) @@ -288,12 +304,21 @@ (while search-pairs (goto-char (car (car search-pairs))) (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t) - (setq o (make-overlay (match-beginning 0) (match-end 0))) + (setq n 1) + (while (null (match-beginning n)) + (vm-increment n)) + (setq o (make-overlay (match-beginning n) (match-end n))) (overlay-put o 'vm-url t) (if vm-highlight-url-face (overlay-put o 'face vm-highlight-url-face)) (if vm-url-browser - (overlay-put o 'mouse-face 'highlight))) + (let ((keymap (make-sparse-keymap))) + (overlay-put o 'mouse-face 'highlight) + (setq keymap (nconc keymap (current-local-map))) + (define-key keymap "\r" + (function (lambda () (interactive) + (vm-mouse-send-url-at-position (point))))) + (overlay-put o 'local-map keymap)))) (setq search-pairs (cdr search-pairs)))))))) (defun vm-energize-headers () @@ -324,9 +349,10 @@ (define-key keymap 'button2 (list 'lambda () '(interactive) (list 'popup-menu (list 'quote menu)))) - (define-key keymap 'button3 - (list 'lambda () '(interactive) - (list 'popup-menu (list 'quote menu)))) + (if vm-popup-menu-on-mouse-3 + (define-key keymap 'button3 + (list 'lambda () '(interactive) + (list 'popup-menu (list 'quote menu))))) (set-extent-property e 'keymap keymap) (set-extent-property e 'balloon-help 'vm-mouse-3-help) (set-extent-property e 'highlight t)) @@ -410,10 +436,48 @@ "Netscape") (t (symbol-name vm-url-browser))))) -(defun vm-preview-current-message () - (setq vm-system-state 'previewing) - (if vm-real-buffers - (vm-make-virtual-copy (car vm-message-pointer))) +(defun vm-energize-urls-in-message-region (&optional start end) + (save-excursion + (or start (setq start (vm-headers-of (car vm-message-pointer)))) + (or end (setq end (vm-text-end-of (car vm-message-pointer)))) + ;; energize the URLs + (if (or vm-highlight-url-face vm-url-browser) + (save-restriction + (widen) + (narrow-to-region start + end) + (vm-energize-urls))))) + +(defun vm-highlight-headers-maybe () + ;; highlight the headers + (if (or vm-highlighted-header-regexp + (and (vm-xemacs-p) vm-use-lucid-highlighting)) + (save-restriction + (widen) + (narrow-to-region (vm-headers-of (car vm-message-pointer)) + (vm-text-end-of (car vm-message-pointer))) + (vm-highlight-headers)))) + +(defun vm-energize-headers-and-xfaces () + ;; energize certain headers + (if (and vm-use-menus (vm-menu-support-possible-p)) + (save-restriction + (widen) + (narrow-to-region (vm-headers-of (car vm-message-pointer)) + (vm-text-of (car vm-message-pointer))) + (vm-energize-headers))) + ;; display xfaces, if we can + (if (and vm-display-xfaces + (vm-xemacs-p) + (vm-multiple-frames-possible-p) + (featurep 'xface)) + (save-restriction + (widen) + (narrow-to-region (vm-headers-of (car vm-message-pointer)) + (vm-text-of (car vm-message-pointer))) + (vm-display-xface)))) + +(defun vm-narrow-for-preview () (widen) ;; hide as much of the message body as vm-preview-lines specifies (narrow-to-region @@ -425,86 +489,104 @@ (goto-char (vm-text-of (car vm-message-pointer))) (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0)) (point)))) - (t (vm-text-end-of (car vm-message-pointer))))) - ;; highlight the headers - (if (or vm-highlighted-header-regexp - (and (vm-xemacs-p) vm-use-lucid-highlighting)) - (save-restriction - (widen) - (narrow-to-region (vm-headers-of (car vm-message-pointer)) - (vm-text-end-of (car vm-message-pointer))) - (vm-highlight-headers))) - ;; energize the URLs - (if (or vm-highlight-url-face vm-url-browser) - (save-restriction - (widen) - (narrow-to-region (vm-headers-of (car vm-message-pointer)) - (vm-text-end-of (car vm-message-pointer))) - (vm-energize-urls))) - ;; energize certain headers - (if (and vm-use-menus (vm-menu-support-possible-p)) - (save-restriction - (widen) - (narrow-to-region (vm-headers-of (car vm-message-pointer)) - (vm-text-of (car vm-message-pointer))) - (vm-energize-headers))) + (t (vm-text-end-of (car vm-message-pointer)))))) + +(defun vm-preview-current-message () + (vm-save-buffer-excursion + (setq vm-system-state 'previewing) + (if vm-real-buffers + (vm-make-virtual-copy (car vm-message-pointer))) + + ;; run the message select hooks. + (save-excursion + (vm-select-folder-buffer) + (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook) + (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer)) + (vm-run-message-hook (car vm-message-pointer) + 'vm-select-new-message-hook)) + (and vm-select-unread-message-hook + (vm-unread-flag (car vm-message-pointer)) + (vm-run-message-hook (car vm-message-pointer) + 'vm-select-unread-message-hook))) - ;; display xfaces, if we can - (if (and vm-display-xfaces - (vm-xemacs-p) - (vm-multiple-frames-possible-p) - (featurep 'xface)) - (save-restriction - (widen) - (narrow-to-region (vm-headers-of (car vm-message-pointer)) - (vm-text-of (car vm-message-pointer))) - (vm-display-xface))) + (vm-narrow-for-preview) + (if (or vm-mime-display-function + (and vm-display-using-mime + (not (vm-mime-plain-message-p (car vm-message-pointer))))) + (let ((layout (vm-mm-layout (car vm-message-pointer)))) + (vm-make-presentation-copy (car vm-message-pointer)) + (vm-save-buffer-excursion + (vm-replace-buffer-in-windows (current-buffer) + vm-presentation-buffer)) + (set-buffer vm-presentation-buffer) + (setq vm-system-state 'previewing) + (vm-narrow-for-preview)) + (setq vm-presentation-buffer nil) + (and vm-presentation-buffer-handle + (vm-replace-buffer-in-windows vm-presentation-buffer-handle + (current-buffer)))) - (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook) - (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer)) - (vm-run-message-hook (car vm-message-pointer) - 'vm-select-new-message-hook)) - (and vm-select-unread-message-hook (vm-unread-flag (car vm-message-pointer)) - (vm-run-message-hook (car vm-message-pointer) - 'vm-select-unread-message-hook)) + ;; at this point the current buffer is the presentation buffer + ;; if we're using one for this message. + + (vm-energize-urls-in-message-region) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces) - (if vm-honor-page-delimiters - (vm-narrow-to-page)) - (goto-char (vm-text-of (car vm-message-pointer))) - ;; If we have a window, set window start appropriately. - (let ((w (vm-get-visible-buffer-window (current-buffer)))) - (if w - (progn (set-window-start w (point-min)) - (set-window-point w (vm-text-of (car vm-message-pointer)))))) - (if (or (null vm-preview-lines) - (and (not vm-preview-read-messages) - (not (vm-new-flag (car vm-message-pointer))) - (not (vm-unread-flag (car vm-message-pointer))))) - (vm-show-current-message) - (vm-update-summary-and-mode-line))) + (if vm-honor-page-delimiters + (vm-narrow-to-page)) + (goto-char (vm-text-of (car vm-message-pointer))) + ;; If we have a window, set window start appropriately. + (let ((w (vm-get-visible-buffer-window (current-buffer)))) + (if w + (progn (set-window-start w (point-min)) + (set-window-point w (vm-text-of (car vm-message-pointer)))))) + (if (or (null vm-preview-lines) + (and (not vm-preview-read-messages) + (not (vm-new-flag (car vm-message-pointer))) + (not (vm-unread-flag (car vm-message-pointer))))) + (vm-show-current-message) + (vm-update-summary-and-mode-line)))) (defun vm-show-current-message () - (save-excursion - (save-excursion - (goto-char (point-min)) - (widen) - (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer)))) - (if vm-honor-page-delimiters - (progn - (if (looking-at page-delimiter) - (forward-page 1)) - (vm-narrow-to-page)))) - ;; don't mark the message as read if the user can't see it! - (if (vm-get-visible-buffer-window (current-buffer)) - (progn - (setq vm-system-state 'showing) - (cond ((vm-new-flag (car vm-message-pointer)) - (vm-set-new-flag (car vm-message-pointer) nil))) - (cond ((vm-unread-flag (car vm-message-pointer)) - (vm-set-unread-flag (car vm-message-pointer) nil))) - (vm-update-summary-and-mode-line) - (vm-howl-if-eom)) - (vm-update-summary-and-mode-line))) + (and vm-display-using-mime + vm-auto-decode-mime-messages + (not vm-mime-decoded) + (not (vm-mime-plain-message-p (car vm-message-pointer))) + (vm-decode-mime-message)) + (vm-save-buffer-excursion + (save-excursion + (save-excursion + (goto-char (point-min)) + (widen) + (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer)))) + (if vm-honor-page-delimiters + (progn + (if (looking-at page-delimiter) + (forward-page 1)) + (vm-narrow-to-page)))) + ;; don't mark the message as read if the user can't see it! + (if (vm-get-visible-buffer-window (current-buffer)) + (progn + (save-excursion + (setq vm-system-state 'showing) + (if vm-mail-buffer + (vm-set-buffer-variable vm-mail-buffer 'vm-system-state + 'showing)) + ;; We could be in the presentation buffer here. Since + ;; the presentation buffer's message pointer and sole + ;; message are a mockup, they will cause trouble if + ;; passed into the undo/update system. So we switch + ;; into the real message buffer to do attribute + ;; updates. + (vm-select-folder-buffer) + (cond ((vm-new-flag (car vm-message-pointer)) + (vm-set-new-flag (car vm-message-pointer) nil))) + (cond ((vm-unread-flag (car vm-message-pointer)) + (vm-set-unread-flag (car vm-message-pointer) nil)))) + (vm-update-summary-and-mode-line) + (vm-howl-if-eom)) + (vm-update-summary-and-mode-line)))) (defun vm-expose-hidden-headers () "Toggle exposing and hiding message headers that are normally not visible." @@ -512,7 +594,10 @@ (vm-follow-summary-cursor) (vm-select-folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-error-if-folder-empty) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) (vm-display (current-buffer) t '(vm-expose-hidden-headers) '(vm-expose-hidden-headers reading-message)) (let* ((exposed (= (point-min) (vm-start-of (car vm-message-pointer))))) @@ -561,7 +646,10 @@ (vm-follow-summary-cursor) (vm-select-folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-error-if-folder-empty) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) (vm-widen-page) (push-mark) (vm-display (current-buffer) t '(vm-beginning-of-message) @@ -583,7 +671,10 @@ (vm-follow-summary-cursor) (vm-select-folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) (vm-error-if-folder-empty) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) (if (eq vm-system-state 'previewing) (vm-show-current-message)) (setq vm-system-state 'reading)
--- a/lisp/vm/vm-pop.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-pop.el Mon Aug 13 08:50:05 2007 +0200 @@ -235,7 +235,13 @@ (vm-convert-folder-type-headers nil vm-folder-type) (goto-char end) (insert-before-markers (vm-trailing-message-separator)))) - (write-region start end crash t 0) + ;; Set file type to binary for DOS/Windows. I don't know if + ;; this is correct to do or not; it depends on whether the + ;; the CRLF or the LF newline convention is used on the inbox + ;; associated with this crashbox. This setting assumes the LF + ;; newline convention is used. + (let ((buffer-file-type t)) + (write-region start end crash t 0)) (delete-region start end) t )) @@ -262,7 +268,7 @@ (insert string) (call-process-region (point-min) (point-max) "/bin/sh" t buffer nil - "-c" vm-pop-md5-program) + shell-command-switch vm-pop-md5-program) ;; MD5 digest is 32 chars long ;; mddriver adds a newline to make neaten output for tty ;; viewing, make sure we leave it behind.
--- a/lisp/vm/vm-reply.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-reply.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Mailing, forwarding, and replying commands for VM -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -29,11 +29,12 @@ ((eq mlist mp) (cond ((setq to (let ((reply-to - (vm-get-header-contents (car mp) "Reply-To:"))) + (vm-get-header-contents (car mp) "Reply-To:" + ", "))) (if (vm-ignored-reply-to reply-to) nil reply-to )))) - ((setq to (vm-get-header-contents (car mp) "From:"))) + ((setq to (vm-get-header-contents (car mp) "From:" ", "))) ;; bad, but better than nothing for some ((setq to (vm-grok-From_-author (car mp)))) (t (error "No From: or Reply-To: header in message"))) @@ -51,9 +52,11 @@ subject) 0))) (setq subject (concat vm-reply-subject-prefix subject)))) - (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:")) + (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:" + ", ")) (setq to (concat to "," tmp))) - ((setq tmp (vm-get-header-contents (car mp) "From:")) + ((setq tmp (vm-get-header-contents (car mp) "From:" + ", ")) (setq to (concat to "," tmp))) ;; bad, but better than nothing for some ((setq tmp (vm-grok-From_-author (car mp))) @@ -61,8 +64,10 @@ (t (error "No From: or Reply-To: header in message"))))) (if to-all (progn - (setq tmp (vm-get-header-contents (car mp) "To:")) - (setq tmp2 (vm-get-header-contents (car mp) "Cc:")) + (setq tmp (vm-get-header-contents (car mp) "To:" + ", ")) + (setq tmp2 (vm-get-header-contents (car mp) "Cc:" + ", ")) (if tmp (if cc (setq cc (concat cc "," tmp)) @@ -72,13 +77,14 @@ (setq cc (concat cc "," tmp2)) (setq cc tmp2))))) (setq references - (cons (vm-get-header-contents (car mp) "References:") - (cons (vm-get-header-contents (car mp) "In-reply-to:") - (cons (vm-get-header-contents (car mp) "Message-ID:") + (cons (vm-get-header-contents (car mp) "References:" " ") + (cons (vm-get-header-contents (car mp) "In-reply-to:" " ") + (cons (vm-get-header-contents (car mp) "Message-ID:" + " ") references)))) (setq newsgroups - (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To:")) - (vm-get-header-contents (car mp) "Newsgroups:")) + (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To:" ",")) + (vm-get-header-contents (car mp) "Newsgroups:" ",")) newsgroups)) (setq mp (cdr mp))) (if vm-strip-reply-headers @@ -192,6 +198,8 @@ (setq newbuf (current-buffer)) (if (not (eq major-mode 'vm-mode)) (vm-mode)) + (if vm-presentation-buffer-handle + (vm-bury-buffer vm-presentation-buffer-handle)) (if (null vm-message-pointer) (error "No messages in folder %s" folder)) (setq default (vm-number-of (car vm-message-pointer))) @@ -275,12 +283,34 @@ (save-restriction (widen) (save-excursion - (set-buffer (vm-buffer-of message)) - (save-restriction - (widen) - (append-to-buffer b (vm-headers-of message) (vm-text-end-of message)) - (setq end (vm-marker (+ start (- (vm-text-end-of message) - (vm-headers-of message))) b)))) + (if (vectorp (vm-mm-layout message)) + (let* ((o (vm-mm-layout message)) + (type (car (vm-mm-layout-type o))) + parts) + (vm-insert-region-from-buffer (vm-buffer-of message) + (vm-headers-of message) + (vm-text-of message)) + (cond ((vm-mime-types-match "multipart" type) + (setq parts (vm-mm-layout-parts o))) + (t (setq parts (list o)))) + (while parts + (cond ((vm-mime-text-type-p (car parts)) + (if (vm-mime-display-internal-text/plain (car parts) t) + nil + ;; charset problems probably + ;; just dump the raw bits + (vm-mime-insert-mime-body (car parts)) + (vm-mime-transfer-decode-region (car parts) + start (point))))) + (setq parts (cdr parts))) + (setq end (point-marker))) + (set-buffer (vm-buffer-of message)) + (save-restriction + (widen) + (append-to-buffer b (vm-headers-of message) + (vm-text-end-of message)) + (setq end (vm-marker (+ start (- (vm-text-end-of message) + (vm-headers-of message))) b))))) (push-mark end) (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) (mail-yank-hooks (run-hooks 'mail-yank-hooks)) @@ -290,11 +320,14 @@ "Just like mail-send-and-exit except that VM flags the appropriate message(s) as having been replied to, if appropriate." (interactive "P") + (vm-check-for-killed-folder) (let ((b (current-buffer))) (vm-mail-send) (cond ((null (buffer-name b)) ;; dead buffer (vm-display nil nil '(vm-mail-send-and-exit) - '(vm-mail-send-and-exit reading-message startup))) + '(vm-mail-send-and-exit + reading-message + startup))) (t (vm-display b nil '(vm-mail-send-and-exit) '(vm-mail-send-and-exit reading-message startup)) @@ -337,27 +370,78 @@ (interactive) (if vm-tale-is-an-idiot (vm-help-tale)) - (if (and vm-confirm-mail-send - (not (y-or-n-p "Send the message? "))) - (error "Message not sent.")) + ;; protect value of this-command from minibuffer read + (let ((this-command this-command)) + (if (and vm-confirm-mail-send + (not (y-or-n-p "Send the message? "))) + (error "Message not sent."))) + ;; send mail using MIME if user requests it and if the buffer + ;; has not already been MIME encoded. + (if (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:"))) + (vm-mime-encode-composition)) ;; this to prevent Emacs 19 from asking whether a message that ;; has already been sent should be sent again. VM renames mail ;; buffers after the message has been sent, so the user should ;; already know that the message has been sent. (set-buffer-modified-p t) - ;; don't want a buffer change to occur here - ;; save-excursion to be sure. - (save-excursion - (mail-send)) - (vm-rename-current-mail-buffer) - (cond ((eq vm-system-state 'replying) - (vm-mail-mark-replied)) - ((eq vm-system-state 'forwarding) - (vm-mail-mark-forwarded)) - ((eq vm-system-state 'redistributing) - (vm-mail-mark-redistributed))) - (vm-keep-mail-buffer (current-buffer)) - (vm-display nil nil '(vm-mail-send) '(vm-mail-send))) + (let ((composition-buffer (current-buffer)) + ;; preserve these in case the composition buffer gets + ;; killed. + (vm-reply-list vm-reply-list) + (vm-forward-list vm-forward-list) + (vm-redistribute-list vm-redistribute-list)) + ;; fragment message using message/partial if it is too big. + (if (and vm-send-using-mime + (integerp vm-mime-max-message-size) + (> (buffer-size) vm-mime-max-message-size)) + (let (list) + (setq list (vm-mime-fragment-composition vm-mime-max-message-size)) + (while list + (save-excursion + (set-buffer (car list)) + (vm-mail-send) + (kill-buffer (car list))) + (setq list (cdr list))) + ;; what mail-send would have done + (set-buffer-modified-p nil)) + ;; don't want a buffer change to occur here + ;; save-excursion to be sure. + ;; + ;; also protect value of this-command from minibuffer reads + (let ((this-command this-command)) + (save-excursion + (mail-send)))) + (cond ((eq vm-system-state 'replying) + (vm-mail-mark-replied)) + ((eq vm-system-state 'forwarding) + (vm-mail-mark-forwarded)) + ((eq vm-system-state 'redistributing) + (vm-mail-mark-redistributed))) + ;; be careful, something could have killed the composition + ;; buffer inside mail-send. + (if (eq (current-buffer) composition-buffer) + (progn + (vm-rename-current-mail-buffer) + (vm-keep-mail-buffer (current-buffer)))) + (vm-display nil nil '(vm-mail-send) '(vm-mail-send)))) + +(defun vm-mail-mode-get-header-contents (header-name-regexp) + (let ((contents nil) + regexp) + (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^" + (regexp-quote mail-header-separator) "$\\)")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (and (re-search-forward regexp nil t) + (match-beginning 1) + (progn (goto-char (match-beginning 0)) + (vm-match-header))) + (vm-matched-header-contents) + nil )))))) (defun vm-rename-current-mail-buffer () (if vm-rename-current-buffer-function @@ -503,6 +587,10 @@ (setq this-command 'vm-next-command-uses-marks) (command-execute 'vm-send-digest)) (let ((dir default-directory) + (miming (and vm-send-using-mime + (equal vm-forwarding-digest-type "mime"))) + mail-buffer + header-end boundary (mp vm-message-pointer)) (save-restriction (widen) @@ -518,10 +606,33 @@ (setq vm-system-state 'forwarding vm-forward-list (list (car mp)) default-directory dir) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil 0) - (cond ((equal vm-forwarding-digest-type "rfc934") + (if miming + (progn + (setq mail-buffer (current-buffer)) + (set-buffer (generate-new-buffer "*vm-forward-buffer*")) + (setq header-end (point)) + (insert "\n")) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) + "\n")) + (goto-char (match-end 0)) + (setq header-end (match-beginning 0))) + (cond ((equal vm-forwarding-digest-type "mime") + (setq boundary (vm-mime-encapsulate-messages + (list (car mp)) vm-forwarded-headers + vm-unforwarded-header-regexp)) + (goto-char header-end) + (insert "MIME-Version: 1.0\n") + (insert (if vm-mime-avoid-folding-content-type + "Content-Type: multipart/digest; boundary=\"" + "Content-Type: multipart/digest;\n\tboundary=\"") + boundary "\"\n") + (insert "Content-Transfer-Encoding: " + (vm-determine-proper-content-transfer-encoding + (point) + (point-max)) + "\n")) + ((equal vm-forwarding-digest-type "rfc934") (vm-rfc934-encapsulate-messages vm-forward-list vm-forwarded-headers vm-unforwarded-header-regexp)) @@ -533,6 +644,17 @@ (vm-no-frills-encapsulate-message (car vm-forward-list) vm-forwarded-headers vm-unforwarded-header-regexp))) + (if miming + (let ((b (current-buffer))) + (set-buffer mail-buffer) + (mail-text) + (vm-mime-attach-object b "multipart/digest" + (list (concat "boundary=\"" + boundary "\"")) t) + (add-hook 'kill-buffer-hook + (list 'lambda () + (list 'if (list 'eq mail-buffer '(current-buffer)) + (list 'kill-buffer b)))))) (mail-position-on-field "To")) (run-hooks 'vm-forward-message-hook) (run-hooks 'vm-mail-mode-hook)))) @@ -548,20 +670,25 @@ (vm-error-if-folder-empty) (let ((b (current-buffer)) start (dir default-directory) + (layout (vm-mm-layout (car vm-message-pointer))) (lim (vm-text-end-of (car vm-message-pointer)))) (save-restriction (widen) - (save-excursion - (goto-char (vm-text-of (car vm-message-pointer))) - (let ((case-fold-search t)) - ;; What a wonderful world it would be if mailers used a single - ;; message encapsulation standard instead all the weird variants - ;; It is useless to try to cover them all. - ;; This simple rule should cover the sanest of the formats - (if (not (re-search-forward "^Received:" lim t)) - (error "This doesn't look like a bounced message.")) - (beginning-of-line) - (setq start (point)))) + (if (or (not (vectorp layout)) + (not (setq layout (vm-mime-layout-contains-type + layout "message/rfc822")))) + (save-excursion + (goto-char (vm-text-of (car vm-message-pointer))) + (let ((case-fold-search t)) + ;; What a wonderful world it would be if mailers + ;; used a single message encapsulation standard + ;; instead of all the weird variants. It is + ;; useless to try to cover them all. This simple + ;; rule should cover the sanest of the formats + (if (not (re-search-forward "^Received:" lim t)) + (error "This doesn't look like a bounced message.")) + (beginning-of-line) + (setq start (point))))) ;; briefly nullify vm-mail-header-from to keep vm-mail-internal ;; from inserting another From header. (let ((vm-mail-header-from nil)) @@ -569,7 +696,12 @@ (format "retry of bounce from %s" (vm-su-from (car vm-message-pointer))))) (goto-char (point-min)) - (insert-buffer-substring b start lim) + (if (vectorp layout) + (progn + (setq start (point)) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout start (point))) + (insert-buffer-substring b start lim)) (delete-region (point) (point-max)) (goto-char (point-min)) ;; delete all but pertinent headers @@ -658,13 +790,14 @@ (vm-check-for-killed-summary) (vm-error-if-folder-empty) (let ((dir default-directory) - (mp vm-message-pointer) + (miming (and vm-send-using-mime (equal vm-digest-send-type "mime"))) + mp mail-buffer b ;; prefix arg doesn't have "normal" meaning here, so only call ;; vm-select-marked-or-prefixed-messages if we're using marks. (mlist (if (eq last-command 'vm-next-command-uses-marks) (vm-select-marked-or-prefixed-messages 0) vm-message-list)) - start) + start header-end boundary) (save-restriction (widen) (vm-mail-internal (format "digest from %s" (buffer-name))) @@ -672,14 +805,36 @@ (setq vm-system-state 'forwarding vm-forward-list mlist default-directory dir) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) - "\n")) - (goto-char (match-end 0)) - (setq start (point) - mp mlist) + (if miming + (progn + (setq mail-buffer (current-buffer)) + (set-buffer (generate-new-buffer "*vm-digest-buffer*")) + (setq header-end (point)) + (insert "\n") + (setq start (point-marker))) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) + "\n")) + (goto-char (match-end 0)) + (setq start (point-marker) + header-end (match-beginning 0))) (vm-unsaved-message "Building %s digest..." vm-digest-send-type) - (cond ((equal vm-digest-send-type "rfc934") + (cond ((equal vm-digest-send-type "mime") + (setq boundary (vm-mime-encapsulate-messages + mlist vm-mime-digest-headers + vm-mime-digest-discard-header-regexp)) + (goto-char header-end) + (insert "MIME-Version: 1.0\n") + (insert (if vm-mime-avoid-folding-content-type + "Content-Type: multipart/digest; boundary=\"" + "Content-Type: multipart/digest;\n\tboundary=\"") + boundary "\"\n") + (insert "Content-Transfer-Encoding: " + (vm-determine-proper-content-transfer-encoding + (point) + (point-max)) + "\n")) + ((equal vm-digest-send-type "rfc934") (vm-rfc934-encapsulate-messages mlist vm-rfc934-digest-headers vm-rfc934-digest-discard-header-regexp)) @@ -701,6 +856,17 @@ (center-line) (forward-char 1))) (setq mp (cdr mp))))) + (if miming + (let ((b (current-buffer))) + (set-buffer mail-buffer) + (mail-text) + (vm-mime-attach-object b "multipart/digest" + (list (concat "boundary=\"" + boundary "\"")) t) + (add-hook 'kill-buffer-hook + (list 'lambda () + (list 'if (list 'eq mail-buffer '(current-buffer)) + (list 'kill-buffer b)))))) (mail-position-on-field "To") (message "Building %s digest... done" vm-digest-send-type))) (run-hooks 'vm-send-digest-hook) @@ -718,6 +884,12 @@ (let ((vm-digest-send-type "rfc1153")) (vm-send-digest preamble))) +(defun vm-send-mime-digest (&optional preamble) + "Like vm-send-digest but always sends an MIME (multipart/digest) digest." + (interactive "P") + (let ((vm-digest-send-type "mime")) + (vm-send-digest preamble))) + (defun vm-continue-composing-message (&optional not-picky) "Find and select the most recently used mail composition buffer. If the selected buffer is already a Mail mode buffer then it is @@ -753,6 +925,14 @@ '(vm-continue-composing-message composing-message))) (message "No composition buffers found")))) +(defun vm-mail-to-mailto-url (url) + (let ((address (car (vm-parse url "^mailto:\\(.+\\)")))) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-mail-internal nil address) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook))) + ;; to quiet the v19 byte compiler (defvar mail-mode-map) (defvar mail-aliases) @@ -780,7 +960,7 @@ (nconc vm-mail-mode-map mail-mode-map) (setq vm-mail-mode-map-parented t)))) (setq vm-mail-buffer folder-buffer - mode-popup-menu (and vm-use-menus + mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3 (vm-menu-support-possible-p) (vm-menu-mode-menu))) ;; sets up popup menu for FSF Emacs @@ -852,6 +1032,8 @@ vm-send-rfc934-digest-other-frame vm-send-rfc1153-digest vm-send-rfc1153-digest-other-frame + vm-send-mime-digest + vm-send-mime-digest-other-frame vm-forward-message vm-forward-message-other-frame vm-forward-message-all-headers @@ -985,3 +1167,14 @@ (vm-send-rfc1153-digest prefix)) (if (vm-multiple-frames-possible-p) (vm-set-hooks-for-frame-deletion))) + +(defun vm-send-mime-digest-other-frame (&optional prefix) + "Like vm-send-mime-digest, but run in a newly created frame." + (interactive "P") + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-send-mime-digest prefix)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion)))
--- a/lisp/vm/vm-save.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 08:50:05 2007 +0200 @@ -142,7 +142,7 @@ (intern (buffer-name) vm-buffers-needing-display-update) (vm-update-summary-and-mode-line)) (if (zerop archived) - (message "No messages archived") + (message "No messages were archived") (message "%d message%s archived" archived (if (= 1 archived) "" "s"))))) @@ -486,7 +486,7 @@ (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))) (call-process-region (point-min) (point-max) (or shell-file-name "sh") - nil buffer nil "-c" command))) + nil buffer nil shell-command-switch command))) (setq mlist (cdr mlist))) (set-buffer buffer) (if (not (zerop (buffer-size)))
--- a/lisp/vm/vm-search.el Mon Aug 13 08:49:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -;;; Incremental search through a mail folder (for Lucid and FSF Emacs 19) -;;; Copyright (C) 1994 Kyle E. Jones -;;; -;;; 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 1, 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., 675 Mass Ave, Cambridge, MA 02139, USA. - -(provide 'vm-search) - -(defun vm-isearch-forward (&optional arg) - "Incrementally search forward through the current folder's messages. -Usage is identical to the standard Emacs incremental search. -When the search terminates the message containing point will be selected. - -If the variable vm-search-using-regexps is non-nil, regular expressions -are understood; nil means the search will be for the input string taken -literally. Specifying a prefix ARG interactively toggles the value of -vm-search-using-regexps for this search." - (interactive "P") - (let ((vm-search-using-regexps - (if arg (not vm-search-using-regexps) vm-search-using-regexps))) - (vm-isearch t))) - -(defun vm-isearch-backward (&optional arg) - "Incrementally search backward through the current folder's messages. -Usage is identical to the standard Emacs incremental search. -When the search terminates the message containing point will be selected. - -If the variable vm-search-using-regexps is non-nil, regular expressions -are understood; nil means the search will be for the input string taken -literally. Specifying a prefix ARG interactively toggles the value of -vm-search-using-regexps for this search." - (interactive "P") - (let ((vm-search-using-regexps - (if arg (not vm-search-using-regexps) vm-search-using-regexps))) - (vm-isearch nil))) - -(defun vm-isearch (forward) - (vm-follow-summary-cursor) - (vm-select-folder-buffer) - (vm-check-for-killed-summary) - (vm-error-if-folder-empty) - (vm-error-if-virtual-folder) - (vm-display (current-buffer) t '(vm-isearch-forward vm-isearch-backward) - (list this-command 'searching-message)) - (let ((clip-head (point-min)) - (clip-tail (point-max)) - (old-vm-message-pointer vm-message-pointer)) - (unwind-protect - (progn (select-window (vm-get-visible-buffer-window (current-buffer))) - (widen) - (add-hook 'pre-command-hook 'vm-isearch-widen) - ;; order is significant, we want to narrow after - ;; the update - (add-hook 'post-command-hook 'vm-isearch-narrow) - (add-hook 'post-command-hook 'vm-isearch-update) - (isearch-mode forward vm-search-using-regexps nil t) - (vm-isearch-update) - (if (not (eq vm-message-pointer old-vm-message-pointer)) - (progn - (vm-record-and-change-message-pointer - old-vm-message-pointer vm-message-pointer) - (vm-update-summary-and-mode-line) - ;; vm-show-current-message only adjusts (point-max), - ;; it doesn't change (point-min). - (widen) - (narrow-to-region - (if (< (point) (vm-vheaders-of (car vm-message-pointer))) - (vm-start-of (car vm-message-pointer)) - (vm-vheaders-of (car vm-message-pointer))) - (vm-text-end-of (car vm-message-pointer))) - (vm-display nil nil - '(vm-isearch-forward vm-isearch-backward) - '(reading-message)) - ;; turn the unwinds into a noop - (setq old-vm-message-pointer vm-message-pointer) - (setq clip-head (point-min)) - (setq clip-tail (point-max))))) - (remove-hook 'pre-command-hook 'vm-isearch-widen) - (remove-hook 'post-command-hook 'vm-isearch-update) - (remove-hook 'post-command-hook 'vm-isearch-narrow) - (narrow-to-region clip-head clip-tail) - (setq vm-message-pointer old-vm-message-pointer)))) - -(defun vm-isearch-widen () - (if (eq major-mode 'vm-mode) - (widen))) - -(defun vm-isearch-narrow () - (if (eq major-mode 'vm-mode) - (narrow-to-region - (if (< (point) (vm-vheaders-of (car vm-message-pointer))) - (vm-start-of (car vm-message-pointer)) - (vm-vheaders-of (car vm-message-pointer))) - (vm-text-end-of (car vm-message-pointer))))) - -(defun vm-isearch-update () - (if (eq major-mode 'vm-mode) - (if (and (>= (point) (vm-start-of (car vm-message-pointer))) - (<= (point) (vm-end-of (car vm-message-pointer)))) - nil - (let ((mp vm-message-list) - (point (point))) - (while mp - (if (and (>= point (vm-start-of (car mp))) - (<= point (vm-end-of (car mp)))) - (setq vm-message-pointer mp mp nil) - (setq mp (cdr mp)))) - (setq vm-need-summary-pointer-update t) - (intern (buffer-name) vm-buffers-needing-display-update) - (vm-update-summary-and-mode-line)))))
--- a/lisp/vm/vm-startup.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-startup.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Entry points for VM -;;; Copyright (C) 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1994-1997 Kyle E. Jones ;;; ;;; 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 @@ -72,6 +72,7 @@ (vm-unsaved-message "Reading %s... done" file)))))))) (set-buffer folder-buffer) (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) ;; If the buffer's not modified then we know that there can be no ;; messages in the folder that are not on disk. (or (buffer-modified-p) (setq vm-messages-not-on-disk 0)) @@ -85,7 +86,7 @@ ;; save file contains information the user might not ;; want overwritten, i.e. recover-file might be ;; desired. What we want to avoid is an auto-save. - ;; Making the folder read only will keep it + ;; Making the folder read only will keep ;; subsequent actions from modifying the buffer in a ;; way that triggers an auto save. ;; @@ -120,26 +121,20 @@ ;; make a new frame if the user wants one. reuse an ;; existing frame that is showing this folder. (if (and full-startup - vm-frame-per-folder - (vm-multiple-frames-possible-p) ;; this so that "emacs -f vm" doesn't create a frame. this-command) - (let ((w (or (vm-get-buffer-window (current-buffer)) - ;; summary == folder for the purpose - ;; of frame reuse. - (and vm-summary-buffer - (vm-get-buffer-window vm-summary-buffer))))) - (if (null w) - (progn - (if folder - (vm-goto-new-frame 'folder) - (vm-goto-new-frame 'primary-folder 'folder)) - (vm-set-hooks-for-frame-deletion)) - (save-excursion - (select-window w) - (and vm-warp-mouse-to-new-frame - (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))) - + (apply 'vm-goto-new-folder-frame-maybe + (if folder '(folder) '(primary-folder folder)))) + + ;; raise frame if requested and apply startup window + ;; configuration. + (if full-startup + (progn + (if vm-raise-frame-at-startup + (vm-raise-frame)) + (vm-display nil nil (list this-command) + (list (or this-command 'vm) 'startup)))) + ;; say this NOW, before the non-previewers read a message, ;; alter the new message count and confuse themselves. (if full-startup @@ -150,8 +145,6 @@ (if vm-message-list (vm-preview-current-message) (vm-update-summary-and-mode-line)) - (if full-startup - (vm-display (current-buffer) t nil nil)) ;; need to do this after any frame creation because the ;; toolbar sets frame-specific height and width specifiers. (and (vm-toolbar-support-possible-p) vm-use-toolbar @@ -163,23 +156,29 @@ (vm-menu-install-visited-folders-menu)) (if full-startup - (save-excursion - (vm-display (current-buffer) t nil nil) - (if (and (vm-should-generate-summary) + (progn + (if (and (vm-should-generate-summary) ;; don't generate a summary if recover-file is ;; likely to happen, since recover-file does ;; nothing useful in a summary buffer. (not preserve-auto-save-file)) - (vm-summarize t)) - ;; People were confused that (vm) behaved differently - ;; than M-x vm. We used to list all the various VM - ;; startup commands here, but now we just accept any - ;; command and treat it as if it were VM. It's - ;; probably just as well, since any command that - ;; calls VM probably does want the window - ;; configuration to be setup. - (vm-display nil nil (list this-command) - (list (or this-command 'vm) 'startup)))) + (vm-summarize t nil)) + ;; raise the summary frame if the user wants frames + ;; raised and if there is a summary frame. + (if (and vm-summary-buffer + vm-frame-per-summary + vm-raise-frame-at-startup) + (vm-raise-frame)) + ;; if vm-mutable-windows is nil, the startup + ;; configuration can't be applied, so do + ;; something to get a VM buffer on the screen + (if vm-mutable-windows + (vm-display nil nil (list this-command) + (list (or this-command 'vm) 'startup)) + (save-excursion + (switch-to-buffer (or vm-summary-buffer + vm-presentation-buffer + (current-buffer))))))) (run-hooks 'vm-visit-folder-hook) @@ -213,8 +212,7 @@ ;; user says no. ;; Check this-command so we don't make the user wait if ;; they call vm non-interactively from some other program. - (if (and (not vm-inhibit-startup-message) - (not vm-startup-message-displayed) + (if (and (not vm-startup-message-displayed) (or (memq this-command '(vm vm-visit-folder)) ;; for emacs -f vm (null last-command))) @@ -253,7 +251,7 @@ (defun vm-mode (&optional read-only) "Major mode for reading mail. -This is VM 5.96 (beta). +This is VM 6.13. Commands: h - summarize folder contents @@ -293,7 +291,7 @@ @ - digestify and mail entire folder contents (the folder is not modified) * - burst a digest into individual messages, and append and assimilate these - message into the current folder. + messages into the current folder. G - sort messages by various keys @@ -322,14 +320,16 @@ M U - unmark the current message M m - mark all messages M u - unmark all messages - M C - mark messages matches by a virtual folder selector - M c - unmark messages matches by a virtual folder selector + M C - mark messages matched by a virtual folder selector + M c - unmark messages matched by a virtual folder selector M T - mark thread tree rooted at the current message M t - unmark thread tree rooted at the current message M S - mark messages with the same subject as the current message M s - unmark messages with the same subject as the current message M A - mark messages with the same author as the current message M a - unmark messages with the same author as the current message + M R - mark messages within the point/mark region in the summary + M r - unmark messages within the point/mark region in the summary M ? - partial help for mark commands @@ -376,17 +376,21 @@ vm-arrived-message-hook vm-arrived-messages-hook vm-auto-center-summary + vm-auto-decode-mime-messages + vm-auto-displayed-mime-content-types vm-auto-folder-alist vm-auto-folder-case-fold-search vm-auto-get-new-mail vm-auto-next-message vm-berkeley-mail-compatibility + vm-burst-digest-messages-inherit-labels vm-check-folder-types - vm-convert-folder-types vm-circular-folders vm-confirm-new-folders vm-confirm-quit + vm-convert-folder-types vm-crash-box + vm-crash-box-suffix vm-default-folder-type vm-delete-after-archiving vm-delete-after-bursting @@ -397,6 +401,7 @@ vm-digest-preamble-format vm-digest-send-type vm-display-buffer-hook + vm-display-using-mime vm-edit-message-hook vm-folder-directory vm-folder-read-only @@ -406,8 +411,11 @@ vm-forwarding-digest-type vm-forwarding-subject-format vm-frame-parameter-alist + vm-frame-per-completion vm-frame-per-composition + vm-frame-per-edit vm-frame-per-folder + vm-frame-per-summary vm-highlighted-header-face vm-highlighted-header-regexp vm-honor-page-delimiters @@ -416,32 +424,52 @@ vm-included-text-discard-header-regexp vm-included-text-headers vm-included-text-prefix - vm-inhibit-startup-message vm-invisible-header-regexp vm-jump-to-new-messages vm-jump-to-unread-messages + vm-keep-crash-boxes vm-keep-sent-messages - vm-keep-crash-boxes vm-mail-header-from vm-mail-mode-hook + vm-make-crash-box-name + vm-make-spool-file-name + vm-mime-8bit-composition-charset + vm-mime-8bit-text-transfer-encoding + vm-mime-alternative-select-method + vm-mime-attachment-auto-type-alist + vm-mime-attachment-save-directory + vm-mime-avoid-folding-content-type + vm-mime-base64-decoder-program + vm-mime-base64-decoder-switches + vm-mime-base64-encoder-program + vm-mime-base64-encoder-switches + vm-mime-button-face + vm-mime-digest-discard-header-regexp + vm-mime-digest-headers + vm-mime-display-function + vm-mime-external-content-types-alist + vm-mime-internal-content-types + vm-mime-max-message-size vm-mode-hook vm-mosaic-program vm-move-after-deleting + vm-move-after-killing vm-move-after-undeleting vm-move-messages-physically + vm-mutable-frames vm-mutable-windows - vm-mutable-frames vm-netscape-program - vm-options-file vm-pop-md5-program + vm-popup-menu-on-mouse-3 + vm-preferences-file vm-preview-lines vm-preview-read-messages vm-primary-inbox vm-quit-hook vm-recognize-pop-maildrops vm-reply-hook + vm-reply-ignored-addresses vm-reply-ignored-reply-tos - vm-reply-ignored-addresses vm-reply-subject-prefix vm-resend-bounced-discard-header-regexp vm-resend-bounced-headers @@ -459,9 +487,11 @@ vm-select-new-message-hook vm-select-unread-message-hook vm-send-digest-hook + vm-send-using-mime vm-skip-deleted-messages vm-skip-read-messages vm-spool-files + vm-spool-file-suffixes vm-startup-with-summary vm-strip-reply-headers vm-summary-arrow @@ -470,14 +500,16 @@ vm-summary-mode-hook vm-summary-redo-hook vm-summary-show-threads - vm-summary-subject-no-newlines vm-summary-thread-indent-level + vm-temp-file-directory + vm-tale-is-an-idiot vm-trust-From_-with-Content-Length vm-undisplay-buffer-hook vm-unforwarded-header-regexp vm-url-browser vm-url-search-limit vm-use-menus + vm-use-toolbar vm-virtual-folder-alist vm-virtual-mirror vm-visible-headers @@ -633,13 +665,15 @@ (use-local-map vm-mode-map) (and (vm-menu-support-possible-p) (vm-menu-install-menus)) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-folder) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-message) ;; save this for last in case the user interrupts. ;; an interrupt anywhere before this point will cause ;; everything to be redone next revisit. (setq major-mode 'vm-virtual-mode) (run-hooks 'vm-virtual-mode-hook) ;; must come after the setting of major-mode - (setq mode-popup-menu (and vm-use-menus + (setq mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3 (vm-menu-support-possible-p) (vm-menu-mode-menu))) (setq blurb (vm-emit-totals-blurb)) @@ -651,35 +685,37 @@ (message blurb))) ;; make a new frame if the user wants one. reuse an ;; existing frame that is showing this folder. - (if (and vm-frame-per-folder (vm-multiple-frames-possible-p)) - (let ((w (or (vm-get-buffer-window (current-buffer)) - ;; summary == folder for the purpose - ;; of frame reuse. - (and vm-summary-buffer - (vm-get-buffer-window (current-buffer)))))) - (if (null w) - (vm-goto-new-frame 'folder) - (save-excursion - (select-window w) - (and vm-warp-mouse-to-new-frame - (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))) - (vm-set-hooks-for-frame-deletion))) - (vm-display (current-buffer) t nil nil) + (vm-goto-new-folder-frame-maybe 'folder) + (if vm-raise-frame-at-startup + (vm-raise-frame)) + (vm-display nil nil (list this-command) (list this-command 'startup)) (and (vm-toolbar-support-possible-p) vm-use-toolbar (vm-toolbar-install-toolbar)) (if first-time - (if (vm-should-generate-summary) - (progn (vm-summarize t) - (message blurb)))) - (vm-display nil nil '(vm-visit-virtual-folder - vm-visit-virtual-folder-other-frame - vm-visit-virtual-folder-other-window - vm-create-virtual-folder - vm-apply-virtual-folder) - (list this-command 'startup)) + (progn + (if (vm-should-generate-summary) + (progn (vm-summarize t nil) + (message blurb))) + ;; raise the summary frame if the user wants frames + ;; raised and if there is a summary frame. + (if (and vm-summary-buffer + vm-frame-per-summary + vm-raise-frame-at-startup) + (vm-raise-frame)) + ;; if vm-mutable-windows is nil, the startup + ;; configuration can't be applied, so do + ;; something to get a VM buffer on the screen + (if vm-mutable-windows + (vm-display nil nil (list this-command) + (list (or this-command 'vm) 'startup)) + (save-excursion + (switch-to-buffer (or vm-summary-buffer + vm-presentation-buffer + (current-buffer))))))) + ;; check interactive-p so as not to bog the user down if they ;; run this function from within another function. - (and (interactive-p) (not vm-inhibit-startup-message) + (and (interactive-p) (not vm-startup-message-displayed) (vm-display-startup-message) (message blurb)))) @@ -768,6 +804,8 @@ 'vm-arrived-message-hook 'vm-arrived-messages-hook 'vm-auto-center-summary + 'vm-auto-decode-mime-messages + 'vm-auto-displayed-mime-content-types ;; don't send this by default, might be personal stuff in here. ;; 'vm-auto-folder-alist 'vm-auto-folder-case-fold-search @@ -780,6 +818,7 @@ 'vm-confirm-quit 'vm-convert-folder-types 'vm-crash-box + 'vm-crash-box-suffix 'vm-default-folder-type 'vm-delete-after-archiving 'vm-delete-after-bursting @@ -791,6 +830,7 @@ 'vm-digest-preamble-format 'vm-digest-send-type 'vm-display-buffer-hook + 'vm-display-using-mime 'vm-edit-message-hook 'vm-edit-message-mode 'vm-flush-interval @@ -802,8 +842,11 @@ 'vm-forwarding-digest-type 'vm-forwarding-subject-format 'vm-frame-parameter-alist + 'vm-frame-per-completion 'vm-frame-per-composition + 'vm-frame-per-edit 'vm-frame-per-folder + 'vm-frame-per-summary 'vm-highlight-url-face 'vm-highlighted-header-regexp 'vm-honor-page-delimiters @@ -812,7 +855,6 @@ 'vm-included-text-discard-header-regexp 'vm-included-text-headers 'vm-included-text-prefix - 'vm-inhibit-startup-message 'vm-init-file 'vm-invisible-header-regexp 'vm-jump-to-new-messages @@ -821,7 +863,26 @@ 'vm-keep-sent-messages 'vm-mail-header-from 'vm-mail-hook + 'vm-make-crash-box-name + 'vm-make-spool-file-name 'vm-mail-mode-hook + 'vm-mime-8bit-composition-charset + 'vm-mime-8bit-text-transfer-encoding + 'vm-mime-alternative-select-method + 'vm-mime-attachment-auto-type-alist + 'vm-mime-attachment-save-directory + 'vm-mime-avoid-folding-content-type + 'vm-mime-base64-decoder-program + 'vm-mime-base64-decoder-switches + 'vm-mime-base64-encoder-program + 'vm-mime-base64-encoder-switches + 'vm-mime-button-face + 'vm-mime-digest-discard-header-regexp + 'vm-mime-digest-headers + 'vm-mime-display-function + 'vm-mime-external-content-types-alist + 'vm-mime-internal-content-types + 'vm-mime-max-message-size 'vm-mode-hook 'vm-mode-hooks 'vm-mosaic-program @@ -832,8 +893,9 @@ 'vm-mutable-frames 'vm-mutable-windows 'vm-netscape-program - 'vm-options-file 'vm-pop-md5-program + 'vm-popup-menu-on-mouse-3 + 'vm-preferences-file 'vm-preview-lines 'vm-preview-read-messages 'vm-primary-inbox @@ -859,10 +921,12 @@ 'vm-select-new-message-hook 'vm-select-unread-message-hook 'vm-send-digest-hook + 'vm-send-using-mime 'vm-skip-deleted-messages 'vm-skip-read-messages ;; don't send vm-spool-files by default, might contain passwords ;; 'vm-spool-files + 'vm-spool-file-suffixes 'vm-startup-with-summary 'vm-strip-reply-headers 'vm-summary-format @@ -871,17 +935,18 @@ 'vm-summary-mode-hooks 'vm-summary-redo-hook 'vm-summary-show-threads - 'vm-summary-subject-no-newlines 'vm-summary-thread-indent-level 'vm-summary-uninteresting-senders 'vm-summary-uninteresting-senders-arrow 'vm-tale-is-an-idiot + 'vm-temp-file-directory 'vm-trust-From_-with-Content-Length 'vm-undisplay-buffer-hook 'vm-unforwarded-header-regexp 'vm-url-browser 'vm-url-search-limit 'vm-use-menus + 'vm-use-toolbar 'vm-virtual-folder-alist 'vm-virtual-mirror 'vm-visible-headers @@ -909,7 +974,22 @@ (setq vm-init-file-loaded t) (vm-display nil nil '(vm-load-init-file) '(vm-load-init-file))) +(defun vm-check-emacs-version () + (cond ((and (vm-xemacs-p) + (or (< emacs-major-version 19) + (and (= emacs-major-version 19) + (< emacs-minor-version 14)))) + (error "VM %s must be run on XEmacs 19.14 or a later version." + vm-version)) + ((and (vm-fsfemacs-19-p) + (or (< emacs-major-version 19) + (and (= emacs-major-version 19) + (< emacs-minor-version 34)))) + (error "VM %s must be run on Emacs 19.34 or a later version." + vm-version)))) + (defun vm-session-initialization () + (vm-check-emacs-version) ;; If this is the first time VM has been run in this Emacs session, ;; do some necessary preparations. (if (or (not (boundp 'vm-session-beginning))
--- a/lisp/vm/vm-summary.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-summary.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Summary gathering and formatting routines for VM -;;; Copyright (C) 1989, 1990, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1989-1995 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -22,7 +22,7 @@ major-mode 'vm-summary-mode mode-line-format vm-mode-line-format ;; must come after the setting of major-mode - mode-popup-menu (and vm-use-menus + mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3 (vm-menu-support-possible-p) (vm-menu-mode-menu)) buffer-read-only t @@ -38,7 +38,8 @@ (use-local-map vm-summary-mode-map) (and (vm-menu-support-possible-p) (vm-menu-install-menus)) - (and (vm-mouse-support-possible-p) + (and vm-mouse-track-summary + (vm-mouse-support-possible-p) (vm-mouse-xemacs-mouse-p) (add-hook 'mode-motion-hook 'mode-motion-highlight-line)) (if (or vm-frame-per-folder vm-frame-per-summary) @@ -50,12 +51,12 @@ (fset 'vm-summary-mode 'vm-mode) (put 'vm-summary-mode 'mode-class 'special) -(defun vm-summarize (&optional display) +(defun vm-summarize (&optional display raise) "Summarize the contents of the folder in a summary buffer. The format is as described by the variable vm-summary-format. Generally one line per message is most pleasing to the eye but this is not mandatory." - (interactive "p") + (interactive "p\np") (vm-select-folder-buffer) (vm-check-for-killed-summary) (if (null vm-summary-buffer) @@ -79,20 +80,11 @@ (vm-set-summary-redo-start-point t))) (if display (save-excursion - (if vm-frame-per-summary - (let ((w (vm-get-buffer-window vm-summary-buffer))) - (if (null w) - (progn - (vm-goto-new-frame 'summary) - (vm-set-hooks-for-frame-deletion)) - (save-excursion - (select-window w) - (and vm-warp-mouse-to-new-frame - (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))) + (vm-goto-new-summary-frame-maybe) (vm-display vm-summary-buffer t '(vm-summarize vm-summarize-other-frame) - (list this-command)) + (list this-command) (not raise)) ;; need to do this after any frame creation because the ;; toolbar sets frame-specific height and width specifiers. (set-buffer vm-summary-buffer) @@ -118,7 +110,8 @@ ;; Just for laughs, make the update interval vary. (modulus (+ (% (vm-abs (random)) 11) 10)) (mouse-track-func - (and (vm-mouse-support-possible-p) + (and vm-mouse-track-summary + (vm-mouse-support-possible-p) (vm-mouse-fsfemacs-mouse-p) (function vm-mouse-set-mouse-track-highlight))) summary) @@ -188,7 +181,8 @@ (marker-buffer (vm-su-start-of m))) (let ((modified (buffer-modified-p)) (mouse-track-func - (and (vm-mouse-support-possible-p) + (and vm-mouse-track-summary + (vm-mouse-support-possible-p) (vm-mouse-fsfemacs-mouse-p) (function vm-mouse-set-mouse-track-highlight))) summary) @@ -203,7 +197,7 @@ (goto-char (vm-su-start-of m)) (setq selected (not (looking-at vm-summary-no-=>))) ;; We do a little dance to update the text in - ;; order to make the markets in the text do + ;; order to make the markers in the text do ;; what we want. ;; ;; 1. We need to avoid having the su-start-of @@ -244,7 +238,8 @@ (if vm-summary-buffer (let ((w (vm-get-visible-buffer-window vm-summary-buffer)) (mouse-track-func - (and (vm-mouse-support-possible-p) + (and vm-mouse-track-summary + (vm-mouse-support-possible-p) (vm-mouse-fsfemacs-mouse-p) (function vm-mouse-set-mouse-track-highlight))) (old-window nil)) @@ -299,6 +294,13 @@ (if (and vm-summary-overlay (extent-end-position vm-summary-overlay)) (set-extent-endpoints vm-summary-overlay start end) (setq vm-summary-overlay (make-extent start end)) + ;; the reason this isn't needed under FSF Emacs is + ;; that insert-before-marker also inserts before + ;; overlays! so a summary update of an entry just + ;; before this overlay in the summary buffer won't + ;; leak into the overlay, but it _will_ leak into an + ;; XEmacs extent. + (set-extent-property vm-summary-overlay 'start-open t) (set-extent-property vm-summary-overlay 'detachable nil) (set-extent-property vm-summary-overlay 'face face))))) @@ -493,7 +495,7 @@ (put format-variable 'vm-compiled-format format) (put format-variable 'vm-format-sexp (if list (cons 'list list) sexp)))) -(defun vm-get-header-contents (message header-name-regexp) +(defun vm-get-header-contents (message header-name-regexp &optional clump-sep) (let ((contents nil) regexp) (setq regexp (concat "^\\(" header-name-regexp "\\)") @@ -504,12 +506,13 @@ (widen) (goto-char (vm-headers-of message)) (let ((case-fold-search t)) - (while (and (re-search-forward regexp (vm-text-of message) t) + (while (and (or (null contents) clump-sep) + (re-search-forward regexp (vm-text-of message) t) (save-excursion (goto-char (match-beginning 0)) (vm-match-header))) (if contents (setq contents - (concat contents ", " (vm-matched-header-contents))) + (concat contents clump-sep (vm-matched-header-contents))) (setq contents (vm-matched-header-contents)))))) contents ))) @@ -612,18 +615,19 @@ nil (save-excursion (set-buffer (vm-buffer-of (vm-real-message-of message))) - (save-restriction - (widen) - (goto-char (vm-start-of message)) - (let ((case-fold-search nil)) - (if (or (looking-at - ;; special case this so that the "remote from blah" - ;; isn't included. - "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\) remote from .*") - (looking-at "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\)")) - (vm-buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))))))) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-start-of message)) + (let ((case-fold-search nil)) + (if (or (looking-at + ;; special case this so that the "remote from blah" + ;; isn't included. + "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\) remote from .*") + (looking-at "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\)")) + (vm-buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))))))) (defun vm-parse-date (date) (let ((weekday "") @@ -779,20 +783,21 @@ nil (save-excursion (set-buffer (vm-buffer-of message)) - (save-restriction - (widen) - (goto-char (vm-start-of message)) - (let ((case-fold-search nil)) - (if (looking-at "From \\([^ \t\n]+\\)") - (vm-buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))))))) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-start-of message)) + (let ((case-fold-search nil)) + (if (looking-at "From \\([^ \t\n]+\\)") + (vm-buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))))))) (defun vm-su-do-author (m) (let ((full-name (vm-get-header-contents m "Full-Name:")) - (from (or (vm-get-header-contents m "From:") + (from (or (vm-get-header-contents m "From:" ", ") (vm-grok-From_-author m))) - pair) + pair i) (if (and full-name (string-match "^[ \t]*$" full-name)) (setq full-name nil)) (if (null from) @@ -806,6 +811,9 @@ (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name) (setq full-name (substring full-name (match-beginning 1) (match-end 1)))) + (setq full-name (vm-decode-mime-encoded-words-maybe full-name)) + (while (setq i (string-match "\n" full-name i)) + (aset full-name i ?\ )) (vm-set-full-name-of m full-name) (vm-set-from-of m from))) @@ -862,37 +870,29 @@ (funcall vm-chop-full-name-function address))) (defun vm-su-do-recipients (m) - (let ((mail-use-rfc822 t) names addresses to cc all list) - (setq to (or (vm-get-header-contents m "To:") - (vm-get-header-contents m "Apparently-To:") + (let ((mail-use-rfc822 t) i names addresses to cc all list full-name) + (setq to (or (vm-get-header-contents m "To:" ", ") + (vm-get-header-contents m "Apparently-To:" ", ") ;; desperation.... (user-login-name)) - cc (vm-get-header-contents m "Cc:") + cc (vm-get-header-contents m "Cc:" ", ") all to all (if all (concat all ", " cc) cc) addresses (rfc822-addresses all)) (setq list (vm-parse-addresses all)) (while list - (cond ((string= (car list) "")) - ((string-match "^\\(\"?\\([^<]+[^ \t\n\"]\\)\"?[ \t\n]+\\)?<\\([^>]+\\)>" - (car list)) - (if (match-beginning 2) - (setq names - (cons - (substring (car list) (match-beginning 2) - (match-end 2)) - names)) - (setq names - (cons - (substring (car list) (match-beginning 3) - (match-end 3)) - names)))) - ((string-match "[\000-\177]*(\\([^)]+\\))[\000-\177]*" (car list)) - (setq names - (cons (substring (car list) (match-beginning 1) - (match-end 1)) - names))) - (t (setq names (cons (car list) names)))) + ;; Just like vm-su-do-author: + (setq full-name (or (nth 0 (funcall vm-chop-full-name-function + (car list))) + (car list))) + ;; If double quoted are around the full name, fish the name out. + (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name) + (setq full-name + (substring full-name (match-beginning 1) (match-end 1)))) + (setq full-name (vm-decode-mime-encoded-words-maybe full-name)) + (while (setq i (string-match "\n" full-name i)) + (aset full-name i ?\ )) + (setq names (cons full-name names)) (setq list (cdr list))) (setq names (nreverse names)) ; added by jwz for fixed vm-parse-addresses (vm-set-to-of m (mapconcat 'identity addresses ", ")) @@ -941,11 +941,11 @@ (or (vm-subject-of m) (vm-set-subject-of m - (let ((subject (or (vm-get-header-contents m "Subject:") "")) + (let ((subject (or (vm-get-header-contents m "Subject:" " ") "")) (i nil)) - (if vm-summary-subject-no-newlines - (while (setq i (string-match "\n" subject i)) - (aset subject i ?\ ))) + (setq subject (vm-decode-mime-encoded-words-maybe subject)) + (while (setq i (string-match "\n" subject i)) + (aset subject i ?\ )) subject )))) (defun vm-su-summary (m) @@ -971,8 +971,8 @@ (while mp (vm-set-summary-of (car mp) nil) (vm-mark-for-summary-update (car mp)) - (vm-stuff-attributes (car mp)) (setq mp (cdr mp))) + (vm-stuff-folder-attributes nil) (set-buffer-modified-p t) (vm-update-summary-and-mode-line)) (vm-unsaved-message "Fixing your summary... done"))
--- a/lisp/vm/vm-thread.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-thread.el Mon Aug 13 08:50:05 2007 +0200 @@ -122,8 +122,7 @@ (setq loop-sym (intern (symbol-name id-sym) vm-thread-loop-obarray)) (if (boundp loop-sym) ;; loop detected, bail... - (setq done t - thread-list (cdr thread-list)) + (setq done t) (set loop-sym t) (if (and (boundp id-sym) (symbol-value id-sym)) (progn @@ -212,12 +211,12 @@ (vm-set-parent-of m (or (let (references) - (setq references (vm-get-header-contents m "References:")) + (setq references (vm-get-header-contents m "References:" " ")) (and references (car (vm-last (vm-parse references "[^<]*\\(<[^>]+>\\)"))))) (let (in-reply-to) - (setq in-reply-to (vm-get-header-contents m "In-Reply-To:")) + (setq in-reply-to (vm-get-header-contents m "In-Reply-To:" " ")) (and in-reply-to (car (vm-parse in-reply-to "[^<]*\\(<[^>]+>\\)"))))))))
--- a/lisp/vm/vm-toolbar.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-toolbar.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Toolbar related functions and commands -;;; Copyright (C) 1995 Kyle E. Jones +;;; Copyright (C) 1995-1997 Kyle E. Jones ;;; ;;; 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 @@ -118,6 +118,24 @@ (or (fboundp 'vm-toolbar-compose-command) (fset 'vm-toolbar-compose-command 'vm-mail)) +(defvar vm-toolbar-decode-mime-button + [vm-toolbar-decode-mime-icon vm-toolbar-decode-mime-command + (vm-toolbar-can-decode-mime-p) + "Decode the MIME objects in the current message.\n +The objects might be displayed immediately, or buttons might be +displayed that you need to click on to view the object. See the +documentation for the variables vm-mime-internal-content-types +and vm-mime-external-content-types-alist to see how to control +whether you see buttons or objects.\n +The command `vm-toolbar-decode-mime-command' is run, which is normally +bound to `vm-decode-mime-messages'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-decode-mime-command 'some-other-command)"]) +(defvar vm-toolbar-decode-mime-icon nil) +(or (fboundp 'vm-toolbar-decode-mime-command) + (fset 'vm-toolbar-decode-mime-command 'vm-decode-mime-message)) + (defvar vm-toolbar-delete-icon nil) (defvar vm-toolbar-undelete-icon nil) @@ -138,7 +156,8 @@ (make-variable-buffer-local 'vm-toolbar-helper-icon) (defvar vm-toolbar-help-button - [vm-toolbar-helper-icon vm-toolbar-helper-command t + [vm-toolbar-helper-icon vm-toolbar-helper-command + (vm-toolbar-can-help-p) "Don't Panic.\n VM uses this button to offer help if you're in trouble. Under normal circumstances, this button runs `vm-help'.\n @@ -154,7 +173,8 @@ (call-interactively vm-toolbar-helper-command)) (defvar vm-toolbar-quit-button - [vm-toolbar-quit-icon vm-toolbar-quit-command t + [vm-toolbar-quit-icon vm-toolbar-quit-command + (vm-toolbar-can-quit-p) "Quit visiting this folder.\n The command `vm-toolbar-quit-command' is run, which is normally bound to `vm-quit'. @@ -217,6 +237,25 @@ buffer-auto-save-file-name buffer-file-name)))) +(defun vm-toolbar-can-decode-mime-p () + (save-excursion + (vm-check-for-killed-folder) + (vm-select-folder-buffer) + (and + vm-display-using-mime + vm-message-pointer + vm-presentation-buffer + (not vm-mime-decoded) + (not (vm-mime-plain-message-p (car vm-message-pointer)))))) + +(defun vm-toolbar-can-quit-p () + (save-excursion + (vm-check-for-killed-folder) + (vm-select-folder-buffer) + (memq major-mode '(vm-mode vm-virtual-mode)))) + +(fset 'vm-toolbar-can-help-p 'vm-toolbar-can-quit-p) + (defun vm-toolbar-update-toolbar () (if (and vm-message-pointer (vm-deleted-flag (car vm-message-pointer))) (setq vm-toolbar-delete/undelete-icon vm-toolbar-undelete-icon) @@ -224,6 +263,9 @@ (cond ((vm-toolbar-can-recover-p) (setq vm-toolbar-helper-command 'recover-file vm-toolbar-helper-icon vm-toolbar-recover-icon)) + ((vm-toolbar-can-decode-mime-p) + (setq vm-toolbar-helper-command 'vm-decode-mime-message + vm-toolbar-helper-icon vm-toolbar-decode-mime-icon)) (t (setq vm-toolbar-helper-command 'vm-help vm-toolbar-helper-icon vm-toolbar-help-icon))) @@ -232,6 +274,11 @@ 'vm-toolbar-delete/undelete-icon 'vm-toolbar-helper-command 'vm-toolbar-helper-icon)) + (if vm-presentation-buffer + (vm-copy-local-variables vm-presentation-buffer + 'vm-toolbar-delete/undelete-icon + 'vm-toolbar-helper-command + 'vm-toolbar-helper-icon)) (and vm-toolbar-specifier (progn (set-specifier vm-toolbar-specifier (cons (current-buffer) nil)) @@ -242,7 +289,14 @@ (vm-toolbar-initialize) (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon)))) (width (+ 4 (glyph-width (car vm-toolbar-help-icon)))) + (myframe (vm-created-this-frame-p)) toolbar ) + ;; glyph-width and glyph-height return 0 at startup sometimes + ;; use reasonable values if they fail. + (if (= width 4) + (setq width 68)) + (if (= height 4) + (setq height 46)) ;; honor user setting of vm-toolbar if they are daring enough ;; to set it. (if vm-toolbar @@ -251,21 +305,29 @@ vm-toolbar toolbar)) (cond ((eq vm-toolbar-orientation 'right) (setq vm-toolbar-specifier right-toolbar) + (if myframe + (set-specifier right-toolbar (cons (selected-frame) toolbar))) (set-specifier right-toolbar (cons (current-buffer) toolbar)) (set-specifier right-toolbar-width (cons (selected-frame) width))) ((eq vm-toolbar-orientation 'left) (setq vm-toolbar-specifier left-toolbar) + (if myframe + (set-specifier left-toolbar (cons (selected-frame) toolbar))) (set-specifier left-toolbar (cons (current-buffer) toolbar)) (set-specifier left-toolbar-width (cons (selected-frame) width))) ((eq vm-toolbar-orientation 'bottom) (setq vm-toolbar-specifier bottom-toolbar) + (if myframe + (set-specifier bottom-toolbar (cons (selected-frame) toolbar))) (set-specifier bottom-toolbar (cons (current-buffer) toolbar)) (set-specifier bottom-toolbar-height (cons (selected-frame) height))) (t (setq vm-toolbar-specifier top-toolbar) + (if myframe + (set-specifier top-toolbar (cons (selected-frame) toolbar))) (set-specifier top-toolbar (cons (current-buffer) toolbar)) (set-specifier top-toolbar-height (cons (selected-frame) height)))))) @@ -277,6 +339,7 @@ (delete/undelete . vm-toolbar-delete/undelete-button) (file . vm-toolbar-file-button) (help . vm-toolbar-help-button) + (mime . vm-toolbar-decode-mime-button) (next . vm-toolbar-next-button) (previous . vm-toolbar-previous-button) (print . vm-toolbar-print-button) @@ -307,25 +370,33 @@ ((null vm-toolbar-help-icon) (let ((tuples (if (featurep 'xpm) - '( - (vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm") - (vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm" + (list + (if (>= (device-bitplanes) 16) + '(vm-toolbar-decode-mime-icon "mime-colorful-up.xpm" + "mime-colorful-dn.xpm" + "mime-colorful-xx.xpm") + '(vm-toolbar-decode-mime-icon "mime-simple-up.xpm" + "mime-simple-dn.xpm" + "mime-simple-xx.xpm")) + '(vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm") + '(vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm" "previous-dn.xpm") - (vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm") - (vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm" + '(vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm") + '(vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm" "undelete-dn.xpm") - (vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm" + '(vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm" "autofile-dn.xpm") - (vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm") - (vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm") - (vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm") - (vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm") - (vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm") - (vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm") - (vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm") - (vm-toolbar-recover-icon "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm") + '(vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm") + '(vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm") + '(vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm") + '(vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm") + '(vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm") + '(vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm") + '(vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm") + '(vm-toolbar-recover-icon "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm") ) '( + (vm-toolbar-decode-mime-icon "mime-up.xbm" "mime-dn.xbm" "mime-xx.xbm") (vm-toolbar-next-icon "next-up.xbm" "next-dn.xbm" "next-xx.xbm") (vm-toolbar-previous-icon "previous-up.xbm" "previous-dn.xbm" "previous-xx.xbm") @@ -359,5 +430,7 @@ files)) (setq tuples (cdr tuples))))))) (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon) + (setq-default vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon) (setq vm-toolbar-helper-command 'vm-help) - (setq vm-toolbar-helper-icon vm-toolbar-help-icon)) + (setq vm-toolbar-helper-icon vm-toolbar-help-icon) + (setq-default vm-toolbar-helper-icon vm-toolbar-help-icon))
--- a/lisp/vm/vm-undo.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-undo.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Commands to undo message attribute changes in VM -;;; Copyright (C) 1989, 1990, 1993, 1994 Kyle E. Jones +;;; Copyright (C) 1989-1995 Kyle E. Jones ;;; ;;; 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
--- a/lisp/vm/vm-vars.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-vars.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; VM user and internal variable initialization -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -21,11 +21,10 @@ "*Startup file for VM that is loaded the first time you run VM in an Emacs session.") -(defvar vm-options-file "~/.vm.options" +(defvar vm-preferences-file "~/.vm.preferences" "*Secondary startup file for VM, loaded after vm-init-file. This file is written and overwritten by VM and is not meant for -users to edit directly. Use the Options menu to change what -appears in this file.") +users to edit directly.") (defvar vm-primary-inbox "~/INBOX" "*Mail is moved from the system mailbox to this file for reading.") @@ -136,6 +135,39 @@ variables are defined and no particular value for vm-spool-files has been specified.") +(defvar vm-spool-file-suffixes nil + "*List of suffixes to be used to create possible spool file names +for folders. Example: + + (setq vm-spool-file-suffixes '(\".spool\" \"-\")) + +If you visit a folder ~/mail/beekeeping, when VM attempts to +retrieve new mail for that folder it will look for mail in +~/mail/beekeeping.spool and ~/mail/beekeeping- in addition to +scanning vm-spool-files for matches. + +The value of vm-spool-files-suffixes will not be used unless +vm-crash-box-suffix is also defined, since a crash box is +required for all mail retrieval from spool files.") + +(defvar vm-crash-box-suffix nil + "*String suffix used to create possible crash box file names for folders. +When VM uses vm-spool-file-suffixes to create a spool file name, +it will append the value of vm-crash-box-suffix to the folder's +file name to create a crash box name.") + +(defvar vm-make-spool-file-name nil + "*Non-nil value should be a function that returns a spool file name +for a folder. The function will be called with one argument, the +folder's file name. If the folder does not have a file name, +the function will not be called.") + +(defvar vm-make-crash-box-name nil + "*Non-nil value should be a function that returns a crash box file name +for a folder. The function will be called with one argument, the +folder's file name. If the folder does not have a file name, +the function will not be called.") + (defvar vm-pop-md5-program "md5" "*Program that reads a message on its standard input and writes an MD5 digest on its output.") @@ -155,9 +187,7 @@ seconds) VM should check for new mail and try to retrieve it. This is done asynchronously and may occur while you are editing other files. It should not disturb your editing, except perhaps -for a pause while the work is being done. The `itimer' package -must be installed for this to work. Otherwise a numeric value is -the same as a value of t.") +for a pause while the check is being done.") (defvar vm-default-folder-type (cond ((not (boundp 'system-configuration)) @@ -282,9 +312,13 @@ (defvar vm-highlighted-header-face 'bold "*Face to be used to highlight headers. -This variable is ignored under Lucid Emacs. -See the documentation for the function `highlight-headers' -to find out how to customize header highlighting under Lucid Emacs.") +The header to highlight are sepcified by the vm-highlighted-header-regexp +variable. + +This variable is ignored under XEmacs if vm-use-lucid-highlighting is +nil. XEmacs' highlight-headers package is used instead. See the +documentation for the function `highlight-headers' to find out how to +customize header highlighting using this package.") (defvar vm-preview-lines 0 "*Non-nil value N causes VM to display the visible headers + N lines of text @@ -301,6 +335,290 @@ "*Non-nil value means to preview messages even if they've already been read. A nil value causes VM to preview messages only if new or unread.") +(defvar vm-display-using-mime t + "*Non-nil value means VM should display messages using MIME. +MIME (Multipurpose Internet Mail Extensions) is a set of +extensions to the standard Internet message format that allows +reliable tranmission and reception of arbitrary data including +images, audio and video as well as traditional text. + +A non-nil value for this variable means that VM will recognize +MIME encoded messages and display them as specified by the +various MIME standards specifications. + +A nil value means VM will not display MIME messages any +differently than any other message.") + +;; try to avoid bad interaction with TM +(defvar vm-send-using-mime (not (featurep 'mime-setup)) + "*Non-nil value means VM should support sending messages using MIME. +MIME (Multipurpose Internet Mail Extensions) is a set of +extensions to the standard Internet message format that allows +reliable tranmission and reception of arbitrary data including +images, audio and video as well as traditional text. + +A non-nil value for this variable means that VM will + + - allow you to attach files and messages to your outbound message. + - analyze the composition buffer when you send off a message and + encode it as needed. + +A nil value means VM will not offer any support for composing +MIME messages.") + +(defvar vm-honor-mime-content-disposition nil + "*Non-nil value means use information from the Content-Disposition header +to display MIME messages. The Content-Disposition header +specifies whether a MIME object should be displayed inline or +treated as an attachment. For VM, ``inline'' display means +displaying the object in the Emacs buffer, if possible. +Attachments will be displayed as a button that you can use +mouse-2 to activate or mouse-3 to pull up a menu of options.") + +(defvar vm-auto-decode-mime-messages nil + "*Non-nil value causes MIME decoding to occur automatically +when a message containing MIME objects is exposed. A nil value +means that you will have to run the `vm-decode-mime-message' +command (normally bound to `D') manually to decode and display +MIME objects.") + +(defvar vm-auto-displayed-mime-content-types '("text" "multipart") + "*List of MIME content types that should be displayed immediately +after decoding. Other types will be displayed as a button that +the user must activate to display the object. + +A value of t means that all types should be displayed immediately. +A nil value means never display MIME objects immediately; only use buttons. + +If the value is a list, it should be a list of strings, which +should all be types or type/subtype pairs. Example: + + (setq vm-auto-displayed-mime-content-types '(\"text\" \"image/jpeg\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included. + +Note that some types are processed specially, and this variable does not +apply to them. + + Multipart/Digest and Message/RFC822 messages are always + displayed as a button to avoid visiting a new folder while the + user is moving around in the current folder. + + Message/Partial messages are always displayed as a button, + because there always needs to be a way to trigger the assembly + of the parts into a full message. + +Any type that cannot be displayed internally or externally will +be displayed as a button that allows you to save the body to a +file.") + +(defvar vm-mime-internal-content-types t + "*List of MIME content types that should be displayed internally +if Emacs is capable of doing so. A value of t means that VM +should always display an object internally if possible. A nil +value means never display MIME objects internally, which means VM +have to run an external viewer to display MIME objects. + +If the value is a list, it should be a list of strings. Example: + + (setq vm-mime-internal-content-types '(\"text\" \"image/jpeg\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included. + +Note that all multipart types are always handled internally. +There is no need to list them here.") + +(defvar vm-mime-external-content-types-alist nil + "*Alist of MIME content types and the external programs used to display them. +If VM cannot display a type internally or has been instructed not +to (see the documentation for the vm-mime-internal-content-types +variable) it will try to launch an external program to display that +type. + +The alist format is + + ( (TYPE PROGRAM ARG ARG ... ) ... ) + +TYPE is a string specifying a MIME type or type/subtype pair. +Example \"text\" or \"image/jpeg\". If a top-level type is +listed without a subtype, all subtypes of that type are assumed +to be included. + +PROGRAM is a string naming a program to run to display an object. +Any ARGS will be passed to the program as arguments. The octets +that compose the object will be written into a file and the name +of the file will be passed to the program as its last argument. + +Example: + + (setq vm-mime-external-content-types-alist + '( + (\"text/html\" \"netscape\") + (\"image/gif\" \"xv\") + (\"image/jpeg\" \"xv\") + (\"video/mpeg\" \"mpeg_play\") + (\"video\" \"xanim\") + ) + ) + +The first matching list element will be used. + +No multipart message will ever be sent to an external viewer.") + +(defvar vm-mime-type-converter-alist nil + "*Alist of MIME types and programs that can convert between them. +If VM cannot display a content type, it will scan this list to +see if the type can be converted into a type that it can display. + +The alist format is + + ( (START-TYPE END-TYPE COMMAND-LINE ) ... ) + +START-TYPE is a string specifying a MIME type or type/subtype pair. +Example \"text\" or \"image/jpeg\". If a top-level type is +listed without a subtype, all subtypes of that type are assumed +to be included. + +END-TYPE must be an exact type/subtype pair. This is the type +to which START-TYPE will be converted. + +COMMAND-LINE is a string giving a command line to be passed to +the shell. The octets that compose the object will be written to +the standard input of the shell command. + +Example: + + (setq vm-mime-type-converter-alist + '( + (\"image/jpeg\" \"image/gif\" \"jpeg2gif\") + (\"text/html\" \"text/plain\" \"striptags\") + ) + ) + +The first matching list element will be used.") + +(defvar vm-mime-alternative-select-method 'best-internal + "*Value tells how to choose which multipart/alternative part to display. +A MIME message of type multipart/alternative has multiple message +parts containing the same information, but each part may be +formatted differently. VM will display only one of the parts. +This variable tells VM how to choose which part to display. + +A value of 'best means choose the part that is the most faithful to +the sender's original content that can be displayed. + +A value of 'best-internal means choose the best part that can be +displayed internally, i.e. with the built-in capabilities of Emacs. +If none of the parts can be displayed internally, behavior reverts to +that of 'best.") + +(defvar vm-mime-button-face + (cond ((fboundp 'find-face) + (or (and (not (eq (device-type) 'tty)) (find-face 'gui-button-face) + 'gui-button-face) + (and (find-face 'bold-italic) 'bold-italic))) + ((fboundp 'facep) + (or (and (facep 'gui-button-face) 'gui-button-face) + (and (facep 'bold-italic) 'bold-italic)))) + "*Face used for text in buttons that trigger the display of MIME objects.") + +(defvar vm-mime-8bit-composition-charset "iso-8859-1" + "*Character set that VM should assume if it finds non-US-ASCII characters +in a composition buffer. Composition buffers are assumed to use +US-ASCII unless the buffer contains a byte with the high bit set. +This variable specifies what character set VM should assume if +such a character is found.") + +(defvar vm-mime-8bit-text-transfer-encoding 'quoted-printable + "*Symbol specifying what kind of transfer encoding to use on 8bit +text. Characters with the high bit set cannot safely pass +through all mail gateways and mail transport software. MIME has +two transfer encodings that convert 8-bit data to 7-bit for same +transport. Quoted-printable leaves the text mostly readable even +if the recipent does not have a MIME-capable mail reader. BASE64 +is unreadable with a MIME-capable mail reader, unless your name +is U3BvY2s=. + +A value of 'quoted-printable, means to use quoted-printable encoding. +A value of 'base64 means to use BASE64 encoding. +A value of '8bit means to send the message as is. + +Note that this only applies to textual MIME content types. Images, audio, +video, etc. will always use BASE64 encoding. + +Note that lines of 1000 characters or longer will automatically +trigger BASE64 encoding. Carriage returns (ascii code 13) in the +text will also trigger BASE64 encoding.") + +(defvar vm-mime-attachment-auto-type-alist + '( + ("\\.jpe?g" . "image/jpeg") + ("\\.gif" . "image/gif") + ("\\.png" . "image/png") + ("\\.tiff" . "image/tiff") + ("\\.htm?l" . "text/html") + ("\\.au" . "audio/basic") + ("\\.mpe?g" . "video/mpeg") + ("\\.ps" . "application/postscript") + ) + "*Alist used to guess a MIME content type based on a file name. +The list format is + + ((REGEXP . TYPE) ...) + +REGEXP is a string that specifies a regular expression. +TYPE is a string specifying a MIME content type. + +When a non-MIME file is attached to a MIME composition buffer, +this list will be scanned until a REGEXP matches the file's name. +The corresponding TYPE will be offered as a default when you are +prompted for the file's type.") + +(defvar vm-mime-max-message-size nil + "*Largest MIME message that VM should send without fragmentation. +The value should be a integer which specifies the size in bytes. +A message larger than this value will be split into multiple parts +for transmission using the MIME message/partial type.") + +(defvar vm-mime-attachment-save-directory nil + "*Non-nil value is a default directory for saving MIME attachments. +When VM prompts you for a target file name when saving a MIME body, +any relative pathnames will be relative to this directory.") + +(defvar vm-mime-avoid-folding-content-type nil + "*Non-nil means don't send folded Content-Type headers in MIME messages. +`Folded' headers are headers broken into multiple lines as specified +in RFC822 for readability and to avoid excessive line lengths. At +least one major UNIX vendor ships a version of sendmail that believes +a folded Content-Type header is a syntax error, and returns any such +message to sender. A typical error message from such a sendmail +version is, + +553 header syntax error, line \" charset=us-ascii\" + +If you see one of these, setting vm-mime-avoid-folding-content-type +non-nil may let your mail get through.") + +(defvar vm-mime-base64-decoder-program nil + "*Non-nil value should be a string that names a MIME base64 decoder. +The program should expect to read base64 data on its standard +input and write the converted data to its standard output.") + +(defvar vm-mime-base64-decoder-switches nil + "*List of command line flags passed to the command named by +vm-mime-base64-decoder-program.") + +(defvar vm-mime-base64-encoder-program nil + "*Non-nil value should be a string that names a MIME base64 encoder. +The program should expect arbitrary data on its standard +input and write base64 data to its standard output.") + +(defvar vm-mime-base64-encoder-switches nil + "*List of command line flags passed to the command named by +vm-mime-base64-encoder-program.") + (defvar vm-auto-next-message t "*Non-nil value causes VM to use vm-next-message to advance to the next message in the folder if the user attempts to scroll past the end of the @@ -421,7 +739,7 @@ changed data into the folder buffer until a particular message or the whole folder is saved to disk. This makes normal Emacs auto-saving useless for VM folder buffers because the information -you'd want to auto-save, i.e. the attribute changes, isn't in +you'd want to auto-save, i.e. the attribute changes are not in the buffer when it is auto-saved. Setting vm-flush-interval to a numeric value will cause the VM's @@ -755,18 +1073,24 @@ vm-forwarded-headers list appearing last in the header section of the forwarded message.") -(defvar vm-forwarding-digest-type "rfc934" +(defvar vm-forwarding-digest-type "mime" "*Non-nil value should be a string that specifies the type of message encapsulation format to use when forwarding a message. Legal values of this variable are: \"rfc934\" \"rfc1153\" +\"mime\" nil A nil value means don't use a digest, just mark the beginning and end of the forwarded message.") +(defvar vm-burst-digest-messages-inherit-labels t + "*Non-nil values means messages from a digest inherit the digest's labels. +Labels are added to messages with vm-add-message-labels, normally +bound to `l a'.") + (defvar vm-digest-preamble-format "\"%s\" (%F)" "*String which specifies the format of the preamble lines generated by vm-send-digest when it is invoked with a prefix argument. One @@ -784,25 +1108,39 @@ "*Header to insert into messages burst from a digest. Value should be a format string of the same type as vm-summary-format that describes a header to be inserted into each message burst from a digest. The format string must end with a newline.") -(defvar vm-digest-burst-type "rfc934" +(defvar vm-digest-burst-type "guess" "*Value specifies the default digest type offered by vm-burst-digest when it asks you what type of digest you want to unpack. Allowed values of this variable are: \"rfc934\" \"rfc1153\" + \"mime\" \"guess\" +rfc1153 digests have a preamble, followed by a line of exactly 70 +dashes, with digested messages separated by lines of exactly 30 dashes. + +rfc934 digests separate messages on any line that begins with a few +dashes, but doesn't require lines with only dashes or lines with a +specific number of dashes. In the text of the message, any line +beginning with dashes is textually modified to be preceeded by a dash +and a space to prevent confusion with message separators. + +MIME digests use whatever boundary that is specified by the +boundary parameter in the Content-Type header of the digest. + If the value is \"guess\", and you take the default response when vm-burst-digest queries you, VM will try to guess the digest type.") -(defvar vm-digest-send-type "rfc934" +(defvar vm-digest-send-type "mime" "*String that specifies the type of digest vm-send-digest will use. Legal values of this variable are: \"rfc934\" \"rfc1153\" +\"mime\" ") @@ -896,8 +1234,56 @@ vm-rfc1153-digest-headers list appearing last in the headers of the digestified messages.") +(defvar vm-mime-digest-headers + '("Resent-" + "From:" "Sender:" + "To:" "Cc:" + "Subject:" + "Date:" + "Message-ID:" + "Keywords:" + "MIME-Version:" + "Content-") + "*List of headers that should be appear in MIME digests +created by VM. These should be listed in the order you wish them +to appear in the messages in the digest. Regular expressions are +allowed. There's no need to anchor patterns with \"^\", as +searches always start at the beginning of a line. Put a colon at +the end of patterns to get exact matches. (E.g. \"Date\" matches +\"Date\" and \"Date-Sent\".) Header names are always matched +case insensitively. + +If the value of vm-mime-digest-discard-header-regexp is nil, the headers +matched by vm-mime-digest-headers are the only headers that will be +kept. + +If vm-mime-digest-discard-header-regexp is non-nil, then only +headers matched by that variable will be discarded; all others +will be kept. vm-mime-digest-headers determines the order of +appearance in that case, with headers not matching any in the +vm-mime-digest-headers list appearing last in the headers +of the digestified messages.") + +(defvar vm-mime-digest-discard-header-regexp nil + "*Non-nil value should be a regular expression header that tells +which headers should not appear in MIME digests created +by VM. This variable along with vm-mime-digest-headers +determines which headers are kept and which are discarded. + +If the value of vm-mime-digest-discard-header-regexp is nil, the headers +matched by vm-mime-digest-headers are the only headers that will be +kept. + +If vm-mime-digest-discard-header-regexp is non-nil, then only +headers matched by this variable will be discarded; all others +will be kept. vm-mime-digest-headers determines the order of +appearance in that case, with headers not matching any in the +vm-mime-digest-headers list appearing last in the headers +of the digestified messages.") + (defvar vm-resend-bounced-headers - '("Resent-" + '("MIME-Version:" "Content-" + "Resent-" "From:" "Sender:" "Reply-To:" "To:" "Cc:" "Subject:" @@ -966,7 +1352,7 @@ (defvar vm-resend-discard-header-regexp "\\(\\(X400-\\)?Received:\\|Resent-\\)" "*Non-nil value should be a regular expression that tells what headers should not appear in a resent message. This -variable along with vm-resend-bounced-headers determines which +variable along with vm-resend-headers determines which headers are kept and which headers are discarded. If the value of vm-resend-discard-header-regexp is nil, @@ -1045,7 +1431,7 @@ the maximum allowed length of the substituted string. If the string is longer than this value the right end of the string is truncated. If the value is negative, the string is truncated on -on the left instead of the right. +the left instead of the right. The summary format need not be one line per message but it must end with a newline, otherwise the message pointer will not be displayed correctly @@ -1061,6 +1447,10 @@ "*Face to use to highlight the summary entry for the current message. Nil means don't highlight the current message's summary entry.") +(defvar vm-mouse-track-summary t + "*Non-nil value means highlight summary lines as the mouse passes +over them.") + (defvar vm-summary-show-threads nil "*Non-nil value means VM should display and maintain message thread trees in the summary buffer. This means that @@ -1121,10 +1511,6 @@ the arrow. A value that is not nil and not t causes VM to center the arrow only if the summary window is not the only existing window.") -(defvar vm-summary-subject-no-newlines t - "*Non-nil value means VM should replace newlines with spaces in the subject -displayed in the summary.") - (defvar vm-subject-ignored-prefix "^\\(re: *\\)+" "*Non-nil value should be a regular expression that matches strings at the beginning of the Subject header that you want VM to ignore @@ -1176,6 +1562,12 @@ under X Windows or some other window system that allows multiple Emacs frames.") +(defvar vm-raise-frame-at-startup t + "*Specifies whether VM should raise its frame at startup. +A value of nil means never raise the frame. +A value of t means always raise the frame. +Other values are reserved for future use.") + (defvar vm-frame-per-folder t "*Non-nil value causes the folder visiting commands to visit in a new frame. Nil means the commands will use the current frame. This variable @@ -1216,6 +1608,24 @@ under X Windows or some other window system that allows multiple Emacs frames.") +(defvar vm-frame-per-completion t + "*Non-nil value causes VM to open a new frame on mouse +initiated completing reads. A mouse initiated completing read +occurs when you invoke a VM command using the mouse, either with a +menu or a toolbar button. That command must then prompt you for +information, and there must be a limited set of proper responses. + +If these conditions are met and vm-frame-per-completion's value +is non-nil, VM will create a new frame containing a list of +responses that you can select with the mouse. + +A nil value means the current frame will be used to display the +list of choices. + +This variable has no meaning if you're not running Emacs native +under X Windows or some other window system that allows multiple +Emacs frames.") + (defvar vm-frame-parameter-alist nil "*Non-nil value is an alist of types and lists of frame parameters. This list tells VM what frame parameters to associate with each @@ -1223,12 +1633,15 @@ The alist should be of this form -((SYMBOL PARAMLIST) (SYMBOL2 PARAMLIST2) ...) - -SYMBOL must be one of `composition', `edit', `folder', -`primary-folder' or `summary'. It specifies the type of frame -that the following PARAMLIST applies to. - + ((SYMBOL PARAMLIST) (SYMBOL2 PARAMLIST2) ...) + +SYMBOL must be one of `completion', `composition', `edit', +`folder', `primary-folder' or `summary'. It specifies the type +of frame that the following PARAMLIST applies to. + +`completion' specifies parameters for frames that display list of + choices generated by a mouse-initiated completing read. + (See vm-frame-per-completion.) `composition' specifies parameters for mail composition frames. `edit' specifies parameters for message edit frames (e.g. created by vm-edit-message-other-frame) @@ -1236,7 +1649,7 @@ `vm-visit-' commands. `primary-folder' specifies parameters for the frame created by running `vm' without any arguments. -`summary' specifies parameters for frames to display a summary buffer +`summary' specifies parameters for frames that display a summary buffer (e.g. created by vm-summarize-other-frame) PARAMLIST is a list of pairs as described in the documentation for @@ -1258,18 +1671,19 @@ toolbar buttons will appears and in what order. Valid symbol value within the list are: -autofile -compose -delete/undelete -file -help -next -previous -print -quit -reply -visit -nil + autofile + compose + delete/undelete + file + help + mime + next + previous + print + quit + reply + visit + nil If nil appears in the list, it should appear exactly once. All buttons after nil in the list will be displayed flushright in @@ -1301,8 +1715,16 @@ Consider this variable experimental; it may not be supported forever.") -(defvar vm-use-menus '(folder motion send mark label sort - virtual undo dispose emacs nil help) +(defvar vm-use-menus + (nconc (list 'folder 'motion 'send 'mark 'label 'sort 'virtual) + (cond ((string-match ".*-.*-\\(win95\\|nt\\)" system-configuration) + nil) + (t (list 'undo))) + (list 'dispose) + (cond ((string-match ".*-.*-\\(win95\\|nt\\)" system-configuration) + nil) + (t (list 'emacs))) + (list nil 'help)) "*Non-nil value causes VM to provide a menu interface. A value that is a list causes VM to install its own menubar. A value of 1 causes VM to install a \"VM\" item in the Emacs menubar. @@ -1333,6 +1755,10 @@ are provided, which usually means Emacs has to be running under a window system.") +(defvar vm-popup-menu-on-mouse-3 t + "*Non-nil value means VM should provide context-sensitive menus on mouse-3. +A nil value means VM should not change the binding of mouse-3.") + (defvar vm-warp-mouse-to-new-frame nil "*Non-nil value causes VM to move the mouse cursor into newly created frames. This is useful to give the new frame the focus under some window managers @@ -1340,34 +1766,31 @@ Nil means don't move the mouse cursor.") -;; if browse-url is around (always will be in XEmacs 19.14 or later) use it; -;; otherwise do our own support. -(if (boundp 'browse-url-browser-function) - (defvaralias 'vm-url-browser 'browse-url-browser-function) - (defvar vm-url-browser - (cond ((fboundp 'w3-fetch-other-frame) - 'w3-fetch-other-frame) - ((fboundp 'w3-fetch) - 'w3-fetch) - (t 'vm-mouse-send-url-to-netscape)) - "*Non-nil value means VM should enable URL passing. -This means that VM will search for URLs (Universal Resource +(defvar vm-url-browser + (cond ((fboundp 'w3-fetch-other-frame) + 'w3-fetch-other-frame) + ((fboundp 'w3-fetch) + 'w3-fetch) + (t 'vm-mouse-send-url-to-netscape)) + "*Non-nil value means VM should enable URL passing. +This means that VM will search for URLs (Uniform Resource Locators) in messages and make it possible for you to pass them to a World Wide Web browser. Clicking mouse-2 on the URL will send it to the browser. -Clicking mouse-3 on the URL will pop up a menu of browsers and -you can pick which one you want to use. +By default clicking mouse-3 on the URL will pop up a menu of +browsers and you can pick which one you want to use. If +vm-popup-menu-on-mouse-3 is set to nil, you will not see the menu. Moving point to a character within the URL and pressing RETURN -will send the URL to the browser (Only in XEmacs). +will send the URL to the browser. If the value of vm-url-browser is a string, it should specify name of an external browser to run. The URL will be passed to the program as its first argument. -If the value of vm-url-browser is a symbol, if should specifiy a +If the value of vm-url-browser is a symbol, it should specify a Lisp function to call. The URL will be passed to the program as its first and only argument. Use @@ -1380,7 +1803,7 @@ for Mosaic. The advantage of using them is that they will display an URL using on existing Mosaic or Netscape process, if possible. -A nil value means VM should not enable URL passing to browsers.")) +A nil value means VM should not enable URL passing to browsers.") (defvar vm-highlight-url-face 'bold-italic "*Non-nil value should be a face to use display URLs found in messages. @@ -1465,6 +1888,14 @@ and not nil means that motion should be done as if vm-circular-folders is set to nil.") +(defvar vm-move-after-killing nil + "*Non-nil value causes VM's `k' command to automatically invoke +vm-next-message or vm-previous-message after killing messages, to try +to move past the deleted messages. A value of t means motion +should honor the value of vm-circular-folders. A value that is +not t and not nil means that motion should be done as if +vm-circular-folders is set to nil.") + (defvar vm-delete-after-saving nil "*Non-nil value causes VM automatically to mark messages for deletion after successfully saving them to a folder.") @@ -1516,7 +1947,7 @@ "*Command VM uses to print messages.") (defvar vm-print-command-switches lpr-switches - "*Command line flags passed to the command named by vm-print-command. + "*List of command line flags passed to the command named by vm-print-command. VM uses vm-print-command to print messages.") (defvar vm-berkeley-mail-compatibility @@ -1528,14 +1959,10 @@ (defvar vm-strip-reply-headers nil "*Non-nil value causes VM to strip away all comments and extraneous text from the headers generated in reply messages. If you use the \"fakemail\" -program as distributed with Emacs, you probably want to set this variable to +program as distributed with Emacs, you probably want to set this variable to t, because as of Emacs v18.52 \"fakemail\" could not handle unstripped headers.") -(defvar vm-inhibit-startup-message nil - "*Non-nil causes VM not to display its copyright notice, disclaimers -etc. when started in the usual way.") - (defvar vm-select-new-message-hook nil "*List of hook functions called every time a message with the 'new' attribute is made to be the current message. When the hooks are run the @@ -1701,6 +2128,17 @@ (defvar vm-menu-setup-hook nil "*List of hook functions that are run just after all menus are initialized.") +(defvar vm-mime-display-function nil + "*If non-nil, this should name a function to be called inside +vm-decode-mime-message to do the MIME display the current +message. The function is called with no arguments, and at the +time of the call the current buffer will be the `presentation' +buffer for the folder, which is a temporary buffer that VM uses +for the display of MIME messages. A copy of the current message +will be in the presentation buffer at that time. The normal work +that vm-decode-mime-message would do is not done, because this +function is expected to subsume all of it.") + (defvar mail-yank-hooks nil "Hooks called after a message is yanked into a mail composition. @@ -1756,6 +2194,10 @@ "*Name of program to use to run Mosaic. vm-mouse-send-url-to-mosaic uses this.") +(defvar vm-temp-file-directory "/tmp" + "*Name of a directory where VM can put temporary files. +This name must not end with a slash.") + (defvar vm-tale-is-an-idiot nil "*Non-nil value causes vm-mail-send to check multi-line recipient headers of outbound mail for lines that don't end with a @@ -1785,6 +2227,7 @@ (define-key map " " 'vm-scroll-forward) (define-key map "b" 'vm-scroll-backward) (define-key map "\C-?" 'vm-scroll-backward) + (define-key map "D" 'vm-decode-mime-message) (define-key map "d" 'vm-delete-message) (define-key map "\C-d" 'vm-delete-message-backward) (define-key map "u" 'vm-undelete-message) @@ -1849,6 +2292,8 @@ (define-key map "Ms" 'vm-unmark-messages-same-subject) (define-key map "MA" 'vm-mark-messages-same-author) (define-key map "Ma" 'vm-unmark-messages-same-author) + (define-key map "MR" 'vm-mark-summary-region) + (define-key map "Mr" 'vm-unmark-summary-region) (define-key map "M?" 'vm-mark-help) (define-key map "W" (make-sparse-keymap)) (define-key map "WW" 'vm-apply-window-configuration) @@ -1884,6 +2329,10 @@ (defvar vm-mail-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-v" vm-mode-map) + (define-key map "\C-c\C-p" 'vm-mime-preview-composition) + (define-key map "\C-c\C-e" 'vm-mime-encode-composition) + (define-key map "\C-c\C-a" 'vm-mime-attach-file) + (define-key map "\C-c\C-m" 'vm-mime-attach-mime-file) (define-key map "\C-c\C-y" 'vm-yank-message) (define-key map "\C-c\C-s" 'vm-mail-send) (define-key map "\C-c\C-c" 'vm-mail-send-and-exit) @@ -1931,6 +2380,12 @@ (make-variable-buffer-local 'vm-last-message-pointer) (defvar vm-mail-buffer nil) (make-variable-buffer-local 'vm-mail-buffer) +(defvar vm-presentation-buffer nil) +(make-variable-buffer-local 'vm-presentation-buffer) +(defvar vm-presentation-buffer-handle nil) +(make-variable-buffer-local 'vm-presentation-buffer-handle) +(defvar vm-mime-decoded nil) +(make-variable-buffer-local 'vm-mime-decoded) (defvar vm-summary-buffer nil) (make-variable-buffer-local 'vm-summary-buffer) (defvar vm-summary-pointer nil) @@ -1958,6 +2413,7 @@ (make-variable-buffer-local 'vm-modification-counter) (defvar vm-flushed-modification-counter nil) (make-variable-buffer-local 'vm-flushed-modification-counter) +(defvar vm-tempfile-counter 0) (defvar vm-messages-needing-summary-update nil) (defvar vm-buffers-needing-display-update nil) (defvar vm-numbering-redo-start-point nil) @@ -2010,7 +2466,8 @@ (defconst vm-supported-folder-types '("From_" "From_-with-Content-Length" "mmdf" "babyl")) (defconst vm-supported-window-configurations - '(("default") + '( + ("default") ("startup") ("quitting") ("composing-message") @@ -2018,113 +2475,135 @@ ("marking-message") ("reading-message") ("searching-message") + ("vm") + ("vm-add-message-labels") + ("vm-apply-virtual-folder") + ("vm-auto-archive-messages") + ("vm-beginning-of-message") + ("vm-burst-digest") + ("vm-burst-mime-digest") + ("vm-burst-rfc1153-digest") + ("vm-burst-rfc934-digest") + ("vm-change-folder-type") + ("vm-clear-all-marks") + ("vm-continue-composing-message") + ("vm-create-virtual-folder") + ("vm-decode-mime-message") ("vm-delete-message") ("vm-delete-message-backward") - ("vm-undelete-message") - ("vm-kill-subject") - ("vm-expunge-folder") - ("vm-burst-digest") - ("vm-burst-rfc934-digest") - ("vm-burst-rfc1153-digest") + ("vm-delete-message-labels") + ("vm-discard-cached-data") ("vm-edit-message") - ("vm-discard-cached-data") + ("vm-edit-message-abort") ("vm-edit-message-end") - ("vm-edit-message-abort") - ("vm-unread-message") - ("vm-quit-no-change") + ("vm-edit-message-other-frame") + ("vm-end-of-message") + ("vm-expose-hidden-headers") + ("vm-expunge-folder") + ("vm-followup") + ("vm-followup-include-text") + ("vm-followup-include-text-other-frame") + ("vm-followup-other-frame") + ("vm-forward-message") + ("vm-forward-message-all-headers") + ("vm-forward-message-all-headers-other-frame") + ("vm-forward-message-other-frame") + ("vm-get-new-mail") + ("vm-goto-message") + ("vm-goto-message-last-seen") + ("vm-goto-parent-message") + ("vm-help") + ("vm-isearch-forward") + ("vm-kill-subject") + ("vm-load-init-file") + ("vm-mail") + ("vm-mail-other-frame") + ("vm-mail-other-window") + ("vm-mail-send") + ("vm-mail-send-and-exit") + ("vm-mark-all-messages") + ("vm-mark-help") + ("vm-mark-matching-messages") + ("vm-mark-message") + ("vm-mark-messages-same-author") + ("vm-mark-messages-same-subject") + ("vm-mark-summary-region") + ("vm-mark-thread-subtree") + ("vm-mode") + ("vm-move-message-backward") + ("vm-move-message-backward-physically") + ("vm-move-message-forward") + ("vm-move-message-forward-physically") + ("vm-next-command-uses-marks") + ("vm-next-message") + ("vm-next-message-no-skip") + ("vm-next-message-no-skip") + ("vm-next-message-same-subject") + ("vm-next-unread-message") + ("vm-other-frame") + ("vm-other-window") + ("vm-pipe-message-to-command") + ("vm-previous-message") + ("vm-previous-message-no-skip") + ("vm-previous-message-no-skip") + ("vm-previous-message-same-subject") + ("vm-previous-unread-message") ("vm-quit") + ("vm-quit-just-bury") + ("vm-quit-just-iconify") + ("vm-quit-no-change") + ("vm-reply") + ("vm-reply-include-text") + ("vm-reply-include-text-other-frame") + ("vm-reply-other-frame") + ("vm-resend-bounced-message") + ("vm-resend-bounced-message-other-frame") + ("vm-resend-message") + ("vm-resend-message-other-frame") + ("vm-save-and-expunge-folder") ("vm-save-buffer") - ("vm-write-file") ("vm-save-folder") - ("vm-save-and-expunge-folder") + ("vm-save-message") + ("vm-save-message-sans-headers") + ("vm-scroll-backward") + ("vm-scroll-forward") + ("vm-send-digest") + ("vm-send-digest-other-frame") + ("vm-send-mime-digest") + ("vm-send-mime-digest-other-frame") + ("vm-send-rfc1153-digest") + ("vm-send-rfc1153-digest-other-frame") + ("vm-send-rfc934-digest") + ("vm-send-rfc934-digest-other-frame") + ("vm-set-message-attributes") + ("vm-show-copying-restrictions") + ("vm-show-no-warranty") + ("vm-sort-messages") + ("vm-submit-bug-report") + ("vm-summarize") + ("vm-summarize-other-frame") + ("vm-toggle-read-only") + ("vm-toggle-threads-display") + ("vm-undelete-message") + ("vm-undo") + ("vm-unmark-matching-messages") + ("vm-unmark-message") + ("vm-unmark-messages-same-author") + ("vm-unmark-messages-same-subject") + ("vm-unmark-summary-region") + ("vm-unmark-thread-subtree") + ("vm-unread-message") + ("vm-virtual-help") ("vm-visit-folder") ("vm-visit-folder-other-frame") ("vm-visit-folder-other-window") - ("vm-help") - ("vm-get-new-mail") - ("vm-load-init-file") - ("vm") - ("vm-other-frame") - ("vm-other-window") - ("vm-toggle-read-only") - ("vm-mode") - ("vm-show-copying-restrictions") - ("vm-show-no-warranty") - ("vm-clear-all-marks") - ("vm-mark-all-messages") - ("vm-mark-message") - ("vm-unmark-message") - ("vm-mark-messages-same-subject") - ("vm-unmark-messages-same-subject") - ("vm-mark-messages-same-author") - ("vm-unmark-messages-same-author") - ("vm-mark-matching-messages") - ("vm-unmark-matching-messages") - ("vm-mark-thread-subtree") - ("vm-unmark-thread-subtree") - ("vm-next-command-uses-marks") - ("vm-mark-help") - ("vm-submit-bug-report") - ("vm-goto-message") - ("vm-goto-message-last-seen") - ("vm-next-message") - ("vm-previous-message") - ("vm-next-message-no-skip") - ("vm-previous-message-no-skip") - ("vm-next-unread-message") - ("vm-previous-unread-message") - ("vm-scroll-forward") - ("vm-scroll-backward") - ("vm-expose-hidden-headers") - ("vm-beginning-of-message") - ("vm-end-of-message") - ("vm-yank-message-other-folder") - ("vm-yank-message") - ("vm-mail-send-and-exit") - ("vm-mail-send") - ("vm-reply") - ("vm-reply-include-text") - ("vm-followup") - ("vm-followup-include-text") - ("vm-forward-message") - ("vm-forward-message-all-headers") - ("vm-mail") - ("vm-resend-bounced-message") - ("vm-resend-message") - ("vm-send-digest") - ("vm-send-rfc934-digest") - ("vm-send-rfc1153-digest") - ("vm-reply-other-frame") - ("vm-reply-include-text-other-frame") - ("vm-followup-other-frame") - ("vm-followup-include-text-other-frame") - ("vm-forward-message-other-frame") - ("vm-forward-message-all-headers-other-frame") - ("vm-mail-other-frame") - ("vm-mail-other-window") - ("vm-resend-bounced-message-other-frame") - ("vm-resend-message-other-frame") - ("vm-send-digest-other-frame") - ("vm-send-rfc934-digest-other-frame") - ("vm-send-rfc1153-digest-other-frame") - ("vm-continue-composing-message") - ("vm-auto-archive-messages") - ("vm-save-message") - ("vm-save-message-sans-headers") - ("vm-pipe-message-to-command") - ("vm-isearch-forward") - ("vm-move-message-forward") - ("vm-move-message-backward") - ("vm-move-message-forward-physically") - ("vm-move-message-backward-physically") - ("vm-sort-messages") - ("vm-toggle-threads-display") - ("vm-summarize") - ("vm-summarize-other-frame") - ("vm-undo") ("vm-visit-virtual-folder") ("vm-visit-virtual-folder-other-frame") - ("vm-visit-virtual-folder-other-window"))) + ("vm-visit-virtual-folder-other-window") + ("vm-write-file") + ("vm-yank-message") + ("vm-yank-message-other-folder") +)) (defconst vm-supported-sort-keys '("date" "reversed-date" "author" "reversed-author" @@ -2182,7 +2661,7 @@ "unanswered")) (defvar vm-key-functions nil) -(defconst vm-digest-type-alist '(("rfc934") ("rfc1153"))) +(defconst vm-digest-type-alist '(("rfc934") ("rfc1153") ("mime"))) (defvar vm-completion-auto-correct t "Non-nil means that minibuffer-complete-file should aggressively erase the trailing part of a word that caused completion to fail, and retry @@ -2195,11 +2674,12 @@ append a space to words that complete unambiguously.") (defconst vm-attributes-vector-length 9) (defconst vm-cache-vector-length 20) -(defconst vm-softdata-vector-length 16) +(defconst vm-softdata-vector-length 18) (defconst vm-location-data-vector-length 6) (defconst vm-mirror-data-vector-length 5) (defconst vm-startup-message-lines '("Please use \\[vm-submit-bug-report] to report bugs." + "For discussion about the VM mail reader, see the gnu.emacs.vm.info newsgroup" "You may give out copies of VM. Type \\[vm-show-copying-restrictions] to see the conditions" "VM comes with ABSOLUTELY NO WARRANTY; type \\[vm-show-no-warranty] for full details" "In Stereo (where available)")) @@ -2207,7 +2687,7 @@ ;; for the mode line (defvar vm-mode-line-format '("" " %&%& " - ("VM: " + ("VM " vm-version ": " (vm-folder-read-only "read-only ") (vm-virtual-folder-definition (vm-virtual-mirror "mirrored ")) "%b" @@ -2277,7 +2757,6 @@ (defvar vm-forward-list nil) (defvar vm-redistribute-list nil) (defvar current-itimer nil) -(defvar mode-popup-menu nil) (defvar current-menubar nil) (defvar scrollbar-height nil) (defvar top-toolbar nil) @@ -2292,8 +2771,11 @@ ;; is loaded before highlight-headers.el (defvar highlight-headers-regexp "Subject[ \t]*:") (defvar vm-url-regexp - "\\(file\\|ftp\\|gopher\\|http\\|https\\|news\\|wais\\|www\\)://[^ \t\n\f\r\"<>|()]*[^ \t\n\f\r\"<>|.!?(){}]" - "Regular expression that matches an absolute URL.") + "<URL:\\([^>]+\\)>\\|\\(\\(file\\|ftp\\|gopher\\|http\\|https\\|news\\|wais\\|www\\)://[^ \t\n\f\r\"<>|()]*[^ \t\n\f\r\"<>|.!?(){}]\\)\\|\\(mailto:[^ \t\n\f\r\"<>|()]*[^ \t\n\f\r\"<>|.!?(){}]\\)" + "Regular expression that matches an absolute URL. +The URL itself must be matched by a \\(..\\) grouping. +VM will extract the URL by copying the lowest number grouping +that has a match.") (defconst vm-month-alist '(("jan" "January" "1") ("feb" "February" "2") @@ -2322,3 +2804,115 @@ (defvar vm-delete-duplicates-obarray (make-vector 29 0)) (defvar vm-mail-mode-map-parented nil) (defvar vm-xface-cache (make-vector 29 0)) +(defconst vm-mime-base64-alphabet + (concat + [ + 65 66 67 68 69 70 71 72 73 74 75 76 77 + 78 79 80 81 82 83 84 85 86 87 88 89 90 + 97 98 99 100 101 102 103 104 105 106 107 108 109 + 110 111 112 113 114 115 116 117 118 119 120 121 122 + 48 49 50 51 52 53 54 55 56 57 43 47 + ] + )) +(defconst vm-mime-base64-alphabet-decoding-vector + [ + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 62 0 0 0 63 + 52 53 54 55 56 57 58 59 60 61 0 0 0 0 0 0 + 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 + 15 16 17 18 19 20 21 22 23 24 25 0 0 0 0 0 + 0 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 + 41 42 43 44 45 46 47 48 49 50 51 0 0 0 0 0 + ]) + +;;(defconst vm-mime-base64-alphabet-decoding-alist +;; '( +;; ( 65 . 00) ( 66 . 01) ( 67 . 02) ( 68 . 03) ( 69 . 04) ( 70 . 05) +;; ( 71 . 06) ( 72 . 07) ( 73 . 08) ( 74 . 09) ( 75 . 10) ( 76 . 11) +;; ( 77 . 12) ( 78 . 13) ( 79 . 14) ( 80 . 15) ( 81 . 16) ( 82 . 17) +;; ( 83 . 18) ( 84 . 19) ( 85 . 20) ( 86 . 21) ( 87 . 22) ( 88 . 23) +;; ( 89 . 24) ( 90 . 25) ( 97 . 26) ( 98 . 27) ( 99 . 28) (100 . 29) +;; (101 . 30) (102 . 31) (103 . 32) (104 . 33) (105 . 34) (106 . 35) +;; (107 . 36) (108 . 37) (109 . 38) (110 . 39) (111 . 40) (112 . 41) +;; (113 . 42) (114 . 43) (115 . 44) (116 . 45) (117 . 46) (118 . 47) +;; (119 . 48) (120 . 49) (121 . 50) (122 . 51) ( 48 . 52) ( 49 . 53) +;; ( 50 . 54) ( 51 . 55) ( 52 . 56) ( 53 . 57) ( 54 . 58) ( 55 . 59) +;; ( 56 . 60) ( 57 . 61) ( 43 . 62) ( 47 . 63) +;; )) +;; +;;(defvar vm-mime-base64-alphabet-decoding-vector +;; (let ((v (make-vector 123 nil)) +;; (p vm-mime-base64-alphabet-decoding-alist)) +;; (while p +;; (aset v (car (car p)) (cdr (car p))) +;; (setq p (cdr p))) +;; v )) + +(defvar vm-message-garbage-alist nil) +(make-variable-buffer-local 'vm-message-garbage-alist) +(defvar vm-folder-garbage-alist nil) +(make-variable-buffer-local 'vm-folder-garbage-alist) +(defconst vm-mime-header-list '("MIME-Version:" "Content-")) +(defconst vm-mime-xemacs-mule-charset-alist + '( + ("us-ascii" no-conversion) + ("iso-8859-1" no-conversion) + ("iso-8859-2" iso-8859-2) + ("iso-8859-3" iso-8859-3) + ("iso-8859-4" iso-8859-4) + ("iso-8859-5" iso-8859-5) + ("iso-8859-6" iso-8859-6) + ("iso-8859-7" iso-8859-7) + ("iso-8859-8" iso-8859-8) + ("iso-8859-9" iso-8859-9) + ("iso-2022-jp" iso-2022-jp) + ;; probably not correct, but probably better than nothing. + ("iso-2022-jp-2" iso-2022-jp) + ("iso-2022-int-1" iso-2022-int-1) + ("iso-2022-kr" iso-2022-kr) + ("euc-kr" iso-2022-kr) + )) +(defconst vm-mime-charset-completion-alist + '( + ("us-ascii") + ("iso-8859-1") + ("iso-8859-2") + ("iso-8859-3") + ("iso-8859-4") + ("iso-8859-5") + ("iso-8859-6") + ("iso-8859-7") + ("iso-8859-8") + ("iso-8859-9") + ("iso-2022-jp") + ("iso-2022-jp-2") + ("iso-2022-int-1") + ("iso-2022-kr") + )) +(defconst vm-mime-type-completion-alist + '( + ("text/plain") + ("text/enriched") + ("text/html") + ("audio/basic") + ("image/jpeg") + ("image/png") + ("image/gif") + ("image/tiff") + ("video/mpeg") + ("application/postscript") + ("application/octet-stream") + ("message/rfc822") + )) +(defconst vm-mime-encoded-word-regexp + "=\\?\\([^?]+\\)\\?\\([BQ]\\)\\?\\([^?]+\\)\\?=") +;; for MS-DOS and Windows NT +;; nil value means text file +;; t value means binary file +;; presumably it controls whether LF -> CRLF mapping is done +;; when writing to files. +(defvar buffer-file-type) +(defvar vm-frame-list nil) +(if (not (boundp 'shell-command-switch)) + (defvar shell-command-switch "-c"))
--- a/lisp/vm/vm-version.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-version.el Mon Aug 13 08:50:05 2007 +0200 @@ -2,7 +2,7 @@ (provide 'vm-version) -(defconst vm-version "5.97" +(defconst vm-version "6.13" "Version number of VM.") (defun vm-version ()
--- a/lisp/vm/vm-virtual.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-virtual.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Virtual folders for VM -;;; Copyright (C) 1990, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1990-1997 Kyle E. Jones ;;; ;;; 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 @@ -165,8 +165,7 @@ (vm-buffer-of (vm-real-message-of (car mp)))) - (apply 'vm-vs-or (vm-real-message-of (car mp)) - selectors)) + (apply 'vm-vs-or (car mp) selectors)) (apply 'vm-vs-or (car mp) selectors))) (progn (intern @@ -221,12 +220,18 @@ ;; ;; Now we tie it all together, with this section of code being ;; uninterruptible. - (let ((inhibit-quit t)) + (let ((inhibit-quit t) + (label-obarray vm-label-obarray)) (if (null vm-real-buffers) (setq vm-real-buffers real-buffers-used)) (save-excursion (while real-buffers-used (set-buffer (car real-buffers-used)) + ;; inherit the global label lists of all the associated + ;; real folders. + (mapatoms (function (lambda (x) (intern (symbol-name x) + label-obarray))) + vm-label-obarray) (if (not (memq vbuffer vm-virtual-buffers)) (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers))) (setq real-buffers-used (cdr real-buffers-used)))) @@ -352,15 +357,6 @@ (vm-display nil nil '(vm-virtual-help) '(vm-virtual-help)) (message "VV = visit, VA = apply selectors, VC = create, VM = toggle virtual mirror")) -(defun vm-delete-directory-file-names (list) - (vm-delete 'file-directory-p list)) - -(defun vm-delete-backup-file-names (list) - (vm-delete 'backup-file-name-p list)) - -(defun vm-delete-auto-save-file-names (list) - (vm-delete 'auto-save-file-name-p list)) - (defun vm-vs-or (m &rest selectors) (let ((result nil) selector arglist) (while selectors @@ -407,8 +403,8 @@ (save-excursion (save-restriction (widen) - (goto-char (vm-headers-of m)) - (re-search-forward arg (vm-text-of m) t)))) + (goto-char (vm-headers-of (vm-real-message-of m))) + (re-search-forward arg (vm-text-of (vm-real-message-of m)) t)))) (defun vm-vs-label (m arg) (vm-member arg (vm-labels-of m))) @@ -417,8 +413,8 @@ (save-excursion (save-restriction (widen) - (goto-char (vm-text-of m)) - (re-search-forward arg (vm-text-end-of m) t)))) + (goto-char (vm-text-of (vm-real-message-of m))) + (re-search-forward arg (vm-text-end-of (vm-real-message-of m)) t)))) (defun vm-vs-more-chars-than (m arg) (> (string-to-int (vm-su-byte-count m)) arg)) @@ -485,6 +481,8 @@ vm-label-obarray) nil))))) (t (setq arg (read-string prompt)))))) + (or (fboundp (intern (concat "vm-vs-" (symbol-name selector)))) + (error "Invalid selector")) (list selector arg))) ;; clear away links between real and virtual folders when @@ -536,22 +534,26 @@ (setq vm-real-buffers (delq b vm-real-buffers)) ;; set the message pointer to a new value if it is ;; now invalid. - (setq vmp vm-message-pointer) - (while (and vm-message-pointer - (equal "Q" (vm-message-id-number-of - (car vm-message-pointer)))) - (setq vm-message-pointer - (cdr vm-message-pointer))) - ;; if there were no good messages ahead, try going - ;; backward. - (if (null vm-message-pointer) - (progn - (setq vm-message-pointer vmp) - (while (and vm-message-pointer - (equal "Q" (vm-message-id-number-of - (car vm-message-pointer)))) - (setq vm-message-pointer - (vm-reverse-link-of (car vm-message-pointer)))))) + (cond + ((equal "Q" (vm-message-id-number-of (car vm-message-pointer))) + (vm-garbage-collect-message) + (setq vmp vm-message-pointer) + (while (and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) + (setq vm-message-pointer + (cdr vm-message-pointer))) + ;; if there were no good messages ahead, try going + ;; backward. + (if (null vm-message-pointer) + (progn + (setq vm-message-pointer vmp) + (while (and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) + (setq vm-message-pointer + (vm-reverse-link-of + (car vm-message-pointer)))))))) ;; expunge the virtual messages associated with ;; real messages that are going away. (setq vm-message-list
--- a/lisp/vm/vm-window.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/vm/vm-window.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,5 @@ ;;; Window management code for VM -;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones +;;; Copyright (C) 1989-1997 Kyle E. Jones ;;; ;;; 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 @@ -17,7 +17,8 @@ (provide 'vm-window) -(defun vm-display (buffer display commands configs) +(defun vm-display (buffer display commands configs + &optional do-not-raise) ;; the clearinghouse VM display function. ;; ;; First arg BUFFER non-nil is a buffer to display or undisplay. @@ -62,11 +63,13 @@ ;; configuration is done, and only then if the value of ;; this-command is found in the COMMANDS list. (vm-save-buffer-excursion - (let ((w (and buffer (vm-get-buffer-window buffer)))) + (let* ((w (and buffer (vm-get-buffer-window buffer))) + (wf (and w (vm-window-frame w)))) (and buffer (set-buffer buffer)) - (and w display (vm-raise-frame (vm-window-frame w))) - (and w display (not (eq (vm-selected-frame) (vm-window-frame w))) - (vm-select-frame (vm-window-frame w))) + (if (and w display (not do-not-raise)) + (vm-raise-frame wf)) + (if (and w display (not (eq (vm-selected-frame) wf))) + (vm-select-frame wf)) (cond ((and buffer display) (if (and vm-display-buffer-hook (null (vm-get-visible-buffer-window buffer))) @@ -155,12 +158,16 @@ (setq message vm-mail-buffer))) ((eq major-mode 'vm-mode) (setq message (current-buffer))) + ((eq major-mode 'vm-presentation-mode) + (setq message vm-mail-buffer)) ((eq major-mode 'vm-virtual-mode) (setq message (current-buffer))) ((eq major-mode 'mail-mode) (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) (throw 'done nil) - (setq message vm-mail-buffer))) + (setq message vm-mail-buffer + ;; assume that the proximity implies affinity + composition (current-buffer)))) ((eq vm-system-state 'editing) (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) (throw 'done nil) @@ -169,6 +176,9 @@ ;; not in a VM related buffer, bail... (t (throw 'done nil))) (set-buffer message) + (vm-check-for-killed-presentation) + (if vm-presentation-buffer + (setq message vm-presentation-buffer)) ;; if this configuration is already the current one, don't ;; set it up again. (if (or (and vm-mutable-frames (eq (car config) vm-window-configuration)) @@ -395,7 +405,8 @@ (progn (condition-case nil (progn - (vm-delete-frame delete-me) + (if (vm-created-this-frame-p delete-me) + (vm-delete-frame delete-me)) (if (eq delete-me start) (setq start nil))) (error nil)) @@ -473,21 +484,31 @@ (defun vm-set-hooks-for-frame-deletion () (make-local-variable 'vm-undisplay-buffer-hook) - (make-local-variable 'kill-buffer-hook) (add-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) (add-hook 'kill-buffer-hook 'vm-delete-buffer-frame)) +(defun vm-created-this-frame-p (&optional frame) + (memq (or frame (vm-selected-frame)) vm-frame-list)) + (defun vm-delete-buffer-frame () - (save-excursion - (let ((w (vm-get-visible-buffer-window (current-buffer))) - (b (current-buffer))) - (and w (eq (vm-selected-frame) (vm-window-frame w)) - (vm-error-free-call 'vm-delete-frame (vm-window-frame w))) - (and w (let ((vm-mutable-frames t)) - (vm-delete-windows-or-frames-on b))))) - ;; do it only once - (remove-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) - (remove-hook 'kill-buffer-hook 'vm-delete-buffer-frame)) + ;; kludge. we only want to this to run on VM related buffers + ;; but this function is generally on a global hook. Check for + ;; vm-undisplay-buffer-hook set; this is a good sign that this + ;; is a VM buffer. + (if vm-undisplay-buffer-hook + (save-excursion + ;; run once only per buffer. + (remove-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) + (let* ((w (vm-get-visible-buffer-window (current-buffer))) + (b (current-buffer)) + (wf (and w (vm-window-frame w)))) + (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf) + (vm-error-free-call 'vm-delete-frame wf)) + (and w (let ((vm-mutable-frames t)) + (vm-delete-windows-or-frames-on b))))))) + +(defun vm-register-frame (frame) + (setq vm-frame-list (cons frame vm-frame-list))) (defun vm-goto-new-frame (&rest types) (let ((params nil)) @@ -503,9 +524,42 @@ (select-screen (make-screen params))) ((fboundp 'new-screen) (select-screen (new-screen params)))) + (vm-register-frame (vm-selected-frame)) (and vm-warp-mouse-to-new-frame (vm-warp-mouse-to-frame-maybe (vm-selected-frame))))) +(defun vm-goto-new-summary-frame-maybe () + (if (and vm-frame-per-summary (vm-multiple-frames-possible-p)) + (let ((w (vm-get-buffer-window vm-summary-buffer))) + (if (null w) + (progn + (vm-goto-new-frame 'summary) + (vm-set-hooks-for-frame-deletion)) + (save-excursion + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) + +(defun vm-goto-new-folder-frame-maybe (&rest types) + (if (and vm-frame-per-folder (vm-multiple-frames-possible-p)) + (let ((w (or (vm-get-buffer-window (current-buffer)) + ;; summary == folder for the purpose + ;; of frame reuse. + (and vm-summary-buffer + (vm-get-buffer-window vm-summary-buffer)) + ;; presentation == folder for the purpose + ;; of frame reuse. + (and vm-presentation-buffer + (vm-get-buffer-window vm-presentation-buffer))))) + (if (null w) + (progn + (apply 'vm-goto-new-frame types) + (vm-set-hooks-for-frame-deletion)) + (save-excursion + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) + (defun vm-warp-mouse-to-frame-maybe (&optional frame) (or frame (setq frame (vm-selected-frame))) (if (vm-mouse-support-possible-p) @@ -577,6 +631,22 @@ ((fboundp 'screen-visible-p) 'screen-visible-p) (t 'ignore)))) +(if (fboundp 'frame-iconified-p) + (fset 'vm-frame-iconified-p 'frame-iconified-p) + (defun vm-frame-iconified-p (&optional frame) + (eq (vm-frame-visible-p frame) 'icon))) + +;; frame-totally-visible-p is broken under XEmacs 19.14 and is +;; absent under Emacs 19.34. So vm-frame-per-summary won't work +;; quite right under these Emacs versions. XEmacs 19.15 should +;; have a working version of this function. +(if (and (fboundp 'frame-totally-visible-p) + (vm-xemacs-p) + (or (>= emacs-major-version 20) + (>= emacs-minor-version 15))) + (fset 'vm-frame-totally-visible-p 'frame-totally-visible-p) + (fset 'vm-frame-totally-visible-p 'vm-frame-visible-p)) + (fset 'vm-window-frame (symbol-function (cond ((fboundp 'window-frame) 'window-frame)
--- a/lisp/w3/ChangeLog Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 08:50:05 2007 +0200 @@ -1,5 +1,181 @@ +Sat Feb 8 13:54:43 1997 William M. Perry <wmperry@aventail.com> + +* Emacs-W3 3.0.56 released. Getting closer! + +* w3-forms.el (w3-form-summarize-radio-button): Finally, a decent + summarization of radio buttons + Fixed typo in specifying summarizer for hidden form fields. + (w3-form-keymap): Bind C-a and C-e by default. + +* w3-widget.el (widget-image-value-create): When using emacspeak, show + client side imagemaps as a table. Need a more general solution for + this, but this makes us nicer than IE again. :) + +* Updated to widget 1.30 + +Fri Feb 7 16:49:55 1997 William M. Perry <wmperry@aventail.com> + +* w3-display.el (w3-handle-string-content): Make sure faces text + properties are closed, so that things don't bleed over. + (w3-fixup-eol-faces): New function for Emacs 19 that removes face + information at newlines, so that underlining will not extend from the + end of a line to the window edges - very ugly. + +* w3-menu.el (w3-menu-initialize-w3-mode-menu-map): Don't support 'emacs + in w3-use-menus under Emacs in Windows 95/NT. + +* w3-display.el (w3-finalize-image-download): Deal with bad images better. + (w3-finish-drawing): Better protection of putting images in. + +* url-gw.el (url-open-stream): Don't auto-retry connections. Don't throw + an error if you fail to connect to a site. This is for image loadings + that fail for some reason or another. + +* css.el (css-expand-length): better handling of float values and 'ex' + unit type. + +* font.el (x-font-create-object): Unconditionally make case-fold-search + non-nil so that we don't lose big-time. This was the cause of the very + weird font-spatial-to-canonical lossage under XEmacs with font sizes of + something like '+12pt' + +* w3.el (w3-view-this-url): Use widget-echo-help if we didn't find a URL + under point. + +Fri Feb 7 15:22:25 1997 Charles Levert <charles@comm.polymtl.ca> + +* w3-widget.el (widget-image-notify): Bad data being fed to w3-fetch if a + client-side imagemap had an alt attribute (but only if the <map> came + _after_ the use. + +Fri Feb 7 15:22:25 1997 William M. Perry <wmperry@aventail.com> + +* font.el (font-spatial-to-canonical): protect against bad input to this + function. + +Fri Feb 7 15:19:36 1997 Toby Speight <tms@ansa.co.uk> + +* w3-parse.el (w3-parse-buffer): Parser didn't allow for the fact that + TAGC is optional on end-tags as well as on start-tags (i.e. "<b<i> + bold-italic</i</b>" is legal). + +Fri Feb 7 06:28:37 1997 William M. Perry <wmperry@aventail.com> + +* w3-forms.el (w3-form-keymap): Now inherits from widget-keymap, with a + few exceptions. + +* url.el (url-uncompress): This function now no longer looks at the file + extension to determine a compression/encoding method. This is so that + doing searches on `foo.tar.gz' will not bogusly cause the decompression + steps to run. Ick! + +* url-file.el (url-insert-possibly-compressed-file): This function no + longer atempts to decompress the file after loading it in. Instead, it + sets an appropriate content-transfer-encoding header based on the + filename, so that this will allow url-uncompress to work correctly on the + buffer. + +Thu Feb 6 06:24:26 1997 William M. Perry <wmperry@aventail.com> + +* w3-print.el (w3-postscript-print-function): New variable to control what + function is used to generate postscript output. + (w3-print-this-url): Use it. + +* w3-display.el (w3-handle-string-content): Make all inserted text + read-only + +* w3-forms.el (w3-form-use-old-style): New variable to control whether to + use the old-style interaction with form fields instead of the 'type + directly into the buffer' method + (w3-form-determine-size): Use it. + (w3-form-create-integer): Use it. + (w3-form-create-float): Use it. + (w3-form-create-text): Use it. + (w3-form-create-password): Use it. + (w3-revert-form): Fixed error with 'reset' buttons on forms that had + hidden form fields. + +* w3-vars.el (w3-mode-map): Define [backtab] by default + +* w3-display.el (w3-size-of-tree): Removed some warnings +(w3-display-table-dimensions): ditto + +* Updated to widget 1.26 + +* default.css: Some default formatting changes for input fields. + Everything is underlined by default except submit/reset/image/button + fields, so that they are a little easier to spot. + +* w3-parse.el (w3-parse-buffer): Now slaps pseudo-elements into input + fields so that stylesheets can access them. + +Wed Feb 5 14:42:12 1997 William M. Perry <wmperry@aventail.com> + +* Updated to widget 1.24 + +* Happy birthday Jenny P. + +Tue Feb 4 08:21:03 1997 William M. Perry <wmperry@aventail.com> + +* font.el (x-font-create-name): Better checking/optimizing of when to just + return the default font. + +* w3-forms.el: Make use of the new information, and pass it down to the + widget library appropriately. + +* w3-display.el (w3-display-node): Now passes in the entire list of active + faces to form creation functions. + +Mon Feb 3 07:26:18 1997 William M. Perry <wmperry@aventail.com> + +* w3-emulate.el (w3-lynx-emulation-minor-mode-map): Lots of new + keybindings for lynx emulation minor mode. + +* Emacs-W3 3.0.55 released + +* w3-forms.el (w3-form-determine-size): Fixed _STUPID_ problem where + option lists would lose everything but the first option in them. I'm a + dumbass. Sort modifies its list parameter! ICK ICK ICK. + +* url.el (url-after-change-function): Show prettier status messages. + Sizes are converted to bytes, k, or M, depending on how big the file + is. + +* w3.txi: Lots of documentation changes - volunteers welcome. + +* Removed personal annotation support, since it wasn't shown with the new + display engine, it needs to be rethought, and nobody had complained in + the entire beta cycle. + +* w3.el (w3-history-find-url-internal): Redid the history mechanism. + Toolbar and menu entries are now grayed out appropriately. + +* url-http.el (url-create-mime-request): Fixed cookie support if not going + through a proxy gateway. + +Sun Feb 2 22:05:41 1997 William M. Perry <wmperry@aventail.com> + +* w3-display.el (w3-display-table): Fix for negative colwidth + +Fri Jan 31 14:28:54 1997 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-fetch): Fixed targetted links (http://blah/#foo) + +Fri Jan 31 11:20:47 1997 Alf-Ivar Holm <alfh@ifi.uio.no> + +* w3.el (w3-mail-current-document): Fixed problem with calling + w3-parse-buffer with too many arguments when mailing LaTeX-ified + files. + +Fri Jan 31 11:19:37 1997 Cord Kielhorn <kielhorn@thphy.uni-duesseldorf.de> + +* css.el (css-expand-length): Fixed bad regexps for percentage and + character based lengths + Thu Jan 30 20:27:06 1997 William M. Perry <wmperry@aventail.com> +* Emacs-W3 3.0.52 released + * w3-display.el (w3-handle-image): When doing table auto layout, don't start loading the images.
--- a/lisp/w3/Makefile Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 08:50:05 2007 +0200 @@ -46,9 +46,9 @@ $(CUSTOMSOURCES) $(URLSOURCES) mule-sysdp.el w3-widget.el \ w3-imap.el css.el dsssl.el font.el images.el w3-vars.el \ w3-style.el w3-keyword.el w3-forms.el w3-emulate.el \ - w3-annotat.el w3-auto.el w3-menu.el w3-mouse.el w3-toolbar.el \ - w3-prefs.el w3-speak.el w3-latex.el w3-parse.el w3-display.el \ - w3-print.el w3-about.el w3-hot.el w3-e19.el w3-xemac.el w3.el + w3-auto.el w3-menu.el w3-mouse.el w3-toolbar.el w3-prefs.el \ + w3-speak.el w3-latex.el w3-parse.el w3-display.el w3-print.el \ + w3-about.el w3-hot.el w3-e19.el w3-xemac.el w3.el OBJECTS = $(SOURCES:.el=.elc)
--- a/lisp/w3/css.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/01/17 14:30:54 -;; Version: 1.25 +;; Created: 1997/02/08 05:24:49 +;; Version: 1.27 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -366,10 +366,10 @@ (cond ((not (stringp spec)) spec) ((string-equal spec "auto") nil) - ((string-match "\([0-9]+\)%" spec) ; A percentage + ((string-match "\\([+-]?\\([0-9]+\\|[0-9]*\\.[0-9]+\\)\\)%" spec) ; A percentage nil) - ((string-match "\([0-9]+\)e[mn]" spec) ; Character based - (string-to-int (substring spec (match-beginning 1) (match-end 1)))) + ((string-match "\\([+-]?\\([0-9]+\\|[0-9]*\\.[0-9]+\\)\\)e[mx]" spec) ; Character based + (max 0 (round (string-to-number (match-string 1 spec))))) (t (truncate (font-spatial-to-canonical spec))) )
--- a/lisp/w3/docomp.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/docomp.el Mon Aug 13 08:50:05 2007 +0200 @@ -78,9 +78,6 @@ 'gnus-nntp-server 'nntp-server-name 'nntp-version 'gnus-default-nntp-server) -;; For ps-print -(w3-declare-variables 'ps-bold-faces 'ps-italic-faces 'ps-print-version) - ;; For xpm-button (w3-declare-variables 'x-library-search-path) @@ -108,5 +105,6 @@ (and w3-running-FSF19 (< emacs-minor-version 29) (require 'font)) + (require 'w3-sysdp) (provide 'ange-ftp)
--- a/lisp/w3/font.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/01/30 00:58:33 -;; Version: 1.29 +;; Created: 1997/02/08 00:56:14 +;; Version: 1.33 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,7 +30,8 @@ ;;; The emacsen compatibility package - load it up before anything else ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile - (require 'w3-sysdp) + (unless (string-match "XEmacs" emacs-version) + (require 'w3-sysdp)) (require 'cl)) (require 'disp-table) @@ -295,8 +296,12 @@ (defun font-spatial-to-canonical (spec &optional device) "Convert SPEC (in inches, millimeters, points, or picas) into points" ;; 1 in = 6 pa = 25.4 mm = 72 pt - (if (numberp spec) - spec + (cond + ((numberp spec) + spec) + ((null spec) + nil) + (t (let ((num nil) (type nil) ;; If for any reason we get null for any of this, default @@ -339,7 +344,7 @@ (t (setq retval num)) ) - retval))) + retval)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -466,46 +471,47 @@ )))) (defun x-font-create-object (fontname &optional device) - (if (or (not (stringp fontname)) - (not (string-match font-x-font-regexp fontname))) - (make-font) - (let ((family nil) - (style nil) - (size nil) - (weight (match-string 1 fontname)) - (slant (match-string 2 fontname)) - (swidth (match-string 3 fontname)) - (adstyle (match-string 4 fontname)) - (pxsize (match-string 5 fontname)) - (ptsize (match-string 6 fontname)) - (retval nil) - (case-fold-search t) - ) - (if (not (string-match x-font-regexp-foundry-and-family fontname)) - nil - (setq family (list (downcase (match-string 1 fontname))))) - (if (string= "*" weight) (setq weight nil)) - (if (string= "*" slant) (setq slant nil)) - (if (string= "*" swidth) (setq swidth nil)) - (if (string= "*" adstyle) (setq adstyle nil)) - (if (string= "*" pxsize) (setq pxsize nil)) - (if (string= "*" ptsize) (setq ptsize nil)) - (if ptsize (setq size (/ (string-to-int ptsize) 10))) - (if (and (not size) pxsize) (setq size (concat pxsize "px"))) - (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) - (if (and adstyle (not (equal adstyle ""))) - (setq family (append family (list (downcase adstyle))))) - (setq retval (make-font :family family - :weight weight - :size size)) - (set-font-bold-p retval (eq :bold weight)) - (cond - ((null slant) nil) - ((member slant '("i" "I")) - (set-font-italic-p retval t)) - ((member slant '("o" "O")) - (set-font-oblique-p retval t))) - retval))) + (let ((case-fold-search t)) + (if (or (not (stringp fontname)) + (not (string-match font-x-font-regexp fontname))) + (make-font) + (let ((family nil) + (style nil) + (size nil) + (weight (match-string 1 fontname)) + (slant (match-string 2 fontname)) + (swidth (match-string 3 fontname)) + (adstyle (match-string 4 fontname)) + (pxsize (match-string 5 fontname)) + (ptsize (match-string 6 fontname)) + (retval nil) + (case-fold-search t) + ) + (if (not (string-match x-font-regexp-foundry-and-family fontname)) + nil + (setq family (list (downcase (match-string 1 fontname))))) + (if (string= "*" weight) (setq weight nil)) + (if (string= "*" slant) (setq slant nil)) + (if (string= "*" swidth) (setq swidth nil)) + (if (string= "*" adstyle) (setq adstyle nil)) + (if (string= "*" pxsize) (setq pxsize nil)) + (if (string= "*" ptsize) (setq ptsize nil)) + (if ptsize (setq size (/ (string-to-int ptsize) 10))) + (if (and (not size) pxsize) (setq size (concat pxsize "px"))) + (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) + (if (and adstyle (not (equal adstyle ""))) + (setq family (append family (list (downcase adstyle))))) + (setq retval (make-font :family family + :weight weight + :size size)) + (set-font-bold-p retval (eq :bold weight)) + (cond + ((null slant) nil) + ((member slant '("i" "I")) + (set-font-italic-p retval t)) + ((member slant '("o" "O")) + (set-font-oblique-p retval t))) + retval)))) (defun x-font-families-for-device (&optional device no-resetp) (condition-case () @@ -565,9 +571,7 @@ (font-size fontobj) (font-registry fontobj) (font-encoding fontobj))) - (not (font-bold-p fontobj)) - (not (font-italic-p fontobj)) - (not (font-oblique-p fontobj))) + (= (font-style fontobj) 0)) (face-font 'default) (or device (setq device (selected-device))) (let ((family (or (font-family fontobj)
--- a/lisp/w3/images.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/images.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; images.el --- Automatic image converters ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.6 +;; Created: 1997/02/06 15:26:06 +;; Version: 1.7 ;; Keywords: images ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,7 +30,10 @@ ;;; The emacsen compatibility package - load it up before anything else ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile - (require 'w3-sysdp)) + (if (not (and (string-match "XEmacs" emacs-version) + (or (> emacs-major-version 19) + (>= emacs-minor-version 14)))) + (require 'w3-sysdp))) (defvar image-temp-stack nil "Do no touch - internal storage.") (defvar image-converters nil "Storage for the image converters.")
--- a/lisp/w3/url-file.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url-file.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-file.el --- File retrieval code ;; Author: wmperry -;; Created: 1997/01/24 14:32:50 -;; Version: 1.9 +;; Created: 1997/02/07 14:29:24 +;; Version: 1.10 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -44,40 +44,44 @@ (coding-system-for-read mule-no-coding-system)) (setq compressed (cond - ((file-exists-p fname) nil) + ((file-exists-p fname) + (if (string-match "\\.\\(z\\|gz\\|Z\\)$" fname) + (case (intern (match-string 1 fname)) + ((z gz) + (setq url-current-mime-headers (cons + (cons + "content-transfer-encoding" + "gzip") + url-current-mime-headers))) + (Z + (setq url-current-mime-headers (cons + (cons + "content-transfer-encoding" + "compress") + url-current-mime-headers)))) + nil)) ((file-exists-p (concat fname ".Z")) - (setq fname (concat fname ".Z"))) + (setq fname (concat fname ".Z") + url-current-mime-headers (cons (cons + "content-transfer-encoding" + "compress") + url-current-mime-headers))) ((file-exists-p (concat fname ".gz")) - (setq fname (concat fname ".gz"))) + (setq fname (concat fname ".gz") + url-current-mime-headers (cons (cons + "content-transfer-encoding" + "gzip") + url-current-mime-headers))) ((file-exists-p (concat fname ".z")) - (setq fname (concat fname ".z"))) + (setq fname (concat fname ".z") + url-current-mime-headers (cons (cons + "content-transfer-encoding" + "gzip") + url-current-mime-headers))) (t (error "File not found %s" fname)))) - (if (or (not compressed) url-inhibit-uncompression) - (apply 'insert-file-contents fname args) - (let* ((extn (url-file-extension fname)) - (code (cdr-safe (assoc extn url-uncompressor-alist))) - (decoder (cdr-safe (assoc code mm-content-transfer-encodings)))) - (cond - ((null decoder) - (apply 'insert-file-contents fname args)) - ((stringp decoder) - (apply 'insert-file-contents fname args) - (message "Decoding...") - (call-process-region (point-min) (point-max) decoder t t nil) - (message "Decoding... done.")) - ((listp decoder) - (apply 'call-process-region (point-min) (point-max) - (car decoder) t t t (cdr decoder))) - ((and (symbolp decoder) (fboundp decoder)) - (apply 'insert-file-contents fname args) - (message "Decoding...") - (funcall decoder (point-min) (point-max)) - (message "Decoding... done.")) - (t - (error "Malformed entry for %s in `mm-content-transfer-encodings'" - code)))))) - (set-buffer-modified-p nil)) + (apply 'insert-file-contents fname args) + (set-buffer-modified-p nil))) (defun url-format-directory (dir) ;; Format the files in DIR into hypertext
--- a/lisp/w3/url-gopher.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url-gopher.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.4 +;; Created: 1997/02/08 05:25:58 +;; Version: 1.5 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -270,8 +270,8 @@ url-current-type "gopher") (if (> (length selector) 0) (setq selector (substring selector 1 nil))) - (if (stringp proc) - (message "%s" proc) + (if (not (processp proc)) + nil (save-excursion (process-send-string proc (concat selector "\r\n")) (while (and (or (not wait-for)
--- a/lisp/w3/url-gw.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url-gw.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-gw.el --- Gateway munging for URL loading ;; Author: wmperry -;; Created: 1997/01/16 14:17:34 -;; Version: 1.3 +;; Created: 1997/02/08 05:29:07 +;; Version: 1.4 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -188,7 +188,6 @@ (int-to-string service)))) ;; An attempt to deal with denied connections, and attempt to reconnect - (max-retries url-connection-retries) (cur-retries 0) (retry t) (errobj nil) @@ -198,44 +197,32 @@ (if url-gateway-broken-resolution (setq host (url-nslookup-host host))) - (while (and (not conn) retry) - (condition-case errobj - (setq conn (case gw-method - (ssl - (open-ssl-stream name buffer host service)) - ((tcp native) - (and (eq 'tcp gw-method) (require 'tcp)) - (open-network-stream name buffer host service)) - (socks - (socks-open-network-stream name buffer host service)) - (telnet - (url-open-telnet name buffer host service)) - (rlogin - (url-open-rlogin name buffer host service)) - (otherwise - (error "Bad setting of url-gateway-method: %s" - url-gateway-method)))) - (error - (url-save-error errobj) - (save-window-excursion - (save-excursion - (switch-to-buffer-other-window " *url-error*") - (shrink-window-if-larger-than-buffer) - (goto-char (point-min)) - (if (and (re-search-forward "in use" nil t) - (< cur-retries max-retries)) - (progn - (setq retry t - cur-retries (1+ cur-retries)) - (sleep-for 0.5)) - (setq cur-retries 0 - retry (funcall url-confirmation-func - (concat "Connection to " host - " failed, retry? ")))) - (kill-buffer (current-buffer))))))) - (if (not conn) - (error "Unable to connect to %s:%s" host service) - (mule-inhibit-code-conversion conn) - conn))) + (condition-case errobj + (setq conn (case gw-method + (ssl + (open-ssl-stream name buffer host service)) + ((tcp native) + (and (eq 'tcp gw-method) (require 'tcp)) + (open-network-stream name buffer host service)) + (socks + (socks-open-network-stream name buffer host service)) + (telnet + (url-open-telnet name buffer host service)) + (rlogin + (url-open-rlogin name buffer host service)) + (otherwise + (error "Bad setting of url-gateway-method: %s" + url-gateway-method)))) + (error + (insert "Could not contact host: " host " / " + (if (stringp service) service (int-to-string service)) + "\nAttempted using gateway method: " + (symbol-name gw-method) + "\n---- Error was: ----\n") + (setq url-current-mime-headers '(("content-type" . "text/plain"))) + (display-error errobj (current-buffer)))) + (if conn + (mule-inhibit-code-conversion conn)) + conn)) (provide 'url-gw)
--- a/lisp/w3/url-http.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url-http.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-http.el --- HTTP Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/01/26 03:56:59 -;; Version: 1.11 +;; Created: 1997/02/08 05:29:12 +;; Version: 1.13 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -133,7 +133,7 @@ (let ((url-basic-auth-storage url-proxy-basic-authentication)) (url-get-authentication url nil 'any nil)))) - (proxy-obj (if (boundp 'proxy-info) + (proxy-obj (if (and (boundp 'proxy-info) proxy-info) (url-generic-parse-url proxy-info))) (real-fname (if proxy-obj (url-filename proxy-obj) fname)) (host (or (and proxy-obj (url-host proxy-obj)) @@ -583,21 +583,8 @@ (let ((process (url-open-stream "WWW" url-working-buffer server (string-to-int port)))) - (if (stringp process) - (progn - (set-buffer url-working-buffer) - (erase-buffer) - (setq url-current-mime-type "text/html" - url-current-mime-viewer - (mm-mime-info "text/html" nil 5)) - (insert "<title>ERROR</title>\n" - "<h1>ERROR - Could not establish connection</h1>" - "<p>" - "The browser could not establish a connection " - (format "to %s:%s.<P>" server port) - "The server is either down, or the URL" - (format "(%s) is malformed.<p>" (url-view-url t))) - (message "%s" process)) + (if (not (processp process)) + nil (progn (url-process-put process 'url (or proxy-info url)) (process-kill-without-query process)
--- a/lisp/w3/url-misc.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url-misc.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/01/21 21:14:56 -;; Version: 1.9 +;; Created: 1997/02/08 05:29:22 +;; Version: 1.10 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -54,8 +54,8 @@ (user (url-unhex-string (url-filename urlobj))) (proc (url-open-stream "finger" url-working-buffer host (string-to-int port)))) - (if (stringp proc) - (message "%s" proc) + (if (not (processp proc)) + nil (process-kill-without-query proc) (if (= (string-to-char user) ?/) (setq user (substring user 1 nil)))
--- a/lisp/w3/url-vars.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/01/16 14:13:05 -;; Version: 1.24 +;; Created: 1997/02/08 05:29:30 +;; Version: 1.26 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -273,7 +273,6 @@ (defvar url-working-buffer url-default-working-buffer " The buffer to do all of the processing in. (It defaults to `url-default-working-buffer' and is bound to ` *URL-<i>*' buffers when used for multiple requests, cf. `url-multiple-p')") -(defvar url-current-annotation nil "URL of document we are annotating...") (defvar url-current-referer nil "Referer of this page.") (defvar url-current-content-length nil "Current content length.") (defvar url-current-file nil "Filename of current document.") @@ -427,12 +426,6 @@ single argument (the prompt), and returns t only if a positive answer is gotten.") -(defvar url-connection-retries 5 - "*# of times to try for a connection before bailing. -If for some reason url-open-stream cannot make a connection to a host -right away, it will sit for 1 second, then try again, up to this many -tries.") - (defvar url-find-this-link nil "Link to go to within a document.") (defvar url-gateway-method 'native
--- a/lisp/w3/url.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/01/29 14:32:36 -;; Version: 1.48 +;; Created: 1997/02/07 14:30:25 +;; Version: 1.51 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/01/29 14:32:36|1.48|Location Undetermined +;;; 1997/02/07 14:30:25|1.51|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -44,7 +44,11 @@ (require 'ange-ftp) (error nil))) -(require 'w3-sysdp) +(eval-and-compile + (if (not (and (string-match "XEmacs" emacs-version) + (or (> emacs-major-version 19) + (>= emacs-minor-version 14)))) + (require 'w3-sysdp))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions that might not exist in old versions of emacs @@ -277,6 +281,15 @@ (round (* 100 (/ x (float y)))) (/ (* x 100) y))) +(defun url-pretty-length (n) + (cond + ((< n 1024) + (format "%d bytes" n)) + ((< n (* 1024 1024)) + (format "%dk" (/ n 1024.0))) + (t + (format "%2.2fM" (/ n (* 1024 1024.0)))))) + (defun url-after-change-function (&rest args) ;; The nitty gritty details of messaging the HTTP/1.0 status messages ;; in the minibuffer." @@ -311,22 +324,25 @@ (cond ((and url-current-content-length (> url-current-content-length 1) url-current-mime-type) - (url-lazy-message "Reading [%s]... %d of %d bytes (%d%%)" + (url-lazy-message "Reading [%s]... %s of %s (%d%%)" url-current-mime-type - current-length - url-current-content-length + (url-pretty-length current-length) + (url-pretty-length url-current-content-length) (url-percentage current-length url-current-content-length))) ((and url-current-content-length (> url-current-content-length 1)) - (url-lazy-message "Reading... %d of %d bytes (%d%%)" - current-length url-current-content-length + (url-lazy-message "Reading... %s of %s (%d%%)" + (url-pretty-length current-length) + (url-pretty-length url-current-content-length) (url-percentage current-length url-current-content-length))) ((and (/= 1 current-length) url-current-mime-type) - (url-lazy-message "Reading [%s]... %d bytes" - url-current-mime-type current-length)) + (url-lazy-message "Reading [%s]... %s" + url-current-mime-type + (url-pretty-length current-length))) ((/= 1 current-length) - (url-lazy-message "Reading... %d bytes." current-length)) + (url-lazy-message "Reading... %s." + (url-pretty-length current-length))) (t (url-lazy-message "Waiting for response..."))))) (defun url-insert-entities-in-string (string) @@ -1527,8 +1543,6 @@ url-current-mime-headers))) (code-2 (cdr-safe (assoc "content-encoding" url-current-mime-headers))) - (code-3 (and (not code-1) (not code-2) - (cdr-safe (assoc extn url-uncompressor-alist)))) (done nil) (default-process-coding-system (cons mule-no-coding-system mule-no-coding-system))) @@ -1539,23 +1553,22 @@ (cdr-safe (assoc code mm-content-transfer-encodings))) done (cons code done)) - (cond - ((null decoder) nil) - ((stringp decoder) - (message "Decoding...") - (call-process-region (point-min) (point-max) decoder t t nil) - (message "Decoding... done.")) - ((listp decoder) - (apply 'call-process-region (point-min) (point-max) - (car decoder) t t nil (cdr decoder))) - ((and (symbolp decoder) (fboundp decoder)) - (message "Decoding...") - (funcall decoder (point-min) (point-max)) - (message "Decoding... done.")) - (t - (error "Bad entry for %s in `mm-content-transfer-encodings'" - code))))) - (list code-1 code-2 code-3)))) + (if (not decoder) + nil + (message "Decoding (%s)..." code) + (cond + ((stringp decoder) + (call-process-region (point-min) (point-max) decoder t t nil)) + ((listp decoder) + (apply 'call-process-region (point-min) (point-max) + (car decoder) t t nil (cdr decoder))) + ((and (symbolp decoder) (fboundp decoder)) + (funcall decoder (point-min) (point-max))) + (t + (error "Bad entry for %s in `mm-content-transfer-encodings'" + code))) + (message "Decoding (%s)... done." code)))) + (list code-1 code-2)))) (set-buffer-modified-p nil)) (defun url-filter (proc string)
--- a/lisp/w3/w3-annotat.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-annotat.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,281 +0,0 @@ -;;; w3-annotat.el --- Annotation functions for Emacs-W3 -;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.6 -;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 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 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Private annotation support -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-parse-personal-annotations () - ;; Read in personal annotation file - (if (and - (file-exists-p (format "%s/LOG" w3-personal-annotation-directory)) - (file-readable-p (format "%s/LOG" w3-personal-annotation-directory))) - (save-excursion - (setq w3-personal-annotations nil);; nuke the old list - (let ((start nil) - (end nil) - (txt nil) - (url nil) - (num nil)) - (set-buffer (get-buffer-create " *panno*")) - (erase-buffer) - (insert-file-contents-literally - (format "%s/LOG" w3-personal-annotation-directory)) - (goto-char (point-min)) - (w3-replace-regexp "\n+" "\n") - (goto-char (point-min)) - ;; nuke the header lines - (delete-region (point-min) (progn (forward-line 2) (point))) - (cond - ((eobp) nil) ; Empty LOG file - (t - (if (/= (char-after (1- (point-max))) ?\n) - (save-excursion - (goto-char (point-max)) - (insert "\n"))) - (while (not (eobp)) - (setq start (point) - end (prog2 (end-of-line) (point) (forward-char 1)) - txt (buffer-substring start end) - url (substring txt 0 (string-match " " txt)) - num (url-split - (substring txt (1+ (string-match " " txt)) nil) - "[ \t]")) - (while num - (setq w3-personal-annotations - (cons - (list url - (list (car (car num)) - (w3-grok-annotation-format - (car (car num))))) - w3-personal-annotations) - num (cdr num)))))) - (kill-buffer " *panno*"))))) - -(defun w3-grok-annotation-format (anno) - ;; Grab the title from an annotation - (let ((fname (format "%s/PAN-%s.html" - w3-personal-annotation-directory anno))) - (save-excursion - (set-buffer (get-buffer-create " *annotmp*")) - (erase-buffer) - (if (file-exists-p fname) - (insert-file-contents-literally fname)) - (goto-char (point-min)) - (prog1 - (if (re-search-forward "<title>\\(.*\\)</title>" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - (concat "Annotation on " - (current-time-string (nth 5 (file-attributes fname))))) - (kill-buffer " *annotmp*"))))) - -(defun w3-is-personal-annotation (url) - ;; Is URL a personal annotation? - (string-match "file:/.*/PAN-.*\\.html" url)) - -(defun w3-delete-personal-annotation-internal (url num) - (save-excursion - (set-buffer (get-buffer-create " *annotmp*")) - (erase-buffer) - (insert-file-contents-literally (format "%s/LOG" - w3-personal-annotation-directory)) - (replace-regexp (format "[ \t]+\\b%s\\b[ \t]*" num) " ") - (goto-char (point-min)) - (delete-matching-lines (format "^%s +$" url)) - (let ((make-backup-files nil) - (version-control nil) - (require-final-newline t)) - (write-region (point-min) (point-max) - (format "%s/LOG" - w3-personal-annotation-directory))) - (kill-buffer " *annotmp*") - (let ((anno w3-personal-annotations)) - (setq w3-personal-annotations nil) - (while anno - (if (not (string= num (car (car (cdr (car anno)))))) - (setq w3-personal-annotations - (cons (car anno) w3-personal-annotations))) - (setq anno (cdr anno))) - (delete-file (format "%s/PAN-%s.html" - w3-personal-annotation-directory num))))) - -(defun w3-delete-personal-annotation () - "Delete a personal annotation." - (interactive) - (let ((url (url-view-url t))) - (cond - ((w3-is-personal-annotation (url-view-url t)) - (let ((num nil) - (annotated-url nil) - (anno w3-personal-annotations)) - (string-match "file:/.*/PAN-\\(.*\\)\\.html" url) - (setq num (match-string 1 url)) - (while anno - (if (equal num (car (car (cdr (car anno))))) - (setq annotated-url (car (car anno)))) - (setq anno (cdr anno))) - (if (not annotated-url) - (message "Couldn't find url that this is annotating!") - (w3-delete-personal-annotation-internal annotated-url num) - (w3-quit)))) - (t - (let* ((tmp w3-personal-annotations) - (thelist nil) - (node nil) - (todel nil)) - (if (not (assoc url tmp)) - (message "No personal annotations.") - (while tmp - (setq node (car tmp)) - (if (string= (car node) url) - (setq thelist (cons (cons (nth 1 (nth 1 node)) "") thelist))) - (setq tmp (cdr tmp))) - (setq todel (completing-read "Delete annotation: " thelist nil t)) - ;; WORK ;; - (message "I should delete %s, but can't." todel))))))) - -(defun w3-personal-annotation-add () - "Add an annotation to this document." - (interactive) - (let ((url (url-view-url t)) - (buf (get-buffer-create "*Personal Annotation*")) - (title (read-string "Title: " - (format "Annotation by %s on %s" - (user-real-login-name) - (current-time-string))))) - (set-buffer buf) - (switch-to-buffer buf) - (erase-buffer) - (if (and w3-annotation-mode (fboundp w3-annotation-mode)) - (funcall w3-annotation-mode) - (message "%S is undefined, using %s" w3-annotation-mode - default-major-mode) - (funcall default-major-mode)) - (w3-annotation-minor-mode 1) - (setq w3-current-annotation (cons url title)) - (insert "<html>\n" - " <head>\n" - " <title>" (url-insert-entities-in-string title) "</title>" - " </head>\n" - " <h1>" (url-insert-entities-in-string title) "</h1>\n" - " <p>\n" - " <address>" (url-insert-entities-in-string (user-full-name)) - (if (stringp url-personal-mail-address) - (concat " <" (url-insert-entities-in-string - url-personal-mail-address) ">") - "") - "</address>\n" - " <address>" (current-time-string) "</address>\n" - " </p>\n" - " <pre>\n") - (save-excursion - (insert "\n\n\n </pre>\n" - "</html>")) - (message "Hit C-cC-c to send this annotation."))) - -(defun w3-annotation-minor-mode (&optional arg) - "Minimal minor mode for entering annotations. Just rebinds C-cC-c to -finish the annotation." - (interactive "P") - (cond - ((null arg) (setq w3-annotation-minor-mode (not w3-annotation-minor-mode))) - ((= 0 arg) (setq w3-annotation-minor-mode nil)) - (t (setq w3-annotation-minor-mode t))) - (cond - ((or w3-running-FSF19 w3-running-xemacs)) - (t (local-set-key "\C-c\C-c" 'w3-personal-annotation-finish))) - ) - -(defun w3-annotation-find-highest-number () - ;; Find the highest annotation number in this buffer - (let (x) - (goto-char (point-min)) - (while (re-search-forward "[^ \t\n]*[ \t]\\(.*\\)" nil t) - (setq x (nconc (mapcar (function (lambda (x) (string-to-int (car x)))) - (url-split (buffer-substring (match-beginning 1) - (match-end 1)) - "[ \t]")) x))) - (if (not x) (setq x '(0))) - (1+ (car (sort x '>))))) - -(defun w3-personal-annotation-finish () - "Finish doing a personal annotation." - (interactive) - (cond - ((or w3-running-FSF19 w3-running-xemacs)) - (t (local-set-key "\C-c\C-c" 'undefined))) - (if (or (not w3-personal-annotation-directory) - (not (file-exists-p w3-personal-annotation-directory)) - (not (file-directory-p w3-personal-annotation-directory))) - (error "No personal annotation directory!") - (let ((url (car w3-current-annotation)) - (txt (buffer-string)) - (title (cdr w3-current-annotation)) - (fname nil) - (num nil)) - (save-excursion - (not-modified) - (kill-buffer (current-buffer)) - (set-buffer (get-buffer-create " *annotmp*")) - (erase-buffer) - (if (file-exists-p ; Insert current LOG file if - ; it exists. - (format "%s/LOG" w3-personal-annotation-directory)) - (insert-file-contents-literally - (format "%s/LOG" w3-personal-annotation-directory)) - (progn ; Otherwise, create a file - (goto-char (point-min)) ; that conforms to first - ; annotation format from NCSA - (insert "ncsa-mosaic-personal-annotation-log-format-1\n") - (insert "Personal\n"))) - (goto-char (point-min)) - (setq num (int-to-string (w3-annotation-find-highest-number)) - fname (format "%s/PAN-%s.html" - w3-personal-annotation-directory num)) - (goto-char (point-min)) - (if (re-search-forward (regexp-quote url) nil t) - (progn - (end-of-line) - (insert " ")) - (goto-char (point-max)) - (insert "\n" url " ")) - (insert num) - (let ((make-backup-files nil) - (version-control nil) - (require-final-newline t)) - (write-region (point-min) (point-max) - (format "%s/LOG" w3-personal-annotation-directory)) - (erase-buffer) - (insert w3-annotation-marker txt) - (write-region (point-min) (point-max) fname)) - (setq w3-personal-annotations - (cons (list url (list num title)) w3-personal-annotations)))))) - -(defun w3-annotation-add () - "Add an annotation to the current document." - (interactive) - (w3-personal-annotation-add))
--- a/lisp/w3/w3-auto.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-auto.el Mon Aug 13 08:50:05 2007 +0200 @@ -3,14 +3,6 @@ ;; About pages (autoload 'w3-about "w3-about") -;; Annotation handling -(autoload 'w3-parse-personal-annotations "w3-annotat") -(autoload 'w3-is-personal-annotation "w3-annotat") -(autoload 'w3-delete-personal-annotation "w3-annotat") -(autoload 'w3-personal-annotation-add "w3-annotat") -(autoload 'w3-annotation-minor-mode "w3-annotat") -(autoload 'w3-annotation-add "w3-annotat") - ;; Hotlist handling (autoload 'w3-read-html-bookmarks "w3-hot") (autoload 'w3-hotlist-apropos "w3-hot") @@ -24,7 +16,6 @@ (autoload 'w3-hotlist-add-document "w3-hot") ;; Printing -(autoload 'w3-print-with-ps-print "w3-print") (autoload 'w3-print-this-url "w3-print") (autoload 'w3-print-url-under-point "w3-print") (autoload 'w3-parse-tree-to-latex "w3-latex")
--- a/lisp/w3/w3-display.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/01/31 04:26:17 -;; Version: 1.115 +;; Created: 1997/02/08 06:51:44 +;; Version: 1.123 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -365,7 +365,12 @@ (point))))) (goto-char (point-max)) (add-text-properties w3-scratch-start-point - (point) (list 'face w3-active-faces 'duplicable t)) + (point) (list 'face w3-active-faces + 'start-open t + 'end-open t + 'rear-nonsticky t + 'duplicable t + 'read-only t)) (if (car w3-active-voices) (add-text-properties w3-scratch-start-point (point) (list 'personality (car w3-active-voices)))) @@ -618,43 +623,47 @@ (defun w3-maybe-start-image-download (widget) (let* ((src (widget-get widget 'src)) (cached-glyph (w3-image-cached-p src))) - (if (and cached-glyph (widget-glyphp cached-glyph)) - (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting)) - (cond - ((or w3-delay-image-loads ; Delaying images - (not (fboundp 'valid-specifier-domain-p)) ; Can't do images - (eq (device-type) 'tty)) ; Why bother? - (w3-add-delayed-graphic widget)) - ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! - (w3-warn 'images (format "Skipping image %s" (url-basepath src t))) - (w3-add-delayed-graphic widget)) - (t ; Grab the images - (let ( - (url-request-method "GET") - (old-asynch url-be-asynchronous) - (url-request-data nil) - (url-request-extra-headers nil) - (url-source t) - (url-mime-accept-string (substring - (mapconcat - (function - (lambda (x) - (if x - (concat (car x) ",") - ""))) - w3-allowed-image-types "") - 0 -1)) - (url-working-buffer (generate-new-buffer-name " *W3GRAPH*"))) - (setq-default url-be-asynchronous t) - (setq w3-graphics-list (cons (cons src (make-glyph)) - w3-graphics-list)) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-callback-data (list widget) - url-be-asynchronous t - url-current-callback-func 'w3-finalize-image-download) - (url-retrieve src)) - (setq-default url-be-asynchronous old-asynch))))))) + (cond + ((and cached-glyph + (widget-glyphp cached-glyph) + (not (eq 'nothing + (image-instance-type + (glyph-image-instance cached-glyph))))) + (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting))) + ((or w3-delay-image-loads ; Delaying images + (not (fboundp 'valid-specifier-domain-p)) ; Can't do images + (eq (device-type) 'tty)) ; Why bother? + (w3-add-delayed-graphic widget)) + ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! + (w3-warn 'images (format "Skipping image %s" (url-basepath src t))) + (w3-add-delayed-graphic widget)) + (t ; Grab the images + (let ( + (url-request-method "GET") + (old-asynch url-be-asynchronous) + (url-request-data nil) + (url-request-extra-headers nil) + (url-source t) + (url-mime-accept-string (substring + (mapconcat + (function + (lambda (x) + (if x + (concat (car x) ",") + ""))) + w3-allowed-image-types "") + 0 -1)) + (url-working-buffer (generate-new-buffer-name " *W3GRAPH*"))) + (setq-default url-be-asynchronous t) + (setq w3-graphics-list (cons (cons src (make-glyph)) + w3-graphics-list)) + (save-excursion + (set-buffer (get-buffer-create url-working-buffer)) + (setq url-current-callback-data (list widget) + url-be-asynchronous t + url-current-callback-func 'w3-finalize-image-download) + (url-retrieve src)) + (setq-default url-be-asynchronous old-asynch)))))) (defun w3-finalize-image-download (widget) (let ((glyph nil) @@ -794,6 +803,7 @@ (setq st (min (point-max) (1+ nd)))))))) (defun w3-size-of-tree (tree minmax) + (declare (special args)) (save-excursion (save-restriction (narrow-to-region (point) (point)) @@ -839,6 +849,7 @@ (defun w3-display-table-dimensions (node) ;; fill-column sets maximum width + (declare (special args)) (let (min-vector max-vector rows cols @@ -1299,7 +1310,7 @@ (setq this-rectangle (aref formatted-cols i)) (if (> height (length this-rectangle)) (let ((colspan-fill-line - (make-string (aref table-colwidth i) ? ))) + (make-string (abs (aref table-colwidth i)) ? ))) (case valign ((center middle) (aset formatted-cols i @@ -1481,6 +1492,7 @@ (content-stack (list (list node))) (right-margin-stack (list fill-column)) (left-margin-stack (list 0)) + (inhibit-read-only t) node insert-before insert-after @@ -1808,25 +1820,25 @@ w3-current-form-number) args)) (w3-handle-content node))) - (keygen - (w3-form-add-element 'keygen - (or (w3-get-attribute 'name) - (w3-get-attribute 'id) - "keygen") - nil ; value - nil ; size - nil ; maxlength - nil ; default - w3-display-form-id ; action - nil ; options - w3-current-form-number - (w3-get-attribute 'id) ; id - nil ; checked - (car w3-active-faces))) +; (keygen +; (w3-form-add-element 'keygen +; (or (w3-get-attribute 'name) +; (w3-get-attribute 'id) +; "keygen") +; nil ; value +; nil ; size +; nil ; maxlength +; nil ; default +; w3-display-form-id ; action +; nil ; options +; w3-current-form-number +; (w3-get-attribute 'id) ; id +; nil ; checked +; (car w3-active-faces))) (input (w3-form-add-element (w3-display-normalize-form-info args) - (car w3-active-faces)) + w3-active-faces) (w3-handle-empty-tag) ) (select @@ -1870,7 +1882,7 @@ (w3-handle-content node)) (setq plist (plist-put plist 'type 'option) plist (plist-put plist 'options options)) - (w3-form-add-element plist (car w3-active-faces)) + (w3-form-add-element plist w3-active-faces) ;; This should really not be necessary, but some versions ;; of the widget library leave point _BEFORE_ the menu ;; widget instead of after. @@ -1882,7 +1894,7 @@ (apply 'concat (nth 2 node))))) (setq plist (plist-put plist 'type 'multiline) plist (plist-put plist 'value value)) - (w3-form-add-element plist (car w3-active-faces))) + (w3-form-add-element plist w3-active-faces)) (w3-handle-empty-tag) ) (style @@ -1954,34 +1966,46 @@ (- nd st))) +(defun w3-fixup-eol-faces () + ;; Remove 'face property at end of lines - underlining screws up stuff + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face nil))))) + (defsubst w3-finish-drawing () - (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting) - (let (url glyph widget) - (while w3-image-widgets-waiting - (setq widget (car w3-image-widgets-waiting) - w3-image-widgets-waiting (cdr w3-image-widgets-waiting) - url (widget-get widget 'src) - glyph (cdr-safe (assoc url w3-graphics-list))) - (widget-value-set widget glyph))) - ;;(w3-handle-annotations) - ;;(w3-handle-headers) - ) + (let (url glyph widget) + (while w3-image-widgets-waiting + (setq widget (car w3-image-widgets-waiting) + w3-image-widgets-waiting (cdr w3-image-widgets-waiting) + url (widget-get widget 'src) + glyph (cdr-safe (assoc url w3-graphics-list))) + (condition-case nil + (widget-value-set widget glyph) + (error nil)))) + (and (not w3-running-xemacs) + (not (eq (device-type) 'tty)) + (w3-fixup-eol-faces)) + ;;(w3-handle-headers) ) (defun w3-region (st nd) (if (not w3-setup-done) (w3-do-setup)) (let* ((source (buffer-substring st nd)) - (w3-display-same-buffer t) + (w3-dislplay-same-buffer t) (parse nil)) - (save-excursion - (set-buffer (get-buffer-create " *w3-region*")) - (erase-buffer) - (insert source) - (setq parse (w3-parse-buffer (current-buffer)))) - (narrow-to-region st nd) - (delete-region (point-min) (point-max)) - (w3-draw-tree parse) - (w3-finish-drawing))) + (save-window-excursion + (save-excursion + (set-buffer (get-buffer-create " *w3-region*")) + (erase-buffer) + (insert source) + (setq parse (w3-parse-buffer (current-buffer)))) + (narrow-to-region st nd) + (delete-region (point-min) (point-max)) + (w3-draw-tree parse) + (w3-finish-drawing) + (widen)))) (defun w3-refresh-buffer () (interactive)
--- a/lisp/w3/w3-emulate.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-emulate.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-emulate.el --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/01/22 16:28:30 -;; Version: 1.6 +;; Created: 1997/02/04 19:21:18 +;; Version: 1.11 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -80,9 +80,9 @@ (define-key w3-netscape-emulation-minor-mode-map [right] 'scroll-left) (define-key w3-netscape-emulation-minor-mode-map [left] 'scroll-right) (define-key w3-netscape-emulation-minor-mode-map [(meta left)] - 'w3-backward-in-history) + 'w3-history-backward) (define-key w3-netscape-emulation-minor-mode-map [(meta right)] - 'w3-forward-in-history) + 'w3-history-forward) (defun turn-on-netscape-emulation () (interactive) @@ -186,31 +186,72 @@ (setq w3-lynx-emulation-minor-mode t w3-netscape-emulation-minor-mode nil)))) +;; The list of keybindings for lynx minor mode was compiled from: +;; http://www.crl.com/~subir/lynx/lynx_help/keystroke_commands/keystroke_help.htm + +;; Movement +(define-key w3-lynx-emulation-minor-mode-map [up] 'w3-widget-backward) +(define-key w3-lynx-emulation-minor-mode-map [down] 'w3-widget-forward) +(define-key w3-lynx-emulation-minor-mode-map [right] 'w3-follow-link) +(define-key w3-lynx-emulation-minor-mode-map [left] 'w3-history-backward) + +;; Scrolling (define-key w3-lynx-emulation-minor-mode-map "+" 'w3-scroll-up) (define-key w3-lynx-emulation-minor-mode-map "-" 'scroll-down) (define-key w3-lynx-emulation-minor-mode-map "b" 'scroll-down) -(define-key w3-lynx-emulation-minor-mode-map "a" 'w3-hotlist-add-document) -(define-key w3-lynx-emulation-minor-mode-map "c" 'w3-mail-document-author) -(define-key w3-lynx-emulation-minor-mode-map "e" 'w3-edit-source) -(define-key w3-lynx-emulation-minor-mode-map "g" 'w3-fetch) -(define-key w3-lynx-emulation-minor-mode-map "i" 'ignore) -(define-key w3-lynx-emulation-minor-mode-map "m" 'w3) -(define-key w3-lynx-emulation-minor-mode-map "o" 'ignore) -(define-key w3-lynx-emulation-minor-mode-map "p" 'w3-print-this-url) -(define-key w3-lynx-emulation-minor-mode-map "q" 'w3-quit) -(define-key w3-lynx-emulation-minor-mode-map "/" 'w3-search-forward) -(define-key w3-lynx-emulation-minor-mode-map "s" 'w3-search-forward) -(define-key w3-lynx-emulation-minor-mode-map "n" 'w3-search-again) -(define-key w3-lynx-emulation-minor-mode-map "v" 'w3-show-hotlist) -(define-key w3-lynx-emulation-minor-mode-map "=" 'w3-document-information) +(define-key w3-lynx-emulation-minor-mode-map "\C-a" 'w3-start-of-document) +(define-key w3-lynx-emulation-minor-mode-map "\C-e" 'w3-end-of-document) +(define-key w3-lynx-emulation-minor-mode-map "\C-f" 'scroll-down) +(define-key w3-lynx-emulation-minor-mode-map "\C-n" 'ignore) ; down 2 +(define-key w3-lynx-emulation-minor-mode-map "\C-p" 'ignore) ; up 2 +(define-key w3-lynx-emulation-minor-mode-map ")" 'ignore) ; forward half +(define-key w3-lynx-emulation-minor-mode-map "(" 'ignore) ; back half +(define-key w3-lynx-emulation-minor-mode-map "#" 'w3-toggle-toolbar) + +;; Dired bindings don't have any meaning for us + +;; Other +(define-key w3-lynx-emulation-minor-mode-map "?" 'w3-help) +(define-key w3-lynx-emulation-minor-mode-map "a" 'w3-hotlist-add-document) +(define-key w3-lynx-emulation-minor-mode-map "c" 'w3-mail-document-author) +(define-key w3-lynx-emulation-minor-mode-map "d" 'w3-download-url) +(define-key w3-lynx-emulation-minor-mode-map "e" 'ignore) ; edit current +(define-key w3-lynx-emulation-minor-mode-map "f" 'dired) +(define-key w3-lynx-emulation-minor-mode-map "g" 'w3-fetch) +(define-key w3-lynx-emulation-minor-mode-map "h" 'w3-help) +(define-key w3-lynx-emulation-minor-mode-map "i" 'ignore) +(define-key w3-lynx-emulation-minor-mode-map "j" 'w3-use-hotlist) +(define-key w3-lynx-emulation-minor-mode-map "k" 'describe-mode) +(define-key w3-lynx-emulation-minor-mode-map "l" 'w3-complete-link) +(define-key w3-lynx-emulation-minor-mode-map "m" 'w3) +(define-key w3-lynx-emulation-minor-mode-map "n" 'w3-search-again) +(define-key w3-lynx-emulation-minor-mode-map "o" 'w3-preferences-edit) +(define-key w3-lynx-emulation-minor-mode-map "p" 'w3-print-this-url) +(define-key w3-lynx-emulation-minor-mode-map "q" 'w3-quit) +(define-key w3-lynx-emulation-minor-mode-map "r" 'w3-hotlist-delete) +(define-key w3-lynx-emulation-minor-mode-map "t" 'ignore) ; tag +(define-key w3-lynx-emulation-minor-mode-map "u" 'w3-history-backward) +(define-key w3-lynx-emulation-minor-mode-map "/" 'w3-search-forward) +(define-key w3-lynx-emulation-minor-mode-map "v" 'w3-show-hotlist) +(define-key w3-lynx-emulation-minor-mode-map "V" 'w3-show-hotlist) +(define-key w3-lynx-emulation-minor-mode-map "x" 'w3-follow-link) +(define-key w3-lynx-emulation-minor-mode-map "z" 'keyboard-quit) +(define-key w3-lynx-emulation-minor-mode-map "=" 'w3-document-information) +(define-key w3-lynx-emulation-minor-mode-map "\\" 'w3-source-document) +(define-key w3-lynx-emulation-minor-mode-map "!" 'shell) +(define-key w3-lynx-emulation-minor-mode-map "'" 'ignore) ; toggle comment +(define-key w3-lynx-emulation-minor-mode-map "`" 'ignore) ; toggle comment +(define-key w3-lynx-emulation-minor-mode-map "*" 'ignore) ; toggle image_links +(define-key w3-lynx-emulation-minor-mode-map "@" 'ignore) ; toggle raw 8-bit +(define-key w3-lynx-emulation-minor-mode-map "[" 'ignore) ; pseudo-inlines +(define-key w3-lynx-emulation-minor-mode-map "]" 'ignore) ; send head +(define-key w3-lynx-emulation-minor-mode-map "\"" 'ignore) ; toggle quoting (define-key w3-lynx-emulation-minor-mode-map "\C-r" 'w3-reload-document) (define-key w3-lynx-emulation-minor-mode-map "\C-w" 'w3-refresh-buffer) -(define-key w3-lynx-emulation-minor-mode-map "\\" 'w3-source-document) -(define-key w3-lynx-emulation-minor-mode-map "!" 'shell) -(define-key w3-lynx-emulation-minor-mode-map [up] 'w3-widget-backward) -(define-key w3-lynx-emulation-minor-mode-map [down] 'w3-widget-forward) -(define-key w3-lynx-emulation-minor-mode-map [right] 'w3-follow-link) -(define-key w3-lynx-emulation-minor-mode-map [left] 'w3-backward-in-history) +(define-key w3-lynx-emulation-minor-mode-map "\C-u" 'ignore) ; erase input +(define-key w3-lynx-emulation-minor-mode-map "\C-g" 'keyboard-quit) +(define-key w3-lynx-emulation-minor-mode-map "\C-t" 'ignore) ; toggle trace +(define-key w3-lynx-emulation-minor-mode-map "\C-k" 'ignore) ; cookie jar (provide 'w3-emulate)
--- a/lisp/w3/w3-forms.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1997/01/28 14:21:54 -;; Version: 1.55 +;; Created: 1997/02/09 06:39:43 +;; Version: 1.65 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -29,20 +29,40 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; FORMS processing for html 2.0/3.0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(eval-when-compile + (require 'cl)) + (eval-and-compile (require 'w3-display) - (require 'widget)) + (require 'widget) + (require 'widget-edit)) (require 'w3-vars) (require 'mule-sysdp) +(defvar w3-form-use-old-style nil + "*Non-nil means use the old way of interacting for form fields.") + (define-widget-keywords :emacspeak-help :w3-form-data) (defvar w3-form-keymap (copy-keymap global-map)) +(if (and w3-form-keymap widget-keymap) + (cl-map-keymap (function + (lambda (key binding) + (define-key w3-form-keymap + (if (vectorp key) key (vector key)) + (case binding + (widget-backward 'w3-widget-backward) + (widget-forward 'w3-widget-forward) + (otherwise binding))))) + widget-keymap)) +(define-key w3-form-keymap [return] 'w3-form-maybe-submit-by-keypress) (define-key w3-form-keymap "\r" 'w3-form-maybe-submit-by-keypress) (define-key w3-form-keymap "\n" 'w3-form-maybe-submit-by-keypress) (define-key w3-form-keymap "\t" 'w3-widget-forward) -(define-key w3-form-keymap [(shift tab)] 'w3-widget-backward) +(define-key w3-form-keymap "\C-k" 'widget-kill-line) +(define-key w3-form-keymap "\C-a" 'widget-beginning-of-line) +(define-key w3-form-keymap "\C-e" 'widget-end-of-line) ;; A form entry area is a vector ;; [ type name default-value value maxlength options widget plist] @@ -84,16 +104,21 @@ (multiline 21) (hidden nil) (file (or size 26)) - ((float password text int) (or size 20)) + ((float password text int) + (if w3-form-use-old-style + (or size 22) + (or size 20))) (image (+ 2 (length (or (plist-get (w3-form-element-plist el) 'alt) "Form-Image")))) (option - (or size - (length (caar (sort (w3-form-element-options el) - (function - (lambda (x y) - (>= (length (car x)) (length (car y)))))))))) + (let ((options (copy-sequence (w3-form-element-options el)))) + (or size + (length (caar (sort options + (function + (lambda (x y) + (>= (length (car x)) + (length (car y))))))))))) (otherwise (or size 22)))) ;;###autoload @@ -120,19 +145,21 @@ (if size (set-text-properties (point) (progn (insert-char ?T size) (point)) - (list 'w3-form-info el + (list 'w3-form-info (cons el face) 'start-open t 'end-open t 'rear-nonsticky t))))) (defun w3-form-resurrect-widgets () (let ((st (point-min)) - info nd node action) + info nd node action face) (while st (if (setq info (get-text-property st 'w3-form-info)) (progn (setq nd (or (next-single-property-change st 'w3-form-info) (point-max)) + face (cdr info) + info (car info) action (w3-form-element-action info) node (assoc action w3-form-elements)) (goto-char st) @@ -143,7 +170,7 @@ (setcdr node (cons info (cdr node))) (setq w3-form-elements (cons (cons action (list info)) w3-form-elements))) - (w3-form-add-element-internal info) + (w3-form-add-element-internal info face) (setq st (next-single-property-change st 'w3-form-info))) (setq st (next-single-property-change st 'w3-form-info)))))) @@ -173,9 +200,10 @@ (while widgets (setq widget (pop widgets)) (widget-put widget :emacspeak-help 'w3-form-summarize-field) + (widget-put widget :help-echo 'w3-form-summarize-field) (widget-put widget :w3-form-data el)))) -(defun w3-form-add-element-internal (el) +(defun w3-form-add-element-internal (el face) (let* ((widget nil) (buffer-read-only nil) (inhibit-read-only t) @@ -184,7 +212,7 @@ 'w3-widget-creation-function) 'w3-form-default-widget-creator) widget (and (fboundp widget-creation-function) - (funcall widget-creation-function el nil))) + (funcall widget-creation-function el face))) (if (not widget) nil (w3-form-mark-widget widget el)))) @@ -230,7 +258,7 @@ (defun w3-form-create-checkbox (el face) (widget-create 'checkbox - :value-face face + :button-face face (and (w3-form-element-default-value el) t))) (defun w3-form-radio-button-update (widget child event) @@ -281,6 +309,7 @@ (widget-create 'push-button :notify 'ignore :button-face face + :value-face face val))) (defun w3-form-create-image (el face) @@ -302,6 +331,7 @@ (defun w3-form-create-file-browser (el face) (widget-create 'file + :button-face face :value-face face :size (w3-form-element-size el) :must-match t @@ -333,6 +363,7 @@ :ignore-case t :tag "Key Length" :size (1+ longest) + :button-face face :value-face face options))) @@ -345,12 +376,15 @@ :format "%v" :size size :value-face face + :button-face face (mapcar (function (lambda (x) (list 'choice-item :format "%[%t%]" :emacspeak-help 'w3-form-summarize-field :tag (mule-truncate-string (car x) size ? ) + :button-face face + :value-face face :value (car x)))) (w3-form-element-options el))))) (widget-value-set widget (w3-form-element-value el)) @@ -365,45 +399,52 @@ "Multiline text area")) (defun w3-form-create-integer (el face) - (widget-create 'integer - :size (w3-form-element-size el) - :value-face face - :tag "" - :format "%v" - :keymap w3-form-keymap - :w3-form-data el - (w3-form-element-value el))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'integer + :size (w3-form-element-size el) + :value-face face + :tag "" + :format "%v" + :keymap w3-form-keymap + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-create-float (el face) - (widget-create 'number - :size (w3-form-element-size el) - :value-face face - :format "%v" - :tag "" - :keymap w3-form-keymap - :w3-form-data el - (w3-form-element-value el))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'number + :size (w3-form-element-size el) + :value-face face + :format "%v" + :tag "" + :keymap w3-form-keymap + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-create-text (el face) - (widget-create 'editable-field - :keymap w3-form-keymap - :size (w3-form-element-size el) - :value-face face - :w3-form-data el - (w3-form-element-value el))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'editable-field + :keymap w3-form-keymap + :size (w3-form-element-size el) + :value-face face + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-create-password (el face) ;; *sigh* This will fail under XEmacs, but I can yell at them about ;; upgrading separately for the release of 19.15 and 20.0 - (if (boundp :secret) - (widget-create 'editable-field - :secret ?* - :keymap w3-form-keymap - :size (w3-form-element-size el) - :value-face face - :w3-form-data el - (w3-form-element-value el)) - (w3-form-default-widget-creator el face))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'editable-field + :secret ?* + :keymap w3-form-keymap + :size (w3-form-element-size el) + :value-face face + :button-face face + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-default-widget-creator (el face) (widget-create 'link @@ -411,6 +452,7 @@ :value-to-internal 'w3-form-default-button-update :size (w3-form-element-size el) :value-face face + :button-face face :w3-form-data el (w3-form-element-value el))) @@ -422,7 +464,7 @@ (if (eq 'password (w3-form-element-type info)) (make-string (length v) ?*) v) - (w3-form-element-size info) ?_))) + (w3-form-element-size info) ? ))) v)) (defun w3-form-default-button-callback (widget &rest ignore) @@ -452,7 +494,7 @@ (put 'option 'w3-summarize-function 'w3-form-summarize-option-list) (put 'keygen 'w3-summarize-function 'w3-form-summarize-keygen-list) (put 'image 'w3-summarize-function 'w3-form-summarize-image) -(put 'hidden 'w3-summariez-function 'ignore) +(put 'hidden 'w3-summarize-function 'ignore) (defun w3-form-summarize-field (widget &rest ignore) "Sumarize a widget that should be a W3 form entry area. @@ -530,7 +572,7 @@ (let ((name (w3-form-element-name data)) (label (w3-form-field-label data)) (cur-value (widget-value (w3-form-element-widget data))) - (this-value (widget-value widget))) + (this-value (widget-value (widget-get-sibling widget)))) (format "Radio button %s is %s, could be %s" (or label name) cur-value this-value))) @@ -639,7 +681,7 @@ deft (w3-form-element-default-value formobj) type (w3-form-element-type formobj)) (case type - ((submit reset image) nil) + ((submit reset image hidden) nil) (radio (setq deft (widget-get widget 'w3-form-default-value)) (if (and widget deft) @@ -823,6 +865,7 @@ (lambda (char) (cond ((= char ? ) "+") + ((memq char '(?: ?/)) (char-to-string char)) ((memq char url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char)))))) (mule-encode-string chunk) ""))
--- a/lisp/w3/w3-menu.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/01/21 20:54:49 -;; Version: 1.25 +;; Created: 1997/02/08 05:30:56 +;; Version: 1.27 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -44,8 +44,8 @@ (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.") (make-variable-buffer-local 'w3-links-menu) -(defvar w3-use-menus '(file edit view go bookmark options - buffers style emacs nil help) +(defvar w3-use-menus '(file edit view go bookmark options buffers style + emacs nil help) "*Non-nil value causes W3 to provide a menu interface. A value that is a list causes W3 to install its own menubar. A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar. @@ -70,7 +70,11 @@ If nil appears in the list, it should appear exactly once. All menus after nil in the list will be displayed flushright in the -menubar.") +menubar. + +NOTE! The current port of Emacs to Windows NT/95 does not support +buttons in the menubar, so the 'emacs' keyword is currently ignored +on that platform.") (defun w3-menu-hotlist-constructor (menu-items) (or (cdr w3-html-bookmarks) @@ -226,7 +230,6 @@ ["PostScript" (w3-mail-current-document nil "PostScript") t] ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t] ) - ["Add Annotation" w3-annotation-add w3-personal-annotation-directory] (if w3-running-xemacs "---:shadowDoubleEtchedIn" "---") @@ -277,8 +280,8 @@ (defconst w3-menu-go-menu (list "Go" - ["Forward" w3-forward-in-history t] - ["Backward" w3-backward-in-history t] + ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))] + ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))] ["Home" w3 w3-default-homepage] ["View History..." w3-show-history-list url-keep-history] "----" @@ -466,7 +469,13 @@ (search (cons "Search" w3-menu-fsfemacs-search-menu)) (emacs - (cons "[Emacs]" 'w3-menu-toggle-menubar)))) + ;; FIXME!!! Currently, win32 doesn't support buttons + ;; in menubars, so we hack around it and ignore the + ;; 'emacs keyword on that platform. REMOVE THIS CODE + ;; as soon as that is fixed. 19.35 timeframe? + (if (eq (device-type) 'win32) + nil + (cons "[Emacs]" 'w3-menu-toggle-menubar))))) cons (vec (vector 'rootmenu 'w3 nil)) ;; menus appear in the opposite order that we
--- a/lisp/w3/w3-parse.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-parse.el Mon Aug 13 08:50:05 2007 +0200 @@ -2136,7 +2136,7 @@ ;; Read the attributes from a start-tag. (if w3-p-d-end-tag-p - (if (looking-at "[ \t\r\n/]*>") + (if (looking-at "[ \t\r\n/]*[<>]") nil ;; This is in here to deal with those idiots who stick ;; attribute/value pairs on end tags. *sigh* @@ -2330,6 +2330,19 @@ (setq tag-attributes (cons (cons 'class (list w3-p-s-btdt)) tag-attributes)))) ) + (if (not (eq w3-p-d-tag-name 'input)) + nil + (setq w3-p-s-btdt (concat ":" + (downcase + (or (cdr-safe + (assq 'type tag-attributes)) + "text")))) + (if (assq 'class tag-attributes) + (setcdr (assq 'class tag-attributes) + (cons w3-p-s-btdt + (cdr (assq 'class tag-attributes)))) + (setq tag-attributes (cons (cons 'class (list w3-p-s-btdt)) + tag-attributes)))) ) ;; Process the end of the tag.
--- a/lisp/w3/w3-print.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-print.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-print.el --- Printing support for emacs-w3 ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.6 +;; Created: 1997/02/07 01:05:01 +;; Version: 1.7 ;; Keywords: faces, help, printing, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -25,77 +25,12 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-use-ps-print nil - "*If non-nil, then printing will be done via the ps-print package by -James C. Thompson <thompson@wg2.waii.com>.") - -(defun w3-face-type (face) - "Return a list specifying what a face looks like. ie: '(bold italic)" - (let ((font (or (face-font face) (face-font 'default))) - (retval nil)) - (if (not (stringp font)) - (setq font - (cond - ((and (fboundp 'fontp) (not (fontp font))) nil) - ((fboundp 'font-truename) (font-truename font)) - ((fboundp 'font-name) (font-name font)) - (t nil)))) - (cond - ((not font) nil) - ((string-match "^-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-" font) - (let ((wght (substring font (match-beginning 3) (match-end 3))) - (slnt (substring font (match-beginning 4) (match-end 4)))) - (if (string-match "bold" wght) - (setq retval (cons 'bold retval))) - (if (or (string-match "i" slnt) (string-match "o" slnt)) - (setq retval (cons 'italic retval))) - (if (and (fboundp 'face-underline-p) - (face-underline-p face)) - (setq retval (cons 'underline retval))))) - ((and (symbolp face) (string-match "bold" (symbol-name face))) - (setq retval '(bold))) - ((and (symbolp face) (string-match "italic" (symbol-name face))) - (setq retval '(italic))) - (t nil)) - retval)) - -(defun w3-print-with-ps-print (&optional buffer function) - "Print a buffer using `ps-print-buffer-with-faces'. -This function wraps `ps-print-buffer-with-faces' so that the w3 faces -will be correctly listed in ps-bold-faces and ps-italic-faces" - (interactive) - (require 'ps-print) - (setq buffer (or buffer (current-buffer)) - function (or function 'ps-print-buffer-with-faces)) - (let ((ps-bold-faces ps-bold-faces) - (ps-italic-faces ps-italic-faces) - (inhibit-read-only t) - (ps-underline-faces (cond - ((boundp 'ps-underline-faces) - (symbol-value 'ps-underline-faces)) - ((boundp 'ps-underlined-faces) - (symbol-value 'ps-underlined-faces)) - (t nil))) - (ps-underlined-faces nil) - (ps-left-header '(ps-get-buffer-name url-view-url)) - (faces (face-list)) - (data nil) - (face nil)) - (if (string< ps-print-version "1.6") - (while faces - (setq face (car faces) - data (w3-face-type face) - faces (cdr faces)) - (if (and (memq 'bold data) (not (memq face ps-bold-faces))) - (setq ps-bold-faces (cons face ps-bold-faces))) - (if (and (memq 'italic data) (not (memq face ps-italic-faces))) - (setq ps-italic-faces (cons face ps-italic-faces))) - (if (and (memq 'underline data) (not (memq face ps-underline-faces))) - (setq ps-underline-faces (cons face ps-underline-faces)))) - (setq ps-underlined-faces ps-underline-faces)) - (save-excursion - (set-buffer buffer) - (funcall function)))) +(defvar w3-postscript-print-function 'ps-print-buffer-with-faces + "*Name of the function to use to print a buffer as PostScript. +This should take no arguments, and act on the current buffer. +Possible values include: +ps-print-buffer-with-faces - print immediately +ps-spool-buffer-with-faces - spool for later") (defun w3-print-this-url (&optional url format) "Print out the current document (in LaTeX format)" @@ -125,7 +60,7 @@ (equal "" format)) (lpr-buffer)) ((equal "PostScript" format) - (w3-print-with-ps-print (current-buffer))) + (funcall w3-postscript-print-function)) ((equal "LaTeX'd" format) (w3-parse-tree-to-latex w3-current-parse url) (save-window-excursion
--- a/lisp/w3/w3-toolbar.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-toolbar.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-toolbar.el --- Toolbar functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.7 +;; Created: 1997/02/03 15:38:24 +;; Version: 1.8 ;; Keywords: mouse, toolbar ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -79,8 +79,8 @@ not `none'.") (defvar w3-toolbar - '([w3-toolbar-back-icon w3-backward-in-history t "Back in history"] - [w3-toolbar-forw-icon w3-forward-in-history t "Forward in history"] + '([w3-toolbar-back-icon w3-history-backward (car (w3-history-find-url-internal (url-view-url t))) "Back in history"] + [w3-toolbar-forw-icon w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t))) "Forward in history"] [w3-toolbar-home-icon w3 t "Go home"] [:style 2d :size 5] [w3-toolbar-reld-icon w3-reload-document t "Reload document"]
--- a/lisp/w3/w3-vars.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/01/31 04:28:42 -;; Version: 1.76 +;; Created: 1997/02/09 06:46:59 +;; Version: 1.82 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,7 +30,7 @@ ;;; Variable definitions for w3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst w3-version-number - (let ((x "p3.0.52")) + (let ((x "p3.0.56")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -38,7 +38,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/01/31 04:28:42")) +(defconst w3-version-date (let ((x "1997/02/09 06:46:59")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -51,15 +51,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; General configuration variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-annotation-mode 'html-mode - "*A symbol specifying the major mode to enter when doing annotations.") - -(defvar w3-annotation-position 'bottom - "*A symbol specifying where personal annotations should appear in a buffer. -Can be one of the symbols 'top or 'bottom. If the symbol is eq to 'top, then -the annotations will appear at the top of the buffer. If 'bottom, will appear -at the end of the buffer.") - (defvar w3-auto-image-alt t "*Whether emacs-w3 should create an alt attribute for an image that is missing it. @@ -244,11 +235,6 @@ Any other value of `w3-notify' is equivalent to `meek'.") -(defvar w3-personal-annotation-directory nil - "*Directory where w3 looks for personal annotations. -This is a directory that should hold the personal annotations stored in -a Mosaic-compatible format.") - (defvar w3-ppmtoxbm-command "ppmtopgm | pgmtopbm | pbmtoxbm" "*The command used to convert from the portable-pixmap graphics format to an x bitmap. This will only ever be used if XEmacs doesn't have support @@ -702,10 +688,8 @@ (defvar w3-navigate-menu nil) (defvar w3-popup-menu '("Emacs-W3 Commands" - ["Back" w3-backward-in-history t] - ["Forward" w3-forward-in-history t] - "---" - ["Add annotation" w3-annotation-add t] + ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))] + ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))] ) "The shorter popup menu.") @@ -858,13 +842,10 @@ ("Mail session" . "mailto")) "An assoc list of descriptive labels and the corresponding URL stub.") -(defvar w3-annotation-marker "<ncsa-annotation-format-1>") -(defvar w3-annotation-minor-mode nil "Whether we are in the minor mode.") (defconst w3-bug-address "wmperry@cs.indiana.edu" "Address of current maintainer, where to send bug reports.") (defvar w3-continuation '(url-uncompress url-clean-text) "List of functions to call to process a document completely.") -(defvar w3-current-annotation nil "URL of document we are annotating...") (defvar w3-current-isindex nil "Is the current document a searchable index?") (defvar w3-current-last-buffer nil "Last W3 buffer seen before this one.") (defvar w3-current-links nil "An assoc list of <link> tags for this doc.") @@ -873,13 +854,11 @@ (defvar w3-current-parse nil "Parsed version of current document.") (defconst w3-default-continuation '(url-uncompress url-clean-text) "Default action to start with - cleans text and uncompresses if necessary.") -(defvar w3-editing-annotation nil "Are we editing an annotation or not?") (defvar w3-find-this-link nil "Link to go to within a document.") (defvar w3-hidden-forms nil "List of hidden form areas and their info.") (defvar w3-hotlist nil "Default hotlist.") (defvar w3-icon-path-cache nil "Cache of where we found icons for entities.") (defvar w3-last-buffer nil "The last W3 buffer visited.") -(defvar w3-personal-annotations nil "Assoc list of personal annotations.") (defvar w3-print-next nil "Should we latex & print the next doc?") (defvar w3-roman-characters "ivxLCDMVX" "Roman numerals.") (defvar w3-setup-done nil "Have we been through setup code yet?") @@ -921,7 +900,6 @@ url-current-type url-current-user w3-current-parse - w3-current-annotation w3-current-isindex w3-current-last-buffer w3-current-links @@ -974,7 +952,6 @@ (make-variable-buffer-local 'w3-state-vector) (make-variable-buffer-local 'w3-current-stylesheet) (make-variable-buffer-local 'w3-base-alist) -(make-variable-buffer-local 'w3-annotation-minor-mode) (make-variable-buffer-local 'w3-last-tag) (make-variable-buffer-local 'w3-last-fill-pos) (make-variable-buffer-local 'w3-table-info) @@ -991,8 +968,6 @@ ;;; Keymap definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar w3-mode-map (make-keymap) "Keymap to use in w3-mode.") -(defvar w3-annotation-minor-mode-map (make-keymap) "Keymap for annotation.") - (suppress-keymap w3-mode-map) (define-key w3-mode-map "h" (make-sparse-keymap)) @@ -1009,20 +984,16 @@ (define-key w3-mode-map "hI" 'w3-hotlist-add-document-at-point) (define-key w3-mode-map "hR" 'w3-hotlist-refresh) -(define-key w3-mode-map "ai" 'w3-annotation-add) -(define-key w3-mode-map "ad" 'w3-delete-personal-annotation) -(define-key w3-mode-map "ae" 'w3-annotation-edit) - -(define-key w3-mode-map "HF" 'w3-forward-in-history) -(define-key w3-mode-map "HB" 'w3-backward-in-history) +(define-key w3-mode-map "HF" 'w3-history-forward) +(define-key w3-mode-map "HB" 'w3-history-backward) (define-key w3-mode-map "Hv" 'w3-show-history-list) (define-key w3-mode-map " " 'w3-scroll-up) (define-key w3-mode-map "<" 'beginning-of-buffer) (define-key w3-mode-map ">" 'end-of-buffer) (define-key w3-mode-map "?" 'w3-help) -(define-key w3-mode-map "B" 'w3-backward-in-history) -(define-key w3-mode-map "F" 'w3-forward-in-history) +(define-key w3-mode-map "B" 'w3-history-backward) +(define-key w3-mode-map "F" 'w3-history-forward) (define-key w3-mode-map "G" 'w3-show-graphics) (define-key w3-mode-map "I" 'w3-popup-info) (define-key w3-mode-map "K" 'w3-save-this-url) @@ -1065,12 +1036,11 @@ (define-key w3-mode-map [(control meta t)] 'url-list-processes) ;; Widget navigation -(define-key w3-mode-map "\t" 'w3-widget-forward) +(define-key w3-mode-map "\t" 'w3-widget-forward) +(define-key w3-mode-map [backtab] 'w3-widget-backward) (define-key w3-mode-map [(shift tab)] 'w3-widget-backward) +(define-key w3-mode-map [(meta tab)] 'w3-widget-backward) -(define-key w3-annotation-minor-mode-map "\C-c\C-c" - 'w3-personal-annotation-finish) - ;;; This is so we can use a consistent method of checking for mule support ;;; Emacs-based mule uses (boundp 'MULE), but XEmacs-based mule uses ;;; (featurep 'mule) - I choose to use the latter.
--- a/lisp/w3/w3-widget.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-widget.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-widget.el --- An image widget ;; Author: wmperry -;; Created: 1997/01/17 22:09:43 -;; Version: 1.16 +;; Created: 1997/02/09 06:37:14 +;; Version: 1.18 ;; Keywords: faces, images ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -148,6 +148,37 @@ 'src (widget-get widget 'src) 'ismap server-map))) +(defun widget-image-emacspeak-tty-imagemap (usemap) + (let* ((default nil) + (href nil) + (tag nil) + (options (delete + nil + (mapcar + (function + (lambda (x) + (if (eq (aref x 0) 'default) + (setq default (aref x 2))) + (if (and (not default) (stringp (aref x 2))) + (setq default (aref x 2))) + (setq tag (or (aref x 3) (aref x 2)) + href (aref x 2)) + (and (stringp tag) + (stringp href) + (list 'a + (list + (cons 'href href) + (cons + 'class + (list + (if (url-have-visited-url href) + ":visited" ":link")))) + (list tag))))) + usemap)))) + (w3-display-node (list 'table '((border . "1")) + (w3-display-chop-into-table + (list nil nil options) 3))))) + (defun widget-image-value-create (widget) ;; Insert the printed representation of the value (let ( @@ -177,27 +208,31 @@ (goto-char where) (cond (client-map - (let* ((default nil) - (options (mapcar - (function - (lambda (x) - (if (eq (aref x 0) 'default) - (setq default (aref x 2))) - (if (and (not default) (stringp (aref x 2))) - (setq default (aref x 2))) - (list 'choice-item - :format "%[%t%]" - :tag (or (aref x 3) (aref x 2)) - :value (aref x 2)))) client-map))) - (setq real-widget - (apply 'widget-create 'menu-choice - :tag (or (widget-get widget :tag) "Imagemap") - :notify (widget-get widget :notify) - :action (widget-get widget :action) - :value default - :parent widget - :help-echo 'widget-image-summarize - options)))) + (if (featurep 'emacspeak) + (widget-image-emacspeak-tty-imagemap client-map) + (let* ((default nil) + (href nil) + (tag nil) + (options (mapcar + (function + (lambda (x) + (if (eq (aref x 0) 'default) + (setq default (aref x 2))) + (if (and (not default) (stringp (aref x 2))) + (setq default (aref x 2))) + (list 'choice-item + :format "%[%t%]" + :tag (or (aref x 3) (aref x 2)) + :value (aref x 2)))) client-map))) + (setq real-widget + (apply 'widget-create 'menu-choice + :tag (or (widget-get widget :tag) "Imagemap") + :notify (widget-get widget :notify) + :action (widget-get widget :action) + :value default + :parent widget + :help-echo 'widget-image-summarize + options))))) ((and server-map (stringp href)) (setq real-widget (widget-image-create-subwidget @@ -334,9 +369,10 @@ (lambda (entry) (cons (or (aref entry 3) (aref entry 2)) - (aref entry 3)))) usemap)) + (aref entry 2)))) usemap)) (choice nil)) - (setq choice (completing-read "Imagemap: " choices nil t)) + (setq choice (completing-read "Imagemap: " choices nil t) + choice (cdr-safe (assoc choice choices))) (and (stringp choice) (w3-fetch choice)))) (ismap ; Do server-side dummy imagemap for tty (w3-fetch (concat href "?0,0")))
--- a/lisp/w3/w3.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/01/29 06:25:59 -;; Version: 1.61 +;; Created: 1997/02/08 00:49:52 +;; Version: 1.72 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -560,12 +560,15 @@ (save-excursion (set-buffer url-working-buffer) (if x - (w3-add-urls-to-history x (url-view-url t))) + (w3-history-push x (url-view-url t))) (setq w3-current-last-buffer lastbuf))) (t - (w3-add-urls-to-history x url) + (w3-history-push x url) (w3-sentinel lastbuf) - )))) + (if (string-match "#\\(.*\\)" url) + (progn + (push-mark (point) t) + (w3-find-specific-link (match-string 1 url)))))))) (if w3-track-last-buffer (setq w3-last-buffer buf)) (let ((w3-notify (if (memq w3-notify '(newframe bully @@ -584,59 +587,58 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; History for forward/back buttons ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-node-history nil "History for forward and backward jumping") +(defvar w3-history-stack nil + "History stack viewing history. +This is an assoc list, with the oldest items first. +Each element is a cons cell of (url . timeobj), where URL +is the normalized URL (default ports removed, etc), and TIMEOBJ is +a standard Emacs time. See the `current-time' function documentation +for information on this format.") -(defun w3-plot-course () - "Show a map of where the user has been in this session of W3. !!!!NYI!!!" - (interactive) - (error "Sorry, w3-plot-course is not yet implemented.")) +(defun w3-history-find-url-internal (url) + "Search in the history list for URL. +Returns a cons cell, where the car is the 'back' node, and +the cdr is the 'next' node." + (let* ((node (assoc url w3-history-stack)) + (next (cadr (memq node w3-history-stack))) + (last nil) + (temp nil) + (todo w3-history-stack)) + ;; Last node is a little harder to find without using back links + (while (and (not last) todo) + (if (string= (caar todo) url) + (setq last (or temp 'none)) + (setq temp (pop todo)))) + (cons (if (not (symbolp last)) last) + next))) -(defun w3-forward-in-history () +(defun w3-history-forward () "Go forward in the history from this page" (interactive) - (let* ((thisurl (url-view-url t)) - (node (assoc (if (string= "" thisurl) (current-buffer) thisurl) - w3-node-history)) - (url (cdr node)) - (w3-reuse-buffers 'yes)) - (cond - ((null url) (error "No forward found for %s" thisurl)) - ((and (bufferp url) (buffer-name url)) - (switch-to-buffer url)) - ((stringp url) - (w3-fetch url)) - ((bufferp url) - (setq w3-node-history (delete node w3-node-history)) - (error "Killed buffer in history, removed.")) - (t - (error "Something is very wrong with the history!"))))) + (let ((next (cadr (w3-history-find-url-internal (url-view-url t)))) + (w3-reuse-buffers 'yes)) + (if next + (w3-fetch next)))) -(defun w3-backward-in-history () +(defun w3-history-backward () "Go backward in the history from this page" (interactive) - (let* ((thisurl (url-view-url t)) - (node (rassoc (if (string= thisurl "") (current-buffer) thisurl) - w3-node-history)) - (url (car node)) - (w3-reuse-buffers 'yes)) - (cond - ((null url) (error "No backward found for %s" thisurl)) - ((and (bufferp url) (buffer-name url)) - (switch-to-buffer url)) - ((stringp url) - (w3-fetch url)) - ((bufferp url) - (setq w3-node-history (delete node w3-node-history)) - (error "Killed buffer in history, removed.")) - (t - (error "Something is very wrong with the history!"))))) + (let ((last (caar (w3-history-find-url-internal (url-view-url t)))) + (w3-reuse-buffers 'yes)) + (if last + (w3-fetch last)))) -(defun w3-add-urls-to-history (referer url) +(defun w3-history-push (referer url) "REFERER is the url we followed this link from. URL is the link we got to." - (let ((node (assoc referer w3-node-history))) - (if node - (setcdr node url) - (setq w3-node-history (cons (cons referer url) w3-node-history))))) + (if (not referer) + (setq w3-history-stack (list (cons url (current-time)))) + (let ((node (memq (assoc referer w3-history-stack) w3-history-stack))) + (if node + (setcdr node (list (cons url (current-time)))))))) + +(defalias 'w3-add-urls-to-history 'w3-history-push) +(defalias 'w3-backward-in-history 'w3-history-backward) +(defalias 'w3-forward-in-history 'w3-history-forward) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1067,16 +1069,14 @@ (let ((ps-spool-buffer-name " *w3-temp*")) (if (get-buffer ps-spool-buffer-name) (kill-buffer ps-spool-buffer-name)) - (w3-print-with-ps-print (current-buffer) - 'ps-spool-buffer-with-faces) + (ps-spool-buffer-with-faces) (set-buffer ps-spool-buffer-name))) ((equal "PostScript" format) (let ((ps-spool-buffer-name " *w3-temp*")) (if (get-buffer ps-spool-buffer-name) (kill-buffer ps-spool-buffer-name)) (setq content-type "application/postscript") - (w3-print-with-ps-print (current-buffer) - 'ps-spool-buffer-with-faces) + (ps-spool-buffer-with-faces) (set-buffer ps-spool-buffer-name))) ((and under (equal "Formatted Text" format)) (setq content-type "text/plain; charset=iso-8859-1") @@ -1089,7 +1089,7 @@ (setq-default url-be-asynchronous nil) (url-retrieve url) (setq-default url-be-asynchronous old-asynch) - (w3-parse-tree-to-latex (w3-parse-buffer (current-buffer) t) + (w3-parse-tree-to-latex (w3-parse-buffer (current-buffer)) url))) ((equal "LaTeX Source" format) (setq content-type "application/x-latex; charset=iso-8859-1") @@ -1270,20 +1270,6 @@ (interactive) (w3-fetch (concat "www://preview/" (buffer-name)))) -(defun w3-edit-source () - "Edit the html document just retrieved" - (set-buffer url-working-buffer) - (let ((ttl (format "Editing %s Annotation: %s" - (cond - ((eq w3-editing-annotation 'group) "Group") - ((eq w3-editing-annotation 'personal) "Personal") - (t "Unknown")) - (url-basepath url-current-file t))) - (str (buffer-string))) - (set-buffer (get-buffer-create ttl)) - (insert str) - (kill-buffer url-working-buffer))) - (defun w3-source () "Show the source of a file" (let ((tmp (buffer-name (generate-new-buffer "Document Source")))) @@ -1328,7 +1314,8 @@ (if (not (string-match "^www:" (or (url-view-url t) ""))) (w3-convert-code-for-mule url-current-mime-type)) - (let ((x (w3-build-continuation))) + (let ((x (w3-build-continuation)) + (url (url-view-url t))) (while x (funcall (pop x))))) @@ -1377,8 +1364,7 @@ (let ((ps-spool-buffer-name " *w3-temp*")) (if (get-buffer ps-spool-buffer-name) (kill-buffer ps-spool-buffer-name)) - (w3-print-with-ps-print (current-buffer) - 'ps-spool-buffer-with-faces) + (ps-spool-buffer-with-faces) (set-buffer ps-spool-buffer-name))) ((equal "LaTeX Source" format) (w3-parse-tree-to-latex w3-current-parse url) @@ -1910,6 +1896,8 @@ (message "%s" (url-truncate-url-for-viewing href))) (no-show nil) + (widget + (widget-echo-help (point))) (t nil)))) @@ -2232,8 +2220,6 @@ (add-minor-mode 'w3-netscape-emulation-minor-mode " NS" w3-netscape-emulation-minor-mode-map) - (add-minor-mode 'w3-annotation-minor-mode " Annotating" - w3-annotation-minor-mode-map) (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx" w3-lynx-emulation-minor-mode-map) @@ -2256,27 +2242,21 @@ (expand-file-name "~/mosaic.mnu")) w3-hotlist-file (or w3-hotlist-file (expand-file-name "~/mosaic.hot")) - w3-personal-annotation-directory (or w3-personal-annotation-directory - (expand-file-name - "~/mosaic.ann")))) + )) ((memq system-type '(axp-vms vax-vms)) (setq w3-documents-menu-file (or w3-documents-menu-file (expand-file-name "decw$system_defaults:documents.menu")) w3-hotlist-file (or w3-hotlist-file (expand-file-name "~/mosaic.hotlist-default")) - w3-personal-annotation-directory - (or w3-personal-annotation-directory - (expand-file-name "~/mosaic-annotations/")))) + )) (t (setq w3-documents-menu-file (or w3-documents-menu-file (expand-file-name "/usr/local/lib/mosaic/documents.menu")) w3-hotlist-file (or w3-hotlist-file (expand-file-name "~/.mosaic-hotlist-default")) - w3-personal-annotation-directory - (or w3-personal-annotation-directory - (expand-file-name "~/.mosaic-personal-annotations"))))) + ))) (if (eq w3-delimit-emphasis 'guess) (setq w3-delimit-emphasis @@ -2300,9 +2280,6 @@ ; Load in the hotlist if they haven't set it already (or w3-hotlist (w3-parse-hotlist)) - ; Load in their personal annotations if they haven't set them already - (or w3-personal-annotations (w3-parse-personal-annotations)) - ; Set the default home page, honoring their defaults, then ; the standard WWW_HOME, then default to the documentation @ IU (or w3-default-homepage @@ -2483,6 +2460,7 @@ (run-hooks 'w3-mode-hook) (widget-setup) (setq url-current-passwd-count 0 + inhibit-read-only nil truncate-lines t mode-line-format w3-modeline-format) (if (and w3-current-isindex (equal url-current-type "http"))
--- a/man/custom.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/custom.texi Mon Aug 13 08:50:05 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Customization Library -Version: 1.20 +Version: 1.30 @menu * Introduction:: @@ -638,6 +638,21 @@ @item Make it possible to append to `choice', `radio', and `set' options. +@item +There should be a way to exit the buffer. + +An @sc{open look} pushpin would do wonders. + +@item +Ask whether set or modified variables should be saved in +@code{kill-buffer-hook}. + +Ditto for @code{kill-emacs-query-functions}. + +@item +Command to check if there are any customization options that +does not belong to an existing group. + @end itemize @contents
--- a/man/lispref/building.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/lispref/building.texi Mon Aug 13 08:50:05 2007 +0200 @@ -134,8 +134,8 @@ @example @group (emacs-version) - @result{} "XEmacs 19.14 [Lucid] (i586-unknown-linux1.2.13) - of Wed Mar 6 1996 on nene" + @result{} "XEmacs 20.0 [Lucid] (i586-unknown-linux2.0.18) + of Wed Feb 6 1997 on nene" @end group @end example @@ -157,7 +157,7 @@ @defvar emacs-version The value of this variable is the version of Emacs being run. It is a -string, e.g. @code{"19.14 XEmacs Lucid"}. +string, e.g. @code{"20.0 XEmacs Lucid"}. @end defvar The following two variables did not exist before FSF GNU Emacs version @@ -166,12 +166,12 @@ @defvar emacs-major-version The major version number of Emacs, as an integer. For XEmacs version -19.14, the value is 19. +20.0, the value is 20. @end defvar @defvar emacs-minor-version The minor version number of Emacs, as an integer. For XEmacs version -19.14, the value is 14. +20.0, the value is 0. @end defvar @node Pure Storage
--- a/man/lispref/extents.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/lispref/extents.texi Mon Aug 13 08:50:05 2007 +0200 @@ -553,17 +553,9 @@ kill, yank, and undo commands will restore or copy it. @xref{Duplicable Extents}. -@item replicating -(Boolean) Meaningful only in conjunction with @code{duplicable}. If -set, actions that cause an extent to be copied from a buffer to a string -cause the original extent to be recorded in the copy (as the copied -extent's parent), so that when the extent is copied back into the -buffer, @code{eq}ness between the original extent and the re-inserted -extent is maintained whenever possible. @xref{Duplicable Extents}. - @item unique -(Boolean) Meaningful only in conjunction with @code{duplicable} and -@code{replicating}. When this is set, there may be only one instance of +(Boolean) Meaningful only in conjunction with @code{duplicable}. +When this is set, there may be only one instance of this extent attached at a time. @xref{Duplicable Extents}. @item invisible @@ -765,8 +757,7 @@ that you cannot create an inheritance loop -- this is explicitly disallowed. - Parent extents are used to implement the ``replicating'' property -(@pxref{Duplicable Extents}) and extents over the modeline. + Parent extents are used to implement the extents over the modeline. @defun set-extent-parent extent parent This function sets the parent of @var{extent} to @var{parent}. @@ -793,30 +784,14 @@ @node Duplicable Extents @section Duplicable Extents @cindex duplicable extent -@cindex replicating extents @cindex unique extents @cindex extent replica @cindex extent, duplicable -@cindex extent, replicating @cindex extent, unique If an extent has the @code{duplicable} property, it will be copied into strings, so that kill, yank, and undo commands will restore or copy it. - If a duplicable extent also has the @code{replicating} property, the -extent itself is not actually copied; rather, a pointer to it is -stored, along with the start and end positions of the extent. (This -is done by making the copied extent a child of the original extent. -Formerly, this was done by creating a special object called an -@dfn{extent replica}. Extent replicas no longer exist, but all the -functionality is available in a cleaner and more general fashion -using the @code{replicating} property.) This means that, e.g., -if you copy a replacting extent into the kill ring, then change the -properties of the extent, then paste the kill-ring text back into the -buffer, the newly-inserted extent will have the property changes you -just made to the original extent, and not the property values at the -time the text was copied into the kill ring. - Specifically: @itemize @bullet @@ -837,42 +812,8 @@ back into a buffer. @item -If a duplicable extent has the @code{replicating} property, then when -it is copied into a string, the parent of the new extent is set to the -extent it was copied from. - -@item -When an extent with the @code{replicating} property is copied from -a string back into a buffer: - -@itemize @minus -@item -If the extent's parent was detached from this buffer, it is reattached -at the new range. - -@item -If the extent's parent is attached to this buffer and is contiguous with -or overlaps the new range, it is simply extended to include that range. -Note that in this case the extent's @code{paste-function} is not called -(see below). - -@item -If the extent's parent was detached from another buffer, it is copied -as if by @code{copy-extent} and attached at the new range. - -@item -If the extent's parent is attached to another buffer, or is attached to -this buffer and does not overlap the new range, it is copied as if by -@code{copy-extent} and attached at the new range. However, if the -extent's parent has the @code{unique} property, this action is inhibited -and nothing happens. -@end itemize - -@item When @code{concat} is called on strings, the extents in the strings are -copied into the resulting string. If two or more replicating extents -with the same parent end up overlapping or abutting in the resulting -string, they are merged into a single extent. +copied into the resulting string. @item When @code{substring} is called on a string, the relevant extents @@ -883,10 +824,8 @@ deletion, or inserted by @code{insert-extent} or string insertion, the action is recorded by the undo mechanism so that it can be undone later. Note that if an extent gets detached and then a later undo causes the -extent to get reinserted, the new extent will be `eq' to the original -extent if and only if the extent has the @code{replicating} property -set. This is the same as what happens when a string is cut and then -pasted back in. +extent to get reinserted, the new extent will not be `eq' to the original +extent. @item Extent motion, face changes, and attachment via @code{make-extent} are
--- a/man/new-users-guide/custom2.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/new-users-guide/custom2.texi Mon Aug 13 08:50:05 2007 +0200 @@ -419,13 +419,13 @@ @noindent If you want to write your own menus, you can look at some of the examples in -@file{/usr/local/lib/xemacs-19.13/lisp/packages/big-menubar.el} file. +@file{/usr/local/lib/xemacs-20.0/lisp/packages/big-menubar.el} file. @end itemize For more information on initializing your @file{.emacs} file, @xref{Init File,,,,XEmacs User's Manual}. You should also look at -@file{/usr/local/lib/xemacs-19.13/etc/sample.emacs}, which is a sample +@file{/usr/local/lib/xemacs-20.0/etc/sample.emacs}, which is a sample @file{.emacs} file. It contains some of the commonly desired customizations in Emacs.
--- a/man/vm.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/vm.texi Mon Aug 13 08:50:05 2007 +0200 @@ -433,9 +433,9 @@ version of the folder until the folder is saved.@refill Typing @kbd{h} (@code{vm-summarize}) causes VM to pop up a window -containing a summary of contents of the current folder. The summary is +containing a summary of the contents of the current folder. The summary is presented one line per message, by message number, listing each message's -author, date sent, line and byte count, and subject. Also various +author, date sent, line and byte count, and subject. Also, various letters appear beside the message number to indicate that a message is new, unread, flagged for deletion, etc. An arrow @samp{->} appears to the left of the line summarizing the current message. The summary @@ -487,7 +487,7 @@ file. Since VM has in excess of forty configuration variables, use of the @file{~/.vm} can considerably reduce clutter in the @file{.emacs} file. You can force the reloading of this file on demand by typing -@kbd{L} from within VM.@refill +@kbd{L} (@code{vm-load-init-file}) from within VM.@refill @findex vm @vindex vm-primary-inbox @@ -545,15 +545,15 @@ The variable @code{vm-startup-with-summary} controls whether VM automatically displays a summary of the folder's contents at startup. A value of @code{nil} gives no summary; a value of @code{t} gives a full -screen summary. A value that is neither @code{t} nor @code{nil} splits -the screen between the summary and the folder display. The latter only +frame summary. A value that is neither @code{t} nor @code{nil} splits +the frame between the summary and the folder display. The latter only works if the variable @code{pop-up-windows}'s value is non-@code{nil}, and the value of @code{vm-mutable-windows} is non-@code{nil}. The default value of @code{vm-startup-with-summary} is @code{nil}.@refill @vindex vm-mail-window-percentage The variable @code{vm-mail-window-percentage} tells VM what percentage of -the screen should be given to the folder display when both it and the +the frame should be given to the folder display when both it and the folder summary are being displayed. Note that Emacs enforces a minimum window size limit, so a very high or very low value for this variable may squeeze out one of the displays entirely. This variable's default @@ -583,7 +583,7 @@ (@code{vm-next-message}) and @kbd{p} (@code{vm-previous-message}). These commands move forward and backward through the current folder. When they go beyond the end or beginning of the folder they wrap to the -beginning and end respectively. By default these commands skip messages +beginning and end respectively. By default, these commands skip messages flagged for deletion. This behavior can be disabled by setting the value of the variable @code{vm-skip-deleted-messages} to @code{nil}. These commands can also be made to skip messages that have been read; set @@ -616,12 +616,7 @@ Other commands to select messages: -@iftex -@table @asis -@end iftex -@ifinfo -@table @key -@end ifinfo +@table @kbd @findex vm-goto-message @kindex RET @item RET (@code{vm-goto-message}) @@ -668,7 +663,7 @@ @node Reading Messages, Sending Messages, Selecting Messages, Top @chapter Reading Messages -Once a message has been selected, VM will present it to you. By default +Once a message has been selected, VM will present it to you. By default, presentation is done in two stages: @dfn{previewing} and @dfn{paging}. @menu @@ -684,9 +679,9 @@ @key{SPC} exposes the body of the message, and from there you can repeatedly type @key{SPC} to page through the message. -By default the sender, recipient, subject and date headers are shown +By default, the sender, recipient, subject and date headers are shown when previewing; the rest of the message is hidden. This behavior may -be altered by changing the settings of two variables: +be altered by changing the settings of three variables: @code{vm-visible-headers}, @code{vm-invisible-header-regexp} and @code{vm-preview-lines}.@refill @@ -731,7 +726,7 @@ causes the From and Subject headers to be highlighted.@refill @vindex vm-preview-read-messages -By default VM previews all messages, even if they have already been read. +By default, VM previews all messages, even if they have already been read. To have VM preview only those messages that have not been read, set the value of @code{vm-preview-read-messages} to @code{nil}. @@ -770,17 +765,12 @@ GNU Emacs Manual}. However, @samp{*mail*} buffers created by VM have extra command keys: -@iftex -@table @asis -@end iftex -@ifinfo -@table @key -@end ifinfo +@table @kbd @findex vm-yank-message @kindex C-c C-y @item C-c C-y (@code{vm-yank-message}) Copies a message from the current folder into the @samp{*mail*} buffer. -The message number is read from the minibuffer. By default each line of +The message number is read from the minibuffer. By default, each line of the copy is prepended with the value of the variable @code{vm-included-text-prefix}. All message headers are yanked along with the text. Point is left before the inserted text, the mark after. @@ -808,12 +798,12 @@ described above. @code{vm-mail} can be invoked outside of VM by typing @kbd{M-x vm-mail}. -However, of the above commands, only @key{C-c y} +However, of the above commands, only @kbd{C-c y} (@code{vm-yank-message-other-folder}) will work; all the other commands require a parent folder.@refill If you send a message and it is returned by the mail system because it -was undeliverable, you an easily resend the message by typing @kbd{M-r} +was undeliverable, you can easily resend the message by typing @kbd{M-r} (@code{vm-resend-bounced-message}). VM will extract the old message and its pertinent headers from the returned message, and place you in a @samp{*mail*} buffer. You can then change the recipient addresses or do @@ -830,7 +820,7 @@ @vindex vm-reply-subject-prefix VM has special commands that make it easy to reply to a message. When a -reply command is invoked VM fills in the subject and recipient headers +reply command is invoked, VM fills in the subject and recipient headers for you, since it is apparent to whom the message should be sent and what the subject should be. There is an old convention of prepending the string @samp{"Re: "} to the subject of replies if the string isn't @@ -877,12 +867,7 @@ The reply commands are: -@iftex -@table @asis -@end iftex -@ifinfo -@table @key -@end ifinfo +@table @kbd @findex vm-reply @kindex r @item r (@code{vm-reply}) @@ -932,7 +917,7 @@ except the current message appears as the body of the message in the @samp{*mail*} buffer. The forwarded message is surrounded by RFC 934 compliant message delimiters. If the variable -@code{vm-rfc934-forwarding} is non-@code{nil} "^-" to "- -" character +@code{vm-rfc934-forwarding} is non-@code{nil}, "^-" to "- -" character stuffing is done to the forwarded message (this is the default). This behavior is required if the recipient of the forwarded message wants to use a RFC 934 standard bursting agent to access the message. If the @@ -1009,13 +994,13 @@ the default when prompting for a folder to save the message in. If the resulting folder name is a relative pathname it resolves to the directory named by @code{vm-folder-directory}, or the @code{default-directory} of -the currently visited folder if @code{vm-folder-directory} is nil.@refill +the currently visited folder if @code{vm-folder-directory} is @code{nil}.@refill When @var{folder-name} is evaluated, the current buffer will contain only the contents of the header named by @var{header-name}. It is safe to modify this buffer. You can use the match data from any @samp{\( @dots{} \)} grouping constructs in @var{regexp} along with the function -buffer-substring to build a folder name based on the header information. +@code{buffer-substring} to build a folder name based on the header information. If the result of evaluating @var{folder-name} is a list, then the list will be treated as another auto-folder-alist and will be descended recursively.@refill @@ -1047,18 +1032,13 @@ @vindex vm-delete-after-saving After a message is saved to a folder, the usual thing to do next is to delete it. If the variable @code{vm-delete-after-saving} is -non-@code{nil} VM will flag messages for deletion automatically after -saving them. This applies only to saves to folders, not for the @key{w} +non-@code{nil}, VM will flag messages for deletion automatically after +saving them. This applies only to saves to folders, not for the @kbd{w} command (see below).@refill Other commands: -@iftex -@table @asis -@end iftex -@ifinfo -@table @key -@end ifinfo +@table @kbd @findex vm-save-message-sans-headers @kindex w @item w (@code{vm-save-message-sans-headers}) @@ -1075,8 +1055,8 @@ @findex vm-pipe-message-to-command @kindex | @item | (@code{vm-pipe-message-to-command}) -Runs a shell command with the some or all of the current message as input. -By default the entire message is used.@* +Runs a shell command with some or all of the current message as input. +By default, the entire message is used.@* @* If invoked with one @t{C-u} the text portion of the message is used.@* If invoked with two @t{C-u}'s the header portion of the message is used.@* @@ -1092,12 +1072,7 @@ @dfn{expunged} or removed from the folder. The messages are not removed from the on-disk copy of the folder until the folder is saved. -@iftex -@table @asis -@end iftex -@ifinfo -@table @key -@end ifinfo +@table @kbd @findex vm-delete-message @kindex d @item d (@code{vm-delete-message}) @@ -1115,7 +1090,7 @@ @findex vm-kill-subject @kindex k @item k (@code{vm-kill-subject}) -Flags all message with the same subject as the current message (ignoring +Flags all messages with the same subject as the current message (ignoring ``Re:'') for deletion. @findex vm-expunge-folder @kindex # @@ -1166,17 +1141,17 @@ messages in the summary window.@refill To remove a mark from the current message, use @kbd{C-c SPC} -(@code{vm-unmark-message}. Prefix arguments work as with +(@code{vm-unmark-message}). Prefix arguments work as with @code{vm-mark-message}.@refill -Use @kbd{C-c C-a} to mark all message in the current folder; @kbd{C-c a} +Use @kbd{C-c C-a} to mark all messages in the current folder; @kbd{C-c a} removes marks from all messages. To apply a VM command to all marked message you must prefix it with the key sequence @kbd{C-c RET} (@code{vm-next-command-uses-marks}). The next VM command will apply to all marked messages, provided the command can be applied to such messages in a meaningful and useful way. -The current commands that can be applied to marked message are: +The current commands that can be applied to marked messages are: @code{vm-delete-message}, @code{vm-discard-cached-data}, @code{vm-followup}, @code{vm-followup-include-text}, @code{vm-reply}, @code{vm-reply-include-text}, @code{vm-save-message}, @@ -1207,7 +1182,7 @@ @kindex G In order to make numerous related messages easier to cope with, VM provides the command @kbd{G} (@code{vm-group-messages}), which groups -all message in a folder according to some criterion. @dfn{Grouping} +all messages in a folder according to some criterion. @dfn{Grouping} causes messages that are related in some way to be presented consecutively. The actual order of the folder is not altered; the messages are simply numbered and presented differently. Grouping @@ -1235,8 +1210,8 @@ If the variable @code{vm-group-by} has a non-@code{nil} value it specifies the default grouping that will be used for all folders. So if you like having your mail presented to you grouped by subject, then put -@code{(setq vm-group-by "subject")} in your @file{.emacs} file to get this -behavior.@refill +@code{(setq vm-group-by "subject")} in your @file{.vm} or @file{.emacs} +file to get this behavior.@refill @node Reading Digests, Summaries, Grouping Messages, Top @chapter Reading Digests @@ -1250,7 +1225,7 @@ @findex vm-burst-digest @kindex * The command @kbd{*} (@code{vm-burst-digest}) bursts a digest into its -individual messages and appends them to current folder. These +individual messages and appends them to the current folder. These messages are then assimilated into the current folder using the default grouping. @xref{Grouping Messages}. The original digest message is not altered, and the messages extracted from it are not part of the on-disk copy @@ -1274,10 +1249,11 @@ arrow @samp{->} appears to the left of the line summarizing the current message. The variable @code{vm-auto-center-summary} controls whether VM will keep the summary arrow vertically centered within the summary -window. A value of @code{t} causes VM to always keep arrow centered. A -value of @code{nil} means VM will never bother centering the arrow. A -value that is not @code{nil} and not @code{t} causes VM to center the -arrow only if the summary window is not the only existing window.@refill +window. A value of @code{t} causes VM to always keep the arrow +centered. A value of @code{nil} (the default) means VM will never +bother centering the arrow. A value that is not @code{nil} and not +@code{t} causes VM to center the arrow only if the summary window is not +the only existing window.@refill @vindex vm-summary-format The variable @code{vm-summary-format} controls the format of each @@ -1355,20 +1331,15 @@ Here are some VM customization variables that don't really fit into the other chapters. -@iftex -@table @asis -@end iftex -@ifinfo @table @code -@end ifinfo @vindex vm-confirm-quit @item vm-confirm-quit -A value of t causes VM to always ask for confirmation before ending -a VM visit of a folder. A nil value means VM will ask only when messages -will be lost unwittingly by quitting, i.e. not removed by intentional -delete and expunge. A value that is not nil and not t causes VM to ask -only when there are unsaved changes to message attributes or message -will be lost. +A value of @code{t} causes VM to always ask for confirmation before +ending a VM visit of a folder. A @code{nil} value means VM will ask +only when messages will be lost unwittingly by quitting, i.e. not +removed by intentional delete and expunge. A value that is neither +@code{nil} nor @code{t} causes VM to ask only when there are unsaved +changes to message attributes or message will be lost. @vindex vm-berkeley-mail-compatibility @item vm-berkeley-mail-compatibility A non-@code{nil} value means to read and write BSD @i{Mail(1)} style Status: @@ -1392,7 +1363,7 @@ @vindex vm-mutable-windows @item vm-mutable-windows This variable's value controls VM's window usage. A value of @code{t} gives VM -free run of the Emacs display; it will commandeer the entire screen for +free run of the Emacs display; it will commandeer the entire frame for its purposes. A value of @code{nil} restricts VM's window usage to the window from which it was invoked. VM will not create, delete, or use any other windows, nor will it resize its own window. A value that is neither @code{t}
--- a/man/w3.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/w3.texi Mon Aug 13 08:50:05 2007 +0200 @@ -1,4 +1,16 @@ \input texinfo +@c +@c Please note that this file uses some constructs not supported by earlier +@c versions of TeXinfo. You must be running one of the newer TeXinfo +@c releases (I currently use version 3.9 from ftp://prep.ai.mit.edu/pub/gnu +@c +@c Please do not send in bug reports about not being able to format the +@c document with 'makeinfo' or 'tex', just upgrade your installation. +@c +@c Info formatted files are provided in the distribution, and you can +@c retrieve dvi, postscript, and PDF versions from the web site or ftp +@c site: http://www.cs.indiana.edu/elisp/w3/docs.html +@c @setfilename w3.info @settitle Emacs-W3 User's Manual @iftex @@ -20,8 +32,8 @@ @ifinfo This file documents the Emacs-W3 World Wide Web browser. -Copyright (C) 1993, 1994, 1995 William M. Perry -Copyright (C) 1996 Free Software Foundation +Copyright (C) 1993, 1994, 1995, 1996 William M. Perry +Copyright (C) 1996, 1997 Free Software Foundation Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -43,14 +55,14 @@ @sp 4 @center Third Edition, Emacs-W3 Version 3.0 @sp 1 -@center December 1996 +@center February 1997 @sp 5 @center William M. Perry @center @i{wmperry@@cs.indiana.edu} @page @vskip 0pt plus 1filll Copyright @copyright{} 1993, 1994, 1995 William M. Perry@* -Copyright @copyright{} 1996 Free Software Foundation +Copyright @copyright{} 1996, 1997 Free Software Foundation Permission is granted to make and distribute verbatim copies of@* this manual provided the copyright notice and this permission notice@* @@ -59,23 +71,35 @@ @end titlepage @page @ifinfo -@node Top, Introduction,, (DIR) -This manual documents the Emacs-W3 World Wide Web browser, a Lisp program -which runs as a subsystem under Emacs. The manual is divided into the -following chapters. +@node Top, Getting Started,, (DIR) +Users can browse the World Wide Web from within Emacs by using Emacs-W3. +All of the widely used (and even some not very widely used) @sc{url} +schemes are supported, and it is very easy to add new methods as the +need arises. + +Emacs-W3 provides some core functionality that can be readily re-used +from any program in Emacs. Users and other package writers are +encouraged to @i{Web-enable} their applications and daily work routines +with the library. + +Emacs-W3 is completely customizable, both from Emacs-Lisp and from +stylesheets @xref{Style Sheets} If there is any aspect of Emacs-W3 that +cannot be modified to your satisfaction, please send mail to the +@t{w3-beta@@indiana.edu} mailing list with any suggestions. +@xref{Reporting Bugs} @menu -* Introduction:: Overview of Emacs-W3. * Getting Started:: Getting up and running with Emacs-W3 * Basic Usage:: Basic movement and usage of Emacs-W3. * Compatibility:: Explanation of compatibility with - other web browsers. -* Controlling Formatting:: How to control HTML formatting -* MIME Support:: Support for MIME -* Security:: Various forms of security + other browsers. +* Stylesheets:: How to control the look of web pages +* MIME Support:: Support for @sc{mime} +* Security:: Various security methods supported * Non-Unix Operating Systems:: Special considerations necessary to get up and running correctly under non-unix OS's. +* Speech Integration:: Outputting to a speech synthesizer. * Advanced Features:: Some of the more arcane features. * More Help:: How to get more help---mailing lists, newsgroups, etc. @@ -83,8 +107,7 @@ Appendices: * Reporting Bugs:: How to report a bug in Emacs-W3 -* Installing SSL:: Turning on SSL support -* Using PGP/PEM:: Turning on PGP/PEM encryption support +* Installing SSL:: Turning on @sc{ssl} support * Mailcap Files:: An explanation of Mailcap files Indices: @@ -93,451 +116,176 @@ @end menu @end ifinfo -@node Introduction, Getting Started, Top, Top -@chapter Introduction -@cindex World Wide Web - -:: WORK :: Basic info on what Emacs-W3 is, including copyrights, etc. - -@ifinfo -Here is some more specific information about what languages and -protocols Emacs-W3 supports. -@menu -* Markup Languages Supported:: Markup languages supported by Emacs-W3 -* Stylesheets:: Stylesheet languages supported by Emacs-W3 -* Supported Protocols:: Network protocols supported by Emacs-W3 -@end menu -@end ifinfo -@node Markup Languages Supported, Stylesheets, Introduction, Introduction -@chapter Supported Markup Languages -Several different markup languages, and various extensions to those -languages, are supported by Emacs-W3. -@ifinfo -@center ---------- -@center HTML 2.0 -@center ---------- -@end ifinfo -@iftex -@section HTML 2.0 -@end iftex -@cindex HTML 2.0 - -:: WORK :: Reference to the HTML 2.0 RFC -:: WORK :: Basic explanation of HTML, tag structure, etc. - -@ifinfo -@center ---------- -@center HTML 3.2 -@center ---------- -@end ifinfo -@iftex -@section HTML 3.2 -@end iftex -@cindex HTML 3.2 -The HTML 3.2 language is an extension of HTML, with a large degree of -backward compatibility with HTML 2.0. This basically documents current -practice as of January, 1996. - -@ifinfo -@center ---------- -@center SGML Features -@center ---------- -@end ifinfo -@iftex -@section SGML Features -@end iftex -@cindex SGML Features -@cindex Entity Definitions -@cindex Marked Sections - -:: WORK :: Document marked sections, SGML features - -@ifinfo -@center ---------- -@center Extras -@center ---------- -@end ifinfo -@iftex -@section Extra Markup -@end iftex -@cindex Easter Eggs -@cindex Fluff -@cindex Pomp & Circumstance -There are several different markup elements that are not officially part -of HTML or HTML 3.2 that Emacs-W3 supports. These are either items that -were dropped from HTML 3.@var{x} after I had implemented them, things I -find just completely hilarious, or experimental parts of HTML that -should not be counted as "official" or long lived. -@itemize @bullet -@item -FLAME support. For truly interesting dynamic documents. This is -replaced with a random quote from Mr. Angry (see @kbd{M-x flame} for a -sample). -@item -The top ten tags that did not make it into netscape. These tags were -posted to the newsgroup comp.infosystems.www.misc by Laura Lemay -(@i{lemay@@netcom.com}). Much thanks to her for the humor. -@table @b -@item <wired>...</wired> -Renders the enclosed text in a suitably ugly font/color combination. If -no default has been set up by the user, this is the default font, with -red text on a yellow background. -@item <roach>...</roach> -When selected, the enclosed text runs and hides under the nearest -window. OR, giggles a lot and demands nachos, depending on the -definition of "roach." (the formal definition, of course, to be -determined by the Official Honorary Internet Standards Committee For -Moving Really Slowly.) -@item <pinhead> -Inserts "zippyisms" into the enclosed text. Perfect for those professional -documents. This is sure to be a favorite of mine! -@item <secret>...</secret> -Must use secret spy decoder glasses (available direct from Netscape for -a reasonable fee) in order to read the enclosed text. Can also be read -by holding the computer in front of a full moon during the autumn -solstice. - -In Emacs-W3, this displays the text using rot13 encoding. -@item <hype> -Causes Marc Andreesen to magically appear and grant an interview (wanted -or not). Please use this tag sparingly. -@item <peek>....</peek> -@item <poke>...</poke> -Need more control over screen layout in HTML? Well, here ya go. -n -Actually, <peek> could almost be considered useful. The VARIABLE -attribute can be used to insert the value of an emacs variable into the -current document. Things like 'Welcome to my page, <peek -variable=user-mail-address>' can be useful in spreading fear, -uncertainty, and doubt among users. -@item <yogsothoth> -@cindex Gates Bill -@cindex Yogsothoth -Summons the elder gods to suck away your immortal soul. Or Bill Gates, -if the elder gods are busy. Unpredictable (but amusing) results occur -when the <YOGSOTHOTH> and <HYPE> tags are used in close proximity. - -@item <blink>...</blink> -Causes the enclosed text to .... ooops that one made it in. -@end table -@end itemize - -@node Stylesheets, Supported Protocols, Markup Languages Supported,Introduction -@chapter Stylesheets -@cindex Stylesheets -@cindex Cascading Style Sheets -@cindex Aural Cascading Style Sheets -@cindex CSS -@cindex DSSSL -:: WORK :: Document CSS support -CSS Information at http://www.w3.org/pub/WWW/TR/REC-CSS1 -Style guide at http://www.htmlhelp.com/reference/css/ -:: WORK :: Document ACSS support -ACSS Information at http://www.w3.org/pub/WWW/Style/CSS/Speech/NOTE-ACSS -:: WORK :: Document DSSSL support - -@node Supported Protocols, , Stylesheets, Introduction -@chapter Supported Protocols -@cindex Network Protocols -@cindex Protocols Supported -@cindex Supported Protocols -Emacs-W3 supports the following protocols -@table @b -@item Usenet News -Can either display an entire newsgroup or specific articles by -Message-ID: header. Instead of rewriting a newsreader, this integrates -with the Gnus newsreader. It requires at least Gnus 5.0, but it is -always safest to use the latest version. Gnus supports some very -advanced features, including virtual newsgroups, mail and news -integration, and reading news from multiple servers. @inforef{Gnus, -Top,gnus}, for more info. - -To be more in line with the other URL schemes, the hostname and port of -an NNTP server can be specified. URLs of the form -news://hostname:port/messageID work, but might not work in some other -browsers. - -@item HTTP -Supports the HTTP/0.9, HTTP/1.0, and parts of the HTTP/1.1 protocols. -@item Gopher -Support for all gopher types, including CSO queries. -@item Gopher+ -Support for Gopher+ retrievals. Support for converting ASK blocks into -HTML 3.0 FORMS and submitting them back to the server. -@item FTP -FTP is handled by either ange-ftp or efs. -@inforef{Ange-FTP,Top,ange-ftp}, for more information on Ange-FTP, or -@inforef{EFS, Top,efs}, for information on EFS. -@item Local files -Local files are of course handled, and MIME content-types are derived -from the file extensions. -@item telnet, tn3270, rlogin -Telnet, tn3270, and rogin are handled by running the appropriate program -in an emacs buffer, or running an external process. -@item mailto -Causes a mail message to be started to a specific address. Supports the -Netscape @i{extensions} to specify arbitrary headers on the message. -@item data -A quick and easy way to `inline' small pieces of information that you do -not necessarily want to download over the net separately. Can speed up -display of small icons, stylesheet information, etc. See the internet -draft draft-masinter-url-data-02.txt for more information. -@item mailserver -A more powerful version of mailto, which allows the author to specify -the subject and body text of the mail message. This type of link is -never fully executed without user confirmation, because it is possible -to insert insulting or threatening (and possibly illegal) data into the -message. The mail message is displayed, and the user must confirm the -message before it is sent. -@item x-exec -A URL can cause a local executable to be run, and its output interpreted -as if it had come from an HTTP server. This is very useful, but is -still an experimental protocol, hence the X- prefix. This URL protocol -is deprecated, but might be useful in the future. -@item NFS -Retrieves information over NFS. This requires that your operating -system support auto-mounting of NFS volumes. -@item finger -Retrieves information about a user via the 'finger' protocol. -@item Info -Creates a link to an GNU-style info file. @inforef{Info,Top,info}, for more -information on the Info format. -@item SSL -SSL requires a set of patches to the Emacs C code and SSLRef 2.0, or an -external program to run in a subprocess (similar to the @file{tcp.el} -package that comes with GNUS. @xref{Installing SSL} -@end table - -@node Getting Started, Getting Emacs, Introduction, Top +@node Getting Started, Basic Usage, Top, Top @chapter Getting Started @cindex Clueless in Seattle @cindex Getting Started -This section of the manual deals with getting, compiling, and -configuring @i{Emacs-W3}. -:: WORK :: Introduction to 'Getting Started' - -@ifinfo -@menu -* Getting Emacs:: Where to get Emacs -* Getting Emacs-W3:: Where to get Emacs-W3 -* Basic Setup:: Basic setup that most people want to do -* Firewalls:: Integrating Emacs-W3 with a firewall setup. -* Proxy Gateways:: Using a proxy server -@end menu -@end ifinfo - -@node Getting Emacs, Getting Emacs-W3, Getting Started, Getting Started -@section Getting Emacs -@cindex Getting Emacs -@cindex Source code availability -:: WORK :: Explanation of Emacs, XEmacs, and where to get both - -@node Getting Emacs-W3, Basic Setup, Getting Emacs, Getting Started -@section Getting Emacs-W3 -@cindex FTP'in the distribution -@cindex Source code availability -:: WORK :: Explanation of Emacs, XEmacs, and where to get both - -@node Basic Setup, Firewalls, Getting Emacs-W3, Getting Started -@section Basic Setup -For most people, Emacs-W3 will be ready to run straight out of the box. -Once the user is more familiar with the web and how it integrates with -Emacs, there are a few basic configuration variables that most people -will want to personalize. - -@table @code -@item w3-default-homepage +@kindex M-x w3 @vindex w3-default-homepage -The URL to open at startup. This defaults to the environment variable -WWW_HOME if it is not set it in the users @file{.emacs} file. If -WWW_HOME is undefined, then it defaults to the hypertext documentation -for Emacs-W3. +@findex w3 +If installed correctly, starting Emacs-W3 is quite painless. Just type +@kbd{M-x w3} in a running Emacs sessions. This will retrieve the +default page that has been configured - by default the documentation for +Emacs-W3 at Indiana University. -@item w3-delay-image-loads -@vindex w3-delay-image-loads -Controls the loading of inlined images. If non-@code{nil}, images are -not loaded. If the correct image converters are not installed or the -network connection is very slow, it is best to set this to @code{t}. -Defaults to @code{nil}. -@item url-global-history-file -@vindex url-global-history-file -The global history file used by both Mosaic/X and Emacs-W3. This file -contains a list of all the URLs that have been visited. This file is parsed -at startup and used to provide URL completion. Emacs-W3 can read and -write Mosaic/X or Netscape 1.x style history files, or use its own -internal format (faster). The file type is determined automatically, or -prompted for if the file does not exist. -@item w3-hotlist-file -@vindex w3-hotlist-file -Hotlist filename. This should be the name of a file that is stored in -NCSA's Mosaic/X or Netscape's format. It is used to keep a listing of -commonly accessed URLs. -@item w3-personal-annotation-directory -@vindex w3-personal-annotation-directory -The directory where Emacs-W3 looks for personal annotations. This is a -directory that should hold the personal annotations stored in a -Mosaic/X-compatible format. -@item url-pgp/pem-entity -@findex user-real-login-name -@findex system-name -The name by which the user is known to PGP and/or PEM entities. If this -is not set when Emacs-W3 is loaded, it defaults to -@code{user-mail-address} if it is set, otherwise @code{(user-real-login-name)}@@@code{(system-name)}. -@item url-personal-mail-address -@vindex url-personal-mail-address -@vindex url-pgp/pem-entity -User's full email address. This is what is sent to HTTP/1.0 servers as -the FROM header. If this is not set when Emacs-W3 is loaded, then it -defaults to the value of @code{url-pgp/pem-entity}. +If the default page is not retrieved correctly at startup, you will have +to do some customization. + +@menu +* Using the Network:: Tell Emacs about your network setup. +* Proxy Gateways:: Using an @sc{http} proxy +* Startup Files:: What is where, and why. +* Preferences Panel:: Quick configuration of common options. +@end menu -@item w3-right-border -@vindex w3-right-border -@findex window-width -Amount of space to leave on right margin of WWW buffers. This amount is -subtracted from the width of the window for each new WWW buffer and used -as the new @code{fill-column}. +@node Using the Network, Proxy Gateways, Getting Started, Getting Started +@section Using the Network +By default, Emacs can support standard @sc{tcp}/@sc{ip} network +connections on almost all the platforms it runs on (Unix, @sc{vms}, +Windows, etc). However, there are several situations where it is not +sufficient. -@item w3-track-mouse -@vindex w3-track-mouse -Controls whether to track the mouse and message the url under the mouse. -If this is non-@code{nil}, then a description of the hypertext area -under the mouse is shown in the minibuffer. This shows what type of -link (inlined image, form entry area, delayed image, delayed MPEG, or -hypertext reference) is under the cursor, and the destination. -@item w3-echo-link -@vindex w3-echo-link -Controls how a URL is shown when a link is reached with @key{f}, -@key{b}, or the mouse moves over it. Possible values are: @table @b -@item url -Displays the URL (ie: @samp{http://www.cs.indiana.edu/}). -@item text -Displays the text of the link (ie: @samp{A link to Indiana University}). -@item title -Displays the title of the link, if any, otherwise behaves the same as @code{url}. -@item nil -Show nothing. -@end table -@item w3-use-forms-index -@vindex w3-use-forms-index -@cindex ISINDEX handling -@cindex Forms based searching -@cindex Searching with forms -Non-@code{nil} means translate <ISINDEX> tags into a hypertext form. A -single text entry box is shown where the ISINDEX tag appears. -@item url-use-hypertext-gopher -@vindex url-use-hypertext-gopher -@cindex Gopher+ -Controls how gopher documents are retrieved. If non-@code{nil}, the -gopher pages are converted into HTML and parsed just like any other -page. If @code{nil}, the requests are passed off to the -@file{gopher.el} package by Scott Snyder. Using the @file{gopher.el} -package loses the gopher+ support, and inlined searching. -@item url-xterm-command -@vindex url-xterm-command -Command used to start a windowed shell, similar to an xterm. This -string is passed through @code{format}, and should expect four strings: -the title of the window, the program name to execute, and the server and -port number. The default is for xterm, which is very UNIX and -XWindows-centric. -@end table -@node Firewalls, Proxy Gateways, Basic Setup, Getting Started -@section Firewalls -@cindex Gateways -There are several different reasons why the gateway support might be -required. -@enumerate @cindex Firewalls -@item -Stuck behind a firewall. This is usually the case at large corporations -with paranoid system-administrators. - -@cindex TERM -@item -Using TERM @footnote{TERM is a user-level protocol for emulating IP over -a serial line. More information is available at -ftp://sunsite.unc.edu/pub/Linux/apps/comm/term} for slip-like access to -the internet. +@item Firewalls +It is becoming more and more common to be behind a firewall or some +other system that restricts your outbound network activity, especially +if you are like me and away from the wonderful world of academia. +Emacs-W3 has several different methods to get around firewalls (not to +worry though - none of them should get you in trouble with the local +@sc{mis} department.) -NOTE: XEmacs and Emacs 19.22 or later have patches to enable native TERM -networking. To enable it, #define TERM in the appropriate s/*.h file -for the operating system, then change the SYSTEM_LIBS define to include -the @file{termnet} library that comes with the latest versions of TERM. - -@item +@item Emacs cannot resolve hostnames. @cindex Faulty hostname resolvers -@cindex Broken SUN libc -@cindex Can't resolve hostnames -Emacs cannot resolve hostnames. This happens quite often on Sun -workstations and some ULTRIX machines. Some C libraries do not include -the hostname resolver routines in their static libraries. If Emacs was -linked statically, this means it won't be able to get to any machines +@cindex Broken SunOS libc +@cindex Hostname resolution +This happens quite often on SunOS workstations and some ULTRIX machines. +Some C libraries do not include the hostname resolver routines in their +static libraries. If Emacs was linked statically, and was not linked +with the resolver libraries, it wil not be able to get to any machines off the local network. This is characterized by being able to reach someplace with a raw ip number, but not its hostname -(http://129.79.254.191/ works, but http://www.cs.indiana.edu/ doesn't). +(@url{http://129.79.254.191/} works, but +@url{http://www.cs.indiana.edu/} doesn't). + +The best solution for this problem is to recompile Emacs, making sure to +either link dynamically (if available on your operating system), or +include the @file{-lresolv}. + +@cindex url-gateway-broken-resolution +If you do not have the disk space or the appropriate permissions to +recompile Emacs, another alternative is using the @file{nslookup} +program to do hostname resolution. To turn this on, set the variable +@code{url-gateway-broken-resolution} in your @file{~/.emacs} file. This +runs the program specified by @code{url-gateway-nslookup-program} (by +default "@code{nslookup}" to do hostname resolution. This program should +expect a single argument on the command line - the hostname to resolve, +and should produce output similar to the standard Unix @file{nslookup} +program: -If for some reason it is not feasible to recompile Emacs with the -@file{-lresolv} library or dynamic linking, it is just like being behind -a firewall. Another alternative is to set the variable -@code{url-broken-resolution} - this will use the support in ange-ftp or -EFS to use @file{nslookup} in a subprocess to do all hostname resolving. -See the variables @code{efs-nslookup-program}, -@code{efs-nslookup-on-connect}, and @code{efs-nslookup-threshold} if are -using EFS, or @code{ange-ftp-nslookup-program} if using Ange-FTP. +@example +Name: www.cs.indiana.ed +Address: 129.79.254.191 +@end example -@end enumerate +@cindex @sc{term} +@item Using @sc{term} (or @sc{term}-like) Networking Software +@sc{term} @footnote{@sc{term} is a user-level protocol for emulating +@sc{ip} over a serial line. More information is available at +@url{ftp://sunsite.unc.edu/pub/Linux/apps/comm/term}} for slip-like +access to the internet. + +@sc{note}: XEmacs and Emacs 19.22 or later have patches to enable native +@sc{term} networking. To enable it, @code{#define TERM} in the +appropriate s/*.h file for the operating system, then change the +@code{SYSTEM_LIBS} definition to include the @file{termnet} library that +comes with the latest versions of @sc{term}. + +If you run into any problems with the native @sc{term} networking +support in Emacs or XEmacs, please let @t{wmperry@@cs.indiana.edu} know, +as he is responsible for the original support. +@end table @vindex url-gateway-local-host-regexp Emacs-W3 has support for using the gateway mechanism for certain -domains, and directly connecting to others. To use this, change the -value of @code{url-gateway-local-host-regexp}. This should be a regular -expression @footnote{Please see the full Emacs distribution for a -description of regular expressions} that matches local hosts that do not -require the use of a gateway. If @code{nil}, then all connections are -made through the gateway. - +domains, and directly connecting to others. The variable +@code{url-gateway-local-host-regexp} controls this behaviour. This is a +regular expression @footnote{Please see the full Emacs distribution for +a description of regular expressions} that matches local hosts that do +not require the use of a gateway. If @code{nil}, then all connections +are made through the gateway. @vindex url-gateway-method -Emacs-W3 supports several methods of getting around gateways. The variable -@code{url-gateway-method} controls which of these methods is used. This -variable can have several values (use these as symbol names, not -strings): +Emacs-W3 supports several methods of getting around gateways. The +variable @code{url-gateway-method} controls which of these methods is +used. This variable can have several values (use these as symbol names, +not strings), ie: @samp{(setq url-gateway-method 'telnet)}. Possible +values are: + @table @dfn -@item program -Run a program in a subprocess to connect to remote hosts (examples are -@i{itelnet}@footnote{Itelnet is a standard name for a telnet executable -that is capable of escaping the firewall. Check with system -administrators to see if anything similar is available}, an -@i{expect}@footnote{Expect is a scripting language that allows control -of interactive programs (like telnet) very easily. It is available from -gatekeeper.dec.com:/pub/GNU/expect-3.24.0.tar.gz} script, etc.). +@item telnet +Use this method if you must first telnet and log into a gateway host, +and then run telnet from that host to connect to outside machines. + +:: WORK :: document telnet gw variables +This section needs more information, specifically documenting the +following variables. For now, please do @key{C-h v} on the variable for +more information. + +@table @code +@item url-gateway-telnet-host +@item url-gateway-telnet-parameters +@item url-gateway-telnet-password-prompt +@item url-gateway-telnet-puser-name +@item url-gateway-prompt-pattern +@end table + +@item rlogin +This method is identical to the @code{telnet} method, but uses +@file{rlogin} to log into the remote machine without having to send the +username and password over the wire every time. + +:: WORK :: document rlogin gw variables +This section needs more information, specifically documenting the +following variables. For now, please do @key{C-h v} on the variable for +more information. + +@table @code +@item url-gateway-rlogin-host +@item url-gateway-rlogin-parameters +@item url-gateway-rlogin-user-name +@item url-gateway-prompt-pattern +@end table @item tcp -Masanobu UMEDA (@i{umerin@@mse.kyutech.ac.jp}) has written a very nice -replacement for the standard networking in Emacs. This does basically -the same thing that a method of @code{program} does, but is slightly -more transparent to the user. -@item native -This means that Emacs-W3 should use the builtin networking code of Emacs. -This should be used only if there is no firewall, or the Emacs source -has already been hacked to get around the firewall. +Masanobu UMEDA (@i{umerin@@mse.kyutech.ac.jp}) has written a very small +application that you can run in a subprocess to do the network +connections. + +@item @sc{socks} +Use if the firewall has a @sc{socks} gateway running on it. + +:: WORK :: document socks variables +This section needs more information, specifically documenting the +following variables. For now, please do @key{C-h v} on the variable for +more information. + +@table @code +@item socks-host +@item socks-password +@item socks-username +@item socks-port +@item socks-timeout @end table -One of these needs a bit more explanation than that: -@vindex url-gateway-telnet-ready-regexp -@vindex url-gateway-telnet-program -When running a program in a subprocess to emulate a network connection, -a few extra variables need to be set. The variable -@code{url-gateway-telnet-program} should point to an executable that -accepts a hostname and port # as its arguments, and passes standard -input to the remote host. This can be either the full path to the -executable or just the basename. The variable -@code{url-gateway-telnet-ready-regexp} controls how long Emacs-W3 should -wait after spawning the subprocess to start sending to its standard -input. This gets around a bug where telnet would miss the beginning of -requests becausse it did not buffer its input before opening a -connection. This should be a regular expression to watch for that -signifies the end of the setup of @code{url-gateway-telnet-program}. -The default should work fine for telnet. + +@c @item ssl +@c This probably shouldn't be documented + +@item native +This means that Emacs-W3 should use the builtin networking code of +Emacs. This should be used only if there is no firewall, or the Emacs +source has already been hacked to get around the firewall. +@end table Emacs-W3 should now be able to get outside the local network. If none of this makes sense, its probably my fault. Please check with the @@ -546,28 +294,28 @@ through something similar to this before, and would be much more helpful/knowledgeable about the local setup than I would be. But feel free to mail me as a last resort. - -@node Proxy Gateways, Basic Usage, Firewalls, Getting Started +@node Proxy Gateways, Startup Files , Using the Network, Getting Started @section Proxy Gateways @vindex url-proxy-services @cindex Proxy Servers @cindex Proxies @cindex Proxies, environment variables @cindex HTTP Proxy + In late January 1993, Kevin Altis and Lou Montulli proposed and implemented a new proxy service. This service requires the use of environment variables to specify a gateway server/port # to send -protocol requests to. Each protocol (HTTP, WAIS, gopher, FTP, etc.@:) -can have a different gateway server. The environment variables are -@var{PROTOCOL}_proxy, where @var{PROTOCOL} is one of the supported -network protocols (gopher, file, HTTP, FTP, etc.) +protocol requests to. Each protocol (@sc{http}, @sc{wais}, gopher, +@sc{ftp}, etc.) can have a different gateway server. The environment +variables are @code{PROTOCOL}_proxy, where @code{PROTOCOL} is one of the +supported network protocols (gopher, file, @sc{http}, @sc{ftp}, etc.) @cindex No Proxy @cindex Proxies, exclusion lists @vindex NO_PROXY For companies with internal intranets, it will usually be helpful to define a list of hosts that should be contacted directly, @b{not} sent -through the proxy. The @var{NO_PROXY} environment variable controls +through the proxy. The @code{NO_PROXY} environment variable controls what hosts are able to be contacted directly. This should be a comma separated list of hostnames, domain names, or a mixture of both. Asterisks can be used as a wildcard. For example: @@ -585,8 +333,8 @@ For those adventurous souls who enjoy writing regular expressions, all the proxy settings can be manipulated from Emacs-Lisp. The variable @code{url-proxy-services} controls this. This is an assoc list, keyed -on the protocol type (http, gopher, etc) in all lowercase. The -@code{cdr} of each entry should be the fully-specified URL of the proxy +on the protocol type (@sc{http}, gopher, etc) in all lowercase. The +@code{cdr} of each entry should be the fully-specified @sc{url} of the proxy server to contact, or, in the case of the special "no_proxy" entry, a regular expression that matches any hostnames that should be contacted directly. @@ -596,22 +344,47 @@ ("no_proxy" . "^.*\\(aventail\\|seanet\\)\.com"))) @end example -@node Basic Usage, , Proxy Gateways, Top +@node Startup Files, Preferences Panel, Proxy Gateways, Getting Started +@section Startup Files +@cindex Startup files +@cindex Default stylesheet +:: WORK :: startup files +This section should document where emacs-w3 looks for its startup files, +and what each one does. 'profile' 'stylesheet' 'hotlist' 'history' etc. + +@node Preferences Panel, , Startup Files, Getting Started +@section Preferences Panel +@cindex Preferences +@kindex M-x w3-edit-preferences +:: WORK :: pref panel +This should document the quick preferences panel. M-x w3-edit-preferences + +@node Basic Usage, Movement , Getting Started, Top @chapter Basic Usage -Emacs-W3 is similar to the Info package all Emacs users hold near and dear to -their hearts (@xref{Top,,Info,info, The Info Manual}, for a description -of Info). Basically, @kbd{space} and @kbd{backspace} control scrolling, -and @kbd{return} or @kbd{mouse2} follows a hypertext link. The @kbd{f} -and @kbd{b} keys maneuver around the various links on the page. +@cindex Basic Usage +@kindex space +@kindex backspace +@kindex return +@kindex tab +@kindex M-tab +Emacs-W3 is similar to the Info package all Emacs users hold near and +dear to their hearts (@xref{Top,,Info,info, The Info Manual}, for a +description of Info). Basically, @kbd{space} and @kbd{backspace} +control scrolling, and @kbd{return} or the middle mouse button follows a +hypertext link. The @kbd{tab} and @kbd{Meta-tab} keys maneuver around the +various links on the page. -@b{NOTE:} To enter data into a form entry area, select it using -@kbd{return} or the middle mouse button, just like a hypertext link. +@b{NOTE:} Starting with Emacs-W3 3.0, form entry areas in a page can be +typed directly into. This is one of the main differences in navigation +from version 2.0. If you are used to using the @kbd{f} and @kbd{b} keys +to navigate around a buffer, I suggest training yourself to always use +@kbd{tab} and @kbd{M-tab} - it will save time and frustration on pages +with lots of form fields. By default, hypertext links are surrounded by '[[' and ']]' on non-graphic terminals (VT100, DOS window, etc.). On a graphics -terminal, the links are in shown in different colors. @xref{Controlling -Formatting} for information on how to change this, or for help on -getting the highlighting to work on graphics terminals. +terminal, the links are in shown in different colors. +@xref{Stylesheets} for information on how to change this. There are approximately 50 keys bound to special Emacs-W3 functions. The basic rule of thumb regarding keybindings in Emacs-W3 is that a @@ -624,26 +397,26 @@ @ifinfo @menu -* Movement:: Moving around in a Emacs-W3 buffer -* Information:: Getting information about the Emacs-W3 document being - viewed, and/or links within that document. -* Action:: Taking actions in a Emacs-W3 buffer (following links, - printing, etc.) -* Miscellaneous:: Miscellaneous keybindings +* Movement:: Moving around in the buffer. +* Information:: Getting information about a document. +* Action:: Following links, printing, etc. +* Miscellaneous:: Everything else. @end menu @end ifinfo @node Movement, Information, Basic Usage, Basic Usage @section Movement -:: WORK :: Document the 'h' and 'a' keymaps +All the standard Emacs bindings for movement are still in effect, with a +few additions for convenience. + @table @kbd -@findex scroll-up -@kindex SPC -@item SPC +@findex w3-scroll-up +@kindex space +@item space Scroll downward in the buffer. With prefix arg, scroll down that many screenfuls. -@kindex DEL +@kindex backspace @findex scroll-down -@item DEL +@item backspace Scroll upward in the buffer. With prefix arg, scroll up that many screenfuls. @kindex < @@ -655,96 +428,110 @@ @item > Goes to the end of document @kindex b -@kindex Shift-TAB -@findex w3-back-link -@item Shift-TAB, b +@kindex Meta-tab +@findex w3-widget-backward +@item Meta-tab, b Attempts to move backward one link area in the current document. Signals an error if no previous links are found. -@kindex hl -@findex w3-show-hotlist -@item hl -Displays a complete listing of the items in the hotlist. -@kindex hu -@findex w3-use-hotlist -@item hu -Go to a link in the hotlist. +@kindex f +@kindex tab +@kindex n +@findex w3-widget-forward +@item tab, f, n +Attempts to move forward one link area in the current document. Signals +an error if no more links are found. +@kindex B +@findex w3-backward-in-history +@item B +Move backwards in the history stack. +@kindex F +@findex w3-forward-in-history +@item F +Move forwards in the history stack. +@kindex l +@findex w3-goto-last-buffer +@item l +Return to the last buffer shown before this buffer. +@kindex q +@findex w3-quit +@item q +Kill this buffer. +@kindex Q, u +@findex w3-leave-buffer +Bury this buffer, but don't kill it +@end table + +@node Information, Action, Movement, Basic Usage +@section Information +These functions relate information about one or more links on the +current document. + +@table @kbd +@kindex v +@findex url-view-url +@item v +This shows the @sc{url} of the current document in the minibuffer. +@kindex V +@findex w3-view-this-url +@item V +This shows the @sc{url} of the hypertext link under point in the +minibuffer. +@kindex i +@findex w3-document-information +@item i +Shows miscellaneous information about the currently displayed document. +This includes the @sc{url}, the last modified date, @sc{mime} headers, +the @sc{http} response code, and any relationships to other documents. +Any security information is also displayed. +@kindex I +@findex w3-document-information-this-url +@item I +Shows information about the @sc{url} at point. +@kindex s +@findex w3-source-document +@item s +This shows the @sc{html} source of the current document in a separate buffer. +The buffer's name is based on the document's @sc{url}. +@kindex S +@findex w3-source-document-at-point +@item S +Shows the @sc{html} source of the hypertext link under point in a separate +buffer. The buffer's name is based on the document's @sc{url}. +@kindex k +@findex w3-save-url +@item k +This stores the current document's @sc{url} in the kill ring, and also in the +current window-system's clipboard, if possible. +@kindex K +@findex w3-save-this-url +@item K +Stores the @sc{url} of the document under point in the kill ring, and also in +the current window-system's clipboard, if possible. +@end table + +@node Action, Miscellaneous, Information, Basic Usage +@section Action +First, here are the keys and functions that bring up a new hypertext +page, usually creating a new buffer. +@table @kbd @kindex m @findex w3-complete-link @item m Choose a link from the current buffer and follow it. A completing-read is done on all the links, so @kbd{space} and @kbd{TAB} can be used for completion. -@kindex f -@kindex TAB -@kindex n -@findex w3-forward-link -@item TAB, f, n -Attempts to move forward one link area in the current document. Signals -an error if no more links are found. -@end table -@node Information, Action, Movement, Basic Usage -@section Information -These functions relate information about one or more links on the -current document. -@table @kbd -@kindex v -@findex url-view-url -@item v -This shows the URL of the current document in the minibuffer. -@kindex V -@findex w3-view-this-url -@item V -This shows the URL of the hypertext link under point in the minibuffer. -If there is not a hypertext link under point, then it shows the type of -form entry area under point. If there is no form entry area under -point, then it shows the inlined image's URL that is under point, if -any. -@kindex i -@findex w3-document-information -@item i -Shows miscellaneous information about the currently displayed document. -This includes the URL, the last modified date, MIME headers, the HTTP -response code, and any relationships to other documents. Any security -information is also displayed. -@kindex I -@findex w3-document-information-this-url -@item I -Shows information about the URL at point. -@kindex s -@findex w3-source-document -@item s -This shows the HTML source of the current document in a separate buffer. -The buffer's name is based on the document's URL. -@kindex S -@findex w3-source-document-at-point -@item S -Shows the HTML source of the hypertext link under point in a separate -buffer. The buffer's name is based on the document's URL. -@kindex k -@findex w3-save-url -@item k -This stores the current document's URL in the kill ring, and also in the -current window-system's clipboard, if possible. -@kindex K -@findex w3-save-this-url -@item K -Stores the URL of the document under point in the kill ring, and also in -the current window-system's clipboard, if possible. -@end table -@node Action, Miscellaneous, Information, Basic Usage -@section Action -First, here are the keys and functions that bring up a new hypertext -page, usually creating a new buffer. -@table @kbd @kindex return @findex w3-follow-link @item return Pressing return when over a hyperlink attempts to follow the link under the cursor. With a prefix argument (@kbd{C-u}), this forces the file to be saved to disk instead of being passed off to other viewers -or being parsed as HTML. +or being parsed as @sc{html}. -Pressing return when over a form input field will prompt in the +Pressing return when over a form input field can cause auto-submission +of the form. This is for Mosaic and Netscape compatibility. If there +is only one item in the form other than submit or reset buttons, then + minibuffer for the data to insert into the input field. Type checking is done, and the data is only entered into the form when data of the correct type is entered (ie: cannot enter 44 for 'date' field, etc). @@ -771,12 +558,12 @@ @findex w3-print-this-url @item p Prints out the current buffer in a variety of formats, including -PostScript, HTML source, or formatted text. +PostScript, @sc{html} source, or formatted text. @kindex P @findex w3-print-url-under-point @item P -Prints out the URL under point in a variety of formats, including -PostScript, HTML source, or formatted text. +Prints out the @sc{url} under point in a variety of formats, including +PostScript, @sc{html} source, or formatted text. @kindex m @findex w3-complete-link @item m @@ -795,7 +582,7 @@ @kindex C-o @findex w3-fetch @item C-o -Prompts for a URL in the minibuffer, and attempts to fetch +Prompts for a @sc{url} in the minibuffer, and attempts to fetch it. If there are any errors, or Emacs-W3 cannot understand the type of link requested, the errors are displayed in a hypertext buffer. @kindex o @@ -816,13 +603,13 @@ Perform a search, if this is a searchable index. Searching requires a server - Emacs-W3 can not do local file searching, as there are too many possible types of searches people could want to do. Generally, the only -URL types that allow searching are HTTP, gopher, and X-EXEC. +@sc{url} types that allow searching are @sc{http}, gopher, and X-EXEC. @kindex Hv @findex w3-show-history-list @vindex w3-keep-history @item Hv If @code{url-keep-history} is non-@code{nil}, then Emacs-W3 keeps track -of all the URLs visited in an Emacs session. This function takes all +of all the @sc{url}s visited in an Emacs session. This function takes all the links that are in that internal list, and formats them as hypertext links in a list. @end table @@ -870,16 +657,16 @@ @findex w3-mail-current-document @item M-m Mails the current document to someone. Choose from several different -formats to mail: formatted text, HTML source, PostScript, or LaTeX source. -When the HTML source is mailed, then an appropriate <base> tag is inserted +formats to mail: formatted text, @sc{html} source, PostScript, or LaTeX source. +When the @sc{html} source is mailed, then an appropriate <base> tag is inserted at the beginning of the document so that relative links may be followed correctly by whoever receives the mail. @kindex M-M @findex w3-mail-document-under-point @item M-M Mails the document pointed to by the hypertext link under point to someone. -Choose from several different formats to mail: formatted text, HTML source, -PostScript, or LaTeX source. When the HTML source is mailed, then an +Choose from several different formats to mail: formatted text, @sc{html} source, +PostScript, or LaTeX source. When the @sc{html} source is mailed, then an appropriate <base> tag is inserted at the beginning of the document so that relative links may be followed correctly by whoever receives the mail. @@ -887,7 +674,7 @@ @findex w3-print-this-url @item p Prints the current document. Choose from several different formats to -print: formatted text, HTML source, PostScript (with ps-print), or by using +print: formatted text, @sc{html} source, PostScript (with ps-print), or by using LaTeX and dvips). @findex lpr-buffer @@ -897,11 +684,11 @@ is called, and the variables @code{lpr-command} and @code{lpr-switches} control how the document is printed. -When the HTML source is printed, then an appropriate <base> tag is +When the @sc{html} source is printed, then an appropriate <base> tag is inserted at the beginning of the document. @vindex w3-print-commnad @vindex w3-latex-docstyle -When postscript is printed, then the HTML source of the document is +When postscript is printed, then the @sc{html} source of the document is converted into LaTeX source. There are several variables controlling what the final LaTeX document looks like. @@ -915,7 +702,7 @@ will be used instead. @item w3-latex-docstyle @vindex w3-latex-docstyle -The document style to use when printing or mailing converted HTML files +The document style to use when printing or mailing converted @sc{html} files in LaTeX. Good defaults are: @{article@}, [psfig,twocolumn]@{article@}, etc. @item w3-latex-packages @@ -928,8 +715,8 @@ document titles. @item w3-latex-print-links @vindex w3-latex-print-links -If non-@code{nil}, prints the URLs of hypertext links as endnotes at the -end of the document. If set to @code{footnote}, prints the URL's as +If non-@code{nil}, prints the @sc{url}s of hypertext links as endnotes at the +end of the document. If set to @code{footnote}, prints the @sc{url}'s as footnotes on each page. @end table @@ -941,15 +728,15 @@ @kindex M-x w3-insert-formatted-url @findex w3-insert-formatted-url @item M-x w3-insert-formatted-url -Insert a fully formatted HTML link into another buffer. This gets the -name and URL of either the current buffer, or, with a prefix arg, of the +Insert a fully formatted @sc{html} link into another buffer. This gets the +name and @sc{url} of either the current buffer, or, with a prefix arg, of the link under point, and construct the appropriate <a...>...</a> markup and insert it into the desired buffer. @kindex M-tab @findex w3-insert-this-url @item M-tab -Inserts the URL of the current document into another buffer. Buffer is -prompted for in the minibuffer. With prefix arg, uses the URL of the +Inserts the @sc{url} of the current document into another buffer. Buffer is +prompted for in the minibuffer. With prefix arg, uses the @sc{url} of the link under point. @kindex U @findex w3-use-links @@ -985,9 +772,6 @@ 'forward' and 'back' buttons easily. * Global History:: Keeping a history of all the places ever visited on the web. -* Annotations:: Annotations allow comments on other - people's Web documents without needing - to change the document. @end menu @end ifinfo @node Emulation, Hotlist Handling, Compatibility, Compatibility @@ -1002,7 +786,131 @@ @findex w3-lynx-emulation-minor-mode @vindex w3-mode-hook :: WORK :: Document lynx emulation +@table @key +@item Down arrow +Highlight next topic +@item Up arrow +Highlight previous topic +@item Right arrow, Return, Enter +Jump to highlighted topic +@item Left arrow +Return to previous topic +@item + +Scroll down to next page (Page-Down) +@item - +Scroll up to previous page (Page-Up) +@item SPACE +Scroll down to next page (Page-Down) +@item b +Scroll up to previous page (Page-Up) +@item C-A +Go to first page of the current document (Home) +@item C-E +Go to last page of the current document (End) +@item C-B +Scroll up to previous page (Page-Up) +@item C-F +Scroll down to next page (Page-Down) +@item C-N +Go forward two lines in the current document +@item C-P +Go back two lines in the current document +@item ) +Go forward half a page in the current document +@item ( +Go back half a page in the current document +@item # +Go to Toolbar or Banner in the current document +@item ?, h +Help (this screen) +@item a +Add the current link to a bookmark file +@item c +Send a comment to the document owner +@item d +Download the current link +@item e +Edit the current file +@item g +Goto a user specified @sc{url} or file +@item i +Show an index of documents +@item j +Execute a jump operation +@item k +Show a list of key mappings +@item l +List references (links) in current document +@item m +Return to main screen +@item o +Set your options +@item p +Print the current document +@item q +Quit +@item / +Search for a string within the current document +@item s +Enter a search string for an external search +@item n +Go to the next search string +@item v +View a bookmark file +@item V +Go to the Visited Links Page +@item x +Force submission of form or link with no-cache +@item z +Cancel transfer in progress +@item [backspace] +Go to the history Page +@item = +Show file and link info +@item \ +Toggle document source/rendered view +@item ! +Spawn your default shell +@item * +Toggle image_links mode on and off +@item [ +Toggle pseudo_inlines mode on and off +@item ] +Send an @sc{http} @sc{head} request for the current doc or link +@item C-R +Reload current file and refresh the screen +@item C-W +Refresh the screen +@item C-U +Erase input line +@item C-G +Cancel input or transfer +@item C-T +Toggle trace mode on and off +@item C-K +Invoke the Cookie Jar Page +@end table + :: WORK :: Document netscape emulation +Uh, turn this into pretty tables about what keys are emulated. + +@example +(define-key w3-netscape-emulation-minor-mode-map "\M-s" 'w3-save-as) +(define-key w3-netscape-emulation-minor-mode-map "\M-m" 'w3-mailto) +(define-key w3-netscape-emulation-minor-mode-map "\M-n" 'make-frame) +(define-key w3-netscape-emulation-minor-mode-map "\M-l" 'w3-fetch) +(define-key w3-netscape-emulation-minor-mode-map "\M-o" 'w3-open-local) +(define-key w3-netscape-emulation-minor-mode-map "\M-p" 'w3-print-this-url) +(define-key w3-netscape-emulation-minor-mode-map "\M-q" 'w3-quit) +(define-key w3-netscape-emulation-minor-mode-map "\M-f" 'w3-search-forward) +(define-key w3-netscape-emulation-minor-mode-map "\M-g" 'w3-search-again) +(define-key w3-netscape-emulation-minor-mode-map "\M-r" 'w3-reload-document) +(define-key w3-netscape-emulation-minor-mode-map "\M-i" 'w3-load-delayed-images) +(define-key w3-netscape-emulation-minor-mode-map "\M-a" 'w3-hotlist-add-document) +(define-key w3-netscape-emulation-minor-mode-map "\M-b" 'w3-show-hotlist) +(define-key w3-netscape-emulation-minor-mode-map "\M-h" 'w3-show-history-list) + +@end example @node Hotlist Handling, Session History, Emulation, Compatibility @section Hotlist Handling @@ -1010,7 +918,7 @@ :: WORK :: Make sure everything hotlist related can be accessed via 'h' In order to avoid having to traverse many documents to get to the same document over and over, Emacs-W3 supports a ``hotlist'' like Mosaic. This is -a file that contains URLs and aliases. Hotlists allow quick access to any +a file that contains @sc{url}s and aliases. Hotlists allow quick access to any document in the Web, providing it has been visited and added to the hotlist. The variable @code{w3-hotlist-file} determines where this information is saved. The structure of the file is compatible with Mosaic's @@ -1024,9 +932,8 @@ @item a Adds the current document to the hotlist, with the buffer name as its identifier. Modifies the file specified by @code{w3-hotlist-file}. If -this is given a @var{prefix-argument} (via @kbd{C-u}), the title is -prompted for instead of automatically defaulting to the -document title. +this is given a prefix-argument (via @kbd{C-u}), the title is prompted +for instead of automatically defaulting to the document title. @findex w3-hotlist-refresh @vindex w3-hotlist-file @@ -1062,7 +969,7 @@ @item hv @kindex hv @findex w3-show-hotlist -Converts the hotlist into HTML and displays it. +Converts the hotlist into @sc{html} and displays it. @item ha @kindex ha @findex w3-hotlist-apropos @@ -1075,16 +982,16 @@ @node Session History, Global History, Hotlist Handling, Compatibility @section History @cindex History Lists -Almost all web browsers keep track of the URLs followed from a page, so +Almost all web browsers keep track of the @sc{url}s followed from a page, so that it can provide @b{forward} and @b{back} buttons to keep a @i{path} -of URLs that can be traversed easily. +of @sc{url}s that can be traversed easily. @vindex url-keep-history If the variable @code{url-keep-history} is @code{t}, then Emacs-W3 -keeps a list of all the URLs visited in a session. +keeps a list of all the @sc{url}s visited in a session. @findex w3-show-history To view a listing of the history for this session of Emacs-W3, use @code{M-x w3-show-history} from any buffer, and Emacs-W3 generates an -HTML document showing every URL visited since Emacs started (or +@sc{html} document showing every @sc{url} visited since Emacs started (or cleared the history list), and then format it. Any of the links can be chosen and followed to the original document. To clear the history list, choose 'Clear History' from the 'Options' menu. @@ -1093,29 +1000,29 @@ @findex w3-backward-in-history @findex w3-fetch Another twist on the history list mechanism is the fact that all -Emacs-W3 buffers remember what URL, buffer, and buffer position of the +Emacs-W3 buffers remember what @sc{url}, buffer, and buffer position of the last document, and also keeps track of the next location jumped @b{to} from that buffer. This means that the user can go forwards and backwards very easily along the path taken to reach a particular document. To go forward, use the function @code{w3-forward-in-history}, to go backward, use the function @code{w3-backward-in-history}. -@node Global History, Annotations, Session History, Compatibility +@node Global History, , Session History, Compatibility @section Global History :: WORK :: Document that the global history can have diff. formats -Most web browsers also support the idea of a ``history'' of URLs the +Most web browsers also support the idea of a ``history'' of @sc{url}s the user has visited, and it displays them in a different style than normal -URLs. +@sc{url}s. @vindex url-keep-history @vindex url-global-history-file If the variable @code{url-keep-history} is @code{t}, then Emacs-W3 -keeps a list of all the URLs visited in a session. The file is +keeps a list of all the @sc{url}s visited in a session. The file is automatically written to disk when exiting emacs. The list is added to those already in the file specified by @code{url-global-history-file}, which defaults to @file{~/.mosaic-global-history}. -If any URL in the list is found in the file, it is not saved, but new +If any @sc{url} in the list is found in the file, it is not saved, but new ones are added at the end of the file. The function that saves the global history list is smart enough to @@ -1127,71 +1034,20 @@ One of the nice things about keeping a global history files is that Emacs-W3 can use it as a completion table. When doing @kbd{M-x w3-fetch}, pressing the @kbd{tab} or @kbd{space} key will show all completions for a -partial URL. This is very useful, especially for very long URLs that +partial @sc{url}. This is very useful, especially for very long @sc{url}s that are not in a hotlist, or for seeing all the pages from a particular web site before choosing which to retrieve. -@node Annotations, Group Annotations, Global History, Compatibility -@section Annotations -@cindex Annotations -Mosaic can @i{annotate} documents. Annotations are comments about the -current document, and these annotations appear as a link to the comments -at the end of the document. The original file is not changed. - -@ifinfo -@menu -* Group Annotations:: Annotations accessible by everyone -* Personal Annotations:: Private annotations only accessible - to the user who created them -@end menu -@end ifinfo -@node Group Annotations, Personal Annotations, Annotations, Annotations -@subsection Group Annotations -@cindex Group Annotations -@b{@i{NOTE}}: The group annotation experiment has been terminated. It -will be replaced with support on the server side for adding <LINK> tags -to documents. - -@node Personal Annotations, , Group Annotations, Annotations -@subsection Personal Annotations -@cindex Personal Annotations -@vindex w3-personal-annotation-directory -Emacs-W3 looks in the directory specified by -@code{w3-personal-annotation-directory} (defaults to -@file{~/.mosaic-personal-annotations}). Any personal annotations for a -document are automatically appended when it is retrieved. - -:: WORK :: Document the new 'a' prefix keymap -:: WORK :: Tell where the annotations are stored - -@findex w3-add-personal-annotation -@vindex w3-annotation-mode -To add a new personal annotation, type @kbd{M-x -w3-add-personal-annotation}. This creates a new buffer, in the mode -specified by @code{w3-annotation-mode}. This defaults to -@code{html-mode}. If this variable is @code{nil}, or it points to an -undefined function, then @code{default-major-mode} is consulted. - -A minor mode redefines @kbd{C-c C-c} to complete the annotation and -store it on the local disk. - -@findex w3-delete-personal-annotation -To delete a personal annotation, it must be the current page. Once -reading the annotation, @kbd{M-x w3-delete-personal-annotation} will -remove it. This deletes the file containing the annotation, and any -references to it in the annotation log file. - -Editing personal annotations is not yet supported. - -@node Controlling Formatting, General Formatting, Top, Top -@chapter Controlling Formatting +@node Stylesheets, General Formatting, Top, Top +@chapter Stylesheets @cindex Customizing formatting @cindex Specifying Fonts @cindex Fonts +@cindex Stylesheets @cindex Colors How Emacs-W3 formats a document is very customizable. All control over formatting is now controlled by a default stylesheet set by the user -with the @code{w3-default-sheet} variable. +with the @code{w3-default-stylesheet} variable. The following sections describe in more detail how to change the formatting of a document. @@ -1212,7 +1068,7 @@ handles inlined images/mpegs. @end menu @end ifinfo -@node General Formatting, Character based terminals, Controlling Formatting, Controlling Formatting +@node General Formatting, Character based terminals, Stylesheets, Stylesheets @section General formatting conventions @iftex @heading Setting the fill column @@ -1240,7 +1096,7 @@ @end ifinfo @vindex url-use-hypertext-dired When Emacs-W3 encounters a link to a directory (whether by local file access -or via FTP), it can either create an HTML document on the fly, or use +or via @sc{ftp}), it can either create an @sc{html} document on the fly, or use @code{dired-mode} to peruse the listing. The variable @code{url-use-hypertext-dired} controls this behavior. @@ -1265,7 +1121,7 @@ @cindex Gopher+ @cindex ASK blocks There are two different ways of viewing gopher links. The built-in -support that converts gopher directories into HTML, or the +support that converts gopher directories into @sc{html}, or the @file{gopher.el} package by Scott Snyder (@i{snyder@@fnald0.fnal.gov}). The variable that controls this is @code{w3-use-hypertext-gopher}. If set to @code{nil}, then @file{gopher.el} is used. Any other value @@ -1292,7 +1148,7 @@ @center -------------------- @end ifinfo @vindex w3-horizontal-rule-char -Horizontal rules (@b{<HR>} tags in HTML[+]) are used to separate chunks +Horizontal rules (@b{<HR>} tags in @sc{html}[+]) are used to separate chunks of a document, and is meant to be rendered as a solid line across the page. Some terminals display characters differently, so the variable @code{w3-horizontal-rule-char} controls which character is used to draw @@ -1301,13 +1157,13 @@ @code{make-string} whenever a horizontal rule of a certain width is necessary. -@node Character based terminals, Graphics workstations, General Formatting, Controlling Formatting +@node Character based terminals, Graphics workstations, General Formatting, Stylesheets @section On character based terminals @vindex w3-delimit-emphasis On character based terminals, there is no easy way to show that a certain range of text is in bold or italics. If the variable @code{w3-delimit-emphasis} is non-@code{nil}, then Emacs-W3 can insert -characters before and after character formatting commands in HTML +characters before and after character formatting commands in @sc{html} documents. The defaul value of @code{w3-delimit-emphasis} is automatically set based on the type of window system and version of Emacs being used. @@ -1321,21 +1177,21 @@ the header (1--6). The rest of the list should contain three items. The first item is text to insert before the header. The second item is text to insert after the header. Both should have reserved characters -converted to their HTML[+] entity definitions. The third item is a +converted to their @sc{html}[+] entity definitions. The third item is a function to call on the area the header is in. This function is called with arguments specifying the start and ending character positions of the header. The starting point is always first. To convert a region to upper case, please use @code{w3-upcase-region} instead of @code{upcase-region}, so that entities are converted properly. -@node Graphics workstations, Inlined images, Character based terminals, Controlling Formatting +@node Graphics workstations, Inlined images, Character based terminals, Stylesheets @section With graphics workstations Starting with the first public release of version 2.3.0, all formatting is controlled by the use of stylesheets. :: WORK :: Graphic workstation stuff - redo for stylesheets -@node Inlined images, , Graphics workstations, Controlling Formatting +@node Inlined images, , Graphics workstations, Stylesheets @cindex Inlined images @cindex Images @cindex Movies @@ -1355,11 +1211,11 @@ sites.} programs are normally used. This is a suite of freeware image conversion tools. The variable @code{w3-graphic-converter-alist} controls how each image type is converted. This is an assoc list, keyed -on the MIME content-type. The @code{car} is the content-type, and the -@code{cdr} is a string suitable to pass to @code{format}. A %s in this -string will be replaced with a converter from the ppm image format to an -XPixmap (or XBitmap, if being run on a monochrome display). By default, -the Emacs-W3 browser has converters for: +on the @sc{mime} content-type. The @code{car} is the content-type, and +the @code{cdr} is a string suitable to pass to @code{format}. A %s in +this string will be replaced with a converter from the ppm image format +to an XPixmap (or XBitmap, if being run on a monochrome display). By +default, the Emacs-W3 browser has converters for: @enumerate @item @@ -1463,19 +1319,19 @@ @node MIME Support, Adding MIME types based on file extensions, , Top @chapter MIME Support -MIME is an emerging standard for multimedia mail. It offers a very +@sc{mime} is an emerging standard for multimedia mail. It offers a very flexible typing mechanism. The type of a file or message is specified in two parts, separated by a '/'. The first part is the general category of the data (text, application, image, etc.). The second part is the specific type of data (postscript, gif, jpeg, etc.). So -@samp{text/html} specifies an HTML document, whereas +@samp{text/html} specifies an @sc{html} document, whereas @samp{image/x-xwindowdump} specifies an image of an Xwindow taken with the @file{xwd} program. -This typing allows much more flexibility in naming files. HTTP/1.0 +This typing allows much more flexibility in naming files. @sc{http}/1.0 servers can now send back content-type headers in response to a request, -and not have the client second-guess it based on file extensions. HTML +and not have the client second-guess it based on file extensions. @sc{html} files can now be named @file{something.gif} (not a great idea, but possible). @@ -1495,8 +1351,8 @@ @vindex mm-mime-extensions For some protocols however, it is still necessary to guess the content of a file based on the file extension. This type of guess-work should -only be needed when accessing files via FTP, local file access, or old -HTTP/0.9 servers. +only be needed when accessing files via @sc{ftp}, local file access, or old +@sc{http}/0.9 servers. Instead of specifying how to view things twice, once based on content-type and once based on the file extension, it is easier to map @@ -1512,7 +1368,7 @@ @cindex mime-types file @findex mm-parse-mimetypes -Both Mosaic and the NCSA HTTP daemon rely on a separate file for mapping +Both Mosaic and the NCSA @sc{http} daemon rely on a separate file for mapping file extensions to MIME types. Instead of having the users of Emacs-W3 duplicate this in lisp, this file can be parsed using the @code{url-parse-mimetypes} function. This function is called each time @@ -1535,7 +1391,7 @@ @file{/usr/local/www/conf/mime-types} @end enumerate -Each line contains information for one http type. These types resemble +Each line contains information for one @sc{http} type. These types resemble MIME types. To add new ones, use subtypes beginning with x-, such as application/x-myprogram. Lines beginning with # are comment lines, and suitably ignored. Each line consists of: @@ -1548,7 +1404,7 @@ @node Specifying Viewers, ,Adding MIME types based on file extensions, MIME Support @section Specifying Viewers -Not all files look as they should when parsed as an HTML document +Not all files look as they should when parsed as an @sc{html} document (whitespace is stripped, paragraphs are reformatted, and lots of little changes that make the document look unrecognizable). Files may be passed to external programs or Emacs Lisp functions to be viewed. @@ -1562,7 +1418,7 @@ As an alternative, the function @code{mm-add-mailcap-entry} can also be used from an appropriate hook.@xref{Hooks} This functions takes three arguments, the major type ("@i{image}"), the minor type ("@i{gif}"), and -an assoc list of information about the viewer. Please see the URL +an assoc list of information about the viewer. Please see the @sc{url} documentation for more specific information on what this assoc list should look like. @@ -1601,25 +1457,8 @@ @cindex Export Restrictions SSL is the @code{Secure Sockets Layer} interface developed by Netscape Communications @footnote{http://www.netscape.com/}. Emacs-W3 supports -HTTP transfers over an SSL encrypted channel, if the appropriate files +@sc{http} transfers over an SSL encrypted channel, if the appropriate files have been installed.@xref{Installing SSL} -@item PGP/PEM -@cindex HTTP/1.0 Authentication -@cindex Public Key Cryptography -@cindex Authentication, PGP -@cindex Authentication, PEM -@cindex RIPEM -@cindex Public Key Cryptography -@cindex PGP -@cindex Pretty Good Privacy -@cindex Encryption -@cindex Security -@cindex ITAR must die -@cindex Stupid export restrictions -@cindex Support your local crypto-anarchist -@cindex NSA freaks -A few servers still support this method of authentication, but it has -been superseded by SSL and Secure-HTTP.@xref{Using PGP/PEM} @end table @node Non-Unix Operating Systems, VMS, Security, Top @@ -1630,8 +1469,7 @@ * VMS:: The wonderful world of VAX|AXP-VMS! * OS/2:: The next-best thing to Unix. * MS-DOS:: The wonderful world of MS-DOG! -* 32-Bit Windows:: Windows NT, Chicago/Windows 95. -* Amiga:: The Amiga, for those who still love them. +* Windows:: Windows NT, Chicago/Windows 95. @end menu @end ifinfo @@ -1649,7 +1487,7 @@ @cindex Warp :: WORK :: OS/2 Specific instructions -@node MS-DOS, 32-Bit Windows, OS/2, Non-Unix Operating Systems +@node MS-DOS, Windows, OS/2, Non-Unix Operating Systems @section MS-DOS @cindex MS-DOS @cindex Microsloth @@ -1657,21 +1495,19 @@ @cindex MS-DOG :: WORK :: DOS Specific instructions -@node 32-Bit Windows, Amiga, MS-DOS, Non-Unix Operating Systems -@section 32-Bit Windows +@node Windows, Speech Integration , MS-DOS, Non-Unix Operating Systems +@section Windows @cindex Windows (32-Bit) @cindex 32-Bit Windows @cindex Microsloth @cindex Windows '95 :: WORK :: 32bit Windows Specific instructions -@node Amiga, Advanced Features, 32-Bit Windows, Non-Unix Operating Systems -@section Amiga -@cindex Amiga -@cindex Commodore -:: WORK :: Amiga specific instructions +@node Speech Integration, Advanced Features, Windows, Top +@chapter Speech Integration +:: WORK :: Emacspeak integration -@node Advanced Features, Style Sheets, Amiga, Top +@node Advanced Features, Style Sheets, Speech Integration, Top @chapter Advanced Features @ifinfo @@ -1680,7 +1516,7 @@ * Disk Caching:: Improving performance by using a local disk cache * Interfacing to Mail/News:: How to make VM understand hypertext links * Debugging HTML:: How to make Emacs-W3 display warnings about invalid - HTML/HTML+ constructs. + @sc{html}/@sc{html}+ constructs. * Native WAIS Support:: How to make Emacs-W3 understand WAIS links without using a gateway. * Rating Links:: How to make Emacs-W3 put an 'interestingness' value @@ -1730,13 +1566,13 @@ To include a stylesheet into a document, simply use the <style> tag. Use the @b{notation} attribute to specify what language the stylesheet is specified in. The default is @b{css}. The data between the <style> -and </style> tags is the stylsheet proper - no HTML parsing is done to +and </style> tags is the stylsheet proper - no @sc{html} parsing is done to this data - it is treated similar to an <XMP> section of text. To reference an external stylesheet, use the <link> tag. @example <link rel="stylesheet" href="/bill.style"> @end example -If these two mechanisms are mixed, then the URL is resolved first, and +If these two mechanisms are mixed, then the @sc{url} is resolved first, and the contents of the <style> tag take precedence if there are any conflicting directives. @@ -1804,7 +1640,7 @@ Emacs-W3 caches files under the temporary directory specified by @code{url-temporary-directory}, in a user-specific subdirectory (determined by the @code{user-real-login-name} function). The cache -files are stored under their original names, so a URL like: +files are stored under their original names, so a @sc{url} like: http://www.aventail.com/foo/bar/baz.html would be stored in a cache file named: /tmp/wmperry/com/aventail/www/foo/bar/baz.html. Sometimes, espcially with gopher links, there will be name conflicts, and an error @@ -1838,18 +1674,18 @@ @cindex Using Emacs-W3 with Gnus @cindex RMAIL @cindex Using Emacs-W3 with RMAIL -More and more people are including URLs in their signatures, and within +More and more people are including @sc{url}s in their signatures, and within the body of mail messages. It can get quite tedious to type these into the minibuffer to follow one. @vindex browse-url-browser-function With the latest versions of VM (the 5.9x series of betas) and Gnus -(5.x), URLs are automatically highlighted, and can be followed with the -mouse or the return key. How the URLs are viewed is determined by the +(5.x), @sc{url}s are automatically highlighted, and can be followed with the +mouse or the return key. How the @sc{url}s are viewed is determined by the variable @code{browse-url-browser-function}, and it should be set to the symbol @code{browse-url-w3}. -To access URLs from within RMAIL, the following hook should do the +To access @sc{url}s from within RMAIL, the following hook should do the trick. @example (add-hook 'rmail-mode-hook @@ -1867,11 +1703,11 @@ @vindex w3-debug-buffer @vindex w3-debug-html For those people that are adventurous, or are just as anal as I am about -people writing valid HTML, set the variable @code{w3-debug-html} to +people writing valid @sc{html}, set the variable @code{w3-debug-html} to @code{t} and see what happens. -If a Emacs-W3 thinks it has encountered invalid HTML, then a debugging +If a Emacs-W3 thinks it has encountered invalid @sc{html}, then a debugging message is displayed. :: WORK :: Need to list the different values w3-debug-html can have, and @@ -1892,17 +1728,17 @@ one of @code{url-wais-gateway-server} or @code{url-wais-gateway-port} should be @code{nil}. -When a WAIS URL is encountered, a form will be automatically generated +When a WAIS @sc{url} is encountered, a form will be automatically generated and displayed. After typing in the search term, the query will be sent to the server by running the @code{url-waisq-prog} in a subprocess. The -results will be converted into HTML and displayed. +results will be converted into @sc{html} and displayed. @node Rating Links, Gopher Plus Support, Native WAIS Support, Advanced Features @section Rating Links -The @code{w3-link-info-display-function} variable can be used to 'rate' a URL -when it shows up in an HTML page. If non-@code{nil}, then this should +The @code{w3-link-info-display-function} variable can be used to 'rate' a @sc{url} +when it shows up in an @sc{html} page. If non-@code{nil}, then this should be a list specifying (or a symbol specifying the name) of a function. -This function should expect one argument, a fully specified URL, and +This function should expect one argument, a fully specified @sc{url}, and should return a string. This string is inserted after the link text. @@ -1925,7 +1761,7 @@ @section Gopher+ Support @cindex Gopher+ The gopher+ support in Emacs-W3 is limited to the conversion of ASK -blocks into HTML 3.0 forms, and the usage of the content-length given by +blocks into @sc{html} 3.0 forms, and the usage of the content-length given by the gopher+ server to give a nice status bar on the bottom of the screen. @@ -1943,7 +1779,7 @@ @table @code @vindex w3-load-hooks @item w3-load-hooks -These hooks are run by @code{w3-do-setup} the first time a URL is +These hooks are run by @code{w3-do-setup} the first time a @sc{url} is fetched. All the w3 variables are initialized before this hook is run. @item w3-file-done-hooks @@ -1954,10 +1790,9 @@ are downloaded and converted. @item w3-file-prepare-hooks These hooks are run by @code{w3-prepare-buffer} before any parsing is -done on the HTML file. The HTTP/1.0 headers specified by -@code{w3-show-headers} have been inserted, the syntax table has been set -to @code{w3-parse-args-syntax-table}, and any personal annotations have -been inserted by the time this hook is run. +done on the @sc{html} file. The @sc{http}/1.0 headers specified by +@code{w3-show-headers} have been inserted, and the syntax table has been +set to @code{w3-parse-args-syntax-table} by the time this hook is run. @item w3-mode-hooks These hooks are run after a buffer has been parsed and displayed, but before any inlined images are downloaded and converted. @@ -1974,7 +1809,7 @@ @item url-bad-port-list @vindex url-bad-port-list List of ports to warn the user about connecting to. Defaults to just -the mail and NNTP ports so a malicious HTML author cannot spoof mail or +the mail and @sc{nntp} ports so a malicious @sc{html} author cannot spoof mail or news to other people. @item url-confirmation-func @vindex url-confirmation-func @@ -2027,10 +1862,10 @@ document. @item w3-show-headers @vindex w3-show-headers -This is a list of HTTP/1.0 headers to show at the end of a buffer. All +This is a list of @sc{http}/1.0 headers to show at the end of a buffer. All the headers should be in lowercase. They are inserted at the end of the buffer in a <UL> list. Alternatively, if this is simply @code{t}, then -all the HTTP/1.0 headers are shown. The default value is +all the @sc{http}/1.0 headers are shown. The default value is @code{nil}. @item w3-show-status, url-show-status @vindex url-show-status @@ -2063,7 +1898,7 @@ @vindex url-uncompressor-alist An assoc list of file extensions and the appropriate uncompression programs for each. This is used to build the Accept-encoding header for -HTTP/1.0 requests. +@sc{http}/1.0 requests. @item url-waisq-prog @vindex url-waisq-prog Name of the waisq executable on this system. This should be the @@ -2133,9 +1968,46 @@ @cindex Bugs @cindex Contacting the author -:: WORK :: Reporting bugs needs work. +If any bugs are discovered in Emacs-W3, please report them to the +mailing list @t{w3-beta@@indiana.edu} - this is where the brave souls +who beta test the latest versions of Emacs-W3 reside, and are generally +very responsive to bug reports. + +@kindex w +Please make sure to use the bug submission feature of Emacs-W3, so that +all relevant information will be sent along with your bug report. By +default this is bound to the `@key{w}' key when in an Emacs-W3 buffer, +or you can use @key{M-x w3-submit-bug} from anywhere within Emacs. + +For problems that are causing emacs to signal and error, please send a +backtrace. You can get a backtrace by @kbd{M-x setvariable RET +debug-on-error RET t RET}, and then reproduce the error. -@node Installing SSL, Using PGP/PEM, Reporting Bugs, Top +If the problem is visual, please capture a copy of the output and mail +it along with the bug report (preferably as a MIME attachment, but +anything will do). You can use the @code{xwd} program under X-windows +for this, or @key{Alt-PrintScreen} under Windows 95/NT. Sorry, but I +don't remember what the magic incarnation is for doing a screen dump +under NeXTstep or OS/2. + +If the problem is actually causing Emacs to crash, then you will need to +also mail the maintainers of the various Emacs distributions with the +bug. Please use the @t{gnu.emacs.bug} newgroup for reporting bugs with +GNU Emacs 19, and @t{comp.emacs.xemacs} for reporting bugs with XEmacs +19 or XEmacs 20. I am actively involved with the beta testing of the +latest versions of both branches of Emacs, and if I can reproduce the +problem, I will do my best to see it gets fixed in the next release. + +It is also important to always maintain as much context as possible in +your responses. I get so much email from my various Emacs-activities +and work, that I cannot remember everything. If you send a bug report, +and I send you a reply, and you reply with 'no that didn't work', then +odds are I will have no clue what didn't work, much less what that was +trying to fix in the first place. It will be much quicker and less +painful if I don't have to waste a round-trip email exchange saying +'what are you talking about'. + +@node Installing SSL, Mailcap Files, Reporting Bugs, Top @appendix Installing SSL @cindex HTTP/1.0 Authentication @cindex Secure Sockets Layer @@ -2171,115 +2043,7 @@ be distributing a set of patches to Emacs 19.xx and XEmacs 19.xx to SSL-enable them, for the sake of speed. -@node Using PGP/PEM, Mailcap Files, Installing SSL, Top -@appendix Using PGP/PEM -@cindex HTTP/1.0 Authentication -@cindex Public Key Cryptography -@cindex Authentication, PGP -@cindex Authentication, PEM -@cindex RIPEM -@cindex Public Key Cryptography -@cindex PGP -@cindex Pretty Good Privacy -@cindex Encryption -@cindex Security -@cindex ITAR must die -@cindex Stupid export restrictions -@cindex Support your local crypto-anarchist -@cindex NSA freaks -Most of this chapter has been reproduced from the original documentation -written by Rob McCool (@i{robm@@netscape.com})@footnote{See -http://hoohoo.ncsa.uiuc.edu/docs/PEMPGP.html for the original}. - -RIPEM is 'Riordan's Internet Privacy Enhanced Mail', and is currently on -version 1.2b3. US citizens can ftp it from -ftp://ripem.msu.edu/pub/crypt/ripem. - -PGP is 'Pretty Good Privacy', and is currently on version 2.6. The -legal controversies that plagued earlier versions have been resolved, so -this is a competely legal program now. There is also a legal version -for european users, called 2.6ui (the Unofficial International -version). - -PGP and PEM are programs that allow two parties to communicate in a way -which does not allow third parties to read them, and which certify that -the person who sent the message is really who they claim they are. - - -PGP and PEM both use RSA encryption. The U.S. government has strict -export controls over foreign use of this technology, so people outside -the U.S. may have a difficult time finding programs which perform the -encryption. - -A working copy of either Pretty Good Privacy or RIPEM is required. You -should be familiar with the program and have generated a public/private -key pair. - - -Currently, the protocol has been implemented with PEM and PGP using -local key files on the server side, and on the client side with PEM -using finger to retrieve the server's public key. - -Parties who wish to use Emacs-W3 with PEM or PGP encryption will need to -communicate beforehand and find a tamper-proof way to exchange their -public keys. - -Pioneers get shot full of arrows. This work is currently in the -experimental stages and thus may have some problems that I have -overlooked. The only known problem that I know about is that the -messages are currently not timestamped. This means that a malicious -user could record the encrypted message with a packet sniffer and repeat -it back to the server ad nauseum. Although they would not be able to -read the reply, if the request was for something being charged for, this -could be very inconvenient. - -This protocol is almost word-for-word a copy of Tony Sander's RIPEM -based scheme, generalized a little. Below, wherever PEM is used, -replace it with PGP, and the behaviour should remain the same. - -@example -*Client:* - -GET /docs/protected.html HTTP/1.0 -UserAgent: Emacs-W3/2.1.x - -*Server:* - -HTTP/1.0 401 Unauthorized -WWW-Authenticate: PEM entity="webmaster@@hoohoo.ncsa.uiuc.edu" -Server: NCSA/1.1 - -*Client:* - -GET / HTTP/1.0 -Authorization: PEM entity="robm@@ncsa.uiuc.edu" -Content-type: application/x-www-pem-request - ---- BEGIN PRIVACY-ENHANCED MESSAGE --- -this is the real request, encrypted ---- END PRIVACY-ENHANCED MESSAGE --- - -*Server:* - -HTTP/1.0 200 OK -Content-type: application/x-www-pem-reply - ---- BEGIN PRIVACY-ENHANCED MESSAGE --- -this is the real reply, encrypted ---- END PRIVACY-ENHANCED MESSAGE --- -That's it. -@end example - -@cindex Mailcrypt -Emacs-W3 uses the excellent @i{mailcrypt}@footnote{Available from -http://www.cs.indiana.edu/LCD/cover.html?mailcrypt} package written by -Jin S Choi (@i{jsc@@mit.edu}). This package takes care of calling ripem -and/or pgp with the correct arguments. Please see the documentation at -the top of mailcrypt.el for instructions on using mailcrypt. All bug -reports about mailcrypt should go to Jin S Choi, but bugs about how I -use it in Emacs-W3 should of course be directed to me. - -@node Mailcap Files, General Index, Using PGP/PEM, Top +@node Mailcap Files, General Index, Installing SSL, Top @appendix Mailcap Files NCSA Mosaic and almost all other WWW browsers rely on a separate file for mapping MIME types to external viewing programs. This takes some of @@ -2421,3 +2185,213 @@ @printindex ky @contents @bye + +@c @ifinfo +@c Here is some more specific information about what languages and +@c protocols Emacs-W3 supports. +@c @menu +@c * Markup Languages Supported:: Markup languages supported by Emacs-W3 +@c * Stylesheets:: Stylesheet languages supported by Emacs-W3 +@c * Supported Protocols:: Network protocols supported by Emacs-W3 +@c @end menu +@c @end ifinfo +@c @node Markup Languages Supported, Stylesheets, Introduction, Introduction +@c @chapter Supported Markup Languages +@c Several different markup languages, and various extensions to those +@c languages, are supported by Emacs-W3. +@c @ifinfo +@c @center ---------- +@c @center HTML 2.0 +@c @center ---------- +@c @end ifinfo +@c @iftex +@c @section HTML 2.0 +@c @end iftex +@c @cindex HTML 2.0 + +@c :: WORK :: Reference to the HTML 2.0 RFC +@c :: WORK :: Basic explanation of HTML, tag structure, etc. + +@c @ifinfo +@c @center ---------- +@c @center HTML 3.2 +@c @center ---------- +@c @end ifinfo +@c @iftex +@c @section HTML 3.2 +@c @end iftex +@c @cindex HTML 3.2 +@c The HTML 3.2 language is an extension of HTML, with a large degree of +@c backward compatibility with HTML 2.0. This basically documents current +@c practice as of January, 1996. + +@c @ifinfo +@c @center ---------- +@c @center SGML Features +@c @center ---------- +@c @end ifinfo +@c @iftex +@c @section SGML Features +@c @end iftex +@c @cindex SGML Features +@c @cindex Entity Definitions +@c @cindex Marked Sections + +@c :: WORK :: Document marked sections, SGML features + +@c @ifinfo +@c @center ---------- +@c @center Extras +@c @center ---------- +@c @end ifinfo +@c @iftex +@c @section Extra Markup +@c @end iftex +@c @cindex Easter Eggs +@c @cindex Fluff +@c @cindex Pomp & Circumstance +@c There are several different markup elements that are not officially part +@c of HTML or HTML 3.2 that Emacs-W3 supports. These are either items that +@c were dropped from HTML 3.@var{x} after I had implemented them, things I +@c find just completely hilarious, or experimental parts of HTML that +@c should not be counted as "official" or long lived. +@c @itemize @bullet +@c @item +@c FLAME support. For truly interesting dynamic documents. This is +@c replaced with a random quote from Mr. Angry (see @kbd{M-x flame} for a +@c sample). +@c @item +@c The top ten tags that did not make it into netscape. These tags were +@c posted to the newsgroup comp.infosystems.www.misc by Laura Lemay +@c (@i{lemay@@netcom.com}). Much thanks to her for the humor. +@c @table @b +@c @item <wired>...</wired> +@c Renders the enclosed text in a suitably ugly font/color combination. If +@c no default has been set up by the user, this is the default font, with +@c red text on a yellow background. +@c @item <roach>...</roach> +@c When selected, the enclosed text runs and hides under the nearest +@c window. OR, giggles a lot and demands nachos, depending on the +@c definition of "roach." (the formal definition, of course, to be +@c determined by the Official Honorary Internet Standards Committee For +@c Moving Really Slowly.) +@c @item <pinhead> +@c Inserts "zippyisms" into the enclosed text. Perfect for those professional +@c documents. This is sure to be a favorite of mine! +@c @item <secret>...</secret> +@c Must use secret spy decoder glasses (available direct from Netscape for +@c a reasonable fee) in order to read the enclosed text. Can also be read +@c by holding the computer in front of a full moon during the autumn +@c solstice. + +@c In Emacs-W3, this displays the text using rot13 encoding. +@c @item <hype> +@c Causes Marc Andreesen to magically appear and grant an interview (wanted +@c or not). Please use this tag sparingly. +@c @item <peek>....</peek> +@c @item <poke>...</poke> +@c Need more control over screen layout in HTML? Well, here ya go. +@c n +@c Actually, <peek> could almost be considered useful. The VARIABLE +@c attribute can be used to insert the value of an emacs variable into the +@c current document. Things like 'Welcome to my page, <peek +@c variable=user-mail-address>' can be useful in spreading fear, +@c uncertainty, and doubt among users. +@c @item <yogsothoth> +@c @cindex Gates Bill +@c @cindex Yogsothoth +@c Summons the elder gods to suck away your immortal soul. Or Bill Gates, +@c if the elder gods are busy. Unpredictable (but amusing) results occur +@c when the <YOGSOTHOTH> and <HYPE> tags are used in close proximity. + +@c @item <blink>...</blink> +@c Causes the enclosed text to .... ooops that one made it in. +@c @end table +@c @end itemize + +@c @node Stylesheets, Supported Protocols, Markup Languages Supported,Introduction +@c @chapter Stylesheets +@c @cindex Stylesheets +@c @cindex Cascading Style Sheets +@c @cindex Aural Cascading Style Sheets +@c @cindex CSS +@c @cindex DSSSL +@c :: WORK :: Document CSS support +@c CSS Information at http://www.w3.org/pub/WWW/TR/REC-CSS1 +@c Style guide at http://www.htmlhelp.com/reference/css/ +@c :: WORK :: Document ACSS support +@c ACSS Information at http://www.w3.org/pub/WWW/Style/CSS/Speech/NOTE-ACSS +@c :: WORK :: Document DSSSL support + +@c @node Supported Protocols, , Stylesheets, Introduction +@c @chapter Supported Protocols +@c @cindex Network Protocols +@c @cindex Protocols Supported +@c @cindex Supported Protocols +@c Emacs-W3 supports the following protocols +@c @table @b +@c @item Usenet News +@c Can either display an entire newsgroup or specific articles by +@c Message-ID: header. Instead of rewriting a newsreader, this integrates +@c with the Gnus newsreader. It requires at least Gnus 5.0, but it is +@c always safest to use the latest version. Gnus supports some very +@c advanced features, including virtual newsgroups, mail and news +@c integration, and reading news from multiple servers. @inforef{Gnus, +@c Top,gnus}, for more info. + +@c To be more in line with the other @sc{url} schemes, the hostname and port of +@c an @sc{nntp} server can be specified. @sc{url}s of the form +@c news://hostname:port/messageID work, but might not work in some other +@c browsers. + +@c @item @sc{http} +@c Supports the @sc{http}/0.9, @sc{http}/1.0, and parts of the @sc{http}/1.1 protocols. +@c @item Gopher +@c Support for all gopher types, including CSO queries. +@c @item Gopher+ +@c Support for Gopher+ retrievals. Support for converting ASK blocks into +@c HTML forms and submitting them back to the server. +@c @item @sc{ftp} +@c @sc{ftp} is handled by either ange-ftp or efs. +@c @inforef{Ange-FTP,Top,ange-ftp}, for more information on Ange-FTP, or +@c @inforef{EFS, Top,efs}, for information on EFS. +@c @item Local files +@c Local files are of course handled, and MIME content-types are derived +@c from the file extensions. +@c @item telnet, tn3270, rlogin +@c Telnet, tn3270, and rogin are handled by running the appropriate program +@c in an emacs buffer, or running an external process. +@c @item mailto +@c Causes a mail message to be started to a specific address. Supports the +@c Netscape @i{extensions} to specify arbitrary headers on the message. +@c @item data +@c A quick and easy way to `inline' small pieces of information that you do +@c not necessarily want to download over the net separately. Can speed up +@c display of small icons, stylesheet information, etc. See the internet +@c draft draft-masinter-url-data-02.txt for more information. +@c @item mailserver +@c A more powerful version of mailto, which allows the author to specify +@c the subject and body text of the mail message. This type of link is +@c never fully executed without user confirmation, because it is possible +@c to insert insulting or threatening (and possibly illegal) data into the +@c message. The mail message is displayed, and the user must confirm the +@c message before it is sent. +@c @item x-exec +@c A @sc{url} can cause a local executable to be run, and its output interpreted +@c as if it had come from an @sc{http} server. This is very useful, but is +@c still an experimental protocol, hence the X- prefix. This @sc{url} protocol +@c is deprecated, but might be useful in the future. +@c @item @sc{nfs} +@c Retrieves information over @sc{nfs}. This requires that your operating +@c system support auto-mounting of @sc{nfs} volumes. +@c @item finger +@c Retrieves information about a user via the 'finger' protocol. +@c @item Info +@c Creates a link to an GNU-style info file. @inforef{Info,Top,info}, for more +@c information on the Info format. +@c @item SSL +@c SSL requires a set of patches to the Emacs C code and SSLRef 2.0, or an +@c external program to run in a subprocess (similar to the @file{tcp.el} +@c package that comes with GNUS. @xref{Installing SSL} +@c @end table +
--- a/man/widget.texi Mon Aug 13 08:49:44 2007 +0200 +++ b/man/widget.texi Mon Aug 13 08:50:05 2007 +0200 @@ -1,6 +1,6 @@ \input texinfo.tex -@c $Id: widget.texi,v 1.1 1997/02/02 04:58:52 steve Exp $ +@c $Id: widget.texi,v 1.2 1997/02/09 23:52:13 steve Exp $ @c %**start of header @setfilename widget @@ -15,7 +15,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.20 +Version: 1.30 @menu * Introduction:: @@ -627,10 +627,21 @@ Face used for highlighting the editable field. Default is @code{widget-field-face}. +@item :secret +Character used to display the value. You can set this to e.g. @code{?*} +if the field contains a password or other secret information. By +default, the value is not secret. + +@item :valid-regexp +By default the @code{:validate} function will match the content of the +field with the value of this attribute. The default value is @code{""} +which matches everything. + @item :keymap -Keymap used in the editable field. @code{widget-keymap} will allow you -to use normal editing commands, even if these has been suppressed in the -current buffer. +Keymap used in the editable field. The default value is +@code{widget-field-keymap}, which allows you to use all the normal +editing commands, even if the buffers major mode supress some of them. +Pressing return activates the function specified by @code{:activate}. @item :hide-front-space @itemx :hide-rear-space @@ -660,7 +671,8 @@ @subsection The @code{text} Widget This is just like @code{editable-field}, but intended for multiline text -fields. +fields. The default @code{:keymap} is @code{widget-text-keymap}, which +does not rebind the return key. @node menu-choice, radio-button-choice, text, Basic Types @comment node-name, next, previous, up @@ -1089,8 +1101,8 @@ @comment node-name, next, previous, up @section Properties -You can examine or set this value by using the widget object that was -returned by @code{widget-create}. +You can examine or set the value of a widget by using the widget object +that was returned by @code{widget-create}. @defun widget-value widget Return the current value contained in @var{widget}. @@ -1129,6 +1141,13 @@ Non-nil if @var{widget} has a value (even nil) for property @var{property}. @end defun +Occasionally it can be useful to know which kind of widget you have, +i.e. the name of the widget type you gave when the widget was created. + +@defun widget-name widget +Return the name of @var{widget}, a symbol. +@end defun + @node Defining New Widgets, Widget Wishlist., Widget Properties, Top @comment node-name, next, previous, up @section Defining New Widgets @@ -1238,24 +1257,13 @@ @section Wishlist. @itemize @bullet -@item -In general, we need @strong{much} better support for keyboard -operations. +@item +A Smalltalk style widget browser. -@itemize - @item It should be possible to add or remove items from a list with @kbd{C-k} and @kbd{C-o} (suggested by @sc{rms}). -@item -@kbd{C-k} should kill to end of field or end of line, whatever come -first. - -@item -Commands to move to the beginning/end of a field. - -@end itemize - @item The @samp{[INS]} and @samp{[DEL]} buttons should be replaced by a single dash (@samp{-}). The dash should be a button that, when activated, ask @@ -1271,9 +1279,7 @@ There should be support for browsing the widget documentation. @item -There should be a way to specify that @key{RET} in a field will call the -@code{:activate} function. This should be used by widgets such as -@code{file} and @code{symbol} prompt with completion. +Widgets such as @code{file} and @code{symbol} should prompt with completion. @item The @code{menu-choice} tag should be prettier, something like the abbreviated @@ -1282,7 +1288,7 @@ @item The functions used in many widgets, like @code{widget-item-convert-widget}, should not have names that are -specific to the first widget where I used them. +specific to the first widget where I happended to use them. @item Unchecked items in a @code{radio-button-choice} or @code{checklist}
--- a/src/Makefile.in.in Mon Aug 13 08:49:44 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 08:50:05 2007 +0200 @@ -1159,7 +1159,7 @@ ${lispdir}bytecomp/bytecomp-runtime.elc FLOAT_LISP EPOCH_LISP \ ${lispdir}prim/itimer.elc ${lispdir}ediff/ediff-hook.elc \ ${lispdir}custom/custom.elc ${lispdir}custom/widget.elc \ - ${lispdir}w3/w3-sysdp.elc ${lispdir}w3/font.elc \ + ${lispdir}w3/font.elc \ ${lispdir}packages/fontl-hooks.elc SCROLLBAR_LISP \ ${lispdir}prim/buffer.elc MENUBAR_LISP \ ${lispdir}packages/buff-menu.elc DIALOG_LISP \
--- a/src/abbrev.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/abbrev.c Mon Aug 13 08:50:05 2007 +0200 @@ -77,12 +77,12 @@ /* Expand the word before point, if it is an abbrev. Returns Qt if an expansion is done. */ -DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "" /* +DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /* Expand the abbrev before point, if there is an abbrev there. Effective when explicitly called even when `abbrev-mode' is nil. Returns t if expansion took place. -*/ ) - () +*/ + ()) { /* This function can GC */ REGISTER Bufbyte *buffer, *p; @@ -225,7 +225,7 @@ syms_of_abbrev (void) { defsymbol (&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook"); - defsubr (&Sexpand_abbrev); + DEFSUBR (Fexpand_abbrev); } void
--- a/src/alloc.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/alloc.c Mon Aug 13 08:50:05 2007 +0200 @@ -984,11 +984,10 @@ /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */ #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000 -DEFUN ("cons", Fcons, Scons, 2, 2, 0 /* +DEFUN ("cons", Fcons, 2, 2, 0, /* Create a new cons, give it CAR and CDR as components, and return it. -*/ ) - (car, cdr) - Lisp_Object car, cdr; +*/ + (car, cdr)) { /* This cannot GC. */ Lisp_Object val = Qnil; @@ -1017,13 +1016,11 @@ return val; } -DEFUN ("list", Flist, Slist, 0, MANY, 0 /* +DEFUN ("list", Flist, 0, MANY, 0, /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { Lisp_Object len, val, val_tail; @@ -1089,11 +1086,10 @@ return Fcons (obj0, list5 (obj1, obj2, obj3, obj4, obj5)); } -DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0 /* +DEFUN ("make-list", Fmake_list, 2, 2, 0, /* Return a newly created list of length LENGTH, with each element being INIT. -*/ ) - (length, init) - Lisp_Object length, init; +*/ + (length, init)) { Lisp_Object val; int size; @@ -1195,12 +1191,11 @@ return (vector); } -DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0 /* +DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /* Return a newly created vector of length LENGTH, with each element being INIT. See also the function `vector'. -*/ ) - (length, init) - Lisp_Object length, init; +*/ + (length, init)) { if (!INTP (length) || XINT (length) < 0) length = wrong_type_argument (Qnatnump, length); @@ -1208,13 +1203,11 @@ return (make_vector (XINT (length), init)); } -DEFUN ("vector", Fvector, Svector, 0, MANY, 0 /* +DEFUN ("vector", Fvector, 0, MANY, 0, /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { Lisp_Object vector = Qnil; int elt; @@ -1403,12 +1396,11 @@ return bit_vector; } -DEFUN ("make-bit-vector", Fmake_bit_vector, Smake_bit_vector, 2, 2, 0 /* +DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /* Return a newly created bit vector of length LENGTH. Each element is set to INIT. See also the function `bit-vector'. -*/ ) - (length, init) - Lisp_Object length, init; +*/ + (length, init)) { if (!INTP (length) || XINT (length) < 0) length = wrong_type_argument (Qnatnump, length); @@ -1416,13 +1408,11 @@ return (make_bit_vector (XINT (length), init)); } -DEFUN ("bit-vector", Fbit_vector, Sbit_vector, 0, MANY, 0 /* +DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /* Return a newly created bit vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { Lisp_Object bit_vector = Qnil; int elt; @@ -1483,7 +1473,7 @@ return (new); } -DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0 /* +DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /* Create a compiled-function object. Usage: (arglist instructions constants stack-size &optional doc-string interactive-spec) @@ -1494,10 +1484,8 @@ specified, then that means the function is not interactive. This is terrible behavior which is retained for compatibility with old `.elc' files which expected these semantics. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* In a non-insane world this function would have this arglist... (arglist, instructions, constants, stack_size, doc_string, interactive) @@ -1658,12 +1646,11 @@ DECLARE_FIXED_TYPE_ALLOC (symbol, struct Lisp_Symbol); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000 -DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0 /* +DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /* Return a newly allocated uninterned symbol whose name is NAME. Its value and function definition are void, and its property list is nil. -*/ ) - (str) - Lisp_Object str; +*/ + (str)) { Lisp_Object val; struct Lisp_Symbol *p; @@ -1742,10 +1729,10 @@ DECLARE_FIXED_TYPE_ALLOC (marker, struct Lisp_Marker); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000 -DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0 /* +DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /* Return a newly allocated marker which does not point at any place. -*/ ) - () +*/ + ()) { Lisp_Object val; struct Lisp_Marker *p; @@ -2070,12 +2057,11 @@ #endif } -DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0 /* +DEFUN ("make-string", Fmake_string, 2, 2, 0, /* Return a newly created string of length LENGTH, with each element being INIT. LENGTH must be an integer and INIT must be a character. -*/ ) - (length, init) - Lisp_Object length, init; +*/ + (length, init)) { Lisp_Object val; @@ -2520,13 +2506,12 @@ -DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0 /* +DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /* Make a copy of OBJECT in pure storage. Recursively copies contents of vectors and cons cells. Does not copy symbols. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { int i; if (!purify_flag) @@ -4112,7 +4097,7 @@ (pl) = gc_plist_hack ((name), s, (pl)); \ } -DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "" /* +DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /* Reclaim storage for Lisp objects no longer needed. Returns info on amount of space in use: ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS) @@ -4122,8 +4107,8 @@ more detailed information. Garbage collection happens automatically if you cons more than `gc-cons-threshold' bytes of Lisp data since previous garbage collection. -*/ ) - () +*/ + ()) { Lisp_Object pl = Qnil; Lisp_Object ret[6]; @@ -4230,24 +4215,24 @@ } #undef HACK_O_MATIC -DEFUN ("consing-since-gc", Fconsing_since_gc, Sconsing_since_gc, 0, 0, "" /* +DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /* Return the number of bytes consed since the last garbage collection. \"Consed\" is a misnomer in that this actually counts allocation of all different kinds of objects, not just conses. If this value exceeds `gc-cons-threshold', a garbage collection happens. -*/ ) - () +*/ + ()) { return (make_int (consing_since_gc)); } -DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, "" /* +DEFUN ("memory-limit", Fmemory_limit, 0, 0, "", /* Return the address of the last byte Emacs has allocated, divided by 1024. This may be helpful in debugging Emacs's memory usage. The value is divided by 1024 to make sure it will fit in a lisp integer. -*/ ) - () +*/ + ()) { return (make_int ((EMACS_INT) sbrk (0) / 1024)); } @@ -4497,21 +4482,21 @@ defsymbol (&Qpost_gc_hook, "post-gc-hook"); defsymbol (&Qgarbage_collecting, "garbage-collecting"); - defsubr (&Scons); - defsubr (&Slist); - defsubr (&Svector); - defsubr (&Sbit_vector); - defsubr (&Smake_byte_code); - defsubr (&Smake_list); - defsubr (&Smake_vector); - defsubr (&Smake_bit_vector); - defsubr (&Smake_string); - defsubr (&Smake_symbol); - defsubr (&Smake_marker); - defsubr (&Spurecopy); - defsubr (&Sgarbage_collect); - defsubr (&Smemory_limit); - defsubr (&Sconsing_since_gc); + DEFSUBR (Fcons); + DEFSUBR (Flist); + DEFSUBR (Fvector); + DEFSUBR (Fbit_vector); + DEFSUBR (Fmake_byte_code); + DEFSUBR (Fmake_list); + DEFSUBR (Fmake_vector); + DEFSUBR (Fmake_bit_vector); + DEFSUBR (Fmake_string); + DEFSUBR (Fmake_symbol); + DEFSUBR (Fmake_marker); + DEFSUBR (Fpurecopy); + DEFSUBR (Fgarbage_collect); + DEFSUBR (Fmemory_limit); + DEFSUBR (Fconsing_since_gc); } void
--- a/src/buffer.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/buffer.c Mon Aug 13 08:50:05 2007 +0200 @@ -292,22 +292,20 @@ } -DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0 /* +DEFUN ("bufferp", Fbufferp, 1, 1, 0, /* T if OBJECT is an editor buffer. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (BUFFERP (object)) return Qt; return Qnil; } -DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0 /* +DEFUN ("buffer-live-p", Fbuffer_live_p, 1, 1, 0, /* T if OBJECT is an editor buffer that has not been deleted. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))) return Qt; @@ -322,15 +320,14 @@ signal_simple_error ("Invalid buffer argument", spec); } -DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0 /* +DEFUN ("buffer-list", Fbuffer_list, 0, 1, 0, /* Return a list of all existing live buffers. The order is specific to the selected frame; if the optional FRAME argument is provided, the ordering for that frame is returned instead. If the FRAME argument is t, then the global (non-frame) ordering is returned instead. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { Lisp_Object list; if (EQ (frame, Qt)) @@ -389,14 +386,13 @@ return XBUFFER (buffer); } -DEFUN ("decode-buffer", Fdecode_buffer, Sdecode_buffer, 1, 1, 0 /* +DEFUN ("decode-buffer", Fdecode_buffer, 1, 1, 0, /* Validate BUFFER or if BUFFER is nil, return the current buffer. If BUFFER is a valid buffer or a string representing a valid buffer, the corresponding buffer object will be returned. Otherwise an error will be signaled. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); XSETBUFFER (buffer, b); @@ -426,13 +422,12 @@ #endif -DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0 /* +DEFUN ("get-buffer", Fget_buffer, 1, 1, 0, /* Return the buffer named NAME (a string). If there is no live buffer named NAME, return nil. NAME may also be a buffer; if so, the value is that buffer. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { #ifdef I18N3 /* #### Doc string should indicate that the buffer name will get @@ -449,7 +444,7 @@ } -DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0 /* +DEFUN ("get-file-buffer", Fget_file_buffer, 1, 1, 0, /* Return the buffer visiting file FILENAME (a string). The buffer's `buffer-file-name' must match exactly the expansion of FILENAME. If there is no such live buffer, return nil. @@ -462,9 +457,8 @@ `buffer-file-name'. Otherwise, if `find-file-use-truenames' is non-nil, FILENAME will be converted to its truename and used for searching, but the search will still be done on `buffer-file-name'. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ REGISTER Lisp_Object tail, buf, tem; @@ -617,15 +611,14 @@ return buf; } -DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0 /* +DEFUN ("get-buffer-create", Fget_buffer_create, 1, 1, 0, /* Return the buffer named NAME, or create such a buffer and return it. A new buffer is created if there is no live buffer named NAME. If NAME starts with a space, the new buffer does not keep undo information. If NAME is a buffer instead of a string, then it is the value returned. The value is never nil. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { /* This function can GC */ Lisp_Object buf; @@ -654,18 +647,16 @@ return finish_init_buffer (b, name); } -DEFUN ("make-indirect-buffer", - Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2, - "bMake indirect buffer (to buffer): \nBName of indirect buffer: " /* +DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, 2, 2, + "bMake indirect buffer (to buffer): \nBName of indirect buffer: ", /* Create and return an indirect buffer for buffer BASE, named NAME. BASE should be an existing buffer (or buffer name). NAME should be a string which is not the name of an existing buffer. If BASE is an indirect buffer itself, the base buffer for that buffer is made the base buffer for the newly created buffer. (Thus, there will never be indirect buffers whose base buffers are themselves indirect.) -*/ ) - (base_buffer, name) - Lisp_Object base_buffer, name; +*/ + (base_buffer, name)) { error ("make-indirect-buffer not yet implemented, oops"); return Qnil; @@ -731,9 +722,7 @@ and set-visited-file-name ought to be able to use this to really rename the buffer properly. */ -DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, - Sgenerate_new_buffer_name, - 1, 2, 0 /* +DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, 1, 2, 0, /* Return a string that is the name of no existing buffer based on NAME. If there is no live buffer named NAME, then return NAME. Otherwise modify name by appending `<NUMBER>', incrementing NUMBER @@ -741,9 +730,8 @@ Optional second argument IGNORE specifies a name that is okay to use \(if it is in the sequence to be tried) even if a buffer with that name exists. -*/ ) - (name, ignore) - Lisp_Object name, ignore; +*/ + (name, ignore)) { REGISTER Lisp_Object gentemp, tem; int count; @@ -779,12 +767,11 @@ } -DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0 /* +DEFUN ("buffer-name", Fbuffer_name, 0, 1, 0, /* Return the name of BUFFER, as a string. With no argument or nil as argument, return the name of the current buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* For compatibility, we allow a dead buffer here. Earlier versions of Emacs didn't provide buffer-live-p. */ @@ -794,12 +781,11 @@ return XBUFFER (buffer)->name; } -DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0 /* +DEFUN ("buffer-file-name", Fbuffer_file_name, 0, 1, 0, /* Return name of file BUFFER is visiting, or nil if none. No argument or nil as argument means use the current buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* For compatibility, we allow a dead buffer here. Yuck! */ if (NILP (buffer)) @@ -808,13 +794,11 @@ return XBUFFER (buffer)->filename; } -DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, - 0, 1, 0 /* +DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, 0, 1, 0, /* Return the base buffer of indirect buffer BUFFER. If BUFFER is not indirect, return nil. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); struct buffer *base = buf->base_buffer; @@ -826,15 +810,12 @@ return base_buffer; } -DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, - Sbuffer_indirect_children, - 0, 1, 0 /* +DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, 0, 1, 0, /* Return a list of all indirect buffers whose base buffer is BUFFER. If BUFFER is indirect, the return value will always be nil; see `make-indirect-buffer'. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); @@ -876,16 +857,14 @@ return 0; } -DEFUN ("buffer-local-variables", Fbuffer_local_variables, - Sbuffer_local_variables, 0, 1, 0 /* +DEFUN ("buffer-local-variables", Fbuffer_local_variables, 0, 1, 0, /* Return an alist of variables that are buffer-local in BUFFER. Most elements look like (SYMBOL . VALUE), describing one variable. For a symbol that is locally unbound, just the symbol appears in the value. Note that storing new VALUEs in these elements doesn't change the variables. No argument or nil as argument means use current buffer as BUFFER. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); Lisp_Object result = Qnil; @@ -929,14 +908,11 @@ return (result); } -DEFUN ("buffer-dedicated-frame", Fbuffer_dedicated_frame, - Sbuffer_dedicated_frame, - 0, 1, 0 /* +DEFUN ("buffer-dedicated-frame", Fbuffer_dedicated_frame, 0, 1, 0, /* Return the frame dedicated to this BUFFER, or nil if there is none. No argument or nil as argument means use current buffer as BUFFER. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); @@ -948,14 +924,11 @@ return buf->dedicated_frame; } -DEFUN ("set-buffer-dedicated-frame", Fset_buffer_dedicated_frame, - Sset_buffer_dedicated_frame, - 2, 2, 0 /* +DEFUN ("set-buffer-dedicated-frame", Fset_buffer_dedicated_frame, 2, 2, 0, /* For this BUFFER, set the FRAME dedicated to it. FRAME must be a frame or nil. -*/ ) - (buffer, frame) - Lisp_Object buffer, frame; +*/ + (buffer, frame)) { struct buffer *buf = decode_buffer (buffer, 0); @@ -967,27 +940,23 @@ -DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p, - 0, 1, 0 /* +DEFUN ("buffer-modified-p", Fbuffer_modified_p, 0, 1, 0, /* Return t if BUFFER was modified since its file was last read or saved. No argument or nil as argument means use current buffer as BUFFER. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; } -DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p, - 1, 2, 0 /* +DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, 1, 2, 0, /* Mark BUFFER as modified or unmodified according to FLAG. A non-nil FLAG means mark the buffer modified. No argument or nil as BUFFER means use current buffer. -*/ ) - (flag, buffer) - Lisp_Object flag, buffer; +*/ + (flag, buffer)) { /* This function can GC */ Lisp_Object fn; @@ -1050,23 +1019,21 @@ return flag; } -DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick, - 0, 1, 0 /* +DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, 0, 1, 0, /* Return BUFFER's tick counter, incremented for each change in text. Each buffer has a tick counter which is incremented each time the text in that buffer is changed. It wraps around occasionally. No argument or nil as argument means use current buffer as BUFFER. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); return make_int (BUF_MODIFF (buf)); } -DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2, - "sRename buffer (to new name): \nP" /* +DEFUN ("rename-buffer", Frename_buffer, 1, 2, + "sRename buffer (to new name): \nP", /* Change current buffer's name to NEWNAME (a string). If second arg UNIQUE is nil or omitted, it is an error if a buffer named NEWNAME already exists. @@ -1075,9 +1042,8 @@ Interactively, one can set UNIQUE with a prefix argument. Returns the name we actually gave the buffer. This does not change the name of the visited file (if any). -*/ ) - (newname, unique) - Lisp_Object newname, unique; +*/ + (newname, unique)) { /* This function can GC */ Lisp_Object tem, buf; @@ -1128,7 +1094,7 @@ return current_buffer->name; } -DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0 /* +DEFUN ("other-buffer", Fother_buffer, 0, 3, 0, /* Return most recently selected buffer other than BUFFER. Buffers not visible in windows are preferred to visible buffers, unless optional third argument VISIBLE-OK is non-nil. @@ -1141,9 +1107,8 @@ Note: In FSF Emacs, this function takes two arguments: BUFFER and VISIBLE-OK. -*/ ) - (buffer, frame, visible_ok) - Lisp_Object buffer, frame, visible_ok; +*/ + (buffer, frame, visible_ok)) { /* This function can GC */ Lisp_Object tail, buf, notsogood, tem; @@ -1200,12 +1165,11 @@ /* XEmacs change: Make this argument required because this is a dangerous function. */ -DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1, 1, "" /* +DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, 1, 1, "", /* Make BUFFER stop keeping undo information. Any undo records it already has are discarded. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* Allowing nil is an RMSism */ struct buffer *real_buf = decode_buffer (buffer, 1); @@ -1213,13 +1177,11 @@ return Qnil; } -DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo, - 0, 1, "" /* +DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, 0, 1, "", /* Start keeping undo information for buffer BUFFER. No argument or nil as argument means do this for the current buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* Allowing nil is an RMSism */ struct buffer *real_buf = decode_buffer (buffer, 1); @@ -1229,7 +1191,7 @@ return Qnil; } -DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: " /* +DEFUN ("kill-buffer", Fkill_buffer, 1, 1, "bKill buffer: ", /* Kill the buffer BUFNAME. The argument may be a buffer or may be the name of a buffer. An argument of nil means kill the current buffer. @@ -1243,9 +1205,8 @@ Any processes that have this buffer as the `process-buffer' are killed with `delete-process'. -*/ ) - (bufname) - Lisp_Object bufname; +*/ + (bufname)) { /* This function can GC */ Lisp_Object buf; @@ -1429,8 +1390,7 @@ return Qt; } -DEFUN ("record-buffer", Frecord_buffer, - Srecord_buffer, 1, 1, 0 /* +DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /* Place buffer BUF first in the buffer order. Call this function when a buffer is selected \"visibly\". @@ -1438,9 +1398,8 @@ order for the selected frame. The buffer order keeps track of recency of selection so that `other-buffer' will return a recently selected buffer. See `other-buffer' for more information. -*/ ) - (buf) - Lisp_Object buf; +*/ + (buf)) { REGISTER Lisp_Object lynk, prev; struct frame *f = selected_frame (); @@ -1479,14 +1438,12 @@ return Qnil; } -DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, - Sset_buffer_major_mode, 1, 1, 0 /* +DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, 1, 1, 0, /* Set an appropriate major mode for BUFFER, according to `default-major-mode'. Use this function before selecting the buffer, since it may need to inspect the current buffer's major mode. -*/ ) - (buf) - Lisp_Object buf; +*/ + (buf)) { int speccount = specpdl_depth (); REGISTER Lisp_Object function, tem; @@ -1520,10 +1477,10 @@ } -DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0 /* +DEFUN ("current-buffer", Fcurrent_buffer, 0, 0, 0, /* Return the current buffer as a Lisp object. -*/ ) - () +*/ + ()) { Lisp_Object buf; XSETBUFFER (buf, current_buffer); @@ -1614,16 +1571,15 @@ } } -DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0 /* +DEFUN ("set-buffer", Fset_buffer, 1, 1, 0, /* Make the buffer BUFNAME current for editing operations. BUFNAME may be a buffer or the name of an existing buffer. See also `save-excursion' when you want to make a buffer current temporarily. This function does not display the buffer, so its effect ends when the current command terminates. Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently. -*/ ) - (bufname) - Lisp_Object bufname; +*/ + (bufname)) { Lisp_Object buffer; buffer = get_buffer (bufname, 0); @@ -1634,8 +1590,7 @@ } -DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, - Sbarf_if_buffer_read_only, 0, 3, 0 /* +DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, 0, 3, 0, /* Signal a `buffer-read-only' error if the buffer is read-only. Optional argument BUFFER defaults to the current buffer. @@ -1649,9 +1604,8 @@ (open on both ends), except that extents that lie completely within [START, END] are not checked. See `extent-in-region-p' for a fuller discussion. -*/ ) - (buffer, start, end) - Lisp_Object buffer, start, end; +*/ + (buffer, start, end)) { struct buffer *b = decode_buffer (buffer, 0); Bufpos s, e; @@ -1689,7 +1643,7 @@ *buffer_alist = lynk; } -DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 2, "" /* +DEFUN ("bury-buffer", Fbury_buffer, 0, 2, "", /* Put BUFFER 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. @@ -1698,9 +1652,8 @@ selected window if it is displayed there. If BEFORE is non-nil, it specifies a buffer before which BUFFER will be placed, instead of being placed at the end. -*/ ) - (buffer, before) - Lisp_Object buffer, before; +*/ + (buffer, before)) { /* This function can GC */ struct buffer *buf = decode_buffer (buffer, 1); @@ -1726,14 +1679,13 @@ } -DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 1, "*" /* +DEFUN ("erase-buffer", Ferase_buffer, 0, 1, "*", /* Delete the entire contents of the BUFFER. Any clipping restriction in effect (see `narrow-to-region') is removed, so the buffer is truly empty after this. BUFFER defaults to the current buffer if omitted. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* This function can GC */ struct buffer *b = decode_buffer (buffer, 1); @@ -1762,8 +1714,7 @@ -DEFUN ("kill-all-local-variables", Fkill_all_local_variables, - Skill_all_local_variables, 0, 0, 0 /* +DEFUN ("kill-all-local-variables", Fkill_all_local_variables, 0, 0, 0, /* Switch to Fundamental mode by killing current buffer's local variables. Most local variable bindings are eliminated so that the default values become effective once more. Also, the syntax table is set from @@ -1780,8 +1731,8 @@ The first thing this function does is run the normal hook `change-major-mode-hook'. -*/ ) - () +*/ + ()) { /* This function can GC */ run_hook (Qchange_major_mode_hook); @@ -1836,8 +1787,7 @@ stats->extents += compute_buffer_extent_usage (b, ovstats); } -DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, Sbuffer_memory_usage, - 1, 1, 0 /* +DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /* Return stats about the memory usage of buffer BUFFER. The values returned are in the form an alist of usage types and byte counts. The byte counts attempt to encompass all the memory used @@ -1855,9 +1805,8 @@ particular way of partitioning it into groups. Within a slice, there is no overlap between the groups of memory, and each slice collectively represents all the memory concerned. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer_stats stats; struct overhead_stats ovstats; @@ -1914,41 +1863,41 @@ defsymbol (&Qswitch_to_buffer, "switch-to-buffer"); - defsubr (&Sbufferp); - defsubr (&Sbuffer_live_p); - defsubr (&Sbuffer_list); - defsubr (&Sdecode_buffer); - defsubr (&Sget_buffer); - defsubr (&Sget_file_buffer); - defsubr (&Sget_buffer_create); - defsubr (&Smake_indirect_buffer); - - defsubr (&Sgenerate_new_buffer_name); - defsubr (&Sbuffer_name); - defsubr (&Sbuffer_file_name); - defsubr (&Sbuffer_base_buffer); - defsubr (&Sbuffer_indirect_children); - defsubr (&Sbuffer_local_variables); - defsubr (&Sbuffer_dedicated_frame); - defsubr (&Sset_buffer_dedicated_frame); - defsubr (&Sbuffer_modified_p); - defsubr (&Sset_buffer_modified_p); - defsubr (&Sbuffer_modified_tick); - defsubr (&Srename_buffer); - defsubr (&Sother_buffer); - defsubr (&Sbuffer_disable_undo); - defsubr (&Sbuffer_enable_undo); - defsubr (&Skill_buffer); - defsubr (&Serase_buffer); - defsubr (&Srecord_buffer); - defsubr (&Sset_buffer_major_mode); - defsubr (&Scurrent_buffer); - defsubr (&Sset_buffer); - defsubr (&Sbarf_if_buffer_read_only); - defsubr (&Sbury_buffer); - defsubr (&Skill_all_local_variables); + DEFSUBR (Fbufferp); + DEFSUBR (Fbuffer_live_p); + DEFSUBR (Fbuffer_list); + DEFSUBR (Fdecode_buffer); + DEFSUBR (Fget_buffer); + DEFSUBR (Fget_file_buffer); + DEFSUBR (Fget_buffer_create); + DEFSUBR (Fmake_indirect_buffer); + + DEFSUBR (Fgenerate_new_buffer_name); + DEFSUBR (Fbuffer_name); + DEFSUBR (Fbuffer_file_name); + DEFSUBR (Fbuffer_base_buffer); + DEFSUBR (Fbuffer_indirect_children); + DEFSUBR (Fbuffer_local_variables); + DEFSUBR (Fbuffer_dedicated_frame); + DEFSUBR (Fset_buffer_dedicated_frame); + DEFSUBR (Fbuffer_modified_p); + DEFSUBR (Fset_buffer_modified_p); + DEFSUBR (Fbuffer_modified_tick); + DEFSUBR (Frename_buffer); + DEFSUBR (Fother_buffer); + DEFSUBR (Fbuffer_disable_undo); + DEFSUBR (Fbuffer_enable_undo); + DEFSUBR (Fkill_buffer); + DEFSUBR (Ferase_buffer); + DEFSUBR (Frecord_buffer); + DEFSUBR (Fset_buffer_major_mode); + DEFSUBR (Fcurrent_buffer); + DEFSUBR (Fset_buffer); + DEFSUBR (Fbarf_if_buffer_read_only); + DEFSUBR (Fbury_buffer); + DEFSUBR (Fkill_all_local_variables); #ifdef MEMORY_USAGE_STATS - defsubr (&Sbuffer_memory_usage); + DEFSUBR (Fbuffer_memory_usage); #endif deferror (&Qprotected_field, "protected-field",
--- a/src/bytecode.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/bytecode.c Mon Aug 13 08:50:05 2007 +0200 @@ -258,14 +258,13 @@ #define TOP (*stackp) -DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0 /* +DEFUN ("byte-code", Fbyte_code, 3, 3, 0, /* Function used internally in byte-compiled code. The first argument is a string of byte code; the second, a vector of constants; the third, the maximum stack depth used in this function. If the third argument is incorrect, Emacs may crash. -*/ ) - (bytestr, vector, maxdepth) - Lisp_Object bytestr, vector, maxdepth; +*/ + (bytestr, vector, maxdepth)) { /* This function can GC */ struct gcpro gcpro1, gcpro2, gcpro3; @@ -1219,7 +1218,7 @@ syms_of_bytecode (void) { defsymbol (&Qbyte_code, "byte-code"); - defsubr (&Sbyte_code); + DEFSUBR (Fbyte_code); #ifdef BYTE_CODE_METER defsymbol (&Qbyte_code_meter, "byte-code-meter"); #endif
--- a/src/callint.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/callint.c Mon Aug 13 08:50:05 2007 +0200 @@ -75,7 +75,7 @@ Lisp_Object Qevents_to_keys; /* ARGSUSED */ -DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0 /* +DEFUN ("interactive", Finteractive, 0, UNEVALLED, 0, /* Specify a way of parsing arguments for interactive use of a function. For example, write (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...) @@ -132,9 +132,8 @@ set to t when the command exits successfully. You may use any of `@', `*' and `_' at the beginning of the string; they are processed in the order that they appear. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { return Qnil; } @@ -197,8 +196,7 @@ /* `lambda' for RECORD-FLAG is an XEmacs addition. */ -DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, - 1, 3, 0 /* +DEFUN ("call-interactively", Fcall_interactively, 1, 3, 0, /* Call FUNCTION, reading args according to its interactive calling specs. Return the value FUNCTION returns. The function contains a specification of how to do the argument reading. @@ -216,9 +214,8 @@ The argument KEYS specifies the value to use instead of (this-command-keys) when reading the arguments. -*/ ) - (function, record_flag, keys) - Lisp_Object function, record_flag, keys; +*/ + (function, record_flag, keys)) { /* This function can GC */ int speccount = specpdl_depth (); @@ -907,14 +904,12 @@ } } -DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, - 1, 1, 0 /* +DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /* Return numeric meaning of raw prefix argument ARG. A raw prefix argument is what you get from `(interactive \"P\")'. Its numeric meaning is what you would get from `(interactive \"p\")'. -*/ ) - (raw) - Lisp_Object raw; +*/ + (raw)) { int val; @@ -962,9 +957,9 @@ defsymbol (&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook"); #endif - defsubr (&Sinteractive); - defsubr (&Scall_interactively); - defsubr (&Sprefix_numeric_value); + DEFSUBR (Finteractive); + DEFSUBR (Fcall_interactively); + DEFSUBR (Fprefix_numeric_value); } void
--- a/src/callproc.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/callproc.c Mon Aug 13 08:50:05 2007 +0200 @@ -151,8 +151,7 @@ } #endif /* unused */ -DEFUN ("call-process-internal", Fcall_process_internal, - Scall_process_internal, 1, MANY, 0 /* +DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /* Call PROGRAM synchronously in separate process, with coding-system specified. Arguments are (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS). @@ -173,10 +172,8 @@ or a signal description string. If you quit, the process is killed with SIGINT, or SIGKILL if you quit again. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* This function can GC */ Lisp_Object infile, buffer, current_dir, display, path; @@ -294,26 +291,17 @@ CHECK_STRING (args[i]); new_argv[i - 3] = (char *) XSTRING_DATA (args[i]); } - /* Program name is first command arg */ - new_argv[0] = (char *) XSTRING_DATA (args[0]); - new_argv[i - 3] = 0; + new_argv[nargs - 3] = 0; } + if (NILP (path)) + report_file_error ("Searching for program", Fcons (args[0], Qnil)); + new_argv[0] = (char *) XSTRING_DATA (path); + filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY, 0); if (filefd < 0) - { - report_file_error ("Opening process input file", - Fcons (infile, Qnil)); - } + report_file_error ("Opening process input file", Fcons (infile, Qnil)); - if (NILP (path)) - { - close (filefd); - report_file_error ("Searching for program", - Fcons (args[0], Qnil)); - } - new_argv[0] = (char *) XSTRING_DATA (path); - #ifdef MSDOS /* These vars record information from process termination. Clear them now before process can possibly terminate, @@ -664,7 +652,7 @@ #if !defined (NO_SUBPROCESSES) /* Close Emacs's descriptors that this process should not have. */ close_process_descs (); -#endif +#endif /* not NO_SUBPROCESSES */ close_load_descs (); /* Note that use of alloca is always safe here. It's obvious for systems @@ -891,13 +879,12 @@ return 0; } -DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np" /* +DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /* Return the value of environment variable VAR, as a string. VAR is a string, the name of the variable. When invoked interactively, prints the value in the echo area. -*/ ) - (var, interactivep) - Lisp_Object var, interactivep; +*/ + (var, interactivep)) { Bufbyte *value; Bytecount valuelen; @@ -1092,8 +1079,8 @@ syms_of_callproc (void) { #ifndef VMS - defsubr (&Scall_process_internal); - defsubr (&Sgetenv); + DEFSUBR (Fcall_process_internal); + DEFSUBR (Fgetenv); #endif }
--- a/src/casefiddle.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/casefiddle.c Mon Aug 13 08:50:05 2007 +0200 @@ -75,34 +75,32 @@ } } -DEFUN ("upcase", Fupcase, Supcase, 1, 2, 0 /* +DEFUN ("upcase", Fupcase, 1, 2, 0, /* Convert argument to upper case and return that. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy. See also `capitalize', `downcase' and `upcase-initials'. Optional second arg BUFFER specifies which buffer's case tables to use, and defaults to the current buffer. -*/ ) - (obj, buffer) - Lisp_Object obj, buffer; +*/ + (obj, buffer)) { return casify_object (decode_buffer (buffer, 0), CASE_UP, obj); } -DEFUN ("downcase", Fdowncase, Sdowncase, 1, 2, 0 /* +DEFUN ("downcase", Fdowncase, 1, 2, 0, /* Convert argument to lower case and return that. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy. Optional second arg BUFFER specifies which buffer's case tables to use, and defaults to the current buffer. -*/ ) - (obj, buffer) - Lisp_Object obj, buffer; +*/ + (obj, buffer)) { return casify_object (decode_buffer (buffer, 0), CASE_DOWN, obj); } -DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 2, 0 /* +DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /* Convert argument to capitalized form and return that. This means that each word's first character is upper case and the rest is lower case. @@ -110,25 +108,23 @@ The argument object is not altered--the value is a copy. Optional second arg BUFFER specifies which buffer's case tables to use, and defaults to the current buffer. -*/ ) - (obj, buffer) - Lisp_Object obj, buffer; +*/ + (obj, buffer)) { return casify_object (decode_buffer (buffer, 0), CASE_CAPITALIZE, obj); } /* Like Fcapitalize but change only the initials. */ -DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 2, 0 /* +DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /* Convert the initial of each word in the argument to upper case. Do not change the other letters of each word. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy. Optional second arg BUFFER specifies which buffer's case tables to use, and defaults to the current buffer. -*/ ) - (obj, buffer) - Lisp_Object obj, buffer; +*/ + (obj, buffer)) { return casify_object (decode_buffer (buffer, 0), CASE_CAPITALIZE_UP, obj); } @@ -176,47 +172,44 @@ end_multiple_change (buf, mccount); } -DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3, "r" /* +DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /* Convert the region to upper case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on. See also `capitalize-region'. Optional third arg BUFFER defaults to the current buffer. -*/ ) - (b, e, buffer) - Lisp_Object b, e, buffer; +*/ + (b, e, buffer)) { /* This function can GC */ casify_region (decode_buffer (buffer, 1), CASE_UP, b, e); return Qnil; } -DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3, "r" /* +DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /* Convert the region to lower case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on. Optional third arg BUFFER defaults to the current buffer. -*/ ) - (b, e, buffer) - Lisp_Object b, e, buffer; +*/ + (b, e, buffer)) { /* This function can GC */ casify_region (decode_buffer (buffer, 1), CASE_DOWN, b, e); return Qnil; } -DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 3, "r" /* +DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /* Convert the region to capitalized form. Capitalized form means each word's first character is upper case and the rest of it is lower case. In programs, give two arguments, the starting and ending character positions to operate on. Optional third arg BUFFER defaults to the current buffer. -*/ ) - (b, e, buffer) - Lisp_Object b, e, buffer; +*/ + (b, e, buffer)) { /* This function can GC */ casify_region (decode_buffer (buffer, 1), CASE_CAPITALIZE, b, e); @@ -225,16 +218,14 @@ /* Like Fcapitalize_region but change only the initials. */ -DEFUN ("upcase-initials-region", Fupcase_initials_region, - Supcase_initials_region, 2, 3, "r" /* +DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /* Upcase the initial of each word in the region. Subsequent letters of each word are not changed. In programs, give two arguments, the starting and ending character positions to operate on. Optional third arg BUFFER defaults to the current buffer. -*/ ) - (b, e, buffer) - Lisp_Object b, e, buffer; +*/ + (b, e, buffer)) { casify_region (decode_buffer (buffer, 1), CASE_CAPITALIZE_UP, b, e); return Qnil; @@ -255,14 +246,13 @@ return (make_int (farend)); } -DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 2, "p" /* +DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /* Convert following word (or ARG words) to upper case, moving over. With negative argument, convert previous words but do not move. See also `capitalize-word'. Optional second arg BUFFER defaults to the current buffer. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { /* This function can GC */ Lisp_Object beg, end; @@ -276,13 +266,12 @@ return Qnil; } -DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 2, "p" /* +DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /* Convert following word (or ARG words) to lower case, moving over. With negative argument, convert previous words but do not move. Optional second arg BUFFER defaults to the current buffer. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { /* This function can GC */ Lisp_Object beg, end; @@ -296,15 +285,14 @@ return Qnil; } -DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 2, "p" /* +DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /* Capitalize the following word (or ARG words), moving over. This gives the word(s) a first character in upper case and the rest lower case. With negative argument, capitalize previous words but do not move. Optional second arg BUFFER defaults to the current buffer. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { /* This function can GC */ Lisp_Object beg, end; @@ -322,15 +310,15 @@ void syms_of_casefiddle (void) { - defsubr (&Supcase); - defsubr (&Sdowncase); - defsubr (&Scapitalize); - defsubr (&Supcase_initials); - defsubr (&Supcase_region); - defsubr (&Sdowncase_region); - defsubr (&Scapitalize_region); - defsubr (&Supcase_initials_region); - defsubr (&Supcase_word); - defsubr (&Sdowncase_word); - defsubr (&Scapitalize_word); + DEFSUBR (Fupcase); + DEFSUBR (Fdowncase); + DEFSUBR (Fcapitalize); + DEFSUBR (Fupcase_initials); + DEFSUBR (Fupcase_region); + DEFSUBR (Fdowncase_region); + DEFSUBR (Fcapitalize_region); + DEFSUBR (Fupcase_initials_region); + DEFSUBR (Fupcase_word); + DEFSUBR (Fdowncase_word); + DEFSUBR (Fcapitalize_word); }
--- a/src/casetab.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/casetab.c Mon Aug 13 08:50:05 2007 +0200 @@ -52,12 +52,11 @@ #define STRING256_P(obj) \ (STRINGP (obj) && string_char_length (XSTRING (obj)) == 256) -DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0 /* +DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /* Return t iff ARG is a case table. See `set-case-table' for more information on these data structures. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { Lisp_Object down, up, canon, eqv; down = Fcar_safe (table); @@ -83,12 +82,10 @@ return (obj); } -DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, - 0, 1, 0 /* +DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* Return the case table of BUFFER, which defaults to the current buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { Lisp_Object down, up, canon, eqv; struct buffer *buf = decode_buffer (buffer, 0); @@ -101,12 +98,11 @@ return Fcons (down, Fcons (up, Fcons (canon, Fcons (eqv, Qnil)))); } -DEFUN ("standard-case-table", Fstandard_case_table, - Sstandard_case_table, 0, 0, 0 /* +DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /* Return the standard case table. This is the one used for new buffers. -*/ ) - () +*/ + ()) { return Fcons (Vascii_downcase_table, Fcons (Vascii_upcase_table, @@ -118,7 +114,7 @@ static Lisp_Object set_case_table (Lisp_Object table, int standard); -DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0 /* +DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /* Select a new case table for the current buffer. A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES) where each element is either nil or a string of length 256. @@ -133,20 +129,17 @@ EQUIVALENCES is a map that cyclicly permutes each equivalence class (of characters with the same canonical equivalent); it may be nil, in which case it is deduced from CANONICALIZE. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { return set_case_table (table, 0); } -DEFUN ("set-standard-case-table", - Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0 /* +DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /* Select a new standard case table for new buffers. See `set-case-table' for more info on case tables. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { return set_case_table (table, 1); } @@ -245,11 +238,11 @@ defsymbol (&Qcase_table_p, "case-table-p"); defsymbol (&Qtranslate_table, "translate-table"); - defsubr (&Scase_table_p); - defsubr (&Scurrent_case_table); - defsubr (&Sstandard_case_table); - defsubr (&Sset_case_table); - defsubr (&Sset_standard_case_table); + DEFSUBR (Fcase_table_p); + DEFSUBR (Fcurrent_case_table); + DEFSUBR (Fstandard_case_table); + DEFSUBR (Fset_case_table); + DEFSUBR (Fset_standard_case_table); } void
--- a/src/cmdloop.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/cmdloop.c Mon Aug 13 08:50:05 2007 +0200 @@ -88,12 +88,10 @@ return (unbind_to (speccount, Qt)); } -DEFUN ("really-early-error-handler", Freally_early_error_handler, - Sreally_early_error_handler, 1, 1, 0 /* +DEFUN ("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /* You should almost certainly not be using this. -*/ ) - (x) - Lisp_Object x; +*/ + (x)) { /* This is an error handler used when we're running temacs and when we're in the early stages of XEmacs. No errors ought to be @@ -308,13 +306,13 @@ return Qnil; } -DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "" /* +DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /* Invoke the editor command loop recursively. To get out of the recursive edit, a command can do `(throw 'exit nil)'; that tells this function to return. Alternately, `(throw 'exit t)' makes this function signal an error. -*/ ) - () +*/ + ()) { /* This function can GC */ Lisp_Object val; @@ -472,11 +470,11 @@ command loop, this will return only when the user specifies a new command loop by changing the command-loop variable. */ -DEFUN ("command-loop-1", Fcommand_loop_1, Scommand_loop_1, 0, 0, 0 /* +DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /* Invoke the internals of the canonical editor command loop. Don't call this unless you know what you're doing. -*/ ) - () +*/ + ()) { /* This function can GC */ Lisp_Object event = Fmake_event (); @@ -566,10 +564,10 @@ defsymbol (&Qtop_level, "top-level"); #ifndef LISP_COMMAND_LOOP - defsubr (&Srecursive_edit); + DEFSUBR (Frecursive_edit); #endif - defsubr (&Sreally_early_error_handler); - defsubr (&Scommand_loop_1); + DEFSUBR (Freally_early_error_handler); + DEFSUBR (Fcommand_loop_1); } void
--- a/src/cmds.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/cmds.c Mon Aug 13 08:50:05 2007 +0200 @@ -42,13 +42,12 @@ Lisp_Object Vself_insert_face_command; -DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 2, "_p" /* +DEFUN ("forward-char", Fforward_char, 0, 2, "_p", /* Move point right ARG characters (left if ARG negative). On reaching end of buffer, stop and signal error. If BUFFER is nil, the current buffer is assumed. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { struct buffer *buf = decode_buffer (buffer, 1); @@ -82,13 +81,12 @@ return Qnil; } -DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 2, "_p" /* +DEFUN ("backward-char", Fbackward_char, 0, 2, "_p", /* Move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error. If BUFFER is nil, the current buffer is assumed. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { if (NILP (arg)) arg = make_int (1); @@ -99,7 +97,7 @@ return Fforward_char (arg, buffer); } -DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 2, "_p" /* +DEFUN ("forward-line", Fforward_line, 0, 2, "_p", /* Move ARG lines forward (backward if ARG is negative). Precisely, if point is on line I, move to the start of line I + ARG. If there isn't room, go as far as possible (no error). @@ -108,9 +106,8 @@ With positive ARG, a non-empty line at the end counts as one line successfully moved (for the return value). If BUFFER is nil, the current buffer is assumed. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { struct buffer *buf = decode_buffer (buffer, 1); Bufpos pos2 = BUF_PT (buf); @@ -137,14 +134,13 @@ return make_int (negp ? - shortage : shortage); } -DEFUN ("point-at-bol", Fpoint_at_bol, Spoint_at_bol, 0, 2, 0 /* +DEFUN ("point-at-bol", Fpoint_at_bol, 0, 2, 0, /* Return the character position of the first character on the current line. With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position. This function does not move point. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { struct buffer *b = decode_buffer (buffer, 1); register int orig, end; @@ -163,15 +159,13 @@ return make_int (end); } -DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, - 0, 2, "_p" /* +DEFUN ("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /* Move point to beginning of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. If BUFFER is nil, the current buffer is assumed. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { struct buffer *b = decode_buffer (buffer, 1); @@ -179,14 +173,13 @@ return Qnil; } -DEFUN ("point-at-eol", Fpoint_at_eol, Spoint_at_eol, 0, 2, 0 /* +DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /* Return the character position of the last character on the current line. With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position. This function does not move point. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { struct buffer *buf = decode_buffer (buffer, 1); @@ -201,15 +194,13 @@ XINT (arg) - (XINT (arg) <= 0))); } -DEFUN ("end-of-line", Fend_of_line, Send_of_line, - 0, 2, "_p" /* +DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /* Move point to end of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. If BUFFER is nil, the current buffer is assumed. -*/ ) - (arg, buffer) - Lisp_Object arg, buffer; +*/ + (arg, buffer)) { struct buffer *b = decode_buffer (buffer, 1); @@ -217,14 +208,13 @@ return Qnil; } -DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "*p\nP" /* +DEFUN ("delete-char", Fdelete_char, 1, 2, "*p\nP", /* Delete the following ARG characters (previous, with negative arg). Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). Interactively, ARG is the prefix arg, and KILLFLAG is set if ARG was explicitly specified. -*/ ) - (arg, killflag) - Lisp_Object arg, killflag; +*/ + (arg, killflag)) { /* This function can GC */ Bufpos pos; @@ -257,15 +247,13 @@ return Qnil; } -DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char, - 1, 2, "*p\nP" /* +DEFUN ("delete-backward-char", Fdelete_backward_char, 1, 2, "*p\nP", /* Delete the previous ARG characters (following, with negative ARG). Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). Interactively, ARG is the prefix arg, and KILLFLAG is set if ARG was explicitly specified. -*/ ) - (arg, killflag) - Lisp_Object arg, killflag; +*/ + (arg, killflag)) { /* This function can GC */ CHECK_INT (arg); @@ -274,12 +262,11 @@ static void internal_self_insert (Emchar ch, int noautofill); -DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "*p" /* +DEFUN ("self-insert-command", Fself_insert_command, 1, 1, "*p", /* Insert the character you type. Whichever character you type to run this command is inserted. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { /* This function can GC */ int n; @@ -436,12 +423,10 @@ /* (this comes from Mule but is a generally good idea) */ -DEFUN ("self-insert-internal", Fself_insert_internal, Sself_insert_internal, - 1, 1, 0 /* +DEFUN ("self-insert-internal", Fself_insert_internal, 1, 1, 0, /* Invoke `self-insert-command' as if CH is entered from keyboard. -*/ ) - (ch) - Lisp_Object ch; +*/ + (ch)) { /* This function can GC */ CHECK_CHAR_COERCE_INT (ch); @@ -458,20 +443,20 @@ defsymbol (&Qself_insert_command, "self-insert-command"); defsymbol (&Qoverwrite_mode_binary, "overwrite-mode-binary"); - defsubr (&Sforward_char); - defsubr (&Sbackward_char); - defsubr (&Sforward_line); - defsubr (&Sbeginning_of_line); - defsubr (&Send_of_line); + DEFSUBR (Fforward_char); + DEFSUBR (Fbackward_char); + DEFSUBR (Fforward_line); + DEFSUBR (Fbeginning_of_line); + DEFSUBR (Fend_of_line); - defsubr (&Spoint_at_bol); - defsubr (&Spoint_at_eol); + DEFSUBR (Fpoint_at_bol); + DEFSUBR (Fpoint_at_eol); - defsubr (&Sdelete_char); - defsubr (&Sdelete_backward_char); + DEFSUBR (Fdelete_char); + DEFSUBR (Fdelete_backward_char); - defsubr (&Sself_insert_command); - defsubr (&Sself_insert_internal); + DEFSUBR (Fself_insert_command); + DEFSUBR (Fself_insert_internal); } void
--- a/src/console-tty.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/console-tty.c Mon Aug 13 08:50:05 2007 +0200 @@ -189,12 +189,10 @@ return XCONSOLE (console); } -DEFUN ("console-tty-terminal-type", Fconsole_tty_terminal_type, - Sconsole_tty_terminal_type, 0, 1, 0 /* +DEFUN ("console-tty-terminal-type", Fconsole_tty_terminal_type, 0, 1, 0, /* Return the terminal type of TTY console CONSOLE. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { return CONSOLE_TTY_DATA (decode_tty_console (console))->terminal_type; } @@ -239,7 +237,7 @@ void syms_of_console_tty (void) { - defsubr (&Sconsole_tty_terminal_type); + DEFSUBR (Fconsole_tty_terminal_type); defsymbol (&Qterminal_type, "terminal-type"); }
--- a/src/console.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/console.c Mon Aug 13 08:50:05 2007 +0200 @@ -204,13 +204,11 @@ return 0; } -DEFUN ("valid-console-type-p", Fvalid_console_type_p, Svalid_console_type_p, - 1, 1, 0 /* +DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /* Given a CONSOLE-TYPE, return t if it is valid. Valid types are 'x, 'tty, and 'stream. -*/ ) - (console_type) - Lisp_Object console_type; +*/ + (console_type)) { if (valid_console_type_p (console_type)) return Qt; @@ -218,30 +216,28 @@ return Qnil; } -DEFUN ("console-type-list", Fconsole_type_list, Sconsole_type_list, - 0, 0, 0 /* +DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /* Return a list of valid console types. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vconsole_type_list); } -DEFUN ("cdfw-console", Fcdfw_console, Scdfw_console, 1, 1, 0 /* +DEFUN ("cdfw-console", Fcdfw_console, 1, 1, 0, /* Given a console, device, frame, or window, return the associated console. Return nil otherwise. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return CDFW_CONSOLE (obj); } -DEFUN ("selected-console", Fselected_console, Sselected_console, 0, 0, 0 /* +DEFUN ("selected-console", Fselected_console, 0, 0, 0, /* Return the console which is currently active. -*/ ) - () +*/ + ()) { return Vselected_console; } @@ -268,15 +264,14 @@ Vwindow_system = Qnil; } -DEFUN ("select-console", Fselect_console, Sselect_console, 1, 1, 0 /* +DEFUN ("select-console", Fselect_console, 1, 1, 0, /* Select the console CONSOLE. Subsequent editing commands apply to its selected device, selected frame, and selected window. The selection of CONSOLE lasts until the next time the user does something to select a different console, or until the next time this function is called. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { CHECK_LIVE_CONSOLE (console); @@ -296,29 +291,27 @@ con->_last_nonminibuf_frame = frame; } -DEFUN ("consolep", Fconsolep, Sconsolep, 1, 1, 0 /* +DEFUN ("consolep", Fconsolep, 1, 1, 0, /* Return non-nil if OBJECT is a console. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (!CONSOLEP (object)) return Qnil; return Qt; } -DEFUN ("console-live-p", Fconsole_live_p, Sconsole_live_p, 1, 1, 0 /* +DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /* Return non-nil if OBJECT is a console that has not been deleted. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (!CONSOLEP (object) || !CONSOLE_LIVE_P (XCONSOLE (object))) return Qnil; return Qt; } -DEFUN ("console-type", Fconsole_type, Sconsole_type, 0, 1, 0 /* +DEFUN ("console-type", Fconsole_type, 0, 1, 0, /* Return the type of the specified console (e.g. `x' or `tty'). Value is `tty' for a tty console (a character-only terminal), `x' for a console that is an X display, @@ -329,9 +322,8 @@ implemented), `stream' for a stream console (which acts like a stdio stream), and `dead' for a deleted console. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { /* don't call decode_console() because we want to allow for dead consoles. */ @@ -341,22 +333,19 @@ return CONSOLE_TYPE (XCONSOLE (console)); } -DEFUN ("console-name", Fconsole_name, Sconsole_name, 0, 1, 0 /* +DEFUN ("console-name", Fconsole_name, 0, 1, 0, /* Return the name of the specified console. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { return CONSOLE_NAME (decode_console (console)); } -DEFUN ("console-connection", Fconsole_connection, Sconsole_connection, - 0, 1, 0 /* +DEFUN ("console-connection", Fconsole_connection, 0, 1, 0, /* Return the connection of the specified console. CONSOLE defaults to the selected console if omitted. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { return CONSOLE_CONNECTION (decode_console (console)); } @@ -403,7 +392,7 @@ return Qnil; } -DEFUN ("find-console", Ffind_console, Sfind_console, 1, 2, 0 /* +DEFUN ("find-console", Ffind_console, 1, 2, 0, /* Look for an existing console attached to connection CONNECTION. Return the console if found; otherwise, return nil. @@ -411,9 +400,8 @@ return consoles of any type. (It is possible, although unlikely, that two consoles of different types could have the same connection name; in such a case, the first console found is returned.) -*/ ) - (connection, type) - Lisp_Object connection, type; +*/ + (connection, type)) { Lisp_Object canon = Qnil; struct gcpro gcpro1; @@ -453,7 +441,7 @@ } } -DEFUN ("get-console", Fget_console, Sget_console, 1, 2, 0 /* +DEFUN ("get-console", Fget_console, 1, 2, 0, /* Look for an existing console attached to connection CONNECTION. Return the console if found; otherwise, signal an error. @@ -461,9 +449,8 @@ return consoles of any type. (It is possible, although unlikely, that two consoles of different types could have the same connection name; in such a case, the first console found is returned.) -*/ ) - (connection, type) - Lisp_Object connection, type; +*/ + (connection, type)) { Lisp_Object console = Ffind_console (connection, type); if (NILP (console)) @@ -739,46 +726,41 @@ delete_console_internal (XCONSOLE (console), 1, 0, 1); } -DEFUN ("delete-console", Fdelete_console, Sdelete_console, 1, 2, 0 /* +DEFUN ("delete-console", Fdelete_console, 1, 2, 0, /* Delete CONSOLE, permanently eliminating it from use. Normally, you cannot delete the last non-minibuffer-only frame (you must use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional second argument FORCE is non-nil, you can delete the last frame. (This will automatically call `save-buffers-kill-emacs'.) -*/ ) - (console, force) - Lisp_Object console, force; +*/ + (console, force)) { CHECK_CONSOLE (console); delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0); return Qnil; } -DEFUN ("console-list", Fconsole_list, Sconsole_list, 0, 0, 0 /* +DEFUN ("console-list", Fconsole_list, 0, 0, 0, /* Return a list of all consoles. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vconsole_list); } -DEFUN ("console-device-list", Fconsole_device_list, Sconsole_device_list, - 0, 1, 0 /* +DEFUN ("console-device-list", Fconsole_device_list, 0, 1, 0, /* Return a list of all devices on CONSOLE. If CONSOLE is nil, the selected console will be used. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console))); } -DEFUN ("console-enable-input", Fconsole_enable_input, Sconsole_enable_input, - 1, 1, 0 /* +DEFUN ("console-enable-input", Fconsole_enable_input, 1, 1, 0, /* Enable input on console CONSOLE. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { struct console *con = decode_console (console); if (!con->input_enabled) @@ -786,13 +768,10 @@ return Qnil; } -DEFUN ("console-disable-input", Fconsole_disable_input, - Sconsole_disable_input, - 1, 1, 0 /* +DEFUN ("console-disable-input", Fconsole_disable_input, 1, 1, 0, /* Disable input on console CONSOLE. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { struct console *con = decode_console (console); if (con->input_enabled) @@ -800,14 +779,12 @@ return Qnil; } -DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, - Sconsole_on_window_system_p, 0, 1, 0 /* +DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0, /* Return non-nil if this console is on a window system. This generally means that there is support for the mouse, the menubar, the toolbar, glyphs, etc. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { struct console *con = decode_console (console); @@ -837,7 +814,7 @@ return Qnil; } -DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "" /* +DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /* Stop Emacs and return to superior process. You can resume later. On systems that don't have job control, run a subshell instead. @@ -850,9 +827,8 @@ Some operating systems cannot stop the Emacs process and resume it later. On such systems, Emacs will start a subshell and wait for it to exit. -*/ ) - (stuffstring) - Lisp_Object stuffstring; +*/ + (stuffstring)) { int speccount = specpdl_depth (); struct gcpro gcpro1; @@ -928,7 +904,7 @@ #endif /* BSD */ } -DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 5, 0 /* +DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /* Set mode of reading keyboard input. First arg is ignored, for backward compatibility. Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal @@ -941,9 +917,8 @@ Optional fifth arg CONSOLE specifies console to make changes to; nil means the selected console. See also `current-input-mode'. -*/ ) - (ignored, flow, meta, quit, console) - Lisp_Object ignored, flow, meta, quit, console; +*/ + (ignored, flow, meta, quit, console)) { struct console *con = decode_console (console); int meta_key = 1; @@ -976,8 +951,7 @@ return Qnil; } -DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, - 0, 1, 0 /* +DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /* Return information about the way Emacs currently reads keyboard input. Optional arg CONSOLE specifies console to return information about; nil means the selected console. @@ -992,9 +966,8 @@ FLOW, and META are only meaningful for TTY consoles. The elements of this list correspond to the arguments of `set-input-mode'. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { Lisp_Object val[4]; struct console *con = decode_console (console); @@ -1016,28 +989,28 @@ void syms_of_console (void) { - defsubr (&Svalid_console_type_p); - defsubr (&Sconsole_type_list); - defsubr (&Scdfw_console); - defsubr (&Sselected_console); - defsubr (&Sselect_console); - defsubr (&Sconsolep); - defsubr (&Sconsole_live_p); - defsubr (&Sconsole_type); - defsubr (&Sconsole_name); - defsubr (&Sconsole_connection); - defsubr (&Sfind_console); - defsubr (&Sget_console); - defsubr (&Sdelete_console); - defsubr (&Sconsole_list); - defsubr (&Sconsole_device_list); - defsubr (&Sconsole_enable_input); - defsubr (&Sconsole_disable_input); - defsubr (&Sconsole_on_window_system_p); + DEFSUBR (Fvalid_console_type_p); + DEFSUBR (Fconsole_type_list); + DEFSUBR (Fcdfw_console); + DEFSUBR (Fselected_console); + DEFSUBR (Fselect_console); + DEFSUBR (Fconsolep); + DEFSUBR (Fconsole_live_p); + DEFSUBR (Fconsole_type); + DEFSUBR (Fconsole_name); + DEFSUBR (Fconsole_connection); + DEFSUBR (Ffind_console); + DEFSUBR (Fget_console); + DEFSUBR (Fdelete_console); + DEFSUBR (Fconsole_list); + DEFSUBR (Fconsole_device_list); + DEFSUBR (Fconsole_enable_input); + DEFSUBR (Fconsole_disable_input); + DEFSUBR (Fconsole_on_window_system_p); - defsubr (&Ssuspend_emacs); - defsubr (&Sset_input_mode); - defsubr (&Scurrent_input_mode); + DEFSUBR (Fsuspend_emacs); + DEFSUBR (Fset_input_mode); + DEFSUBR (Fcurrent_input_mode); defsymbol (&Qconsolep, "consolep"); defsymbol (&Qconsole_live_p, "console-live-p");
--- a/src/data.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/data.c Mon Aug 13 08:50:05 2007 +0200 @@ -105,16 +105,14 @@ signal_error (Qwrong_type_argument, list2 (predicate, value)); } -DEFUN ("wrong-type-argument", Fwrong_type_argument, Swrong_type_argument, - 2, 2, 0 /* +DEFUN ("wrong-type-argument", Fwrong_type_argument, 2, 2, 0, /* Signal an error until the correct type value is given by the user. This function loops, signalling a continuable `wrong-type-argument' error with PREDICATE and VALUE as the data associated with the error and then calling PREDICATE on the returned value, until the value gotten satisfies PREDICATE. At that point, the gotten value is returned. -*/ ) - (predicate, value) - Lisp_Object predicate, value; +*/ + (predicate, value)) { return wrong_type_argument (predicate, value); } @@ -185,110 +183,98 @@ /* Data type predicates */ -DEFUN ("eq", Feq, Seq, 2, 2, 0 /* +DEFUN ("eq", Feq, 2, 2, 0, /* T if the two args are the same Lisp object. -*/ ) - (obj1, obj2) - Lisp_Object obj1, obj2; +*/ + (obj1, obj2)) { return EQ (obj1, obj2) ? Qt : Qnil; } -DEFUN ("null", Fnull, Snull, 1, 1, 0 /* +DEFUN ("null", Fnull, 1, 1, 0, /* T if OBJECT is nil. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return NILP (object) ? Qt : Qnil; } -DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0 /* +DEFUN ("consp", Fconsp, 1, 1, 0, /* T if OBJECT is a cons cell. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return CONSP (object) ? Qt : Qnil; } -DEFUN ("atom", Fatom, Satom, 1, 1, 0 /* +DEFUN ("atom", Fatom, 1, 1, 0, /* T if OBJECT is not a cons cell. This includes nil. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return CONSP (object) ? Qnil : Qt; } -DEFUN ("listp", Flistp, Slistp, 1, 1, 0 /* +DEFUN ("listp", Flistp, 1, 1, 0, /* T if OBJECT is a list. This includes nil. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (CONSP (object) || NILP (object)) ? Qt : Qnil; } -DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0 /* +DEFUN ("nlistp", Fnlistp, 1, 1, 0, /* T if OBJECT is not a list. Lists include nil. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (CONSP (object) || NILP (object)) ? Qnil : Qt; } -DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0 /* +DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /* T if OBJECT is a symbol. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return SYMBOLP (object) ? Qt : Qnil; } -DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0 /* +DEFUN ("keywordp", Fkeywordp, 1, 1, 0, /* T if OBJECT is a keyword. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return KEYWORDP (object) ? Qt : Qnil; } -DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0 /* +DEFUN ("vectorp", Fvectorp, 1, 1, 0, /* T if OBJECT is a vector. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return VECTORP (object) ? Qt : Qnil; } -DEFUN ("bit-vector-p", Fbit_vector_p, Sbit_vector_p, 1, 1, 0 /* +DEFUN ("bit-vector-p", Fbit_vector_p, 1, 1, 0, /* T if OBJECT is a bit vector. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return BIT_VECTORP (object) ? Qt : Qnil; } -DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0 /* +DEFUN ("stringp", Fstringp, 1, 1, 0, /* T if OBJECT is a string. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return STRINGP (object) ? Qt : Qnil; } -DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0 /* +DEFUN ("arrayp", Farrayp, 1, 1, 0, /* T if OBJECT is an array (string, vector, or bit vector). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (VECTORP (object) || STRINGP (object) || @@ -296,11 +282,10 @@ ? Qt : Qnil; } -DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0 /* +DEFUN ("sequencep", Fsequencep, 1, 1, 0, /* T if OBJECT is a sequence (list or array). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (CONSP (object) || NILP (object) || @@ -310,40 +295,36 @@ ? Qt : Qnil; } -DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0 /* +DEFUN ("markerp", Fmarkerp, 1, 1, 0, /* T if OBJECT is a marker (editor pointer). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return MARKERP (object) ? Qt : Qnil; } -DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0 /* +DEFUN ("subrp", Fsubrp, 1, 1, 0, /* T if OBJECT is a built-in function. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return SUBRP (object) ? Qt : Qnil; } -DEFUN ("subr-min-args", Fsubr_min_args, Ssubr_min_args, 1, 1, 0 /* +DEFUN ("subr-min-args", Fsubr_min_args, 1, 1, 0, /* Return minimum number of args built-in function SUBR may be called with. -*/ ) - (subr) - Lisp_Object subr; +*/ + (subr)) { CHECK_SUBR (subr); return make_int (XSUBR (subr)->min_args); } -DEFUN ("subr-max-args", Fsubr_max_args, Ssubr_max_args, 1, 1, 0 /* +DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /* Return maximum number of args built-in function SUBR may be called with, or nil if it takes an arbitrary number of arguments or is a special form. -*/ ) - (subr) - Lisp_Object subr; +*/ + (subr)) { int nargs; CHECK_SUBR (subr); @@ -354,108 +335,96 @@ return make_int (nargs); } -DEFUN ("compiled-function-p", Fcompiled_function_p, Scompiled_function_p, 1, 1, 0 /* +DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* t if OBJECT is a byte-compiled function object. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return COMPILED_FUNCTIONP (object) ? Qt : Qnil; } -DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 1, 0 /* +DEFUN ("characterp", Fcharacterp, 1, 1, 0, /* t if OBJECT is a character. A character is an integer that can be inserted into a buffer with `insert-char'. All integers are considered valid characters and are modded with 256 to get the actual character to use. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return CHARP (object) ? Qt : Qnil; } -DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0 /* +DEFUN ("char-or-string-p", Fchar_or_string_p, 1, 1, 0, /* t if OBJECT is a character or a string. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil; } -DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0 /* +DEFUN ("integerp", Fintegerp, 1, 1, 0, /* t if OBJECT is an integer. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return INTP (object) ? Qt : Qnil; } -DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, - 1, 1, 0 /* +DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /* t if OBJECT is an integer or a marker (editor pointer). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return INTP (object) || MARKERP (object) ? Qt : Qnil; } -DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0 /* +DEFUN ("natnump", Fnatnump, 1, 1, 0, /* t if OBJECT is a nonnegative integer. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return NATNUMP (object) ? Qt : Qnil; } -DEFUN ("bitp", Fbitp, Sbitp, 1, 1, 0 /* +DEFUN ("bitp", Fbitp, 1, 1, 0, /* t if OBJECT is a bit (0 or 1). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return BITP (object) ? Qt : Qnil; } -DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0 /* +DEFUN ("numberp", Fnumberp, 1, 1, 0, /* t if OBJECT is a number (floating point or integer). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return INT_OR_FLOATP (object) ? Qt : Qnil; } -DEFUN ("number-or-marker-p", Fnumber_or_marker_p, Snumber_or_marker_p, 1, 1, 0 /* +DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /* t if OBJECT is a number or a marker. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil; } #ifdef LISP_FLOAT_TYPE -DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0 /* +DEFUN ("floatp", Ffloatp, 1, 1, 0, /* t if OBJECT is a floating point number. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return FLOATP (object) ? Qt : Qnil; } #endif /* LISP_FLOAT_TYPE */ -DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0 /* +DEFUN ("type-of", Ftype_of, 1, 1, 0, /* Return a symbol representing the type of OBJECT. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (CONSP (object)) return Qcons; if (SYMBOLP (object)) return Qsymbol; @@ -471,12 +440,11 @@ /* Extract and set components of lists */ -DEFUN ("car", Fcar, Scar, 1, 1, 0 /* +DEFUN ("car", Fcar, 1, 1, 0, /* Return the car of LIST. If arg is nil, return nil. Error if arg is not nil and not a cons cell. See also `car-safe'. -*/ ) - (list) - Lisp_Object list; +*/ + (list)) { while (1) { @@ -489,21 +457,19 @@ } } -DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0 /* +DEFUN ("car-safe", Fcar_safe, 1, 1, 0, /* Return the car of OBJECT if it is a cons cell, or else nil. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return CONSP (object) ? XCAR (object) : Qnil; } -DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0 /* +DEFUN ("cdr", Fcdr, 1, 1, 0, /* Return the cdr of LIST. If arg is nil, return nil. Error if arg is not nil and not a cons cell. See also `cdr-safe'. -*/ ) - (list) - Lisp_Object list; +*/ + (list)) { while (1) { @@ -516,20 +482,18 @@ } } -DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0 /* +DEFUN ("cdr-safe", Fcdr_safe, 1, 1, 0, /* Return the cdr of OBJECT if it is a cons cell, or else nil. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return CONSP (object) ? XCDR (object) : Qnil; } -DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0 /* +DEFUN ("setcar", Fsetcar, 2, 2, 0, /* Set the car of CONSCELL to be NEWCAR. Returns NEWCAR. -*/ ) - (conscell, newcar) - Lisp_Object conscell, newcar; +*/ + (conscell, newcar)) { if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); @@ -539,11 +503,10 @@ return newcar; } -DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0 /* +DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /* Set the cdr of CONSCELL to be NEWCDR. Returns NEWCDR. -*/ ) - (conscell, newcdr) - Lisp_Object conscell, newcdr; +*/ + (conscell, newcdr)) { if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); @@ -588,7 +551,7 @@ return hare; } -DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0 /* +DEFUN ("indirect-function", Findirect_function, 1, 1, 0, /* Return the function at the end of OBJECT's function chain. If OBJECT is a symbol, follow all function indirections and return the final function binding. @@ -596,23 +559,20 @@ Signal a void-function error if the final symbol is unbound. Signal a cyclic-function-indirection error if there is a loop in the function chain of symbols. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return indirect_function (object, 1); } /* Extract and set vector and string elements */ -DEFUN ("aref", Faref, Saref, 2, 2, 0 /* +DEFUN ("aref", Faref, 2, 2, 0, /* Return the element of ARRAY at index INDEX. ARRAY may be a vector, bit vector, string, or byte-code object. IDX starts at 0. -*/ ) - (array, idx) - Lisp_Object array; - Lisp_Object idx; +*/ + (array, idx)) { int idxval; @@ -654,13 +614,11 @@ } } -DEFUN ("aset", Faset, Saset, 3, 3, 0 /* +DEFUN ("aset", Faset, 3, 3, 0, /* Store into the element of ARRAY at index IDX the value NEWVAL. ARRAY may be a vector, bit vector, or string. IDX starts at 0. -*/ ) - (array, idx, newval) - Lisp_Object array; - Lisp_Object idx, newval; +*/ + (array, idx, newval)) { int idxval; @@ -792,58 +750,48 @@ b->doc_and_interactive = new; } -DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, - Scompiled_function_instructions, 1, 1, 0 /* +DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /* Return the byte-opcode string of the compiled-function object. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); return (XCOMPILED_FUNCTION (function)->bytecodes); } -DEFUN ("compiled-function-constants", Fcompiled_function_constants, - Scompiled_function_constants, 1, 1, 0 /* +DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /* Return the constants vector of the compiled-function object. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); return (XCOMPILED_FUNCTION (function)->constants); } -DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, - Scompiled_function_stack_depth, 1, 1, 0 /* +DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /* Return the max stack depth of the compiled-function object. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); return (make_int (XCOMPILED_FUNCTION (function)->maxdepth)); } -DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, - Scompiled_function_arglist, 1, 1, 0 /* +DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /* Return the argument list of the compiled-function object. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); return (XCOMPILED_FUNCTION (function)->arglist); } -DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, - Scompiled_function_interactive, 1, 1, 0 /* +DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /* Return the interactive spec of the compiled-function object, or nil. If non-nil, the return value will be a list whose first element is `interactive' and whose second element is the interactive spec. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); if (!XCOMPILED_FUNCTION (function)->flags.interactivep) @@ -853,12 +801,10 @@ (XCOMPILED_FUNCTION (function)))); } -DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, - Scompiled_function_doc_string, 1, 1, 0 /* +DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /* Return the doc string of the compiled-function object, if available. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); if (!XCOMPILED_FUNCTION (function)->flags.interactivep) @@ -870,8 +816,7 @@ #ifdef COMPILED_FUNCTION_ANNOTATION_HACK -DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, - Scompiled_function_annotation, 1, 1, 0 /* +DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /* Return the annotation of the compiled-function object, or nil. The annotation is a piece of information indicating where this compiled-function object came from. Generally this will be @@ -879,9 +824,8 @@ compiled-function object was not defined in a function; or nil, if the compiled-function object was not created as a result of a `load'. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); return (compiled_function_annotation (XCOMPILED_FUNCTION (function))); @@ -889,13 +833,11 @@ #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ -DEFUN ("compiled-function-domain", Fcompiled_function_domain, - Scompiled_function_domain, 1, 1, 0 /* +DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /* Return the domain of the compiled-function object, or nil. This is only meaningful if I18N3 was enabled when emacs was compiled. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { CHECK_COMPILED_FUNCTION (function); if (!XCOMPILED_FUNCTION (function)->flags.domainp) @@ -948,70 +890,63 @@ return Qnil; /* suppress compiler warning */ } -DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0 /* +DEFUN ("=", Feqlsign, 2, 2, 0, /* T if two args, both numbers or markers, are equal. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { return arithcompare (num1, num2, equal); } -DEFUN ("<", Flss, Slss, 2, 2, 0 /* +DEFUN ("<", Flss, 2, 2, 0, /* T if first arg is less than second arg. Both must be numbers or markers. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { return arithcompare (num1, num2, less); } -DEFUN (">", Fgtr, Sgtr, 2, 2, 0 /* +DEFUN (">", Fgtr, 2, 2, 0, /* T if first arg is greater than second arg. Both must be numbers or markers. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { return arithcompare (num1, num2, grtr); } -DEFUN ("<=", Fleq, Sleq, 2, 2, 0 /* +DEFUN ("<=", Fleq, 2, 2, 0, /* T if first arg is less than or equal to second arg. Both must be numbers or markers. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { return arithcompare (num1, num2, less_or_equal); } -DEFUN (">=", Fgeq, Sgeq, 2, 2, 0 /* +DEFUN (">=", Fgeq, 2, 2, 0, /* T if first arg is greater than or equal to second arg. Both must be numbers or markers. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { return arithcompare (num1, num2, grtr_or_equal); } -DEFUN ("/=", Fneq, Sneq, 2, 2, 0 /* +DEFUN ("/=", Fneq, 2, 2, 0, /* T if first arg is not equal to second arg. Both must be numbers or markers. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { return arithcompare (num1, num2, notequal); } -DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0 /* +DEFUN ("zerop", Fzerop, 1, 1, 0, /* T if NUMBER is zero. -*/ ) - (number) - Lisp_Object number; +*/ + (number)) { CHECK_INT_OR_FLOAT (number); @@ -1052,13 +987,12 @@ } -DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0 /* +DEFUN ("number-to-string", Fnumber_to_string, 1, 1, 0, /* Convert NUM to a string by printing it in decimal. Uses a minus sign if negative. NUM may be an integer or a floating point number. -*/ ) - (num) - Lisp_Object num; +*/ + (num)) { char buffer[VALBITS]; @@ -1083,13 +1017,12 @@ return build_string (buffer); } -DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 1, 0 /* +DEFUN ("string-to-number", Fstring_to_number, 1, 1, 0, /* Convert STRING to a number by parsing it as a decimal number. This parses both integers and floating point numbers. It ignores leading spaces and tabs. -*/ ) - (string) - Lisp_Object string; +*/ + (string)) { Lisp_Object value; char *p; @@ -1253,57 +1186,48 @@ return val; } -DEFUN ("+", Fplus, Splus, 0, MANY, 0 /* +DEFUN ("+", Fplus, 0, MANY, 0, /* Return sum of any number of arguments. The arguments should all be numbers or markers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Aadd, nargs, args); } -DEFUN ("-", Fminus, Sminus, 0, MANY, 0 /* +DEFUN ("-", Fminus, 0, MANY, 0, /* Negate number or subtract numbers or markers. With one arg, negates it. With more than one arg, subtracts all but the first from the first. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Asub, nargs, args); } -DEFUN ("*", Ftimes, Stimes, 0, MANY, 0 /* +DEFUN ("*", Ftimes, 0, MANY, 0, /* Return product of any number of arguments. The arguments should all be numbers or markers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Amult, nargs, args); } -DEFUN ("/", Fquo, Squo, 2, MANY, 0 /* +DEFUN ("/", Fquo, 2, MANY, 0, /* Return first argument divided by all the remaining arguments. The arguments must be numbers or markers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Adiv, nargs, args); } -DEFUN ("%", Frem, Srem, 2, 2, 0 /* +DEFUN ("%", Frem, 2, 2, 0, /* Return remainder of first arg divided by second. Both must be integers or markers. -*/ ) - (num1, num2) - Lisp_Object num1, num2; +*/ + (num1, num2)) { CHECK_INT_COERCE_CHAR_OR_MARKER (num1); CHECK_INT_COERCE_CHAR_OR_MARKER (num2); @@ -1329,14 +1253,13 @@ #endif /* ! HAVE_FMOD */ -DEFUN ("mod", Fmod, Smod, 2, 2, 0 /* +DEFUN ("mod", Fmod, 2, 2, 0, /* Return X modulo Y. The result falls between zero (inclusive) and Y (exclusive). Both X and Y must be numbers or markers. If either argument is a float, a float will be returned. -*/ ) - (x, y) - Lisp_Object x, y; +*/ + (x, y)) { EMACS_INT i1, i2; @@ -1381,70 +1304,59 @@ } -DEFUN ("max", Fmax, Smax, 1, MANY, 0 /* +DEFUN ("max", Fmax, 1, MANY, 0, /* Return largest of all the arguments. All arguments must be numbers or markers. The value is always a number; markers are converted to numbers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Amax, nargs, args); } -DEFUN ("min", Fmin, Smin, 1, MANY, 0 /* +DEFUN ("min", Fmin, 1, MANY, 0, /* Return smallest of all the arguments. All arguments must be numbers or markers. The value is always a number; markers are converted to numbers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Amin, nargs, args); } -DEFUN ("logand", Flogand, Slogand, 0, MANY, 0 /* +DEFUN ("logand", Flogand, 0, MANY, 0, /* Return bitwise-and of all the arguments. Arguments may be integers, or markers converted to integers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Alogand, nargs, args); } -DEFUN ("logior", Flogior, Slogior, 0, MANY, 0 /* +DEFUN ("logior", Flogior, 0, MANY, 0, /* Return bitwise-or of all the arguments. Arguments may be integers, or markers converted to integers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Alogior, nargs, args); } -DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0 /* +DEFUN ("logxor", Flogxor, 0, MANY, 0, /* Return bitwise-exclusive-or of all the arguments. Arguments may be integers, or markers converted to integers. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return arith_driver (Alogxor, nargs, args); } -DEFUN ("ash", Fash, Sash, 2, 2, 0 /* +DEFUN ("ash", Fash, 2, 2, 0, /* Return VALUE with its bits shifted left by COUNT. If COUNT is negative, shifting is actually to the right. In this case, the sign bit is duplicated. -*/ ) - (value, count) - Lisp_Object value, count; +*/ + (value, count)) { CHECK_INT_COERCE_CHAR (value); CHECK_INT (count); @@ -1454,13 +1366,12 @@ XINT (value) >> -XINT (count)); } -DEFUN ("lsh", Flsh, Slsh, 2, 2, 0 /* +DEFUN ("lsh", Flsh, 2, 2, 0, /* Return VALUE with its bits shifted left by COUNT. If COUNT is negative, shifting is actually to the right. In this case, zeros are shifted in on the left. -*/ ) - (value, count) - Lisp_Object value, count; +*/ + (value, count)) { Lisp_Object val; @@ -1474,12 +1385,11 @@ return val; } -DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0 /* +DEFUN ("1+", Fadd1, 1, 1, 0, /* Return NUMBER plus one. NUMBER may be a number or a marker. Markers are converted to integers. -*/ ) - (number) - Lisp_Object number; +*/ + (number)) { CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number); @@ -1491,12 +1401,11 @@ return (make_int (XINT (number) + 1)); } -DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0 /* +DEFUN ("1-", Fsub1, 1, 1, 0, /* Return NUMBER minus one. NUMBER may be a number or a marker. Markers are converted to integers. -*/ ) - (number) - Lisp_Object number; +*/ + (number)) { CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number); @@ -1508,11 +1417,10 @@ return (make_int (XINT (number) - 1)); } -DEFUN ("lognot", Flognot, Slognot, 1, 1, 0 /* +DEFUN ("lognot", Flognot, 1, 1, 0, /* Return the bitwise complement of NUMBER. NUMBER must be an integer. -*/ ) - (number) - Lisp_Object number; +*/ + (number)) { CHECK_INT (number); return (make_int (~XINT (number))); @@ -1872,16 +1780,15 @@ return Qnil; /* not reached */ } -DEFUN ("weak-list-p", Fweak_list_p, Sweak_list_p, 1, 1, 0 /* +DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /* Return non-nil if OBJECT is a weak list. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return WEAK_LISTP (object) ? Qt : Qnil; } -DEFUN ("make-weak-list", Fmake_weak_list, Smake_weak_list, 0, 1, 0 /* +DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /* Create a new weak list. A weak list object is an object that contains a list. This list behaves like any other list except that its elements do not count towards @@ -1904,9 +1811,8 @@ and the car is not pointed to. `value-assoc' Objects in the list disappear if they are conses and the cdr is not pointed to. -*/ ) - (type) - Lisp_Object type; +*/ + (type)) { if (NILP (type)) type = Qsimple; @@ -1914,32 +1820,28 @@ return make_weak_list (decode_weak_list_type (type)); } -DEFUN ("weak-list-type", Fweak_list_type, Sweak_list_type, 1, 1, 0 /* +DEFUN ("weak-list-type", Fweak_list_type, 1, 1, 0, /* Return the type of the given weak-list object. -*/ ) - (weak) - Lisp_Object weak; +*/ + (weak)) { CHECK_WEAK_LIST (weak); return encode_weak_list_type (XWEAK_LIST (weak)->type); } -DEFUN ("weak-list-list", Fweak_list_list, Sweak_list_list, 1, 1, 0 /* +DEFUN ("weak-list-list", Fweak_list_list, 1, 1, 0, /* Return the list contained in a weak-list object. -*/ ) - (weak) - Lisp_Object weak; +*/ + (weak)) { CHECK_WEAK_LIST (weak); return XWEAK_LIST_LIST (weak); } -DEFUN ("set-weak-list-list", Fset_weak_list_list, Sset_weak_list_list, - 2, 2, 0 /* +DEFUN ("set-weak-list-list", Fset_weak_list_list, 2, 2, 0, /* Change the list contained in a weak-list object. -*/ ) - (weak, new_list) - Lisp_Object weak, new_list; +*/ + (weak, new_list)) { CHECK_WEAK_LIST (weak); XWEAK_LIST_LIST (weak) = new_list; @@ -2090,90 +1992,90 @@ defsymbol (&Qweak_listp, "weak-list-p"); - defsubr (&Swrong_type_argument); + DEFSUBR (Fwrong_type_argument); - defsubr (&Seq); - defsubr (&Snull); - defsubr (&Slistp); - defsubr (&Snlistp); - defsubr (&Sconsp); - defsubr (&Satom); - defsubr (&Schar_or_string_p); - defsubr (&Scharacterp); - defsubr (&Sintegerp); - defsubr (&Sinteger_or_marker_p); - defsubr (&Snumberp); - defsubr (&Snumber_or_marker_p); + DEFSUBR (Feq); + DEFSUBR (Fnull); + DEFSUBR (Flistp); + DEFSUBR (Fnlistp); + DEFSUBR (Fconsp); + DEFSUBR (Fatom); + DEFSUBR (Fchar_or_string_p); + DEFSUBR (Fcharacterp); + DEFSUBR (Fintegerp); + DEFSUBR (Finteger_or_marker_p); + DEFSUBR (Fnumberp); + DEFSUBR (Fnumber_or_marker_p); #ifdef LISP_FLOAT_TYPE - defsubr (&Sfloatp); + DEFSUBR (Ffloatp); #endif /* LISP_FLOAT_TYPE */ - defsubr (&Snatnump); - defsubr (&Ssymbolp); - defsubr (&Skeywordp); - defsubr (&Sstringp); - defsubr (&Svectorp); - defsubr (&Sbitp); - defsubr (&Sbit_vector_p); - defsubr (&Sarrayp); - defsubr (&Ssequencep); - defsubr (&Smarkerp); - defsubr (&Ssubrp); - defsubr (&Ssubr_min_args); - defsubr (&Ssubr_max_args); - defsubr (&Scompiled_function_p); - defsubr (&Stype_of); - defsubr (&Scar); - defsubr (&Scdr); - defsubr (&Scar_safe); - defsubr (&Scdr_safe); - defsubr (&Ssetcar); - defsubr (&Ssetcdr); - defsubr (&Sindirect_function); - defsubr (&Saref); - defsubr (&Saset); + DEFSUBR (Fnatnump); + DEFSUBR (Fsymbolp); + DEFSUBR (Fkeywordp); + DEFSUBR (Fstringp); + DEFSUBR (Fvectorp); + DEFSUBR (Fbitp); + DEFSUBR (Fbit_vector_p); + DEFSUBR (Farrayp); + DEFSUBR (Fsequencep); + DEFSUBR (Fmarkerp); + DEFSUBR (Fsubrp); + DEFSUBR (Fsubr_min_args); + DEFSUBR (Fsubr_max_args); + DEFSUBR (Fcompiled_function_p); + DEFSUBR (Ftype_of); + DEFSUBR (Fcar); + DEFSUBR (Fcdr); + DEFSUBR (Fcar_safe); + DEFSUBR (Fcdr_safe); + DEFSUBR (Fsetcar); + DEFSUBR (Fsetcdr); + DEFSUBR (Findirect_function); + DEFSUBR (Faref); + DEFSUBR (Faset); - defsubr (&Scompiled_function_instructions); - defsubr (&Scompiled_function_constants); - defsubr (&Scompiled_function_stack_depth); - defsubr (&Scompiled_function_arglist); - defsubr (&Scompiled_function_interactive); - defsubr (&Scompiled_function_doc_string); - defsubr (&Scompiled_function_domain); + DEFSUBR (Fcompiled_function_instructions); + DEFSUBR (Fcompiled_function_constants); + DEFSUBR (Fcompiled_function_stack_depth); + DEFSUBR (Fcompiled_function_arglist); + DEFSUBR (Fcompiled_function_interactive); + DEFSUBR (Fcompiled_function_doc_string); + DEFSUBR (Fcompiled_function_domain); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK - defsubr (&Scompiled_function_annotation); + DEFSUBR (Fcompiled_function_annotation); #endif - defsubr (&Snumber_to_string); - defsubr (&Sstring_to_number); - defsubr (&Seqlsign); - defsubr (&Slss); - defsubr (&Sgtr); - defsubr (&Sleq); - defsubr (&Sgeq); - defsubr (&Sneq); - defsubr (&Szerop); - defsubr (&Splus); - defsubr (&Sminus); - defsubr (&Stimes); - defsubr (&Squo); - defsubr (&Srem); - defsubr (&Smod); - defsubr (&Smax); - defsubr (&Smin); - defsubr (&Slogand); - defsubr (&Slogior); - defsubr (&Slogxor); - defsubr (&Slsh); - defsubr (&Sash); - defsubr (&Sadd1); - defsubr (&Ssub1); - defsubr (&Slognot); + DEFSUBR (Fnumber_to_string); + DEFSUBR (Fstring_to_number); + DEFSUBR (Feqlsign); + DEFSUBR (Flss); + DEFSUBR (Fgtr); + DEFSUBR (Fleq); + DEFSUBR (Fgeq); + DEFSUBR (Fneq); + DEFSUBR (Fzerop); + DEFSUBR (Fplus); + DEFSUBR (Fminus); + DEFSUBR (Ftimes); + DEFSUBR (Fquo); + DEFSUBR (Frem); + DEFSUBR (Fmod); + DEFSUBR (Fmax); + DEFSUBR (Fmin); + DEFSUBR (Flogand); + DEFSUBR (Flogior); + DEFSUBR (Flogxor); + DEFSUBR (Flsh); + DEFSUBR (Fash); + DEFSUBR (Fadd1); + DEFSUBR (Fsub1); + DEFSUBR (Flognot); - defsubr (&Sweak_list_p); - defsubr (&Smake_weak_list); - defsubr (&Sweak_list_type); - defsubr (&Sweak_list_list); - defsubr (&Sset_weak_list_list); + DEFSUBR (Fweak_list_p); + DEFSUBR (Fmake_weak_list); + DEFSUBR (Fweak_list_type); + DEFSUBR (Fweak_list_list); + DEFSUBR (Fset_weak_list_list); } void
--- a/src/database.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/database.c Mon Aug 13 08:50:05 2007 +0200 @@ -71,7 +71,7 @@ XEMACS_DB_TYPE type; int mode; int ackcess; - int errno; + int dberrno; void *db_handle; DB_FUNCS *funcs; }; @@ -100,7 +100,7 @@ dbase->db_handle = NULL; dbase->ackcess = 0; dbase->mode = 0; - dbase->errno = 0; + dbase->dberrno = 0; dbase->type = DB_UNKNOWN; return (dbase); } @@ -160,11 +160,10 @@ db->funcs->close (db); } -DEFUN ("close-database", Fdatabase_close, Sdatabase_close, 1, 1, 0 /* +DEFUN ("close-database", Fdatabase_close, 1, 1, 0, /* Close database OBJ. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { struct database_struct *db; CHECK_DATABASE (obj); @@ -178,11 +177,10 @@ return (Qnil); } -DEFUN ("database-type", Fdatabase_type, Sdatabase_type, 1, 1, 0 /* +DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /* Return the type of database OBJ. -*/) - (obj) - Lisp_Object obj; +*/ + (obj)) { struct database_struct *db; CHECK_DATABASE (obj); @@ -191,11 +189,10 @@ return db->funcs->get_lisp_type (db); } -DEFUN ("database-subtype", Fdatabase_subtype, Sdatabase_subtype, 1, 1, 0 /* +DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* Return the subtype of database OBJ, if any. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { struct database_struct *db; @@ -205,11 +202,10 @@ return (intern (db->funcs->get_subtype (db))); } -DEFUN ("database-live-p", Fdatabase_live_p, Sdatabase_live_p, 1, 1, 0 /* +DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* Return t iff OBJ is an active database, else nil. -*/ ) - (obj) - Lisp_Object (obj); +*/ + (obj)) { struct database_struct *db; CHECK_DATABASE (obj); @@ -218,12 +214,10 @@ return (DATABASE_LIVE_P (db) ? Qt : Qnil); } -DEFUN ("database-file-name", Fdatabase_file_name, Sdatabase_file_name, - 1, 1, 0 /* +DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* Return the filename associated with the database OBJ. -*/) - (obj) - Lisp_Object obj; +*/ + (obj)) { struct database_struct *db; CHECK_DATABASE (obj); @@ -231,11 +225,10 @@ return (db->fname); } -DEFUN ("databasep", Fdatabasep, Sdatabasep, 1, 1, 0 /* +DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* Return t iff OBJ is a database, else nil. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return ((DATABASEP (obj)) ? Qt : Qnil); } @@ -329,7 +322,7 @@ static Lisp_Object dbm_lasterr (struct database_struct *dbp) { - char *temp = strerror (dbp->errno); + char *temp = strerror (dbp->dberrno); return (make_string ((unsigned char *) temp, strlen (temp))); } @@ -412,7 +405,7 @@ static Lisp_Object berkdb_lasterr (struct database_struct *dbp) { - char *temp = strerror (dbp->errno); + char *temp = strerror (dbp->dberrno); return (make_string ((unsigned char *) temp, strlen (temp))); } @@ -431,7 +424,7 @@ if (!status) return (make_string (valdatum.data, valdatum.size)); - db->errno = (status == 1) ? -1 : errno; + db->dberrno = (status == 1) ? -1 : errno; return (Qnil); } @@ -451,7 +444,7 @@ valdatum.size = XSTRING_LENGTH (val); status = dbp->put (dbp, &keydatum, &valdatum, NILP (replace) ? R_NOOVERWRITE : 0); - db->errno = (status == 1) ? -1 : errno; + db->dberrno = (status == 1) ? -1 : errno; return status; } @@ -469,7 +462,7 @@ if (!status) return 0; - db->errno = (status == 1) ? -1 : errno; + db->dberrno = (status == 1) ? -1 : errno; return 1; } @@ -518,11 +511,10 @@ }; #endif -DEFUN ("database-last-error", Fdatabase_error, Sdatabase_error, 0, 1, 0 /* +DEFUN ("database-last-error", Fdatabase_error, 0, 1, 0, /* Return the last error associated with database OBJ. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { struct database_struct *db; @@ -537,13 +529,12 @@ return (db->funcs->last_error (db)); } -DEFUN ("open-database", Fmake_database, Smake_database, 1, 5, 0 /* +DEFUN ("open-database", Fmake_database, 1, 5, 0, /* Open database FILE, using database method TYPE and SUBTYPE, with access rights ACCESS and permissions MODE. ACCESS can be any combination of 'r' 'w' and '+', for read, write, and creation flags. -*/ ) - (file, type, subtype, ackcess, mode) - Lisp_Object file, type, subtype, ackcess, mode; +*/ + (file, type, subtype, ackcess, mode)) { Lisp_Object retval = Qnil; int modemask; @@ -635,12 +626,11 @@ return (retval); } -DEFUN ("put-database", Fputdatabase, Sputdatabase, 3, 4, 0 /* +DEFUN ("put-database", Fputdatabase, 3, 4, 0, /* Store KEY and VAL in DATABASE. If optinal fourth arg REPLACE is non-nil, replace any existing entry in the database. -*/ ) - (key, val, dbase, replace) - Lisp_Object key, val, dbase, replace; +*/ + (key, val, dbase, replace)) { struct database_struct *db; int status; @@ -658,11 +648,10 @@ return status ? Qt : Qnil; } -DEFUN ("remove-database", Fremdatabase, Sremdatabase, 2, 2, 0 /* +DEFUN ("remove-database", Fremdatabase, 2, 2, 0, /* Remove KEY from DATABASE. -*/ ) - (key, dbase) - Lisp_Object key, dbase; +*/ + (key, dbase)) { struct database_struct *db; CHECK_DATABASE (dbase); @@ -674,12 +663,11 @@ return db->funcs->rem (db, key) ? Qt : Qnil; } -DEFUN ("get-database", Fgetdatabase, Sgetdatabase, 2, 3, 0 /* +DEFUN ("get-database", Fgetdatabase, 2, 3, 0, /* Find value for KEY in DATABASE. If there is no corresponding value, return DEFAULT (defaults to nil). -*/ ) - (key, dbase, defalt) - Lisp_Object key, dbase, defalt; /* One can't even spell correctly in C */ +*/ + (key, dbase, defalt)) { Lisp_Object retval; struct database_struct *db; @@ -695,12 +683,11 @@ return (NILP (retval) ? defalt : retval); } -DEFUN ("map-database", Fmapdatabase, Smapdatabase, 2, 2, 0 /* +DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* Map FUNCTION over entries in DATABASE, calling it with two args, each key and value in the database. -*/ ) - (function, dbase) - Lisp_Object function, dbase; +*/ + (function, dbase)) { struct gcpro gcpro1, gcpro2; struct database_struct *db; @@ -730,18 +717,18 @@ defsymbol (&Qrecno, "recno"); #endif - defsubr (&Smake_database); - defsubr (&Sdatabasep); - defsubr (&Smapdatabase); - defsubr (&Sputdatabase); - defsubr (&Sgetdatabase); - defsubr (&Sremdatabase); - defsubr (&Sdatabase_type); - defsubr (&Sdatabase_subtype); - defsubr (&Sdatabase_error); - defsubr (&Sdatabase_live_p); - defsubr (&Sdatabase_file_name); - defsubr (&Sdatabase_close); + DEFSUBR (Fmake_database); + DEFSUBR (Fdatabasep); + DEFSUBR (Fmapdatabase); + DEFSUBR (Fputdatabase); + DEFSUBR (Fgetdatabase); + DEFSUBR (Fremdatabase); + DEFSUBR (Fdatabase_type); + DEFSUBR (Fdatabase_subtype); + DEFSUBR (Fdatabase_error); + DEFSUBR (Fdatabase_live_p); + DEFSUBR (Fdatabase_file_name); + DEFSUBR (Fdatabase_close); } void
--- a/src/debug.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/debug.c Mon Aug 13 08:50:05 2007 +0200 @@ -94,12 +94,10 @@ #undef FROB } -DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, - Sadd_debug_class_to_check, 1, 1, 0 /* +DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /* Add a debug class to the list of active classes. -*/ ) - (class) - Lisp_Object class; +*/ + (class)) { if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) error ("No such debug class exists"); @@ -109,12 +107,10 @@ return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); } -DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, - Sdelete_debug_class_to_check, 1, 1, 0 /* +DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /* Delete a debug class from the list of active classes. -*/ ) - (class) - Lisp_Object class; +*/ + (class)) { if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) error ("No such debug class exists"); @@ -124,30 +120,27 @@ return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); } -DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, - Sdebug_classes_being_checked, 0, 0, 0 /* +DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* Return a list of active debug classes. -*/ ) - () +*/ + ()) { return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); } -DEFUN ("debug-classes-list", Fdebug_classes_list, Sdebug_classes_list, 0, 0, 0 /* +DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* Return a list of all defined debug classes. -*/ ) - () +*/ + ()) { return (xemacs_debug_loop (LIST, Qnil, Qnil)); } -DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, - Sset_debug_classes_to_check, 1, 1, 0 /* +DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /* Set which classes of debug statements should be active. CLASSES should be a list of debug classes. -*/ ) - (classes) - Lisp_Object classes; +*/ + (classes)) { Lisp_Object rest; @@ -167,14 +160,12 @@ return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); } -DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, - Sset_debug_class_types_to_check, 2, 2, 0 /* +DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* For the given debug CLASS, set which TYPES are actually interesting. TYPES should be an integer representing the or'd value of all desired types. Lists of defined types and their values are located in the source code. -*/ ) - (class, type) - Lisp_Object class, type; +*/ + (class, type)) { CHECK_INT (type); if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) @@ -185,12 +176,10 @@ return (xemacs_debug_loop (TYPE, class, Qnil)); } -DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, - Sdebug_types_being_checked, 1, 1, 0 /* +DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* For the given CLASS, return the associated type value. -*/ ) - (class) - Lisp_Object class; +*/ + (class)) { if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) error ("Invalid debug class"); @@ -209,13 +198,13 @@ defsymbol (&Qdevices, "devices"); /* defsymbol (&Qbyte_code, "byte-code"); in bytecode.c */ - defsubr (&Sadd_debug_class_to_check); - defsubr (&Sdelete_debug_class_to_check); - defsubr (&Sdebug_classes_being_checked); - defsubr (&Sdebug_classes_list); - defsubr (&Sset_debug_classes_to_check); - defsubr (&Sset_debug_class_types_to_check); - defsubr (&Sdebug_types_being_checked); + DEFSUBR (Fadd_debug_class_to_check); + DEFSUBR (Fdelete_debug_class_to_check); + DEFSUBR (Fdebug_classes_being_checked); + DEFSUBR (Fdebug_classes_list); + DEFSUBR (Fset_debug_classes_to_check); + DEFSUBR (Fset_debug_class_types_to_check); + DEFSUBR (Fdebug_types_being_checked); } void
--- a/src/device-x.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/device-x.c Mon Aug 13 08:50:05 2007 +0200 @@ -612,7 +612,7 @@ return 0; } -DEFUN ("x-debug-mode", Fx_debug_mode, Sx_debug_mode, 1, 2, 0 /* +DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /* With a true arg, make the connection to the X server synchronous. With false, make it asynchronous. Synchronous connections are much slower, but are useful for debugging. (If you get X errors, make the connection @@ -623,9 +623,8 @@ Calling this function is the same as calling the C function `XSynchronize', or starting the program with the `-sync' command line argument. -*/ ) - (arg, device) - Lisp_Object arg, device; +*/ + (arg, device)) { struct device *d = decode_x_device (device); @@ -801,7 +800,7 @@ return; } -DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 3, 6, 0 /* +DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /* Retrieve an X resource from the resource manager. The first arg is the name of the resource to retrieve, such as \"font\". @@ -882,9 +881,8 @@ `integer', an integer is returned. If the third arg is `boolean', then the returned value is the list (t) for true, (nil) for false, and is nil to mean ``unspecified.'' -*/ ) - (name, class, type, locale, device, no_error) - Lisp_Object name, class, type, locale, device, no_error; +*/ + (name, class, type, locale, device, no_error)) { /* #### fixed limit, could be overflowed */ char name_string[2048], class_string[2048]; @@ -985,8 +983,7 @@ return Qnil; /* shut up compiler */ } -DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, - Sx_get_resource_prefix, 1, 2, 0 /* +DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /* Return the resource prefix for LOCALE on DEVICE. The resource prefix is the strings used to prefix resources if the LOCALE and DEVICE arguments were passed to `x-get-resource'. @@ -995,9 +992,8 @@ \(\"xemacs.frame.FRAME-NAME\" . \"Emacs.EmacsLocaleType.EmacsFrame\"). If no valid X device for resourcing can be obtained, this function returns nil. (In such a case, `x-get-resource' would always return nil.) -*/ ) - (locale, device) - Lisp_Object locale, device; +*/ + (locale, device)) { /* #### fixed limit, could be overflowed */ char name[1024], class[1024]; @@ -1009,13 +1005,12 @@ return Fcons (build_string (name), build_string (class)); } -DEFUN ("x-put-resource", Fx_put_resource, Sx_put_resource, 1, 2, 0 /* +DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /* Add a resource to the resource database for DEVICE. RESOURCE-LINE specifies the resource to add and should be a standard resource specification. -*/ ) - (resource_line, device) - Lisp_Object resource_line, device; +*/ + (resource_line, device)) { struct device *d = decode_device (device); char *str, *colon_pos; @@ -1045,23 +1040,21 @@ /* display information functions */ /************************************************************************/ -DEFUN ("default-x-device", Fdefault_x_device, Sdefault_x_device, 0, 0, 0 /* +DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /* Return the default X device for resourcing. This is the first-created X device that still exists. -*/ ) - () +*/ + ()) { return Vdefault_x_device; } -DEFUN ("x-display-visual-class", Fx_display_visual_class, - Sx_display_visual_class, 0, 1, 0 /* +DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /* Return the visual class of the X display `device' is on. The returned value will be one of the symbols `static-gray', `gray-scale', `static-color', `pseudo-color', `true-color', or `direct-color'. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { switch (DefaultVisualOfScreen (DefaultScreenOfDisplay (get_x_display (device)))->class) @@ -1127,11 +1120,10 @@ return DisplayCells (dpy, DefaultScreen (dpy)); } -DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0 /* +DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /* Return the vendor ID string of the X server `device' on. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { Display *dpy = get_x_display (device); char *vendor = ServerVendor (dpy); @@ -1142,14 +1134,13 @@ return (build_string ("")); } -DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0 /* +DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /* Return the version numbers of the X server `device' is on. The returned value is a list of three integers: the major and minor version numbers of the X Protocol in use, and the vendor-specific release number. See also `x-server-vendor'. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { Display *dpy = get_x_display (device); @@ -1158,14 +1149,12 @@ make_int (VendorRelease (dpy))); } -DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, Sx_valid_keysym_name_p, - 1, 1, 0 /* +DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /* Return true if KEYSYM names a keysym that the X library knows about. Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -*/ ) - (keysym) - Lisp_Object keysym; +*/ + (keysym)) { CONST char *keysym_ext; @@ -1176,16 +1165,14 @@ return Qnil; } -DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, Sx_keysym_on_keyboard_p, - 1, 2, 0 /* +DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /* Return true if KEYSYM names a key on the keyboard of DEVICE. More precisely, return true if pressing a physical key on the keyboard of DEVICE without any modifier keys generates KEYSYM. Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -*/ ) - (keysym, device) - Lisp_Object keysym, device; +*/ + (keysym, device)) { struct device *d = decode_device(device); CONST char *keysym_string; @@ -1219,7 +1206,7 @@ /* grabs and ungrabs */ /************************************************************************/ -DEFUN ("x-grab-pointer", Fx_grab_pointer, Sx_grab_pointer, 0, 3, 0 /* +DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /* Grab the pointer and restrict it to its current window. If optional DEVICE argument is nil, the default device will be used. If optional CURSOR argument is non-nil, change the pointer shape to that @@ -1228,9 +1215,8 @@ If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all keyboard events during the grab. Returns t if the grab is successful, nil otherwise. -*/ ) - (device, cursor, ignore_keyboard) - Lisp_Object device, cursor, ignore_keyboard; +*/ + (device, cursor, ignore_keyboard)) { Window w; int pointer_mode, result; @@ -1266,13 +1252,12 @@ return ((result == GrabSuccess) ? Qt : Qnil); } -DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, Sx_ungrab_pointer, 0, 1, 0 /* +DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /* Release a pointer grab made with `x-grab-pointer'. If optional first arg DEVICE is nil the default device is used. If it is t the pointer will be released on all X devices. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { if (!EQ (device, Qt)) { @@ -1295,15 +1280,14 @@ return Qnil; } -DEFUN ("x-grab-keyboard", Fx_grab_keyboard, Sx_grab_keyboard, 0, 1, 0 /* +DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /* Grab the keyboard on the given device (defaulting to the selected one). So long as the keyboard is grabbed, all keyboard events will be delivered to emacs -- it is not possible for other X clients to eavesdrop on them. Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect). Returns t if the grab was successful; nil otherwise. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_x_device (device); Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); @@ -1334,11 +1318,10 @@ return Qnil; } -DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, Sx_ungrab_keyboard, 0, 1, 0 /* +DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /* Release a keyboard grab made with `x-grab-keyboard'. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { Display *dpy = get_x_display (device); XUngrabKeyboard (dpy, CurrentTime); @@ -1353,22 +1336,22 @@ void syms_of_device_x (void) { - defsubr (&Sx_debug_mode); - defsubr (&Sx_get_resource); - defsubr (&Sx_get_resource_prefix); - defsubr (&Sx_put_resource); + DEFSUBR (Fx_debug_mode); + DEFSUBR (Fx_get_resource); + DEFSUBR (Fx_get_resource_prefix); + DEFSUBR (Fx_put_resource); - defsubr (&Sdefault_x_device); - defsubr (&Sx_display_visual_class); - defsubr (&Sx_server_vendor); - defsubr (&Sx_server_version); - defsubr (&Sx_valid_keysym_name_p); - defsubr (&Sx_keysym_on_keyboard_p); + DEFSUBR (Fdefault_x_device); + DEFSUBR (Fx_display_visual_class); + DEFSUBR (Fx_server_vendor); + DEFSUBR (Fx_server_version); + DEFSUBR (Fx_valid_keysym_name_p); + DEFSUBR (Fx_keysym_on_keyboard_p); - defsubr (&Sx_grab_pointer); - defsubr (&Sx_ungrab_pointer); - defsubr (&Sx_grab_keyboard); - defsubr (&Sx_ungrab_keyboard); + DEFSUBR (Fx_grab_pointer); + DEFSUBR (Fx_ungrab_pointer); + DEFSUBR (Fx_grab_keyboard); + DEFSUBR (Fx_ungrab_keyboard); defsymbol (&Qx_error, "x-error"); defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
--- a/src/device.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/device.c Mon Aug 13 08:50:05 2007 +0200 @@ -132,13 +132,11 @@ return !NILP (memq_no_quit (class, Vdevice_class_list)); } -DEFUN ("valid-device-class-p", Fvalid_device_class_p, Svalid_device_class_p, - 1, 1, 0 /* +DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /* Given a DEVICE-CLASS, return t if it is valid. Valid classes are 'color, 'grayscale, and 'mono. -*/ ) - (device_class) - Lisp_Object device_class; +*/ + (device_class)) { if (valid_device_class_p (device_class)) return Qt; @@ -146,11 +144,10 @@ return Qnil; } -DEFUN ("device-class-list", Fdevice_class_list, Sdevice_class_list, - 0, 0, 0 /* +DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /* Return a list of valid device classes. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vdevice_class_list); } @@ -220,24 +217,22 @@ return device; } -DEFUN ("dfw-device", Fdfw_device, Sdfw_device, 1, 1, 0 /* +DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /* Given a device, frame, or window, return the associated device. Return nil otherwise. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return DFW_DEVICE (obj); } -DEFUN ("selected-device", Fselected_device, Sselected_device, 0, 1, 0 /* +DEFUN ("selected-device", Fselected_device, 0, 1, 0, /* Return the device which is currently active. If optional CONSOLE is non-nil, return the device that would be currently active if CONSOLE were the selected console. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { if (NILP (console) && NILP (Vselected_console)) return Qnil; /* happens early in temacs */ @@ -259,16 +254,15 @@ select_console_1 (DEVICE_CONSOLE (dev)); } -DEFUN ("select-device", Fselect_device, Sselect_device, 1, 1, 0 /* +DEFUN ("select-device", Fselect_device, 1, 1, 0, /* Select the device DEVICE. Subsequent editing commands apply to its console, selected frame, and selected window. The selection of DEVICE lasts until the next time the user does something to select a different device, or until the next time this function is called. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { CHECK_LIVE_DEVICE (device); @@ -290,14 +284,12 @@ d->_selected_frame = frame; } -DEFUN ("set-device-selected-frame", Fset_device_selected_frame, - Sset_device_selected_frame, 2, 2, 0 /* +DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /* Set the selected frame of device object DEVICE to FRAME. If DEVICE is nil, the selected device is used. If DEVICE is the selected device, this makes FRAME the selected frame. -*/ ) - (device, frame) - Lisp_Object device, frame; +*/ + (device, frame)) { XSETDEVICE (device, decode_device (device)); CHECK_LIVE_FRAME (frame); @@ -312,54 +304,49 @@ return frame; } -DEFUN ("devicep", Fdevicep, Sdevicep, 1, 1, 0 /* +DEFUN ("devicep", Fdevicep, 1, 1, 0, /* Return non-nil if OBJECT is a device. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (!DEVICEP (object)) return Qnil; return Qt; } -DEFUN ("device-live-p", Fdevice_live_p, Sdevice_live_p, 1, 1, 0 /* +DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /* Return non-nil if OBJECT is a device that has not been deleted. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (!DEVICEP (object) || !DEVICE_LIVE_P (XDEVICE (object))) return Qnil; return Qt; } -DEFUN ("device-name", Fdevice_name, Sdevice_name, 0, 1, 0 /* +DEFUN ("device-name", Fdevice_name, 0, 1, 0, /* Return the name of the specified device. DEVICE defaults to the selected device if omitted. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { return DEVICE_NAME (decode_device (device)); } -DEFUN ("device-connection", Fdevice_connection, Sdevice_connection, 0, 1, 0 /* +DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /* Return the connection of the specified device. DEVICE defaults to the selected device if omitted. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { return DEVICE_CONNECTION (decode_device (device)); } -DEFUN ("device-console", Fdevice_console, Sdevice_console, 0, 1, 0 /* +DEFUN ("device-console", Fdevice_console, 0, 1, 0, /* Return the console of the specified device. DEVICE defaults to the selected device if omitted. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { return DEVICE_CONSOLE (decode_device (device)); } @@ -433,7 +420,7 @@ return Qnil; } -DEFUN ("find-device", Ffind_device, Sfind_device, 1, 2, 0 /* +DEFUN ("find-device", Ffind_device, 1, 2, 0, /* Look for an existing device attached to connection CONNECTION. Return the device if found; otherwise, return nil. @@ -441,9 +428,8 @@ return devices of any type. (It is possible, although unlikely, that two devices of different types could have the same connection name; in such a case, the first device found is returned.) -*/ ) - (connection, type) - Lisp_Object connection, type; +*/ + (connection, type)) { Lisp_Object canon = Qnil; struct gcpro gcpro1; @@ -482,7 +468,7 @@ } } -DEFUN ("get-device", Fget_device, Sget_device, 1, 2, 0 /* +DEFUN ("get-device", Fget_device, 1, 2, 0, /* Look for an existing device attached to connection CONNECTION. Return the device if found; otherwise, signal an error. @@ -490,9 +476,8 @@ return devices of any type. (It is possible, although unlikely, that two devices of different types could have the same connection name; in such a case, the first device found is returned.) -*/ ) - (connection, type) - Lisp_Object connection, type; +*/ + (connection, type)) { Lisp_Object device = Ffind_device (connection, type); if (NILP (device)) @@ -505,7 +490,7 @@ return device; } -DEFUN ("make-device", Fmake_device, Smake_device, 2, 3, 0 /* +DEFUN ("make-device", Fmake_device, 2, 3, 0, /* Create a new device of type TYPE, attached to connection CONNECTION. The valid values for CONNECTION are device-specific; however, @@ -521,9 +506,8 @@ If CONNECTION specifies an already-existing device connection, that device is simply returned; no new device is created, and PROPS have no effect. -*/ ) - (type, connection, props) - Lisp_Object type, connection, props; +*/ + (type, connection, props)) { /* This function can GC */ struct device *d; @@ -831,52 +815,45 @@ delete_device_internal (XDEVICE (device), 1, 0, 1); } -DEFUN ("delete-device", Fdelete_device, Sdelete_device, 1, 2, 0 /* +DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /* Delete DEVICE, permanently eliminating it from use. Normally, you cannot delete the last non-minibuffer-only frame (you must use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional second argument FORCE is non-nil, you can delete the last frame. (This will automatically call `save-buffers-kill-emacs'.) -*/ ) - (device, force) - Lisp_Object device, force; +*/ + (device, force)) { CHECK_DEVICE (device); delete_device_internal (XDEVICE (device), !NILP (force), 0, 0); return Qnil; } -DEFUN ("device-frame-list", Fdevice_frame_list, Sdevice_frame_list, - 0, 1, 0 /* +DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /* Return a list of all frames on DEVICE. If DEVICE is nil, the selected device will be used. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device))); } -DEFUN ("device-class", Fdevice_class, Sdevice_class, - 0, 1, 0 /* +DEFUN ("device-class", Fdevice_class, 0, 1, 0, /* Return the class (color behavior) of DEVICE. This will be one of 'color, 'grayscale, or 'mono. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { return DEVICE_CLASS (decode_device (device)); } -DEFUN ("set-device-class", Fset_device_class, Sset_device_class, - 2, 2, 0 /* +DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /* Set the class (color behavior) of DEVICE. CLASS should be one of 'color, 'grayscale, or 'mono. This is only allowed on device such as TTY devices, where the color behavior cannot necessarily be determined automatically. -*/ ) - (device, class) - Lisp_Object device, class; +*/ + (device, class)) { struct device *d = decode_device (device); XSETDEVICE (device, d); @@ -888,12 +865,10 @@ return Qnil; } -DEFUN ("device-pixel-width", Fdevice_pixel_width, Sdevice_pixel_width, - 0, 1, 0 /* +DEFUN ("device-pixel-width", Fdevice_pixel_width, 0, 1, 0, /* Return the width in pixels of DEVICE, or nil if unknown. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); int retval; @@ -905,12 +880,10 @@ return make_int (retval); } -DEFUN ("device-pixel-height", Fdevice_pixel_height, Sdevice_pixel_height, - 0, 1, 0 /* +DEFUN ("device-pixel-height", Fdevice_pixel_height, 0, 1, 0, /* Return the height in pixels of DEVICE, or nil if unknown. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); int retval; @@ -922,12 +895,10 @@ return make_int (retval); } -DEFUN ("device-mm-width", Fdevice_mm_width, Sdevice_mm_width, - 0, 1, 0 /* +DEFUN ("device-mm-width", Fdevice_mm_width, 0, 1, 0, /* Return the width in millimeters of DEVICE, or nil if unknown. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); int retval; @@ -939,12 +910,10 @@ return make_int (retval); } -DEFUN ("device-mm-height", Fdevice_mm_height, Sdevice_mm_height, - 0, 1, 0 /* +DEFUN ("device-mm-height", Fdevice_mm_height, 0, 1, 0, /* Return the height in millimeters of DEVICE, or nil if unknown. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); int retval; @@ -956,12 +925,10 @@ return make_int (retval); } -DEFUN ("device-bitplanes", Fdevice_bitplanes, Sdevice_bitplanes, - 0, 1, 0 /* +DEFUN ("device-bitplanes", Fdevice_bitplanes, 0, 1, 0, /* Return the number of bitplanes of DEVICE, or nil if unknown. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); int retval; @@ -973,12 +940,10 @@ return make_int (retval); } -DEFUN ("device-color-cells", Fdevice_color_cells, Sdevice_color_cells, - 0, 1, 0 /* +DEFUN ("device-color-cells", Fdevice_color_cells, 0, 1, 0, /* Return the number of color cells of DEVICE, or nil if unknown. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); int retval; @@ -990,14 +955,12 @@ return make_int (retval); } -DEFUN ("set-device-baud-rate", Fset_device_baud_rate, Sset_device_baud_rate, - 2, 2, 0 /* +DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /* Set the output baud rate of DEVICE to RATE. On most systems, changing this value will affect the amount of padding and other strategic decisions made during redisplay. -*/ ) - (device, rate) - Lisp_Object device, rate; +*/ + (device, rate)) { CHECK_INT (rate); @@ -1006,12 +969,10 @@ return rate; } -DEFUN ("device-baud-rate", Fdevice_baud_rate, Sdevice_baud_rate, - 0, 1, 0 /* +DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /* Return the output baud rate of DEVICE. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { return make_int (DEVICE_BAUD_RATE (decode_device (device))); } @@ -1072,33 +1033,33 @@ void syms_of_device (void) { - defsubr (&Svalid_device_class_p); - defsubr (&Sdevice_class_list); + DEFSUBR (Fvalid_device_class_p); + DEFSUBR (Fdevice_class_list); - defsubr (&Sdfw_device); - defsubr (&Sselected_device); - defsubr (&Sselect_device); - defsubr (&Sset_device_selected_frame); - defsubr (&Sdevicep); - defsubr (&Sdevice_live_p); - defsubr (&Sdevice_name); - defsubr (&Sdevice_connection); - defsubr (&Sdevice_console); - defsubr (&Sfind_device); - defsubr (&Sget_device); - defsubr (&Smake_device); - defsubr (&Sdelete_device); - defsubr (&Sdevice_frame_list); - defsubr (&Sdevice_class); - defsubr (&Sset_device_class); - defsubr (&Sdevice_pixel_width); - defsubr (&Sdevice_pixel_height); - defsubr (&Sdevice_mm_width); - defsubr (&Sdevice_mm_height); - defsubr (&Sdevice_bitplanes); - defsubr (&Sdevice_color_cells); - defsubr (&Sset_device_baud_rate); - defsubr (&Sdevice_baud_rate); + DEFSUBR (Fdfw_device); + DEFSUBR (Fselected_device); + DEFSUBR (Fselect_device); + DEFSUBR (Fset_device_selected_frame); + DEFSUBR (Fdevicep); + DEFSUBR (Fdevice_live_p); + DEFSUBR (Fdevice_name); + DEFSUBR (Fdevice_connection); + DEFSUBR (Fdevice_console); + DEFSUBR (Ffind_device); + DEFSUBR (Fget_device); + DEFSUBR (Fmake_device); + DEFSUBR (Fdelete_device); + DEFSUBR (Fdevice_frame_list); + DEFSUBR (Fdevice_class); + DEFSUBR (Fset_device_class); + DEFSUBR (Fdevice_pixel_width); + DEFSUBR (Fdevice_pixel_height); + DEFSUBR (Fdevice_mm_width); + DEFSUBR (Fdevice_mm_height); + DEFSUBR (Fdevice_bitplanes); + DEFSUBR (Fdevice_color_cells); + DEFSUBR (Fset_device_baud_rate); + DEFSUBR (Fdevice_baud_rate); defsymbol (&Qdevicep, "devicep"); defsymbol (&Qdevice_live_p, "device-live-p");
--- a/src/dialog-x.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/dialog-x.c Mon Aug 13 08:50:05 2007 +0200 @@ -212,7 +212,7 @@ } } -DEFUN ("popup-dialog-box", Fpopup_dialog_box, Spopup_dialog_box, 1, 1, 0 /* +DEFUN ("popup-dialog-box", Fpopup_dialog_box, 1, 1, 0, /* Pop up a dialog box. A dialog box description is a list. @@ -241,9 +241,8 @@ Though the keyword/value syntax is supported for dialog boxes just as in popup menus, the only keyword which is both meaningful and fully implemented for dialog box buttons is `:active'. -*/ ) - (dbox_desc) - Lisp_Object dbox_desc; +*/ + (dbox_desc)) { int dbox_id; struct frame *f = selected_frame (); @@ -294,7 +293,7 @@ void syms_of_dialog_x (void) { - defsubr (&Spopup_dialog_box); + DEFSUBR (Fpopup_dialog_box); } void
--- a/src/dired.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/dired.c Mon Aug 13 08:50:05 2007 +0200 @@ -38,7 +38,7 @@ Lisp_Object Qfile_name_all_completions; Lisp_Object Qfile_attributes; -DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 5, 0 /* +DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /* Return a list of names of files in DIRECTORY. There are four optional arguments: If FULL is non-nil, absolute pathnames of the files are returned. @@ -50,9 +50,8 @@ nil and not t, then only the subdirectories will be returned. Otherwise, if FILES-ONLY is nil (the default) then both files and subdirectories will be returned. -*/ ) - (dirname, full, match, nosort, files_only) - Lisp_Object dirname, full, match, nosort, files_only; +*/ + (dirname, full, match, nosort, files_only)) { /* This function can GC */ DIR *d; @@ -212,8 +211,7 @@ Lisp_Object dirname, int all_flag, int ver_flag); -DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion, - 2, 2, 0 /* +DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /* Complete file name FILE in directory DIR. Returns the longest string common to all filenames in DIR that start with FILE. @@ -224,9 +222,8 @@ are not considered as possible completions for FILE unless there is no other possible completion. `completion-ignored-extensions' is not applied to the names of directories. -*/ ) - (file, dirname) - Lisp_Object file, dirname; +*/ + (file, dirname)) { /* This function can GC */ Lisp_Object handler; @@ -246,8 +243,7 @@ return file_name_completion (file, dirname, 0, 0); } -DEFUN ("file-name-all-completions", Ffile_name_all_completions, - Sfile_name_all_completions, 2, 2, 0 /* +DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /* Return a list of all completions of file name FILE in directory DIR. These are all file names in directory DIR which begin with FILE. @@ -255,9 +251,8 @@ are not considered as possible completions for FILE unless there is no other possible completion. `completion-ignored-extensions' is not applied to the names of directories. -*/ ) - (file, dirname) - Lisp_Object file, dirname; +*/ + (file, dirname)) { /* This function can GC */ Lisp_Object handler; @@ -546,23 +541,20 @@ #ifdef VMS -DEFUN ("file-name-all-versions", Ffile_name_all_versions, - Sfile_name_all_versions, 2, 2, 0 /* +DEFUN ("file-name-all-versions", Ffile_name_all_versions, 2, 2, 0, /* Return a list of all versions of file name FILE in directory DIR. -*/ ) - (file, dirname) - Lisp_Object file, dirname; +*/ + (file, dirname)) { /* This function can GC */ return file_name_completion (file, dirname, 1, 1); } -DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0 /* +DEFUN ("file-version-limit", Ffile_version_limit, 1, 1, 0, /* Return the maximum number of versions allowed for FILE. Returns nil if the file cannot be opened or if there is no version limit. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object retval; @@ -601,7 +593,7 @@ return cons; } -DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0 /* +DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /* Return a list of attributes of file FILENAME. Value is nil if specified file cannot be opened. Otherwise, list elements are: @@ -620,9 +612,8 @@ 11. Device number. If file does not exist, returns nil. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object values[12]; @@ -738,14 +729,14 @@ defsymbol (&Qfile_name_all_completions, "file-name-all-completions"); defsymbol (&Qfile_attributes, "file-attributes"); - defsubr (&Sdirectory_files); - defsubr (&Sfile_name_completion); + DEFSUBR (Fdirectory_files); + DEFSUBR (Ffile_name_completion); #ifdef VMS - defsubr (&Sfile_name_all_versions); - defsubr (&Sfile_version_limit); + DEFSUBR (Ffile_name_all_versions); + DEFSUBR (Ffile_version_limit); #endif /* VMS */ - defsubr (&Sfile_name_all_completions); - defsubr (&Sfile_attributes); + DEFSUBR (Ffile_name_all_completions); + DEFSUBR (Ffile_attributes); } void
--- a/src/doc.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/doc.c Mon Aug 13 08:50:05 2007 +0200 @@ -286,13 +286,12 @@ return Fread (string); } -DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0 /* +DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* Return the documentation string of FUNCTION. Unless a non-nil second argument is given, the string is passed through `substitute-command-keys'. -*/ ) - (function, raw) - Lisp_Object function, raw; +*/ + (function, raw)) { /* This function can GC */ Lisp_Object fun; @@ -384,16 +383,14 @@ return doc; } -DEFUN ("documentation-property", Fdocumentation_property, - Sdocumentation_property, 2, 3, 0 /* +DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /* Return the documentation string that is SYMBOL's PROP property. This is like `get', but it can refer to strings stored in the `doc-directory/DOC' file; and if the value is a string, it is passed through `substitute-command-keys'. A non-nil third argument avoids this translation. -*/ ) - (sym, prop, raw) - Lisp_Object sym, prop, raw; +*/ + (sym, prop, raw)) { /* This function can GC */ REGISTER Lisp_Object doc; @@ -432,17 +429,15 @@ } -DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, - 1, 1, 0 /* +DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /* Used during Emacs initialization, before dumping runnable Emacs, to find pointers to doc strings stored in `.../lib-src/DOC' and record them in function definitions. One arg, FILENAME, a string which does not include a directory. The file is written to `../lib-src', and later found in `exec-directory' when doc strings are referred to in the dumped Emacs. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* !!#### This function has not been Mule-ized */ int fd; @@ -736,12 +731,11 @@ } } -DEFUN ("Verify-documentation", Fverify_documentation, Sverify_documentation, - 0, 0, 0 /* +DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /* Used to make sure everything went well with Snarf-documentation. Writes to stderr if not. -*/ ) - () +*/ + ()) { Lisp_Object closure = Fcons (Qnil, Qnil); struct gcpro gcpro1; @@ -756,8 +750,7 @@ } -DEFUN ("substitute-command-keys", Fsubstitute_command_keys, - Ssubstitute_command_keys, 1, 1, 0 /* +DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /* Substitute key descriptions for command names in STRING. Return a new string which is STRING with substrings of the form \\=\\[COMMAND] replaced by either: a keystroke sequence that will invoke COMMAND, @@ -768,9 +761,8 @@ as the keymap for future \\=\\[COMMAND] substrings. \\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. -*/ ) - (str) - Lisp_Object str; +*/ + (str)) { /* This function can GC */ Bufbyte *buf; @@ -1001,11 +993,11 @@ void syms_of_doc (void) { - defsubr (&Sdocumentation); - defsubr (&Sdocumentation_property); - defsubr (&Ssnarf_documentation); - defsubr (&Sverify_documentation); - defsubr (&Ssubstitute_command_keys); + DEFSUBR (Fdocumentation); + DEFSUBR (Fdocumentation_property); + DEFSUBR (Fsnarf_documentation); + DEFSUBR (Fverify_documentation); + DEFSUBR (Fsubstitute_command_keys); } void
--- a/src/editfns.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/editfns.c Mon Aug 13 08:50:05 2007 +0200 @@ -168,11 +168,10 @@ #endif /* 0 */ } -DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0 /* +DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /* Convert arg CH to a one-character string containing that character. -*/ ) - (ch) - Lisp_Object ch; +*/ + (ch)) { Bytecount len; Bufbyte str[MAX_EMCHAR_LEN]; @@ -193,11 +192,10 @@ return make_string (str, len); } -DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0 /* +DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /* Convert arg STRING to a character, the first character of that string. -*/ ) - (str) - Lisp_Object str; +*/ + (str)) { struct Lisp_String *p; CHECK_STRING (str); @@ -221,28 +219,26 @@ return mark; } -DEFUN ("point", Fpoint, Spoint, 0, 1, 0 /* +DEFUN ("point", Fpoint, 0, 1, 0, /* Return value of point, as an integer. Beginning of buffer is position (point-min). If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return (make_int (BUF_PT (b))); } -DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 2, 0 /* +DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /* Return value of point, as a marker object. This marker is a copy; you may modify it with reckless abandon. If optional argument DONT-COPY-P is non-nil, then it returns the real point-marker; modifying the position of this marker will move point. It is illegal to change the buffer of it, or make it point nowhere. If BUFFER is nil, the current buffer is assumed. -*/ ) - (dont_copy_p, buffer) - Lisp_Object dont_copy_p, buffer; +*/ + (dont_copy_p, buffer)) { struct buffer *b = decode_buffer (buffer, 1); if (NILP (dont_copy_p)) @@ -286,14 +282,13 @@ */ int atomic_extent_goto_char_p; -DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 2, "NGoto char: " /* +DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /* Set point to POSITION, a number or marker. Beginning of buffer is position (point-min), end is (point-max). If BUFFER is nil, the current buffer is assumed. Return value of POSITION, as an integer. -*/ ) - (position, buffer) - Lisp_Object position, buffer; +*/ + (position, buffer)) { struct buffer *b = decode_buffer (buffer, 1); Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE); @@ -320,22 +315,20 @@ return (m); } -DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 1, 0 /* +DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /* Return position of beginning of region, as an integer. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { return (region_limit (1, decode_buffer (buffer, 1))); } -DEFUN ("region-end", Fregion_end, Sregion_end, 0, 1, 0 /* +DEFUN ("region-end", Fregion_end, 0, 1, 0, /* Return position of end of region, as an integer. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { return (region_limit (0, decode_buffer (buffer, 1))); } @@ -379,7 +372,7 @@ return Qnil; } -DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 2, 0 /* +DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /* Return this buffer's mark, as a marker object. If `zmacs-regions' is true, then this returns nil unless the region is currently in the active (highlighted) state. If optional argument FORCE @@ -389,9 +382,8 @@ Watch out! Moving this marker changes the mark position. If you set the marker not to point anywhere, the buffer will have no mark. If BUFFER is nil, the current buffer is assumed. -*/ ) - (force, buffer) - Lisp_Object force, buffer; +*/ + (force, buffer)) { struct buffer *b = decode_buffer (buffer, 1); if (! zmacs_regions || zmacs_region_active_p || !NILP (force)) @@ -484,14 +476,13 @@ return Qnil; } -DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0 /* +DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /* Save point, mark, and current buffer; execute BODY; restore those things. Executes BODY just like `progn'. The values of point, mark and the current buffer are restored even in case of abnormal exit (throw or error). -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ int speccount = specpdl_depth (); @@ -501,74 +492,68 @@ return unbind_to (speccount, Fprogn (args)); } -DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0 /* +DEFUN ("buffer-size", Fbufsize, 0, 1, 0, /* Return the number of characters in BUFFER. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return (make_int (BUF_SIZE (b))); } -DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 1, 0 /* +DEFUN ("point-min", Fpoint_min, 0, 1, 0, /* Return the minimum permissible value of point in BUFFER. This is 1, unless narrowing (a buffer restriction) is in effect. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return (make_int (BUF_BEGV (b))); } -DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 1, 0 /* +DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /* Return a marker to the minimum permissible value of point in BUFFER. This is the beginning, unless narrowing (a buffer restriction) is in effect. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return buildmark (BUF_BEGV (b), make_buffer (b)); } -DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 1, 0 /* +DEFUN ("point-max", Fpoint_max, 0, 1, 0, /* Return the maximum permissible value of point in BUFFER. This is (1+ (buffer-size)), unless narrowing (a buffer restriction) is in effect, in which case it is less. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return (make_int (BUF_ZV (b))); } -DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 1, 0 /* +DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /* Return a marker to the maximum permissible value of point BUFFER. This is (1+ (buffer-size)), unless narrowing (a buffer restriction) is in effect, in which case it is less. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return buildmark (BUF_ZV (b), make_buffer (b)); } -DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 1, 0 /* +DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /* Return the character following point, as a number. At the end of the buffer or accessible region, return 0. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); if (BUF_PT (b) >= BUF_ZV (b)) @@ -577,13 +562,12 @@ return (make_char (BUF_FETCH_CHAR (b, BUF_PT (b)))); } -DEFUN ("preceding-char", Fpreceding_char, Spreceding_char, 0, 1, 0 /* +DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /* Return the character preceding point, as a number. At the beginning of the buffer or accessible region, return 0. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); if (BUF_PT (b) <= BUF_BEGV (b)) @@ -592,25 +576,23 @@ return (make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1))); } -DEFUN ("bobp", Fbobp, Sbobp, 0, 1, 0 /* +DEFUN ("bobp", Fbobp, 0, 1, 0, /* Return T if point is at the beginning of the buffer. If the buffer is narrowed, this means the beginning of the narrowed part. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil; } -DEFUN ("eobp", Feobp, Seobp, 0, 1, 0 /* +DEFUN ("eobp", Feobp, 0, 1, 0, /* Return T if point is at the end of the buffer. If the buffer is narrowed, this means the end of the narrowed part. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil; @@ -625,25 +607,23 @@ } -DEFUN ("bolp", Fbolp, Sbolp, 0, 1, 0 /* +DEFUN ("bolp", Fbolp, 0, 1, 0, /* Return T if point is at the beginning of a line. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil; } -DEFUN ("eolp", Feolp, Seolp, 0, 1, 0 /* +DEFUN ("eolp", Feolp, 0, 1, 0, /* Return T if point is at the end of a line. `End of a line' includes point being at the end of the buffer. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); if (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n') @@ -651,14 +631,13 @@ return Qnil; } -DEFUN ("char-after", Fchar_after, Schar_after, 1, 2, 0 /* +DEFUN ("char-after", Fchar_after, 1, 2, 0, /* Return character in BUFFER at position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil. If BUFFER is nil, the current buffer is assumed. -*/ ) - (pos, buffer) - Lisp_Object pos, buffer; +*/ + (pos, buffer)) { struct buffer *b = decode_buffer (buffer, 1); Bufpos n = get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD); @@ -669,16 +648,15 @@ } -DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0 /* +DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /* Return the name under which the user logged in, as a string. This is based on the effective uid, not the real uid. Also, if the environment variable LOGNAME or USER is set, that determines the value of this function. If the optional argument UID is present, then environment variables are ignored and this function returns the login name for that UID, or nil. -*/ ) - (uid) - Lisp_Object uid; +*/ + (uid)) { struct passwd *pw = NULL; @@ -709,13 +687,12 @@ return (pw ? build_string (pw->pw_name) : Qnil); } -DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, - 0, 0, 0 /* +DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /* Return the name of the user's real uid, as a string. This ignores the environment variables LOGNAME and USER, so it differs from `user-login-name' when running under `su'. -*/ ) - () +*/ + ()) { struct passwd *pw = (struct passwd *) getpwuid (getuid ()); /* #### - I believe this should return nil instead of "unknown" when pw==0 */ @@ -731,29 +708,28 @@ return (tem); } -DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0 /* +DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /* Return the effective uid of Emacs, as an integer. -*/ ) - () +*/ + ()) { return make_int (geteuid ()); } -DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0 /* +DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /* Return the real uid of Emacs, as an integer. -*/ ) - () +*/ + ()) { return make_int (getuid ()); } -DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0 /* +DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /* Return the full name of the user logged in, as a string. If the optional argument USER is given, then the full name for that user is returned, or nil. USER may be either a login name or a uid. -*/ ) - (user) - Lisp_Object user; +*/ + (user)) { Lisp_Object uname = (STRINGP (user) ? user : Fuser_login_name (user)); struct passwd *pw = NULL; @@ -812,10 +788,10 @@ return (tem); } -DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0 /* +DEFUN ("system-name", Fsystem_name, 0, 0, 0, /* Return the name of the machine you are running on, as a string. -*/ ) - () +*/ + ()) { return (Fcopy_sequence (Vsystem_name)); } @@ -828,15 +804,15 @@ return xstrdup ((char *) XSTRING_DATA (Vsystem_name)); } -DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0 /* +DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /* Return the process ID of Emacs, as an integer. -*/ ) - () +*/ + ()) { return make_int (getpid ()); } -DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0 /* +DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. The time is returned as a list of three integers. The first has the most significant 16 bits of the seconds, while the second has the @@ -845,8 +821,8 @@ The microsecond count is zero on systems that do not provide resolution finer than a second. -*/ ) - () +*/ + ()) { EMACS_TIME t; Lisp_Object result[3]; @@ -859,8 +835,7 @@ return Flist (3, result); } -DEFUN ("current-process-time", Fcurrent_process_time, Scurrent_process_time, - 0, 0, 0 /* +DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /* Return the amount of time used by this XEmacs process so far. The return value is a list of three floating-point numbers, expressing the user, system, and real times used by the process. The user time @@ -882,8 +857,8 @@ Some systems do not allow the real and processor times to be distinguished. In this case, the user and real times will be the same and the system time will be 0. -*/ ) - () +*/ + ()) { double user, sys, real; @@ -923,8 +898,7 @@ static long difftm (CONST struct tm *a, CONST struct tm *b); -DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, - 2, 2, 0 /* +DEFUN ("format-time-string", Fformat_time_string, 2, 2, 0, /* Use FORMAT-STRING to format the time TIME. TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from `current-time' and `file-attributes'. @@ -966,9 +940,8 @@ BUG: If the charset used by the current locale is not ISO 8859-1, the characters appearing in the day and month names may be incorrect. -*/ ) - (format_string, _time) - Lisp_Object format_string, _time; +*/ + (format_string, _time)) { time_t value; int size; @@ -995,7 +968,7 @@ } } -DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0 /* +DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE). The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED) or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil' @@ -1008,9 +981,8 @@ 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil. ZONE is an integer indicating the number of seconds east of Greenwich. \(Note that Common Lisp has different meanings for DOW and ZONE.) -*/ ) - (specified_time) - Lisp_Object specified_time; +*/ + (specified_time)) { time_t time_spec; struct tm save_tm; @@ -1042,7 +1014,7 @@ static void set_time_zone_rule (char *tzstring); -DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0 /* +DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. This is the reverse operation of `decode-time', which see. ZONE defaults to the current time zone rule. This can @@ -1059,10 +1031,8 @@ for example, a DAY of 0 means the day preceding the given month. Year numbers less than 100 are treated just like other year numbers. If you want them to stand for years in this century, you must do that yourself -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { time_t _time; struct tm tm; @@ -1126,8 +1096,7 @@ return wasteful_word_to_lisp (_time); } -DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, - 0, 1, 0 /* +DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /* Return the current time, as a human-readable string. Programs can use this function to decode a time, since the number of columns in each field is fixed. @@ -1139,9 +1108,8 @@ (HIGH LOW . IGNORED). Thus, you can use times obtained from `current-time' and from `file-attributes'. -*/ ) - (specified_time) - Lisp_Object specified_time; +*/ + (specified_time)) { time_t value; char buf[30]; @@ -1181,7 +1149,7 @@ + (a->tm_sec - b->tm_sec)); } -DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0 /* +DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /* Return the offset and name for the local time zone. This returns a list of the form (OFFSET NAME). OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). @@ -1198,9 +1166,8 @@ Some operating systems cannot provide all this information to Emacs; in this case, `current-time-zone' returns a list containing nil for the data it can't find. -*/ ) - (specified_time) - Lisp_Object specified_time; +*/ + (specified_time)) { time_t value; struct tm *t; @@ -1272,13 +1239,11 @@ #endif } -DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, - 1, 1, 0 /* +DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /* Set the local time zone using TZ, a string specifying a time zone rule. If TZ is nil, use implementation-defined default time zone information. -*/ ) - (tz) - Lisp_Object tz; +*/ + (tz)) { char *tzstring; @@ -1329,15 +1294,13 @@ not be used after calling insert_emacs_char or insert_lisp_string, so we don't care if it gets trashed. */ -DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0 /* +DEFUN ("insert", Finsert, 0, MANY, 0, /* Insert the arguments, either strings or characters, at point. Point moves forward so that it ends up after the inserted text. Any other markers at the point of insertion remain before the text. If a string has non-null string-extent-data, new extents will be created. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* This function can GC */ REGISTER int argnum; @@ -1350,14 +1313,12 @@ return Qnil; } -DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0 /* +DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /* Insert strings or characters at point, relocating markers after the text. Point moves forward so that it ends up after the inserted text. Any other markers at the point of insertion also end up after the text. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* This function can GC */ REGISTER int argnum; @@ -1388,15 +1349,14 @@ return Qnil; } -DEFUN ("insert-string", Finsert_string, Sinsert_string, 1, 2, 0 /* +DEFUN ("insert-string", Finsert_string, 1, 2, 0, /* Insert STRING into BUFFER at BUFFER's point. Point moves forward so that it ends up after the inserted text. Any other markers at the point of insertion remain before the text. If a string has non-null string-extent-data, new extents will be created. BUFFER defaults to the current buffer. -*/ ) - (string, buffer) - Lisp_Object string, buffer; +*/ + (string, buffer)) { struct buffer *buf = decode_buffer (buffer, 1); CHECK_STRING (string); @@ -1413,7 +1373,7 @@ Jamie thinks this is bogus. */ -DEFUN ("insert-char", Finsert_char, Sinsert_char, 1, 4, 0 /* +DEFUN ("insert-char", Finsert_char, 1, 4, 0, /* Insert COUNT (second arg) copies of CHR (first arg). Point and all markers are affected as in the function `insert'. COUNT defaults to 1 if omitted. @@ -1422,9 +1382,8 @@ `t' were passed to INHERIT. The optional fourth arg BUFFER specifies the buffer to insert the text into. If BUFFER is nil, the current buffer is assumed. -*/ ) - (chr, count, ignored, buffer) - Lisp_Object chr, count, ignored, buffer; +*/ + (chr, count, ignored, buffer)) { /* This function can GC */ REGISTER Bufbyte *string; @@ -1480,7 +1439,7 @@ /* Making strings from buffer contents. */ -DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 0, 3, 0 /* +DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /* Return the contents of part of BUFFER as a string. The two arguments START and END are character positions; they can be in either order. If omitted, they default to the beginning @@ -1488,9 +1447,8 @@ If there are duplicable extents in the region, the string remembers them in its extent data. If BUFFER is nil, the current buffer is assumed. -*/ ) - (start, end, buffer) - Lisp_Object start, end, buffer; +*/ + (start, end, buffer)) { /* This function can GC */ Bufpos begv, zv; @@ -1500,15 +1458,13 @@ return make_string_from_buffer (b, begv, zv - begv); } -DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, - 1, 3, 0 /* +DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /* Insert before point a substring of the contents of buffer BUFFER. BUFFER may be a buffer or a buffer name. Arguments START and END are character numbers specifying the substring. They default to the beginning and the end of BUFFER. -*/ ) - (buffer, start, end) - Lisp_Object buffer, start, end; +*/ + (buffer, start, end)) { /* This function can GC */ Bufpos b, e; @@ -1523,8 +1479,7 @@ return Qnil; } -DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings, - 6, 6, 0 /* +DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /* Compare two substrings of two buffers; return result as number. the value is -N if first string is less after N-1 chars, +N if first string is greater after N-1 chars, or 0 if strings match. @@ -1533,9 +1488,8 @@ The value of `case-fold-search' in the current buffer determines whether case is significant or ignored. -*/ ) - (buffer1, start1, end1, buffer2, start2, end2) - Lisp_Object buffer1, start1, end1, buffer2, start2, end2; +*/ + (buffer1, start1, end1, buffer2, start2, end2)) { Bufpos begp1, endp1, begp2, endp2; REGISTER Charcount len1, len2, length, i; @@ -1600,14 +1554,12 @@ return Qnil; } -DEFUN ("subst-char-in-region", Fsubst_char_in_region, - Ssubst_char_in_region, 4, 5, 0 /* +DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /* From START to END, replace FROMCHAR with TOCHAR each time it occurs. If optional arg NOUNDO is non-nil, don't record this change for undo and don't mark the buffer as really changed. -*/ ) - (start, end, fromchar, tochar, noundo) - Lisp_Object start, end, fromchar, tochar, noundo; +*/ + (start, end, fromchar, tochar, noundo)) { /* This function can GC */ Bufpos pos, stop; @@ -1667,15 +1619,12 @@ return Qnil; } -DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0 /* +DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /* From START to END, translate characters according to TABLE. TABLE is a string; the Nth character in it is the mapping for the character with code N. Returns the number of characters changed. -*/ ) - (start, end, table) - Lisp_Object start; - Lisp_Object end; - Lisp_Object table; +*/ + (start, end, table)) { /* This function can GC */ Bufpos pos, stop; /* Limits of the region. */ @@ -1711,14 +1660,13 @@ return make_int (cnt); } -DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 3, "r" /* +DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /* 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. If BUFFER is nil, the current buffer is assumed. -*/ ) - (b, e, buffer) - Lisp_Object b, e, buffer; +*/ + (b, e, buffer)) { /* This function can GC */ Bufpos start, end; @@ -1753,13 +1701,12 @@ } } -DEFUN ("widen", Fwiden, Swiden, 0, 1, "" /* +DEFUN ("widen", Fwiden, 0, 1, "", /* Remove restrictions (narrowing) from BUFFER. This allows the buffer's full text to be seen and edited. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 1); widen_buffer (b, 0); @@ -1767,7 +1714,7 @@ return Qnil; } -DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 3, "r" /* +DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /* Restrict editing in BUFFER to the current region. The rest of the text becomes temporarily invisible and untouchable but is not deleted; if you save the buffer in a file, the invisible @@ -1777,9 +1724,8 @@ When calling from a program, pass two arguments; positions (integers or markers) bounding the text that should remain visible. -*/ ) - (b, e, buffer) - Lisp_Object b, e, buffer; +*/ + (b, e, buffer)) { Bufpos start, end; struct buffer *buf = decode_buffer (buffer, 1); @@ -1875,7 +1821,7 @@ return Qnil; } -DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0 /* +DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /* Execute BODY, saving and restoring current buffer's restrictions. The buffer's restrictions make parts of the beginning and end invisible. \(They are set up with `narrow-to-region' and eliminated with `widen'.) @@ -1893,9 +1839,8 @@ Note: if you are using both `save-excursion' and `save-restriction', use `save-excursion' outermost: (save-excursion (save-restriction ...)) -*/ ) - (body) - Lisp_Object body; +*/ + (body)) { /* This function can GC */ int speccount = specpdl_depth (); @@ -1906,7 +1851,7 @@ } -DEFUN ("format", Fformat, Sformat, 1, MANY, 0 /* +DEFUN ("format", Fformat, 1, MANY, 0, /* Format a string out of a control-string and arguments. The first argument is a control string. The other arguments are substituted into it to make the result, a string. @@ -1958,10 +1903,8 @@ %g and %G conversions. Use %% to put a single % into the output. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* It should not be necessary to GCPRO ARGS, because the caller in the interpreter should take care of that. */ @@ -1971,14 +1914,13 @@ } -DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 3, 0 /* +DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /* Return t if two characters match, optionally ignoring case. Both arguments must be characters (i.e. integers). Case is ignored if `case-fold-search' is non-nil in BUFFER. If BUFFER is nil, the current buffer is assumed. -*/ ) - (c1, c2, buffer) - Lisp_Object c1, c2, buffer; +*/ + (c1, c2, buffer)) { Emchar x1, x2; struct buffer *buf = decode_buffer (buffer, 1); @@ -2060,7 +2002,7 @@ #endif -DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0 /* +DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /* Transpose region START1 to END1 with START2 to END2. The regions may not be overlapping, because the size of the buffer is never changed in a transposition. @@ -2070,9 +2012,8 @@ this function always acts as if LEAVE_MARKERS is non-nil.) Transposing beyond buffer boundaries is an error. -*/ ) - (startr1, endr1, startr2, endr2, leave_markers) - Lisp_Object startr1, endr1, startr2, endr2, leave_markers; +*/ + (startr1, endr1, startr2, endr2, leave_markers)) { Bufpos start1, end1, start2, end2; Charcount len1, len2; @@ -2119,63 +2060,63 @@ defsymbol (&Qregion_end, "region-end"); defsymbol (&Qformat, "format"); - defsubr (&Schar_equal); - defsubr (&Sgoto_char); - defsubr (&Sstring_to_char); - defsubr (&Schar_to_string); - defsubr (&Sbuffer_substring); + DEFSUBR (Fchar_equal); + DEFSUBR (Fgoto_char); + DEFSUBR (Fstring_to_char); + DEFSUBR (Fchar_to_string); + DEFSUBR (Fbuffer_substring); - defsubr (&Spoint_marker); - defsubr (&Smark_marker); - defsubr (&Spoint); - defsubr (&Sregion_beginning); - defsubr (&Sregion_end); - defsubr (&Ssave_excursion); + DEFSUBR (Fpoint_marker); + DEFSUBR (Fmark_marker); + DEFSUBR (Fpoint); + DEFSUBR (Fregion_beginning); + DEFSUBR (Fregion_end); + DEFSUBR (Fsave_excursion); - defsubr (&Sbufsize); - defsubr (&Spoint_max); - defsubr (&Spoint_min); - defsubr (&Spoint_min_marker); - defsubr (&Spoint_max_marker); + DEFSUBR (Fbufsize); + DEFSUBR (Fpoint_max); + DEFSUBR (Fpoint_min); + DEFSUBR (Fpoint_min_marker); + DEFSUBR (Fpoint_max_marker); - defsubr (&Sbobp); - defsubr (&Seobp); - defsubr (&Sbolp); - defsubr (&Seolp); - defsubr (&Sfollowing_char); - defsubr (&Spreceding_char); - defsubr (&Schar_after); - defsubr (&Sinsert); - defsubr (&Sinsert_string); - defsubr (&Sinsert_before_markers); - defsubr (&Sinsert_char); + DEFSUBR (Fbobp); + DEFSUBR (Feobp); + DEFSUBR (Fbolp); + DEFSUBR (Feolp); + DEFSUBR (Ffollowing_char); + DEFSUBR (Fpreceding_char); + DEFSUBR (Fchar_after); + DEFSUBR (Finsert); + DEFSUBR (Finsert_string); + DEFSUBR (Finsert_before_markers); + DEFSUBR (Finsert_char); - defsubr (&Suser_login_name); - defsubr (&Suser_real_login_name); - defsubr (&Suser_uid); - defsubr (&Suser_real_uid); - defsubr (&Suser_full_name); - defsubr (&Semacs_pid); - defsubr (&Scurrent_time); - defsubr (&Scurrent_process_time); - defsubr (&Sformat_time_string); - defsubr (&Sdecode_time); - defsubr (&Sencode_time); - defsubr (&Scurrent_time_string); - defsubr (&Scurrent_time_zone); - defsubr (&Sset_time_zone_rule); - defsubr (&Ssystem_name); - defsubr (&Sformat); + DEFSUBR (Fuser_login_name); + DEFSUBR (Fuser_real_login_name); + DEFSUBR (Fuser_uid); + DEFSUBR (Fuser_real_uid); + DEFSUBR (Fuser_full_name); + DEFSUBR (Femacs_pid); + DEFSUBR (Fcurrent_time); + DEFSUBR (Fcurrent_process_time); + DEFSUBR (Fformat_time_string); + DEFSUBR (Fdecode_time); + DEFSUBR (Fencode_time); + DEFSUBR (Fcurrent_time_string); + DEFSUBR (Fcurrent_time_zone); + DEFSUBR (Fset_time_zone_rule); + DEFSUBR (Fsystem_name); + DEFSUBR (Fformat); - defsubr (&Sinsert_buffer_substring); - defsubr (&Scompare_buffer_substrings); - defsubr (&Ssubst_char_in_region); - defsubr (&Stranslate_region); - defsubr (&Sdelete_region); - defsubr (&Swiden); - defsubr (&Snarrow_to_region); - defsubr (&Ssave_restriction); - defsubr (&Stranspose_regions); + DEFSUBR (Finsert_buffer_substring); + DEFSUBR (Fcompare_buffer_substrings); + DEFSUBR (Fsubst_char_in_region); + DEFSUBR (Ftranslate_region); + DEFSUBR (Fdelete_region); + DEFSUBR (Fwiden); + DEFSUBR (Fnarrow_to_region); + DEFSUBR (Fsave_restriction); + DEFSUBR (Ftranspose_regions); defsymbol (&Qzmacs_update_region, "zmacs-update-region"); defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
--- a/src/elhash.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/elhash.c Mon Aug 13 08:50:05 2007 +0200 @@ -176,11 +176,10 @@ } -DEFUN ("hashtablep", Fhashtablep, Shashtablep, 1, 1, 0 /* +DEFUN ("hashtablep", Fhashtablep, 1, 1, 0, /* Return t if OBJ is a hashtable, else nil. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return ((HASHTABLEP (obj)) ? Qt : Qnil); } @@ -311,7 +310,7 @@ return HASHTABLE_EQ; /* not reached */ } -DEFUN ("make-hashtable", Fmake_hashtable, Smake_hashtable, 1, 2, 0 /* +DEFUN ("make-hashtable", Fmake_hashtable, 1, 2, 0, /* Make a hashtable of initial size SIZE. Comparison between keys is done with TEST-FUN, which must be one of `eq', `eql', or `equal'. The default is `eql'; i.e. two keys must @@ -320,21 +319,19 @@ See also `make-weak-hashtable', `make-key-weak-hashtable', and `make-value-weak-hashtable'. -*/ ) - (size, test_fun) - Lisp_Object size, test_fun; +*/ + (size, test_fun)) { CHECK_NATNUM (size); return make_lisp_hashtable (XINT (size), HASHTABLE_NONWEAK, decode_hashtable_test_fun (test_fun)); } -DEFUN ("copy-hashtable", Fcopy_hashtable, Scopy_hashtable, 1, 1, 0 /* +DEFUN ("copy-hashtable", Fcopy_hashtable, 1, 1, 0, /* Make a new hashtable which contains the same keys and values as the given table. The keys and values will not themselves be copied. -*/ ) - (old_table) - Lisp_Object old_table; +*/ + (old_table)) { struct _C_hashtable old_htbl; struct _C_hashtable new_htbl; @@ -373,12 +370,11 @@ } -DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0 /* +DEFUN ("gethash", Fgethash, 2, 3, 0, /* Find hash value for KEY in TABLE. If there is no corresponding value, return DEFAULT (defaults to nil). -*/ ) - (key, table, defalt) - Lisp_Object key, table, defalt; /* One can't even spell correctly in C */ +*/ + (key, table, defalt)) { CONST void *vval; struct _C_hashtable htbl; @@ -396,11 +392,10 @@ } -DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0 /* +DEFUN ("remhash", Fremhash, 2, 2, 0, /* Remove hash value for KEY in TABLE. -*/ ) - (key, table) - Lisp_Object key, table; +*/ + (key, table)) { struct _C_hashtable htbl; CHECK_HASHTABLE (table); @@ -412,11 +407,10 @@ } -DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0 /* +DEFUN ("puthash", Fputhash, 3, 3, 0, /* Hash KEY to VAL in TABLE. -*/ ) - (key, val, table) - Lisp_Object key, val, table; +*/ + (key, val, table)) { struct hashtable_struct *ht; void *vkey = LISP_TO_VOID (key); @@ -439,11 +433,10 @@ return (val); } -DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0 /* +DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* Flush TABLE. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { struct _C_hashtable htbl; CHECK_HASHTABLE (table); @@ -453,11 +446,10 @@ return Qnil; } -DEFUN ("hashtable-fullness", Fhashtable_fullness, Shashtable_fullness, 1, 1, 0 /* +DEFUN ("hashtable-fullness", Fhashtable_fullness, 1, 1, 0, /* Return number of entries in TABLE. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { struct _C_hashtable htbl; CHECK_HASHTABLE (table); @@ -506,12 +498,11 @@ } -DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0 /* +DEFUN ("maphash", Fmaphash, 2, 2, 0, /* Map FUNCTION over entries in TABLE, calling it with two args, each key and value in the table. -*/ ) - (function, table) - Lisp_Object function, table; +*/ + (function, table)) { struct _C_hashtable htbl; struct gcpro gcpro1, gcpro2; @@ -567,8 +558,7 @@ -DEFUN ("make-weak-hashtable", Fmake_weak_hashtable, Smake_weak_hashtable, - 1, 2, 0 /* +DEFUN ("make-weak-hashtable", Fmake_weak_hashtable, 1, 2, 0, /* Make a fully weak hashtable of initial size SIZE. A weak hashtable is one whose pointers do not count as GC referents: for any key-value pair in the hashtable, if the only remaining pointer @@ -579,43 +569,38 @@ You can also create semi-weak hashtables; see `make-key-weak-hashtable' and `make-value-weak-hashtable'. -*/ ) - (size, test_fun) - Lisp_Object size, test_fun; +*/ + (size, test_fun)) { CHECK_NATNUM (size); return make_lisp_hashtable (XINT (size), HASHTABLE_WEAK, decode_hashtable_test_fun (test_fun)); } -DEFUN ("make-key-weak-hashtable", Fmake_key_weak_hashtable, - Smake_key_weak_hashtable, 1, 2, 0 /* +DEFUN ("make-key-weak-hashtable", Fmake_key_weak_hashtable, 1, 2, 0, /* Make a key-weak hashtable of initial size SIZE. A key-weak hashtable is similar to a fully-weak hashtable (see `make-weak-hashtable') except that a key-value pair will be removed only if the key remains unmarked outside of weak hashtables. The pair will remain in the hashtable if the key is pointed to by something other than a weak hashtable, even if the value is not. -*/ ) - (size, test_fun) - Lisp_Object size, test_fun; +*/ + (size, test_fun)) { CHECK_NATNUM (size); return make_lisp_hashtable (XINT (size), HASHTABLE_KEY_WEAK, decode_hashtable_test_fun (test_fun)); } -DEFUN ("make-value-weak-hashtable", Fmake_value_weak_hashtable, - Smake_value_weak_hashtable, 1, 2, 0 /* +DEFUN ("make-value-weak-hashtable", Fmake_value_weak_hashtable, 1, 2, 0, /* Make a value-weak hashtable of initial size SIZE. A value-weak hashtable is similar to a fully-weak hashtable (see `make-weak-hashtable') except that a key-value pair will be removed only if the value remains unmarked outside of weak hashtables. The pair will remain in the hashtable if the value is pointed to by something other than a weak hashtable, even if the key is not. -*/ ) - (size, test_fun) - Lisp_Object size, test_fun; +*/ + (size, test_fun)) { CHECK_NATNUM (size); return make_lisp_hashtable (XINT (size), HASHTABLE_VALUE_WEAK, @@ -888,18 +873,18 @@ void syms_of_elhash (void) { - defsubr (&Smake_hashtable); - defsubr (&Scopy_hashtable); - defsubr (&Shashtablep); - defsubr (&Sgethash); - defsubr (&Sputhash); - defsubr (&Sremhash); - defsubr (&Sclrhash); - defsubr (&Smaphash); - defsubr (&Shashtable_fullness); - defsubr (&Smake_weak_hashtable); - defsubr (&Smake_key_weak_hashtable); - defsubr (&Smake_value_weak_hashtable); + DEFSUBR (Fmake_hashtable); + DEFSUBR (Fcopy_hashtable); + DEFSUBR (Fhashtablep); + DEFSUBR (Fgethash); + DEFSUBR (Fputhash); + DEFSUBR (Fremhash); + DEFSUBR (Fclrhash); + DEFSUBR (Fmaphash); + DEFSUBR (Fhashtable_fullness); + DEFSUBR (Fmake_weak_hashtable); + DEFSUBR (Fmake_key_weak_hashtable); + DEFSUBR (Fmake_value_weak_hashtable); defsymbol (&Qhashtablep, "hashtablep"); }
--- a/src/emacs.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/emacs.c Mon Aug 13 08:50:05 2007 +0200 @@ -64,6 +64,12 @@ extern void memory_warnings (void *, void (*warnfun) (CONST char *)); +#ifndef SYSTEM_MALLOC +extern void *(*__malloc_hook)(size_t); +extern void *(*__realloc_hook)(void *, size_t); +extern void (*__free_hook)(void *); +#endif /* not SYSTEM_MALLOC */ + /* Command line args from shell, as list of strings */ Lisp_Object Vcommand_line_args; @@ -336,19 +342,19 @@ Vcommand_line_args = make_arg_list_1 (argc, argv, skip_args); } -DEFUN ("invocation-name", Finvocation_name, Sinvocation_name, 0, 0, 0 /* +DEFUN ("invocation-name", Finvocation_name, 0, 0, 0, /* Return the program name that was used to run XEmacs. Any directory names are omitted. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vinvocation_name); } -DEFUN ("invocation-directory", Finvocation_directory, Sinvocation_directory, 0, 0, 0 /* +DEFUN ("invocation-directory", Finvocation_directory, 0, 0, 0, /* Return the directory name in which the Emacs executable was located. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vinvocation_directory); } @@ -431,12 +437,21 @@ int skip_args = 0; Lisp_Object load_me; int inhibit_window_system; +#ifdef NeXT + extern int malloc_cookie; +#endif + +#ifndef SYSTEM_MALLOC + /* Make sure that any libraries we link against haven't installed a + hook for a gmalloc of a potentially incompatible version. */ + __malloc_hook = NULL; + __realloc_hook = NULL; + __free_hook = NULL; +#endif /* not SYSTEM_MALLOC */ noninteractive = 0; #ifdef NeXT - extern int malloc_cookie; - /* 19-Jun-1995 -baw * NeXT secret magic, ripped from Emacs-for-NS by Carl Edman * <cedman@princeton.edu>. Note that even Carl doesn't know what this @@ -660,7 +675,7 @@ if the display was specified on the command line. */ if ((dpy = getenv ("DISPLAY")) && dpy[0]) display_use = "x"; - + #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_NEXTSTEP @@ -1392,7 +1407,7 @@ /* NOTREACHED */ } - + /* Sort the args so we can find the most important ones at the beginning of argv. */ @@ -1462,7 +1477,7 @@ { "-reverse", 0, 5, 0 }, { "-hb", "--horizontal-scroll-bars", 5, 0 }, { "-vb", "--vertical-scroll-bars", 5, 0 }, - + /* These have the same priority as ordinary file name args, so they are not reordered with respect to those. */ { "-L", "--directory", 0, 1 }, @@ -1585,7 +1600,7 @@ if (options[from] > 0) from += options[from]; } - + if (best < 0) abort (); @@ -1613,33 +1628,29 @@ extern int gc_in_progress; -DEFUN ("running-temacs-p", - Frunning_temacs_p, Srunning_temacs_p, 0, 0, 0 /* +DEFUN ("running-temacs-p", Frunning_temacs_p, 0, 0, 0, /* True if running temacs. This means we are in the dumping stage. This is false during normal execution of the `xemacs' program, and becomes false once `run-emacs-from-temacs' is run. -*/ ) - () +*/ + ()) { return run_temacs_argc >= 0 ? Qt : Qnil; } -DEFUN ("run-emacs-from-temacs", - Frun_emacs_from_temacs, Srun_emacs_from_temacs, 0, MANY, 0 /* +DEFUN ("run-emacs-from-temacs", Frun_emacs_from_temacs, 0, MANY, 0, /* Do not call this. It will reinitialize your XEmacs. You'll be sorry. -*/ ) +*/ /* If this function is called from startup.el, it will be possible to run temacs as an editor using 'temacs -batch -l loadup.el run-temacs', instead of having to dump an emacs and then run that (when debugging emacs itself, - this can be much faster). [Actually, the speed difference isn't that + this can be much faster)). [Actually, the speed difference isn't that much as long as your filesystem is local, and you don't end up with a dumped version in case you want to rerun it. This function is most useful when used as part of the `make all-elc' command. --ben] This will \"restart\" emacs with the specified command-line arguments. */ - (nargs, args) - int nargs; - Lisp_Object *args; + (int nargs, Lisp_Object *args)) { int ac; Extbyte *wampum; @@ -1726,12 +1737,12 @@ However, on both my systems environ is a plain old global variable initialized to zero. _environ is the one that contains pointers to the actual environment. - + Since we can't figure out the difference (and we're hours away from a release), this takes a very cowardly approach and is bracketed with both a system specific preprocessor test and a runtime "do you have this problem" test - + 06/20/96 robertl@dgii.com */ { extern char *_environ; @@ -1747,7 +1758,7 @@ } -DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P" /* +DEFUN ("kill-emacs", Fkill_emacs, 0, 1, "P", /* Exit the XEmacs job and kill it. Ask for confirmation, without argument. If ARG is an integer, return ARG as the exit program code. If ARG is a string, stuff it as keyboard input. @@ -1755,9 +1766,8 @@ The value of `kill-emacs-hook', if not void, is a list of functions (of no args), all of which are called before XEmacs is actually killed. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { /* This function can GC */ struct gcpro gcpro1; @@ -1920,12 +1930,11 @@ #ifdef HAVE_SHM -DEFUN ("dump-emacs-data", Fdump_emacs_data, Sdump_emacs_data, 1, 1, 0 /* +DEFUN ("dump-emacs-data", Fdump_emacs_data, 1, 1, 0, /* Dump current state of XEmacs into data file FILENAME. This function exists on systems that use HAVE_SHM. -*/ ) - (intoname) - Lisp_Object intoname; +*/ + (intoname)) { /* This function can GC */ int opurify; @@ -1959,7 +1968,7 @@ #else /* not HAVE_SHM */ -DEFUN ("dump-emacs", Fdump_emacs, Sdump_emacs, 2, 2, 0 /* +DEFUN ("dump-emacs", Fdump_emacs, 2, 2, 0, /* Dump current state of XEmacs into executable file FILENAME. Take symbols from SYMFILE (presumably the file you executed to run XEmacs). This is used in the file `loadup.el' when building XEmacs. @@ -1967,9 +1976,8 @@ Remember to set `command-line-processed' to nil before dumping if you want the dumped XEmacs to process its command line and announce itself normally when it is run. -*/ ) - (intoname, symname) - Lisp_Object intoname, symname; +*/ + (intoname, symname)) { /* This function can GC */ struct gcpro gcpro1, gcpro2; @@ -2099,10 +2107,10 @@ return Fnreverse (lpath); } -DEFUN ("noninteractive", Fnoninteractive, Snoninteractive, 0, 0, 0 /* +DEFUN ("noninteractive", Fnoninteractive, 0, 0, 0, /* Non-nil return value means XEmacs is running without interactive terminal. -*/ ) - () +*/ + ()) { return ((noninteractive) ? Qt : Qnil); } @@ -2128,31 +2136,30 @@ #endif /* USE_ASSERTIONS */ #ifdef QUANTIFY -DEFUN ("quantify-start-recording-data", Fquantify_start_recording_data, - Squantify_start_recording_data, 0, 0, 0 /* +DEFUN ("quantify-start-recording-data", + Fquantify_start_recording_data, 0, 0, 0, /* Start recording Quantify data. -*/) - () +*/ + ()) { quantify_start_recording_data (); return Qnil; } -DEFUN ("quantify-stop-recording-data", Fquantify_stop_recording_data, - Squantify_stop_recording_data, 0, 0, 0 /* +DEFUN ("quantify-stop-recording-data", + Fquantify_stop_recording_data, 0, 0, 0, /* Stop recording Quantify data. -*/) - () +*/ + ()) { quantify_stop_recording_data (); return Qnil; } -DEFUN ("quantify-clear-data", Fquantify_clear_data, - Squantify_clear_data, 0, 0, 0 /* +DEFUN ("quantify-clear-data", Fquantify_clear_data, 0, 0, 0, /* Clear all Quantify data. -*/) - () +*/ + ()) { quantify_clear_data (); return Qnil; @@ -2164,23 +2171,23 @@ { #ifndef CANNOT_DUMP #ifdef HAVE_SHM - defsubr (&Sdump_emacs_data); + DEFSUBR (Fdump_emacs_data); #else - defsubr (&Sdump_emacs); + DEFSUBR (Fdump_emacs); #endif #endif /* !CANNOT_DUMP */ - defsubr (&Srun_emacs_from_temacs); - defsubr (&Srunning_temacs_p); - defsubr (&Sinvocation_name); - defsubr (&Sinvocation_directory); - defsubr (&Skill_emacs); - defsubr (&Snoninteractive); + DEFSUBR (Frun_emacs_from_temacs); + DEFSUBR (Frunning_temacs_p); + DEFSUBR (Finvocation_name); + DEFSUBR (Finvocation_directory); + DEFSUBR (Fkill_emacs); + DEFSUBR (Fnoninteractive); #ifdef QUANTIFY - defsubr (&Squantify_start_recording_data); - defsubr (&Squantify_stop_recording_data); - defsubr (&Squantify_clear_data); + DEFSUBR (Fquantify_start_recording_data); + DEFSUBR (Fquantify_stop_recording_data); + DEFSUBR (Fquantify_clear_data); #endif /* QUANTIFY */ defsymbol (&Qkill_emacs_hook, "kill-emacs-hook");
--- a/src/energize.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/energize.c Mon Aug 13 08:50:05 2007 +0200 @@ -943,23 +943,19 @@ #endif /* !I18N4 */ -DEFUN ("energize-update-menubar", Fenergize_update_menubar, - Senergize_update_menubar, 0, 1, 0 /* +DEFUN ("energize-update-menubar", Fenergize_update_menubar, 0, 1, 0, /* obsolete -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return Qnil; } -DEFUN ("energize-extent-menu-p", Fenergize_extent_menu_p, - Senergize_extent_menu_p, 1, 1, 0 /* +DEFUN ("energize-extent-menu-p", Fenergize_extent_menu_p, 1, 1, 0, /* Whether the extent has a set of commands defined by Energize. -*/ ) - (extent_obj) - Lisp_Object extent_obj; +*/ + (extent_obj)) { CHECK_EXTENT (extent_obj); @@ -2478,8 +2474,7 @@ return NILP (only_name) ? item_list : item; } -DEFUN ("energize-list-menu", Fenergize_list_menu, - Senergize_list_menu, 3, 4, 0 /* +DEFUN ("energize-list-menu", Fenergize_list_menu, 3, 4, 0, /* Request the set of menu options from the Energize server that are appropriate to the buffer and the extent. Extent can be (), in which case the options are requested for the whole buffer. Selection-p tells @@ -2491,9 +2486,8 @@ where <itemI> is (name id1 id2 flags); idI is (high . low). If optional argument only-name is provided only the item with name only-name is returned, or () if no such item exists. -*/ ) - (buffer, extent_obj, selection_p, only_name) - Lisp_Object buffer, extent_obj, selection_p, only_name; +*/ + (buffer, extent_obj, selection_p, only_name)) { Lisp_Object res; CHECK_BUFFER (buffer); @@ -2509,17 +2503,15 @@ return res; } -DEFUN ("energize-execute-menu-item", Fenergize_execute_menu_item, - Senergize_execute_menu_item, 3, 5, 0 /* +DEFUN ("energize-execute-menu-item", Fenergize_execute_menu_item, 3, 5, 0, /* Item is a vector received by energize-list-menu. Sends a request to execute the code associated to this menu inside the Energize server. Optional fourth argument is a string or a vector to be used as the selection for entry disabled because they need the selection. Optional fifth argument, if non NIL, tells Energize to not request confirmation before executing the command. -*/ ) -(buffer, extent_obj, item, selection, no_confirm) -Lisp_Object buffer, extent_obj, item, selection, no_confirm; +*/ + (buffer, extent_obj, item, selection, no_confirm)) { struct Lisp_Vector *v; @@ -2543,8 +2535,8 @@ return Qt; } -DEFUN ("energize-execute-command-internal", Fenergize_execute_command_internal, - Senergize_execute_command_internal, 3, 5, 0 /* +DEFUN ("energize-execute-command-internal", + Fenergize_execute_command_internal, 3, 5, 0, /* Command is a string naming an energize command. Sends a request to execute this command inside the Energize server. Optional fourth argument is a string or a vector to be used as the selection. @@ -2552,9 +2544,8 @@ confirmation before executing the command. See also 'energize-list-menu'. -*/ ) - (buffer, extent_obj, command, selection, no_confirm) - Lisp_Object buffer, extent_obj, command, selection, no_confirm; +*/ + (buffer, extent_obj, command, selection, no_confirm)) { if (!energize_connection || !energize_connection->conn) return Qnil; @@ -2570,14 +2561,11 @@ /********************************* kill buffer interface ****************/ -DEFUN ("energize-buffer-type-internal", - Fenergize_buffer_type, Senergize_buffer_type, - 1, 1, 0 /* +DEFUN ("energize-buffer-type-internal", Fenergize_buffer_type, 1, 1, 0, /* Return a symbol denoting the buffer type if buffer is an Energize buffer, else it returns NIL. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { if (!energize_connection) return Qnil; @@ -2585,14 +2573,11 @@ return get_buffer_type_for_emacs_buffer (buffer, energize_connection); } -DEFUN ("set-energize-buffer-type-internal", - Fset_energize_buffer_type_internal, - Sset_energize_buffer_type_internal, 2, 2, 0 /* +DEFUN ("set-energize-buffer-type-internal", Fset_energize_buffer_type_internal, 2, 2, 0, /* Return the type symbol which is the new buffer-type, if the buffer is an Energize buffer and the type is non-NIL symbol, else it returns NIL. -*/ ) - (buffer, type) - Lisp_Object buffer, type; +*/ + (buffer, type)) { BufferInfo *binfo; @@ -2609,11 +2594,10 @@ set_buffer_type_for_emacs_buffer (buffer, energize_connection, type); } -DEFUN ("energize-buffer-p", Fenergize_buffer_p, Senergize_buffer_p, 1, 1, 0 /* +DEFUN ("energize-buffer-p", Fenergize_buffer_p, 1, 1, 0, /* Whether buffer is an Energize buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { BufferInfo *binfo; @@ -2627,11 +2611,10 @@ return Qt; } -DEFUN ("energize-buffer-id", Fenergize_buffer_id, Senergize_buffer_id, 1, 1, 0 /* +DEFUN ("energize-buffer-id", Fenergize_buffer_id, 1, 1, 0, /* Return (high . low) if buffer is an Energize buffer, otherwise nil. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { BufferInfo *binfo; @@ -2645,12 +2628,10 @@ return word_to_lisp (binfo->id); } -DEFUN ("energize-request-kill-buffer", Fenergize_request_kill_buffer, - Senergize_request_kill_buffer, 1, 1, 0 /* +DEFUN ("energize-request-kill-buffer", Fenergize_request_kill_buffer, 1, 1, 0, /* Sends a request to energize for killing buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { BufferInfo *binfo; @@ -3747,13 +3728,10 @@ return conn; } -DEFUN ("handle-energize-request", Fhandle_energize_request, - Shandle_energize_request, - 2, 2, 0 /* +DEFUN ("handle-energize-request", Fhandle_energize_request, 2, 2, 0, /* Filter called when a request is available from Energize. -*/ ) - (proc, string) - Lisp_Object proc, string; +*/ + (proc, string)) { if (!NILP (string)) CHECK_STRING (string); @@ -3837,7 +3815,7 @@ #endif abort (); - XSETSUBR (fil, &Shandle_energize_request); + XSETSUBR (fil, &SFhandle_energize_request); set_process_filter (lp, fil, 1); Venergize_kernel_busy = Qnil; @@ -3932,16 +3910,13 @@ } -DEFUN ("connect-to-energize-internal", - Fconnect_to_energize_internal, Sconnect_to_energize_internal, 0, 2, 0 /* +DEFUN ("connect-to-energize-internal", Fconnect_to_energize_internal, 0, 2, 0, /* Usage: (connect-to-energize-internal <server-name> <energizearg>) Energizearg representing two 32 bit Energize ids that will be passed to the Energize server when opening the Energize connection. Only one connection can be open at a time. -*/ ) - - (server_name, energize_arg) - Lisp_Object server_name, energize_arg; +*/ + (server_name, energize_arg)) { unsigned char *server; unsigned char *arg; @@ -3970,11 +3945,10 @@ return Qnil; } -DEFUN ("close-connection-to-energize", Fclose_connection_to_energize, - Sclose_connection_to_energize, 0, 0, 0 /* +DEFUN ("close-connection-to-energize", Fclose_connection_to_energize, 0, 0, 0, /* Close the open Energize connection, if any. -*/ ) - () +*/ + ()) { if (!energize_connection) return Qnil; @@ -4126,12 +4100,10 @@ set_extent_attributes_index (extent, ext); } -DEFUN ("extent-to-generic-id", Fextent_to_generic_id, Sextent_to_generic_id, - 1, 1, 0 /* +DEFUN ("extent-to-generic-id", Fextent_to_generic_id, 1, 1, 0, /* Return Energize ID of buffer of EXTENT. -*/ ) - (extent_obj) - Lisp_Object extent_obj; +*/ + (extent_obj)) { CHECK_EXTENT (extent_obj); return word_to_lisp (energize_extent_data_id @@ -4365,13 +4337,10 @@ /* Send the BufferModified events for the current buffer. * Handles both global buffer modified and extents modified. */ -DEFUN ("energize-send-buffer-modified", Fenergize_send_buffer_modified, - Senergize_send_buffer_modified, - 3, 3, 0 /* +DEFUN ("energize-send-buffer-modified", Fenergize_send_buffer_modified, 3, 3, 0, /* Send a BufferModified request for the current buffer. -*/ ) - (state, from, to) - Lisp_Object state, from, to; /* dont use ANSI arglists in DEFUNs */ +*/ + (state, from, to)) { int modifiedp = NILP (state)? 0 : 1; Lisp_Object buffer; @@ -4422,11 +4391,11 @@ return Qnil; } -DEFUN ("energize-barf-if-buffer-locked", Fenergize_barf_if_buffer_locked, - Senergize_barf_if_buffer_locked, 0, 0, 0 /* +DEFUN ("energize-barf-if-buffer-locked", + Fenergize_barf_if_buffer_locked, 0, 0, 0, /* Error if the buffer is locked. -*/ ) - () +*/ + ()) { Lisp_Object buffer; XSETBUFFER (buffer, current_buffer); @@ -4443,13 +4412,10 @@ } -DEFUN ("energize-send-region", Fenergize_send_region, - Senergize_send_region, - 2, 2, 0 /* +DEFUN ("energize-send-region", Fenergize_send_region, 2, 2, 0, /* Send region as user input -*/ ) - (start, end) - Lisp_Object start, end; +*/ + (start, end)) { BufferInfo *binfo; Lisp_Object b; @@ -4485,12 +4451,10 @@ return Qnil; } -DEFUN ("connected-to-energize-p", Fconnected_to_energize_p, - Sconnected_to_energize_p, - 0, 0, 0 /* +DEFUN ("connected-to-energize-p", Fconnected_to_energize_p, 0, 0, 0, /* Return nil if no connection to Energize. -*/ ) - () +*/ + ()) { if (!energize_connection || !energize_connection->conn || @@ -4501,12 +4465,11 @@ return Qt; } -DEFUN ("energize-user-input-buffer-mark", Fenergize_user_input_buffer_mark, - Senergize_user_input_buffer_mark, 0, 1, 0 /* +DEFUN ("energize-user-input-buffer-mark", + Fenergize_user_input_buffer_mark, 0, 1, 0, /* Return the mark associated to the given Energize buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { BufferInfo *binfo; @@ -4590,15 +4553,13 @@ } } -DEFUN ("energize-query-buffer", Fenergize_query_buffer, - Senergize_query_buffer, 1, 2, 0 /* +DEFUN ("energize-query-buffer", Fenergize_query_buffer, 1, 2, 0, /* Ask Energize to create a buffer containing the file filename. Returns the buffer or NIL if Energize cannot create the buffer. If second argument just-ask is T, just ask if Energize already knows about the file and returns T if yes, NIL otherwise. -*/ ) - (filename, just_ask) - Lisp_Object filename, just_ask; +*/ + (filename, just_ask)) { struct Lisp_String *filename_str; CEditorRequest *creq; @@ -4645,11 +4606,10 @@ } -DEFUN ("energize-protocol-level", Fenergize_protocol_level, - Senergize_protocol_level, 0, 0, 0 /* +DEFUN ("energize-protocol-level", Fenergize_protocol_level, 0, 0, 0, /* Return the Energize protocol level. -*/ ) - () +*/ + ()) { return energize_connection @@ -4659,12 +4619,10 @@ } -DEFUN ("energize-psheets-visible-p", Fenergize_psheets_visible_p, - Senergize_psheets_visible_p, 0, 1, 0 /* +DEFUN ("energize-psheets-visible-p", Fenergize_psheets_visible_p, 0, 1, 0, /* Whether the (optional) frame currently has open psheets. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { if (NILP (frame)) XSETFRAME (frame, XFRAME(Fselected_frame(Qnil))); @@ -4674,12 +4632,10 @@ return Qnil; } -DEFUN ("energize-buffer-has-psheets-p", Fenergize_buffer_has_psheets_p, - Senergize_buffer_has_psheets_p, 0, 1, 0 /* +DEFUN ("energize-buffer-has-psheets-p", Fenergize_buffer_has_psheets_p, 0, 1, 0, /* Whether the buffer has psheets associated with it. -*/ ) - (buf) - Lisp_Object buf; +*/ + (buf)) { int count; if (NILP (buf)) @@ -4736,11 +4692,10 @@ /* This function is invoked when the user clicks on the "sheet" button. */ -DEFUN ("energize-toggle-psheet", Fenergize_toggle_psheet, - Senergize_toggle_psheet, 0, 0, "" /* - -*/ ) - () +DEFUN ("energize-toggle-psheet", Fenergize_toggle_psheet, 0, 0, "", /* + +*/ + ()) { struct frame *frame = XFRAME(Fselected_frame(Qnil)); Lisp_Object buffer = Fwindow_buffer (Fselected_window (Qnil)); @@ -4995,12 +4950,10 @@ extern LWLIB_ID new_lwlib_id (void); -DEFUN ("energize-edit-mode-prompt", Fenergize_edit_mode_prompt, - Senergize_edit_mode_prompt, 6, 6, 0 /* - -*/ ) - (external, edit_mode, view_mode, other_text, window, split) - Lisp_Object external, edit_mode, view_mode, other_text, window, split; +DEFUN ("energize-edit-mode-prompt", Fenergize_edit_mode_prompt, 6, 6, 0, /* + +*/ + (external, edit_mode, view_mode, other_text, window, split)) { int dbox_id; struct frame *f = selected_frame (); @@ -5238,10 +5191,10 @@ } -DEFUN ("energize-search", Fenergize_search, Senergize_search, 0, 0, "" /* +DEFUN ("energize-search", Fenergize_search, 0, 0, "", /* Pop up the search-and-replace dialog box. -*/ ) - () +*/ + ()) { int dbox_id; struct frame *f = selected_frame (); @@ -5317,32 +5270,32 @@ void syms_of_energize (void) { - defsubr (&Senergize_send_buffer_modified); - defsubr (&Senergize_list_menu); - defsubr (&Senergize_execute_menu_item); - defsubr (&Senergize_execute_command_internal); - defsubr (&Sconnect_to_energize_internal); - defsubr (&Sconnected_to_energize_p); - defsubr (&Sclose_connection_to_energize); - defsubr (&Shandle_energize_request); - defsubr (&Senergize_buffer_p); - defsubr (&Senergize_buffer_type); - defsubr (&Sset_energize_buffer_type_internal); - defsubr (&Senergize_buffer_id); - defsubr (&Senergize_request_kill_buffer); - defsubr (&Senergize_send_region); - defsubr (&Senergize_user_input_buffer_mark); - defsubr (&Senergize_update_menubar); - defsubr (&Senergize_extent_menu_p); - defsubr (&Senergize_query_buffer); - defsubr (&Senergize_barf_if_buffer_locked); - defsubr (&Senergize_psheets_visible_p); - defsubr (&Senergize_buffer_has_psheets_p); - defsubr (&Senergize_toggle_psheet); - defsubr (&Senergize_protocol_level); - defsubr (&Senergize_edit_mode_prompt); - defsubr (&Senergize_search); - defsubr (&Sextent_to_generic_id); + DEFSUBR (Fenergize_send_buffer_modified); + DEFSUBR (Fenergize_list_menu); + DEFSUBR (Fenergize_execute_menu_item); + DEFSUBR (Fenergize_execute_command_internal); + DEFSUBR (Fconnect_to_energize_internal); + DEFSUBR (Fconnected_to_energize_p); + DEFSUBR (Fclose_connection_to_energize); + DEFSUBR (Fhandle_energize_request); + DEFSUBR (Fenergize_buffer_p); + DEFSUBR (Fenergize_buffer_type); + DEFSUBR (Fset_energize_buffer_type_internal); + DEFSUBR (Fenergize_buffer_id); + DEFSUBR (Fenergize_request_kill_buffer); + DEFSUBR (Fenergize_send_region); + DEFSUBR (Fenergize_user_input_buffer_mark); + DEFSUBR (Fenergize_update_menubar); + DEFSUBR (Fenergize_extent_menu_p); + DEFSUBR (Fenergize_query_buffer); + DEFSUBR (Fenergize_barf_if_buffer_locked); + DEFSUBR (Fenergize_psheets_visible_p); + DEFSUBR (Fenergize_buffer_has_psheets_p); + DEFSUBR (Fenergize_toggle_psheet); + DEFSUBR (Fenergize_protocol_level); + DEFSUBR (Fenergize_edit_mode_prompt); + DEFSUBR (Fenergize_search); + DEFSUBR (Fextent_to_generic_id); defsymbol (&Qenergize_create_buffer_hook, "energize-create-buffer-hook"); defsymbol (&Qenergize_buffer_modified_hook, "energize-buffer-modified-hook");
--- a/src/epoch.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/epoch.c Mon Aug 13 08:50:05 2007 +0200 @@ -134,31 +134,28 @@ /* * Epoch equivalent: epoch::resourcep */ -DEFUN ("x-resource-p", Fx_resource_p, Sx_resource_p, 1, 1, 0 /* +DEFUN ("x-resource-p", Fx_resource_p, 1, 1, 0, /* Return non-nil if OBJECT is an X resource object. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (X_RESOURCEP (object) ? Qt : Qnil); } -DEFUN ("x-resource-live-p", Fx_resource_live_p, Sx_resource_live_p, 1, 1, 0 /* +DEFUN ("x-resource-live-p", Fx_resource_live_p, 1, 1, 0, /* Return non-nil if OBJECT is a live X resource object. That means that the X resource's device is live. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (X_RESOURCEP (object) && X_RESOURCE_LIVE_P (XX_RESOURCE (object)) ? Qt : Qnil); } -DEFUN ("x-resource-device", Fx_resource_device, Sx_resource_device, 1, 1, 0 /* +DEFUN ("x-resource-device", Fx_resource_device, 1, 1, 0, /* Return the device that OBJECT (an X resource object) exists on. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { CHECK_LIVE_X_RESOURCE (object); return XX_RESOURCE (object)->device; @@ -167,12 +164,10 @@ /* * Epoch equivalent: epoch::set-resource-type */ -DEFUN ("set-x-resource-type", Fset_x_resource_type, Sset_x_resource_type, - 2, 2, 0 /* +DEFUN ("set-x-resource-type", Fset_x_resource_type, 2, 2, 0, /* Set the type of RESOURCE to TYPE. The new type must be an atom. -*/ ) - (resource, type) - Lisp_Object resource, type; +*/ + (resource, type)) { CHECK_LIVE_X_RESOURCE (resource); CHECK_LIVE_X_RESOURCE (type); @@ -219,13 +214,12 @@ /* * Epoch equivalent: epoch::intern-atom */ -DEFUN ("x-intern-atom", Fx_intern_atom, Sx_intern_atom, 1, 2, 0 /* +DEFUN ("x-intern-atom", Fx_intern_atom, 1, 2, 0, /* Convert a string or symbol into an atom and return as an X resource. Optional argument DEVICE specifies the display connection and defaults to the selected device. -*/ ) - (name, device) - Lisp_Object name, device; +*/ + (name, device)) { Atom atom; struct device *d = decode_x_device (device); @@ -238,11 +232,10 @@ /* * Epoch equivalent: epoch::unintern-atom */ -DEFUN ("x-atom-name", Fx_atom_name, Sx_atom_name, 1, 1, 0 /* +DEFUN ("x-atom-name", Fx_atom_name, 1, 1, 0, /* Return the name of an X atom resource as a string. -*/ ) - (atom) - Lisp_Object atom; +*/ + (atom)) { Lisp_Object val; @@ -260,15 +253,13 @@ /* * Epoch equivalent: epoch::string-to-resource */ -DEFUN ("string-to-x-resource", Fstring_to_x_resource, - Sstring_to_x_resource, 2, 3, 0 /* +DEFUN ("string-to-x-resource", Fstring_to_x_resource, 2, 3, 0, /* Convert a numeric STRING to an X-RESOURCE. STRING is assumed to represent a 32-bit numer value. X-RESOURCE must be an X atom. Optional BASE argument should be a number between 2 and 36, specifying the base for converting STRING. -*/ ) - (string, type, base) - Lisp_Object string, type, base; +*/ + (string, type, base)) { XID xid; struct Lisp_X_Resource *xr; @@ -301,12 +292,10 @@ /* * Epoch equivalent: epoch::resource-to-type */ -DEFUN ("x-resource-to-type", Fx_resource_to_type, Sx_resource_to_type, - 1, 1, 0 /* +DEFUN ("x-resource-to-type", Fx_resource_to_type, 1, 1, 0, /* Return an x-resource of type ATOM whose value is the type of the argument -*/ ) - (resource) - Lisp_Object resource; +*/ + (resource)) { struct Lisp_X_Resource *xr; @@ -337,13 +326,11 @@ /* * Epoch equivalent: epoch::resource-to-string */ -DEFUN ("x-resource-to-string", Fx_resource_to_string, Sx_resource_to_string, - 1, 2, 0 /* +DEFUN ("x-resource-to-string", Fx_resource_to_string, 1, 2, 0, /* Convert the xid of RESOURCE to a numeric string. Optional BASE specifies the base for the conversion (2..36 inclusive) -*/ ) - (resource, base) - Lisp_Object resource, base; +*/ + (resource, base)) { int cbase = 10; @@ -361,13 +348,12 @@ /* * Epoch equivalent: epoch::xid-of-frame */ -DEFUN ("x-id-of-frame", Fx_id_of_frame, Sx_id_of_frame, 0, 1, 0 /* +DEFUN ("x-id-of-frame", Fx_id_of_frame, 0, 1, 0, /* Return the window ID of FRAME as an x-resource. This differs from `x-window-id' in that its return value is an x-resource rather than a string. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_x_frame (frame); @@ -408,13 +394,12 @@ /* * Epoch equivalent: epoch::query-tree */ -DEFUN ("x-query-tree", Fx_query_tree, Sx_query_tree, 0, 1, 0 /* +DEFUN ("x-query-tree", Fx_query_tree, 0, 1, 0, /* Return the portion of the window tree adjacent to FRAME. Return value is the list ( ROOT PARENT . CHILDREN ). The FRAME arg can either be a frame object or an x-resource of type window. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { Window win; Window root, parent, *children; @@ -1032,16 +1017,15 @@ /* * Epoch equivalent: epoch::get-property */ -DEFUN ("x-get-property", Fx_get_property, Sx_get_property, 1, 2, 0 /* +DEFUN ("x-get-property", Fx_get_property, 1, 2, 0, /* Retrieve the X window property for a frame. Arguments are PROPERTY: must be a string or an X-resource of type ATOM. FRAME: (optional) If present, must be a frame object, a frame id, or and X-resource of type WINDOW. Defaults to the current frame. Returns the value of the property, or nil if the property couldn't be retrieved. -*/ ) - (name, frame) - Lisp_Object name, frame; +*/ + (name, frame)) { Atom prop = None; Lisp_Object device; @@ -1103,14 +1087,13 @@ return value; } -DEFUN ("x-set-property", Fx_set_property, Sx_set_property, 2, 3, 0 /* +DEFUN ("x-set-property", Fx_set_property, 2, 3, 0, /* Set a named property for a frame. The first argument (required) is the name of the property. The second is the value to set the propery to. The third (optional) is the frame, default is the current frame. -*/ ) - (name, value, frame) - Lisp_Object name, value, frame; +*/ + (name, value, frame)) { Atom prop = None; /* name of the property */ Lisp_Object device; @@ -1151,14 +1134,12 @@ /* * Epoch equivalent: epoch::send-client-message */ -DEFUN ("x-send-client-message", Fx_send_client_message, Sx_send_client_message, - 1, 5, 0 /* +DEFUN ("x-send-client-message", Fx_send_client_message, 1, 5, 0, /* Send a client message to DEST, marking it as being from SOURCE. The message is DATA of TYPE with FORMAT. If TYPE and FORMAT are omitted, they are deduced from DATA. If SOURCE is nil, the current frame is used. -*/ ) - (dest, source, data, type, format) - Lisp_Object dest, source, data, type, format; +*/ + (dest, source, data, type, format)) { /* !!#### This function has not been Mule-ized */ int actual_format = 0; @@ -1343,20 +1324,20 @@ void syms_of_epoch (void) { - defsubr (&Sx_intern_atom); - defsubr (&Sx_atom_name); - defsubr (&Sstring_to_x_resource); - defsubr (&Sx_resource_to_type); - defsubr (&Sx_resource_to_string); - defsubr (&Sx_id_of_frame); - defsubr (&Sx_query_tree); - defsubr (&Sx_get_property); - defsubr (&Sx_set_property); - defsubr (&Sx_send_client_message); - defsubr (&Sx_resource_p); - defsubr (&Sx_resource_device); - defsubr (&Sx_resource_live_p); - defsubr (&Sset_x_resource_type); + DEFSUBR (Fx_intern_atom); + DEFSUBR (Fx_atom_name); + DEFSUBR (Fstring_to_x_resource); + DEFSUBR (Fx_resource_to_type); + DEFSUBR (Fx_resource_to_string); + DEFSUBR (Fx_id_of_frame); + DEFSUBR (Fx_query_tree); + DEFSUBR (Fx_get_property); + DEFSUBR (Fx_set_property); + DEFSUBR (Fx_send_client_message); + DEFSUBR (Fx_resource_p); + DEFSUBR (Fx_resource_device); + DEFSUBR (Fx_resource_live_p); + DEFSUBR (Fset_x_resource_type); defsymbol (&Qx_resourcep, "x-resource-p"); defsymbol (&Qx_resource_live_p, "x-resource-live-p");
--- a/src/eval.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/eval.c Mon Aug 13 08:50:05 2007 +0200 @@ -403,9 +403,8 @@ do_debug_on_exit (Lisp_Object val) { /* This is falsified by call_debugger */ - int old_debug_on_next_call = debug_on_next_call; Lisp_Object v = call_debugger (list2 (Qexit, val)); - debug_on_next_call = old_debug_on_next_call; + return ((!UNBOUNDP (v)) ? v : val); } @@ -587,13 +586,12 @@ and temporaries from garbage collection while it needs them. The definition of `For' shows what you have to do. */ -DEFUN ("or", For, Sor, 0, UNEVALLED, 0 /* +DEFUN ("or", For, 0, UNEVALLED, 0, /* Eval args until one of them yields non-nil, then return that value. The remaining args are not evalled at all. If all args return nil, return nil. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object val; @@ -619,13 +617,12 @@ return val; } -DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0 /* +DEFUN ("and", Fand, 0, UNEVALLED, 0, /* Eval args until one of them yields nil, then return nil. The remaining args are not evalled at all. If no arg yields nil, return the last arg's value. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object val; @@ -651,14 +648,13 @@ return val; } -DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0 /* +DEFUN ("if", Fif, 2, UNEVALLED, 0, /* (if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE... Returns the value of THEN or the value of the last of the ELSE's. THEN must be one expression, but ELSE... can be zero or more expressions. If COND yields nil, and there are no ELSE's, the value is nil. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object cond; @@ -673,7 +669,7 @@ return Fprogn (Fcdr (Fcdr (args))); } -DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0 /* +DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /* (cond CLAUSES...): try each clause until one succeeds. Each clause looks like (CONDITION BODY...). CONDITION is evaluated and, if the value is non-nil, this clause succeeds: @@ -682,9 +678,8 @@ If no clause succeeds, cond returns nil. If a clause has one element, as in (CONDITION), CONDITION's value if non-nil is returned from the cond-form. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object clause, val; @@ -709,11 +704,10 @@ return val; } -DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0 /* +DEFUN ("progn", Fprogn, 0, UNEVALLED, 0, /* (progn BODY...): eval BODY forms sequentially and return value of last one. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object val; @@ -752,13 +746,12 @@ return val; } -DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0 /* +DEFUN ("prog1", Fprog1, 1, UNEVALLED, 0, /* (prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST. The value of FIRST is saved during the evaluation of the remaining args, whose values are discarded. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object val; @@ -787,13 +780,12 @@ return val; } -DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0 /* +DEFUN ("prog2", Fprog2, 2, UNEVALLED, 0, /* (prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y. The value of Y is saved during the evaluation of the remaining args, whose values are discarded. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object val; @@ -824,15 +816,14 @@ return val; } -DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0 /* +DEFUN ("let*", FletX, 1, UNEVALLED, 0, /* (let* VARLIST BODY...): bind variables according to VARLIST then eval BODY. The value of the last form in BODY is returned. Each element of VARLIST is a symbol (which is bound to nil) or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). Each VALUEFORM can refer to the symbols already bound by this VARLIST. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object varlist, val, elt; @@ -863,15 +854,14 @@ return unbind_to (speccount, val); } -DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0 /* +DEFUN ("let", Flet, 1, UNEVALLED, 0, /* (let VARLIST BODY...): bind variables according to VARLIST then eval BODY. The value of the last form in BODY is returned. Each element of VARLIST is a symbol (which is bound to nil) or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). All the VALUEFORMs are evalled before any symbols are bound. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object *temps, tem; @@ -921,13 +911,12 @@ return unbind_to (speccount, elt); } -DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0 /* +DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /* (while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat. The order of execution is thus TEST, BODY, TEST, BODY and so on until TEST returns nil. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object test, body, tem; @@ -954,7 +943,7 @@ Lisp_Object Qsetq; -DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0 /* +DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /* (setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL. The symbols SYM are variables; they are literal (not evaluated). The values VAL are expressions; they are evaluated. @@ -962,9 +951,8 @@ The second VAL is not computed until after the first SYM is set, and so on; each VAL can use the new value of variables set earlier in the `setq'. The return value of the `setq' form is the value of the last VAL. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object args_left; @@ -994,22 +982,20 @@ return val; } -DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0 /* +DEFUN ("quote", Fquote, 1, UNEVALLED, 0, /* Return the argument, without evaluating it. `(quote x)' yields `x'. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { return Fcar (args); } -DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0 /* +DEFUN ("function", Ffunction, 1, UNEVALLED, 0, /* Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be compiled. `quote' cannot do that. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { return Fcar (args); } @@ -1019,13 +1005,12 @@ /* Defining functions/variables */ /**********************************************************************/ -DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0 /* +DEFUN ("defun", Fdefun, 2, UNEVALLED, 0, /* (defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. The definition is (lambda ARGLIST [DOCSTRING] BODY...). See also the function `interactive'. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object fn_name; @@ -1040,16 +1025,15 @@ return fn_name; } -DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0 /* +DEFUN ("defmacro", Fdefmacro, 2, UNEVALLED, 0, /* (defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. The definition is (macro lambda ARGLIST [DOCSTRING] BODY...). When the macro is called, as in (NAME ARGS...), the function (lambda ARGLIST BODY...) is applied to the list ARGS... as it appears in the expression, and the result should be a form to be evaluated instead of the original. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object fn_name; @@ -1064,7 +1048,7 @@ return fn_name; } -DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0 /* +DEFUN ("defvar", Fdefvar, 1, UNEVALLED, 0, /* (defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable. You are not required to define a variable in order to use it, but the definition can supply documentation and an initial value @@ -1082,9 +1066,8 @@ If INITVALUE is missing, SYMBOL's value is not set. In lisp-interaction-mode defvar is treated as defconst. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object sym, tem, tail; @@ -1124,7 +1107,7 @@ return sym; } -DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0 /* +DEFUN ("defconst", Fdefconst, 2, UNEVALLED, 0, /* (defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable. The intent is that programs do not change this value, but users may. @@ -1140,9 +1123,8 @@ their own values for such variables before loading the library. Since `defconst' unconditionally assigns the variable, it would override the user's choice. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ REGISTER Lisp_Object sym, tem; @@ -1176,14 +1158,13 @@ return sym; } -DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0 /* +DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* Return t if VARIABLE is intended to be set and modified by users. \(The alternative is a variable used internally in a Lisp program.) Determined by whether the first character of the documentation for the variable is `*'. -*/ ) - (variable) - Lisp_Object variable; +*/ + (variable)) { Lisp_Object documentation; @@ -1202,8 +1183,7 @@ return Qnil; } -DEFUN ("macroexpand-internal", Fmacroexpand_internal, Smacroexpand_internal, - 1, 2, 0 /* +DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. Otherwise, the macro is expanded and the expansion is considered @@ -1211,10 +1191,8 @@ The second optional arg ENVIRONMENT species an environment of macro definitions to shadow the loaded ones for use in file byte-compilation. -*/ ) - (form, env) - Lisp_Object form; - Lisp_Object env; +*/ + (form, env)) { /* This function can GC */ /* With cleanups from Hallvard Furuseth. */ @@ -1287,15 +1265,14 @@ /* Non-local exits */ /**********************************************************************/ -DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0 /* +DEFUN ("catch", Fcatch, 1, UNEVALLED, 0, /* (catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'. TAG is evalled to get the tag to use. Then the BODY is executed. Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'. If no throw happens, `catch' returns the value of the last BODY form. If a throw happens, it specifies the value to return from `catch'. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object tag; @@ -1487,26 +1464,24 @@ condition_case_1). See below for more info. */ -DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0 /* +DEFUN ("throw", Fthrow, 2, 2, 0, /* (throw TAG VALUE): throw to the catch for TAG and return VALUE from it. Both TAG and VALUE are evalled. -*/ ) - (tag, val) - Lisp_Object tag, val; +*/ + (tag, val)) { throw_or_bomb_out (tag, val, 0, Qnil, Qnil); /* Doesn't return */ return Qnil; } -DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0 /* +DEFUN ("unwind-protect", Funwind_protect, 1, UNEVALLED, 0, /* Do BODYFORM, protecting with UNWINDFORMS. Usage looks like (unwind-protect BODYFORM UNWINDFORMS...). If BODYFORM completes normally, its value is returned after executing the UNWINDFORMS. If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object val; @@ -1738,7 +1713,7 @@ var); } -DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0 /* +DEFUN ("condition-case", Fcondition_case, 2, UNEVALLED, 0, /* Regain control when an error is signalled. Usage looks like (condition-case VAR BODYFORM HANDLERS...). executes BODYFORM and returns its value if no error happens. @@ -1771,9 +1746,8 @@ If you want to establish an error handler that is called with the Lisp stack, bindings, etc. as they were when `signal' was called, rather than when the handler was set, use `call-with-condition-handler'. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ return Fcondition_case_3 (Fcar (Fcdr (args)), @@ -1781,9 +1755,7 @@ Fcdr (Fcdr (args))); } -DEFUN ("call-with-condition-handler", - Fcall_with_condition_handler, - Scall_with_condition_handler, 2, MANY, 0 /* +DEFUN ("call-with-condition-handler", Fcall_with_condition_handler, 2, MANY, 0, /* Regain control when an error is signalled, without popping the stack. Usage looks like (call-with-condition-handler HANDLER FUNCTION &rest ARGS). This function is similar to `condition-case', but the handler is invoked @@ -1798,10 +1770,8 @@ returns, `signal' continues as if the handler were never invoked. (It continues to look for handlers established earlier than this one, and invokes the standard error-handler if none is found.) -*/ ) - (nargs, args) /* Note! Args side-effected! */ - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) /* Note! Args side-effected! */ { /* This function can GC */ int speccount = specpdl_depth_counter; @@ -2038,7 +2008,7 @@ signal_continuable_error() in the terminology below, but it's Lisp-callable. */ -DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0 /* +DEFUN ("signal", Fsignal, 2, 2, 0, /* Signal a continuable error. Args are ERROR-SYMBOL, and associated DATA. An error symbol is a symbol defined using `define-error'. DATA should be a list. Its elements are printed as part of the error message. @@ -2048,9 +2018,8 @@ Note that this function can return, if the debugger is invoked and the user invokes the "return from signal" option. -*/ ) - (error_symbol, data) - Lisp_Object error_symbol, data; +*/ + (error_symbol, data)) { /* Fsignal() is one of these functions that's called all the time with newly-created Lisp objects. We allow this; but we must GC- @@ -2510,7 +2479,7 @@ /* User commands */ /**********************************************************************/ -DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0 /* +DEFUN ("commandp", Fcommandp, 1, 1, 0, /* T if FUNCTION makes provisions for interactive calling. This means it contains a description for how to read arguments to give it. The value is nil for an invalid function or a symbol with no function @@ -2527,9 +2496,8 @@ -- subrs (built-in functions) that are interactively callable Also, a symbol satisfies `commandp' if its function definition does so. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { REGISTER Lisp_Object fun; REGISTER Lisp_Object funcar; @@ -2577,15 +2545,14 @@ return Qnil; } -DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 3, 0 /* +DEFUN ("command-execute", Fcommand_execute, 1, 3, 0, /* Execute CMD as an editor command. CMD must be an object that satisfies the `commandp' predicate. Optional second arg RECORD-FLAG is as in `call-interactively'. The argument KEYS specifies the value to use instead of (this-command-keys) when reading the arguments. -*/ ) - (cmd, record, keys) - Lisp_Object cmd, record, keys; +*/ + (cmd, record, keys)) { /* This function can GC */ Lisp_Object prefixarg; @@ -2644,13 +2611,13 @@ } } -DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0 /* +DEFUN ("interactive-p", Finteractive_p, 0, 0, 0, /* Return t if function in which this appears was called interactively. This means that the function was called with call-interactively (which includes being called as the binding of a key) and input is currently coming from the keyboard (not in keyboard macro). -*/ ) - () +*/ + ()) { REGISTER struct backtrace *btp; REGISTER Lisp_Object fun; @@ -2722,7 +2689,7 @@ /* Autoloading */ /**********************************************************************/ -DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0 /* +DEFUN ("autoload", Fautoload, 2, 5, 0, /* Define FUNCTION to autoload from FILE. FUNCTION is a symbol; FILE is a file name string to pass to `load'. Third arg DOCSTRING is documentation for the function. @@ -2735,9 +2702,8 @@ They default to nil. If FUNCTION is already defined other than as an autoload, this does nothing and returns nil. -*/ ) - (function, file, docstring, interactive, type) - Lisp_Object function, file, docstring, interactive, type; +*/ + (function, file, docstring, interactive, type)) { /* This function can GC */ CHECK_SYMBOL (function); @@ -2865,11 +2831,10 @@ } -DEFUN ("eval", Feval, Seval, 1, 1, 0 /* +DEFUN ("eval", Feval, 1, 1, 0, /* Evaluate FORM and return its value. -*/ ) - (form) - Lisp_Object form; +*/ + (form)) { /* This function can GC */ Lisp_Object fun, val, original_fun, original_args; @@ -3243,25 +3208,21 @@ return val; } -DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0 /* +DEFUN ("funcall", Ffuncall, 1, MANY, 0, /* Call first argument as a function, passing remaining arguments to it. Thus, (funcall 'cons 'x 'y) returns (x . y). -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return funcall_recording_as (args[0], nargs, args); } -DEFUN ("function-min-args", Ffunction_min_args, Sfunction_min_args, - 1, 1, 0 /* +DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /* Return the number of arguments a function may be called with. The function may be any form that can be passed to `funcall', any special form, or any macro. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { Lisp_Object orig_function = function; Lisp_Object arglist; @@ -3318,15 +3279,13 @@ return make_int (argcount); } -DEFUN ("function-max-args", Ffunction_max_args, Sfunction_max_args, - 1, 1, 0 /* +DEFUN ("function-max-args", Ffunction_max_args, 1, 1, 0, /* Return the number of arguments a function may be called with. If the function takes an arbitrary number of arguments or is a built-in special form, nil is returned. The function may be any form that can be passed to `funcall', any special form, or any macro. -*/ ) - (function) - Lisp_Object function; +*/ + (function)) { Lisp_Object orig_function = function; Lisp_Object arglist; @@ -3388,13 +3347,11 @@ } -DEFUN ("apply", Fapply, Sapply, 2, MANY, 0 /* +DEFUN ("apply", Fapply, 2, MANY, 0, /* Call FUNCTION with our remaining args, using our last arg as list of args. Thus, (apply '+ 1 2 '(3 4)) returns 10. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* This function can GC */ Lisp_Object fun = args[0]; @@ -3638,12 +3595,10 @@ return unbind_to (speccount, val); } -DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, - 1, 1, 0 /* +DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /* If byte-compiled OBJECT is lazy-loaded, fetch it now. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { Lisp_Object tem; @@ -3666,7 +3621,7 @@ /* Run hook variables in various ways. */ /**********************************************************************/ -DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 1, MANY, 0 /* +DEFUN ("run-hooks", Frun_hooks, 1, MANY, 0, /* Run each hook in HOOKS. Major mode functions use this. Each argument should be a symbol, a hook variable. These symbols are processed in the order specified. @@ -3677,10 +3632,8 @@ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { Lisp_Object hook[1]; REGISTER int i; @@ -3694,8 +3647,7 @@ return Qnil; } -DEFUN ("run-hook-with-args", - Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0 /* +DEFUN ("run-hook-with-args", Frun_hook_with_args, 1, MANY, 0, /* Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil value, that value may be a function or a list of functions to be @@ -3708,17 +3660,13 @@ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return run_hook_with_args (nargs, args, RUN_HOOKS_TO_COMPLETION); } -DEFUN ("run-hook-with-args-until-success", - Frun_hook_with_args_until_success, Srun_hook_with_args_until_success, - 1, MANY, 0 /* +DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 1, MANY, 0, /* Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. Its value should be a list of functions. We call those functions, one by one, @@ -3728,17 +3676,13 @@ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_SUCCESS); } -DEFUN ("run-hook-with-args-until-failure", - Frun_hook_with_args_until_failure, Srun_hook_with_args_until_failure, - 1, MANY, 0 /* +DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 1, MANY, 0, /* Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. Its value should be a list of functions. We call those functions, one by one, @@ -3748,10 +3692,8 @@ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_FAILURE); } @@ -4874,12 +4816,11 @@ /* Backtraces */ /**********************************************************************/ -DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0 /* +DEFUN ("backtrace-debug", Fbacktrace_debug, 2, 2, 0, /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil. -*/ ) - (level, flag) - Lisp_Object level, flag; +*/ + (level, flag)) { REGISTER struct backtrace *backlist = backtrace_list; REGISTER int i; @@ -4923,16 +4864,15 @@ if (printing_bindings) write_c_string (")\n", stream); } -DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 2, "" /* +DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* Print a trace of Lisp function calls currently active. Option arg STREAM specifies the output stream to send the backtrace to, and defaults to the value of `standard-output'. Optional second arg DETAILED means show places where currently active variable bindings, catches, condition-cases, and unwind-protects were made as well as function calls. -*/ ) - (stream, detailed) - Lisp_Object stream, detailed; +*/ + (stream, detailed)) { struct backtrace *backlist = backtrace_list; struct catchtag *catches = catchlist; @@ -5050,7 +4990,7 @@ } -DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, "" /* +DEFUN ("backtrace-frame", Fbacktrace_frame, 1, 1, "", /* Return the function and arguments N frames up from current execution point. If that frame has not evaluated the arguments yet (or is a special form), the value is (nil FUNCTION ARG-FORMS...). @@ -5060,9 +5000,8 @@ FUNCTION is whatever was supplied as car of evaluated list, or a lambda expression for macro calls. If N is more than the number of frames, the value is nil. -*/ ) - (nframes) - Lisp_Object nframes; +*/ + (nframes)) { REGISTER struct backtrace *backlist = backtrace_list; REGISTER int i; @@ -5160,48 +5099,48 @@ defsymbol (&Qdisplay_warning, "display-warning"); defsymbol (&Qrun_hooks, "run-hooks"); - defsubr (&Sor); - defsubr (&Sand); - defsubr (&Sif); - defsubr (&Scond); - defsubr (&Sprogn); - defsubr (&Sprog1); - defsubr (&Sprog2); - defsubr (&Ssetq); - defsubr (&Squote); - defsubr (&Sfunction); - defsubr (&Sdefun); - defsubr (&Sdefmacro); - defsubr (&Sdefvar); - defsubr (&Sdefconst); - defsubr (&Suser_variable_p); - defsubr (&Slet); - defsubr (&SletX); - defsubr (&Swhile); - defsubr (&Smacroexpand_internal); - defsubr (&Scatch); - defsubr (&Sthrow); - defsubr (&Sunwind_protect); - defsubr (&Scondition_case); - defsubr (&Scall_with_condition_handler); - defsubr (&Ssignal); - defsubr (&Sinteractive_p); - defsubr (&Scommandp); - defsubr (&Scommand_execute); - defsubr (&Sautoload); - defsubr (&Seval); - defsubr (&Sapply); - defsubr (&Sfuncall); - defsubr (&Sfunction_min_args); - defsubr (&Sfunction_max_args); - defsubr (&Srun_hooks); - defsubr (&Srun_hook_with_args); - defsubr (&Srun_hook_with_args_until_success); - defsubr (&Srun_hook_with_args_until_failure); - defsubr (&Sfetch_bytecode); - defsubr (&Sbacktrace_debug); - defsubr (&Sbacktrace); - defsubr (&Sbacktrace_frame); + DEFSUBR (For); + DEFSUBR (Fand); + DEFSUBR (Fif); + DEFSUBR (Fcond); + DEFSUBR (Fprogn); + DEFSUBR (Fprog1); + DEFSUBR (Fprog2); + DEFSUBR (Fsetq); + DEFSUBR (Fquote); + DEFSUBR (Ffunction); + DEFSUBR (Fdefun); + DEFSUBR (Fdefmacro); + DEFSUBR (Fdefvar); + DEFSUBR (Fdefconst); + DEFSUBR (Fuser_variable_p); + DEFSUBR (Flet); + DEFSUBR (FletX); + DEFSUBR (Fwhile); + DEFSUBR (Fmacroexpand_internal); + DEFSUBR (Fcatch); + DEFSUBR (Fthrow); + DEFSUBR (Funwind_protect); + DEFSUBR (Fcondition_case); + DEFSUBR (Fcall_with_condition_handler); + DEFSUBR (Fsignal); + DEFSUBR (Finteractive_p); + DEFSUBR (Fcommandp); + DEFSUBR (Fcommand_execute); + DEFSUBR (Fautoload); + DEFSUBR (Feval); + DEFSUBR (Fapply); + DEFSUBR (Ffuncall); + DEFSUBR (Ffunction_min_args); + DEFSUBR (Ffunction_max_args); + DEFSUBR (Frun_hooks); + DEFSUBR (Frun_hook_with_args); + DEFSUBR (Frun_hook_with_args_until_success); + DEFSUBR (Frun_hook_with_args_until_failure); + DEFSUBR (Ffetch_bytecode); + DEFSUBR (Fbacktrace_debug); + DEFSUBR (Fbacktrace); + DEFSUBR (Fbacktrace_frame); } void
--- a/src/event-Xt.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 08:50:05 2007 +0200 @@ -48,6 +48,8 @@ a core widget directly. We could use XtVaGetValues(), but ... */ +static void enqueue_Xt_dispatch_event (Lisp_Object event); + static struct event_stream *Xt_event_stream; /* With the new event model, all events go through XtDispatchEvent() @@ -89,7 +91,6 @@ void emacs_Xt_mapping_action (Widget w, XEvent *event); void debug_process_finalization (struct Lisp_Process *p); -Lisp_Object dequeue_Xt_dispatch_event (void); void emacs_Xt_event_handler (Widget wid, XtPointer closure, XEvent *event, Boolean *continue_to_dispatch); @@ -294,8 +295,7 @@ assigned to a key that is not one of the above, but OpenWindows assigns modifier bits to a couple of random function keys for no reason that I can discern, so printing a warning here would - be annoying. - */ + be annoying. */ } } } @@ -306,8 +306,7 @@ /* If there was no Meta key, then try using the Alt key instead. If there is both a Meta key and an Alt key, then the Alt key - is not disturbed and remains an Alt key. - */ + is not disturbed and remains an Alt key. */ if (! meta_bit && alt_bit) meta_bit = alt_bit, alt_bit = 0; @@ -316,8 +315,7 @@ generate the same modifier bit (which is an error), then we don't interpret that bit as Meta, because we can't make XLookupString() not interpret it as Mode_switch; and interpreting it as both would - be totally wrong. - */ + be totally wrong. */ if (mode_bit) { CONST char *warn = 0; @@ -363,7 +361,7 @@ " assigning the key a different modifier bit. You must also make that\n" " key generate an appropriate keysym (Control_L, Meta_L, etc)."); - /* Don\'t need to say anything more for warned_about_duplicate_modifiers. */ + /* No need to say anything more for warned_about_duplicate_modifiers. */ if (warned_about_overlapping_modifiers || warned_about_predefined_modifiers) warn_when_safe (Qkey_mapping, Qwarning, "\n" @@ -466,8 +464,7 @@ to provide an obvious way to distinguish these cases. So we assume that if the release and the next press occur at the same time, the key was actually auto- - repeated. Under Open-Windows, at least, this works. - */ + repeated. Under Open-Windows, at least, this works. */ xd->release_time = key_event_p ? ev->xkey.time : ev->xbutton.time; } else /* Modifier key pressed */ @@ -535,9 +532,9 @@ struct x_device *xd = DEVICE_X_DATA (d); xd->need_to_add_mask = 0; - xd->last_downkey = 0; - xd->release_time = 0; - xd->down_mask = 0; + xd->last_downkey = 0; + xd->release_time = 0; + xd->down_mask = 0; } static int @@ -547,8 +544,7 @@ /* Eeeeevil hack. Don't apply Caps_Lock to things that aren't alphabetic characters, where "alphabetic" means something more than simply A-Z. That is, if Caps_Lock is down, typing ESC doesn't produce Shift-ESC. - But if shift-lock is down, then it does. - */ + But if shift-lock is down, then it does. */ if (xd->lock_interpretation == XK_Shift_Lock) return 1; @@ -566,8 +562,8 @@ decided that Xt event handlers never get MappingNotify events. O'Reilly Xt Programming Manual 9.1.2 says: - MappingNotify is automatically handled by Xt, so it isn't passed - to event handlers and you don't need to worry about it. + MappingNotify is automatically handled by Xt, so it isn't passed + to event handlers and you don't need to worry about it. Of course, we DO worry about it, so we need a special translation. */ void @@ -581,8 +577,7 @@ /* xmodmap generates about a billion MappingKeyboard events, followed by a single MappingModifier event, so it might be worthwhile to take extra MappingKeyboard events out of the queue before requesting - the current keymap from the server. - */ + the current keymap from the server. */ switch (event->xmapping.request) { case MappingKeyboard: x_reset_key_mapping (d); break; @@ -607,13 +602,12 @@ XEvent *event, int simple_p) #else /* !SUNOS_GCC_L0_BUG */ static Lisp_Object -x_to_emacs_keysym (XEvent *event, int simple_p) +x_to_emacs_keysym (XKeyPressedEvent *event, int simple_p) #endif /* !SUNOS_GCC_L0_BUG */ /* simple_p means don't try too hard (ASCII only) */ { char *name; KeySym keysym = 0; - /* struct device *d = get_device_from_display (event->xany.display); */ /* Apparently it's necessary to specify a dummy here (rather than passing in 0) to avoid crashes on German IRIX */ char dummy[256]; @@ -625,35 +619,33 @@ /* ### FIX this by replacing with calls to XmbLookupString. XLookupString should never be called. --mrb */ - XLookupString (&event->xkey, dummy, 200, &keysym, 0); - - /* &DEVICE_X_X_COMPOSE_STATUS (d)); */ + XLookupString (event, dummy, 200, &keysym, 0); if (keysym >= XK_exclam && keysym <= XK_asciitilde) /* We must assume that the X keysym numbers for the ASCII graphic characters are the same as their ASCII codes. */ - return (make_char (keysym)); + return make_char (keysym); switch (keysym) { /* These would be handled correctly by the default case, but by special-casing them here we don't garbage a string or call intern(). */ - case XK_BackSpace: return (QKbackspace); - case XK_Tab: return (QKtab); - case XK_Linefeed: return (QKlinefeed); - case XK_Return: return (QKreturn); - case XK_Escape: return (QKescape); - case XK_space: return (QKspace); - case XK_Delete: return (QKdelete); - case 0: return (Qnil); + case XK_BackSpace: return QKbackspace; + case XK_Tab: return QKtab; + case XK_Linefeed: return QKlinefeed; + case XK_Return: return QKreturn; + case XK_Escape: return QKescape; + case XK_space: return QKspace; + case XK_Delete: return QKdelete; + case 0: return Qnil; /* This kludge prevents bogus Xlib compose conversions. Don't ask why. The following case must be removed when we switch to using XmbLookupString */ - case XK_Multi_key: XLookupString (&event->xkey, dummy, 200, &keysym, 0); + case XK_Multi_key: XLookupString (event, dummy, 200, &keysym, 0); /* Fallthrough!! */ default: - if (simple_p) return (Qnil); + if (simple_p) return Qnil; /* #### without return_value_sunos_bug, %l0 (GCC struct return pointer) * #### gets roached (top 8 bits cleared) around this call. */ @@ -663,16 +655,17 @@ { char buf [255]; sprintf (buf, "unknown_keysym_0x%X", (int) keysym); - return (KEYSYM (buf)); + return KEYSYM (buf); } /* If it's got a one-character name, that's good enough. */ - if (!name[1]) return (make_char (name[0])); + if (!name[1]) + return make_char (name[0]); /* If it's in the "Keyboard" character set, downcase it. The case of those keysyms is too totally random for us to force anyone to remember them. The case of the other character sets is significant, however. - */ + */ if ((((unsigned int) keysym) & (~0xFF)) == ((unsigned int) 0xFF00)) { char buf [255]; @@ -685,9 +678,9 @@ } } *s2 = 0; - return (KEYSYM (buf)); + return KEYSYM (buf); } - return (KEYSYM (name)); + return KEYSYM (name); } #ifdef SUNOS_GCC_L0_BUG # undef return @@ -748,129 +741,127 @@ case ButtonPress: case ButtonRelease: { - unsigned int modifiers = 0; - int shift_p; - int lock_p; - Bool key_event_p = (x_event->type == KeyPress); - unsigned int *state = - key_event_p ? &x_event->xkey.state : &x_event->xbutton.state; - - /* If this is a synthetic KeyPress or Button event, and the user - has expressed a disinterest in this security hole, then drop - it on the floor. */ - if ((key_event_p - ? x_event->xkey.send_event - : x_event->xbutton.send_event) + unsigned int modifiers = 0; + int shift_p, lock_p; + Bool key_event_p = (x_event->type == KeyPress); + unsigned int *state = + key_event_p ? &x_event->xkey.state : &x_event->xbutton.state; + + /* If this is a synthetic KeyPress or Button event, and the user + has expressed a disinterest in this security hole, then drop + it on the floor. */ + if ((key_event_p + ? x_event->xkey.send_event + : x_event->xbutton.send_event) #ifdef EXTERNAL_WIDGET - /* ben: events get sent to an ExternalShell using XSendEvent. - This is not a perfect solution. */ - && !FRAME_X_EXTERNAL_WINDOW_P ( - x_any_window_to_frame (d, x_event->xany.window)) + /* ben: events get sent to an ExternalShell using XSendEvent. + This is not a perfect solution. */ + && !FRAME_X_EXTERNAL_WINDOW_P + (x_any_window_to_frame (d, x_event->xany.window)) #endif - && !x_allow_sendevents) - return 0; + && !x_allow_sendevents) + return 0; - DEVICE_X_MOUSE_TIMESTAMP (d) = - DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d) = - key_event_p ? x_event->xkey.time : x_event->xbutton.time; - - x_handle_sticky_modifiers (x_event, d); + DEVICE_X_MOUSE_TIMESTAMP (d) = + DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d) = + key_event_p ? x_event->xkey.time : x_event->xbutton.time; - if (*state & ControlMask) modifiers |= MOD_CONTROL; - if (*state & xd->MetaMask) modifiers |= MOD_META; - if (*state & xd->SuperMask) modifiers |= MOD_SUPER; - if (*state & xd->HyperMask) modifiers |= MOD_HYPER; - if (*state & xd->AltMask) modifiers |= MOD_ALT; + x_handle_sticky_modifiers (x_event, d); + + if (*state & ControlMask) modifiers |= MOD_CONTROL; + if (*state & xd->MetaMask) modifiers |= MOD_META; + if (*state & xd->SuperMask) modifiers |= MOD_SUPER; + if (*state & xd->HyperMask) modifiers |= MOD_HYPER; + if (*state & xd->AltMask) modifiers |= MOD_ALT; - /* Ignore the Caps_Lock key if: - - any other modifiers are down, so that Caps_Lock doesn't - turn C-x into C-X, which would suck. - - the event was a mouse event. */ - if (modifiers || ! key_event_p) - *state &= (~LockMask); + /* Ignore the Caps_Lock key if: + - any other modifiers are down, so that Caps_Lock doesn't + turn C-x into C-X, which would suck. + - the event was a mouse event. */ + if (modifiers || ! key_event_p) + *state &= (~LockMask); - shift_p = *state & ShiftMask; - lock_p = *state & LockMask; + shift_p = *state & ShiftMask; + lock_p = *state & LockMask; - if (shift_p || lock_p) - modifiers |= MOD_SHIFT; + if (shift_p || lock_p) + modifiers |= MOD_SHIFT; - if (key_event_p) - { - Lisp_Object keysym; - XKeyEvent *ev = &x_event->xkey; - KeyCode keycode = ev->keycode; + if (key_event_p) + { + Lisp_Object keysym; + XKeyEvent *ev = &x_event->xkey; + KeyCode keycode = ev->keycode; + if (x_key_is_modifier_p (keycode, d)) /* it's a modifier key */ + return 0; - if (x_key_is_modifier_p (keycode, d)) /* it's a modifier key */ - return 0; + /* This used to compute the frame from the given X window and + store it here, but we really don't care about the frame. */ + emacs_event->channel = DEVICE_CONSOLE (d); + keysym = x_to_emacs_keysym (&x_event->xkey, 0); - /* This used to compute the frame from the given X window and - store it here, but we really don't care about the frame. */ - emacs_event->channel = DEVICE_CONSOLE (d); - keysym = x_to_emacs_keysym (x_event, 0); - - /* If the emacs keysym is nil, then that means that the - X keysym was NoSymbol, which probably means that - we're in the midst of reading a Multi_key sequence, - or a "dead" key prefix. Ignore it. */ - if (NILP (keysym)) - return 0; - - /* More Caps_Lock garbage: Caps_Lock should *only* add the - shift modifier to two-case keys (that is, A-Z and - related characters). So at this point (after looking up - the keysym) if the keysym isn't a dual-case alphabetic, - and if the caps lock key was down but the shift key - wasn't, then turn off the shift modifier. Gag barf */ - /* #### type lossage: assuming equivalence of emacs and - X keysyms */ - /* !!#### maybe fix for Mule */ - if (lock_p && !shift_p && - ! (CHAR_OR_CHAR_INTP (keysym) - && keysym_obeys_caps_lock_p - ((KeySym) XCHAR_OR_CHAR_INT (keysym), d))) - modifiers &= (~MOD_SHIFT); - - /* If this key contains two distinct keysyms, that is, - "shift" generates a different keysym than the - non-shifted key, then don't apply the shift modifier - bit: it's implicit. Otherwise, if there would be no - other way to tell the difference between the shifted - and unshifted version of this key, apply the shift bit. - Non-graphics, like Backspace and F1 get the shift bit - in the modifiers slot. Neither the characters "a", - "A", "2", nor "@" normally have the shift bit set. - However, "F1" normally does. */ - if (modifiers & MOD_SHIFT) - { - int Mode_switch_p = *state & xd->ModeMask; - KeySym bot = XLookupKeysym (ev, Mode_switch_p ? 2 : 0); - KeySym top = XLookupKeysym (ev, Mode_switch_p ? 3 : 1); - if (top && bot && top != bot) - modifiers &= ~MOD_SHIFT; - } - emacs_event->event_type = key_press_event; - emacs_event->timestamp = ev->time; - emacs_event->event.key.modifiers = modifiers; - emacs_event->event.key.keysym = keysym; - } - else /* Mouse press/release event */ - { - XButtonEvent *ev = &x_event->xbutton; - struct frame *frame = x_window_to_frame (d, ev->window); - if (! frame) - return 0; /* not for us */ - XSETFRAME (emacs_event->channel, frame); - - emacs_event->event_type = (x_event->type == ButtonPress) ? - button_press_event : button_release_event; - - emacs_event->event.button.modifiers = modifiers; - emacs_event->timestamp = ev->time; - emacs_event->event.button.button = ev->button; - emacs_event->event.button.x = ev->x; - emacs_event->event.button.y = ev->y; + /* If the emacs keysym is nil, then that means that the + X keysym was NoSymbol, which probably means that + we're in the midst of reading a Multi_key sequence, + or a "dead" key prefix. Ignore it. */ + if (NILP (keysym)) + return 0; + + /* More Caps_Lock garbage: Caps_Lock should *only* add the + shift modifier to two-case keys (that is, A-Z and + related characters). So at this point (after looking up + the keysym) if the keysym isn't a dual-case alphabetic, + and if the caps lock key was down but the shift key + wasn't, then turn off the shift modifier. Gag barf */ + /* #### type lossage: assuming equivalence of emacs and + X keysyms */ + /* !!#### maybe fix for Mule */ + if (lock_p && !shift_p && + ! (CHAR_OR_CHAR_INTP (keysym) + && keysym_obeys_caps_lock_p + ((KeySym) XCHAR_OR_CHAR_INT (keysym), d))) + modifiers &= (~MOD_SHIFT); + + /* If this key contains two distinct keysyms, that is, + "shift" generates a different keysym than the + non-shifted key, then don't apply the shift modifier + bit: it's implicit. Otherwise, if there would be no + other way to tell the difference between the shifted + and unshifted version of this key, apply the shift bit. + Non-graphics, like Backspace and F1 get the shift bit + in the modifiers slot. Neither the characters "a", + "A", "2", nor "@" normally have the shift bit set. + However, "F1" normally does. */ + if (modifiers & MOD_SHIFT) + { + int Mode_switch_p = *state & xd->ModeMask; + KeySym bot = XLookupKeysym (ev, Mode_switch_p ? 2 : 0); + KeySym top = XLookupKeysym (ev, Mode_switch_p ? 3 : 1); + if (top && bot && top != bot) + modifiers &= ~MOD_SHIFT; + } + emacs_event->event_type = key_press_event; + emacs_event->timestamp = ev->time; + emacs_event->event.key.modifiers = modifiers; + emacs_event->event.key.keysym = keysym; + } + else /* Mouse press/release event */ + { + XButtonEvent *ev = &x_event->xbutton; + struct frame *frame = x_window_to_frame (d, ev->window); + if (! frame) + return 0; /* not for us */ + XSETFRAME (emacs_event->channel, frame); + + emacs_event->event_type = (x_event->type == ButtonPress) ? + button_press_event : button_release_event; + + emacs_event->event.button.modifiers = modifiers; + emacs_event->timestamp = ev->time; + emacs_event->event.button.button = ev->button; + emacs_event->event.button.x = ev->x; + emacs_event->event.button.y = ev->y; } } break; @@ -1141,7 +1132,7 @@ this is so that clicking on the close-box will make emacs prompt using a dialog box instead of the minibuffer if there are unsaved buffers. - */ + */ enqueue_misc_user_event (frame, Qeval, list3 (Qdelete_frame, frame, Qt)); } @@ -1261,14 +1252,14 @@ break; case VisibilityNotify: /* window visiblity has changed */ - if (event->xvisibility.window == XtWindow (FRAME_X_SHELL_WIDGET (f))) + if (event->xvisibility.window == XtWindow (FRAME_X_SHELL_WIDGET (f))) FRAME_X_TOTALLY_VISIBLE_P (f) = (event->xvisibility.state == VisibilityUnobscured); - break; + break; case ConfigureNotify: #ifdef HAVE_XIM - XIC_SetGeometry (f); + XIM_SetGeometry (f); #endif /* ### If the following code fails to work, simply always call x_smash_bastardly_shell_position always. In this case we no @@ -1777,6 +1768,7 @@ describe_event_window (ev->window, ev->display); stderr_out (" subwindow: %ld\n", ev->subwindow); stderr_out (" state: "); + /* Complete list of modifier key masks */ if (state & ShiftMask) stderr_out ("Shift "); if (state & LockMask) stderr_out ("Lock "); if (state & ControlMask) stderr_out ("Control "); @@ -1785,13 +1777,6 @@ if (state & Mod3Mask) stderr_out ("Mod3 "); if (state & Mod4Mask) stderr_out ("Mod4 "); if (state & Mod5Mask) stderr_out ("Mod5 "); -#if 0 /* Apparently these don't exist? */ - if (state & MetaMask) stderr_out ("Meta "); - if (state & SuperMask) stderr_out ("Super "); - if (state & HyperMask) stderr_out ("Hyper "); - if (state & AltMask) stderr_out ("Alt "); - if (state & ModeMask) stderr_out ("Mode_switch "); -#endif if (! state) stderr_out ("vanilla\n"); @@ -1800,17 +1785,6 @@ if (x_key_is_modifier_p (ev->keycode, d)) stderr_out (" Modifier key"); stderr_out (" keycode: 0x%x\n", ev->keycode); - keysym = x_to_emacs_keysym (event, 0); - if (CHAR_OR_CHAR_INTP (keysym)) - { - Emchar c = XCHAR_OR_CHAR_INT (keysym); - if (c > 32 && c < 127) - stderr_out (" keysym: %c\n", c); - else - stderr_out (" keysym: %d\n", c); - } - else - stderr_out (" keysym: %s\n", string_data (XSYMBOL (keysym)->name)); } break; @@ -1928,7 +1902,7 @@ enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail); } -Lisp_Object +static Lisp_Object dequeue_Xt_dispatch_event (void) { return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail); @@ -2081,7 +2055,7 @@ /* This duplicates some code that exists elsewhere, but it's relatively fast and doesn't cons. */ - keysym = x_to_emacs_keysym (event, 1); + keysym = x_to_emacs_keysym (&event->xkey, 1); if (NILP (keysym)) return 0; if (CHAR_OR_CHAR_INTP (keysym)) c = XCHAR_OR_CHAR_INT (keysym);
--- a/src/event-stream.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 08:50:05 2007 +0200 @@ -251,6 +251,8 @@ Chained through event_next() command_event_queue_tail is a pointer to the last-added element. */ +static Lisp_Object process_event_queue; +static Lisp_Object process_event_queue_tail; static Lisp_Object command_event_queue; static Lisp_Object command_event_queue_tail; @@ -857,11 +859,11 @@ return 0; } -DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0 /* +DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /* T if command input is currently available with no waiting. Actually, the value is nil only if we can be sure that no input is available. -*/ ) - () +*/ + ()) { return ((detect_input_pending ()) ? Qt : Qnil); } @@ -1294,7 +1296,7 @@ return msecs; } -DEFUN ("add-timeout", Fadd_timeout, Sadd_timeout, 3, 4, 0 /* +DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /* Add a timeout, to be signaled after the timeout period has elapsed. SECS is a number of seconds, expressed as an integer or a float. FUNCTION will be called after that many seconds have elapsed, with one @@ -1327,9 +1329,8 @@ WARNING: if you are thinking of calling add-timeout from inside of a callback function as a way of resignalling a timeout, think again. There is a race condition. That's why the RESIGNAL argument exists. -*/ ) - (secs, function, object, resignal) - Lisp_Object secs, function, object, resignal; +*/ + (secs, function, object, resignal)) { unsigned long msecs = lisp_number_to_milliseconds (secs, 0); unsigned long msecs2 = (NILP (resignal) ? 0 : @@ -1342,7 +1343,7 @@ return lid; } -DEFUN ("disable-timeout", Fdisable_timeout, Sdisable_timeout, 1, 1, 0 /* +DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /* Disable a timeout from signalling any more. ID should be a timeout id number as returned by `add-timeout'. If ID corresponds to a one-shot timeout that has already signalled, nothing @@ -1350,16 +1351,15 @@ It will not work to call this function on an id number returned by `add-async-timeout'. Use `disable-async-timeout' for that. -*/ ) - (id) - Lisp_Object id; +*/ + (id)) { CHECK_INT (id); event_stream_disable_wakeup (XINT (id), 0); return Qnil; } -DEFUN ("add-async-timeout", Fadd_async_timeout, Sadd_async_timeout, 3, 4, 0 /* +DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /* Add an asynchronous timeout, to be signaled after an interval has elapsed. SECS is a number of seconds, expressed as an integer or a float. FUNCTION will be called after that many seconds have elapsed, with one @@ -1408,9 +1408,8 @@ WARNING: if you are thinking of calling `add-async-timeout' from inside of a callback function as a way of resignalling a timeout, think again. There is a race condition. That's why the RESIGNAL argument exists. -*/ ) - (secs, function, object, resignal) - Lisp_Object secs, function, object, resignal; +*/ + (secs, function, object, resignal)) { unsigned long msecs = lisp_number_to_milliseconds (secs, 0); unsigned long msecs2 = (NILP (resignal) ? 0 : @@ -1423,8 +1422,7 @@ return lid; } -DEFUN ("disable-async-timeout", Fdisable_async_timeout, - Sdisable_async_timeout, 1, 1, 0 /* +DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /* Disable an asynchronous timeout from signalling any more. ID should be a timeout id number as returned by `add-async-timeout'. If ID corresponds to a one-shot timeout that has already signalled, nothing @@ -1432,9 +1430,8 @@ It will not work to call this function on an id number returned by `add-timeout'. Use `disable-timeout' for that. -*/ ) - (id) - Lisp_Object id; +*/ + (id)) { CHECK_INT (id); event_stream_disable_wakeup (XINT (id), 1); @@ -1446,6 +1443,19 @@ /* enqueuing and dequeuing events */ /**********************************************************************/ +/* Add an event to the back of the process_event_queue */ +void +enqueue_process_event (Lisp_Object event) +{ + enqueue_event (event, &process_event_queue, &process_event_queue_tail); +} + +Lisp_Object +dequeue_process_event (void) +{ + return dequeue_event (&process_event_queue, &process_event_queue_tail); +} + /* Add an event to the back of the command-event queue: it will be the next event read after all pending events. This only works on keyboard, mouse-click, misc-user, and eval events. @@ -1491,16 +1501,14 @@ enqueue_command_event (event); } -DEFUN ("enqueue-eval-event", Fenqueue_eval_event, Senqueue_eval_event, - 2, 2, 0 /* +DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /* Add an eval event to the back of the eval event queue. When this event is dispatched, FUNCTION (which should be a function of one argument) will be called with OBJECT as its argument. See `next-event' for a description of event types and how events are received. -*/ ) - (function, object) - Lisp_Object function, object; +*/ + (function, object)) { Lisp_Object event; @@ -1837,7 +1845,8 @@ Charcount num_input_chars; static void -next_event_internal (Lisp_Object target_event, int allow_queued) +next_event_internal (Lisp_Object target_event, int allow_queued, + int allow_deferred) { struct gcpro gcpro1; /* QUIT; This is incorrect - the caller must do this because some @@ -1863,6 +1872,21 @@ } #endif } + else if (allow_deferred && !NILP (process_event_queue)) + { + Lisp_Object event = dequeue_process_event (); + Fcopy_event (event, target_event); + Fdeallocate_event (event); +#ifdef DEBUG_EMACS + if (debug_emacs_events) + { + write_c_string ("(process event queue) ", + Qexternal_debugging_output); + print_internal (target_event, Qexternal_debugging_output, 1); + write_c_string ("\n", Qexternal_debugging_output); + } +#endif + } else { struct Lisp_Event *e = XEVENT (target_event); @@ -1929,7 +1953,7 @@ static void dribble_out_event (Lisp_Object event); static void execute_internal_event (Lisp_Object event); -DEFUN ("next-event", Fnext_event, Snext_event, 0, 2, 0 /* +DEFUN ("next-event", Fnext_event, 0, 2, 0, /* Return the next available event. Pass this object to `dispatch-event' to handle it. In most cases, you will want to use `next-command-event', which returns @@ -1965,9 +1989,8 @@ happened (such as an focus-change notification) that must be handled synchronously with other events. `dispatch-event' knows what to do with these events. -*/ ) - (event, prompt) - Lisp_Object event, prompt; +*/ + (event, prompt)) { /* This function can GC */ /* #### We start out using the selected console before an event @@ -2100,7 +2123,7 @@ { run_pre_idle_hook (); redisplay (); - next_event_internal (event, 1); + next_event_internal (event, 1, 1); Vquit_flag = Qnil; /* Read C-g as an event. */ store_this_key = 1; } @@ -2213,8 +2236,7 @@ return (event); } -DEFUN ("next-command-event", Fnext_command_event, Snext_command_event, - 0, 2, 0 /* +DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /* Return the next available \"user\" event. Pass this object to `dispatch-event' to handle it. @@ -2236,9 +2258,8 @@ (misc-user-event-p event)))) (dispatch-event event)) -*/ ) - (event, prompt) - Lisp_Object event, prompt; +*/ + (event, prompt)) { /* This function can GC */ struct gcpro gcpro1; @@ -2267,13 +2288,13 @@ deallocate_event_chain (event); } -DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0 /* +DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* Discard any pending \"user\" events. Also cancel any kbd macro being defined. A user event is a key press, button press, button release, or \"other-user\" event (menu selection or scrollbar action). -*/ ) - () +*/ + ()) { /* This throws away user-input on the queue, but doesn't process any events. Calling dispatch_event() here leads to a race condition. @@ -2303,7 +2324,7 @@ /* This will take stuff off the command_event_queue, or read it from the event_stream, but it will not block. */ - next_event_internal (event, 1); + next_event_internal (event, 1, 1); Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it). It is vitally important that we reset Vquit_flag here. Otherwise, if we're @@ -2360,12 +2381,12 @@ /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)? */ -DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, - 0, 3, 0 /* +DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /* Allow any pending output from subprocesses to be read by Emacs. It is read into the process' buffers or given to their filter functions. Non-nil arg PROCESS means do not return until some output has been received - from PROCESS. + from PROCESS. Nil arg PROCESS means do not return until some output has + been received from any process. If the second arg is non-nil, it is the maximum number of seconds to wait: this function will return after that much time even if no input has arrived from PROCESS. This argument may be a float, meaning wait some fractional @@ -2373,9 +2394,8 @@ If the third arg is non-nil, it is a number of milliseconds that is added to the second arg. (This exists only for compatibility.) Return non-nil iff we received any output before the timeout expired. -*/ ) - (process, timeout_secs, timeout_msecs) - Lisp_Object process, timeout_secs, timeout_msecs; +*/ + (process, timeout_secs, timeout_msecs)) { /* This function can GC */ struct gcpro gcpro1, gcpro2; @@ -2383,6 +2403,7 @@ Lisp_Object result = Qnil; int timeout_id; int timeout_enabled = 0; + int done = 0; struct buffer *old_buffer = current_buffer; /* We preserve the current buffer but nothing else. If a focus @@ -2395,7 +2416,7 @@ GCPRO2 (event, process); - if (!NILP (process) && (!NILP (timeout_secs) || !NILP (timeout_msecs))) + if (!NILP (timeout_secs) || !NILP (timeout_msecs)) { unsigned long msecs = 0; if (!NILP (timeout_secs)) @@ -2414,7 +2435,10 @@ event = Fmake_event (); - while (!NILP (process) + while (!done && + ((NILP (process) && timeout_enabled) || + (NILP (process) && event_stream_event_pending_p (0)) || + (!NILP (process)))) /* Calling detect_input_pending() is the wrong thing here, because that considers the Vunread_command_events and command_event_queue. We don't need to look at the command_event_queue because we are @@ -2429,13 +2453,13 @@ loop will process it, and I don't think that there is ever a time when one calls accept-process-output with a nil argument and really need the processes to be handled. */ - || (!EQ (result, Qt) && event_stream_event_pending_p (0))) { /* If our timeout has arrived, we move along. */ if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0)) { timeout_enabled = 0; - process = Qnil; /* We're done. */ + done = 1; /* We're done. */ + continue; /* Don't call next_event_internal */ } QUIT; /* next_event_internal() does not QUIT, so check for ^G @@ -2443,7 +2467,7 @@ less likely that the filter will actually be aborted. */ - next_event_internal (event, 0); + next_event_internal (event, 0, 1); /* If C-g was pressed while we were waiting, Vquit_flag got set and next_event_internal() also returns C-g. When we enqueue the C-g below, it will get discarded. The @@ -2452,9 +2476,10 @@ { case process_event: { - if (EQ (XEVENT (event)->event.process.process, process)) + if (NILP (process) || + EQ (XEVENT (event)->event.process.process, process)) { - process = Qnil; + done = 1; /* RMS's version always returns nil when proc is nil, and only returns t if input ever arrived on proc. */ result = Qt; @@ -2469,6 +2494,7 @@ case pointer_motion_event: case magic_event: { + EXECUTE_INTERNAL: execute_internal_event (event); break; } @@ -2490,12 +2516,11 @@ return result; } -DEFUN ("sleep-for", Fsleep_for, Ssleep_for, 1, 1, 0 /* +DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /* Pause, without updating display, for ARG seconds. ARG may be a float, meaning pause for some fractional part of a second. -*/ ) - (seconds) - Lisp_Object seconds; +*/ + (seconds)) { /* This function can GC */ unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); @@ -2521,15 +2546,22 @@ consumer as well. We don't care about command and eval-events anyway. */ - next_event_internal (event, 0); /* blocks */ + next_event_internal (event, 0, 0); /* blocks */ /* See the comment in accept-process-output about Vquit_flag */ switch (XEVENT_TYPE (event)) { + case process_event: + { + /* Avoid calling filter functions recursively by squirreling + away process events */ + enqueue_process_event (Fcopy_event (event, Qnil)); + goto DONE_LABEL; + } + case timeout_event: /* We execute the event even if it's ours, and notice that it's happened above. */ case pointer_motion_event: - case process_event: case magic_event: { EXECUTE_INTERNAL: @@ -2549,16 +2581,15 @@ return Qnil; } -DEFUN ("sit-for", Fsit_for, Ssit_for, 1, 2, 0 /* +DEFUN ("sit-for", Fsit_for, 1, 2, 0, /* Perform redisplay, then wait ARG seconds or until user input is available. ARG may be a float, meaning a fractional part of a second. Optional second arg non-nil means don't redisplay, just wait for input. Redisplay is preempted as always if user input arrives, and does not happen if input is available before it starts. Value is t if waited the full time with no input arriving. -*/ ) - (seconds, nodisplay) - Lisp_Object seconds, nodisplay; +*/ + (seconds, nodisplay)) { /* This function can GC */ unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); @@ -2627,7 +2658,7 @@ consumer as well. In fact, we know there's nothing on the command_event_queue that we didn't just put there. */ - next_event_internal (event, 0); /* blocks */ + next_event_internal (event, 0, 0); /* blocks */ /* See the comment in accept-process-output about Vquit_flag */ if (command_event_p (event)) @@ -2643,6 +2674,14 @@ enqueue_command_event (Fcopy_event (event, Qnil)); break; } + + case process_event: + { + /* Avoid recursive calls to process filters */ + enqueue_process_event (Fcopy_event (event, Qnil)); + break; + } + case timeout_event: /* We execute the event even if it's ours, and notice that it's happened above. */ @@ -2697,7 +2736,7 @@ command_event_queue; there are only user and eval-events there, and we'd just have to put them back anyway. */ - next_event_internal (event, 0); + next_event_internal (event, 0, 1); /* See the comment in accept-process-output about Vquit_flag */ if (command_event_p (event) || (XEVENT_TYPE (event) == eval_event) @@ -2795,14 +2834,12 @@ #endif ) { - /* Currently, we rely on SIGCHLD to indicate that - the process has terminated. Unfortunately, it - appears that on some systems the SIGCHLD gets - missed some of the time. So, we put in am - additional check in status_notify() to see - whether a process has terminated. We have to - tell status_notify() to enable that check, and - we do so now. */ + /* Currently, we rely on SIGCHLD to indicate that the + process has terminated. Unfortunately, on some systems + the SIGCHLD gets missed some of the time. So we put an + additional check in status_notify() to see whether a + process has terminated. We must tell status_notify() + to enable that check, and we do so now. */ kick_status_notify (); } else @@ -3132,12 +3169,12 @@ Lisp_Object recent_keys_ring; int recent_keys_ring_index; -DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0 /* +DEFUN ("recent-keys", Frecent_keys, 0, 0, 0, /* Return vector of last 100 or so keyboard or mouse button events read. This copies the event objects into a new vector; it is safe to keep and modify them. -*/ ) - () +*/ + ()) { struct gcpro gcpro1; Lisp_Object val = Qnil; @@ -3617,7 +3654,7 @@ } -DEFUN ("dispatch-event", Fdispatch_event, Sdispatch_event, 1, 1, 0 /* +DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /* Given an event object as returned by `next-event', execute it. Key-press, button-press, and button-release events get accumulated @@ -3637,9 +3674,8 @@ appropriately (see `start-process'). Magic events are handled as necessary. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { /* This function can GC */ struct command_builder *command_builder; @@ -3845,7 +3881,7 @@ return (Qnil); } -DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 3, 0 /* +DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /* Read a sequence of keystrokes or mouse clicks. Returns a vector of the event objects read. The vector and the event objects it contains are freshly created (and will not be side-effected @@ -3878,9 +3914,8 @@ `read-key-sequence' checks `function-key-map' for function key sequences, where they wouldn't conflict with ordinary bindings. See `function-key-map' for more details. -*/ ) - (prompt, continue_echo, dont_downcase_last) - Lisp_Object prompt, continue_echo, dont_downcase_last; +*/ + (prompt, continue_echo, dont_downcase_last)) { /* This function can GC */ struct console *con = XCONSOLE (Vselected_console); /* #### correct? @@ -3936,12 +3971,12 @@ RETURN_UNGCPRO (unbind_to (speccount, result)); } -DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0 /* +DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /* Return a vector of the keyboard or mouse button events that were used to invoke this command. This copies the vector and the events; it is safe to keep and modify them. -*/ ) - () +*/ + ()) { Lisp_Object event; Lisp_Object result; @@ -3959,8 +3994,7 @@ return (result); } -DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, - Sreset_this_command_lengths, 0, 0, 0 /* +DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /* Used for complicated reasons in `universal-argument-other-key'. `universal-argument-other-key' rereads the event just typed. @@ -3972,8 +4006,8 @@ Calling this function directs the translated event to replace the original event, so that only one version of the event actually appears in the echo area and in the value of `this-command-keys.'. -*/ ) - () +*/ + ()) { /* #### I don't understand this at all, so currently it does nothing. If there is ever a problem, maybe someone should investigate. */ @@ -4015,13 +4049,12 @@ Lstream_flush (XLSTREAM (Vdribble_file)); } -DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1, - "FOpen dribble file: " /* +DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1, + "FOpen dribble file: ", /* Start writing all keyboard characters to a dribble file called FILE. If FILE is nil, close any open dribble file. -*/ ) - (file) - Lisp_Object file; +*/ + (file)) { /* This function can GC */ /* XEmacs change: always close existing dribble file. */ @@ -4059,24 +4092,24 @@ "Undefined keystroke sequence", Qerror); defsymbol (&Qcommand_execute, "command-execute"); - defsubr (&Srecent_keys); - defsubr (&Sinput_pending_p); - defsubr (&Senqueue_eval_event); - defsubr (&Snext_event); - defsubr (&Snext_command_event); - defsubr (&Sdiscard_input); - defsubr (&Ssit_for); - defsubr (&Ssleep_for); - defsubr (&Saccept_process_output); - defsubr (&Sadd_timeout); - defsubr (&Sdisable_timeout); - defsubr (&Sadd_async_timeout); - defsubr (&Sdisable_async_timeout); - defsubr (&Sdispatch_event); - defsubr (&Sread_key_sequence); - defsubr (&Sthis_command_keys); - defsubr (&Sreset_this_command_lengths); - defsubr (&Sopen_dribble_file); + DEFSUBR (Frecent_keys); + DEFSUBR (Finput_pending_p); + DEFSUBR (Fenqueue_eval_event); + DEFSUBR (Fnext_event); + DEFSUBR (Fnext_command_event); + DEFSUBR (Fdiscard_input); + DEFSUBR (Fsit_for); + DEFSUBR (Fsleep_for); + DEFSUBR (Faccept_process_output); + DEFSUBR (Fadd_timeout); + DEFSUBR (Fdisable_timeout); + DEFSUBR (Fadd_async_timeout); + DEFSUBR (Fdisable_async_timeout); + DEFSUBR (Fdispatch_event); + DEFSUBR (Fread_key_sequence); + DEFSUBR (Fthis_command_keys); + DEFSUBR (Freset_this_command_lengths); + DEFSUBR (Fopen_dribble_file); defsymbol (&Qpre_command_hook, "pre-command-hook"); defsymbol (&Qpost_command_hook, "post-command-hook"); @@ -4123,6 +4156,10 @@ staticpro (&command_event_queue); command_event_queue_tail = Qnil; + process_event_queue = Qnil; + staticpro (&process_event_queue); + process_event_queue_tail = Qnil; + Vlast_selected_frame = Qnil; staticpro (&Vlast_selected_frame);
--- a/src/events.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/events.c Mon Aug 13 08:50:05 2007 +0200 @@ -388,12 +388,12 @@ to determine if, for a given button-down event, what the binding for the corresponding button-up event is. */ -DEFUN ("make-event", Fmake_event, Smake_event, 0, 0, 0 /* +DEFUN ("make-event", Fmake_event, 0, 0, 0, /* Create a new empty event. WARNING, the event object returned may be a reused one; see the function `deallocate-event'. -*/ ) - () +*/ + ()) { Lisp_Object event; @@ -410,16 +410,15 @@ return event; } -DEFUN ("deallocate-event", Fdeallocate_event, Sdeallocate_event, 1, 1, 0 /* +DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /* Allow the given event structure to be reused. You MUST NOT use this event object after calling this function with it. You will lose. It is not necessary to call this function, as event objects are garbage-collected like all other objects; however, it may be more efficient to explicitly deallocate events when you are sure that it is safe to do so. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_EVENT (event); @@ -459,15 +458,14 @@ return Qnil; } -DEFUN ("copy-event", Fcopy_event, Scopy_event, 1, 2, 0 /* +DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /* Make a copy of the given event object. If a second argument is given, the first event is copied into the second and the second is returned. If the second argument is not supplied (or is nil) then a new event will be made as with `allocate-event.' See also the function `deallocate-event'. -*/ ) - (event1, event2) - Lisp_Object event1, event2; +*/ + (event1, event2)) { CHECK_LIVE_EVENT (event1); if (NILP (event2)) @@ -673,7 +671,6 @@ error ("character-to-event called with a deallocated event!"); c &= 255; - if (c > 127 && c <= 255) { int meta_flag = 1; @@ -790,9 +787,7 @@ return c; } - -DEFUN ("event-to-character", Fevent_to_character, Sevent_to_character, - 1, 4, 0 /* +DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /* Return the closest ASCII approximation to the given event object. If the event isn't a keypress, this returns nil. If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in @@ -809,9 +804,8 @@ the return value being restricted to ASCII. Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as both use the high bit; `M-x' and `oslash' will be indistinguishable. -*/ ) - (event, allow_extra_modifiers, allow_meta, allow_non_ascii) - Lisp_Object event, allow_extra_modifiers, allow_meta, allow_non_ascii; +*/ + (event, allow_extra_modifiers, allow_meta, allow_non_ascii)) { Emchar c; CHECK_LIVE_EVENT (event); @@ -822,8 +816,7 @@ return (c < 0 ? Qnil : make_char (c)); } -DEFUN ("character-to-event", Fcharacter_to_event, Scharacter_to_event, - 1, 4, 0 /* +DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /* Converts a keystroke specifier into an event structure, replete with bucky bits. The keystroke is the first argument, and the event to fill in is the second. This function contains knowledge about what the codes @@ -850,9 +843,8 @@ Beware that character-to-event and event-to-character are not strictly inverse functions, since events contain much more information than the ASCII character set can encode. -*/ ) - (ch, event, console, use_console_meta_flag) - Lisp_Object ch, event, console, use_console_meta_flag; +*/ + (ch, event, console, use_console_meta_flag)) { struct console *con = decode_console (console); if (NILP (event)) @@ -1025,20 +1017,18 @@ strncpy (buf, "up", 4); } -DEFUN ("eventp", Feventp, Seventp, 1, 1, 0 /* +DEFUN ("eventp", Feventp, 1, 1, 0, /* True if OBJECT is an event object. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return ((EVENTP (object)) ? Qt : Qnil); } -DEFUN ("event-live-p", Fevent_live_p, Sevent_live_p, 1, 1, 0 /* +DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /* True if OBJECT is an event object that has not been deallocated. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return ((EVENTP (object) && XEVENT (object)->event_type != dead_event) ? Qt : Qnil); @@ -1092,7 +1082,7 @@ #endif /* 0 */ -DEFUN ("event-type", Fevent_type, Sevent_type, 1, 1, 0 /* +DEFUN ("event-type", Fevent_type, 1, 1, 0, /* Return the type of EVENT. This will be a symbol; one of @@ -1106,9 +1096,8 @@ timeout A timeout has expired. eval This causes a specified action to occur when dispatched. magic Some window-system-specific event has occurred. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_LIVE_EVENT (event); switch (XEVENT (event)->event_type) @@ -1147,11 +1136,10 @@ } } -DEFUN ("event-timestamp", Fevent_timestamp, Sevent_timestamp, 1, 1, 0 /* +DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /* Return the timestamp of the given event object. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_LIVE_EVENT (event); /* This junk is so that timestamps don't get to be negative, but contain @@ -1173,22 +1161,20 @@ e = wrong_type_argument ((sym),(e)); \ } -DEFUN ("event-key", Fevent_key, Sevent_key, 1, 1, 0 /* +DEFUN ("event-key", Fevent_key, 1, 1, 0, /* Return the Keysym of the given key-press event. This will be the ASCII code of a printing character, or a symbol. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p); return (XEVENT (event)->event.key.keysym); } -DEFUN ("event-button", Fevent_button, Sevent_button, 1, 1, 0 /* +DEFUN ("event-button", Fevent_button, 1, 1, 0, /* Return the button-number of the given mouse-button-press event. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_EVENT_TYPE2 (event, button_press_event, button_release_event, Qbutton_event_p); @@ -1199,14 +1185,12 @@ #endif /* !HAVE_WINDOW_SYSTEM */ } -DEFUN ("event-modifier-bits", Fevent_modifier_bits, Sevent_modifier_bits, - 1, 1, 0 /* +DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* Return a number representing the modifier keys which were down when the given mouse or keyboard event was produced. See also the function event-modifiers. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { again: CHECK_LIVE_EVENT (event); @@ -1224,13 +1208,12 @@ } } -DEFUN ("event-modifiers", Fevent_modifiers, Sevent_modifiers, 1, 1, 0 /* +DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /* Return a list of symbols, the names of the modifier keys which were down when the given mouse or keyboard event was produced. See also the function event-modifier-bits. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int mod = XINT (Fevent_modifier_bits (event)); Lisp_Object result = Qnil; @@ -1284,15 +1267,13 @@ return 1; } -DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, Sevent_window_x_pixel, - 1, 1, 0 /* +DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /* Return the X position in pixels of the given mouse event. The value returned is relative to the window the event occurred in. This will signal an error if the event is not a mouse-motion, button-press, or button-release event. See also `event-x-pixel'. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int x, y; @@ -1304,15 +1285,13 @@ return make_int (x); } -DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, Sevent_window_y_pixel, - 1, 1, 0 /* +DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /* Return the Y position in pixels of the given mouse event. The value returned is relative to the window the event occurred in. This will signal an error if the event is not a mouse-motion, button-press, or button-release event. See also `event-y-pixel'. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int x, y; @@ -1324,15 +1303,13 @@ return make_int (y); } -DEFUN ("event-x-pixel", Fevent_x_pixel, Sevent_x_pixel, - 1, 1, 0 /* +DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /* Return the X position in pixels of the given mouse event. The value returned is relative to the frame the event occurred in. This will signal an error if the event is not a mouse-motion, button-press, or button-release event. See also `event-window-x-pixel'. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int x, y; @@ -1344,15 +1321,13 @@ return make_int (x); } -DEFUN ("event-y-pixel", Fevent_y_pixel, Sevent_y_pixel, - 1, 1, 0 /* +DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /* Return the Y position in pixels of the given mouse event. The value returned is relative to the frame the event occurred in. This will signal an error if the event is not a mouse-motion, button-press, or button-release event. See also `event-window-y-pixel'. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int x, y; @@ -1472,13 +1447,11 @@ return result; } -DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, - Sevent_over_text_area_p, 1, 1, 0 /* +DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /* Return whether the given mouse event occurred over the text area of a window. The modeline is not considered to be part of the text area. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); @@ -1488,12 +1461,10 @@ return Qnil; } -DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, Sevent_over_modeline_p, - 1, 1, 0 /* +DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /* Return whether the given mouse event occurred over the modeline of a window. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); @@ -1503,12 +1474,10 @@ return Qnil; } -DEFUN ("event-over-border-p", Fevent_over_border_p, Sevent_over_border_p, - 1, 1, 0 /* +DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /* Return whether the given mouse event occurred over an internal border. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); @@ -1518,12 +1487,10 @@ return Qnil; } -DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, Sevent_over_toolbar_p, - 1, 1, 0 /* +DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /* Return whether the given mouse event occurred over a toolbar. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); @@ -1545,25 +1512,23 @@ return XCONSOLE (console); } -DEFUN ("event-channel", Fevent_channel, Sevent_channel, 1, 1, 0 /* +DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /* Return the channel that the given event occurred on. This will be a frame, device, console, or nil for some types of events (e.g. eval events). -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_LIVE_EVENT (event); return EVENT_CHANNEL (XEVENT (event)); } -DEFUN ("event-window", Fevent_window, Sevent_window, 1, 1, 0 /* +DEFUN ("event-window", Fevent_window, 1, 1, 0, /* Return the window of the given mouse event. This may be nil if the event occurred in the border or over a toolbar. The modeline is considered to be in the window it represents. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { struct window *w; Lisp_Object window; @@ -1579,14 +1544,13 @@ } } -DEFUN ("event-point", Fevent_point, Sevent_point, 1, 1, 0 /* +DEFUN ("event-point", Fevent_point, 1, 1, 0, /* Return the character position of the given mouse event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Bufpos bufp; struct window *w; @@ -1601,8 +1565,7 @@ return make_int (bufp); } -DEFUN ("event-closest-point", Fevent_closest_point, Sevent_closest_point, - 1, 1, 0 /* +DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /* Return the character position of the given mouse event. If the event did not occur over a window or over text, return the closest point to the location of the event. If the Y pixel position @@ -1613,9 +1576,8 @@ of the line containing the Y position. If the Y pixel position is above a window, return 0. If it is below a window, return the value of (window-end). -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Bufpos bufp; @@ -1627,12 +1589,11 @@ return make_int (bufp); } -DEFUN ("event-x", Fevent_x, Sevent_x, 1, 1, 0 /* +DEFUN ("event-x", Fevent_x, 1, 1, 0, /* Return the X position of the given mouse event in characters. This is relative to the window the event occurred over. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int char_x; @@ -1641,12 +1602,11 @@ return make_int (char_x); } -DEFUN ("event-y", Fevent_y, Sevent_y, 1, 1, 0 /* +DEFUN ("event-y", Fevent_y, 1, 1, 0, /* Return the Y position of the given mouse event in characters. This is relative to the window the event occurred over. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { int char_y; @@ -1655,8 +1615,7 @@ return make_int (char_y); } -DEFUN ("event-modeline-position", Fevent_modeline_position, - Sevent_modeline_position, 1, 1, 0 /* +DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /* Return the character position in the modeline that EVENT occurred over. EVENT should be a mouse event. If EVENT did not occur over a modeline, nil is returned. You can determine the actual character that the @@ -1664,9 +1623,8 @@ returned character position. Note that `generated-modeline-string' is buffer-local, and you must use EVENT's buffer when retrieving `generated-modeline-string' in order to get accurate results. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Charcount mbufp; @@ -1678,12 +1636,10 @@ return make_int (mbufp); } -DEFUN ("event-glyph", Fevent_glyph, Sevent_glyph, - 1, 1, 0 /* +DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /* Return the glyph that the given mouse event occurred over, or nil. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Lisp_Object glyph; struct window *w; @@ -1698,13 +1654,11 @@ return Qnil; } -DEFUN ("event-glyph-extent", Fevent_glyph_extent, Sevent_glyph_extent, - 1, 1, 0 /* +DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /* Return the extent of the glyph that the given mouse event occurred over. If the event did not occur over a glyph, nil is returned. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Lisp_Object extent; struct window *w; @@ -1719,14 +1673,12 @@ return Qnil; } -DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, Sevent_glyph_x_pixel, - 1, 1, 0 /* +DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /* Return the X pixel position of EVENT relative to the glyph it occurred over. EVENT should be a mouse event. If the event did not occur over a glyph, nil is returned. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Lisp_Object extent; struct window *w; @@ -1740,14 +1692,12 @@ return Qnil; } -DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, Sevent_glyph_y_pixel, - 1, 1, 0 /* +DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /* Return the Y pixel position of EVENT relative to the glyph it occurred over. EVENT should be a mouse event. If the event did not occur over a glyph, nil is returned. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Lisp_Object extent; struct window *w; @@ -1761,13 +1711,11 @@ return Qnil; } -DEFUN ("event-toolbar-button", Fevent_toolbar_button, Sevent_toolbar_button, - 1, 1, 0 /* +DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /* Return the toolbar button that the given mouse event occurred over. If the event did not occur over a toolbar, nil is returned. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { #ifdef HAVE_TOOLBARS Lisp_Object button; @@ -1787,22 +1735,20 @@ return Qnil; } -DEFUN ("event-process", Fevent_process, Sevent_process, 1, 1, 0 /* +DEFUN ("event-process", Fevent_process, 1, 1, 0, /* Return the process of the given process-output event. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p); return (XEVENT (event)->event.process.process); } -DEFUN ("event-function", Fevent_function, Sevent_function, 1, 1, 0 /* +DEFUN ("event-function", Fevent_function, 1, 1, 0, /* Return the callback function of EVENT. EVENT should be a timeout, misc-user, or eval event. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { CHECK_LIVE_EVENT (event); switch (XEVENT (event)->event_type) @@ -1817,12 +1763,11 @@ } } -DEFUN ("event-object", Fevent_object, Sevent_object, 1, 1, 0 /* +DEFUN ("event-object", Fevent_object, 1, 1, 0, /* Return the callback function argument of EVENT. EVENT should be a timeout, misc-user, or eval event. -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { again: CHECK_LIVE_EVENT (event); @@ -1839,12 +1784,11 @@ } } -DEFUN ("event-properties", Fevent_properties, Sevent_properties, 1, 1, 0 /* +DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /* Return a list of all of the properties of EVENT. This is in the form of a property list (alternating keyword/value pairs). -*/ ) - (event) - Lisp_Object event; +*/ + (event)) { Lisp_Object props = Qnil; struct Lisp_Event *e; @@ -1917,45 +1861,45 @@ void syms_of_events (void) { - defsubr (&Scharacter_to_event); - defsubr (&Sevent_to_character); + DEFSUBR (Fcharacter_to_event); + DEFSUBR (Fevent_to_character); - defsubr (&Smake_event); - defsubr (&Sdeallocate_event); - defsubr (&Scopy_event); - defsubr (&Seventp); - defsubr (&Sevent_live_p); - defsubr (&Sevent_type); - defsubr (&Sevent_properties); + DEFSUBR (Fmake_event); + DEFSUBR (Fdeallocate_event); + DEFSUBR (Fcopy_event); + DEFSUBR (Feventp); + DEFSUBR (Fevent_live_p); + DEFSUBR (Fevent_type); + DEFSUBR (Fevent_properties); - defsubr (&Sevent_timestamp); - defsubr (&Sevent_key); - defsubr (&Sevent_button); - defsubr (&Sevent_modifier_bits); - defsubr (&Sevent_modifiers); - defsubr (&Sevent_x_pixel); - defsubr (&Sevent_y_pixel); - defsubr (&Sevent_window_x_pixel); - defsubr (&Sevent_window_y_pixel); - defsubr (&Sevent_over_text_area_p); - defsubr (&Sevent_over_modeline_p); - defsubr (&Sevent_over_border_p); - defsubr (&Sevent_over_toolbar_p); - defsubr (&Sevent_channel); - defsubr (&Sevent_window); - defsubr (&Sevent_point); - defsubr (&Sevent_closest_point); - defsubr (&Sevent_x); - defsubr (&Sevent_y); - defsubr (&Sevent_modeline_position); - defsubr (&Sevent_glyph); - defsubr (&Sevent_glyph_extent); - defsubr (&Sevent_glyph_x_pixel); - defsubr (&Sevent_glyph_y_pixel); - defsubr (&Sevent_toolbar_button); - defsubr (&Sevent_process); - defsubr (&Sevent_function); - defsubr (&Sevent_object); + DEFSUBR (Fevent_timestamp); + DEFSUBR (Fevent_key); + DEFSUBR (Fevent_button); + DEFSUBR (Fevent_modifier_bits); + DEFSUBR (Fevent_modifiers); + DEFSUBR (Fevent_x_pixel); + DEFSUBR (Fevent_y_pixel); + DEFSUBR (Fevent_window_x_pixel); + DEFSUBR (Fevent_window_y_pixel); + DEFSUBR (Fevent_over_text_area_p); + DEFSUBR (Fevent_over_modeline_p); + DEFSUBR (Fevent_over_border_p); + DEFSUBR (Fevent_over_toolbar_p); + DEFSUBR (Fevent_channel); + DEFSUBR (Fevent_window); + DEFSUBR (Fevent_point); + DEFSUBR (Fevent_closest_point); + DEFSUBR (Fevent_x); + DEFSUBR (Fevent_y); + DEFSUBR (Fevent_modeline_position); + DEFSUBR (Fevent_glyph); + DEFSUBR (Fevent_glyph_extent); + DEFSUBR (Fevent_glyph_x_pixel); + DEFSUBR (Fevent_glyph_y_pixel); + DEFSUBR (Fevent_toolbar_button); + DEFSUBR (Fevent_process); + DEFSUBR (Fevent_function); + DEFSUBR (Fevent_object); defsymbol (&Qeventp, "eventp"); defsymbol (&Qevent_live_p, "event-live-p");
--- a/src/extents.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/extents.c Mon Aug 13 08:50:05 2007 +0200 @@ -445,7 +445,6 @@ /* Qhighlight defined in general.c */ Lisp_Object Qunique; Lisp_Object Qduplicable; -Lisp_Object Qreplicating; Lisp_Object Qdetachable; Lisp_Object Qpriority; Lisp_Object Qmouse_face; @@ -2959,12 +2958,11 @@ if (!NILP (extent_read_only (anc))) *bp++ = '%'; if (!NILP (extent_mouse_face (anc))) *bp++ = 'H'; if (extent_unique_p (anc)) *bp++ = 'U'; - else if (extent_replicating_p (anc)) *bp++ = 'R'; else if (extent_duplicable_p (anc)) *bp++ = 'D'; if (!NILP (extent_invisible (anc))) *bp++ = 'I'; if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || - extent_unique_p (anc) || extent_replicating_p (anc) || + extent_unique_p (anc) || extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) *bp++ = ' '; @@ -3222,80 +3220,71 @@ return make_int (extent_endpoint_bufpos (extent, endp)); } -DEFUN ("extentp", Fextentp, Sextentp, 1, 1, 0 /* +DEFUN ("extentp", Fextentp, 1, 1, 0, /* T if OBJECT is an extent. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (EXTENTP (object)) return Qt; return Qnil; } -DEFUN ("extent-live-p", Fextent_live_p, Sextent_live_p, 1, 1, 0 /* +DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /* T if OBJECT is an extent and the extent has not been destroyed. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object))) return Qt; return Qnil; } -DEFUN ("extent-detached-p", Fextent_detached_p, Sextent_detached_p, 1, 1, 0 /* +DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /* T if EXTENT is detached. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { if (extent_detached_p (decode_extent (extent, 0))) return Qt; return Qnil; } -DEFUN ("extent-object", Fextent_object, Sextent_object, 1, 1, 0 /* +DEFUN ("extent-object", Fextent_object, 1, 1, 0, /* Return object (buffer or string) EXTENT refers to. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { return extent_object (decode_extent (extent, 0)); } -DEFUN ("extent-start-position", Fextent_start_position, - Sextent_start_position, 1, 1, 0 /* +DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /* Return start position of EXTENT, or nil if EXTENT is detached. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { return extent_endpoint_external (extent, 0); } -DEFUN ("extent-end-position", Fextent_end_position, - Sextent_end_position, 1, 1, 0 /* +DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /* Return end position of EXTENT, or nil if EXTENT is detached. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { return extent_endpoint_external (extent, 1); } -DEFUN ("extent-length", Fextent_length, Sextent_length, 1, 1, 0 /* +DEFUN ("extent-length", Fextent_length, 1, 1, 0, /* Return length of EXTENT in characters. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); return make_int (extent_endpoint_bufpos (e, 1) - extent_endpoint_bufpos (e, 0)); } -DEFUN ("next-extent", Fnext_extent, Snext_extent, 1, 1, 0 /* +DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /* Find next extent after EXTENT. If EXTENT is a buffer return the first extent in the buffer; likewise for strings. @@ -3308,9 +3297,8 @@ extents in a buffer. Note: The display order is not necessarily the order that `map-extents' processes extents in! -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { Lisp_Object val; EXTENT next; @@ -3326,14 +3314,13 @@ return (val); } -DEFUN ("previous-extent", Fprevious_extent, Sprevious_extent, 1, 1, 0 /* +DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /* Find last extent before EXTENT. If EXTENT is a buffer return the last extent in the buffer; likewise for strings. This function is analogous to `next-extent'. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { Lisp_Object val; EXTENT prev; @@ -3351,13 +3338,12 @@ #ifdef DEBUG_XEMACS -DEFUN ("next-e-extent", Fnext_e_extent, Snext_e_extent, 1, 1, 0 /* +DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* Find next extent after EXTENT using the \"e\" order. If EXTENT is a buffer return the first extent in the buffer; likewise for strings. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { Lisp_Object val; EXTENT next; @@ -3373,14 +3359,13 @@ return (val); } -DEFUN ("previous-e-extent", Fprevious_e_extent, Sprevious_e_extent, 1, 1, 0 /* +DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* Find last extent before EXTENT using the \"e\" order. If EXTENT is a buffer return the last extent in the buffer; likewise for strings. This function is analogous to `next-e-extent'. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { Lisp_Object val; EXTENT prev; @@ -3398,15 +3383,13 @@ #endif -DEFUN ("next-extent-change", Fnext_extent_change, Snext_extent_change, - 1, 2, 0 /* +DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* Return the next position after POS where an extent begins or ends. If POS is at the end of the buffer or string, POS will be returned; otherwise a position greater than POS will always be returned. If BUFFER is nil, the current buffer is assumed. -*/ ) - (pos, object) - Lisp_Object pos, object; +*/ + (pos, object)) { Lisp_Object obj = decode_buffer_or_string (object); Bytind bpos; @@ -3416,15 +3399,13 @@ return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos)); } -DEFUN ("previous-extent-change", Fprevious_extent_change, - Sprevious_extent_change, 1, 2, 0 /* +DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* Return the last position before POS where an extent begins or ends. If POS is at the beginning of the buffer or string, POS will be returned; otherwise a position less than POS will always be returned. If OBJECT is nil, the current buffer is assumed. -*/ ) - (pos, object) - Lisp_Object pos, object; +*/ + (pos, object)) { Lisp_Object obj = decode_buffer_or_string (object); Bytind bpos; @@ -3439,29 +3420,27 @@ /* parent and children stuff */ /************************************************************************/ -DEFUN ("extent-parent", Fextent_parent, Sextent_parent, 1, 1, 0 /* +DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /* Return the parent (if any) of EXTENT. If an extent has a parent, it derives all its properties from that extent and has no properties of its own. (The only \"properties\" that the extent keeps are the buffer/string it refers to and the start and end points.) It is possible for an extent's parent to itself have a parent. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) /* do I win the prize for the strangest split infinitive? */ { EXTENT e = decode_extent (extent, 0); return extent_parent (e); } -DEFUN ("extent-children", Fextent_children, Sextent_children, 1, 1, 0 /* +DEFUN ("extent-children", Fextent_children, 1, 1, 0, /* Return a list of the children (if any) of EXTENT. The children of an extent are all those extents whose parent is that extent. This function does not recursively trace children of children. \(To do that, use `extent-descendants'.) -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT e = decode_extent (extent, 0); Lisp_Object children = extent_children (e); @@ -3501,12 +3480,11 @@ XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children)); } -DEFUN ("set-extent-parent", Fset_extent_parent, Sset_extent_parent, 2, 2, 0 /* +DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /* Set the parent of EXTENT to PARENT (may be nil). See `extent-parent'. -*/ ) - (extent, parent) - Lisp_Object extent, parent; +*/ + (extent, parent)) { EXTENT e = decode_extent (extent, 0); Lisp_Object cur_parent = extent_parent (e); @@ -3703,7 +3681,7 @@ extent_object (extent) = Qt; } -DEFUN ("make-extent", Fmake_extent, Smake_extent, 2, 3, 0 /* +DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /* Make an extent for the range [FROM, TO) in BUFFER-OR-STRING. BUFFER-OR-STRING defaults to the current buffer. Insertions at point TO will be outside of the extent; insertions at FROM will be inside the @@ -3712,9 +3690,8 @@ using `set-extent-property'. The extent is initially detached if both FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil, meaning the extent is in no buffer and no string. -*/ ) - (from, to, buffer_or_string) - Lisp_Object from, to, buffer_or_string; +*/ + (from, to, buffer_or_string)) { Lisp_Object extent_obj = Qnil; Lisp_Object obj; @@ -3737,12 +3714,11 @@ return extent_obj; } -DEFUN ("copy-extent", Fcopy_extent, Scopy_extent, 1, 2, 0 /* +DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /* Make a copy of EXTENT. It is initially detached. Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string. -*/ ) - (extent, buffer_or_string) - Lisp_Object extent, buffer_or_string; +*/ + (extent, buffer_or_string)) { EXTENT ext = decode_extent (extent, 0); @@ -3755,13 +3731,12 @@ return extent; } -DEFUN ("delete-extent", Fdelete_extent, Sdelete_extent, 1, 1, 0 /* +DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /* Remove EXTENT from its buffer and destroy it. This does not modify the buffer's text, only its display properties. The extent cannot be used thereafter. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT ext; @@ -3776,7 +3751,7 @@ return Qnil; } -DEFUN ("detach-extent", Fdetach_extent, Sdetach_extent, 1, 1, 0 /* +DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /* Remove EXTENT from its buffer in such a way that it can be re-inserted. An extent is also detached when all of its characters are all killed by a deletion, unless its `detachable' property has been unset. @@ -3788,9 +3763,8 @@ are not recorded. This means that extent changes which are to be undo-able must be performed by character editing, or by insertion and detachment of duplicable extents. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT ext = decode_extent (extent, 0); @@ -3803,17 +3777,15 @@ return extent; } -DEFUN ("set-extent-endpoints", Fset_extent_endpoints, Sset_extent_endpoints, - 3, 4, 0 /* +DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /* Set the endpoints of EXTENT to START, END. If START and END are null, call detach-extent on EXTENT. BUFFER-OR-STRING specifies the new buffer or string that the extent should be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT is in no buffer and no string, it defaults to the current buffer.) See documentation on `detach-extent' for a discussion of undo recording. -*/ ) - (extent, start, end, buffer_or_string) - Lisp_Object extent, start, end, buffer_or_string; +*/ + (extent, start, end, buffer_or_string)) { EXTENT ext; Bytind s, e; @@ -3900,14 +3872,12 @@ return retval; } -DEFUN ("extent-in-region-p", Fextent_in_region_p, Sextent_in_region_p, - 1, 4, 0 /* +DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /* Return whether EXTENT overlaps a specified region. This is equivalent to whether `map-extents' would visit EXTENT when called with these args. -*/ ) - (extent, from, to, flags) - Lisp_Object extent, from, to, flags; +*/ + (extent, from, to, flags)) { EXTENT ext; Lisp_Object obj; @@ -3961,7 +3931,7 @@ return 1; } -DEFUN ("map-extents", Fmap_extents, Smap_extents, 1, 8, 0 /* +DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /* Map FUNCTION over the extents which overlap a region in OBJECT. OBJECT is normally a buffer or string but could be an extent (see below). The region is normally bounded by [FROM, TO) (i.e. the beginning of the @@ -4033,9 +4003,8 @@ If optional arg PROPERTY is non-nil, only extents with that property set on them will be visited. If optional arg VALUE is non-nil, only extents whose value for that property is `eq' to VALUE will be visited. -*/ ) - (function, object, from, to, maparg, flags, property, value) - Lisp_Object function, object, from, to, maparg, flags, property, value; +*/ + (function, object, from, to, maparg, flags, property, value)) { /* This function can GC */ struct slow_map_extents_arg closure; @@ -4166,8 +4135,7 @@ return 1; } -DEFUN ("map-extent-children", Fmap_extent_children, Smap_extent_children, - 1, 8, 0 /* +DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /* Map FUNCTION over the extents in the region from FROM to TO. FUNCTION is called with arguments (extent, MAPARG). See `map-extents' for a full discussion of the arguments FROM, TO, and FLAGS. @@ -4180,9 +4148,8 @@ Thus, this function may be used to walk a tree of extents in a buffer: (defun walk-extents (buffer &optional ignore) (map-extent-children 'walk-extents buffer)) -*/ ) - (function, object, from, to, maparg, flags, property, value) - Lisp_Object function, object, from, to, maparg, flags, property, value; +*/ + (function, object, from, to, maparg, flags, property, value)) { /* This function can GC */ struct slow_map_extent_children_arg closure; @@ -4368,7 +4335,7 @@ return extent_obj; } -DEFUN ("extent-at", Fextent_at, Sextent_at, 1, 5, 0 /* +DEFUN ("extent-at", Fextent_at, 1, 5, 0, /* Find \"smallest\" extent at POS in OBJECT having PROPERTY set. Normally, an extent is \"at\" POS if it overlaps the region (POS, POS+1); i.e. if it covers the character after POS. (However, see the definition @@ -4395,9 +4362,8 @@ Note that in all cases, the start-openness and end-openness of the extents considered is ignored. If you want to pay attention to those properties, you should use `map-extents', which gives you more control. -*/ ) - (pos, object, property, before, at_flag) - Lisp_Object pos, object, property, before, at_flag; +*/ + (pos, object, property, before, at_flag)) { Bytind position; EXTENT before_extent; @@ -4776,13 +4742,12 @@ return value; } -DEFUN ("extent-face", Fextent_face, Sextent_face, 1, 1, 0 /* +DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* Return the name of the face in which EXTENT is displayed, or nil if the extent's face is unspecified. This might also return a list of face names. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { Lisp_Object face; @@ -4792,14 +4757,13 @@ return external_of_internal_memoized_face (face); } -DEFUN ("set-extent-face", Fset_extent_face, Sset_extent_face, 2, 2, 0 /* +DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /* Make the given EXTENT have the graphic attributes specified by FACE. FACE can also be a list of faces, and all faces listed will apply, with faces earlier in the list taking priority over those later in the list. -*/ ) - (extent, face) - Lisp_Object extent, face; +*/ + (extent, face)) { EXTENT e; Lisp_Object orig_face = face; @@ -4818,13 +4782,12 @@ } -DEFUN ("extent-mouse-face", Fextent_mouse_face, Sextent_mouse_face, 1, 1, 0 /* +DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /* Return the face used to highlight EXTENT when the mouse passes over it. The return value will be a face name, a list of face names, or nil if the extent's mouse face is unspecified. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { Lisp_Object face; @@ -4834,15 +4797,13 @@ return external_of_internal_memoized_face (face); } -DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, Sset_extent_mouse_face, - 2, 2, 0 /* +DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /* Set the face used to highlight EXTENT when the mouse passes over it. FACE can also be a list of faces, and all faces listed will apply, with faces earlier in the list taking priority over those later in the list. -*/ ) - (extent, face) - Lisp_Object extent, face; +*/ + (extent, face)) { EXTENT e; Lisp_Object orig_face = face; @@ -4934,56 +4895,47 @@ return glyph; } -DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, - Sset_extent_begin_glyph, 2, 3, 0 /* +DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /* Display a bitmap, subwindow or string at the beginning of EXTENT. BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'. -*/ ) - (extent, begin_glyph, layout) - Lisp_Object extent, begin_glyph, layout; +*/ + (extent, begin_glyph, layout)) { return set_extent_glyph_1 (extent, begin_glyph, 0, layout); } -DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, - Sset_extent_end_glyph, 2, 3, 0 /* +DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /* Display a bitmap, subwindow or string at the end of the EXTENT. END-GLYPH must be a glyph object. The layout policy defaults to `text'. -*/ ) - (extent, end_glyph, layout) - Lisp_Object extent, end_glyph, layout; +*/ + (extent, end_glyph, layout)) { return set_extent_glyph_1 (extent, end_glyph, 1, layout); } -DEFUN ("extent-begin-glyph", Fextent_begin_glyph, Sextent_begin_glyph, - 1, 1, 0 /* +DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /* Return the glyph object displayed at the beginning of EXTENT. If there is none, nil is returned. -*/ ) - (extent_obj) - Lisp_Object extent_obj; +*/ + (extent_obj)) { return extent_begin_glyph (decode_extent (extent_obj, 0)); } -DEFUN ("extent-end-glyph", Fextent_end_glyph, Sextent_end_glyph, 1, 1, 0 /* +DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /* Return the glyph object displayed at the end of EXTENT. If there is none, nil is returned. -*/ ) - (extent_obj) - Lisp_Object extent_obj; +*/ + (extent_obj)) { return extent_end_glyph (decode_extent (extent_obj, 0)); } -DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, - Sset_extent_begin_glyph_layout, 2, 2, 0 /* +DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /* Set the layout policy of the given extent's begin glyph. Access this using the `extent-begin-glyph-layout' function. -*/ ) - (extent, layout) - Lisp_Object extent, layout; +*/ + (extent, layout)) { EXTENT e = decode_extent (extent, 0); e = extent_ancestor (e); @@ -4992,13 +4944,11 @@ return layout; } -DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, - Sset_extent_end_glyph_layout, 2, 2, 0 /* +DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /* Set the layout policy of the given extent's end glyph. Access this using the `extent-end-glyph-layout' function. -*/ ) - (extent, layout) - Lisp_Object extent, layout; +*/ + (extent, layout)) { EXTENT e = decode_extent (extent, 0); e = extent_ancestor (e); @@ -5007,41 +4957,35 @@ return layout; } -DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, - Sextent_begin_glyph_layout, 1, 1, 0 /* +DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /* Return the layout policy associated with the given extent's begin glyph. Set this using the `set-extent-begin-glyph-layout' function. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT e = decode_extent (extent, 0); return glyph_layout_to_symbol (extent_begin_glyph_layout (e)); } -DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, - Sextent_end_glyph_layout, 1, 1, 0 /* +DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /* Return the layout policy associated with the given extent's end glyph. Set this using the `set-extent-end-glyph-layout' function. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT e = decode_extent (extent, 0); return glyph_layout_to_symbol (extent_end_glyph_layout (e)); } -DEFUN ("set-extent-priority", Fset_extent_priority, Sset_extent_priority, - 2, 2, 0 /* +DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /* Changes the display priority of EXTENT. When the extent attributes are being merged for display, the priority is used to determine which extent takes precedence in the event of a conflict (two extents whose faces both specify font, for example: the font of the extent with the higher priority will be used). Extents are created with priority 0; priorities may be negative. -*/ ) - (extent, pri) - Lisp_Object extent, pri; +*/ + (extent, pri)) { EXTENT e = decode_extent (extent, 0); @@ -5052,18 +4996,16 @@ return pri; } -DEFUN ("extent-priority", Fextent_priority, Sextent_priority, 1, 1, 0 /* +DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /* Return the display priority of EXTENT; see `set-extent-priority'. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT e = decode_extent (extent, 0); return make_int (extent_priority (e)); } -DEFUN ("set-extent-property", Fset_extent_property, Sset_extent_property, - 3, 3, 0 /* +DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /* Change a property of an extent. PROPERTY may be any symbol; the value stored may be accessed with the `extent-property' function. @@ -5134,26 +5076,13 @@ string into a buffer, the extents are copied back into the buffer. - replicating Meaningful only in conjunction with `duplicable'. - If this flag is set, extents that are copied from - buffers into strings are made children of the - original extent. When the string is pasted back - into a buffer, the same extent (i.e. the `eq' - predicate applies) that was originally in the - buffer will be used if possible -- i.e. if the - extent is detached or the paste location abuts or - overlaps the extent. This behavior is compatible - with the old "extent replica" behavior and was - apparently required by Energize. - - unique Meaningful only in conjunction with `duplicable' - and `replicating'. When this is set, there may be - only one instance of this extent attached at a - time: if it is copied to the kill ring and then - yanked, the extent is not copied. If, however, it - is killed (removed from the buffer) and then - yanked, it will be re-attached at the new - position. + unique Meaningful only in conjunction with `duplicable'. + When this is set, there may be only one instance + of this extent attached at a time: if it is copied + to the kill ring and then yanked, the extent is + not copied. If, however, it is killed (removed + from the buffer) and then yanked, it will be + re-attached at the new position. invisible If the value is non-nil, text under this extent may be treated as not present for the purpose of @@ -5209,10 +5138,8 @@ `inside-margin', or `outside-margin') of the extent's begin glyph. - end-glyph-layout The layout policy of the extent's end glyph. -*/ ) - (extent, property, value) - Lisp_Object extent, property, value; + end-glyph-layout The layout policy of the extent's end glyph. */ + (extent, property, value)) { /* This function can GC if property is `keymap' */ EXTENT e = decode_extent (extent, 0); @@ -5224,8 +5151,6 @@ extent_unique_p (e) = !NILP (value); else if (EQ (property, Qduplicable)) extent_duplicable_p (e) = !NILP (value); - else if (EQ (property, Qreplicating)) - extent_replicating_p (e) = !NILP (value); else if (EQ (property, Qinvisible)) set_extent_invisible (e, value); else if (EQ (property, Qdetachable)) @@ -5293,12 +5218,11 @@ return value; } -DEFUN ("extent-property", Fextent_property, Sextent_property, 2, 3, 0 /* +DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* Return EXTENT's value for property PROPERTY. See `set-extent-property' for the built-in property names. -*/ ) - (extent, property, defalt) - Lisp_Object extent, property, defalt; +*/ + (extent, property, defalt)) { EXTENT e = decode_extent (extent, 0); CHECK_SYMBOL (property); @@ -5313,7 +5237,6 @@ else if (EQ (property, Qend_open)) RETURN_FLAG (end_open); else if (EQ (property, Qunique)) RETURN_FLAG (unique); else if (EQ (property, Qduplicable)) RETURN_FLAG (duplicable); - else if (EQ (property, Qreplicating)) RETURN_FLAG (replicating); else if (EQ (property, Qdetachable)) RETURN_FLAG (detachable); #undef RETURN_FLAG /* Support (but don't document...) the obvious antonyms. */ @@ -5358,12 +5281,11 @@ } } -DEFUN ("extent-properties", Fextent_properties, Sextent_properties, 1, 1, 0 /* +DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* Return a property list of the attributes of the given extent. Do not modify this list; use `set-extent-property' instead. -*/ ) - (extent) - Lisp_Object extent; +*/ + (extent)) { EXTENT e, anc; Lisp_Object result, face, anc_obj = Qnil; @@ -5417,7 +5339,6 @@ result = Fcons (sym, Fcons (Qt, result)) CONS_FLAG (end_open, Qend_open); CONS_FLAG (start_open, Qstart_open); - CONS_FLAG (replicating, Qreplicating); CONS_FLAG (detachable, Qdetachable); CONS_FLAG (duplicable, Qduplicable); CONS_FLAG (unique, Qunique); @@ -5462,15 +5383,13 @@ } } -DEFUN ("force-highlight-extent", Fforce_highlight_extent, - Sforce_highlight_extent, 1, 2, 0 /* +DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /* Highlight or unhighlight the given extent. If the second arg is non-nil, it will be highlighted, else dehighlighted. This is the same as `highlight-extent', except that it will work even on extents without the `mouse-face' property. -*/ ) - (extent_obj, highlight_p) - Lisp_Object extent_obj, highlight_p; +*/ + (extent_obj, highlight_p)) { if (NILP (extent_obj)) highlight_p = Qnil; @@ -5480,15 +5399,14 @@ return Qnil; } -DEFUN ("highlight-extent", Fhighlight_extent, Shighlight_extent, 1, 2, 0 /* +DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /* Highlight the given extent, if it is highlightable \(that is, if it has the `mouse-face' property). If the second arg is non-nil, it will be highlighted, else dehighlighted. Highlighted extents are displayed as if they were merged with the face or faces specified by the `mouse-face' property. -*/ ) - (extent_obj, highlight_p) - Lisp_Object extent_obj, highlight_p; +*/ + (extent_obj, highlight_p)) { if (EXTENTP (extent_obj) && NILP (extent_mouse_face (XEXTENT (extent_obj)))) return Qnil; @@ -5616,7 +5534,7 @@ } } -DEFUN ("insert-extent", Finsert_extent, Sinsert_extent, 1, 5, 0 /* +DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* Insert EXTENT from START to END in BUFFER-OR-STRING. BUFFER-OR-STRING defaults to the current buffer if omitted. This operation does not insert any characters, @@ -5626,9 +5544,8 @@ The fourth arg, NO-HOOKS, can be used to inhibit the running of the extent's `paste-function' property if it has one. See documentation on `detach-extent' for a discussion of undo recording. -*/ ) - (extent, start, end, no_hooks, buffer_or_string) - Lisp_Object extent, start, end, no_hooks, buffer_or_string; +*/ + (extent, start, end, no_hooks, buffer_or_string)) { EXTENT ext = decode_extent (extent, 0); Lisp_Object copy; @@ -5681,14 +5598,6 @@ end + closure->from)) return 0; e = copy_extent (extent, start, end, closure->string); - if (extent_replicating_p (extent)) - { - Lisp_Object e_obj = Qnil, extent_obj = Qnil; - - XSETEXTENT (e_obj, e); - XSETEXTENT (extent_obj, extent); - Fset_extent_parent (e_obj, extent_obj); - } } return 0; @@ -5756,62 +5665,12 @@ if (!extent_duplicable_p (extent)) return 0; - if (!extent_replicating_p (extent)) - { - if (!inside_undo && - !run_extent_paste_function (extent, new_start, new_end, - closure->buffer)) - return 0; - copy_extent (extent, new_start, new_end, closure->buffer); - } - else - { - Bytind parstart = 0; - Bytind parend = 0; - Lisp_Object parent_obj = extent_parent (extent); - EXTENT parent; - - if (!EXTENTP (parent_obj)) - return 0; - parent = XEXTENT (parent_obj); - if (!EXTENT_LIVE_P (parent)) - return 0; - - if (!extent_detached_p (parent)) - { - parstart = extent_endpoint_bytind (parent, 0); - parend = extent_endpoint_bytind (parent, 1); - } - -/* #### remove this crap */ -#ifdef ENERGIZE - /* Energize extents like toplevel-forms can only be pasted - in the buffer they come from. This should be parametrized - in the generic extent objects. Right now just silently - skip the extents if it's not from the same buffer. - */ - if (!EQ (extent_object (parent), closure->buffer) - && energize_extent_data (parent)) - return 0; -#endif - - /* If this is a `unique' extent, and it is currently attached - somewhere other than here (non-overlapping), then don't copy - it (that's what `unique' means). If however it is detached, - or if we are inserting inside/adjacent to the original - extent, then insert_extent() will simply reattach it, which - is what we want. - */ - if (extent_unique_p (parent) - && !extent_detached_p (parent) - && (!EQ (extent_object (parent), closure->buffer) - || parend > new_end - || parstart < new_start)) - return 0; - - insert_extent (parent, new_start, new_end, - closure->buffer, !inside_undo); - } + if (!inside_undo && + !run_extent_paste_function (extent, new_start, new_end, + closure->buffer)) + return 0; + copy_extent (extent, new_start, new_end, closure->buffer); + return 0; } @@ -5864,13 +5723,6 @@ struct copy_string_extents_1_arg *closure = (struct copy_string_extents_1_arg *) arg; - if (extent_replicating_p (extent) && - EQ (extent_parent (extent), closure->parent_in_question)) - { - closure->found_extent = extent; - return 1; /* stop mapping */ - } - return 0; } @@ -5894,35 +5746,6 @@ new_start = old_start + closure->new_pos - closure->old_pos; new_end = old_end + closure->new_pos - closure->old_pos; - if (extent_replicating_p (extent)) - { - struct copy_string_extents_1_arg closure_1; - - closure_1.parent_in_question = extent_parent (extent); - closure_1.found_extent = 0; - - /* When adding a replicating extent, we need to make sure - that there isn't an existing replicating extent referring - to the same parent extent that abuts or overlaps. If so, - we merge with that extent rather than adding anew. */ - map_extents_bytind (closure->old_pos, closure->old_pos + closure->length, - copy_string_extents_1_mapper, - (void *) &closure, closure->new_string, 0, - /* get all extents that abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_CLOSED); - if (closure_1.found_extent) - { - Bytecount exstart = - extent_endpoint_bytind (closure_1.found_extent, 0); - Bytecount exend = - extent_endpoint_bytind (closure_1.found_extent, 1); - exstart = min (exstart, new_start); - exend = max (exend, new_end); - set_extent_endpoints (closure_1.found_extent, exstart, exend, Qnil); - return 0; - } - } - copy_extent (extent, old_start + closure->new_pos - closure->old_pos, old_end + closure->new_pos - closure->old_pos, @@ -6048,7 +5871,7 @@ } } -DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 4, 0 /* +DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /* Returns the value of the PROP property at the given position. Optional arg OBJECT specifies the buffer or string to look in, and defaults to the current buffer. @@ -6056,14 +5879,13 @@ a position, and has the same meaning as in `extent-at'. This examines only those properties added with `put-text-property'. See also `get-char-property'. -*/ ) - (pos, prop, object, at_flag) - Lisp_Object pos, prop, object, at_flag; +*/ + (pos, prop, object, at_flag)) { return get_text_property_1 (pos, prop, object, at_flag, 1); } -DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 4, 0 /* +DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* Returns the value of the PROP property at the given position. Optional arg OBJECT specifies the buffer or string to look in, and defaults to the current buffer. @@ -6071,9 +5893,8 @@ a position, and has the same meaning as in `extent-at'. This examines properties on all extents. See also `get-text-property'. -*/ ) - (pos, prop, object, at_flag) - Lisp_Object pos, prop, object, at_flag; +*/ + (pos, prop, object, at_flag)) { return get_text_property_1 (pos, prop, object, at_flag, 0); } @@ -6388,15 +6209,14 @@ return closure.changed_p; } -DEFUN ("put-text-property", Fput_text_property, Sput_text_property, 4, 5, 0 /* +DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /* Adds the given property/value to all characters in the specified region. The property is conceptually attached to the characters rather than the region. The properties are copied when the characters are copied/pasted. Fifth argument OBJECT is the buffer or string containing the text, and defaults to the current buffer. -*/ ) - (start, end, prop, value, object) - Lisp_Object start, end, prop, value, object; +*/ + (start, end, prop, value, object)) { /* This function can GC */ Bytind s, e; @@ -6408,17 +6228,16 @@ return prop; } -DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property, - Sput_nonduplicable_text_property, 4, 5, 0 /* +DEFUN ("put-nonduplicable-text-property", + Fput_nonduplicable_text_property, 4, 5, 0, /* Adds the given property/value to all characters in the specified region. The property is conceptually attached to the characters rather than the region, however the properties will not be copied when the characters are copied. Fifth argument OBJECT is the buffer or string containing the text, and defaults to the current buffer. -*/ ) - (start, end, prop, value, object) - Lisp_Object start, end, prop, value, object; +*/ + (start, end, prop, value, object)) { /* This function can GC */ Bytind s, e; @@ -6430,16 +6249,14 @@ return prop; } -DEFUN ("add-text-properties", Fadd_text_properties, Sadd_text_properties, - 3, 4, 0 /* +DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /* Add properties to the characters from START to END. The third argument PROPS is a property list specifying the property values to add. The optional fourth argument, OBJECT, is the buffer or string containing the text and defaults to the current buffer. Returns t if any property was changed, nil otherwise. -*/ ) - (start, end, props, object) - Lisp_Object start, end, props, object; +*/ + (start, end, props, object)) { /* This function can GC */ int changed = 0; @@ -6460,18 +6277,15 @@ DEFUN ("add-nonduplicable-text-properties", - Fadd_nonduplicable_text_properties, - Sadd_nonduplicable_text_properties, - 3, 4, 0 /* + Fadd_nonduplicable_text_properties, 3, 4, 0, /* Add nonduplicable properties to the characters from START to END. (The properties will not be copied when the characters are copied.) The third argument PROPS is a property list specifying the property values to add. The optional fourth argument, OBJECT, is the buffer or string containing the text and defaults to the current buffer. Returns t if any property was changed, nil otherwise. -*/ ) - (start, end, props, object) - Lisp_Object start, end, props, object; +*/ + (start, end, props, object)) { /* This function can GC */ int changed = 0; @@ -6490,16 +6304,14 @@ return (changed ? Qt : Qnil); } -DEFUN ("remove-text-properties", Fremove_text_properties, - Sremove_text_properties, 3, 4, 0 /* +DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* Remove the given properties from all characters in the specified region. PROPS should be a plist, but the values in that plist are ignored (treated as nil). Returns t if any property was changed, nil otherwise. Fourth argument OBJECT is the buffer or string containing the text, and defaults to the current buffer. -*/ ) - (start, end, props, object) - Lisp_Object start, end, props, object; +*/ + (start, end, props, object)) { /* This function can GC */ int changed = 0; @@ -6529,12 +6341,11 @@ the rest of the put-text-prop code here, I moved this as well for completeness. */ -DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, - Stext_prop_extent_paste_function, 3, 3, 0 /* +DEFUN ("text-prop-extent-paste-function", + Ftext_prop_extent_paste_function, 3, 3, 0, /* Used as the `paste-function' property of `text-prop' extents. -*/ ) - (extent, from, to) - Lisp_Object extent, from, to; +*/ + (extent, from, to)) { /* This function can GC */ Lisp_Object prop, val; @@ -6543,9 +6354,15 @@ if (NILP (prop)) signal_simple_error ("internal error: no text-prop", extent); val = Fextent_property (extent, prop, Qnil); +#if 0 + /* removed by bill perry, 2/9/97 + ** This little bit of code would not allow you to have a text property + ** with a value of Qnil. This is bad bad bad. + */ if (NILP (val)) signal_simple_error_2 ("internal error: no text-prop", extent, prop); +#endif Fput_text_property (from, to, prop, val, Qnil); return Qnil; /* important! */ } @@ -6554,8 +6371,7 @@ to use it in connection with invisible extents (at least currently). If this changes, consider moving this back into Lisp. */ -DEFUN ("next-single-property-change", Fnext_single_property_change, - Snext_single_property_change, 2, 4, 0 /* +DEFUN ("next-single-property-change", Fnext_single_property_change, 2, 4, 0, /* Return the position of next property change for a specific property. Scans characters forward from POS till it finds a change in the PROP property, then returns the position of the change. The optional third @@ -6571,9 +6387,8 @@ a particular character, it is undefined which value is considered to be the value of PROP. (Note that this situation will not happen if you always use the text-property primitives.) -*/ ) - (pos, prop, object, limit) - Lisp_Object pos, prop, object, limit; +*/ + (pos, prop, object, limit)) { Bufpos bpos; Bufpos blim; @@ -6623,8 +6438,8 @@ /* See comment on previous function about why this is written in C. */ -DEFUN ("previous-single-property-change", Fprevious_single_property_change, - Sprevious_single_property_change, 2, 4, 0 /* +DEFUN ("previous-single-property-change", + Fprevious_single_property_change, 2, 4, 0, /* Return the position of next property change for a specific property. Scans characters backward from POS till it finds a change in the PROP property, then returns the position of the change. The optional third @@ -6640,9 +6455,8 @@ a particular character, it is undefined which value is considered to be the value of PROP. (Note that this situation will not happen if you always use the text-property primitives.) -*/ ) - (pos, prop, object, limit) - Lisp_Object pos, prop, object, limit; +*/ + (pos, prop, object, limit)) { Bufpos bpos; Bufpos blim; @@ -6740,7 +6554,6 @@ /* defsymbol (&Qhighlight, "highlight"); in faces.c */ defsymbol (&Qunique, "unique"); defsymbol (&Qduplicable, "duplicable"); - defsymbol (&Qreplicating, "replicating"); defsymbol (&Qdetachable, "detachable"); defsymbol (&Qpriority, "priority"); defsymbol (&Qmouse_face, "mouse-face"); @@ -6762,73 +6575,73 @@ defsymbol (&Qtext_prop_extent_paste_function, "text-prop-extent-paste-function"); - defsubr (&Sextentp); - defsubr (&Sextent_live_p); - defsubr (&Sextent_detached_p); - defsubr (&Sextent_start_position); - defsubr (&Sextent_end_position); - defsubr (&Sextent_object); - defsubr (&Sextent_length); + DEFSUBR (Fextentp); + DEFSUBR (Fextent_live_p); + DEFSUBR (Fextent_detached_p); + DEFSUBR (Fextent_start_position); + DEFSUBR (Fextent_end_position); + DEFSUBR (Fextent_object); + DEFSUBR (Fextent_length); #if 0 - defsubr (&Sstack_of_extents); + DEFSUBR (Fstack_of_extents); #endif - defsubr (&Smake_extent); - defsubr (&Scopy_extent); - defsubr (&Sdelete_extent); - defsubr (&Sdetach_extent); - defsubr (&Sset_extent_endpoints); - defsubr (&Snext_extent); - defsubr (&Sprevious_extent); + DEFSUBR (Fmake_extent); + DEFSUBR (Fcopy_extent); + DEFSUBR (Fdelete_extent); + DEFSUBR (Fdetach_extent); + DEFSUBR (Fset_extent_endpoints); + DEFSUBR (Fnext_extent); + DEFSUBR (Fprevious_extent); #if DEBUG_XEMACS - defsubr (&Snext_e_extent); - defsubr (&Sprevious_e_extent); + DEFSUBR (Fnext_e_extent); + DEFSUBR (Fprevious_e_extent); #endif - defsubr (&Snext_extent_change); - defsubr (&Sprevious_extent_change); - - defsubr (&Sextent_parent); - defsubr (&Sextent_children); - defsubr (&Sset_extent_parent); - - defsubr (&Sextent_in_region_p); - defsubr (&Smap_extents); - defsubr (&Smap_extent_children); - defsubr (&Sextent_at); - - defsubr (&Sextent_face); - defsubr (&Sset_extent_face); - defsubr (&Sextent_mouse_face); - defsubr (&Sset_extent_mouse_face); - defsubr (&Sset_extent_begin_glyph); - defsubr (&Sset_extent_end_glyph); - defsubr (&Sextent_begin_glyph); - defsubr (&Sextent_end_glyph); - defsubr (&Sset_extent_begin_glyph_layout); - defsubr (&Sset_extent_end_glyph_layout); - defsubr (&Sextent_begin_glyph_layout); - defsubr (&Sextent_end_glyph_layout); - defsubr (&Sset_extent_priority); - defsubr (&Sextent_priority); - defsubr (&Sset_extent_property); - defsubr (&Sextent_property); - defsubr (&Sextent_properties); - - defsubr (&Shighlight_extent); - defsubr (&Sforce_highlight_extent); - - defsubr (&Sinsert_extent); - - defsubr (&Sget_text_property); - defsubr (&Sget_char_property); - defsubr (&Sput_text_property); - defsubr (&Sput_nonduplicable_text_property); - defsubr (&Sadd_text_properties); - defsubr (&Sadd_nonduplicable_text_properties); - defsubr (&Sremove_text_properties); - defsubr (&Stext_prop_extent_paste_function); - defsubr (&Snext_single_property_change); - defsubr (&Sprevious_single_property_change); + DEFSUBR (Fnext_extent_change); + DEFSUBR (Fprevious_extent_change); + + DEFSUBR (Fextent_parent); + DEFSUBR (Fextent_children); + DEFSUBR (Fset_extent_parent); + + DEFSUBR (Fextent_in_region_p); + DEFSUBR (Fmap_extents); + DEFSUBR (Fmap_extent_children); + DEFSUBR (Fextent_at); + + DEFSUBR (Fextent_face); + DEFSUBR (Fset_extent_face); + DEFSUBR (Fextent_mouse_face); + DEFSUBR (Fset_extent_mouse_face); + DEFSUBR (Fset_extent_begin_glyph); + DEFSUBR (Fset_extent_end_glyph); + DEFSUBR (Fextent_begin_glyph); + DEFSUBR (Fextent_end_glyph); + DEFSUBR (Fset_extent_begin_glyph_layout); + DEFSUBR (Fset_extent_end_glyph_layout); + DEFSUBR (Fextent_begin_glyph_layout); + DEFSUBR (Fextent_end_glyph_layout); + DEFSUBR (Fset_extent_priority); + DEFSUBR (Fextent_priority); + DEFSUBR (Fset_extent_property); + DEFSUBR (Fextent_property); + DEFSUBR (Fextent_properties); + + DEFSUBR (Fhighlight_extent); + DEFSUBR (Fforce_highlight_extent); + + DEFSUBR (Finsert_extent); + + DEFSUBR (Fget_text_property); + DEFSUBR (Fget_char_property); + DEFSUBR (Fput_text_property); + DEFSUBR (Fput_nonduplicable_text_property); + DEFSUBR (Fadd_text_properties); + DEFSUBR (Fadd_nonduplicable_text_properties); + DEFSUBR (Fremove_text_properties); + DEFSUBR (Ftext_prop_extent_paste_function); + DEFSUBR (Fnext_single_property_change); + DEFSUBR (Fprevious_single_property_change); } void
--- a/src/extents.h Mon Aug 13 08:49:44 2007 +0200 +++ b/src/extents.h Mon Aug 13 08:50:05 2007 +0200 @@ -75,7 +75,8 @@ unsigned int unused9 : 1; /* 9 unused */ unsigned int unique : 1; /* 10 there may be only one attached */ unsigned int duplicable : 1; /* 11 copied to strings by kill/undo */ - unsigned int replicating : 1; /* 12 invoke old extent-replica behav.*/ + unsigned int REPLICATING : 1; /* 12 invoke old extent-replica behav.*/ + /* Not used any more */ unsigned int detachable : 1; /* 13 extent detaches if text deleted */ unsigned int internal : 1; /* 14 used by map-extents etc. */ unsigned int unused15 : 1; /* 15 unused */ @@ -283,7 +284,6 @@ #define extent_end_open_p(e) extent_normal_field (e, end_open) #define extent_unique_p(e) extent_normal_field (e, unique) #define extent_duplicable_p(e) extent_normal_field (e, duplicable) -#define extent_replicating_p(e) extent_normal_field (e, replicating) #define extent_detachable_p(e) extent_normal_field (e, detachable) #define extent_internal_p(e) extent_normal_field (e, internal)
--- a/src/faces.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/faces.c Mon Aug 13 08:50:05 2007 +0200 @@ -631,23 +631,21 @@ } -DEFUN ("facep", Ffacep, Sfacep, 1, 1, 0 /* +DEFUN ("facep", Ffacep, 1, 1, 0, /* Return non-nil if OBJECT is a face. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (FACEP (object) ? Qt : Qnil); } -DEFUN ("find-face", Ffind_face, Sfind_face, 1, 1, 0 /* +DEFUN ("find-face", Ffind_face, 1, 1, 0, /* Retrieve the face of the given name. If FACE-OR-NAME is a face object, it is simply returned. Otherwise, FACE-OR-NAME should be a symbol. If there is no such face, nil is returned. Otherwise the associated face object is returned. -*/ ) - (face_or_name) - Lisp_Object face_or_name; +*/ + (face_or_name)) { Lisp_Object retval; @@ -664,13 +662,12 @@ return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil); } -DEFUN ("get-face", Fget_face, Sget_face, 1, 1, 0 /* +DEFUN ("get-face", Fget_face, 1, 1, 0, /* Retrieve the face of the given name. Same as `find-face' except an error is signalled if there is no such face instead of returning nil. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { Lisp_Object face = Ffind_face (name); @@ -679,21 +676,19 @@ return face; } -DEFUN ("face-name", Fface_name, Sface_name, 1, 1, 0 /* +DEFUN ("face-name", Fface_name, 1, 1, 0, /* Return the name of the given face. -*/ ) - (face) - Lisp_Object face; +*/ + (face)) { return (XFACE (Fget_face (face))->name); } -DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, - Sbuilt_in_face_specifiers, 0, 0, 0 /* +DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /* Return a list of all built-in face specifier properties. Don't modify this list! -*/ ) - () +*/ + ()) { return Vbuilt_in_face_specifiers; } @@ -762,14 +757,13 @@ default_face_font_info (domain, 0, 0, height, width, 0); } -DEFUN ("face-list", Fface_list, Sface_list, 0, 1, 0 /* +DEFUN ("face-list", Fface_list, 0, 1, 0, /* Return a list of the names of all defined faces. If TEMPORARY is nil, only the permanent faces are included. If it is t, only the temporary faces are included. If it is any other non-nil value both permanent and temporary are included. -*/ ) - (temporary) - Lisp_Object temporary; +*/ + (temporary)) { Lisp_Object face_list = Qnil; @@ -788,14 +782,13 @@ return face_list; } -DEFUN ("make-face", Fmake_face, Smake_face, 1, 3, 0 /* +DEFUN ("make-face", Fmake_face, 1, 3, 0, /* Defines and returns a new FACE described by DOC-STRING. You can modify the font, color, etc of a face with the set-face- functions. If the face already exists, it is unmodified. If TEMPORARY is non-nil, this face will cease to exist if not in use. -*/ ) - (name, doc_string, temporary) - Lisp_Object name, doc_string, temporary; +*/ + (name, doc_string, temporary)) { /* This function can GC if initialized is non-zero */ struct Lisp_Face *f; @@ -1753,13 +1746,12 @@ XFACE (face)->dirty = 1; } -DEFUN ("copy-face", Fcopy_face, Scopy_face, 2, 6, 0 /* +DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /* Defines and returns a new face which is a copy of an existing one, or makes an already-existing face be exactly like another. LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. -*/ ) - (old_face, new_name, locale, tag_set, exact_p, how_to_add) - Lisp_Object old_face, new_name, locale, tag_set, exact_p, how_to_add; +*/ + (old_face, new_name, locale, tag_set, exact_p, how_to_add)) { struct Lisp_Face *fold, *fnew; Lisp_Object new_face = Qnil; @@ -1829,14 +1821,14 @@ defsymbol (&Qright_margin, "right-margin"); defsymbol (&Qtext_cursor, "text-cursor"); - defsubr (&Sfacep); - defsubr (&Sfind_face); - defsubr (&Sget_face); - defsubr (&Sface_name); - defsubr (&Sbuilt_in_face_specifiers); - defsubr (&Sface_list); - defsubr (&Smake_face); - defsubr (&Scopy_face); + DEFSUBR (Ffacep); + DEFSUBR (Ffind_face); + DEFSUBR (Fget_face); + DEFSUBR (Fface_name); + DEFSUBR (Fbuilt_in_face_specifiers); + DEFSUBR (Fface_list); + DEFSUBR (Fmake_face); + DEFSUBR (Fcopy_face); defsymbol (&Qfacep, "facep"); defsymbol (&Qforeground, "foreground");
--- a/src/fileio.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/fileio.c Mon Aug 13 08:50:05 2007 +0200 @@ -321,8 +321,7 @@ /* If FILENAME is handled specially on account of its syntax, return its handler function. Otherwise, return nil. */ -DEFUN ("find-file-name-handler", - Ffind_file_name_handler, Sfind_file_name_handler, 1, 2, 0 /* +DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /* Return FILENAME's handler function for OPERATION, if it has one. Otherwise, return nil. A file name is handled if one of the regular expressions in @@ -332,9 +331,8 @@ any handlers that are members of `inhibit-file-name-handlers', but we still do run any other handlers. This lets handlers use the standard functions without calling themselves recursively. -*/ ) - (filename, operation) - Lisp_Object filename, operation; +*/ + (filename, operation)) { /* This function must not munge the match data. */ Lisp_Object chain, inhibited_handlers; @@ -387,16 +385,14 @@ } -DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, - 1, 1, 0 /* +DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /* Return the directory component in file name NAME. Return nil if NAME does not include a directory. Otherwise return a directory spec. Given a Unix syntax file name, returns a string ending in slash; on VMS, perhaps instead a string ending in `:', `]' or `>'. -*/ ) - (file) - Lisp_Object file; +*/ + (file)) { /* This function can GC */ Bufbyte *beg; @@ -464,16 +460,13 @@ return make_string (beg, p - beg); } -DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, - Sfile_name_nondirectory, - 1, 1, 0 /* +DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /* Return file name NAME sans its directory. For example, in a Unix-syntax file name, this is everything after the last slash, or the entire name if it contains no slash. -*/ ) - (file) - Lisp_Object file; +*/ + (file)) { /* This function can GC */ Bufbyte *beg, *p, *end; @@ -500,8 +493,7 @@ return make_string (p, end - p); } -DEFUN ("unhandled-file-name-directory", - Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0 /* +DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /* Return a directly usable directory name somehow associated with FILENAME. A `directly usable' directory name is one that may be used without the intervention of any file handler. @@ -509,9 +501,8 @@ (file-name-directory FILENAME). The `call-process' and `start-process' functions use this function to get a current directory to run processes in. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object handler; @@ -602,8 +593,7 @@ return out; } -DEFUN ("file-name-as-directory", Ffile_name_as_directory, - Sfile_name_as_directory, 1, 1, 0 /* +DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /* Return a string representing file FILENAME interpreted as a directory. This operation exists because a directory is also a file, but its name as a directory is different from its name as a file. @@ -611,9 +601,8 @@ or passed as second argument to `expand-file-name'. For a Unix-syntax file name, just appends a slash. On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. -*/ ) - (file) - Lisp_Object file; +*/ + (file)) { /* This function can GC */ char *buf; @@ -790,8 +779,7 @@ return 1; } -DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, - 1, 1, 0 /* +DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /* Return the file name of the directory named DIR. This is the name of the file that holds the data for the directory DIR. This operation exists because a directory is also a file, but its name as @@ -799,9 +787,8 @@ In Unix-syntax, this function just removes the final slash. On VMS, given a VMS-syntax directory name such as \"[X.Y]\", it returns a file name such as \"[X]Y.DIR.1\". -*/ ) - (directory) - Lisp_Object directory; +*/ + (directory)) { /* This function can GC */ char *buf; @@ -832,13 +819,12 @@ return build_string (buf); } -DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0 /* +DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* Generate temporary file name (string) starting with PREFIX (a string). The Emacs process number forms part of the result, so there is no danger of generating a name being used by another process. -*/ ) - (prefix) - Lisp_Object prefix; +*/ + (prefix)) { CONST char suffix[] = "XXXXXX"; Bufbyte *data; @@ -857,7 +843,7 @@ return val; } -DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0 /* +DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /* Convert FILENAME to absolute, and canonicalize it. Second arg DEFAULT is directory to start with if FILENAME is relative (does not start with slash); if DEFAULT is nil or missing, @@ -869,9 +855,8 @@ An initial `~/' expands to your home directory. An initial `~USER/' expands to USER's home directory. See also the function `substitute-in-file-name'. -*/ ) - (name, defalt) - Lisp_Object name, defalt; +*/ + (name, defalt)) { /* This function can GC */ Bufbyte *nm; @@ -1386,16 +1371,15 @@ on different systems */ extern char *realpath (); -DEFUN ("file-truename", Ffile_truename, Sfile_truename, 1, 2, 0 /* +DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /* Return the canonical name of the given FILE. Second arg DEFAULT is directory to start with if FILE is relative (does not start with slash); if DEFAULT is nil or missing, the current buffer's value of default-directory is used. No component of the resulting pathname will be a symbolic link, as in the realpath() function. -*/ ) - (filename, defalt) - Lisp_Object filename, defalt; +*/ + (filename, defalt)) { /* This function can GC */ struct gcpro gcpro1; @@ -1513,8 +1497,7 @@ } -DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, - Ssubstitute_in_file_name, 1, 1, 0 /* +DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* Substitute environment variables referred to in FILENAME. `$FOO' where FOO is an environment variable name means to substitute the value of that variable. The variable name should be terminated @@ -1524,9 +1507,8 @@ On VMS, `$' substitution is not done; this function does little and only duplicates what `expand-file-name' does. -*/ ) - (string) - Lisp_Object string; +*/ + (string)) { Bufbyte *nm; @@ -1817,8 +1799,8 @@ return; } -DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, - "fCopy file: \nFCopy %s to file: \np\nP" /* +DEFUN ("copy-file", Fcopy_file, 2, 4, + "fCopy file: \nFCopy %s to file: \np\nP", /* Copy FILE to NEWNAME. Both args must be strings. Signals a `file-already-exists' error if file NEWNAME already exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. @@ -1827,9 +1809,8 @@ Fourth arg KEEP-TIME non-nil means give the new file the same last-modified time as the old one. (This works on only some systems.) A prefix arg makes KEEP-TIME non-nil. -*/ ) - (filename, newname, ok_if_already_exists, keep_time) - Lisp_Object filename, newname, ok_if_already_exists, keep_time; +*/ + (filename, newname, ok_if_already_exists, keep_time)) { /* This function can GC */ int ifd, ofd, n; @@ -1992,12 +1973,10 @@ return Qnil; } -DEFUN ("make-directory-internal", Fmake_directory_internal, - Smake_directory_internal, 1, 1, 0 /* +DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /* Create a directory. One argument, a file name string. -*/ ) - (dirname) - Lisp_Object dirname; +*/ + (dirname)) { /* This function can GC */ char dir [MAXPATHLEN]; @@ -2040,12 +2019,10 @@ return Qnil; } -DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, - "FDelete directory: " /* +DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /* Delete a directory. One argument, a file name or directory name string. -*/ ) - (dirname) - Lisp_Object dirname; +*/ + (dirname)) { /* This function can GC */ Lisp_Object handler; @@ -2067,12 +2044,11 @@ return Qnil; } -DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: " /* +DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /* Delete specified file. One argument, a file name string. If file has multiple names, it continues to exist with the other names. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object handler; @@ -2107,17 +2083,16 @@ internal_delete_file_1, Qnil)); } -DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, - "fRename file: \nFRename %s to file: \np" /* +DEFUN ("rename-file", Frename_file, 2, 3, + "fRename file: \nFRename %s to file: \np", /* Rename FILE as NEWNAME. Both args strings. If file has names other than FILE, it continues to have those names. Signals a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. A number as third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x. -*/ ) - (filename, newname, ok_if_already_exists) - Lisp_Object filename, newname, ok_if_already_exists; +*/ + (filename, newname, ok_if_already_exists)) { /* This function can GC */ Lisp_Object handler; @@ -2202,16 +2177,15 @@ return Qnil; } -DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, - "fAdd name to file: \nFName to add to %s: \np" /* +DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3, + "fAdd name to file: \nFName to add to %s: \np", /* Give FILE additional name NEWNAME. Both args strings. Signals a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. A number as third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x. -*/ ) - (filename, newname, ok_if_already_exists) - Lisp_Object filename, newname, ok_if_already_exists; +*/ + (filename, newname, ok_if_already_exists)) { /* This function can GC */ Lisp_Object handler; @@ -2260,16 +2234,15 @@ } #ifdef S_IFLNK -DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, - "FMake symbolic link to file: \nFMake symbolic link to file %s: \np" /* +DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, + "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings. Signals a `file-already-exists' error if a file LINKNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. A number as third arg means request confirmation if LINKNAME already exists. This happens for interactive use with M-x. -*/ ) - (filename, linkname, ok_if_already_exists) - Lisp_Object filename, linkname, ok_if_already_exists; +*/ + (filename, linkname, ok_if_already_exists)) { /* This function can GC */ Lisp_Object handler; @@ -2318,14 +2291,12 @@ #ifdef VMS -DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, - 2, 2, "sDefine logical name: \nsDefine logical name %s as: " /* +DEFUN ("define-logical-name", Fdefine_logical_name, 2, 2, + "sDefine logical name: \nsDefine logical name %s as: ", /* Define the job-wide logical name NAME to have the value STRING. If STRING is nil or a null string, the logical name NAME is deleted. -*/ ) - (varname, string) - Lisp_Object varname; - Lisp_Object string; +*/ + (varname, string)) { CHECK_STRING (varname); if (NILP (string)) @@ -2346,11 +2317,10 @@ #ifdef HPUX_NET -DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0 /* +DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* Open a network connection to PATH using LOGIN as the login string. -*/ ) - (path, login) - Lisp_Object path, login; +*/ + (path, login)) { int netresult; @@ -2376,13 +2346,11 @@ } #endif /* HPUX_NET */ -DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, - 1, 1, 0 /* +DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /* Return t if file FILENAME specifies an absolute path name. On Unix, this is a name starting with a `/' or a `~'. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { Bufbyte *ptr; @@ -2457,12 +2425,11 @@ #endif /* not MSDOS */ } -DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0 /* +DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /* Return t if file FILENAME exists. (This does not mean you can read it.) See also `file-readable-p' and `file-attributes'. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object abspath; @@ -2489,13 +2456,11 @@ return (Qnil); } -DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0 /* +DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /* Return t if FILENAME can be executed by you. For a directory, this means you can access files in that directory. -*/ ) - (filename) - Lisp_Object filename; - +*/ + (filename)) { /* This function can GC */ Lisp_Object abspath; @@ -2519,12 +2484,11 @@ ? Qt : Qnil); } -DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0 /* +DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /* Return t if file FILENAME exists and you can read it. See also `file-exists-p' and `file-attributes'. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object abspath; @@ -2554,11 +2518,10 @@ /* Having this before file-symlink-p mysteriously caused it to be forgotten on the RT/PC. */ -DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0 /* +DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /* Return t if file FILENAME can be written or created by you. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object abspath, dir; @@ -2594,13 +2557,12 @@ ? Qt : Qnil); } -DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0 /* +DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /* Return non-nil if file FILENAME is the name of a symbolic link. The value is the name of the file to which it is linked. Otherwise returns nil. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ #ifdef S_IFLNK @@ -2647,13 +2609,12 @@ #endif /* not S_IFLNK */ } -DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0 /* +DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /* Return t if file FILENAME is the name of a directory as a file. A directory name spec may be given instead; then the value is t if the directory so specified exists and really is a directory. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object abspath; @@ -2679,17 +2640,15 @@ return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; } -DEFUN ("file-accessible-directory-p", - Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0 /* +DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /* Return t if file FILENAME is the name of a directory as a file, and files in that directory can be opened by you. In order to use a directory as a buffer's current directory, this predicate must return true. A directory name spec may be given instead; then the value is t if the directory so specified exists and really is a readable and searchable directory. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object handler; @@ -2713,12 +2672,11 @@ return (handler); } -DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0 /* +DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* "Return t if file FILENAME is the name of a regular file. This is the sort of file that holds an ordinary stream of data bytes. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { REGISTER Lisp_Object abspath; struct stat st; @@ -2737,11 +2695,10 @@ return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; } -DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0 /* +DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /* Return mode bits of FILE, as an integer. -*/ ) - (filename) - Lisp_Object filename; +*/ + (filename)) { /* This function can GC */ Lisp_Object abspath; @@ -2772,12 +2729,11 @@ return make_int (st.st_mode & 07777); } -DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0 /* +DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /* Set mode bits of FILE to MODE (an integer). Only the 12 low bits of MODE are used. -*/ ) - (filename, mode) - Lisp_Object filename, mode; +*/ + (filename, mode)) { /* This function can GC */ Lisp_Object abspath; @@ -2803,16 +2759,14 @@ return Qnil; } -DEFUN ("set-default-file-modes", Fset_default_file_modes, - Sset_default_file_modes, 1, 1, 0 /* +DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /* Set the file permission bits for newly created files. MASK should be an integer; if a permission's bit in MASK is 1, subsequently created files will not have that permission enabled. Only the low 9 bits are used. This setting is inherited by subprocesses. -*/ ) - (mode) - Lisp_Object mode; +*/ + (mode)) { CHECK_INT (mode); @@ -2821,13 +2775,13 @@ return Qnil; } -DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0 /* +DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /* Return the default file protection for created files. The umask value determines which permissions are enabled in newly created files. If a permission's bit in the umask is 1, subsequently created files will not have that permission enabled. -*/ ) - () +*/ + ()) { int mode; @@ -2838,10 +2792,10 @@ } #ifndef VMS -DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "" /* +DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* Tell Unix to finish all pending disk updates. -*/ ) - () +*/ + ()) { sync (); return Qnil; @@ -2849,14 +2803,12 @@ #endif /* !VMS */ -DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, - Sfile_newer_than_file_p, 2, 2, 0 /* +DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /* Return t if file FILE1 is newer than file FILE2. If FILE1 does not exist, the answer is nil; otherwise, if FILE2 does not exist, the answer is t. -*/ ) - (file1, file2) - Lisp_Object file1, file2; +*/ + (file1, file2)) { /* This function can GC */ Lisp_Object abspath1, abspath2; @@ -2907,8 +2859,8 @@ /* #define READ_BUF_SIZE (2 << 16) */ #define READ_BUF_SIZE (1 << 15) -DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal, - Sinsert_file_contents_internal, 1, 5, 0 /* +DEFUN ("insert-file-contents-internal", + Finsert_file_contents_internal, 1, 5, 0, /* Insert contents of file FILENAME after point. Returns list of absolute file name and length of data inserted. If second argument VISIT is non-nil, the buffer's visited filename @@ -2924,9 +2876,8 @@ with the file contents. This is better than simply deleting and inserting the whole thing because (1) it preserves some marker positions and (2) it puts less data in the undo list. -*/ ) - (filename, visit, beg, end, replace) - Lisp_Object filename, visit, beg, end, replace; +*/ + (filename, visit, beg, end, replace)) { /* This function can GC */ struct stat st; @@ -3051,7 +3002,7 @@ /* The replace-mode code currently only works when the assumption 'one byte == one char' holds true. This fails under MSDOS and Windows NT (because newlines are represented as CR-LF in text - files). and under Mule because files may contain multibyte characters. */ + files) and under Mule because files may contain multibyte characters. */ # define FSFMACS_SPEEDY_INSERT #endif #ifndef FSFMACS_SPEEDY_INSERT @@ -3352,9 +3303,8 @@ return Qnil; } -DEFUN ("write-region-internal", Fwrite_region_internal, - Swrite_region_internal, 3, 6, - "r\nFWrite region to file: " /* +DEFUN ("write-region-internal", Fwrite_region_internal, 3, 6, + "r\nFWrite region to file: ", /* Write current region into specified file. When called from a program, takes three arguments: START, END and FILENAME. START and END are buffer positions. @@ -3370,9 +3320,8 @@ that means do not print the \"Wrote file\" message. Kludgy feature: if START is a string, then that string is written to the file, instead of any buffer contents, and END is ignored. -*/ ) - (start, end, filename, append, visit, lockname) - Lisp_Object start, end, filename, append, visit, lockname; +*/ + (start, end, filename, append, visit, lockname)) { /* This function can GC */ int desc; @@ -3765,22 +3714,20 @@ /* #### This is such a load of shit!!!! There is no way we should define something so stupid as a subr, just sort the fucking list more intelligently. */ -DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0 /* +DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /* Return t if (car A) is numerically less than (car B). -*/ ) - (a, b) - Lisp_Object a, b; +*/ + (a, b)) { return Flss (Fcar (a), Fcar (b)); } /* Heh heh heh, let's define this too, just to aggravate the person who wrote the above comment. */ -DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, Scdr_less_than_cdr, 2, 2, 0 /* +DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /* Return t if (cdr A) is numerically less than (cdr B). -*/ ) - (a, b) - Lisp_Object a, b; +*/ + (a, b)) { return Flss (Fcdr (a), Fcdr (b)); } @@ -3922,11 +3869,10 @@ #define CRYPT_BLOCK_SIZE 8 /* bytes */ #define CRYPT_KEY_SIZE 8 /* bytes */ -DEFUN ("encrypt-string", Fencrypt_string, Sencrypt_string, 2, 2, 0 /* +DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /* Encrypt STRING using KEY. -*/ ) - (string, key) - Lisp_Object string, key; +*/ + (string, key)) { char *encrypted_string, *raw_key; int rounded_size, extra, key_size; @@ -3955,11 +3901,10 @@ return make_string (encrypted_string, rounded_size); } -DEFUN ("decrypt-string", Fdecrypt_string, Sdecrypt_string, 2, 2, 0 /* +DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /* Decrypt STRING using KEY. -*/ ) - (string, key) - Lisp_Object string, key; +*/ + (string, key)) { char *decrypted_string, *raw_key; int string_size, key_size; @@ -3989,13 +3934,11 @@ #endif -DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, - Sverify_visited_file_modtime, 1, 1, 0 /* +DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /* Return t if last mod time of BUF's visited file matches what BUF records. This means that the file has not been changed since it was visited or saved. -*/ ) - (buf) - Lisp_Object buf; +*/ + (buf)) { /* This function can GC */ struct buffer *b; @@ -4033,39 +3976,35 @@ return Qnil; } -DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, - Sclear_visited_file_modtime, 0, 0, 0 /* +DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /* Clear out records of last mod time of visited file. Next attempt to save will certainly not complain of a discrepancy. -*/ ) - () +*/ + ()) { current_buffer->modtime = 0; return Qnil; } -DEFUN ("visited-file-modtime", Fvisited_file_modtime, - Svisited_file_modtime, 0, 0, 0 /* +DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /* Return the current buffer's recorded visited file modification time. The value is a list of the form (HIGH . LOW), like the time values that `file-attributes' returns. -*/ ) - () +*/ + ()) { return time_to_lisp ((time_t) current_buffer->modtime); } -DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, - Sset_visited_file_modtime, 0, 1, 0 /* +DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /* Update buffer's recorded modification time from the visited file's time. Useful if the buffer was not read from the file normally or if the file itself has been changed for some known benign reason. An argument specifies the modification time value to use (instead of that of the visited file), in the form of a list (HIGH . LOW) or (HIGH LOW). -*/ ) - (time_list) - Lisp_Object time_list; +*/ + (time_list)) { /* This function can GC */ if (!NILP (time_list)) @@ -4099,15 +4038,13 @@ return Qnil; } -DEFUN ("set-buffer-modtime", Fset_buffer_modtime, - Sset_buffer_modtime, 1, 2, 0 /* +DEFUN ("set-buffer-modtime", Fset_buffer_modtime, 1, 2, 0, /* Update BUFFER's recorded modification time from the associated file's modtime, if there is an associated file. If not, use the current time. In either case, if the optional arg TIME is supplied, it will be used if it is either an integer or a cons of two integers. -*/ ) - (buf, in_time) - Lisp_Object buf, in_time; +*/ + (buf, in_time)) { /* This function can GC */ unsigned long time_to_use = 0; @@ -4244,7 +4181,7 @@ It's fairly important that we generate autosave files in that case! */ -DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "" /* +DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /* Auto-save all buffers that need it. This is all buffers that have auto-saving enabled and are changed since last auto-saved. @@ -4255,9 +4192,8 @@ Non-nil first argument means do not print any message if successful. Non-nil second argument means save only current buffer. -*/ ) - (no_message, current_only) - Lisp_Object no_message, current_only; +*/ + (no_message, current_only)) { /* This function can GC */ struct buffer *old = current_buffer, *b; @@ -4465,12 +4401,11 @@ RETURN_UNGCPRO (unbind_to (speccount, Qnil)); } -DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, - Sset_buffer_auto_saved, 0, 0, 0 /* +DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /* Mark current buffer as auto-saved with its current text. No auto-save file will be written until the buffer changes again. -*/ ) - () +*/ + ()) { current_buffer->auto_save_modified = BUF_MODIFF (current_buffer); current_buffer->save_length = make_int (BUF_SIZE (current_buffer)); @@ -4478,21 +4413,19 @@ return Qnil; } -DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, - Sclear_buffer_auto_save_failure, 0, 0, 0 /* +DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /* Clear any record of a recent auto-save failure in the current buffer. -*/ ) - () +*/ + ()) { current_buffer->auto_save_failure_time = -1; return Qnil; } -DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, - 0, 0, 0 /* +DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /* Return t if buffer has been auto-saved since last read in or saved. -*/ ) - () +*/ + ()) { return (BUF_SAVE_MODIFF (current_buffer) < current_buffer->auto_save_modified) ? Qt : Qnil; @@ -4555,65 +4488,65 @@ deferror (&Qfile_already_exists, "file-already-exists", "File already exists", Qfile_error); - defsubr (&Sfind_file_name_handler); - - defsubr (&Sfile_name_directory); - defsubr (&Sfile_name_nondirectory); - defsubr (&Sunhandled_file_name_directory); - defsubr (&Sfile_name_as_directory); - defsubr (&Sdirectory_file_name); - defsubr (&Smake_temp_name); - defsubr (&Sexpand_file_name); - defsubr (&Sfile_truename); - defsubr (&Ssubstitute_in_file_name); - defsubr (&Scopy_file); - defsubr (&Smake_directory_internal); - defsubr (&Sdelete_directory); - defsubr (&Sdelete_file); - defsubr (&Srename_file); - defsubr (&Sadd_name_to_file); + DEFSUBR (Ffind_file_name_handler); + + DEFSUBR (Ffile_name_directory); + DEFSUBR (Ffile_name_nondirectory); + DEFSUBR (Funhandled_file_name_directory); + DEFSUBR (Ffile_name_as_directory); + DEFSUBR (Fdirectory_file_name); + DEFSUBR (Fmake_temp_name); + DEFSUBR (Fexpand_file_name); + DEFSUBR (Ffile_truename); + DEFSUBR (Fsubstitute_in_file_name); + DEFSUBR (Fcopy_file); + DEFSUBR (Fmake_directory_internal); + DEFSUBR (Fdelete_directory); + DEFSUBR (Fdelete_file); + DEFSUBR (Frename_file); + DEFSUBR (Fadd_name_to_file); #ifdef S_IFLNK - defsubr (&Smake_symbolic_link); + DEFSUBR (Fmake_symbolic_link); #endif /* S_IFLNK */ #ifdef VMS - defsubr (&Sdefine_logical_name); + DEFSUBR (Fdefine_logical_name); #endif /* VMS */ #ifdef HPUX_NET - defsubr (&Ssysnetunam); + DEFSUBR (Fsysnetunam); #endif /* HPUX_NET */ - defsubr (&Sfile_name_absolute_p); - defsubr (&Sfile_exists_p); - defsubr (&Sfile_executable_p); - defsubr (&Sfile_readable_p); - defsubr (&Sfile_writable_p); - defsubr (&Sfile_symlink_p); - defsubr (&Sfile_directory_p); - defsubr (&Sfile_accessible_directory_p); - defsubr (&Sfile_regular_p); - defsubr (&Sfile_modes); - defsubr (&Sset_file_modes); - defsubr (&Sset_default_file_modes); - defsubr (&Sdefault_file_modes); - defsubr (&Sunix_sync); - defsubr (&Sfile_newer_than_file_p); - defsubr (&Sinsert_file_contents_internal); - defsubr (&Swrite_region_internal); - defsubr (&Scar_less_than_car); /* Vomitous! */ - defsubr (&Scdr_less_than_cdr); /* Yeah oh yeah bucko .... */ + DEFSUBR (Ffile_name_absolute_p); + DEFSUBR (Ffile_exists_p); + DEFSUBR (Ffile_executable_p); + DEFSUBR (Ffile_readable_p); + DEFSUBR (Ffile_writable_p); + DEFSUBR (Ffile_symlink_p); + DEFSUBR (Ffile_directory_p); + DEFSUBR (Ffile_accessible_directory_p); + DEFSUBR (Ffile_regular_p); + DEFSUBR (Ffile_modes); + DEFSUBR (Fset_file_modes); + DEFSUBR (Fset_default_file_modes); + DEFSUBR (Fdefault_file_modes); + DEFSUBR (Funix_sync); + DEFSUBR (Ffile_newer_than_file_p); + DEFSUBR (Finsert_file_contents_internal); + DEFSUBR (Fwrite_region_internal); + DEFSUBR (Fcar_less_than_car); /* Vomitous! */ + DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */ #if 0 - defsubr (&Sencrypt_string); - defsubr (&Sdecrypt_string); + DEFSUBR (Fencrypt_string); + DEFSUBR (Fdecrypt_string); #endif - defsubr (&Sverify_visited_file_modtime); - defsubr (&Sclear_visited_file_modtime); - defsubr (&Svisited_file_modtime); - defsubr (&Sset_visited_file_modtime); - defsubr (&Sset_buffer_modtime); - - defsubr (&Sdo_auto_save); - defsubr (&Sset_buffer_auto_saved); - defsubr (&Sclear_buffer_auto_save_failure); - defsubr (&Srecent_auto_save_p); + DEFSUBR (Fverify_visited_file_modtime); + DEFSUBR (Fclear_visited_file_modtime); + DEFSUBR (Fvisited_file_modtime); + DEFSUBR (Fset_visited_file_modtime); + DEFSUBR (Fset_buffer_modtime); + + DEFSUBR (Fdo_auto_save); + DEFSUBR (Fset_buffer_auto_saved); + DEFSUBR (Fclear_buffer_auto_save_failure); + DEFSUBR (Frecent_auto_save_p); } void
--- a/src/filelock.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/filelock.c Mon Aug 13 08:50:05 2007 +0200 @@ -405,13 +405,12 @@ } -DEFUN ("lock-buffer", Flock_buffer, Slock_buffer, 0, 1, 0 /* +DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /* Lock FILE, if current buffer is modified. FILE defaults to current buffer's visited file, or else nothing is done if current buffer isn't visiting a file. -*/ ) - (fn) - Lisp_Object fn; +*/ + (fn)) { /* This function can GC */ if (NILP (fn)) @@ -423,11 +422,11 @@ return Qnil; } -DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer, 0, 0, 0 /* +DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /* Unlock the file visited in the current buffer, if it should normally be locked. -*/ ) - () +*/ + ()) { if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) && STRINGP (current_buffer->file_truename)) @@ -446,12 +445,11 @@ unlock_file (buffer->file_truename); } -DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0 /* +DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /* Return nil if the FILENAME is not locked, t if it is locked by you, else a string of the name of the locker. -*/ ) - (fn) - Lisp_Object fn; +*/ + (fn)) { /* This function can GC */ REGISTER char *lfname; @@ -478,9 +476,9 @@ syms_of_filelock (void) { /* This function can GC */ - defsubr (&Sunlock_buffer); - defsubr (&Slock_buffer); - defsubr (&Sfile_locked_p); + DEFSUBR (Funlock_buffer); + DEFSUBR (Flock_buffer); + DEFSUBR (Ffile_locked_p); defsymbol (&Qask_user_about_supersession_threat, "ask-user-about-supersession-threat");
--- a/src/floatfns.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/floatfns.c Mon Aug 13 08:50:05 2007 +0200 @@ -206,11 +206,10 @@ /* Trig functions. */ #ifdef LISP_FLOAT_TYPE -DEFUN ("acos", Facos, Sacos, 1, 1, 0 /* +DEFUN ("acos", Facos, 1, 1, 0, /* Return the inverse cosine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -221,11 +220,10 @@ return make_float (d); } -DEFUN ("asin", Fasin, Sasin, 1, 1, 0 /* +DEFUN ("asin", Fasin, 1, 1, 0, /* Return the inverse sine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -236,11 +234,10 @@ return make_float (d); } -DEFUN ("atan", Fatan, Satan, 1, 2, 0 /* +DEFUN ("atan", Fatan, 1, 2, 0, /* Return the inverse tangent of ARG. -*/ ) - (arg1, arg2) - Lisp_Object arg1, arg2; +*/ + (arg1, arg2)) { double d = extract_float (arg1); @@ -258,33 +255,30 @@ return make_float (d); } -DEFUN ("cos", Fcos, Scos, 1, 1, 0 /* +DEFUN ("cos", Fcos, 1, 1, 0, /* Return the cosine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = cos (d), "cos", arg); return make_float (d); } -DEFUN ("sin", Fsin, Ssin, 1, 1, 0 /* +DEFUN ("sin", Fsin, 1, 1, 0, /* Return the sine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = sin (d), "sin", arg); return make_float (d); } -DEFUN ("tan", Ftan, Stan, 1, 1, 0 /* +DEFUN ("tan", Ftan, 1, 1, 0, /* Return the tangent of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); double c = cos (d); @@ -302,34 +296,31 @@ #if 0 /* Leave these out unless we find there's a reason for them. */ /* #ifdef LISP_FLOAT_TYPE */ -DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0 /* +DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* Return the bessel function j0 of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = j0 (d), "bessel-j0", arg); return make_float (d); } -DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0 /* +DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /* Return the bessel function j1 of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = j1 (d), "bessel-j1", arg); return make_float (d); } -DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0 /* +DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /* Return the order N bessel function output jn of ARG. The first arg (the order) is truncated to an integer. -*/ ) - (arg1, arg2) - Lisp_Object arg1, arg2; +*/ + (arg1, arg2)) { int i1 = extract_float (arg1); double f2 = extract_float (arg2); @@ -338,34 +329,31 @@ return make_float (f2); } -DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0 /* +DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /* Return the bessel function y0 of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = y0 (d), "bessel-y0", arg); return make_float (d); } -DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0 /* +DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /* Return the bessel function y1 of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = y1 (d), "bessel-y0", arg); return make_float (d); } -DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0 /* +DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /* Return the order N bessel function output yn of ARG. The first arg (the order) is truncated to an integer. -*/ ) - (arg1, arg2) - Lisp_Object arg1, arg2; +*/ + (arg1, arg2)) { int i1 = extract_float (arg1); double f2 = extract_float (arg2); @@ -380,33 +368,30 @@ #if 0 /* Leave these out unless we see they are worth having. */ /* #ifdef LISP_FLOAT_TYPE */ -DEFUN ("erf", Ferf, Serf, 1, 1, 0 /* +DEFUN ("erf", Ferf, 1, 1, 0, /* Return the mathematical error function of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = erf (d), "erf", arg); return make_float (d); } -DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0 /* +DEFUN ("erfc", Ferfc, 1, 1, 0, /* Return the complementary error function of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = erfc (d), "erfc", arg); return make_float (d); } -DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0 /* +DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /* Return the log gamma of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = lgamma (d), "log-gamma", arg); @@ -419,11 +404,10 @@ /* Root and Log functions. */ #ifdef LISP_FLOAT_TYPE -DEFUN ("exp", Fexp, Sexp, 1, 1, 0 /* +DEFUN ("exp", Fexp, 1, 1, 0, /* Return the exponential base e of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -439,11 +423,10 @@ #endif /* LISP_FLOAT_TYPE */ -DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0 /* +DEFUN ("expt", Fexpt, 2, 2, 0, /* Return the exponential ARG1 ** ARG2. -*/ ) - (arg1, arg2) - Lisp_Object arg1, arg2; +*/ + (arg1, arg2)) { double f1, f2; @@ -496,12 +479,11 @@ } #ifdef LISP_FLOAT_TYPE -DEFUN ("log", Flog, Slog, 1, 2, 0 /* +DEFUN ("log", Flog, 1, 2, 0, /* Return the natural logarithm of ARG. If second optional argument BASE is given, return log ARG using that base. -*/ ) - (arg, base) - Lisp_Object arg, base; +*/ + (arg, base)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -526,11 +508,10 @@ } -DEFUN ("log10", Flog10, Slog10, 1, 1, 0 /* +DEFUN ("log10", Flog10, 1, 1, 0, /* Return the logarithm base 10 of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -542,11 +523,10 @@ } -DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0 /* +DEFUN ("sqrt", Fsqrt, 1, 1, 0, /* Return the square root of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -558,11 +538,10 @@ } -DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0 /* +DEFUN ("cube-root", Fcube_root, 1, 1, 0, /* Return the cube root of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef HAVE_CBRT @@ -582,11 +561,10 @@ #ifdef LISP_FLOAT_TYPE /* #if 0 Not clearly worth adding... */ -DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0 /* +DEFUN ("acosh", Facosh, 1, 1, 0, /* Return the inverse hyperbolic cosine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -601,11 +579,10 @@ return make_float (d); } -DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0 /* +DEFUN ("asinh", Fasinh, 1, 1, 0, /* Return the inverse hyperbolic sine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef HAVE_INVERSE_HYPERBOLIC @@ -616,11 +593,10 @@ return make_float (d); } -DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0 /* +DEFUN ("atanh", Fatanh, 1, 1, 0, /* Return the inverse hyperbolic tangent of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -635,11 +611,10 @@ return make_float (d); } -DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0 /* +DEFUN ("cosh", Fcosh, 1, 1, 0, /* Return the hyperbolic cosine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -650,11 +625,10 @@ return make_float (d); } -DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0 /* +DEFUN ("sinh", Fsinh, 1, 1, 0, /* Return the hyperbolic sine of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN @@ -665,11 +639,10 @@ return make_float (d); } -DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0 /* +DEFUN ("tanh", Ftanh, 1, 1, 0, /* Return the hyperbolic tangent of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = tanh (d), "tanh", arg); @@ -679,11 +652,10 @@ /* Rounding functions */ -DEFUN ("abs", Fabs, Sabs, 1, 1, 0 /* +DEFUN ("abs", Fabs, 1, 1, 0, /* Return the absolute value of ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { CHECK_INT_OR_FLOAT (arg); @@ -703,11 +675,10 @@ } #ifdef LISP_FLOAT_TYPE -DEFUN ("float", Ffloat, Sfloat, 1, 1, 0 /* +DEFUN ("float", Ffloat, 1, 1, 0, /* Return the floating point number equal to ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { CHECK_INT_OR_FLOAT (arg); @@ -720,12 +691,11 @@ #ifdef LISP_FLOAT_TYPE -DEFUN ("logb", Flogb, Slogb, 1, 1, 0 /* +DEFUN ("logb", Flogb, 1, 1, 0, /* Return largest integer <= the base 2 log of the magnitude of ARG. This is the same as the exponent of a float. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double f = extract_float (arg); @@ -774,11 +744,10 @@ #endif /* LISP_FLOAT_TYPE */ -DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0 /* +DEFUN ("ceiling", Fceiling, 1, 1, 0, /* Return the smallest integer no less than ARG. (Round toward +inf.) -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { CHECK_INT_OR_FLOAT (arg); @@ -795,12 +764,11 @@ } -DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0 /* +DEFUN ("floor", Ffloor, 1, 2, 0, /* Return the largest integer no greater than ARG. (Round towards -inf.) With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. -*/ ) - (arg, divisor) - Lisp_Object arg, divisor; +*/ + (arg, divisor)) { CHECK_INT_OR_FLOAT (arg); @@ -852,11 +820,10 @@ return arg; } -DEFUN ("round", Fround, Sround, 1, 1, 0 /* +DEFUN ("round", Fround, 1, 1, 0, /* Return the nearest integer to ARG. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { CHECK_INT_OR_FLOAT (arg); @@ -873,12 +840,11 @@ return arg; } -DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0 /* +DEFUN ("truncate", Ftruncate, 1, 1, 0, /* Truncate a floating point number to an integer. Rounds the value toward zero. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { CHECK_INT_OR_FLOAT (arg); @@ -895,47 +861,43 @@ #ifdef LISP_FLOAT_TYPE /* #if 1 It's not clear these are worth adding... */ -DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0 /* +DEFUN ("fceiling", Ffceiling, 1, 1, 0, /* Return the smallest integer no less than ARG, as a float. \(Round toward +inf.\) -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = ceil (d), "fceiling", arg); return make_float (d); } -DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0 /* +DEFUN ("ffloor", Fffloor, 1, 1, 0, /* Return the largest integer no greater than ARG, as a float. \(Round towards -inf.\) -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = floor (d), "ffloor", arg); return make_float (d); } -DEFUN ("fround", Ffround, Sfround, 1, 1, 0 /* +DEFUN ("fround", Ffround, 1, 1, 0, /* Return the nearest integer to ARG, as a float. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); IN_FLOAT (d = rint (d), "fround", arg); return make_float (d); } -DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0 /* +DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /* Truncate a floating point number to an integral float value. Rounds the value toward zero. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { double d = extract_float (arg); if (d >= 0.0) @@ -1021,76 +983,76 @@ /* Trig functions. */ #ifdef LISP_FLOAT_TYPE - defsubr (&Sacos); - defsubr (&Sasin); - defsubr (&Satan); - defsubr (&Scos); - defsubr (&Ssin); - defsubr (&Stan); + DEFSUBR (Facos); + DEFSUBR (Fasin); + DEFSUBR (Fatan); + DEFSUBR (Fcos); + DEFSUBR (Fsin); + DEFSUBR (Ftan); #endif /* LISP_FLOAT_TYPE */ /* Bessel functions */ #if 0 - defsubr (&Sbessel_y0); - defsubr (&Sbessel_y1); - defsubr (&Sbessel_yn); - defsubr (&Sbessel_j0); - defsubr (&Sbessel_j1); - defsubr (&Sbessel_jn); + DEFSUBR (Fbessel_y0); + DEFSUBR (Fbessel_y1); + DEFSUBR (Fbessel_yn); + DEFSUBR (Fbessel_j0); + DEFSUBR (Fbessel_j1); + DEFSUBR (Fbessel_jn); #endif /* 0 */ /* Error functions. */ #if 0 - defsubr (&Serf); - defsubr (&Serfc); - defsubr (&Slog_gamma); + DEFSUBR (Ferf); + DEFSUBR (Ferfc); + DEFSUBR (Flog_gamma); #endif /* 0 */ /* Root and Log functions. */ #ifdef LISP_FLOAT_TYPE - defsubr (&Sexp); + DEFSUBR (Fexp); #endif /* LISP_FLOAT_TYPE */ - defsubr (&Sexpt); + DEFSUBR (Fexpt); #ifdef LISP_FLOAT_TYPE - defsubr (&Slog); - defsubr (&Slog10); - defsubr (&Ssqrt); - defsubr (&Scube_root); + DEFSUBR (Flog); + DEFSUBR (Flog10); + DEFSUBR (Fsqrt); + DEFSUBR (Fcube_root); #endif /* LISP_FLOAT_TYPE */ /* Inverse trig functions. */ #ifdef LISP_FLOAT_TYPE - defsubr (&Sacosh); - defsubr (&Sasinh); - defsubr (&Satanh); - defsubr (&Scosh); - defsubr (&Ssinh); - defsubr (&Stanh); + DEFSUBR (Facosh); + DEFSUBR (Fasinh); + DEFSUBR (Fatanh); + DEFSUBR (Fcosh); + DEFSUBR (Fsinh); + DEFSUBR (Ftanh); #endif /* LISP_FLOAT_TYPE */ /* Rounding functions */ - defsubr (&Sabs); + DEFSUBR (Fabs); #ifdef LISP_FLOAT_TYPE - defsubr (&Sfloat); - defsubr (&Slogb); + DEFSUBR (Ffloat); + DEFSUBR (Flogb); #endif /* LISP_FLOAT_TYPE */ - defsubr (&Sceiling); - defsubr (&Sfloor); - defsubr (&Sround); - defsubr (&Struncate); + DEFSUBR (Fceiling); + DEFSUBR (Ffloor); + DEFSUBR (Fround); + DEFSUBR (Ftruncate); /* Float-rounding functions. */ #ifdef LISP_FLOAT_TYPE - defsubr (&Sfceiling); - defsubr (&Sffloor); - defsubr (&Sfround); - defsubr (&Sftruncate); + DEFSUBR (Ffceiling); + DEFSUBR (Fffloor); + DEFSUBR (Ffround); + DEFSUBR (Fftruncate); #endif /* LISP_FLOAT_TYPE */ }
--- a/src/fns.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/fns.c Mon Aug 13 08:50:05 2007 +0200 @@ -110,11 +110,10 @@ sizeof (long))); } -DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0 /* +DEFUN ("identity", Fidentity, 1, 1, 0, /* Return the argument unchanged. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { return arg; } @@ -122,15 +121,14 @@ extern long get_random (void); extern void seed_random (long arg); -DEFUN ("random", Frandom, Srandom, 0, 1, 0 /* +DEFUN ("random", Frandom, 0, 1, 0, /* Return a pseudo-random number. All integers representable in Lisp are equally likely.\n\ On most systems, this is 28 bits' worth.\n\ With positive integer argument N, return random number in interval [0,N).\n\ With argument t, set the random number seed from the current time and pid. -*/ ) - (limit) - Lisp_Object limit; +*/ + (limit)) { EMACS_INT val; Lisp_Object lispy_val; @@ -199,11 +197,10 @@ function); } -DEFUN ("length", Flength, Slength, 1, 1, 0 /* +DEFUN ("length", Flength, 1, 1, 0, /* Return the length of vector, bit vector, list or string SEQUENCE. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { Lisp_Object tail; int i; @@ -240,14 +237,13 @@ /* This does not check for quits. That is safe since it must terminate. */ -DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0 /* +DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /* Return the length of a list, but avoid error or infinite loop. This function never gets an error. If LIST is not really a list, it returns 0. If LIST is circular, it returns a finite value which is at least the number of distinct elements. -*/ ) - (list) - Lisp_Object list; +*/ + (list)) { Lisp_Object tail, halftail, length; int len = 0; @@ -269,15 +265,14 @@ /*** string functions. ***/ -DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0 /* +DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /* T if two strings have identical contents. Case is significant. Text properties are ignored. (Under XEmacs, `equal' also ignores text properties and extents in strings, but this is not the case under FSF Emacs.) Symbols are also allowed; their print names are used instead. -*/ ) - (s1, s2) - Lisp_Object s1, s2; +*/ + (s1, s2)) { int len; @@ -296,14 +291,13 @@ } -DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0 /* +DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* T if first arg string is less than second in lexicographic order. If I18N2 support was compiled in, ordering is determined by the locale. Case is significant for the default C locale. Symbols are also allowed; their print names are used instead. -*/ ) - (s1, s2) - Lisp_Object s1, s2; +*/ + (s1, s2)) { struct Lisp_String *p1, *p2; Charcount end, len2; @@ -352,14 +346,12 @@ } } -DEFUN ("string-modified-tick", Fstring_modified_tick, Sstring_modified_tick, - 1, 1, 0 /* +DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /* Return STRING's tick counter, incremented for each change to the string. Each string has a tick counter which is incremented each time the contents of the string are changed (e.g. with `aset'). It wraps around occasionally. -*/ ) - (string) - Lisp_Object string; +*/ + (string)) { struct Lisp_String *s; @@ -434,20 +426,18 @@ return concat (3, args, c_vector, 0); } -DEFUN ("append", Fappend, Sappend, 0, MANY, 0 /* +DEFUN ("append", Fappend, 0, MANY, 0, /* Concatenate all the arguments and make the result a list. The result is a list whose elements are the elements of all the arguments. Each argument may be a list, vector, bit vector, or string. The last argument is not copied, just used as the tail of the new list. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_cons, 1); } -DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0 /* +DEFUN ("concat", Fconcat, 0, MANY, 0, /* Concatenate all the arguments and make the result a string. 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). @@ -456,45 +446,38 @@ The behavior of `concat' in that case will be changed later! If your program passes an integer as an argument to `concat', you should change it right away not to do so. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_string, 0); } -DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0 /* +DEFUN ("vconcat", Fvconcat, 0, MANY, 0, /* Concatenate all the arguments and make the result a vector. The result is a vector whose elements are the elements of all the arguments. Each argument may be a list, vector, bit vector, or string. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_vector, 0); } -DEFUN ("bvconcat", Fbvconcat, Sbvconcat, 0, MANY, 0 /* +DEFUN ("bvconcat", Fbvconcat, 0, MANY, 0, /* Concatenate all the arguments and make the result a bit vector. The result is a bit vector whose elements are the elements of all the arguments. Each argument may be a list, vector, bit vector, or string. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_bit_vector, 0); } -DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0 /* +DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /* Return a copy of a list, vector, bit vector or string. The elements of a list or vector are not copied; they are shared with the original. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { again: if (NILP (arg)) return arg; @@ -782,16 +765,15 @@ RETURN_UNGCPRO (val); } -DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0 /* +DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /* Return a copy of ALIST. This is an alist which represents the same mapping from objects to objects, but does not share the alist structure with ALIST. The objects mapped (cars and cdrs of elements of the alist) are shared, however. Elements of ALIST that are not conses are also shared. -*/ ) - (alist) - Lisp_Object alist; +*/ + (alist)) { Lisp_Object tem; @@ -810,15 +792,14 @@ return alist; } -DEFUN ("copy-tree", Fcopy_tree, Scopy_tree, 1, 2, 0 /* +DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /* Return a copy of a list and substructures. The argument is copied, and any lists contained within it are copied recursively. Circularities and shared substructures are not preserved. Second arg VECP causes vectors to be copied, too. Strings and bit vectors are not copied. -*/ ) - (arg, vecp) - Lisp_Object arg, vecp; +*/ + (arg, vecp)) { if (CONSP (arg)) { @@ -851,15 +832,13 @@ return arg; } -DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0 /* +DEFUN ("substring", Fsubstring, 2, 3, 0, /* Return a substring of STRING, starting at index FROM and ending before TO. TO may be nil or omitted; then the substring runs to the end of STRING. If FROM or TO is negative, it counts from the end. Relevant parts of the string-extent-data are copied in the new string. -*/ ) - (string, from, to) - Lisp_Object string; - Lisp_Object from, to; +*/ + (string, from, to)) { Charcount ccfr, ccto; Bytecount bfr, bto; @@ -878,7 +857,7 @@ return (val); } -DEFUN ("subseq", Fsubseq, Ssubseq, 2, 3, 0 /* +DEFUN ("subseq", Fsubseq, 2, 3, 0, /* Return a subsequence of SEQ, starting at index FROM and ending before TO. TO may be nil or omitted; then the subsequence runs to the end of SEQ. If FROM or TO is negative, it counts from the end. @@ -886,10 +865,8 @@ sequence. If SEQ is a string, relevant parts of the string-extent-data are copied in the new string. -*/ ) - (seq, from, to) - Lisp_Object seq; - Lisp_Object from, to; +*/ + (seq, from, to)) { int len, f, t; @@ -965,12 +942,10 @@ } -DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0 /* +DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* Take cdr N times on LIST, returns the result. -*/ ) - (n, list) - Lisp_Object n; - Lisp_Object list; +*/ + (n, list)) { REGISTER int i, num; CHECK_INT (n); @@ -983,21 +958,19 @@ return list; } -DEFUN ("nth", Fnth, Snth, 2, 2, 0 /* +DEFUN ("nth", Fnth, 2, 2, 0, /* Return the Nth element of LIST. N counts from zero. If LIST is not that long, nil is returned. -*/ ) - (n, list) - Lisp_Object n, list; +*/ + (n, list)) { return Fcar (Fnthcdr (n, list)); } -DEFUN ("elt", Felt, Selt, 2, 2, 0 /* +DEFUN ("elt", Felt, 2, 2, 0, /* Return element of SEQUENCE at index N. -*/ ) - (seq, n) - Lisp_Object seq, n; +*/ + (seq, n)) { retry: CHECK_INT_COERCE_CHAR (n); /* yuck! */ @@ -1069,13 +1042,11 @@ } } -DEFUN ("member", Fmember, Smember, 2, 2, 0 /* +DEFUN ("member", Fmember, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. -*/ ) - (elt, list) - Lisp_Object elt; - Lisp_Object list; +*/ + (elt, list)) { REGISTER Lisp_Object tail, tem; for (tail = list; !NILP (tail); tail = Fcdr (tail)) @@ -1088,13 +1059,11 @@ return Qnil; } -DEFUN ("memq", Fmemq, Smemq, 2, 2, 0 /* +DEFUN ("memq", Fmemq, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. -*/ ) - (elt, list) - Lisp_Object elt; - Lisp_Object list; +*/ + (elt, list)) { REGISTER Lisp_Object tail, tem; for (tail = list; !NILP (tail); tail = Fcdr (tail)) @@ -1118,13 +1087,11 @@ return Qnil; } -DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0 /* +DEFUN ("assoc", Fassoc, 2, 2, 0, /* Return non-nil if KEY is `equal' to the car of an element of LIST. The value is actually the element of LIST whose car equals KEY. -*/ ) - (key, list) - Lisp_Object key; - Lisp_Object list; +*/ + (key, list)) { /* This function can GC. */ REGISTER Lisp_Object tail, elt, tem; @@ -1147,14 +1114,12 @@ return (unbind_to (speccount, Fassoc (key, list))); } -DEFUN ("assq", Fassq, Sassq, 2, 2, 0 /* +DEFUN ("assq", Fassq, 2, 2, 0, /* Return non-nil if KEY is `eq' to the car of an element of LIST. The value is actually the element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. -*/ ) - (key, list) - Lisp_Object key; - Lisp_Object list; +*/ + (key, list)) { REGISTER Lisp_Object tail, elt, tem; for (tail = list; !NILP (tail); tail = Fcdr (tail)) @@ -1186,13 +1151,11 @@ return Qnil; } -DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0 /* +DEFUN ("rassoc", Frassoc, 2, 2, 0, /* Return non-nil if KEY is `equal' to the cdr of an element of LIST. The value is actually the element of LIST whose cdr equals KEY. -*/ ) - (key, list) - Lisp_Object key; - Lisp_Object list; +*/ + (key, list)) { REGISTER Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) @@ -1207,13 +1170,11 @@ return Qnil; } -DEFUN ("rassq", Frassq, Srassq, 2, 2, 0 /* +DEFUN ("rassq", Frassq, 2, 2, 0, /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. The value is actually the element of LIST whose cdr is KEY. -*/ ) - (key, list) - Lisp_Object key; - Lisp_Object list; +*/ + (key, list)) { REGISTER Lisp_Object tail, elt, tem; for (tail = list; !NILP (tail); tail = Fcdr (tail)) @@ -1242,16 +1203,14 @@ } -DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0 /* +DEFUN ("delete", Fdelete, 2, 2, 0, /* Delete by side effect any occurrences of ELT as a member of LIST. The modified LIST is returned. Comparison is done with `equal'. If the first member of LIST is ELT, there is no way to remove it by side effect; therefore, write `(setq foo (delete element foo))' to be sure of changing the value of `foo'. -*/ ) - (elt, list) - Lisp_Object elt; - Lisp_Object list; +*/ + (elt, list)) { REGISTER Lisp_Object tail, prev; @@ -1274,16 +1233,14 @@ return list; } -DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0 /* +DEFUN ("delq", Fdelq, 2, 2, 0, /* Delete by side effect any occurrences of ELT as a member of LIST. The modified LIST is returned. Comparison is done with `eq'. If the first member of LIST is ELT, there is no way to remove it by side effect; therefore, write `(setq foo (delq element foo))' to be sure of changing the value of `foo'. -*/ ) - (elt, list) - Lisp_Object elt; - Lisp_Object list; +*/ + (elt, list)) { REGISTER Lisp_Object tail, prev; REGISTER Lisp_Object tem; @@ -1371,16 +1328,14 @@ return list; } -DEFUN ("remassoc", Fremassoc, Sremassoc, 2, 2, 0 /* +DEFUN ("remassoc", Fremassoc, 2, 2, 0, /* Delete by side effect any elements of LIST whose car is `equal' to KEY. The modified LIST is returned. If the first member of LIST has a car that is `equal' to KEY, there is no way to remove it by side effect; therefore, write `(setq foo (remassoc key foo))' to be sure of changing the value of `foo'. -*/ ) - (key, list) - Lisp_Object key; - Lisp_Object list; +*/ + (key, list)) { REGISTER Lisp_Object tail, prev; @@ -1412,16 +1367,14 @@ return (unbind_to (speccount, Fremassoc (key, list))); } -DEFUN ("remassq", Fremassq, Sremassq, 2, 2, 0 /* +DEFUN ("remassq", Fremassq, 2, 2, 0, /* Delete by side effect any elements of LIST whose car is `eq' to KEY. The modified LIST is returned. If the first member of LIST has a car that is `eq' to KEY, there is no way to remove it by side effect; therefore, write `(setq foo (remassq key foo))' to be sure of changing the value of `foo'. -*/ ) - (key, list) - Lisp_Object key; - Lisp_Object list; +*/ + (key, list)) { REGISTER Lisp_Object tail, prev; @@ -1472,16 +1425,14 @@ return list; } -DEFUN ("remrassoc", Fremrassoc, Sremrassoc, 2, 2, 0 /* +DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /* Delete by side effect any elements of LIST whose cdr is `equal' to VALUE. The modified LIST is returned. If the first member of LIST has a car that is `equal' to VALUE, there is no way to remove it by side effect; therefore, write `(setq foo (remrassoc value foo))' to be sure of changing the value of `foo'. -*/ ) - (value, list) - Lisp_Object value; - Lisp_Object list; +*/ + (value, list)) { REGISTER Lisp_Object tail, prev; @@ -1505,16 +1456,14 @@ return list; } -DEFUN ("remrassq", Fremrassq, Sremrassq, 2, 2, 0 /* +DEFUN ("remrassq", Fremrassq, 2, 2, 0, /* Delete by side effect any elements of LIST whose cdr is `eq' to VALUE. The modified LIST is returned. If the first member of LIST has a car that is `eq' to VALUE, there is no way to remove it by side effect; therefore, write `(setq foo (remrassq value foo))' to be sure of changing the value of `foo'. -*/ ) - (value, list) - Lisp_Object value; - Lisp_Object list; +*/ + (value, list)) { REGISTER Lisp_Object tail, prev; @@ -1565,12 +1514,11 @@ return list; } -DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0 /* +DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* Reverse LIST by modifying cdr pointers. Returns the beginning of the reversed list. -*/ ) - (list) - Lisp_Object list; +*/ + (list)) { Lisp_Object prev, tail, next; struct gcpro gcpro1, gcpro2; @@ -1591,12 +1539,11 @@ return prev; } -DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0 /* +DEFUN ("reverse", Freverse, 1, 1, 0, /* Reverse LIST, copying. Returns the beginning of the reversed list. See also the function `nreverse', which is used more often. -*/ ) - (list) - Lisp_Object list; +*/ + (list)) { Lisp_Object length; Lisp_Object *vec; @@ -1668,14 +1615,13 @@ return 1; } -DEFUN ("sort", Fsort, Ssort, 2, 2, 0 /* +DEFUN ("sort", Fsort, 2, 2, 0, /* Sort LIST, stably, comparing elements using PREDICATE. Returns the sorted list. LIST is modified by side effects. PREDICATE is called with two elements of LIST, and should return T if the first element is \"less\" than the second. -*/ ) - (list, pred) - Lisp_Object list, pred; +*/ + (list, pred)) { return list_sort (list, pred, merge_pred_function); } @@ -1836,7 +1782,7 @@ return 1; } -DEFUN ("plists-eq", Fplists_eq, Splists_eq, 2, 3, 0 /* +DEFUN ("plists-eq", Fplists_eq, 2, 3, 0, /* Return non-nil if property lists A and B are `eq'. A property list is an alternating list of keywords and values. This function does order-insensitive comparisons of the property lists: @@ -1846,15 +1792,14 @@ a nil value is ignored. This feature is a virus that has infected old Lisp implementations, but should not be used except for backward compatibility. -*/ ) - (a, b, nil_means_not_present) - Lisp_Object a, b, nil_means_not_present; +*/ + (a, b, nil_means_not_present)) { return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1) ? Qnil : Qt); } -DEFUN ("plists-equal", Fplists_equal, Splists_equal, 2, 3, 0 /* +DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /* Return non-nil if property lists A and B are `equal'. A property list is an alternating list of keywords and values. This function does order-insensitive comparisons of the property lists: For @@ -1864,16 +1809,15 @@ a nil value is ignored. This feature is a virus that has infected old Lisp implementations, but should not be used except for backward compatibility. -*/ ) - (a, b, nil_means_not_present) - Lisp_Object a, b, nil_means_not_present; +*/ + (a, b, nil_means_not_present)) { return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1) ? Qnil : Qt); } -DEFUN ("lax-plists-eq", Flax_plists_eq, Slax_plists_eq, 2, 3, 0 /* +DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /* Return non-nil if lax property lists A and B are `eq'. A property list is an alternating list of keywords and values. This function does order-insensitive comparisons of the property lists: @@ -1885,15 +1829,14 @@ a nil value is ignored. This feature is a virus that has infected old Lisp implementations, but should not be used except for backward compatibility. -*/ ) - (a, b, nil_means_not_present) - Lisp_Object a, b, nil_means_not_present; +*/ + (a, b, nil_means_not_present)) { return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1) ? Qnil : Qt); } -DEFUN ("lax-plists-equal", Flax_plists_equal, Slax_plists_equal, 2, 3, 0 /* +DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /* Return non-nil if lax property lists A and B are `equal'. A property list is an alternating list of keywords and values. This function does order-insensitive comparisons of the property lists: For @@ -1905,9 +1848,8 @@ a nil value is ignored. This feature is a virus that has infected old Lisp implementations, but should not be used except for backward compatibility. -*/ ) - (a, b, nil_means_not_present) - Lisp_Object a, b, nil_means_not_present; +*/ + (a, b, nil_means_not_present)) { return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1) ? Qnil : Qt); @@ -2216,15 +2158,14 @@ return 0; } -DEFUN ("plist-get", Fplist_get, Splist_get, 2, 3, 0 /* +DEFUN ("plist-get", Fplist_get, 2, 3, 0, /* Extract a value from a property list. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value corresponding to the given PROP, or DEFAULT if PROP is not one of the properties on the list. -*/ ) - (plist, prop, defalt) /* Cant spel in C */ - Lisp_Object plist, prop, defalt; +*/ + (plist, prop, defalt)) /* Cant spel in C */ { Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME); if (UNBOUNDP (val)) @@ -2232,7 +2173,7 @@ return val; } -DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0 /* +DEFUN ("plist-put", Fplist_put, 3, 3, 0, /* Change value in PLIST of PROP to VAL. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is usually a symbol and VAL is any object. @@ -2240,44 +2181,39 @@ otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. -*/ ) - (plist, prop, val) - Lisp_Object plist, prop, val; +*/ + (plist, prop, val)) { external_plist_put (&plist, prop, val, 0, ERROR_ME); return plist; } -DEFUN ("plist-remprop", Fplist_remprop, Splist_remprop, 2, 2, 0 /* +DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /* Remove from PLIST the property PROP and its value. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is usually a symbol. The new plist is returned; use `(setq x (plist-remprop x prop val))' to be sure to use the new value. The PLIST is modified by side effects. -*/ ) - (plist, prop) - Lisp_Object plist, prop; +*/ + (plist, prop)) { external_remprop (&plist, prop, 0, ERROR_ME); return plist; } -DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0 /* +DEFUN ("plist-member", Fplist_member, 2, 2, 0, /* Return t if PROP has a value specified in PLIST. -*/ ) - (plist, prop) - Lisp_Object plist, prop; +*/ + (plist, prop)) { return UNBOUNDP (Fplist_get (plist, prop, Qunbound)) ? Qnil : Qt; } -DEFUN ("check-valid-plist", Fcheck_valid_plist, Scheck_valid_plist, - 1, 1, 0 /* +DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /* Given a plist, signal an error if there is anything wrong with it. This means that it's a malformed or circular plist. -*/ ) - (plist) - Lisp_Object plist; +*/ + (plist)) { Lisp_Object *tortoise; Lisp_Object *hare; @@ -2298,15 +2234,13 @@ return Qnil; } -DEFUN ("valid-plist-p", Fvalid_plist_p, Svalid_plist_p, - 1, 1, 0 /* +DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /* Given a plist, return non-nil if its format is correct. If it returns nil, `check-valid-plist' will signal an error when given the plist; that means it's a malformed or circular plist or has non-symbols as keywords. -*/ ) - (plist) - Lisp_Object plist; +*/ + (plist)) { Lisp_Object *tortoise; Lisp_Object *hare; @@ -2326,8 +2260,7 @@ return Qt; } -DEFUN ("canonicalize-plist", Fcanonicalize_plist, Scanonicalize_plist, - 1, 2, 0 /* +DEFUN ("canonicalize-plist", Fcanonicalize_plist, 1, 2, 0, /* Destructively remove any duplicate entries from a plist. In such cases, the first entry applies. @@ -2339,9 +2272,8 @@ The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the return value may not be EQ to the passed-in value, so make sure to `setq' the value back into where it came from. -*/ ) - (plist, nil_means_not_present) - Lisp_Object plist, nil_means_not_present; +*/ + (plist, nil_means_not_present)) { Lisp_Object head = plist; @@ -2370,7 +2302,7 @@ return head; } -DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 3, 0 /* +DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /* Extract a value from a lax property list. LAX-PLIST is a lax property list, which is a list of the form \(PROP1 @@ -2378,9 +2310,8 @@ using `equal' instead of `eq'. This function returns the value corresponding to the given PROP, or DEFAULT if PROP is not one of the properties on the list. -*/ ) - (lax_plist, prop, defalt) /* Cant spel in C */ - Lisp_Object lax_plist, prop, defalt; +*/ + (lax_plist, prop, defalt)) /* Cant spel in C */ { Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME); if (UNBOUNDP (val)) @@ -2388,7 +2319,7 @@ return val; } -DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0 /* +DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* Change value in LAX-PLIST of PROP to VAL. LAX-PLIST is a lax property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...), where comparions between properties is done @@ -2397,43 +2328,39 @@ set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. The LAX-PLIST is modified by side effects. -*/ ) - (lax_plist, prop, val) - Lisp_Object lax_plist, prop, val; +*/ + (lax_plist, prop, val)) { external_plist_put (&lax_plist, prop, val, 1, ERROR_ME); return lax_plist; } -DEFUN ("lax-plist-remprop", Flax_plist_remprop, Slax_plist_remprop, 2, 2, 0 /* +DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /* Remove from LAX-PLIST the property PROP and its value. LAX-PLIST is a lax property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...), where comparions between properties is done using `equal' instead of `eq'. PROP is usually a symbol. The new plist is returned; use `(setq x (lax-plist-remprop x prop val))' to be sure to use the new value. The LAX-PLIST is modified by side effects. -*/ ) - (lax_plist, prop) - Lisp_Object lax_plist, prop; +*/ + (lax_plist, prop)) { external_remprop (&lax_plist, prop, 1, ERROR_ME); return lax_plist; } -DEFUN ("lax-plist-member", Flax_plist_member, Slax_plist_member, 2, 2, 0 /* +DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /* Return t if PROP has a value specified in LAX-PLIST. LAX-PLIST is a lax property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...), where comparions between properties is done using `equal' instead of `eq'. -*/ ) - (lax_plist, prop) - Lisp_Object lax_plist, prop; +*/ + (lax_plist, prop)) { return UNBOUNDP (Flax_plist_get (lax_plist, prop, Qunbound)) ? Qnil : Qt; } -DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, - Scanonicalize_lax_plist, 1, 2, 0 /* +DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /* Destructively remove any duplicate entries from a lax plist. In such cases, the first entry applies. @@ -2445,9 +2372,8 @@ The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the return value may not be EQ to the passed-in value, so make sure to `setq' the value back into where it came from. -*/ ) - (lax_plist, nil_means_not_present) - Lisp_Object lax_plist, nil_means_not_present; +*/ + (lax_plist, nil_means_not_present)) { Lisp_Object head = lax_plist; @@ -2478,8 +2404,7 @@ /* In C because the frame props stuff uses it */ -DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, - Sdestructive_alist_to_plist, 1, 1, 0 /* +DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, 1, 1, 0, /* Convert association list ALIST into the equivalent property-list form. The plist is returned. This converts from @@ -2491,9 +2416,8 @@ The original alist is destroyed in the process of constructing the plist. See also `alist-to-plist'. -*/ ) - (alist) - Lisp_Object alist; +*/ + (alist)) { Lisp_Object head = alist; while (!NILP (alist)) @@ -2587,15 +2511,14 @@ return *string_plist_ptr (s); } -DEFUN ("get", Fget, Sget, 2, 3, 0 /* +DEFUN ("get", Fget, 2, 3, 0, /* Return the value of OBJECT's PROPNAME property. This is the last VALUE stored with `(put OBJECT PROPNAME VALUE)'. If there is no such property, return optional third arg DEFAULT (which defaults to `nil'). OBJECT can be a symbol, face, extent, or string. See also `put', `remprop', and `object-plist'. -*/ ) - (object, propname, defalt) /* Cant spel in C */ - Lisp_Object object, propname, defalt; +*/ + (object, propname, defalt)) /* Cant spel in C */ { Lisp_Object val; @@ -2630,7 +2553,7 @@ return val; } -DEFUN ("put", Fput, Sput, 3, 3, 0 /* +DEFUN ("put", Fput, 3, 3, 0, /* Store OBJECT's PROPNAME property with value VALUE. It can be retrieved with `(get OBJECT PROPNAME)'. OBJECT can be a symbol, face, extent, or string. @@ -2640,11 +2563,8 @@ For the predefined properties for faces, see `set-face-property'. See also `get', `remprop', and `object-plist'. -*/ ) - (object, propname, value) - Lisp_Object object; - Lisp_Object propname; - Lisp_Object value; +*/ + (object, propname, value)) { CHECK_SYMBOL (propname); CHECK_IMPURE (object); @@ -2680,15 +2600,14 @@ Fput (sym, prop, Fpurecopy (val)); } -DEFUN ("remprop", Fremprop, Sremprop, 2, 2, 0 /* +DEFUN ("remprop", Fremprop, 2, 2, 0, /* Remove from OBJECT's property list the property PROPNAME and its value. OBJECT can be a symbol, face, extent, or string. Returns non-nil if the property list was actually changed (i.e. if PROPNAME was present in the property list). See also `get', `put', and `object-plist'. -*/ ) - (object, propname) - Lisp_Object object, propname; +*/ + (object, propname)) { int retval = 0; @@ -2722,15 +2641,14 @@ return retval ? Qt : Qnil; } -DEFUN ("object-plist", Fobject_plist, Sobject_plist, 1, 1, 0 /* +DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* Return a property list of OBJECT's props. For a symbol this is equivalent to `symbol-plist'. Do not modify the property list directly; this may or may not have the desired effects. (In particular, for a property with a special interpretation, this will probably have no effect at all.) -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (SYMBOLP (object)) return Fsymbol_plist (object); @@ -2817,26 +2735,24 @@ return (0); } -DEFUN ("equal", Fequal, Sequal, 2, 2, 0 /* +DEFUN ("equal", Fequal, 2, 2, 0, /* T if two Lisp objects have similar structure and contents. They must have the same data type. Conses are compared by comparing the cars and the cdrs. Vectors and strings are compared element by element. Numbers are compared by value. Symbols must match exactly. -*/ ) - (o1, o2) - Lisp_Object o1, o2; +*/ + (o1, o2)) { return ((internal_equal (o1, o2, 0)) ? Qt : Qnil); } -DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0 /* +DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* Store each element of ARRAY with ITEM. ARRAY is a vector, bit vector, or string. -*/ ) - (array, item) - Lisp_Object array, item; +*/ + (array, item)) { retry: if (STRINGP (array)) @@ -2894,13 +2810,11 @@ return Fnconc (2, args); } -DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0 /* +DEFUN ("nconc", Fnconc, 0, MANY, 0, /* Concatenate any number of lists by altering them. Only the last argument is not altered, and need not be a list. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { int argnum; Lisp_Object tail, tem, val; @@ -3024,13 +2938,12 @@ UNGCPRO; } -DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0 /* +DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* Apply FN to each element of SEQ, and concat the results as strings. In between each pair of results, stick in SEP. Thus, \" \" as SEP results in spaces between the values returned by FN. -*/ ) - (fn, seq, sep) - Lisp_Object fn, seq, sep; +*/ + (fn, seq, sep)) { int len = XINT (Flength (seq)); int nargs; @@ -3056,13 +2969,12 @@ return Fconcat (nargs, args); } -DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0 /* +DEFUN ("mapcar", Fmapcar, 2, 2, 0, /* Apply FUNCTION to each element of SEQUENCE, and make a list of the results. The result is a list just as long as SEQUENCE. SEQUENCE may be a list, a vector, a bit vector, or a string. -*/ ) - (fn, seq) - Lisp_Object fn, seq; +*/ + (fn, seq)) { int len = XINT (Flength (seq)); Lisp_Object *args = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); @@ -3072,14 +2984,13 @@ return Flist (len, args); } -DEFUN ("mapc-internal", Fmapc_internal, Smapc_internal, 2, 2, 0 /* +DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /* Apply FUNCTION to each element of SEQUENCE. SEQUENCE may be a list, a vector, a bit vector, or a string. This function is like `mapcar' but does not accumulate the results, which is more efficient if you do not use the results. -*/ ) - (fn, seq) - Lisp_Object fn, seq; +*/ + (fn, seq)) { mapcar1 (XINT (Flength (seq)), 0, fn, seq); @@ -3089,7 +3000,7 @@ /* #### this function doesn't belong in this file! */ -DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0 /* +DEFUN ("load-average", Fload_average, 0, 0, 0, /* Return list of 1 minute, 5 minute and 15 minute load averages. Each of the three load averages is multiplied by 100, then converted to integer. @@ -3099,8 +3010,8 @@ On most systems, this won't work unless the emacs executable is installed as setgid kmem (assuming that /dev/kmem is in the group kmem). -*/ ) - () +*/ + ()) { double load_ave[10]; /* hey, just in case */ int loads = getloadavg (load_ave, 3); @@ -3121,26 +3032,24 @@ Lisp_Object Vfeatures; -DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0 /* +DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* Return t if FEATURE is present in this Emacs. Use this to conditionalize execution of lisp code based on the presence or absence of emacs or environment extensions. Use `provide' to declare that a feature is available. This function looks at the value of the variable `features'. -*/ ) - (feature) - Lisp_Object feature; +*/ + (feature)) { CHECK_SYMBOL (feature); return NILP (Fmemq (feature, Vfeatures)) ? Qnil : Qt; } -DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0 /* +DEFUN ("provide", Fprovide, 1, 1, 0, /* Announce that FEATURE is a feature of the current Emacs. This function updates the value of the variable `features'. -*/ ) - (feature) - Lisp_Object feature; +*/ + (feature)) { Lisp_Object tem; CHECK_SYMBOL (feature); @@ -3153,14 +3062,13 @@ return feature; } -DEFUN ("require", Frequire, Srequire, 1, 2, 0 /* +DEFUN ("require", Frequire, 1, 2, 0, /* If feature FEATURE is not loaded, load it from FILENAME. If FEATURE is not a member of the list `features', then the feature is not loaded; so load the file FILENAME. If FILENAME is omitted, the printname of FEATURE is used as the file name. -*/ ) - (feature, file_name) - Lisp_Object feature, file_name; +*/ + (feature, file_name)) { Lisp_Object tem; CHECK_SYMBOL (feature); @@ -3200,71 +3108,71 @@ defsymbol (&Qidentity, "identity"); defsymbol (&Qyes_or_no_p, "yes-or-no-p"); - defsubr (&Sidentity); - defsubr (&Srandom); - defsubr (&Slength); - defsubr (&Ssafe_length); - defsubr (&Sstring_equal); - defsubr (&Sstring_lessp); - defsubr (&Sstring_modified_tick); - defsubr (&Sappend); - defsubr (&Sconcat); - defsubr (&Svconcat); - defsubr (&Sbvconcat); - defsubr (&Scopy_sequence); - defsubr (&Scopy_alist); - defsubr (&Scopy_tree); - defsubr (&Ssubstring); - defsubr (&Ssubseq); - defsubr (&Snthcdr); - defsubr (&Snth); - defsubr (&Selt); - defsubr (&Smember); - defsubr (&Smemq); - defsubr (&Sassoc); - defsubr (&Sassq); - defsubr (&Srassoc); - defsubr (&Srassq); - defsubr (&Sdelete); - defsubr (&Sdelq); - defsubr (&Sremassoc); - defsubr (&Sremassq); - defsubr (&Sremrassoc); - defsubr (&Sremrassq); - defsubr (&Snreverse); - defsubr (&Sreverse); - defsubr (&Ssort); - defsubr (&Splists_eq); - defsubr (&Splists_equal); - defsubr (&Slax_plists_eq); - defsubr (&Slax_plists_equal); - defsubr (&Splist_get); - defsubr (&Splist_put); - defsubr (&Splist_remprop); - defsubr (&Splist_member); - defsubr (&Scheck_valid_plist); - defsubr (&Svalid_plist_p); - defsubr (&Scanonicalize_plist); - defsubr (&Slax_plist_get); - defsubr (&Slax_plist_put); - defsubr (&Slax_plist_remprop); - defsubr (&Slax_plist_member); - defsubr (&Scanonicalize_lax_plist); - defsubr (&Sdestructive_alist_to_plist); - defsubr (&Sget); - defsubr (&Sput); - defsubr (&Sremprop); - defsubr (&Sobject_plist); - defsubr (&Sequal); - defsubr (&Sfillarray); - defsubr (&Snconc); - defsubr (&Smapcar); - defsubr (&Smapc_internal); - defsubr (&Smapconcat); - defsubr (&Sload_average); - defsubr (&Sfeaturep); - defsubr (&Srequire); - defsubr (&Sprovide); + DEFSUBR (Fidentity); + DEFSUBR (Frandom); + DEFSUBR (Flength); + DEFSUBR (Fsafe_length); + DEFSUBR (Fstring_equal); + DEFSUBR (Fstring_lessp); + DEFSUBR (Fstring_modified_tick); + DEFSUBR (Fappend); + DEFSUBR (Fconcat); + DEFSUBR (Fvconcat); + DEFSUBR (Fbvconcat); + DEFSUBR (Fcopy_sequence); + DEFSUBR (Fcopy_alist); + DEFSUBR (Fcopy_tree); + DEFSUBR (Fsubstring); + DEFSUBR (Fsubseq); + DEFSUBR (Fnthcdr); + DEFSUBR (Fnth); + DEFSUBR (Felt); + DEFSUBR (Fmember); + DEFSUBR (Fmemq); + DEFSUBR (Fassoc); + DEFSUBR (Fassq); + DEFSUBR (Frassoc); + DEFSUBR (Frassq); + DEFSUBR (Fdelete); + DEFSUBR (Fdelq); + DEFSUBR (Fremassoc); + DEFSUBR (Fremassq); + DEFSUBR (Fremrassoc); + DEFSUBR (Fremrassq); + DEFSUBR (Fnreverse); + DEFSUBR (Freverse); + DEFSUBR (Fsort); + DEFSUBR (Fplists_eq); + DEFSUBR (Fplists_equal); + DEFSUBR (Flax_plists_eq); + DEFSUBR (Flax_plists_equal); + DEFSUBR (Fplist_get); + DEFSUBR (Fplist_put); + DEFSUBR (Fplist_remprop); + DEFSUBR (Fplist_member); + DEFSUBR (Fcheck_valid_plist); + DEFSUBR (Fvalid_plist_p); + DEFSUBR (Fcanonicalize_plist); + DEFSUBR (Flax_plist_get); + DEFSUBR (Flax_plist_put); + DEFSUBR (Flax_plist_remprop); + DEFSUBR (Flax_plist_member); + DEFSUBR (Fcanonicalize_lax_plist); + DEFSUBR (Fdestructive_alist_to_plist); + DEFSUBR (Fget); + DEFSUBR (Fput); + DEFSUBR (Fremprop); + DEFSUBR (Fobject_plist); + DEFSUBR (Fequal); + DEFSUBR (Ffillarray); + DEFSUBR (Fnconc); + DEFSUBR (Fmapcar); + DEFSUBR (Fmapc_internal); + DEFSUBR (Fmapconcat); + DEFSUBR (Fload_average); + DEFSUBR (Ffeaturep); + DEFSUBR (Frequire); + DEFSUBR (Fprovide); } void
--- a/src/font-lock.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/font-lock.c Mon Aug 13 08:50:05 2007 +0200 @@ -635,8 +635,7 @@ return Qnil; /* suppress compiler warning */ } -DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, - Sbuffer_syntactic_context, 0, 1, 0 /* +DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, 0, 1, 0, /* Return the syntactic context of BUFFER at point. If BUFFER is nil or omitted, the current buffer is assumed. The returned value is one of the following symbols: @@ -652,9 +651,8 @@ over each syntactic context in a region. WARNING: this may alter match-data. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* This function can GC */ struct buffer *buf = decode_buffer (buffer, 0); @@ -662,14 +660,13 @@ return context_to_symbol (context_cache.context); } -DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth, - Sbuffer_syntactic_context_depth, 0, 1, 0 /* +DEFUN ("buffer-syntactic-context-depth", + Fbuffer_syntactic_context_depth, 0, 1, 0, /* Return the depth within all parenthesis-syntax delimiters at point. If BUFFER is nil or omitted, the current buffer is assumed. WARNING: this may alter match-data. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* This function can GC */ struct buffer *buf = decode_buffer (buffer, 0); @@ -678,8 +675,7 @@ } -DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, - Ssyntactically_sectionize, 3, 4, 0 /* +DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, 3, 4, 0, /* Calls FUNCTION for each contiguous syntactic context in the region. Calls the given function with four arguments: the start and end of the region, a symbol representing the syntactic context, and the current @@ -688,9 +684,8 @@ current buffer will be set to BUFFER. WARNING: this may alter match-data. -*/ ) - (function, start, end, buffer) - Lisp_Object function, start, end, buffer; +*/ + (function, start, end, buffer)) { /* This function can GC */ Bufpos s, pt, e; @@ -767,9 +762,9 @@ defsymbol (&Qblock_comment, "block-comment"); defsymbol (&Qbeginning_of_defun, "beginning-of-defun"); - defsubr (&Sbuffer_syntactic_context); - defsubr (&Sbuffer_syntactic_context_depth); - defsubr (&Ssyntactically_sectionize); + DEFSUBR (Fbuffer_syntactic_context); + DEFSUBR (Fbuffer_syntactic_context_depth); + DEFSUBR (Fsyntactically_sectionize); } void
--- a/src/frame-x.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/frame-x.c Mon Aug 13 08:50:05 2007 +0200 @@ -486,6 +486,7 @@ *y = xwa.y; } +#if 0 static void x_smash_bastardly_shell_position (Widget shell) { @@ -501,6 +502,7 @@ x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &shell->core.x, &shell->core.y); } +#endif /* 0 */ static Lisp_Object x_frame_property (struct frame *f, Lisp_Object property) @@ -512,15 +514,26 @@ #define FROB(propprop, value) \ do { \ if (EQ (property, propprop)) \ - { \ - return (value); \ - } \ + return (value); \ } while (0) +#if 0 if (EQ (property, Qleft) || EQ (property, Qtop)) x_smash_bastardly_shell_position (shell); +#endif + if (EQ (property, Qleft) || EQ (property, Qtop)) + { + Position x, y; + if (!XtWindow(shell)) + return make_int (0); + x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y); + FROB (Qleft, make_int (x)); + FROB (Qtop, make_int (y)); + } +#if 0 FROB (Qleft, make_int (shell->core.x)); FROB (Qtop, make_int (shell->core.y)); +#endif FROB (Qborder_width, make_int (w->core.border_width)); FROB (Qinternal_border_width, make_int (w->emacs_frame.internal_border_width)); @@ -534,7 +547,7 @@ color_to_string (gw, w->emacs_frame.background_toolbar_pixel)); FROB (Qtoolbar_shadow_thickness, make_int (w->emacs_frame.toolbar_shadow_thickness)); -#endif +#endif /* HAVE_TOOLBARS */ FROB (Qinter_line_space, make_int (w->emacs_frame.interline)); FROB (Qwindow_id, Fx_window_id (make_frame (f))); @@ -546,23 +559,20 @@ static int x_internal_frame_property_p (struct frame *f, Lisp_Object property) { - if (EQ (property, Qleft) - || EQ (property, Qtop) - || EQ (property, Qborder_width) - || EQ (property, Qinternal_border_width) - || EQ (property, Qborder_color) + return EQ (property, Qleft) + || EQ (property, Qtop) + || EQ (property, Qborder_width) + || EQ (property, Qinternal_border_width) + || EQ (property, Qborder_color) #ifdef HAVE_TOOLBARS - || EQ (property, Qtop_toolbar_shadow_color) - || EQ (property, Qbottom_toolbar_shadow_color) - || EQ (property, Qbackground_toolbar_color) - || EQ (property, Qtoolbar_shadow_thickness) + || EQ (property, Qtop_toolbar_shadow_color) + || EQ (property, Qbottom_toolbar_shadow_color) + || EQ (property, Qbackground_toolbar_color) + || EQ (property, Qtoolbar_shadow_thickness) #endif - || EQ (property, Qinter_line_space) - || EQ (property, Qwindow_id) - || STRINGP (property)) - return 1; - - return 0; + || EQ (property, Qinter_line_space) + || EQ (property, Qwindow_id) + || STRINGP (property); } static Lisp_Object @@ -572,6 +582,7 @@ Widget shell = FRAME_X_SHELL_WIDGET (f); EmacsFrame w = (EmacsFrame) FRAME_X_TEXT_WIDGET (f); Widget gw = (Widget) w; + Position x, y; #define FROB(propprop, value) \ do { \ @@ -581,9 +592,19 @@ result = Fcons (temtem, Fcons (propprop, result)); \ } while (0) +#if 0 x_smash_bastardly_shell_position (shell); FROB (Qleft, make_int (shell->core.x)); FROB (Qtop, make_int (shell->core.y)); +#endif + if (!XtWindow(shell)) + x = y = 0; + else + x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y); + + FROB (Qleft, make_int (x)); + FROB (Qtop, make_int (y)); + FROB (Qborder_width, make_int (w->core.border_width)); FROB (Qinternal_border_width, make_int (w->emacs_frame.internal_border_width)); @@ -597,7 +618,7 @@ color_to_string (gw, w->emacs_frame.background_toolbar_pixel)); FROB (Qtoolbar_shadow_thickness, make_int (w->emacs_frame.toolbar_shadow_thickness)); -#endif +#endif /* HAVE_TOOLBARS */ FROB (Qinter_line_space, make_int (w->emacs_frame.interline)); FROB (Qwindow_id, Fx_window_id (make_frame (f))); @@ -618,7 +639,6 @@ Atom encoding = XA_STRING; String new_XtValue = (String) value; String old_XtValue = NULL; - Bufbyte *ptr; Arg av[2]; /* ### Caching is device-independent - belongs in update_frame_title. */ @@ -694,7 +714,7 @@ static void x_set_frame_properties (struct frame *f, Lisp_Object plist) { - int x = 0, y = 0; + Position x, y; Dimension width = 0, height = 0; Bool width_specified_p = False; Bool height_specified_p = False; @@ -781,14 +801,14 @@ if (!strcmp ((char *) XSTRING_DATA (str), "x")) { CHECK_INT (val); - x = XINT (val); + x = (Position) XINT (val); x_position_specified_p = True; continue; } if (!strcmp ((char *) XSTRING_DATA (str), "y")) { CHECK_INT (val); - y = XINT (val); + y = (Position) XINT (val); y_position_specified_p = True; continue; } @@ -837,7 +857,7 @@ { x_update_frame_scrollbars (f); } -#endif +#endif /* HAVE_SCROLLBARS */ } } @@ -854,16 +874,26 @@ height = FRAME_HEIGHT (f); /* Kludge kludge kludge kludge. */ - if (!x_position_specified_p) - x = (int) (FRAME_X_SHELL_WIDGET (f)->core.x); - if (!y_position_specified_p) - y = (int) (FRAME_X_SHELL_WIDGET (f)->core.y); + if (position_specified_p && + (!x_position_specified_p || !y_position_specified_p)) + { + Position dummy; + Widget shell = FRAME_X_SHELL_WIDGET (f); + x_get_top_level_position (XtDisplay (shell), XtWindow (shell), + (x_position_specified_p ? &dummy : &x), + (y_position_specified_p ? &dummy : &y)); +#if 0 + x = (int) (FRAME_X_SHELL_WIDGET (f)->core.x); + y = (int) (FRAME_X_SHELL_WIDGET (f)->core.y); +#endif + } if (!f->init_finished) { int flags = (size_specified_p ? WidthValue | HeightValue : 0) | - (position_specified_p ? XValue | YValue : 0) | - (x < 0 ? XNegative : 0) | (y < 0 ? YNegative : 0); + (position_specified_p ? + XValue | YValue | (x < 0 ? XNegative : 0) | (y < 0 ? YNegative : 0) + : 0); if (size_specified_p || position_specified_p || internal_border_width_specified) @@ -937,16 +967,131 @@ #include <Dt/Dt.h> #include <Dt/Dnd.h> +static Widget CurrentDragWidget = NULL; + +static void +x_cde_destroy_callback (Widget widget, XtPointer clientData, + XtPointer callData) +{ + xfree (clientData); + CurrentDragWidget = NULL; +} + +static void +x_cde_convert_callback (Widget widget, XtPointer clientData, + XtPointer callData) +{ + DtDndConvertCallbackStruct *convertInfo = + (DtDndConvertCallbackStruct *) callData; + char *textdata = (char *) clientData; + + if(convertInfo == NULL) + { + return; + } + + if((convertInfo->dragData->protocol != DtDND_BUFFER_TRANSFER) || + (convertInfo->reason != DtCR_DND_CONVERT_DATA)) + { + return; + } + + convertInfo->dragData->data.buffers[0].bp = XtNewString(textdata); + convertInfo->dragData->data.buffers[0].size = strlen(textdata); + convertInfo->dragData->data.buffers[0].name = NULL; + convertInfo->dragData->numItems = 1; + convertInfo->status = DtDND_SUCCESS; +} + + +static XtCallbackRec dnd_convert_cb_rec[2]; +static XtCallbackRec dnd_destroy_cb_rec[2]; +static int drag_not_done = 0; + +static Lisp_Object +abort_current_drag(Lisp_Object arg) +{ + if(CurrentDragWidget && drag_not_done) + { + XmDragCancel(CurrentDragWidget); + CurrentDragWidget = NULL; + } + return arg; +} + +DEFUN ("cde-start-drag-internal", Fcde_start_drag_internal, 1, 1, 0, /* +Start a CDE drag from a buffer. +*/ + (text)) +{ + if (STRINGP (text)) + { + struct frame *f = decode_x_frame (Fselected_frame (Qnil)); + XEvent event; + Widget Wuh = FRAME_X_TEXT_WIDGET (f); + char *Ctext; + Display *display = XtDisplayOfObject (Wuh); + Window root_window, child_window; + int root_x, root_y, win_x, win_y; + unsigned int keys_and_buttons; + + if (XQueryPointer (display, RootWindow (display, DefaultScreen (display)), + &root_window, &child_window, &root_x, &root_y, + &win_x, &win_y, &keys_and_buttons) == False) + return Qnil; + + Ctext = xstrdup ((char *) XSTRING_DATA (text)); + + /* + * Eek - XEmacs doesn't keep the old X event around so we have to + * build a dummy event. This is a truly gross hack. + */ + + event.xbutton.type = ButtonPress; + event.xbutton.send_event = False; + event.xbutton.display = XtDisplayOfObject(Wuh); + event.xbutton.window = XtWindowOfObject(Wuh); + event.xbutton.root = XRootWindow(event.xkey.display, 0); + event.xbutton.subwindow = 0; + event.xbutton.time = 0; + event.xbutton.x = win_x; + event.xbutton.y = win_y; + event.xbutton.x_root = root_x; + event.xbutton.y_root = root_y; + event.xbutton.state = 0; + event.xbutton.button = 1; + event.xkey.same_screen = True; + + dnd_convert_cb_rec[0].callback = x_cde_convert_callback; + dnd_convert_cb_rec[0].closure = (XtPointer) Ctext; + dnd_convert_cb_rec[1].callback = NULL; + dnd_convert_cb_rec[1].closure = NULL; + + dnd_destroy_cb_rec[0].callback = x_cde_destroy_callback; + dnd_destroy_cb_rec[0].closure = (XtPointer) Ctext; + dnd_destroy_cb_rec[1].callback = NULL; + dnd_destroy_cb_rec[1].closure = NULL; + + CurrentDragWidget = + DtDndDragStart (Wuh, &event, DtDND_BUFFER_TRANSFER, 1, XmDROP_COPY, + dnd_convert_cb_rec, + dnd_destroy_cb_rec, + NULL, 0); + return Qt; + } + return Qnil; +} + void x_cde_transfer_callback (Widget widget, XtPointer clientData, XtPointer callData) { char *filePath, *buf; int ii; - Lisp_Object data = Qnil; - Lisp_Object path = Qnil; + Lisp_Object path = Qnil; Lisp_Object frame = Qnil; - struct gcpro gcpro1, gcpro2; + Lisp_Object data = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3; DtDndTransferCallbackStruct *transferInfo = (DtDndTransferCallbackStruct *) callData; @@ -954,7 +1099,7 @@ if (transferInfo == NULL) return; - GCPRO2 (path, frame); + GCPRO3 (path, frame, data); frame = make_frame ((struct frame *) clientData); if (transferInfo->dropData->protocol == DtDND_FILENAME_TRANSFER) @@ -962,28 +1107,37 @@ for (ii = 0; ii < transferInfo->dropData->numItems; ii++) { filePath = transferInfo->dropData->data.files[ii]; + /* ### Mule-izing required */ path = make_string ((Bufbyte *)filePath, strlen (filePath)); va_run_hook_with_args (Qdrag_and_drop_functions, 2, frame, path); } } else if (transferInfo->dropData->protocol == DtDND_BUFFER_TRANSFER) { + int speccount = specpdl_depth(); + + record_unwind_protect(abort_current_drag, Qnil); + drag_not_done = 1; for (ii = 0; ii < transferInfo->dropData->numItems; ii++) { filePath = transferInfo->dropData->data.buffers[ii].name; - path = (filePath != NULL) ? - make_string ((Bufbyte *)filePath, strlen (filePath)) : Qnil; + /* ### Mule-izing required */ + path = (filePath == NULL) ? Qnil + : make_string ((Bufbyte *)filePath, strlen (filePath)); buf = transferInfo->dropData->data.buffers[ii].bp; data = make_string ((Bufbyte *)buf, transferInfo->dropData->data.buffers[ii].size); - va_run_hook_with_args(Qdrag_and_drop_functions, 3, frame, path, data); + va_run_hook_with_args(Qdrag_and_drop_functions, 3, frame, path, + data); } + drag_not_done = 0; + unbind_to(speccount, Qnil); } UNGCPRO; return; } -#endif +#endif /* HAVE_CDE */ #ifdef HAVE_OFFIX_DND #include <OffiX/DragAndDrop.h> @@ -1400,7 +1554,7 @@ scrollbar_placement == XtTOP_RIGHT); f->scrollbar_y_offset = topbreadth + textbord; } -#endif +#endif /* HAVE_SCROLLBARS */ /* finally the text area */ XtConfigureWidget (text, text_x, text_y, @@ -1423,8 +1577,8 @@ x_get_layout_sizes (f, &topbreadth); - /* strip away menubar from suggested size, and ask the text widget - what size it wants to be */ + /* Strip away menubar from suggested size, and ask the text widget + what size it wants to be. */ req.request_mode = mask; if (mask & CWWidth) req.width = emst->proposed_width - 2*textbord; @@ -1433,7 +1587,7 @@ XtQueryGeometry (text, &req, &repl); /* Now add the menubar back again */ - emst->proposed_width = repl.width + 2*textbord; + emst->proposed_width = repl.width + 2*textbord; emst->proposed_height = repl.height + topbreadth + 2*textbord; } @@ -1527,7 +1681,7 @@ XtSetArg (av[ac], XtNwindow, window_id); ac++; } else -#endif +#endif /* EXTERNAL_WIDGET */ { XtSetArg (av[ac], XtNinput, True); ac++; XtSetArg (av[ac], (String) XtNminWidthCells, 10); ac++; @@ -1581,7 +1735,7 @@ if (menubar_visible) XtManageChild (menubar); -#endif +#endif /* HAVE_MENUBARS */ XtManageChild (text); XtManageChild (container); } @@ -1626,7 +1780,7 @@ /* Does this have to be non-automatic? */ /* hack frame to respond to dnd messages */ static XtCallbackRec dnd_transfer_cb_rec[2]; -#endif +#endif /* HAVE_CDE */ /* create the windows for the specified frame and display them. Note that the widgets have already been created, and any @@ -1681,7 +1835,7 @@ True, /* called on non-maskable events? */ _XEditResCheckMessages, /* the handler */ NULL); -#endif +#endif /* HACK_EDITRES */ #ifdef HAVE_CDE { @@ -1697,7 +1851,7 @@ DtNpreserveRegistration, False, NULL); } -#endif +#endif /* HAVE_CDE */ #ifdef HAVE_OFFIX_DND { @@ -1846,6 +2000,8 @@ Widget parentwid = 0; Arg av[1]; + /* We may be passed a dangling deleted frame */ + /* I do not know how to test for this. -sb */ XtSetArg (av[0], XtNtransientFor, &parentwid); XtGetValues (FRAME_X_SHELL_WIDGET (f), av, 1); /* find the frame whose wid is parentwid */ @@ -1862,14 +2018,13 @@ return Qnil; } -DEFUN ("x-window-id", Fx_window_id, Sx_window_id, 0, 1, 0 /* +DEFUN ("x-window-id", Fx_window_id, 0, 1, 0, /* Get the ID of the X11 window. This gives us a chance to manipulate the Emacs window from within a different program. Since the ID is an unsigned long, we return it as a string. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { char str[255]; struct frame *f = decode_x_frame (frame); @@ -1888,14 +2043,14 @@ { Widget w = FRAME_X_SHELL_WIDGET (f); Display *dpy = XtDisplay (w); - Dimension frame_w = DisplayWidth (dpy, DefaultScreen (dpy)); + Dimension frame_w = DisplayWidth (dpy, DefaultScreen (dpy)); Dimension frame_h = DisplayHeight (dpy, DefaultScreen (dpy)); Dimension shell_w, shell_h, shell_bord; int win_gravity; XtVaGetValues (w, - XtNwidth, &shell_w, - XtNheight, &shell_h, + XtNwidth, &shell_w, + XtNheight, &shell_h, XtNborderWidth, &shell_bord, 0); @@ -1918,24 +2073,21 @@ XtNx, xoff, XtNy, yoff, 0); + /* Sometimes you will find that (set-frame-position (selected-frame) -50 -50) - doesn't put the frame where you expect it to: - i.e. it's closer to the lower-right corner than - it should be, and it appears that the size of - the WM decorations was not taken into account. - This is *not* a problem with this function. - Both mwm and twm have bugs in handling this - situation. (mwm ignores the window gravity - and always assumes NorthWest, except the first - time you map the window; twm gets things almost - right, but forgets to account for the border - width of the top-level window.) This function - does what it's supposed to according to the ICCCM, - and I'm not about to hack around window-manager - bugs. */ + doesn't put the frame where you expect it to: i.e. it's closer to + the lower-right corner than it should be, and it appears that the + size of the WM decorations was not taken into account. This is + *not* a problem with this function. Both mwm and twm have bugs + in handling this situation. (mwm ignores the window gravity and + always assumes NorthWest, except the first time you map the + window; twm gets things almost right, but forgets to account for + the border width of the top-level window.) This function does + what it's supposed to according to the ICCCM, and I'm not about + to hack around window-manager bugs. */ #if 0 /* This is not necessary under either mwm or twm */ @@ -2267,7 +2419,10 @@ defsymbol (&Qpopup, "popup"); defsymbol (&Qx_resource_name, "x-resource-name"); - defsubr (&Sx_window_id); + DEFSUBR (Fx_window_id); +#ifdef HAVE_CDE + DEFSUBR (Fcde_start_drag_internal); +#endif } void
--- a/src/frame.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/frame.c Mon Aug 13 08:50:05 2007 +0200 @@ -365,7 +365,7 @@ return foolist; } -DEFUN ("make-frame", Fmake_frame, Smake_frame, 0, 2, "" /* +DEFUN ("make-frame", Fmake_frame, 0, 2, "", /* Create a new frame, displaying the current buffer. Optional argument PROPS is a property list (a list of alternating @@ -375,9 +375,8 @@ See `set-frame-properties', `default-x-frame-plist', and `default-tty-frame-plist' for the specially-recognized properties. -*/ ) - (props, device) - Lisp_Object props, device; +*/ + (props, device)) { struct frame *f; struct device *d; @@ -610,23 +609,21 @@ -DEFUN ("framep", Fframep, Sframep, 1, 1, 0 /* +DEFUN ("framep", Fframep, 1, 1, 0, /* Return non-nil if OBJECT is a frame. Also see `frame-live-p'. Note that FSF Emacs kludgily returns a value indicating what type of frame this is. Use the cleaner function `frame-type' for that. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return FRAMEP (object) ? Qt : Qnil; } -DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0 /* +DEFUN ("frame-live-p", Fframe_live_p, 1, 1, 0, /* Return non-nil if OBJECT is a frame which has not been deleted. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return FRAMEP (object) && FRAME_LIVE_P (XFRAME (object)) ? Qt : Qnil; } @@ -649,7 +646,7 @@ update_frame_window_mirror (f); } -DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, 0 /* +DEFUN ("select-frame", Fselect_frame, 1, 1, 0, /* Select the frame FRAME. Subsequent editing commands apply to its selected window. The selection of FRAME lasts until the next time the user does @@ -659,9 +656,8 @@ Note that this does not actually cause the window-system focus to be set to this frame, or the select-frame-hook or deselect-frame-hook to be run, until the next time that XEmacs is waiting for an event. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { CHECK_LIVE_FRAME (frame); @@ -720,8 +716,7 @@ If EVENT is frame object, handle it as if it were a switch-frame event to that frame. */ ) - (frame, no_enter) - Lisp_Object frame, no_enter; + (Lisp_Object frame, Lisp_Object no_enter) { /* Preserve prefix arg that the command loop just cleared. */ XCONSOLE (Vselected_console)->prefix_arg = Vcurrent_prefix_arg; @@ -746,13 +741,12 @@ #endif -DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 1, 0 /* +DEFUN ("selected-frame", Fselected_frame, 0, 1, 0, /* Return the frame that is now selected on device DEVICE. If DEVICE is not specified, the selected device will be used. If no frames exist on the device, nil is returned. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { if (NILP (device) && NILP (Fselected_device (Qnil))) return Qnil; /* happens early in temacs */ @@ -777,24 +771,21 @@ return w; } -DEFUN ("active-minibuffer-window", Factive_minibuffer_window, - Sactive_minibuffer_window, 0, 0, 0 /* +DEFUN ("active-minibuffer-window", Factive_minibuffer_window, 0, 0, 0, /* Return the currently active minibuffer window, or nil if none. -*/ ) - () +*/ + ()) { return minibuf_level ? minibuf_window : Qnil; } -DEFUN ("last-nonminibuf-frame", Flast_nonminibuf_frame, - Slast_nonminibuf_frame, 0, 1, 0 /* +DEFUN ("last-nonminibuf-frame", Flast_nonminibuf_frame, 0, 1, 0, /* Return the most-recently-selected non-minibuffer-only frame on CONSOLE. This will always be the same as (selected-frame device) unless the selected frame is a minibuffer-only frame. CONSOLE defaults to the selected console if omitted. -*/ ) - (console) - Lisp_Object console; +*/ + (console)) { Lisp_Object result; @@ -808,23 +799,20 @@ return CONSOLE_LAST_NONMINIBUF_FRAME (XCONSOLE (console)); } -DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0 /* +DEFUN ("frame-root-window", Fframe_root_window, 0, 1, 0, /* Return the root-window of FRAME. If omitted, FRAME defaults to the currently selected frame. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return (FRAME_ROOT_WINDOW (decode_frame (frame))); } -DEFUN ("frame-selected-window", Fframe_selected_window, - Sframe_selected_window, 0, 1, 0 /* +DEFUN ("frame-selected-window", Fframe_selected_window, 0, 1, 0, /* Return the selected window of frame object FRAME. If omitted, FRAME defaults to the currently selected frame. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return (FRAME_SELECTED_WINDOW (decode_frame (frame))); } @@ -838,14 +826,12 @@ f->last_nonminibuf_window = window; } -DEFUN ("set-frame-selected-window", Fset_frame_selected_window, - Sset_frame_selected_window, 2, 2, 0 /* +DEFUN ("set-frame-selected-window", Fset_frame_selected_window, 2, 2, 0, /* Set the selected window of frame object FRAME to WINDOW. If FRAME is nil, the selected frame is used. If FRAME is the selected frame, this makes WINDOW the selected window. -*/ ) - (frame, window) - Lisp_Object frame, window; +*/ + (frame, window)) { XSETFRAME (frame, decode_frame (frame)); CHECK_LIVE_WINDOW (window); @@ -861,13 +847,11 @@ } -DEFUN ("frame-device", Fframe_device, Sframe_device, - 0, 1, 0 /* +DEFUN ("frame-device", Fframe_device, 0, 1, 0, /* Return the device that FRAME is on. If omitted, FRAME defaults to the currently selected frame. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return (FRAME_DEVICE (decode_frame (frame))); } @@ -1096,8 +1080,7 @@ return prev; } -DEFUN ("next-frame", Fnext_frame, Snext_frame, - 0, 3, 0 /* +DEFUN ("next-frame", Fnext_frame, 0, 3, 0, /* Return the next frame of the right type in the frame list after FRAME. FRAMETYPE controls which frames are eligible to be returned; all others will be skipped. Note that if there is only one eligible @@ -1136,17 +1119,15 @@ of that type. If CONSOLE is 'window-system, return any frames on any window-system consoles. If CONSOLE is nil or omitted, return frames only on the FRAME's console. Otherwise, all frames are considered. -*/ ) - (frame, frametype, console) - Lisp_Object frame, frametype, console; +*/ + (frame, frametype, console)) { XSETFRAME (frame, decode_frame (frame)); return (next_frame (frame, frametype, console)); } -DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, - 0, 3, 0 /* +DEFUN ("previous-frame", Fprevious_frame, 0, 3, 0, /* Return the next frame of the right type in the frame list after FRAME. FRAMETYPE controls which frames are eligible to be returned; all others will be skipped. Note that if there is only one eligible @@ -1156,9 +1137,8 @@ See `next-frame' for an explanation of the FRAMETYPE and CONSOLE arguments. -*/ ) - (frame, frametype, console) - Lisp_Object frame, frametype, console; +*/ + (frame, frametype, console)) { XSETFRAME (frame, decode_frame (frame)); @@ -1297,6 +1277,29 @@ } } } + /* Test for popup frames hanging around. */ + /* Deletion of a parent frame with popups is deadly. */ + { + Lisp_Object frmcons, devcons, concons; + + FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) + { + Lisp_Object this = XCAR (frmcons); + + + if (! EQ (this, frame) + && EQ (frame, DEVMETH_OR_GIVEN(XDEVICE(XCAR(devcons)), + get_frame_parent, + (XFRAME(this)), + Qnil))) + { + /* We've found another frame whose minibuffer is on + this frame. */ + signal_simple_error + ("Attempt to delete a frame with live popups", frame); + } + } + } /* Before here, we haven't made any dangerous changes (just checked for error conditions). Now run the delete-frame-hook. Remember that @@ -1318,7 +1321,7 @@ { va_run_hook_with_args (Qdelete_device_hook, 1, device); if (!FRAME_LIVE_P (f)) /* Make sure the delete-device-hook didn't */ - { /* go ahead and delete anything. */ + { /* go ahead and delete anything. */ UNGCPRO; return; } @@ -1374,6 +1377,7 @@ First try the same device, then the same console. */ next = DEVMETH_OR_GIVEN (d, get_frame_parent, (f), Qnil); + if (NILP (next) || EQ (next, frame) || ! FRAME_LIVE_P (XFRAME (next))) next = next_frame_internal (frame, Qvisible, device, called_from_delete_device); @@ -1545,8 +1549,7 @@ delete_frame_internal (XFRAME (frame), 1, 0, 1); } -DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, - 0, 2, "" /* +DEFUN ("delete-frame", Fdelete_frame, 0, 2, "", /* Delete FRAME, permanently eliminating it from use. If omitted, FRAME defaults to the selected frame. A frame may not be deleted if its minibuffer is used by other frames. @@ -1554,9 +1557,8 @@ use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional second argument FORCE is non-nil, you can delete the last frame. (This will automatically call `save-buffers-kill-emacs'.) -*/ ) - (frame, force) - Lisp_Object frame, force; +*/ + (frame, force)) { /* This function can GC */ struct frame *f; @@ -1579,7 +1581,7 @@ /* Return mouse position in character cell units. */ -DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 1, 0 /* +DEFUN ("mouse-position", Fmouse_position, 0, 1, 0, /* Return a list (WINDOW X . Y) giving the current mouse window and position. The position is given in character cells, where (0, 0) is the upper-left corner of the window. @@ -1588,9 +1590,8 @@ defaults to the selected device. If the device is a mouseless terminal or Emacs hasn't been programmed to read its mouse position, it returns the device's selected window for WINDOW and nil for X and Y. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { Lisp_Object val = Fmouse_pixel_position (device); int x, y, obj_x, obj_y; @@ -1651,8 +1652,7 @@ return 0; } -DEFUN ("mouse-pixel-position", Fmouse_pixel_position, - Smouse_pixel_position, 0, 1, 0 /* +DEFUN ("mouse-pixel-position", Fmouse_pixel_position, 0, 1, 0, /* Return a list (WINDOW X . Y) giving the current mouse window and position. The position is given in pixel units, where (0, 0) is the upper-left corner. @@ -1661,9 +1661,8 @@ defaults to the selected device. If the device is a mouseless terminal or Emacs hasn't been programmed to read its mouse position, it returns the device's selected window for WINDOW and nil for X and Y. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); Lisp_Object frame; @@ -1701,8 +1700,7 @@ return Fcons (window, Fcons (x, y)); } -DEFUN ("mouse-position-as-motion-event", Fmouse_position_as_motion_event, - Smouse_position_as_motion_event, 0, 1, 0 /* +DEFUN ("mouse-position-as-motion-event", Fmouse_position_as_motion_event, 0, 1, 0, /* Return the current mouse position as a motion event. This allows you to call the standard event functions such as `event-over-toolbar-p' to determine where the mouse is. @@ -1710,9 +1708,8 @@ DEVICE specifies the device on which to read the mouse position, and defaults to the selected device. If the mouse position can't be determined (e.g. DEVICE is a TTY device), nil is returned instead of an event. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); Lisp_Object frame; @@ -1731,7 +1728,7 @@ return Qnil; } -DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0 /* +DEFUN ("set-mouse-position", Fset_mouse_position, 3, 3, 0, /* Move the mouse pointer to the center of character cell (X,Y) in WINDOW. Note, this is a no-op for an X frame that is not visible. If you have just created a frame, you must wait for it to become visible @@ -1739,9 +1736,8 @@ (while (not (frame-visible-p frame)) (sleep-for .5)) Note also: Warping the mouse is contrary to the ICCCM, so be very sure that the behavior won't end up being obnoxious! -*/ ) - (window, x, y) - Lisp_Object window, x, y; +*/ + (window, x, y)) { struct window *w; int pix_x, pix_y; @@ -1759,16 +1755,14 @@ return Qnil; } -DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position, - Sset_mouse_pixel_position, 3, 3, 0 /* +DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position, 3, 3, 0, /* Move the mouse pointer to pixel position (X,Y) in WINDOW. Note, this is a no-op for an X frame that is not visible. If you have just created a frame, you must wait for it to become visible before calling this function on it, like this. (while (not (frame-visible-p frame)) (sleep-for .5)) -*/ ) - (window, x, y) - Lisp_Object window, x, y; +*/ + (window, x, y)) { struct window *w; @@ -1783,14 +1777,12 @@ return Qnil; } -DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible, - 0, 1, 0 /* +DEFUN ("make-frame-visible", Fmake_frame_visible, 0, 1, 0, /* Make the frame FRAME visible (assuming it is an X-window). If omitted, FRAME defaults to the currently selected frame. Also raises the frame so that nothing obscures it. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); @@ -1798,8 +1790,7 @@ return frame; } -DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible, - 0, 2, 0 /* +DEFUN ("make-frame-invisible", Fmake_frame_invisible, 0, 2, 0, /* Unconditionally removes frame from the display (assuming it is an X-window). If omitted, FRAME defaults to the currently selected frame. If what you want to do is iconify the frame (if the window manager uses @@ -1807,9 +1798,8 @@ Normally you may not make FRAME invisible if all other frames are invisible and uniconified, but if the second optional argument FORCE is non-nil, you may do so. -*/ ) - (frame, force) - Lisp_Object frame, force; +*/ + (frame, force)) { struct frame *f, *sel_frame; struct device *d; @@ -1834,13 +1824,11 @@ return Qnil; } -DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame, - 0, 1, "" /* +DEFUN ("iconify-frame", Ficonify_frame, 0, 1, "", /* Make the frame FRAME into an icon, if the window manager supports icons. If omitted, FRAME defaults to the currently selected frame. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f, *sel_frame; struct device *d; @@ -1862,58 +1850,50 @@ return Qnil; } -DEFUN ("deiconify-frame", Fdeiconify_frame, Sdeiconify_frame, - 0, 1, 0 /* +DEFUN ("deiconify-frame", Fdeiconify_frame, 0, 1, 0, /* Open (de-iconify) the iconified frame FRAME. Under X, this is currently the same as `make-frame-visible'. If omitted, FRAME defaults to the currently selected frame. Also raises the frame so that nothing obscures it. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return Fmake_frame_visible (frame); } /* FSF returns 'icon for iconized frames. What a crock! */ -DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p, - 1, 1, 0 /* +DEFUN ("frame-visible-p", Fframe_visible_p, 0, 1, 0, /* Return t if FRAME is now \"visible\" (actually in use for display). A frame that is not visible is not updated, and, if it works through a window system, may not show at all. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); return (FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible) ? Qt : Qnil); } -DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, - Sframe_totally_visible_p, 0, 1, 0 /* +DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, 0, 1, 0, /* Return T if frame is not obscured by any other X windows, NIL otherwise. Always returns t for tty frames. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); return (FRAMEMETH_OR_GIVEN (f, frame_totally_visible_p, (f), f->visible) ? Qt : Qnil); } -DEFUN ("frame-iconified-p", Fframe_iconified_p, Sframe_iconified_p, - 1, 1, 0 /* +DEFUN ("frame-iconified-p", Fframe_iconified_p, 0, 1, 0, /* Return t if FRAME is iconified. Not all window managers use icons; some merely unmap the window, so this function is not the inverse of `frame-visible-p'. It is possible for a frame to not be visible and not be iconified either. However, if the frame is iconified, it will not be visible. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); if (f->visible) @@ -1922,13 +1902,11 @@ return (f->iconified ? Qt : Qnil); } -DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list, - 0, 1, 0 /* +DEFUN ("visible-frame-list", Fvisible_frame_list, 0, 1, 0, /* Return a list of all frames now \"visible\" (being updated). If DEVICE is specified only frames on that device will be returned. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { Lisp_Object devcons, concons; struct frame *f; @@ -1958,15 +1936,14 @@ } -DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "" /* +DEFUN ("raise-frame", Fraise_frame, 0, 1, "", /* Bring FRAME to the front, so it occludes any frames it overlaps. If omitted, FRAME defaults to the currently selected frame. If FRAME is invisible, make it visible. If Emacs is displaying on an ordinary terminal or some other device which doesn't support multiple overlapping frames, this function does nothing. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); @@ -1976,14 +1953,13 @@ return Qnil; } -DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "" /* +DEFUN ("lower-frame", Flower_frame, 0, 1, "", /* Send FRAME to the back, so it is occluded by any frames that overlap it. If omitted, FRAME defaults to the currently selected frame. If Emacs is displaying on an ordinary terminal or some other device which doesn't support multiple overlapping frames, this function does nothing. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); @@ -2117,8 +2093,7 @@ But of course. This stuff needs more work, but it's a lot closer to sanity now than before with the horrible frame-params stuff. */ -DEFUN ("set-frame-properties", Fset_frame_properties, Sset_frame_properties, - 2, 2, 0 /* +DEFUN ("set-frame-properties", Fset_frame_properties, 2, 2, 0, /* Change some properties of a frame. PLIST is a property list. You can also change frame properties individually using `set-frame-property', @@ -2183,9 +2158,8 @@ See the variables `default-x-frame-plist' and `default-tty-frame-plist' for a description of the properties recognized for particular types of frames. -*/ ) - (frame, plist) - Lisp_Object frame, plist; +*/ + (frame, plist)) { struct frame *f = decode_frame (frame); Lisp_Object tail; @@ -2270,12 +2244,11 @@ return Qnil; } -DEFUN ("frame-property", Fframe_property, Sframe_property, 2, 3, 0 /* +DEFUN ("frame-property", Fframe_property, 2, 3, 0, /* Return FRAME's value for property PROPERTY. See `set-frame-properties' for the built-in property names. -*/ ) - (frame, property, defalt) - Lisp_Object frame, property, defalt; +*/ + (frame, property, defalt)) { struct frame *f = decode_frame (frame); @@ -2337,12 +2310,11 @@ } } -DEFUN ("frame-properties", Fframe_properties, Sframe_properties, 1, 1, 0 /* +DEFUN ("frame-properties", Fframe_properties, 0, 1, 0, /* Return a property list of the properties of FRAME. Do not modify this list; use `set-frame-property' instead. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); Lisp_Object result = Qnil; @@ -2391,38 +2363,34 @@ } -DEFUN ("frame-pixel-height", Fframe_pixel_height, Sframe_pixel_height, 0, 1, 0 /* +DEFUN ("frame-pixel-height", Fframe_pixel_height, 0, 1, 0, /* Return the height in pixels of FRAME. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); return (make_int (f->pixheight)); } -DEFUN ("frame-pixel-width", Fframe_pixel_width, Sframe_pixel_width, 0, 1, 0 /* +DEFUN ("frame-pixel-width", Fframe_pixel_width, 0, 1, 0, /* Return the width in pixels of FRAME. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { struct frame *f = decode_frame (frame); return (make_int (f->pixwidth)); } -DEFUN ("frame-name", Fframe_name, Sframe_name, 0, 1, 0 /* +DEFUN ("frame-name", Fframe_name, 0, 1, 0, /* Return the name of FRAME (defaulting to the selected frame). This is not the same as the `title' of the frame. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return (decode_frame (frame)->name); } -DEFUN ("frame-modified-tick", Fframe_modified_tick, Sframe_modified_tick, - 0, 1, 0 /* +DEFUN ("frame-modified-tick", Fframe_modified_tick, 0, 1, 0, /* Return FRAME's tick counter, incremented for each change to the frame. Each frame has a tick counter which is incremented each time the frame is resized, a window is resized, added, or deleted, a face is changed, @@ -2430,9 +2398,8 @@ frame, the window-start of a window in the frame has changed, or anything else interesting has happened. It wraps around occasionally. No argument or nil as argument means use selected frame as FRAME. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { return make_int (decode_frame (frame)->modiff); } @@ -2446,13 +2413,12 @@ FRAMEMETH (f, set_frame_size, (f, cols, rows)); } -DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0 /* +DEFUN ("set-frame-height", Fset_frame_height, 2, 3, 0, /* Specify that the frame FRAME has LINES lines. Optional third arg non-nil means that redisplay should use LINES lines but that the idea of the actual height of the frame should not be changed. -*/ ) - (frame, rows, pretend) - Lisp_Object frame, rows, pretend; +*/ + (frame, rows, pretend)) { struct frame *f = decode_frame (frame); XSETFRAME (frame, f); @@ -2463,13 +2429,12 @@ return frame; } -DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0 /* +DEFUN ("set-frame-width", Fset_frame_width, 2, 3, 0, /* Specify that the frame FRAME has COLS columns. Optional third arg non-nil means that redisplay should use COLS columns but that the idea of the actual width of the frame should not be changed. -*/ ) - (frame, cols, pretend) - Lisp_Object frame, cols, pretend; +*/ + (frame, cols, pretend)) { struct frame *f = decode_frame (frame); XSETFRAME (frame, f); @@ -2480,14 +2445,12 @@ return frame; } -DEFUN ("set-frame-size", Fset_frame_size, - Sset_frame_size, 3, 4, 0 /* +DEFUN ("set-frame-size", Fset_frame_size, 3, 4, 0, /* Sets size of FRAME to COLS by ROWS. Optional fourth arg non-nil means that redisplay should use COLS by ROWS but that the idea of the actual size of the frame should not be changed. -*/ ) - (frame, cols, rows, pretend) - Lisp_Object frame, cols, rows, pretend; +*/ + (frame, cols, rows, pretend)) { struct frame *f = decode_frame (frame); XSETFRAME (frame, f); @@ -2498,15 +2461,13 @@ return frame; } -DEFUN ("set-frame-position", Fset_frame_position, - Sset_frame_position, 3, 3, 0 /* +DEFUN ("set-frame-position", Fset_frame_position, 3, 3, 0, /* Sets position of FRAME in pixels to XOFFSET by YOFFSET. This is actually the position of the upper left corner of the frame. Negative values for XOFFSET or YOFFSET are interpreted relative to the rightmost or bottommost possible position (that stays within the screen). -*/ ) - (frame, xoffset, yoffset) - Lisp_Object frame, xoffset, yoffset; +*/ + (frame, xoffset, yoffset)) { struct frame *f = decode_frame (frame); CHECK_INT (xoffset); @@ -2795,16 +2756,14 @@ } -DEFUN ("set-frame-pointer", Fset_frame_pointer, Sset_frame_pointer, - 2, 2, 0 /* +DEFUN ("set-frame-pointer", Fset_frame_pointer, 2, 2, 0, /* Set the mouse pointer of FRAME to the given pointer image instance. You should not call this function directly. Instead, set one of the variables `text-pointer-glyph', `nontext-pointer-glyph', `modeline-pointer-glyph', `selection-pointer-glyph', `busy-pointer-glyph', or `toolbar-pointer-glyph'. -*/ ) - (frame, image_instance) - Lisp_Object frame, image_instance; +*/ + (frame, image_instance)) { struct frame *f = decode_frame (frame); CHECK_POINTER_IMAGE_INSTANCE (image_instance); @@ -2917,50 +2876,50 @@ defsymbol (&Qface_property_instance, "face-property-instance"); defsymbol (&Qframe_property_alias, "frame-property-alias"); - defsubr (&Smake_frame); - defsubr (&Sframep); - defsubr (&Sframe_live_p); + DEFSUBR (Fmake_frame); + DEFSUBR (Fframep); + DEFSUBR (Fframe_live_p); #if 0 /* FSFmacs */ - defsubr (&Signore_event); + DEFSUBR (Fignore_event); #endif - defsubr (&Sselect_frame); - defsubr (&Sselected_frame); - defsubr (&Sactive_minibuffer_window); - defsubr (&Slast_nonminibuf_frame); - defsubr (&Sframe_root_window); - defsubr (&Sframe_selected_window); - defsubr (&Sset_frame_selected_window); - defsubr (&Sframe_device); - defsubr (&Snext_frame); - defsubr (&Sprevious_frame); - defsubr (&Sdelete_frame); - defsubr (&Smouse_position); - defsubr (&Smouse_pixel_position); - defsubr (&Smouse_position_as_motion_event); - defsubr (&Sset_mouse_position); - defsubr (&Sset_mouse_pixel_position); - defsubr (&Smake_frame_visible); - defsubr (&Smake_frame_invisible); - defsubr (&Siconify_frame); - defsubr (&Sdeiconify_frame); - defsubr (&Sframe_visible_p); - defsubr (&Sframe_totally_visible_p); - defsubr (&Sframe_iconified_p); - defsubr (&Svisible_frame_list); - defsubr (&Sraise_frame); - defsubr (&Slower_frame); - defsubr (&Sframe_property); - defsubr (&Sframe_properties); - defsubr (&Sset_frame_properties); - defsubr (&Sframe_pixel_height); - defsubr (&Sframe_pixel_width); - defsubr (&Sframe_name); - defsubr (&Sframe_modified_tick); - defsubr (&Sset_frame_height); - defsubr (&Sset_frame_width); - defsubr (&Sset_frame_size); - defsubr (&Sset_frame_position); - defsubr (&Sset_frame_pointer); + DEFSUBR (Fselect_frame); + DEFSUBR (Fselected_frame); + DEFSUBR (Factive_minibuffer_window); + DEFSUBR (Flast_nonminibuf_frame); + DEFSUBR (Fframe_root_window); + DEFSUBR (Fframe_selected_window); + DEFSUBR (Fset_frame_selected_window); + DEFSUBR (Fframe_device); + DEFSUBR (Fnext_frame); + DEFSUBR (Fprevious_frame); + DEFSUBR (Fdelete_frame); + DEFSUBR (Fmouse_position); + DEFSUBR (Fmouse_pixel_position); + DEFSUBR (Fmouse_position_as_motion_event); + DEFSUBR (Fset_mouse_position); + DEFSUBR (Fset_mouse_pixel_position); + DEFSUBR (Fmake_frame_visible); + DEFSUBR (Fmake_frame_invisible); + DEFSUBR (Ficonify_frame); + DEFSUBR (Fdeiconify_frame); + DEFSUBR (Fframe_visible_p); + DEFSUBR (Fframe_totally_visible_p); + DEFSUBR (Fframe_iconified_p); + DEFSUBR (Fvisible_frame_list); + DEFSUBR (Fraise_frame); + DEFSUBR (Flower_frame); + DEFSUBR (Fframe_property); + DEFSUBR (Fframe_properties); + DEFSUBR (Fset_frame_properties); + DEFSUBR (Fframe_pixel_height); + DEFSUBR (Fframe_pixel_width); + DEFSUBR (Fframe_name); + DEFSUBR (Fframe_modified_tick); + DEFSUBR (Fset_frame_height); + DEFSUBR (Fset_frame_width); + DEFSUBR (Fset_frame_size); + DEFSUBR (Fset_frame_position); + DEFSUBR (Fset_frame_pointer); } void @@ -2970,6 +2929,10 @@ Vframe_being_created = Qnil; staticpro (&Vframe_being_created); +#ifdef HAVE_CDE + Vfeatures = Fcons (intern ("cde"), Vfeatures); +#endif + #if 0 /* FSFmacs stupidity */ xxDEFVAR_LISP ("emacs-iconified", &Vemacs_iconified /* Non-nil if all of emacs is iconified and frame updates are not needed.
--- a/src/free-hook.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/free-hook.c Mon Aug 13 08:50:05 2007 +0200 @@ -431,12 +431,11 @@ void really_free_one_entry (void *, int, int *); -DEFUN ("really-free", Freally_free, Sreally_free, 0, 1, "P" /* +DEFUN ("really-free", Freally_free, 0, 1, "P", /* Actually free the storage held by the free() debug hook. A no-op if the free hook is disabled. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { int count[2]; Lisp_Object lisp_count[2]; @@ -477,7 +476,7 @@ void syms_of_free_hook (void) { - defsubr (&Sreally_free); + DEFSUBR (Freally_free); } #else
--- a/src/glyphs-x.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 08:50:05 2007 +0200 @@ -3516,8 +3516,7 @@ /* #### These are completely un-re-implemented in 19.14. Get it done for 19.15. */ -DEFUN ("make-subwindow", Fmake_subwindow, Smake_subwindow, - 0, 3, 0 /* +DEFUN ("make-subwindow", Fmake_subwindow, 0, 3, 0, /* Creates a new `subwindow' object of size WIDTH x HEIGHT. The default is a window of size 1x1, which is also the minimum allowed window size. Subwindows are per-frame. A buffer being shown in two @@ -3528,9 +3527,8 @@ is used. Subwindows are not currently implemented. -*/ ) - (width, height, frame) - Lisp_Object width, height, frame; +*/ + (width, height, frame)) { Display *dpy; Screen *xs; @@ -3591,13 +3589,11 @@ } /* #### Should this function exist? */ -DEFUN ("change-subwindow-property", Fchange_subwindow_property, - Schange_subwindow_property, 3, 3, 0 /* +DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /* For the given SUBWINDOW, set PROPERTY to DATA, which is a string. Subwindows are not currently implemented. -*/ ) - (subwindow, property, data) - Lisp_Object subwindow, property, data; +*/ + (subwindow, property, data)) { Atom property_atom; struct Lisp_Subwindow *sw; @@ -3620,59 +3616,51 @@ return (property); } -DEFUN ("subwindowp", Fsubwindowp, Ssubwindowp, 1, 1, 0 /* +DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* Return non-nil if OBJECT is a subwindow. Subwindows are not currently implemented. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (SUBWINDOWP (object) ? Qt : Qnil); } -DEFUN ("subwindow-width", Fsubwindow_width, Ssubwindow_width, - 1, 1, 0 /* +DEFUN ("subwindow-width", Fsubwindow_width, 1, 1, 0, /* Width of SUBWINDOW. Subwindows are not currently implemented. -*/ ) - (subwindow) - Lisp_Object subwindow; +*/ + (subwindow)) { CHECK_SUBWINDOW (subwindow); return (make_int (XSUBWINDOW (subwindow)->width)); } -DEFUN ("subwindow-height", Fsubwindow_height, Ssubwindow_height, - 1, 1, 0 /* +DEFUN ("subwindow-height", Fsubwindow_height, 1, 1, 0, /* Height of SUBWINDOW. Subwindows are not currently implemented. -*/ ) - (subwindow) - Lisp_Object subwindow; +*/ + (subwindow)) { CHECK_SUBWINDOW (subwindow); return (make_int (XSUBWINDOW (subwindow)->height)); } -DEFUN ("subwindow-xid", Fsubwindow_xid, Ssubwindow_xid, 1, 1, 0 /* +DEFUN ("subwindow-xid", Fsubwindow_xid, 1, 1, 0, /* Return the xid of SUBWINDOW as a number. Subwindows are not currently implemented. -*/ ) - (subwindow) - Lisp_Object subwindow; +*/ + (subwindow)) { CHECK_SUBWINDOW (subwindow); return (make_int (XSUBWINDOW (subwindow)->subwindow)); } -DEFUN ("resize-subwindow", Fresize_subwindow, Sresize_subwindow, - 1, 3, 0 /* +DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* Resize SUBWINDOW to WIDTH x HEIGHT. If a value is nil that parameter is not changed. Subwindows are not currently implemented. -*/ ) - (subwindow, width, height) - Lisp_Object subwindow, width, height; +*/ + (subwindow, width, height)) { int neww, newh; struct Lisp_Subwindow *sw; @@ -3698,13 +3686,11 @@ return subwindow; } -DEFUN ("force-subwindow-map", Fforce_subwindow_map, - Sforce_subwindow_map, 1, 1, 0 /* +DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* Generate a Map event for SUBWINDOW. Subwindows are not currently implemented. -*/ ) - (subwindow) - Lisp_Object subwindow; +*/ + (subwindow)) { CHECK_SUBWINDOW (subwindow); @@ -3724,14 +3710,14 @@ { defsymbol (&Qsubwindowp, "subwindowp"); - defsubr (&Smake_subwindow); - defsubr (&Schange_subwindow_property); - defsubr (&Ssubwindowp); - defsubr (&Ssubwindow_width); - defsubr (&Ssubwindow_height); - defsubr (&Ssubwindow_xid); - defsubr (&Sresize_subwindow); - defsubr (&Sforce_subwindow_map); + DEFSUBR (Fmake_subwindow); + DEFSUBR (Fchange_subwindow_property); + DEFSUBR (Fsubwindowp); + DEFSUBR (Fsubwindow_width); + DEFSUBR (Fsubwindow_height); + DEFSUBR (Fsubwindow_xid); + DEFSUBR (Fresize_subwindow); + DEFSUBR (Fforce_subwindow_map); defkeyword (&Q_mask_file, ":mask-file"); defkeyword (&Q_mask_data, ":mask-data");
--- a/src/glyphs.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/glyphs.c Mon Aug 13 08:50:05 2007 +0200 @@ -140,15 +140,14 @@ return 0; } -DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p, - Svalid_image_instantiator_format_p, 1, 1, 0 /* +DEFUN ("valid-image-instantiator-format-p", + Fvalid_image_instantiator_format_p, 1, 1, 0, /* Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. Valid formats are some subset of 'nothing, 'string, 'formatted-string, 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, 'autodetect, and 'subwindow, depending on how XEmacs was compiled. -*/ ) - (image_instantiator_format) - Lisp_Object image_instantiator_format; +*/ + (image_instantiator_format)) { if (valid_image_instantiator_format_p (image_instantiator_format)) return Qt; @@ -156,12 +155,11 @@ return Qnil; } -DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list, - Simage_instantiator_format_list, - 0, 0, 0 /* +DEFUN ("image-instantiator-format-list", + Fimage_instantiator_format_list, 0, 0, 0, /* Return a list of valid image-instantiator formats. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vimage_instantiator_format_list); } @@ -187,8 +185,7 @@ } DEFUN ("set-console-type-image-conversion-list", - Fset_console_type_image_conversion_list, - Sset_console_type_image_conversion_list, 2, 2, 0 /* + Fset_console_type_image_conversion_list, 2, 2, 0, /* Set the image-conversion-list for consoles of the given TYPE. The image-conversion-list specifies how image instantiators that are strings should be interpreted. Each element of the list should be @@ -203,9 +200,8 @@ instantiated. Therefore, changing the image-conversion-list only affects newly-added instantiators. Existing instantiators in glyphs and image specifiers will not be affected. -*/ ) - (console_type, list) - Lisp_Object console_type, list; +*/ + (console_type, list)) { Lisp_Object tail; Lisp_Object *imlist = get_image_conversion_list (console_type); @@ -258,15 +254,13 @@ } DEFUN ("console-type-image-conversion-list", - Fconsole_type_image_conversion_list, - Sconsole_type_image_conversion_list, 1, 1, 0 /* + Fconsole_type_image_conversion_list, 1, 1, 0, /* Return the image-conversion-list for devices of the given TYPE. The image-conversion-list specifies how to interpret image string instantiators for the specified console type. See `set-console-type-image-conversion-list' for a description of its syntax. -*/ ) - (console_type) - Lisp_Object console_type; +*/ + (console_type)) { return Fcopy_tree (*get_image_conversion_list (console_type), Qt); } @@ -920,14 +914,12 @@ return 0; } -DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, - Svalid_image_instance_type_p, 1, 1, 0 /* +DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /* Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid. Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap, 'pointer, and 'subwindow, depending on how XEmacs was compiled. -*/ ) - (image_instance_type) - Lisp_Object image_instance_type; +*/ + (image_instance_type)) { if (valid_image_instance_type_p (image_instance_type)) return Qt; @@ -935,12 +927,10 @@ return Qnil; } -DEFUN ("image-instance-type-list", Fimage_instance_type_list, - Simage_instance_type_list, - 0, 0, 0 /* +DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /* Return a list of valid image-instance types. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vimage_instance_type_list); } @@ -995,8 +985,7 @@ RETURN_UNGCPRO (ii); } -DEFUN ("make-image-instance", Fmake_image_instance, Smake_image_instance, - 1, 4, 0 /* +DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /* Create a new `image-instance' object. Image-instance objects encapsulate the way a particular image (pixmap, @@ -1054,9 +1043,8 @@ If nil, an error message is generated. If t, no messages are generated and this function returns nil. If anything else, a warning message is generated and this function returns nil. -*/ ) - (data, device, dest_types, no_error) - Lisp_Object data, device, dest_types, no_error; +*/ + (data, device, dest_types, no_error)) { Error_behavior errb = decode_error_behavior_flag (no_error); @@ -1065,46 +1053,39 @@ 3, data, device, dest_types); } -DEFUN ("image-instance-p", Fimage_instance_p, Simage_instance_p, 1, 1, 0 /* +DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /* Return non-nil if OBJECT is an image instance. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (IMAGE_INSTANCEP (object) ? Qt : Qnil); } -DEFUN ("image-instance-type", Fimage_instance_type, Simage_instance_type, - 1, 1, 0 /* +DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /* Return the type of the given image instance. The return value will be one of 'nothing, 'text, 'mono-pixmap, 'color-pixmap, 'pointer, or 'subwindow. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance)); } -DEFUN ("image-instance-name", Fimage_instance_name, - Simage_instance_name, 1, 1, 0 /* +DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /* Return the name of the given image instance. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); return (XIMAGE_INSTANCE_NAME (image_instance)); } -DEFUN ("image-instance-string", Fimage_instance_string, - Simage_instance_string, 1, 1, 0 /* +DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* Return the string of the given image instance. This will only be non-nil for text image instances. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) @@ -1113,12 +1094,10 @@ return Qnil; } -DEFUN ("image-instance-file-name", Fimage_instance_file_name, - Simage_instance_file_name, 1, 1, 0 /* +DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* Return the file name from which IMAGE-INSTANCE was read, if known. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1134,12 +1113,10 @@ } } -DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, - Simage_instance_mask_file_name, 1, 1, 0 /* +DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /* Return the file name from which IMAGE-INSTANCE's mask was read, if known. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1155,13 +1132,11 @@ } } -DEFUN ("image-instance-depth", Fimage_instance_depth, - Simage_instance_depth, 1, 1, 0 /* +DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /* Return the depth of the image instance. This is 0 for a bitmap, or a positive integer for a pixmap. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1177,12 +1152,10 @@ } } -DEFUN ("image-instance-height", Fimage_instance_height, - Simage_instance_height, 1, 1, 0 /* +DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /* Return the height of the image instance, in pixels. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1198,12 +1171,10 @@ } } -DEFUN ("image-instance-width", Fimage_instance_width, - Simage_instance_width, 1, 1, 0 /* +DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /* Return the width of the image instance, in pixels. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1219,17 +1190,15 @@ } } -DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, - Simage_instance_hotspot_x, 1, 1, 0 /* +DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /* Return the X coordinate of the image instance's hotspot, if known. This is a point relative to the origin of the pixmap. When an image is used as a mouse pointer, the hotspot is the point on the image that sits over the location that the pointer points to. This is, for example, the tip of the arrow or the center of the crosshairs. This will always be nil for a non-pointer image instance. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1245,17 +1214,15 @@ } } -DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, - Simage_instance_hotspot_y, 1, 1, 0 /* +DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /* Return the Y coordinate of the image instance's hotspot, if known. This is a point relative to the origin of the pixmap. When an image is used as a mouse pointer, the hotspot is the point on the image that sits over the location that the pointer points to. This is, for example, the tip of the arrow or the center of the crosshairs. This will always be nil for a non-pointer image instance. -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1271,14 +1238,12 @@ } } -DEFUN ("image-instance-foreground", Fimage_instance_foreground, - Simage_instance_foreground, 1, 1, 0 /* +DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /* Return the foreground color of IMAGE-INSTANCE, if applicable. This will be a color instance or nil. (It will only be non-nil for colorized mono pixmaps and for pointers.) -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1294,14 +1259,12 @@ } } -DEFUN ("image-instance-background", Fimage_instance_background, - Simage_instance_background, 1, 1, 0 /* +DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /* Return the background color of IMAGE-INSTANCE, if applicable. This will be a color instance or nil. (It will only be non-nil for colorized mono pixmaps and for pointers.) -*/ ) - (image_instance) - Lisp_Object image_instance; +*/ + (image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); @@ -1318,16 +1281,14 @@ } -DEFUN ("colorize-image-instance", Fcolorize_image_instance, - Scolorize_image_instance, 3, 3, 0 /* +DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /* Make the image instance be displayed in the given colors. This function returns a new image instance that is exactly like the specified one except that (if possible) the foreground and background colors and as specified. Currently, this only does anything if the image instance is a mono pixmap; otherwise, the same image instance is returned. -*/ ) - (image_instance, foreground, background) - Lisp_Object image_instance, foreground, background; +*/ + (image_instance, foreground, background)) { Lisp_Object new; Lisp_Object device; @@ -1790,7 +1751,7 @@ return retlist; } -DEFUN ("image-specifier-p", Fimage_specifier_p, Simage_specifier_p, 1, 1, 0 /* +DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is an image specifier. An image specifier is used for images (pixmaps and the like). It is used @@ -1950,9 +1911,8 @@ file must exist when the instantiator is added to the image, but does not need to exist at any other time (e.g. it may safely be a temporary file). -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (IMAGE_SPECIFIERP (object) ? Qt : Qnil); } @@ -2216,13 +2176,11 @@ return 0; } -DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, - Svalid_glyph_type_p, 1, 1, 0 /* +DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /* Given a GLYPH-TYPE, return non-nil if it is valid. Valid types are `buffer', `pointer', and `icon'. -*/ ) - (glyph_type) - Lisp_Object glyph_type; +*/ + (glyph_type)) { if (valid_glyph_type_p (glyph_type)) return Qt; @@ -2230,18 +2188,15 @@ return Qnil; } -DEFUN ("glyph-type-list", Fglyph_type_list, - Sglyph_type_list, - 0, 0, 0 /* +DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /* Return a list of valid glyph types. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vglyph_type_list); } -DEFUN ("make-glyph-internal", Fmake_glyph_internal, Smake_glyph_internal, - 0, 1, 0 /* +DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* Create a new, uninitialized glyph. TYPE specifies the type of the glyph; this should be one of `buffer', @@ -2261,15 +2216,14 @@ `icon' glyphs can be used to specify the icon used when a frame is iconified. Their image can be instantiated as `mono-pixmap' and `color-pixmap'. -*/ ) - (type) - Lisp_Object type; +*/ + (type)) { enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); return allocate_glyph (typeval, 0); } -DEFUN ("glyphp", Fglyphp, Sglyphp, 1, 1, 0 /* +DEFUN ("glyphp", Fglyphp, 1, 1, 0, /* Return non-nil if OBJECT is a glyph. A glyph is an object used for pixmaps and the like. It is used @@ -2277,20 +2231,17 @@ annotations, in overlay arrows (overlay-arrow-* variables), in toolbar buttons, and the like. Its image is described using an image specifier -- see `image-specifier-p'. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return GLYPHP (object) ? Qt : Qnil; } -DEFUN ("glyph-type", Fglyph_type, Sglyph_type, - 1, 1, 0 /* +DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /* Return the type of the given glyph. The return value will be one of 'buffer, 'pointer, or 'icon. -*/ ) - (glyph) - Lisp_Object glyph; +*/ + (glyph)) { CHECK_GLYPH (glyph); switch (XGLYPH_TYPE (glyph)) @@ -2372,13 +2323,12 @@ } } -DEFUN ("glyph-width", Fglyph_width, Sglyph_width, 1, 2, 0 /* +DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /* Return the width of GLYPH on WINDOW. This may not be exact as it does not take into account all of the context that redisplay will. -*/ ) - (glyph, window) - Lisp_Object glyph, window; +*/ + (glyph, window)) { XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); @@ -2502,13 +2452,12 @@ RETURN_HEIGHT); } -DEFUN ("glyph-ascent", Fglyph_ascent, Sglyph_ascent, 1, 2, 0 /* +DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /* Return the ascent value of GLYPH on WINDOW. This may not be exact as it does not take into account all of the context that redisplay will. -*/ ) - (glyph, window) - Lisp_Object glyph, window; +*/ + (glyph, window)) { XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); @@ -2516,13 +2465,12 @@ return (make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window))); } -DEFUN ("glyph-descent", Fglyph_descent, Sglyph_descent, 1, 2, 0 /* +DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* Return the descent value of GLYPH on WINDOW. This may not be exact as it does not take into account all of the context that redisplay will. -*/ ) - (glyph, window) - Lisp_Object glyph, window; +*/ + (glyph, window)) { XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); @@ -2531,13 +2479,12 @@ } /* This is redundant but I bet a lot of people expect it to exist. */ -DEFUN ("glyph-height", Fglyph_height, Sglyph_height, 1, 2, 0 /* +DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /* Return the height of GLYPH on WINDOW. This may not be exact as it does not take into account all of the context that redisplay will. -*/ ) - (glyph, window) - Lisp_Object glyph, window; +*/ + (glyph, window)) { XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); @@ -2795,10 +2742,10 @@ { /* image instantiators */ - defsubr (&Simage_instantiator_format_list); - defsubr (&Svalid_image_instantiator_format_p); - defsubr (&Sset_console_type_image_conversion_list); - defsubr (&Sconsole_type_image_conversion_list); + DEFSUBR (Fimage_instantiator_format_list); + DEFSUBR (Fvalid_image_instantiator_format_p); + DEFSUBR (Fset_console_type_image_conversion_list); + DEFSUBR (Fconsole_type_image_conversion_list); defkeyword (&Q_file, ":file"); defkeyword (&Q_data, ":data"); @@ -2806,7 +2753,7 @@ /* image specifiers */ - defsubr (&Simage_specifier_p); + DEFSUBR (Fimage_specifier_p); /* Qimage in general.c */ /* image instances */ @@ -2820,23 +2767,23 @@ defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p"); defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p"); - defsubr (&Smake_image_instance); - defsubr (&Simage_instance_p); - defsubr (&Simage_instance_type); - defsubr (&Svalid_image_instance_type_p); - defsubr (&Simage_instance_type_list); - defsubr (&Simage_instance_name); - defsubr (&Simage_instance_string); - defsubr (&Simage_instance_file_name); - defsubr (&Simage_instance_mask_file_name); - defsubr (&Simage_instance_depth); - defsubr (&Simage_instance_height); - defsubr (&Simage_instance_width); - defsubr (&Simage_instance_hotspot_x); - defsubr (&Simage_instance_hotspot_y); - defsubr (&Simage_instance_foreground); - defsubr (&Simage_instance_background); - defsubr (&Scolorize_image_instance); + DEFSUBR (Fmake_image_instance); + DEFSUBR (Fimage_instance_p); + DEFSUBR (Fimage_instance_type); + DEFSUBR (Fvalid_image_instance_type_p); + DEFSUBR (Fimage_instance_type_list); + DEFSUBR (Fimage_instance_name); + DEFSUBR (Fimage_instance_string); + DEFSUBR (Fimage_instance_file_name); + DEFSUBR (Fimage_instance_mask_file_name); + DEFSUBR (Fimage_instance_depth); + DEFSUBR (Fimage_instance_height); + DEFSUBR (Fimage_instance_width); + DEFSUBR (Fimage_instance_hotspot_x); + DEFSUBR (Fimage_instance_hotspot_y); + DEFSUBR (Fimage_instance_foreground); + DEFSUBR (Fimage_instance_background); + DEFSUBR (Fcolorize_image_instance); /* Qnothing defined as part of the "nothing" image-instantiator type. */ @@ -2858,15 +2805,15 @@ defsymbol (&Qconst_glyph_variable, "const-glyph-variable"); - defsubr (&Sglyph_type); - defsubr (&Svalid_glyph_type_p); - defsubr (&Sglyph_type_list); - defsubr (&Sglyphp); - defsubr (&Smake_glyph_internal); - defsubr (&Sglyph_width); - defsubr (&Sglyph_ascent); - defsubr (&Sglyph_descent); - defsubr (&Sglyph_height); + DEFSUBR (Fglyph_type); + DEFSUBR (Fvalid_glyph_type_p); + DEFSUBR (Fglyph_type_list); + DEFSUBR (Fglyphp); + DEFSUBR (Fmake_glyph_internal); + DEFSUBR (Fglyph_width); + DEFSUBR (Fglyph_ascent); + DEFSUBR (Fglyph_descent); + DEFSUBR (Fglyph_height); /* Qbuffer defined in general.c. */ /* Qpointer defined above */
--- a/src/gui-x.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/gui-x.c Mon Aug 13 08:50:05 2007 +0200 @@ -216,11 +216,11 @@ free_widget_value (wv); } -DEFUN ("popup-up-p", Fpopup_up_p, Spopup_up_p, 0, 0, 0 /* +DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /* Return t if a popup menu or dialog box is up, nil otherwise. See `popup-menu' and `popup-dialog-box'. -*/ ) - () +*/ + ()) { return popup_up_p ? Qt : Qnil; } @@ -594,7 +594,7 @@ syms_of_gui_x (void) { #ifdef HAVE_POPUPS - defsubr (&Spopup_up_p); + DEFSUBR (Fpopup_up_p); defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); #endif }
--- a/src/indent.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/indent.c Mon Aug 13 08:50:05 2007 +0200 @@ -199,7 +199,7 @@ return column_at_point (buf, BUF_PT (buf), 1); } -DEFUN ("current-column", Fcurrent_column, Scurrent_column, 0, 1, 0 /* +DEFUN ("current-column", Fcurrent_column, 0, 1, 0, /* Return the horizontal position of point. Beginning of line is column 0. This is calculated by adding together the widths of all the displayed representations of the character between the start of the previous line @@ -210,22 +210,20 @@ Whether the line is visible (if `selective-display' is t) has no effect; however, ^M is treated as end of line when `selective-display' is t. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { return (make_int (current_column (decode_buffer (buffer, 0)))); } -DEFUN ("indent-to", Findent_to, Sindent_to, 1, 3, "NIndent to column: " /* +DEFUN ("indent-to", Findent_to, 1, 3, "NIndent to column: ", /* Indent from point with tabs and spaces until COLUMN is reached. Optional second argument MIN says always do at least MIN spaces even if that goes past COLUMN; by default, MIN is zero. If BUFFER is nil, the current buffer is assumed. -*/ ) - (col, minimum, buffer) - Lisp_Object col, minimum, buffer; +*/ + (col, minimum, buffer)) { /* This function can GC */ int mincol; @@ -310,14 +308,12 @@ } -DEFUN ("current-indentation", Fcurrent_indentation, Scurrent_indentation, - 0, 1, 0 /* +DEFUN ("current-indentation", Fcurrent_indentation, 0, 1, 0, /* Return the indentation of the current line. This is the horizontal position of the character following any initial whitespace. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); Bufpos pos = find_next_newline (buf, BUF_PT (buf), -1); @@ -331,7 +327,7 @@ } -DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 3, 0 /* +DEFUN ("move-to-column", Fmove_to_column, 1, 3, 0, /* Move point to column COLUMN in the current line. The column of a character is calculated by adding together the widths as displayed of the previous characters in the line. @@ -346,9 +342,8 @@ is too short to reach column COLUMN then add spaces/tabs to get there, and if COLUMN is in the middle of a tab character, change it to spaces. Returns the actual column that it moved to. -*/ ) - (column, force, buffer) - Lisp_Object column, force, buffer; +*/ + (column, force, buffer)) { /* This function can GC */ Bufpos pos; @@ -607,7 +602,7 @@ RETURN_NOT_REACHED(0) /* shut up compiler */ } -DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0 /* +DEFUN ("vertical-motion", Fvertical_motion, 1, 2, 0, /* Move to start of frame line LINES lines down. If LINES is negative, this is moving up. @@ -623,9 +618,8 @@ Returns number of lines moved; may be closer to zero than LINES if beginning or end of buffer was reached. Optional second argument is WINDOW to move in. -*/ ) - (lines, window) - Lisp_Object lines, window; +*/ + (lines, window)) { if (NILP (window)) window = Fselected_window (Qnil); @@ -651,14 +645,14 @@ void syms_of_indent (void) { - defsubr (&Scurrent_indentation); - defsubr (&Sindent_to); - defsubr (&Scurrent_column); - defsubr (&Smove_to_column); + DEFSUBR (Fcurrent_indentation); + DEFSUBR (Findent_to); + DEFSUBR (Fcurrent_column); + DEFSUBR (Fmove_to_column); #if 0 /* #### */ - defsubr (&Scompute_motion); + DEFSUBR (Fcompute_motion); #endif - defsubr (&Svertical_motion); + DEFSUBR (Fvertical_motion); } void
--- a/src/intl.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/intl.c Mon Aug 13 08:50:05 2007 +0200 @@ -168,14 +168,12 @@ Lisp_Object Qdomain; Lisp_Object Qdefer_gettext; -DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, Signore_defer_gettext, - 1, 1, 0 /* +DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /* If OBJ is of the form (defer-gettext \"string\"), return the string. The purpose of the defer-gettext symbol is to identify strings which are translated when they are referenced instead of when they are defined. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { if (CONSP (obj) && SYMBOLP (Fcar (obj)) && EQ (Fcar (obj), Qdefer_gettext)) return Fcar (Fcdr (obj)); @@ -183,12 +181,11 @@ return obj; } -DEFUN ("gettext", Fgettext, Sgettext, 1, 1, 0 /* +DEFUN ("gettext", Fgettext, 1, 1, 0, /* Look up STRING in the default message domain and return its translation. This function does nothing if I18N3 was not enabled when Emacs was compiled. -*/ ) - (string) - Lisp_Object string; +*/ + (string)) { #ifdef I18N3 /* #### What should happen here is: @@ -228,12 +225,11 @@ #endif -DEFUN ("dgettext", Fdgettext, Sdgettext, 2, 2, 0 /* +DEFUN ("dgettext", Fdgettext, 2, 2, 0, /* Look up STRING in the specified message domain and return its translation. This function does nothing if I18N3 was not enabled when Emacs was compiled. -*/ ) - (domain, string) - Lisp_Object domain, string; +*/ + (domain, string)) { CHECK_STRING (domain); CHECK_STRING (string); @@ -245,14 +241,13 @@ #endif } -DEFUN ("bind-text-domain", Fbind_text_domain, Sbind_text_domain, 2, 2, 0 /* +DEFUN ("bind-text-domain", Fbind_text_domain, 2, 2, 0, /* Associate a pathname with a message domain. Here's how the path to message files is constructed under SunOS 5.0: {pathname}/{LANG}/LC_MESSAGES/{domain}.mo This function does nothing if I18N3 was not enabled when Emacs was compiled. -*/ ) - (domain, pathname) - Lisp_Object domain, pathname; +*/ + (domain, pathname)) { CHECK_STRING (domain); CHECK_STRING (pathname); @@ -266,7 +261,7 @@ extern int load_in_progress; -DEFUN ("set-domain", Fset_domain, Sset_domain, 1, 1, 0 /* +DEFUN ("set-domain", Fset_domain, 1, 1, 0, /* Specify the domain used for translating messages in this source file. The domain declaration may only appear at top-level, and should preceed all function and variable definitions. @@ -274,9 +269,8 @@ The presence of this declaration in a compiled file effectively sets the domain of all functions and variables which are defined in that file. Bug: it has no effect on source (.el) files, only compiled (.elc) files. -*/ ) - (domain_name) - Lisp_Object domain_name; +*/ + (domain_name)) { CHECK_STRING (domain_name); if (load_in_progress) @@ -319,11 +313,11 @@ menu_item_descriptor_to_widget_value(). */ defsymbol (&Qdefer_gettext, "defer-gettext"); - defsubr (&Signore_defer_gettext); - defsubr (&Sgettext); - defsubr (&Sdgettext); - defsubr (&Sbind_text_domain); - defsubr (&Sset_domain); + DEFSUBR (Fignore_defer_gettext); + DEFSUBR (Fgettext); + DEFSUBR (Fdgettext); + DEFSUBR (Fbind_text_domain); + DEFSUBR (Fset_domain); } void
--- a/src/keymap.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/keymap.c Mon Aug 13 08:50:05 2007 +0200 @@ -765,16 +765,15 @@ return (result); } -DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0 /* +DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /* Construct and return a new keymap object. All entries in it are nil, meaning \"command undefined\". Optional argument NAME specifies a name to assign to the keymap, as in `set-keymap-name'. This name is only a debugging convenience; it is not used except when printing the keymap. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { Lisp_Object keymap = make_keymap (60); if (!NILP (name)) @@ -782,8 +781,7 @@ return keymap; } -DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, - 0, 1, 0 /* +DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /* Construct and return a new keymap object. All entries in it are nil, meaning \"command undefined\". The only difference between this function and make-keymap is that this function @@ -793,9 +791,8 @@ Optional argument NAME specifies a name to assign to the keymap, as in `set-keymap-name'. This name is only a debugging convenience; it is not used except when printing the keymap. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { Lisp_Object keymap = make_keymap (8); if (!NILP (name)) @@ -803,14 +800,13 @@ return keymap; } -DEFUN ("keymap-parents", Fkeymap_parents, Skeymap_parents, 1, 1, 0 /* +DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /* Return the `parent' keymaps of the given keymap, or nil. The parents of a keymap are searched for keybindings when a key sequence isn't bound in this one. `(current-global-map)' is the default parent of all keymaps. -*/ ) - (keymap) - Lisp_Object keymap; +*/ + (keymap)) { keymap = get_keymap (keymap, 1, 1); return (Fcopy_sequence (XKEYMAP (keymap)->parents)); @@ -824,14 +820,13 @@ return (Qnil); } -DEFUN ("set-keymap-parents", Fset_keymap_parents, Sset_keymap_parents, 2, 2, 0 /* +DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /* Sets the `parent' keymaps of the given keymap. The parents of a keymap are searched for keybindings when a key sequence isn't bound in this one. `(current-global-map)' is the default parent of all keymaps. -*/ ) - (keymap, parents) - Lisp_Object keymap, parents; +*/ + (keymap, parents)) { /* This function can GC */ Lisp_Object k; @@ -865,13 +860,12 @@ return (parents); } -DEFUN ("set-keymap-name", Fset_keymap_name, Sset_keymap_name, 2, 2, 0 /* +DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /* Set the `name' of the KEYMAP to NEW-NAME. The name is only a debugging convenience; it is not used except when printing the keymap. -*/ ) - (keymap, new_name) - Lisp_Object keymap, new_name; +*/ + (keymap, new_name)) { keymap = get_keymap (keymap, 1, 1); @@ -879,26 +873,24 @@ return (new_name); } -DEFUN ("keymap-name", Fkeymap_name, Skeymap_name, 1, 1, 0 /* +DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /* Return the `name' of KEYMAP. The name is only a debugging convenience; it is not used except when printing the keymap. -*/ ) - (keymap) - Lisp_Object keymap; +*/ + (keymap)) { keymap = get_keymap (keymap, 1, 1); return (XKEYMAP (keymap)->name); } -DEFUN ("set-keymap-prompt", Fset_keymap_prompt, Sset_keymap_prompt, 2, 2, 0 /* +DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /* Sets the `prompt' of KEYMAP to string NEW-PROMPT, or `nil' if no prompt is desired. The prompt is shown in the echo-area when reading a key-sequence to be looked-up in this keymap. -*/ ) - (keymap, new_prompt) - Lisp_Object keymap, new_prompt; +*/ + (keymap, new_prompt)) { keymap = get_keymap (keymap, 1, 1); @@ -916,13 +908,12 @@ } -DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 2, 0 /* +DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /* Return the `prompt' of the given keymap. If non-nil, the prompt is shown in the echo-area when reading a key-sequence to be looked-up in this keymap. -*/ ) - (keymap, use_inherited) - Lisp_Object keymap, use_inherited; +*/ + (keymap, use_inherited)) { /* This function can GC */ Lisp_Object prompt; @@ -936,16 +927,14 @@ keymap_prompt_mapper, 0)); } -DEFUN ("set-keymap-default-binding", - Fset_keymap_default_binding, Sset_keymap_default_binding, 2, 2, 0 /* +DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /* Sets the default binding of KEYMAP to COMMAND, or `nil' if no default is desired. The default-binding is returned when no other binding for a key-sequence is found in the keymap. If a keymap has a non-nil default-binding, neither the keymap's parents nor the current global map are searched for key bindings. -*/ ) - (keymap, command) - Lisp_Object keymap, command; +*/ + (keymap, command)) { /* This function can GC */ keymap = get_keymap (keymap, 1, 1); @@ -954,28 +943,25 @@ return (command); } -DEFUN ("keymap-default-binding", - Fkeymap_default_binding, Skeymap_default_binding, 1, 1, 0 /* +DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /* Return the default binding of KEYMAP, or `nil' if it has none. The default-binding is returned when no other binding for a key-sequence is found in the keymap. If a keymap has a non-nil default-binding, neither the keymap's parents nor the current global map are searched for key bindings. -*/ ) - (keymap) - Lisp_Object keymap; +*/ + (keymap)) { /* This function can GC */ keymap = get_keymap (keymap, 1, 1); return (XKEYMAP (keymap)->default_binding); } -DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0 /* +DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /* Return t if ARG is a keymap object. The keymap may be autoloaded first if necessary. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { /* This function can GC */ Lisp_Object tem = get_keymap (object, 0, 1); @@ -1195,14 +1181,13 @@ return keymap; } -DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0 /* +DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /* Return a copy of the keymap KEYMAP. The copy starts out with the same definitions of KEYMAP, but changing either the copy or KEYMAP does not affect the other. Any key definitions that are subkeymaps are recursively copied. -*/ ) - (keymap) - Lisp_Object keymap; +*/ + (keymap)) { /* This function can GC */ keymap = get_keymap (keymap, 1, 1); @@ -1235,11 +1220,10 @@ return (fullness); } -DEFUN ("keymap-fullness", Fkeymap_fullness, Skeymap_fullness, 1, 1, 0 /* +DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /* Return the number of bindings in the keymap. -*/ ) - (keymap) - Lisp_Object keymap; +*/ + (keymap)) { /* This function can GC */ return (make_int (keymap_fullness @@ -1593,16 +1577,12 @@ return event_matches_key_specifier_p (&event, Vmeta_prefix_char); } -DEFUN ("event-matches-key-specifier-p", - Fevent_matches_key_specifier_p, - Sevent_matches_key_specifier_p, - 2, 2, 0 /* +DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /* Return non-nil if EVENT matches KEY-SPECIFIER. This can be useful, e.g., to determine if the user pressed `help-char' or `quit-char'. -*/ ) - (event, key_specifier) - Lisp_Object event, key_specifier; +*/ + (event, key_specifier)) { CHECK_LIVE_EVENT (event); return (event_matches_key_specifier_p (XEVENT (event), key_specifier) @@ -1718,7 +1698,7 @@ signal_simple_error (buf, mpc_binding); } -DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0 /* +DEFUN ("define-key", Fdefine_key, 3, 3, 0, /* Define key sequence KEYS, in KEYMAP, as DEF. KEYMAP is a keymap object. KEYS is the sequence of keystrokes to bind, described below. @@ -1818,11 +1798,8 @@ Of course, all of this applies only when running under a window system. If you're talking to XEmacs through a TTY connection, you don't get any of these features. -*/ ) - (keymap, keys, def) - Lisp_Object keymap; - Lisp_Object keys; - Lisp_Object def; +*/ + (keymap, keys, def)) { /* This function can GC */ int idx; @@ -2177,7 +2154,7 @@ return (tem); } -DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0 /* +DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /* In keymap KEYMAP, look up key-sequence KEYS. Return the definition. Nil is returned if KEYS is unbound. See documentation of `define-key' for valid key definitions and key-sequence specifications. @@ -2185,9 +2162,8 @@ characters fail to be a valid sequence of prefix characters in KEYMAP. The number is how many characters at the front of KEYS it takes to reach a non-prefix command. -*/ ) - (keymap, keys, accept_default) - Lisp_Object keymap, keys, accept_default; +*/ + (keymap, keys, accept_default)) { /* This function can GC */ if (VECTORP (keys)) @@ -2495,7 +2471,7 @@ } /* #### Would map-current-keymaps be a better thing?? */ -DEFUN ("current-keymaps", Fcurrent_keymaps, Scurrent_keymaps, 0, 1, 0 /* +DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /* Return a list of the current keymaps that will be searched for bindings. This lists keymaps such as the current local map and the minor-mode maps, but does not list the parents of those keymaps. @@ -2503,9 +2479,8 @@ If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a mouse event), the keymaps for that mouse event will be listed (see `key-binding'). Otherwise, the keymaps for key presses will be listed. -*/ ) - (event_or_keys) - Lisp_Object event_or_keys; +*/ + (event_or_keys)) { /* This function can GC */ struct gcpro gcpro1; @@ -2525,7 +2500,7 @@ return (Flist (nmaps, gubbish)); } -DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0 /* +DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /* Return the binding for command KEYS in current keymaps. KEYS is a string, a vector of events, or a vector of key-description lists as described in the documentation for the `define-key' function. @@ -2553,9 +2528,8 @@ Note that if `overriding-local-map' or `overriding-terminal-local-map' is non-nil, *only* those two maps and the current global map are searched. -*/ ) - (keys, accept_default) - Lisp_Object keys, accept_default; +*/ + (keys, accept_default)) { /* This function can GC */ int i; @@ -2666,11 +2640,10 @@ /* Setting/querying the global and local maps */ /************************************************************************/ -DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0 /* +DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /* Select KEYMAP as the global keymap. -*/ ) - (keymap) - Lisp_Object keymap; +*/ + (keymap)) { /* This function can GC */ keymap = get_keymap (keymap, 1, 1); @@ -2678,13 +2651,12 @@ return Qnil; } -DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 2, 0 /* +DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /* Select KEYMAP as the local keymap in BUFFER. If KEYMAP is nil, that means no local keymap. If BUFFER is nil, the current buffer is assumed. -*/ ) - (keymap, buffer) - Lisp_Object keymap, buffer; +*/ + (keymap, buffer)) { /* This function can GC */ struct buffer *b = decode_buffer (buffer, 0); @@ -2696,21 +2668,20 @@ return Qnil; } -DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 1, 0 /* +DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /* Return BUFFER's local keymap, or nil if it has none. If BUFFER is nil, the current buffer is assumed. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *b = decode_buffer (buffer, 0); return b->keymap; } -DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0 /* +DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /* Return the current global keymap. -*/ ) - () +*/ + ()) { return (Vcurrent_global_map); } @@ -2951,7 +2922,7 @@ } } -DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0 /* +DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /* Apply FUNCTION to each element of KEYMAP. FUNCTION will be called with two arguments: a key-description list, and the binding. The order in which the elements of the keymap are passed to @@ -2969,9 +2940,8 @@ the keymap will be passed to the mapper function in a canonical order. Otherwise, they will be passed in hash (that is, random) order, which is faster. -*/ ) - (function, keymap, sort_first) - Lisp_Object function, keymap, sort_first; +*/ + (function, keymap, sort_first)) { /* This function can GC */ struct gcpro gcpro1, gcpro2; @@ -3069,17 +3039,15 @@ } -DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, - 1, 2, 0 /* +DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /* Find all keymaps accessible via prefix characters from STARTMAP. Returns a list of elements of the form (KEYS . MAP), where the sequence KEYS starting from STARTMAP gets you to MAP. These elements are ordered so that the KEYS increase in length. The first element is ([] . STARTMAP). An optional argument PREFIX, if non-nil, should be a key sequence; then the value includes only maps for prefixes that start with PREFIX. -*/ ) - (startmap, prefix) - Lisp_Object startmap, prefix; +*/ + (startmap, prefix)) { /* This function can GC */ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -3148,13 +3116,12 @@ /* Pretty descriptions of key sequences */ /************************************************************************/ -DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0 /* +DEFUN ("key-description", Fkey_description, 1, 1, 0, /* Return a pretty description of key-sequence KEYS. Control characters turn into \"C-foo\" sequences, meta into \"M-foo\" spaces are put between sequence elements, etc. -*/ ) - (keys) - Lisp_Object keys; +*/ + (keys)) { if (INTP (keys) || CONSP (keys) || SYMBOLP (keys) || EVENTP (keys)) { @@ -3188,15 +3155,13 @@ return Fkey_description (wrong_type_argument (Qsequencep, keys)); } -DEFUN ("single-key-description", Fsingle_key_description, - Ssingle_key_description, 1, 1, 0 /* +DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /* Return a pretty description of command character KEY. Control characters turn into C-whatever, etc. This differs from `text-char-description' in that it returns a description of a key read from the user rather than a character from a buffer. -*/ ) - (key) - Lisp_Object key; +*/ + (key)) { if (SYMBOLP (key)) key = Fcons (key, Qnil); /* sleaze sleaze */ @@ -3261,16 +3226,14 @@ (wrong_type_argument (intern ("char-or-event-p"), key)); } -DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, - 1, 1, 0 /* +DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /* Return a pretty description of file-character CHR. Unprintable characters turn into \"^char\" or \\NNN, depending on the value of the `ctl-arrow' variable. This differs from `single-key-description' in that it returns a description of a character from a buffer rather than a key read from the user. -*/ ) - (chr) - Lisp_Object chr; +*/ + (chr)) { Bufbyte buf[200]; Bufbyte *p; @@ -3336,7 +3299,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, Lisp_Object firstonly, char *target_buffer); -DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0 /* +DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /* Return list of keys that invoke DEFINITION in KEYMAPS. KEYMAPS can be either a keymap (meaning search in that keymap and the current global keymap) or a list of keymaps (meaning search in exactly @@ -3351,9 +3314,8 @@ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections to other keymaps or slots. This makes it possible to search for an indirect definition itself. -*/ ) - (definition, keymaps, firstonly, noindirect, event_or_keys) - Lisp_Object definition, keymaps, firstonly, noindirect, event_or_keys; +*/ + (definition, keymaps, firstonly, noindirect, event_or_keys)) { /* This function can GC */ Lisp_Object maps[100]; @@ -3705,8 +3667,7 @@ /* Describing keymaps */ /************************************************************************/ -DEFUN ("describe-bindings-internal", - Fdescribe_bindings_internal, Sdescribe_bindings_internal, 1, 5, 0 /* +DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /* Insert a list of all defined keys and their definitions in MAP. Optional second argument ALL says whether to include even \"uninteresting\" definitions (ie symbols with a non-nil `suppress-keymap' property. @@ -3715,9 +3676,8 @@ Fourth argument PREFIX, if non-nil, should be a key sequence; only bindings which start with that key sequence will be printed. Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks. -*/ ) - (map, all, shadow, prefix, mouse_only_p) - Lisp_Object map, all, shadow, prefix, mouse_only_p; +*/ + (map, all, shadow, prefix, mouse_only_p)) { /* This function can GC */ describe_map_tree (map, NILP (all), shadow, prefix, @@ -4164,38 +4124,38 @@ defsymbol (&Qmodeline_map, "modeline-map"); defsymbol (&Qtoolbar_map, "toolbar-map"); - defsubr (&Skeymap_parents); - defsubr (&Sset_keymap_parents); - defsubr (&Skeymap_name); - defsubr (&Sset_keymap_name); - defsubr (&Skeymap_prompt); - defsubr (&Sset_keymap_prompt); - defsubr (&Skeymap_default_binding); - defsubr (&Sset_keymap_default_binding); - - defsubr (&Skeymapp); - defsubr (&Smake_keymap); - defsubr (&Smake_sparse_keymap); - - defsubr (&Scopy_keymap); - defsubr (&Skeymap_fullness); - defsubr (&Smap_keymap); - defsubr (&Sevent_matches_key_specifier_p); - defsubr (&Sdefine_key); - defsubr (&Slookup_key); - defsubr (&Skey_binding); - defsubr (&Suse_global_map); - defsubr (&Suse_local_map); - defsubr (&Scurrent_local_map); - defsubr (&Scurrent_global_map); - defsubr (&Scurrent_keymaps); - defsubr (&Saccessible_keymaps); - defsubr (&Skey_description); - defsubr (&Ssingle_key_description); - defsubr (&Swhere_is_internal); - defsubr (&Sdescribe_bindings_internal); - - defsubr (&Stext_char_description); + DEFSUBR (Fkeymap_parents); + DEFSUBR (Fset_keymap_parents); + DEFSUBR (Fkeymap_name); + DEFSUBR (Fset_keymap_name); + DEFSUBR (Fkeymap_prompt); + DEFSUBR (Fset_keymap_prompt); + DEFSUBR (Fkeymap_default_binding); + DEFSUBR (Fset_keymap_default_binding); + + DEFSUBR (Fkeymapp); + DEFSUBR (Fmake_keymap); + DEFSUBR (Fmake_sparse_keymap); + + DEFSUBR (Fcopy_keymap); + DEFSUBR (Fkeymap_fullness); + DEFSUBR (Fmap_keymap); + DEFSUBR (Fevent_matches_key_specifier_p); + DEFSUBR (Fdefine_key); + DEFSUBR (Flookup_key); + DEFSUBR (Fkey_binding); + DEFSUBR (Fuse_global_map); + DEFSUBR (Fuse_local_map); + DEFSUBR (Fcurrent_local_map); + DEFSUBR (Fcurrent_global_map); + DEFSUBR (Fcurrent_keymaps); + DEFSUBR (Faccessible_keymaps); + DEFSUBR (Fkey_description); + DEFSUBR (Fsingle_key_description); + DEFSUBR (Fwhere_is_internal); + DEFSUBR (Fdescribe_bindings_internal); + + DEFSUBR (Ftext_char_description); defsymbol (&Qcontrol, "control"); defsymbol (&Qctrl, "ctrl");
--- a/src/lisp.h Mon Aug 13 08:49:44 2007 +0200 +++ b/src/lisp.h Mon Aug 13 08:50:05 2007 +0200 @@ -1365,10 +1365,8 @@ as a null-terminated C string. `Fname' should be the C equivalent of `lname', using only characters valid in a C identifier, with an "F" prepended. - `sname' should be the name for the C constant structure - that records information on this function for internal use. - By convention, it should be the same as `fnname' but with S instead of F. - It's too bad that C macros can't compute this from `fnname'. + The name of the C constant structure that records information + on this function for internal use is "S" concatenated with Fname. `minargs' should be a number, the minimum number of arguments allowed. `maxargs' should be a number, the maximum number of arguments allowed, or else MANY or UNEVALLED. @@ -1393,17 +1391,19 @@ /* Can't be const, because then subr->doc is read-only and Snarf_documentation chokes */ -#define DEFUN(lname, Fname, sname, minargs, maxargs, prompt) \ - Lisp_Object Fname ( DEFUN__ ## maxargs ) ; /* See below */ \ - static struct Lisp_Subr sname \ - = { { lrecord_subr }, minargs, maxargs, prompt, 0, lname, (lisp_fn_t) Fname }; \ - Lisp_Object Fname + +#define DEFUN(lname, Fname, minargs, maxargs, prompt, arglist) \ + Lisp_Object Fname (DEFUN_ ## maxargs arglist) ; /* See below */ \ + static struct Lisp_Subr S##Fname = { {lrecord_subr}, \ + minargs, maxargs, prompt, 0, lname, (lisp_fn_t) Fname }; \ + Lisp_Object Fname (DEFUN_##maxargs arglist) + /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a prototype that matches maxargs, and add the obligatory `Lisp_Object' type declaration to the formal C arguments. */ -#define DEFUN_MANY(named_int, named_Lisp_Object) int named_int, Lisp_Object *named_Lisp_Object +#define DEFUN_MANY(named_int, named_Lisp_Object) named_int, named_Lisp_Object #define DEFUN_UNEVALLED(args) Lisp_Object args #define DEFUN_0() void #define DEFUN_1(a) Lisp_Object a @@ -1415,18 +1415,6 @@ #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g), Lisp_Object h -#define DEFUN__MANY DEFUN_MANY(argc,argv) -#define DEFUN__UNEVALLED DEFUN_UNEVALLED(args) -#define DEFUN__0 DEFUN_0() -#define DEFUN__1 DEFUN_1(a) -#define DEFUN__2 DEFUN_2(a,b) -#define DEFUN__3 DEFUN_3(a,b,c) -#define DEFUN__4 DEFUN_4(a,b,c,d) -#define DEFUN__5 DEFUN_5(a,b,c,d,e) -#define DEFUN__6 DEFUN_6(a,b,c,d,e,f) -#define DEFUN__7 DEFUN_7(a,b,c,d,e,f,g) -#define DEFUN__8 DEFUN_8(a,b,c,d,e,f,g,h) - /* WARNING: If you add defines here for higher values of maxargs, make sure to also fix the clauses in primitive_funcall(), and change the define of SUBR_MAX_ARGS above. */ @@ -1478,6 +1466,12 @@ that might have gotten queued until it was safe. */ #define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0) +/* +#define QUIT \ + do {if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ + { Vquit_flag = Qnil; Fsignal (Qquit, Qnil); }} while (0) +*/ + #define REALLY_QUIT do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
--- a/src/lread.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/lread.c Mon Aug 13 08:50:05 2007 +0200 @@ -473,7 +473,7 @@ } #endif /* I18N3 */ -DEFUN ("load-internal", Fload_internal, Sload_internal, 1, 4, 0 /* +DEFUN ("load-internal", Fload_internal, 1, 4, 0, /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', then try FILE unmodified. @@ -485,9 +485,8 @@ If optional fourth arg NOSUFFIX is non-nil, don't try adding suffixes `.elc' or `.el' to the specified name FILE. Return t if file exists. -*/ ) - (file, no_error, nomessage, nosuffix) - Lisp_Object file, no_error, nomessage, nosuffix; +*/ + (file, no_error, nomessage, nosuffix)) { /* This function can GC */ int fd = -1; @@ -727,7 +726,7 @@ } #endif /* 0 */ -DEFUN ("locate-file", Flocate_file, Slocate_file, 2, 4, 0 /* +DEFUN ("locate-file", Flocate_file, 2, 4, 0, /* Search for FILENAME through PATH-LIST, expanded by one of the optional SUFFIXES (string of suffixes separated by \":\"s), checking for access MODE (0|1|2|4 = exists|executable|writeable|readable), default readable. @@ -738,9 +737,8 @@ get tripped up. In this case, you will have to call `locate-file-clear-hashing' to get it back on track. See that function for details. -*/ ) - (filename, path_list, suffixes, mode) - Lisp_Object filename, path_list, suffixes, mode; +*/ + (filename, path_list, suffixes, mode)) { /* This function can GC */ Lisp_Object tp; @@ -1058,8 +1056,7 @@ return val; } -DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, - Slocate_file_clear_hashing, 1, 1, 0 /* +DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /* Clear the hash records for the specified list of directories. `locate-file' uses a hashing scheme to speed lookup, and will correctly track the following environmental changes: @@ -1072,9 +1069,8 @@ `locate-file' will primarily get confused if you add a file that shadows (i.e. has the same name as) another file further down in the directory list. In this case, you must call `locate-file-clear-hashing'. -*/ ) - (path) - Lisp_Object path; +*/ + (path)) { Lisp_Object pathtail; @@ -1261,7 +1257,7 @@ #ifndef standalone -DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 2, "bBuffer: " /* +DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /* Execute BUFFER as Lisp code. Programs can pass two arguments, BUFFER and PRINTFLAG. BUFFER is the buffer to evaluate (nil means use current buffer). @@ -1271,9 +1267,8 @@ If there is no error, point does not move. If there is an error, point remains at the end of the last character read from the buffer. Execute BUFFER as Lisp code. -*/ ) - (bufname, printflag) - Lisp_Object bufname, printflag; +*/ + (bufname, printflag)) { /* This function can GC */ int speccount = specpdl_depth (); @@ -1315,7 +1310,7 @@ } #endif -DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r" /* +DEFUN ("eval-region", Feval_region, 2, 3, "r", /* Execute the region as Lisp code. When called from programs, expects two arguments, giving starting and ending indices in the current buffer @@ -1329,9 +1324,8 @@ Note: Before evaling the region, this function narrows the buffer to it. If the code being eval'd should happen to trigger a redisplay you may see some text temporarily disappear because of this. -*/ ) - (b, e, printflag) - Lisp_Object b, e, printflag; +*/ + (b, e, printflag)) { /* This function can GC */ int speccount = specpdl_depth (); @@ -1359,7 +1353,7 @@ #endif /* standalone */ -DEFUN ("read", Fread, Sread, 0, 1, 0 /* +DEFUN ("read", Fread, 0, 1, 0, /* Read one Lisp expression as text from STREAM, return as Lisp object. If STREAM is nil, use the value of `standard-input' (which see). STREAM or the value of `standard-input' may be: @@ -1369,9 +1363,8 @@ call it with a char as argument to push a char back) a string (takes text from string, starting at the beginning) t (read text line using minibuffer and use it). -*/ ) - (stream) - Lisp_Object stream; +*/ + (stream)) { if (NILP (stream)) stream = Vstandard_input; @@ -1396,14 +1389,13 @@ return read0 (stream); } -DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0 /* +DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /* Read one Lisp expression which is represented as text by STRING. Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX). START and END optionally delimit a substring of STRING from which to read; they default to 0 and (length STRING) respectively. -*/ ) - (string, start, end) - Lisp_Object string, start, end; +*/ + (string, start, end)) { Bytecount startval, endval; Lisp_Object tem; @@ -2854,15 +2846,15 @@ void syms_of_lread (void) { - defsubr (&Sread); - defsubr (&Sread_from_string); - defsubr (&Sload_internal); - defsubr (&Slocate_file); - defsubr (&Slocate_file_clear_hashing); - defsubr (&Seval_buffer); - defsubr (&Seval_region); + DEFSUBR (Fread); + DEFSUBR (Fread_from_string); + DEFSUBR (Fload_internal); + DEFSUBR (Flocate_file); + DEFSUBR (Flocate_file_clear_hashing); + DEFSUBR (Feval_buffer); + DEFSUBR (Feval_region); #ifdef standalone - defsubr (&Sread_char); + DEFSUBR (Fread_char); #endif defsymbol (&Qstandard_input, "standard-input");
--- a/src/macros.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/macros.c Mon Aug 13 08:50:05 2007 +0200 @@ -49,16 +49,15 @@ int executing_macro_index; -DEFUN ("start-kbd-macro", Fstart_kbd_macro, Sstart_kbd_macro, 1, 1, "P" /* +DEFUN ("start-kbd-macro", Fstart_kbd_macro, 1, 1, "P", /* Record subsequent keyboard and menu input, defining a keyboard macro. The commands are recorded even as they are executed. Use \\[end-kbd-macro] to finish recording and make the macro available. Use \\[name-last-kbd-macro] to give it a permanent name. Non-nil arg (prefix arg) means append to last macro defined; This begins by re-executing that macro as if you typed it again. -*/ ) - (append) - Lisp_Object append; +*/ + (append)) { /* This function can GC */ struct console *con = XCONSOLE (Vselected_console); @@ -88,7 +87,7 @@ return Qnil; } -DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 1, "P" /* +DEFUN ("end-kbd-macro", Fend_kbd_macro, 0, 1, "P", /* Finish defining a keyboard macro. The definition was started by \\[start-kbd-macro]. The macro is now available for use via \\[call-last-kbd-macro], @@ -98,9 +97,8 @@ With numeric arg, repeat macro now that many times, counting the definition just completed as the first repetition. An argument of zero means repeat until error. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { /* This function can GC */ struct console *con = XCONSOLE (Vselected_console); @@ -196,11 +194,10 @@ con->kbd_macro_end = con->kbd_macro_ptr; } -DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events, - Scancel_kbd_macro_events, 0, 0, 0 /* +DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events, 0, 0, 0, /* Cancel the events added to a keyboard macro for this command. -*/ ) - () +*/ + ()) { struct console *con = XCONSOLE (Vselected_console); @@ -209,17 +206,15 @@ return Qnil; } -DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro, Scall_last_kbd_macro, - 0, 1, "p" /* +DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro, 0, 1, "p", /* Call the last keyboard macro that you defined with \\[start-kbd-macro]. A prefix argument serves as a repeat count. Zero means repeat until error. To make a macro permanent so you can call it even after defining others, use \\[name-last-kbd-macro]. -*/ ) - (prefix) - Lisp_Object prefix; +*/ + (prefix)) { /* This function can GC */ struct console *con = XCONSOLE (Vselected_console); @@ -245,13 +240,12 @@ return Qnil; } -DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 2, 0 /* +DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, 1, 2, 0, /* Execute MACRO as string of editor command characters. If MACRO is a symbol, its function definition is used. COUNT is a repeat count, or nil for once, or 0 for infinite loop. -*/ ) - (macro, prefixarg) - Lisp_Object macro, prefixarg; +*/ + (macro, prefixarg)) { /* This function can GC */ Lisp_Object final; @@ -295,11 +289,11 @@ void syms_of_macros (void) { - defsubr (&Sstart_kbd_macro); - defsubr (&Send_kbd_macro); - defsubr (&Scall_last_kbd_macro); - defsubr (&Sexecute_kbd_macro); - defsubr (&Scancel_kbd_macro_events); + DEFSUBR (Fstart_kbd_macro); + DEFSUBR (Fend_kbd_macro); + DEFSUBR (Fcall_last_kbd_macro); + DEFSUBR (Fexecute_kbd_macro); + DEFSUBR (Fcancel_kbd_macro_events); defsymbol (&Qexecute_kbd_macro, "execute-kbd-macro"); }
--- a/src/marker.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/marker.c Mon Aug 13 08:50:05 2007 +0200 @@ -106,12 +106,11 @@ /* Operations on markers. */ -DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0 /* +DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* Return the buffer that MARKER points into, or nil if none. Returns nil if MARKER points into a dead buffer. -*/ ) - (marker) - Lisp_Object marker; +*/ + (marker)) { Lisp_Object buf; CHECK_MARKER (marker); @@ -125,12 +124,11 @@ return Qnil; } -DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0 /* +DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /* Return the position MARKER points at, as a character number. Returns `nil' if marker doesn't point anywhere. -*/ ) - (marker) - Lisp_Object marker; +*/ + (marker)) { CHECK_MARKER (marker); if (XMARKER (marker)->buffer) @@ -261,7 +259,7 @@ } -DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0 /* +DEFUN ("set-marker", Fset_marker, 2, 3, 0, /* Position MARKER before character number NUMBER in BUFFER. BUFFER defaults to the current buffer. If NUMBER is nil, makes marker point nowhere. @@ -269,9 +267,8 @@ If this marker was returned by (point-marker t), then changing its position moves point. You cannot change its buffer or make it point nowhere. Returns MARKER. -*/ ) - (marker, number, buffer) - Lisp_Object marker, number, buffer; +*/ + (marker, number, buffer)) { return set_marker_internal (marker, number, buffer, 0); } @@ -399,15 +396,14 @@ RETURN_NOT_REACHED (Qnil) /* not reached */ } -DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0 /* +DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /* Return a new marker pointing at the same place as MARKER. If argument is a number, makes a new marker pointing at that position in the current buffer. The optional argument TYPE specifies the insertion type of the new marker; see `marker-insertion-type'. -*/ ) - (marker, type) - Lisp_Object marker, type; +*/ + (marker, type)) { return copy_marker_1 (marker, type, 0); } @@ -418,26 +414,22 @@ return copy_marker_1 (marker, type, 1); } -DEFUN ("marker-insertion-type", Fmarker_insertion_type, - Smarker_insertion_type, 1, 1, 0 /* +DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /* Return insertion type of MARKER: t if it stays after inserted text. nil means the marker stays before text inserted there. -*/ ) - (marker) - register Lisp_Object marker; +*/ + (marker)) { CHECK_MARKER (marker); return XMARKER (marker)->insertion_type ? Qt : Qnil; } -DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, - Sset_marker_insertion_type, 2, 2, 0 /* +DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /* Set the insertion-type of MARKER to TYPE. If TYPE is t, it means the marker advances when you insert text at it. If TYPE is nil, it means the marker stays behind when you insert text at it. -*/ ) - (marker, type) - Lisp_Object marker, type; +*/ + (marker, type)) { CHECK_MARKER (marker); @@ -470,12 +462,12 @@ void syms_of_marker (void) { - defsubr (&Smarker_position); - defsubr (&Smarker_buffer); - defsubr (&Sset_marker); - defsubr (&Scopy_marker); - defsubr (&Smarker_insertion_type); - defsubr (&Sset_marker_insertion_type); + DEFSUBR (Fmarker_position); + DEFSUBR (Fmarker_buffer); + DEFSUBR (Fset_marker); + DEFSUBR (Fcopy_marker); + DEFSUBR (Fmarker_insertion_type); + DEFSUBR (Fset_marker_insertion_type); } void init_buffer_markers (struct buffer *b);
--- a/src/md5.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/md5.c Mon Aug 13 08:50:05 2007 +0200 @@ -365,14 +365,13 @@ from their internal representation, and thus their MD5 hash would be different. */ -DEFUN ("md5", Fmd5, Smd5, 1, 3, 0 /* +DEFUN ("md5", Fmd5, 1, 3, 0, /* Return the MD5 (a secure message digest algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments START and END denote buffer positions for computing the hash of a portion of OBJECT. -*/ ) - (object, start, end) - Lisp_Object object, start, end; +*/ + (object, start, end)) { MD_CTX context; unsigned char digest[16]; @@ -422,7 +421,7 @@ void syms_of_md5 (void) { - defsubr (&Smd5); + DEFSUBR (Fmd5); defsymbol (&Qmd5, "md5"); }
--- a/src/menubar.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/menubar.c Mon Aug 13 08:50:05 2007 +0200 @@ -91,7 +91,7 @@ update_frame_menubars (f); } -DEFUN ("popup-menu", Fpopup_menu, Spopup_menu, 1, 2, 0 /* +DEFUN ("popup-menu", Fpopup_menu, 1, 2, 0, /* Pop up the given menu. A menu description is a list of menu items, strings, and submenus. @@ -169,9 +169,8 @@ [ \"Read Only\" toggle-read-only :style toggle :selected buffer-read-only ] See menubar.el for many more examples. -*/ ) - (menu_desc, event) - Lisp_Object menu_desc, event; +*/ + (menu_desc, event)) { struct frame *f = decode_frame(Qnil); MAYBE_FRAMEMETH (f, popup_menu, (menu_desc,event)); @@ -182,7 +181,7 @@ syms_of_menubar (void) { defsymbol (&Qcurrent_menubar, "current-menubar"); - defsubr (&Spopup_menu); + DEFSUBR (Fpopup_menu); } void
--- a/src/minibuf.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/minibuf.c Mon Aug 13 08:50:05 2007 +0200 @@ -58,10 +58,10 @@ Qclear_message, Qdisplay_message; -DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0 /* +DEFUN ("minibuffer-depth", Fminibuffer_depth, 0, 0, 0, /* Return current depth of activations of minibuffer, a nonnegative integer. -*/ ) - () +*/ + ()) { return make_int (minibuf_level); } @@ -106,13 +106,10 @@ return Qnil; } -DEFUN ("read-minibuffer-internal", - Fread_minibuffer_internal, Sread_minibuffer_internal, - 1, 1, 0 /* +DEFUN ("read-minibuffer-internal", Fread_minibuffer_internal, 1, 1, 0, /* Lowest-level interface to minibuffers. Don't call this. -*/ ) - (prompt) - Lisp_Object prompt; +*/ + (prompt)) { /* This function can GC */ int speccount = specpdl_depth (); @@ -269,7 +266,7 @@ -DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0 /* +DEFUN ("try-completion", Ftry_completion, 2, 3, 0, /* Return common substring of all completions of STRING in ALIST. Each car of each element of ALIST is tested to see if it begins with STRING. All that match are compared together; the longest initial sequence @@ -288,9 +285,8 @@ it is used to test each possible match. The match is a candidate only if PREDICATE returns non-nil. The argument given to PREDICATE is the alist element or the symbol from the obarray. -*/ ) - (string, alist, pred) - Lisp_Object string, alist, pred; +*/ + (string, alist, pred)) { /* This function can GC */ Lisp_Object bestmatch, tail; @@ -472,7 +468,7 @@ } -DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 3, 0 /* +DEFUN ("all-completions", Fall_completions, 2, 3, 0, /* Search for partial matches to STRING in ALIST. Each car of each element of ALIST is tested to see if it begins with STRING. The value is a list of all the strings from ALIST that match. @@ -488,9 +484,8 @@ The match is a candidate only if PREDICATE returns non-nil. The argument given to PREDICATE is the alist element or the symbol from the obarray. -*/ ) - (string, alist, pred) - Lisp_Object string, alist, pred; +*/ + (string, alist, pred)) { /* This function can GC */ Lisp_Object tail; @@ -865,16 +860,16 @@ defsymbol (&Qcompletion_ignore_case, "completion-ignore-case"); - defsubr (&Sminibuffer_depth); + DEFSUBR (Fminibuffer_depth); #if 0 - defsubr (&Sminibuffer_prompt); - defsubr (&Sminibuffer_prompt_width); + DEFSUBR (Fminibuffer_prompt); + DEFSUBR (Fminibuffer_prompt_width); #endif - defsubr (&Sread_minibuffer_internal); + DEFSUBR (Fread_minibuffer_internal); - defsubr (&Stry_completion); - defsubr (&Sall_completions); + DEFSUBR (Ftry_completion); + DEFSUBR (Fall_completions); defsymbol (&Qappend_message, "append-message"); defsymbol (&Qclear_message, "clear-message");
--- a/src/mocklisp.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/mocklisp.c Mon Aug 13 08:50:05 2007 +0200 @@ -35,11 +35,10 @@ Lisp_Object Vmocklisp_arguments; #if 0 /* Now in lisp code ("macrocode...") */ -xxDEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0 /* +xxDEFUN ("ml-defun", ml_defun, 0, UNEVALLED, 0 /* Define mocklisp functions */ ) - (args) - Lisp_Object args; + (Lisp_Object args) { Lisp_Object elt; @@ -54,11 +53,10 @@ #endif /* 0 */ -DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0 /* +DEFUN ("ml-if", Fml_if, 0, UNEVALLED, 0, /* Mocklisp version of `if'. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object val; @@ -82,11 +80,10 @@ } #if 0 /* Now converted to regular "while" by hairier conversion code. */ -xxDEFUN ("ml-while", Fml_while, Sml_while, 1, UNEVALLED, 0 /* +xxDEFUN ("ml-while", ml_while, 1, UNEVALLED, 0 /* while for mocklisp programs */ ) - (args) - Lisp_Object args; + (Lisp_Object args) { Lisp_Object test, body, tem; struct gcpro gcpro1, gcpro2; @@ -163,12 +160,10 @@ /* ??? Isn't this the same as `provide-prefix-arg' from mlsupport.el? */ -DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument, - 2, UNEVALLED, 0 /* +DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, 2, UNEVALLED, 0, /* Evaluate second argument, using first argument as prefix arg value. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ struct gcpro gcpro1; @@ -178,13 +173,10 @@ return Feval (Fcar (Fcdr (args))); } -DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, - Sml_prefix_argument_loop, - 0, UNEVALLED, 0 /* +DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, 0, UNEVALLED, 0, /* -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object tem; @@ -214,12 +206,11 @@ #if 0 /* now in lisp code */ -DEFUN ("ml-substr", Fml_substr, Sml_substr, 3, 3, 0 /* +DEFUN ("ml-substr", Fml_substr, 3, 3, 0, /* Return a substring of STRING, starting at index FROM and of length LENGTH. If either FROM or LENGTH is negative, the length of STRING is added to it. -*/ ) - (string, from, to) - Lisp_Object string, from, to; +*/ + (string, from, to)) { CHECK_STRING (string); CHECK_INT (from); @@ -235,14 +226,12 @@ /* now in lisp code */ -DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0 /* +DEFUN ("insert-string", Finsert_string, 0, MANY, 0, /* Mocklisp-compatibility insert function. Like the function `insert' except that any argument that is a number is converted into a string by expressing it in decimal. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { int argnum; Lisp_Object tem; @@ -277,16 +266,16 @@ defsymbol (&Qmocklisp, "mocklisp"); defsymbol (&Qmocklisp_arguments, "mocklisp-arguments"); -/*defsubr (&Sml_defun);*/ - defsubr (&Sml_if); -/*defsubr (&Sml_while);*/ -/*defsubr (&Sml_nargs);*/ -/*defsubr (&Sml_arg);*/ -/*defsubr (&Sml_interactive);*/ - defsubr (&Sml_provide_prefix_argument); - defsubr (&Sml_prefix_argument_loop); -/*defsubr (&Sml_substr);*/ -/*defsubr (&Sinsert_string);*/ +/*DEFSUBR (Fml_defun);*/ + DEFSUBR (Fml_if); +/*DEFSUBR (Fml_while);*/ +/*DEFSUBR (Fml_nargs);*/ +/*DEFSUBR (Fml_arg);*/ +/*DEFSUBR (Fml_interactive);*/ + DEFSUBR (Fml_provide_prefix_argument); + DEFSUBR (Fml_prefix_argument_loop); +/*DEFSUBR (Fml_substr);*/ +/*DEFSUBR (Finsert_string);*/ } void
--- a/src/msdos.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/msdos.c Mon Aug 13 08:50:05 2007 +0200 @@ -1124,11 +1124,12 @@ int total_doskeys; /* Total number of elements stored into recent_doskeys */ Lisp_Object recent_doskeys; /* A vector, holding the last 100 keystrokes */ -DEFUN ("recent-doskeys", Frecent_doskeys, Srecent_doskeys, 0, 0, 0, - "Return vector of last 100 keyboard input values seen in dos_rawgetc.\n\ -Each input key receives two values in this vector: first the ASCII code,\n\ -and then the scan code.") - () +DEFUN ("recent-doskeys", Frecent_doskeys, 0, 0, 0, /* +Return vector of last 100 keyboard input values seen in dos_rawgetc. +Each input key receives two values in this vector: first the ASCII code, +and then the scan code. +*/ + ()) { Lisp_Object *keys = XVECTOR (recent_doskeys)->contents; Lisp_Object val; @@ -2495,7 +2496,7 @@ void syms_of_msdos (void) { - defsubr (&Srecent_doskeys); + DEFSUBR (Frecent_doskeys); } void
--- a/src/objects-tty.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/objects-tty.c Mon Aug 13 08:50:05 2007 +0200 @@ -35,15 +35,13 @@ Lisp_Object Vtty_dynamic_color_bg; #endif -DEFUN ("register-tty-color", Fregister_tty_color, Sregister_tty_color, 3, 3, - 0 /* +DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /* Register COLOR as a recognized TTY color. COLOR should be a string. Strings FG-STRING and BG-STRING should specify the escape sequences to set the foreground and background to the given color, respectively. -*/ ) - (color, fg_string, bg_string) - Lisp_Object color, fg_string, bg_string; +*/ + (color, fg_string, bg_string)) { CHECK_STRING (color); CHECK_STRING (fg_string); @@ -57,12 +55,10 @@ return Qnil; } -DEFUN ("unregister-tty-color", Funregister_tty_color, Sunregister_tty_color, - 1, 1, 0 /* +DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /* Unregister COLOR as a recognized TTY color. -*/ ) - (color) - Lisp_Object color; +*/ + (color)) { CHECK_STRING (color); @@ -71,14 +67,13 @@ return Qnil; } -DEFUN ("find-tty-color", Ffind_tty_color, Sfind_tty_color, 1, 1, 0 /* +DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /* Look up COLOR in the list of registered TTY colors. If it is found, return a list (FG-STRING BG-STRING) of the escape sequences used to set the foreground and background to the color, respectively. If it is not found, return nil. -*/ ) - (color) - Lisp_Object color; +*/ + (color)) { Lisp_Object result; @@ -91,10 +86,10 @@ return Qnil; } -DEFUN ("tty-color-list", Ftty_color_list, Stty_color_list, 0, 0, 0 /* +DEFUN ("tty-color-list", Ftty_color_list, 0, 0, 0, /* Return a list of the registered TTY colors. -*/ ) - () +*/ + ()) { Lisp_Object result = Qnil; Lisp_Object rest; @@ -113,15 +108,13 @@ dynamic color settings apply to *all* text in the default color, not just the text output after the escape sequence has been given. */ -DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, - Sset_tty_dynamic_color_specs, 2, 2, 0 /* +DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /* Set the dynamic color specifications for TTY's. FG and BG should be either nil or vaguely printf-like strings, where each occurrence of %s is replaced with the color name and each occurrence of %% is replaced with a single % character. -*/ ) - (fg, bg) - Lisp_Object fg, bg; +*/ + (fg, bg)) { if (!NILP (fg)) CHECK_STRING (fg); @@ -134,12 +127,11 @@ return Qnil; } -DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, - Stty_dynamic_color_specs, 0, 0, 0 /* +DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /* Return the dynamic color specifications for TTY's as a list of (FG BG). See `set-tty-dynamic-color-specs'. -*/ ) - () +*/ + ()) { return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg); } @@ -280,13 +272,13 @@ void syms_of_objects_tty (void) { - defsubr (&Sregister_tty_color); - defsubr (&Sunregister_tty_color); - defsubr (&Sfind_tty_color); - defsubr (&Stty_color_list); + DEFSUBR (Fregister_tty_color); + DEFSUBR (Funregister_tty_color); + DEFSUBR (Ffind_tty_color); + DEFSUBR (Ftty_color_list); #if 0 - defsubr (&Sset_tty_dynamic_color_specs); - defsubr (&Stty_dynamic_color_specs); + DEFSUBR (Fset_tty_dynamic_color_specs); + DEFSUBR (Ftty_dynamic_color_specs); #endif }
--- a/src/objects.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/objects.c Mon Aug 13 08:50:05 2007 +0200 @@ -136,8 +136,7 @@ LISP_HASH (obj))); } -DEFUN ("make-color-instance", Fmake_color_instance, Smake_color_instance, - 1, 3, 0 /* +DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* Creates a new `color-instance' object of the specified color. DEVICE specifies the device this object applies to and defaults to the selected device. An error is signalled if the color is unknown or cannot @@ -149,9 +148,8 @@ you drop all pointers to it and allow it to be garbage collected. When these objects are GCed, the underlying window-system data (e.g. X object) is deallocated as well. -*/ ) - (name, device, no_error) - Lisp_Object name, device, no_error; +*/ + (name, device, no_error)) { struct Lisp_Color_Instance *c; Lisp_Object val; @@ -178,33 +176,28 @@ return val; } -DEFUN ("color-instance-p", Fcolor_instance_p, Scolor_instance_p, 1, 1, 0 /* +DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* Return non-nil if OBJECT is a color instance. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (COLOR_INSTANCEP (object) ? Qt : Qnil); } -DEFUN ("color-instance-name", Fcolor_instance_name, Scolor_instance_name, - 1, 1, 0 /* +DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /* Return the name used to allocate COLOR-INSTANCE. -*/ ) - (color_instance) - Lisp_Object color_instance; +*/ + (color_instance)) { CHECK_COLOR_INSTANCE (color_instance); return (XCOLOR_INSTANCE (color_instance)->name); } -DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, - Scolor_instance_rgb_components, 1, 1, 0 /* +DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /* Return a three element list containing the red, green, and blue color components of COLOR-INSTANCE, or nil if unknown. -*/ ) - (color_instance) - Lisp_Object color_instance; +*/ + (color_instance)) { struct Lisp_Color_Instance *c; @@ -219,8 +212,7 @@ (c)); } -DEFUN ("valid-color-name-p", Fvalid_color_name_p, Svalid_color_name_p, - 1, 2, 0 /* +DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /* Return true if COLOR names a valid color for the current device. Valid color names for X are listed in the file /usr/lib/X11/rgb.txt, or @@ -229,9 +221,8 @@ Valid color names for TTY are those which have an ISO 6429 (ANSI) sequence. In addition to being a color this may be one of a number of attributes such as `blink'. -*/ ) - (color, device) - Lisp_Object color, device; +*/ + (color, device)) { struct device *d = decode_device (device); @@ -319,8 +310,7 @@ depth + 1); } -DEFUN ("make-font-instance", Fmake_font_instance, Smake_font_instance, - 1, 3, 0 /* +DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* Creates a new `font-instance' object of the specified name. DEVICE specifies the device this object applies to and defaults to the selected device. An error is signalled if the font is unknown or cannot @@ -331,9 +321,8 @@ `deallocate' the font is the way you deallocate any other lisp object: you drop all pointers to it and allow it to be garbage collected. When these objects are GCed, the underlying X data is deallocated as well. -*/ ) - (name, device, no_error) - Lisp_Object name, device, no_error; +*/ + (name, device, no_error)) { struct Lisp_Font_Instance *f; Lisp_Object val; @@ -370,73 +359,63 @@ return val; } -DEFUN ("font-instance-p", Ffont_instance_p, Sfont_instance_p, 1, 1, 0 /* +DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* Return non-nil if OBJECT is a font instance. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (FONT_INSTANCEP (object) ? Qt : Qnil); } -DEFUN ("font-instance-name", Ffont_instance_name, Sfont_instance_name, 1, 1, 0 /* +DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /* Return the name used to allocate FONT-INSTANCE. -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { CHECK_FONT_INSTANCE (font_instance); return (XFONT_INSTANCE (font_instance)->name); } -DEFUN ("font-instance-ascent", Ffont_instance_ascent, - Sfont_instance_ascent, 1, 1, 0 /* +DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /* Return the ascent in pixels of FONT-INSTANCE. The returned value is the maximum ascent for all characters in the font, where a character's ascent is the number of pixels above (and including) the baseline. -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { CHECK_FONT_INSTANCE (font_instance); return make_int (XFONT_INSTANCE (font_instance)->ascent); } -DEFUN ("font-instance-descent", Ffont_instance_descent, - Sfont_instance_descent, 1, 1, 0 /* +DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /* Return the descent in pixels of FONT-INSTANCE. The returned value is the maximum descent for all characters in the font, where a character's descent is the number of pixels below the baseline. (Many characters to do not have any descent. Typical characters with a descent are lowercase p and lowercase g.) -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { CHECK_FONT_INSTANCE (font_instance); return make_int (XFONT_INSTANCE (font_instance)->descent); } -DEFUN ("font-instance-width", Ffont_instance_width, - Sfont_instance_width, 1, 1, 0 /* +DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /* Return the width in pixels of FONT-INSTANCE. The returned value is the average width for all characters in the font. -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { CHECK_FONT_INSTANCE (font_instance); return make_int (XFONT_INSTANCE (font_instance)->width); } -DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, - Sfont_instance_proportional_p, 1, 1, 0 /* +DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /* Return whether FONT-INSTANCE is proportional. This means that different characters in the font have different widths. -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { CHECK_FONT_INSTANCE (font_instance); return (XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil); @@ -451,26 +430,22 @@ (f, errb), f->name); } -DEFUN ("font-instance-truename", Ffont_instance_truename, - Sfont_instance_truename, 1, 1, 0 /* +DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* Return the canonical name of FONT-INSTANCE. Font names are patterns which may match any number of fonts, of which the first found is used. This returns an unambiguous name for that font (but not necessarily its only unambiguous name). -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { CHECK_FONT_INSTANCE (font_instance); return font_instance_truename_internal (font_instance, ERROR_ME); } -DEFUN ("font-instance-properties", Ffont_instance_properties, - Sfont_instance_properties, 1, 1, 0 /* +DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* Return the properties (an alist or nil) of FONT-INSTANCE. -*/ ) - (font_instance) - Lisp_Object font_instance; +*/ + (font_instance)) { struct Lisp_Font_Instance *f; @@ -481,13 +456,12 @@ font_instance_properties, (f)); } -DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 2, 0 /* +DEFUN ("list-fonts", Flist_fonts, 1, 2, 0, /* Return a list of font names matching the given pattern. DEVICE specifies which device to search for names, and defaults to the currently selected device. -*/ ) - (pattern, device) - Lisp_Object pattern, device; +*/ + (pattern, device)) { CHECK_STRING (pattern); XSETDEVICE (device, decode_device (device)); @@ -653,7 +627,7 @@ COLOR_SPECIFIER_FACE_PROPERTY (color) = property; } -DEFUN ("color-specifier-p", Fcolor_specifier_p, Scolor_specifier_p, 1, 1, 0 /* +DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a color specifier. Valid instantiators for color specifiers are: @@ -669,9 +643,8 @@ either `foreground' or `background' (if omitted, defaults to the same property that this color specifier is used for; if this specifier is not part of a face, the instantiator would not be valid) -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (COLOR_SPECIFIERP (object) ? Qt : Qnil); } @@ -791,7 +764,7 @@ FONT_SPECIFIER_FACE_PROPERTY (font) = property; } -DEFUN ("font-specifier-p", Ffont_specifier_p, Sfont_specifier_p, 1, 1, 0 /* +DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a font specifier. Valid instantiators for font specifiers are: @@ -804,9 +777,8 @@ -- a vector of no elements (only on TTY's; this means to set no font at all, thus using the \"natural\" font of the terminal's text) -- a vector of one element (a face to inherit from) -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (FONT_SPECIFIERP (object) ? Qt : Qnil); } @@ -938,8 +910,7 @@ FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; } -DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, - Sface_boolean_specifier_p, 1, 1, 0 /* +DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a face-boolean specifier. Valid instantiators for face-boolean specifiers are @@ -951,9 +922,8 @@ specifier is used for; if this specifier is not part of a face, the instantiator would not be valid), and optionally a value which, if non-nil, means to invert the sense of the inherited property. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil); } @@ -966,28 +936,28 @@ void syms_of_objects (void) { - defsubr (&Scolor_specifier_p); - defsubr (&Sfont_specifier_p); - defsubr (&Sface_boolean_specifier_p); + DEFSUBR (Fcolor_specifier_p); + DEFSUBR (Ffont_specifier_p); + DEFSUBR (Fface_boolean_specifier_p); defsymbol (&Qcolor_instancep, "color-instance-p"); - defsubr (&Smake_color_instance); - defsubr (&Scolor_instance_p); - defsubr (&Scolor_instance_name); - defsubr (&Scolor_instance_rgb_components); - defsubr (&Svalid_color_name_p); + DEFSUBR (Fmake_color_instance); + DEFSUBR (Fcolor_instance_p); + DEFSUBR (Fcolor_instance_name); + DEFSUBR (Fcolor_instance_rgb_components); + DEFSUBR (Fvalid_color_name_p); defsymbol (&Qfont_instancep, "font-instance-p"); - defsubr (&Smake_font_instance); - defsubr (&Sfont_instance_p); - defsubr (&Sfont_instance_name); - defsubr (&Sfont_instance_ascent); - defsubr (&Sfont_instance_descent); - defsubr (&Sfont_instance_width); - defsubr (&Sfont_instance_proportional_p); - defsubr (&Sfont_instance_truename); - defsubr (&Sfont_instance_properties); - defsubr (&Slist_fonts); + DEFSUBR (Fmake_font_instance); + DEFSUBR (Ffont_instance_p); + DEFSUBR (Ffont_instance_name); + DEFSUBR (Ffont_instance_ascent); + DEFSUBR (Ffont_instance_descent); + DEFSUBR (Ffont_instance_width); + DEFSUBR (Ffont_instance_proportional_p); + DEFSUBR (Ffont_instance_truename); + DEFSUBR (Ffont_instance_properties); + DEFSUBR (Flist_fonts); /* Qcolor, Qfont defined in general.c */ defsymbol (&Qface_boolean, "face-boolean");
--- a/src/print.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/print.c Mon Aug 13 08:50:05 2007 +0200 @@ -375,12 +375,11 @@ } -DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0 /* +DEFUN ("write-char", Fwrite_char, 1, 2, 0, /* Output character CH to stream STREAM. STREAM defaults to the value of `standard-output' (which see). -*/ ) - (ch, stream) - Lisp_Object ch, stream; +*/ + (ch, stream)) { /* This function can GC */ Bufbyte str[MAX_EMCHAR_LEN]; @@ -440,8 +439,7 @@ return unbind_to (speccount, arg); } -DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, - 1, UNEVALLED, 0 /* +DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0, /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer. The buffer is cleared out initially, and marked as unmodified when done. All output done by BODY is inserted in that buffer by default. @@ -451,9 +449,8 @@ If variable `temp-buffer-show-function' is non-nil, call it at the end to get the buffer displayed. It gets one argument, the buffer to display. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ struct gcpro gcpro1; @@ -481,12 +478,11 @@ } #endif /* not standalone */ -DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0 /* +DEFUN ("terpri", Fterpri, 0, 1, 0, /* Output a newline to STREAM. If STREAM is omitted or nil, the value of `standard-output' is used. -*/ ) - (stream) - Lisp_Object stream; +*/ + (stream)) { /* This function can GC */ Bufbyte str[1]; @@ -495,14 +491,13 @@ return Qt; } -DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0 /* +DEFUN ("prin1", Fprin1, 1, 2, 0, /* Output the printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). -*/ ) - (object, stream) - Lisp_Object object, stream; +*/ + (object, stream)) { /* This function can GC */ Lisp_Object the_stream = Qnil; @@ -520,14 +515,13 @@ /* a buffer which is used to hold output being built by prin1-to-string */ Lisp_Object Vprin1_to_string_buffer; -DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0 /* +DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /* Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output that `read' can handle, whenever this is possible, unless the optional second argument NOESCAPE is non-nil. -*/ ) - (object, noescape) - Lisp_Object object, noescape; +*/ + (object, noescape)) { /* This function can GC */ Lisp_Object old = Fcurrent_buffer (); @@ -552,14 +546,13 @@ return (object); } -DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0 /* +DEFUN ("princ", Fprinc, 1, 2, 0, /* Output the printed representation of OBJECT, any Lisp object. No quoting characters are used; no delimiters are printed around the contents of strings. Output stream is STREAM, or value of standard-output (which see). -*/ ) - (obj, stream) - Lisp_Object obj, stream; +*/ + (obj, stream)) { /* This function can GC */ Lisp_Object the_stream = Qnil; @@ -574,14 +567,13 @@ return (obj); } -DEFUN ("print", Fprint, Sprint, 1, 2, 0 /* +DEFUN ("print", Fprint, 1, 2, 0, /* Output the printed representation of OBJECT, with newlines around it. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). -*/ ) - (obj, stream) - Lisp_Object obj, stream; +*/ + (obj, stream)) { /* This function can GC */ Lisp_Object the_stream = Qnil; @@ -1160,16 +1152,14 @@ int alternate_do_pointer; char alternate_do_string[5000]; -DEFUN ("alternate-debugging-output", Falternate_debugging_output, - Salternate_debugging_output, 1, 1, 0 /* +DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /* Append CHARACTER to the array `alternate_do_string'. This can be used in place of `external-debugging-output' as a function to be passed to `print'. Before calling `print', set `alternate_do_pointer' to 0. -*/ ) - (character) - Lisp_Object character; +*/ + (character)) { Bufbyte str[MAX_EMCHAR_LEN]; Bytecount len; @@ -1185,8 +1175,7 @@ return character; } -DEFUN ("external-debugging-output", Fexternal_debugging_output, - Sexternal_debugging_output, 1, 3, 0 /* +DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /* Write CHAR-OR-STRING to stderr or stdout. If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write to stderr. You can use this function to write directly to the terminal. @@ -1194,9 +1183,8 @@ If you have opened a termscript file (using `open-termscript'), then the output also will be logged to this file. -*/ ) - (char_or_string, stdout_p, device) - Lisp_Object char_or_string, stdout_p, device; +*/ + (char_or_string, stdout_p, device)) { FILE *file = 0; struct console *con = 0; @@ -1241,13 +1229,11 @@ return char_or_string; } -DEFUN ("open-termscript", Fopen_termscript, Sopen_termscript, - 1, 1, "FOpen termscript file: " /* +DEFUN ("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ", /* Start writing all terminal output to FILE as well as the terminal. FILE = nil means just close any termscript file currently open. -*/ ) - (file) - Lisp_Object file; +*/ + (file)) { /* This function can GC */ if (termscript != 0) @@ -1407,19 +1393,19 @@ defsymbol (&Qprint_length, "print-length"); defsymbol (&Qprint_string_length, "print-string-length"); - defsubr (&Sprin1); - defsubr (&Sprin1_to_string); - defsubr (&Sprinc); - defsubr (&Sprint); - defsubr (&Sterpri); - defsubr (&Swrite_char); - defsubr (&Salternate_debugging_output); + DEFSUBR (Fprin1); + DEFSUBR (Fprin1_to_string); + DEFSUBR (Fprinc); + DEFSUBR (Fprint); + DEFSUBR (Fterpri); + DEFSUBR (Fwrite_char); + DEFSUBR (Falternate_debugging_output); defsymbol (&Qalternate_debugging_output, "alternate-debugging-output"); - defsubr (&Sexternal_debugging_output); - defsubr (&Sopen_termscript); + DEFSUBR (Fexternal_debugging_output); + DEFSUBR (Fopen_termscript); defsymbol (&Qexternal_debugging_output, "external-debugging-output"); #ifndef standalone - defsubr (&Swith_output_to_temp_buffer); + DEFSUBR (Fwith_output_to_temp_buffer); #endif /* not standalone */ }
--- a/src/process.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/process.c Mon Aug 13 08:50:05 2007 +0200 @@ -360,28 +360,26 @@ return p->connected_via_filedesc_p; } -DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0 /* +DEFUN ("processp", Fprocessp, 1, 1, 0, /* Return t if OBJECT is a process. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return ((PROCESSP (obj)) ? Qt : Qnil); } -DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0 /* +DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* Return a list of all processes. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vprocess_list); } -DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0 /* +DEFUN ("get-process", Fget_process, 1, 1, 0, /* Return the process named NAME, or nil if there is none. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { Lisp_Object tail; @@ -403,12 +401,11 @@ return Qnil; } -DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0 /* +DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* Return the (or, a) process associated with BUFFER. BUFFER may be a buffer or the name of one. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { Lisp_Object buf, tail, proc; @@ -475,14 +472,13 @@ return Qnil; /* warning suppression */ } -DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0 /* +DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* Return the process id of PROCESS. This is the pid of the Unix process which PROCESS uses or talks to. For a network connection, this value is a cons of (foreign-network-port . foreign-host-name). -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { Lisp_Object pid; CHECK_PROCESS (proc); @@ -495,25 +491,23 @@ return (pid); } -DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0 /* +DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* Return the name of PROCESS, as a string. This is the name of the program invoked in PROCESS, possibly modified to make it unique among process names. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return XPROCESS (proc)->name; } -DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0 /* +DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* Return the command that was executed to start PROCESS. This is a list of strings, the first string being the program executed and the rest of the strings being the arguments given to it. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return XPROCESS (proc)->command; @@ -1084,8 +1078,7 @@ return Qnil; } -DEFUN ("start-process-internal", Fstart_process_internal, - Sstart_process_internal, 3, MANY, 0 /* +DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* Start a program in a subprocess. Return the process object for it. Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS NAME is name for process. It is modified if necessary to make it unique. @@ -1098,10 +1091,8 @@ Remaining arguments are strings to give program as arguments. INCODE and OUTCODE specify the coding-system objects used in input/output from/to the process. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ @@ -1350,9 +1341,7 @@ connection has no PID; you cannot signal it. All you can do is deactivate and close it via delete-process */ -DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, - Sopen_network_stream_internal, - 4, 4, 0 /* +DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 4, 0, /* Open a TCP connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. @@ -1366,9 +1355,8 @@ Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. -*/ ) - (name, buffer, host, service) - Lisp_Object name, buffer, host, service; +*/ + (name, buffer, host, service)) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ @@ -1528,12 +1516,10 @@ } -DEFUN ("set-process-window-size", Fset_process_window_size, - Sset_process_window_size, 3, 3, 0 /* +DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. -*/ ) - (proc, height, width) - Lisp_Object proc, height, width; +*/ + (proc, height, width)) { CHECK_PROCESS (proc); CHECK_NATNUM (height); @@ -1878,24 +1864,21 @@ UNGCPRO; } -DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0 /* +DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* Return the name of the terminal PROCESS uses, or nil if none. This is the terminal that the process itself reads and writes on, not the name of the pty that Emacs uses to talk with that terminal. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return XPROCESS (proc)->tty_name; } -DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, - 2, 2, 0 /* +DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). -*/ ) - (proc, buffer) - Lisp_Object proc, buffer; +*/ + (proc, buffer)) { CHECK_PROCESS (proc); if (!NILP (buffer)) @@ -1904,25 +1887,21 @@ return buffer; } -DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, - 1, 1, 0 /* +DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* Return the buffer PROCESS is associated with. Output from PROCESS is inserted in this buffer unless PROCESS has a filter. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return XPROCESS (proc)->buffer; } -DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, - 1, 1, 0 /* +DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* Return the marker for the end of the last output from PROCESS. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); #ifdef ENERGIZE @@ -1946,45 +1925,39 @@ XPROCESS (proc)->filter_does_read = filter_does_read; } -DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, - 2, 2, 0 /* +DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* Give PROCESS the filter function FILTER; nil means no filter. t means stop accepting output from the process. When a process has a filter, each time it does output the entire string of output is passed to the filter. The filter gets two arguments: the process and the string of output. If the process has a filter, its buffer is not used for output. -*/ ) - (proc, filter) - Lisp_Object proc, filter; +*/ + (proc, filter)) { set_process_filter (proc, filter, 0); return filter; } -DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, - 1, 1, 0 /* +DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* Return the filter function of PROCESS; nil if none. See `set-process-filter' for more info on filter functions. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return XPROCESS (proc)->filter; } -DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, - 3, 3, 0 /* +DEFUN ("process-send-region", Fprocess_send_region, 3, 3, 0, /* Send current contents of region as input to PROCESS. PROCESS may be a process name or an actual process. Called from program, takes three arguments, PROCESS, START and END. If the region is more than 500 or so characters long, it is sent in several bunches. This may happen even for shorter regions. Output from processes can arrive in between bunches. -*/ ) - (process, start, end) - Lisp_Object process, start, end; +*/ + (process, start, end)) { /* This function can GC */ Lisp_Object proc = get_process (process); @@ -1997,17 +1970,15 @@ return (Qnil); } -DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string, - 2, 4, 0 /* +DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* Send PROCESS the contents of STRING as input. PROCESS may be a process name or an actual process. Optional arguments FROM and TO specify part of STRING, see `substring'. If STRING is more than 500 or so characters long, it is sent in several bunches. This may happen even for shorter strings. Output from processes can arrive in between bunches. -*/ ) - (process, string, from, to) - Lisp_Object process, string, from, to; +*/ + (process, string, from, to)) { /* This function can GC */ Lisp_Object proc; @@ -2070,27 +2041,23 @@ unbind_to (speccount, Qnil); } -DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, - 2, 2, 0 /* +DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* Give PROCESS the sentinel SENTINEL; nil for none. The sentinel is called as a function when the process changes state. It gets two arguments: the process, and a string describing the change. -*/ ) - (proc, sentinel) - Lisp_Object proc, sentinel; +*/ + (proc, sentinel)) { CHECK_PROCESS (proc); XPROCESS (proc)->sentinel = sentinel; return sentinel; } -DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, - 1, 1, 0 /* +DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* Return the sentinel of PROCESS; nil if none. See `set-process-sentinel' for more info on sentinels. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return XPROCESS (proc)->sentinel; @@ -2544,7 +2511,7 @@ UNGCPRO; } -DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0 /* +DEFUN ("process-status", Fprocess_status, 1, 1, 0, /* Return the status of PROCESS. This is a symbol, one of these: @@ -2557,9 +2524,8 @@ nil -- if arg is a process name and no such process exists. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { Lisp_Object status; @@ -2582,13 +2548,11 @@ return (status); } -DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, - 1, 1, 0 /* +DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* Return the exit status of PROCESS or the signal number that killed it. If PROCESS has not yet exited or died, return 0. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return (make_int (XPROCESS (proc)->exit_code)); @@ -2805,7 +2769,7 @@ #endif /* ! defined (TIOCSIGSEND) */ } -DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0 /* +DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* Interrupt process PROCESS. May be process or name of one. Nil or no arg means current buffer's process. Second arg CURRENT-GROUP non-nil means send signal to @@ -2813,21 +2777,19 @@ rather than to the process's own process group. If the process is a shell, this means interrupt current subjob rather than the shell. -*/ ) - (process, current_group) - Lisp_Object process, current_group; +*/ + (process, current_group)) { /* This function can GC */ process_send_signal (process, SIGINT, !NILP (current_group), 0); return process; } -DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0 /* +DEFUN ("kill-process", Fkill_process, 0, 2, 0, /* Kill process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. -*/ ) - (process, current_group) - Lisp_Object process, current_group; +*/ + (process, current_group)) { /* This function can GC */ process_send_signal (process, SIGKILL, !NILP (current_group), @@ -2835,12 +2797,11 @@ return process; } -DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0 /* +DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* Send QUIT signal to process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. -*/ ) - (process, current_group) - Lisp_Object process, current_group; +*/ + (process, current_group)) { /* This function can GC */ process_send_signal (process, SIGQUIT, !NILP (current_group), @@ -2848,12 +2809,11 @@ return process; } -DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0 /* +DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* Stop process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. -*/ ) - (process, current_group) - Lisp_Object process, current_group; +*/ + (process, current_group)) { /* This function can GC */ #ifndef SIGTSTP @@ -2865,12 +2825,11 @@ return process; } -DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0 /* +DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* Continue process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. -*/ ) - (process, current_group) - Lisp_Object process, current_group; +*/ + (process, current_group)) { /* This function can GC */ #ifdef SIGCONT @@ -2882,14 +2841,13 @@ return process; } -DEFUN ("signal-process", Fsignal_process, Ssignal_process, - 2, 2, "nProcess number: \nnSignal code: " /* +DEFUN ("signal-process", Fsignal_process, 2, 2, + "nProcess number: \nnSignal code: ", /* Send the process with process id PID the signal with code SIGCODE. PID must be an integer. The process need not be a child of this Emacs. SIGCODE may be an integer, or a symbol whose name is a signal name. -*/ ) - (pid, sigcode) - Lisp_Object pid, sigcode; +*/ + (pid, sigcode)) { CHECK_INT (pid); @@ -3012,16 +2970,15 @@ #endif } -DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0 /* +DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* Make PROCESS see end-of-file in its input. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process. If PROCESS is a network connection, or is a process communicating through a pipe (as opposed to a pty), then you cannot send any more text to PROCESS after you call this function. -*/ ) - (process) - Lisp_Object process; +*/ + (process)) { /* This function can GC */ Lisp_Object proc; @@ -3122,12 +3079,11 @@ deactivate_process (proc); } -DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0 /* +DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* Delete PROCESS: kill it and forget about it immediately. PROCESS may be a process or the name of one, or a buffer name. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { /* This function can GC */ struct Lisp_Process *p; @@ -3197,14 +3153,12 @@ } #endif /* Unused */ -DEFUN ("process-kill-without-query", Fprocess_kill_without_query, - Sprocess_kill_without_query, 1, 2, 0 /* +DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* Say no query needed if PROCESS is running when Emacs is exited. Optional second argument if non-nil says to require a query. Value is t if a query was formerly required. -*/ ) - (proc, require_query_p) - Lisp_Object proc, require_query_p; +*/ + (proc, require_query_p)) { int tem; @@ -3215,12 +3169,10 @@ return (tem ? Qnil : Qt); } -DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, - Sprocess_kill_without_query_p, 1, 1, 0 /* +DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* Whether PROC will be killed without query if running when emacs is exited. -*/ ) - (proc) - Lisp_Object proc; +*/ + (proc)) { CHECK_PROCESS (proc); return (XPROCESS (proc)->kill_without_query ? Qt : Qnil); @@ -3275,41 +3227,41 @@ defsymbol (&Qopen, "open"); defsymbol (&Qclosed, "closed"); - defsubr (&Sprocessp); - defsubr (&Sget_process); - defsubr (&Sget_buffer_process); - defsubr (&Sdelete_process); - defsubr (&Sprocess_status); - defsubr (&Sprocess_exit_status); - defsubr (&Sprocess_id); - defsubr (&Sprocess_name); - defsubr (&Sprocess_tty_name); - defsubr (&Sprocess_command); - defsubr (&Sset_process_buffer); - defsubr (&Sprocess_buffer); - defsubr (&Sprocess_mark); - defsubr (&Sset_process_filter); - defsubr (&Sprocess_filter); - defsubr (&Sset_process_window_size); - defsubr (&Sset_process_sentinel); - defsubr (&Sprocess_sentinel); - defsubr (&Sprocess_kill_without_query); - defsubr (&Sprocess_kill_without_query_p); - defsubr (&Sprocess_list); - defsubr (&Sstart_process_internal); + DEFSUBR (Fprocessp); + DEFSUBR (Fget_process); + DEFSUBR (Fget_buffer_process); + DEFSUBR (Fdelete_process); + DEFSUBR (Fprocess_status); + DEFSUBR (Fprocess_exit_status); + DEFSUBR (Fprocess_id); + DEFSUBR (Fprocess_name); + DEFSUBR (Fprocess_tty_name); + DEFSUBR (Fprocess_command); + DEFSUBR (Fset_process_buffer); + DEFSUBR (Fprocess_buffer); + DEFSUBR (Fprocess_mark); + DEFSUBR (Fset_process_filter); + DEFSUBR (Fprocess_filter); + DEFSUBR (Fset_process_window_size); + DEFSUBR (Fset_process_sentinel); + DEFSUBR (Fprocess_sentinel); + DEFSUBR (Fprocess_kill_without_query); + DEFSUBR (Fprocess_kill_without_query_p); + DEFSUBR (Fprocess_list); + DEFSUBR (Fstart_process_internal); #ifdef HAVE_SOCKETS - defsubr (&Sopen_network_stream_internal); + DEFSUBR (Fopen_network_stream_internal); #endif /* HAVE_SOCKETS */ - defsubr (&Sprocess_send_region); - defsubr (&Sprocess_send_string); - defsubr (&Sinterrupt_process); - defsubr (&Skill_process); - defsubr (&Squit_process); - defsubr (&Sstop_process); - defsubr (&Scontinue_process); - defsubr (&Sprocess_send_eof); - defsubr (&Ssignal_process); -/* defsubr (&Sprocess_connection); */ + DEFSUBR (Fprocess_send_region); + DEFSUBR (Fprocess_send_string); + DEFSUBR (Finterrupt_process); + DEFSUBR (Fkill_process); + DEFSUBR (Fquit_process); + DEFSUBR (Fstop_process); + DEFSUBR (Fcontinue_process); + DEFSUBR (Fprocess_send_eof); + DEFSUBR (Fsignal_process); +/* DEFSUBR (Fprocess_connection); */ } void
--- a/src/profile.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/profile.c Mon Aug 13 08:50:05 2007 +0200 @@ -97,7 +97,7 @@ } } -DEFUN ("start-profiling", Fstart_profiling, Sstart_profiling, 0, 1, 0 /* +DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /* Start profiling, with profile queries every MICROSECS. If MICROSECS is nil or omitted, the value of `default-profiling-interval' is used. @@ -106,10 +106,9 @@ Starting and stopping profiling does not clear the currently recorded info. Thus you can start and stop as many times as you want and everything -will be properly accumulated. -*/ ) - (microsecs) - Lisp_Object microsecs; +will be properly accumulated. +*/ + (microsecs)) { int msecs; struct itimerval foo; @@ -141,10 +140,10 @@ return Qnil; } -DEFUN ("stop-profiling", Fstop_profiling, Sstop_profiling, 0, 0, 0 /* +DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /* Stop profiling. -*/ ) - () +*/ + ()) { struct itimerval foo; @@ -179,11 +178,10 @@ closure->accum); } -DEFUN ("get-profiling-info", Fget_profiling_info, Sget_profiling_info, - 0, 0, 0 /* +DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* Return the profiling info as an alist. -*/ ) - () +*/ + ()) { struct get_profiling_info_closure closure; @@ -221,22 +219,20 @@ maphash (mark_profiling_info_maphash, big_profile_table, &closure); } -DEFUN ("clear-profiling-info", Fclear_profiling_info, Sclear_profiling_info, - 0, 0, 0 /* +DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, 0, /* Clear out the recorded profiling info. -*/ ) - () +*/ + ()) { if (big_profile_table) clrhash (big_profile_table); return Qnil; } -DEFUN ("profiling-active-p", Fprofiling_active_p, Sprofiling_active_p, - 0, 0, 0 /* +DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /* Return non-nil if profiling information is currently being recorded. -*/ ) - () +*/ + ()) { return profiling_active ? Qt : Qnil; } @@ -244,11 +240,11 @@ void syms_of_profile (void) { - defsubr (&Sstart_profiling); - defsubr (&Sstop_profiling); - defsubr (&Sget_profiling_info); - defsubr (&Sclear_profiling_info); - defsubr (&Sprofiling_active_p); + DEFSUBR (Fstart_profiling); + DEFSUBR (Fstop_profiling); + DEFSUBR (Fget_profiling_info); + DEFSUBR (Fclear_profiling_info); + DEFSUBR (Fprofiling_active_p); } void
--- a/src/puresize.h Mon Aug 13 08:49:44 2007 +0200 +++ b/src/puresize.h Mon Aug 13 08:50:05 2007 +0200 @@ -110,7 +110,7 @@ /* Extra amount of purespace needed for Sunpro builds. */ #ifdef SUNPRO -# define SUNPRO_PURESIZE_EXTRA 40000 +# define SUNPRO_PURESIZE_EXTRA 135000 #else # define SUNPRO_PURESIZE_EXTRA 0 #endif
--- a/src/ralloc.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/ralloc.c Mon Aug 13 08:50:05 2007 +0200 @@ -827,8 +827,7 @@ #define MLVAL(x) (make_int (meter[x])) static int meter[N_Meterables]; -DEFUN ("mmap-allocator-status", Fmmap_allocator_status, - Smmap_allocator_status, 0, 0, 0 /* +DEFUN ("mmap-allocator-status", Fmmap_allocator_status, 0, 0, 0, /* Return some information about mmap-based allocator. mmap-addrlist-size: number of entries in address picking list. @@ -841,8 +840,8 @@ mmap-average-bumpval: average increase in size demanded to re-alloc. mmap-wastage: total number of bytes allocated, but not currently in use. mmap-live-pages: total number of pages live. -*/ ) - () +*/ + ()) { Lisp_Object result; @@ -1279,7 +1278,7 @@ defsymbol (&Qmm_addr_looked_up, "mmap-had-to-look-up-address"); defsymbol (&Qmm_hash_worked, "mmap-hash-table-worked"); defsymbol (&Qmm_addrlist_size, "mmap-addrlist-size"); - defsubr (&Smmap_allocator_status); + DEFSUBR (Fmmap_allocator_status); #endif /* MMAP_METERING */ }
--- a/src/rangetab.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/rangetab.c Mon Aug 13 08:50:05 2007 +0200 @@ -222,21 +222,20 @@ return defalt; } -DEFUN ("range-table-p", Frange_table_p, Srange_table_p, 1, 1, 0 /* +DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /* Return non-nil if OBJECT is a range table. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (RANGE_TABLEP (object) ? Qt : Qnil); } -DEFUN ("make-range-table", Fmake_range_table, Smake_range_table, 0, 0, 0 /* +DEFUN ("make-range-table", Fmake_range_table, 0, 0, 0, /* Make a new, empty range table. You can manipulate it using `put-range-table', `get-range-table', `remove-range-table', and `clear-range-table'. -*/ ) - () +*/ + ()) { struct Lisp_Range_Table *rt; Lisp_Object obj; @@ -248,12 +247,11 @@ return obj; } -DEFUN ("copy-range-table", Fcopy_range_table, Scopy_range_table, 1, 1, 0 /* +DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* Make a new range table which contains the same values for the same ranges as the given table. The values will not themselves be copied. -*/ ) - (old_table) - Lisp_Object old_table; +*/ + (old_table)) { struct Lisp_Range_Table *rt, *rtnew; Lisp_Object obj = Qnil; @@ -270,12 +268,11 @@ return obj; } -DEFUN ("get-range-table", Fget_range_table, Sget_range_table, 2, 3, 0 /* +DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* Find value for position POS in TABLE. If there is no corresponding value, return DEFAULT (defaults to nil). -*/ ) - (pos, table, defalt) - Lisp_Object pos, table, defalt;/* Man kann in C nicht selber buchstabieren */ +*/ + (pos, table, defalt)) { struct Lisp_Range_Table *rt; EMACS_INT po; @@ -414,11 +411,10 @@ } } -DEFUN ("put-range-table", Fput_range_table, Sput_range_table, 4, 4, 0 /* +DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /* Set the value for range (START, END) to be VAL in TABLE. -*/ ) - (start, end, val, table) - Lisp_Object start, end, val, table; +*/ + (start, end, val, table)) { EMACS_INT first, last; @@ -435,32 +431,29 @@ return Qnil; } -DEFUN ("remove-range-table", Fremove_range_table, Sremove_range_table, 3, 3, 0 /* +DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /* Remove the value for range (START, END) in TABLE. -*/ ) - (start, end, table) - Lisp_Object start, end, table; +*/ + (start, end, table)) { return Fput_range_table (start, end, Qunbound, table); } -DEFUN ("clear-range-table", Fclear_range_table, Sclear_range_table, 1, 1, 0 /* +DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /* Flush TABLE. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { CHECK_RANGE_TABLE (table); Dynarr_reset (XRANGE_TABLE (table)->entries); return Qnil; } -DEFUN ("map-range-table", Fmap_range_table, Smap_range_table, 2, 2, 0 /* +DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* Map FUNCTION over entries in TABLE, calling it with three args, the beginning and end of the range and the corresponding value. -*/ ) - (function, table) - Lisp_Object function, table; +*/ + (function, table)) { error ("not yet implemented"); return Qnil; @@ -723,14 +716,14 @@ defsymbol (&Qrange_tablep, "range-table-p"); defsymbol (&Qrange_table, "range-table"); - defsubr (&Srange_table_p); - defsubr (&Smake_range_table); - defsubr (&Scopy_range_table); - defsubr (&Sget_range_table); - defsubr (&Sput_range_table); - defsubr (&Sremove_range_table); - defsubr (&Sclear_range_table); - defsubr (&Smap_range_table); + DEFSUBR (Frange_table_p); + DEFSUBR (Fmake_range_table); + DEFSUBR (Fcopy_range_table); + DEFSUBR (Fget_range_table); + DEFSUBR (Fput_range_table); + DEFSUBR (Fremove_range_table); + DEFSUBR (Fclear_range_table); + DEFSUBR (Fmap_range_table); } void
--- a/src/redisplay.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 08:50:05 2007 +0200 @@ -105,6 +105,10 @@ Used to optimize some lookups -- we only have to do some things when the charset changes. */ + face_index last_findex; /* The face index of the previous character. + Needed to ensure the validity of the + last_charset optimization. */ + int last_char_width; /* The width of the previous character. */ int font_is_bogus; /* If true, it means we couldn't instantiate the font for this charset, so we substitute @@ -847,7 +851,8 @@ else { Lisp_Object charset = CHAR_CHARSET (data->ch); - if (!EQ (charset, data->last_charset)) + if (!EQ (charset, data->last_charset) || + data->findex != data->last_findex) { /* OK, we need to do things the hard way. */ struct window *w = XWINDOW (data->window); @@ -873,8 +878,8 @@ data->last_char_width = -1; data->new_ascent = max (data->new_ascent, (int) fi->ascent); data->new_descent = max (data->new_descent, (int) fi->descent); - /* The following line causes display goobers and I don't know why */ - /*data->last_charset = charset;*/ + data->last_charset = charset; + data->last_findex = data->findex; } width = data->last_char_width; @@ -1874,6 +1879,7 @@ data.bi_bufpos = bi_start_pos; data.pixpos = dl->bounds.left_in; data.last_charset = Qunbound; + data.last_findex = DEFAULT_INDEX; data.result_str = Qnil; /* Set the right boundary adjusting it to take into account any end @@ -2640,6 +2646,7 @@ data.cursor_x = -1; data.findex = DEFAULT_INDEX; data.last_charset = Qunbound; + data.last_findex = DEFAULT_INDEX; data.result_str = Qnil; Dynarr_reset (data.db->runes); @@ -3567,6 +3574,7 @@ data.max_pixpos = max_pixpos; data.cursor_type = NO_CURSOR; data.last_charset = Qunbound; + data.last_findex = DEFAULT_INDEX; data.result_str = result_str; data.is_modeline = 1; XSETWINDOW (data.window, w); @@ -7715,11 +7723,10 @@ /* */ /***************************************************************************/ -DEFUN ("redisplay-echo-area", Fredisplay_echo_area, Sredisplay_echo_area, - 0, 0, 0 /* +DEFUN ("redisplay-echo-area", Fredisplay_echo_area, 0, 0, 0, /* Ensure that all minibuffers are correctly showing the echo area. -*/ ) - () +*/ + ()) { Lisp_Object devcons, concons; @@ -7757,15 +7764,14 @@ return Qnil; } -DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 0, 2, 0 /* +DEFUN ("redraw-frame", Fredraw_frame, 0, 2, 0, /* Clear frame FRAME and output again what is supposed to appear on it. FRAME defaults to the selected frame if omitted. Normally, redisplay is preempted as normal if input arrives. However, if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for input and is guaranteed to proceed to completion. -*/ ) - (frame, no_preempt) - Lisp_Object frame, no_preempt; +*/ + (frame, no_preempt)) { struct frame *f = decode_frame (frame); int count = specpdl_depth (); @@ -7783,7 +7789,7 @@ return unbind_to (count, Qnil); } -DEFUN ("redisplay-frame", Fredisplay_frame, Sredisplay_frame, 0, 2, 0 /* +DEFUN ("redisplay-frame", Fredisplay_frame, 0, 2, 0, /* Ensure that FRAME's contents are correctly displayed. This differs from `redraw-frame' in that it only redraws what needs to be updated, as opposed to unconditionally clearing and redrawing @@ -7792,9 +7798,8 @@ Normally, redisplay is preempted as normal if input arrives. However, if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for input and is guaranteed to proceed to completion. -*/ ) - (frame, no_preempt) - Lisp_Object frame, no_preempt; +*/ + (frame, no_preempt)) { struct frame *f = decode_frame (frame); int count = specpdl_depth (); @@ -7811,15 +7816,14 @@ return unbind_to (count, Qnil); } -DEFUN ("redraw-device", Fredraw_device, Sredraw_device, 0, 2, 0 /* +DEFUN ("redraw-device", Fredraw_device, 0, 2, 0, /* Clear device DEVICE and output again what is supposed to appear on it. DEVICE defaults to the selected device if omitted. Normally, redisplay is preempted as normal if input arrives. However, if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for input and is guaranteed to proceed to completion. -*/ ) - (device, no_preempt) - Lisp_Object device, no_preempt; +*/ + (device, no_preempt)) { struct device *d = decode_device (device); Lisp_Object frmcons; @@ -7841,7 +7845,7 @@ return unbind_to (count, Qnil); } -DEFUN ("redisplay-device", Fredisplay_device, Sredisplay_device, 0, 2, 0 /* +DEFUN ("redisplay-device", Fredisplay_device, 0, 2, 0, /* Ensure that DEVICE's contents are correctly displayed. This differs from `redraw-device' in that it only redraws what needs to be updated, as opposed to unconditionally clearing and redrawing @@ -7850,9 +7854,8 @@ Normally, redisplay is preempted as normal if input arrives. However, if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for input and is guaranteed to proceed to completion. -*/ ) - (device, no_preempt) - Lisp_Object device, no_preempt; +*/ + (device, no_preempt)) { struct device *d = decode_device (device); int count = specpdl_depth (); @@ -7872,24 +7875,21 @@ /* Big lie. Big lie. This will force all modelines to be updated regardless if the all flag is set or not. It remains in existence solely for backwards compatibility. */ -DEFUN ("redraw-modeline", Fredraw_modeline, Sredraw_modeline, 0, 1, 0 /* +DEFUN ("redraw-modeline", Fredraw_modeline, 0, 1, 0, /* Force the modeline of the current buffer to be redisplayed. With optional non-nil ALL, force redisplay of all modelines. -*/ ) - (all) - Lisp_Object all; +*/ + (all)) { MARK_MODELINE_CHANGED; return Qnil; } -DEFUN ("force-cursor-redisplay", Fforce_cursor_redisplay, - Sforce_cursor_redisplay, 0, 1, 0 /* +DEFUN ("force-cursor-redisplay", Fforce_cursor_redisplay, 0, 1, 0, /* Force an immediate update of the cursor on FRAME. FRAME defaults to the selected frame if omitted. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { redisplay_redraw_cursor (decode_frame (frame), 1); return Qnil; @@ -8113,13 +8113,13 @@ defsymbol (&Qredisplay_end_trigger_functions, "redisplay-end-trigger-functions"); - defsubr (&Sredisplay_echo_area); - defsubr (&Sredraw_frame); - defsubr (&Sredisplay_frame); - defsubr (&Sredraw_device); - defsubr (&Sredisplay_device); - defsubr (&Sredraw_modeline); - defsubr (&Sforce_cursor_redisplay); + DEFSUBR (Fredisplay_echo_area); + DEFSUBR (Fredraw_frame); + DEFSUBR (Fredisplay_frame); + DEFSUBR (Fredraw_device); + DEFSUBR (Fredisplay_device); + DEFSUBR (Fredraw_modeline); + DEFSUBR (Fforce_cursor_redisplay); } void
--- a/src/scrollbar-x.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/scrollbar-x.c Mon Aug 13 08:50:05 2007 +0200 @@ -46,7 +46,7 @@ scrollbar is incredibly stupid about updating the thumb and causes lots of flicker if it is done too often. */ static int inhibit_thumb_size_change; -int stupid_vertical_scrollbar_drag_hack = 1; +int stupid_vertical_scrollbar_drag_hack; /* Doesn't work with athena */ #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) @@ -597,8 +597,9 @@ SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) = data->slider_value; SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance) = XINT (Fwindow_start (win)); +#else + stupid_vertical_scrollbar_drag_hack = 0; #endif - stupid_vertical_scrollbar_drag_hack = 0; break; case SCROLLBAR_DRAG: @@ -857,4 +858,5 @@ #elif defined (LWLIB_SCROLLBARS_ATHENA) Fprovide (intern ("athena-scrollbars")); #endif + stupid_vertical_scrollbar_drag_hack = 1; }
--- a/src/scrollbar.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/scrollbar.c Mon Aug 13 08:50:05 2007 +0200 @@ -675,14 +675,13 @@ } } -DEFUN ("scrollbar-line-up", Fscrollbar_line_up, Sscrollbar_line_up, 1, 1, 0 /* +DEFUN ("scrollbar-line-up", Fscrollbar_line_up, 1, 1, 0, /* Function called when the line-up arrow on the scrollbar is clicked. This is the little arrow at the top of the scrollbar. One argument, the scrollbar's window. You can advise this function to change the scrollbar behavior. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { CHECK_LIVE_WINDOW (window); window_scroll (window, make_int (1), -1, ERROR_ME_NOT); @@ -690,15 +689,13 @@ return Qnil; } -DEFUN ("scrollbar-line-down", Fscrollbar_line_down, Sscrollbar_line_down, - 1, 1, 0 /* +DEFUN ("scrollbar-line-down", Fscrollbar_line_down, 1, 1, 0, /* Function called when the line-down arrow on the scrollbar is clicked. This is the little arrow at the bottom of the scrollbar. One argument, the scrollbar's window. You can advise this function to change the scrollbar behavior. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { CHECK_LIVE_WINDOW (window); window_scroll (window, make_int (1), 1, ERROR_ME_NOT); @@ -706,17 +703,15 @@ return Qnil; } -DEFUN ("scrollbar-page-up", Fscrollbar_page_up, Sscrollbar_page_up, - 1, 1, 0 /* +DEFUN ("scrollbar-page-up", Fscrollbar_page_up, 1, 1, 0, /* Function called when the user gives the \"page-up\" scrollbar action. (The way this is done can vary from scrollbar to scrollbar.) One argument, a cons containing the scrollbar's window and a value (#### document me! This value is nil for Motif/Lucid scrollbars and a number for Athena scrollbars). You can advise this function to change the scrollbar behavior. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { Lisp_Object window = Fcar (object); @@ -749,17 +744,15 @@ return Qnil; } -DEFUN ("scrollbar-page-down", Fscrollbar_page_down, Sscrollbar_page_down, - 1, 1, 0 /* +DEFUN ("scrollbar-page-down", Fscrollbar_page_down, 1, 1, 0, /* Function called when the user gives the \"page-down\" scrollbar action. (The way this is done can vary from scrollbar to scrollbar.) One argument, a cons containing the scrollbar's window and a value (#### document me! This value is nil for Motif/Lucid scrollbars and a number for Athena scrollbars). You can advise this function to change the scrollbar behavior. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { Lisp_Object window = Fcar (object); @@ -783,15 +776,13 @@ return Qnil; } -DEFUN ("scrollbar-to-top", Fscrollbar_to_top, Sscrollbar_to_top, - 1, 1, 0 /* +DEFUN ("scrollbar-to-top", Fscrollbar_to_top, 1, 1, 0, /* Function called when the user gives the \"to-top\" scrollbar action. (The way this is done can vary from scrollbar to scrollbar.). One argument, the scrollbar's window. You can advise this function to change the scrollbar behavior. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { Lisp_Object orig_pt; @@ -803,15 +794,13 @@ return Qnil; } -DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, Sscrollbar_to_bottom, - 1, 1, 0 /* +DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, 1, 1, 0, /* Function called when the user gives the \"to-bottom\" scrollbar action. (The way this is done can vary from scrollbar to scrollbar.). One argument, the scrollbar's window. You can advise this function to change the scrollbar behavior. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { Lisp_Object orig_pt; @@ -823,15 +812,13 @@ return Qnil; } -DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag, - Sscrollbar_vertical_drag, 1, 1, 0 /* +DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag, 1, 1, 0, /* Function called when the user drags the vertical scrollbar thumb. One argument, a cons containing the scrollbar's window and a value between point-min and point-max. You can advise this function to change the scrollbar behavior. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { Bufpos start_pos; Lisp_Object orig_pt; @@ -847,13 +834,11 @@ return Qnil; } -DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, Sscrollbar_set_hscroll, - 2, 2, 0 /* +DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, 2, 2, 0, /* Sets WINDOW's hscroll position to VALUE. This ensures that VALUE is in the proper range for the horizontal scrollbar. -*/ ) - (window, value) - Lisp_Object window, value; +*/ + (window, value)) { struct window *w; int hscroll, wcw, max_len; @@ -911,15 +896,15 @@ /* #### All these functions should be moved into Lisp. See comment above. */ - defsubr (&Sscrollbar_line_up); - defsubr (&Sscrollbar_line_down); - defsubr (&Sscrollbar_page_up); - defsubr (&Sscrollbar_page_down); - defsubr (&Sscrollbar_to_top); - defsubr (&Sscrollbar_to_bottom); - defsubr (&Sscrollbar_vertical_drag); + DEFSUBR (Fscrollbar_line_up); + DEFSUBR (Fscrollbar_line_down); + DEFSUBR (Fscrollbar_page_up); + DEFSUBR (Fscrollbar_page_down); + DEFSUBR (Fscrollbar_to_top); + DEFSUBR (Fscrollbar_to_bottom); + DEFSUBR (Fscrollbar_vertical_drag); - defsubr (&Sscrollbar_set_hscroll); + DEFSUBR (Fscrollbar_set_hscroll); } void
--- a/src/search.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/search.c Mon Aug 13 08:50:05 2007 +0200 @@ -314,21 +314,20 @@ return val; } -DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 2, 0 /* +DEFUN ("looking-at", Flooking_at, 1, 2, 0, /* Return t if text after point matches regular expression REGEXP. This function modifies the match data that `match-beginning', `match-end' and `match-data' access; save and restore the match data if you want to preserve them. Optional argument BUFFER defaults to the current buffer. -*/ ) - (regexp, buffer) - Lisp_Object regexp, buffer; +*/ + (regexp, buffer)) { return looking_at_1 (regexp, decode_buffer (buffer, 0), 0); } -DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 2, 0 /* +DEFUN ("posix-looking-at", Fposix_looking_at, 1, 2, 0, /* Return t if text after point matches regular expression REGEXP. Find the longest match, in accord with Posix regular expression rules. This function modifies the match data that `match-beginning', @@ -336,9 +335,8 @@ data if you want to preserve them. Optional argument BUFFER defaults to the current buffer. -*/ ) - (regexp, buffer) - Lisp_Object regexp, buffer; +*/ + (regexp, buffer)) { return looking_at_1 (regexp, decode_buffer (buffer, 0), 1); } @@ -394,7 +392,7 @@ return make_int (bytecount_to_charcount (XSTRING_DATA (string), val)); } -DEFUN ("string-match", Fstring_match, Sstring_match, 2, 4, 0 /* +DEFUN ("string-match", Fstring_match, 2, 4, 0, /* Return index of start of first match for REGEXP in STRING, or nil. If third arg START is non-nil, start search at that index in STRING. For index of first char beyond the match, do (match-end 0). @@ -404,14 +402,13 @@ Optional arg BUFFER controls how case folding is done (according to the value of `case-fold-search' in that buffer and that buffer's case tables) and defaults to the current buffer. -*/ ) - (regexp, string, start, buffer) - Lisp_Object regexp, string, start, buffer; +*/ + (regexp, string, start, buffer)) { return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 0); } -DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 4, 0 /* +DEFUN ("posix-string-match", Fposix_string_match, 2, 4, 0, /* Return index of start of first match for REGEXP in STRING, or nil. Find the longest match, in accord with Posix regular expression rules. If third arg START is non-nil, start search at that index in STRING. @@ -422,9 +419,8 @@ Optional arg BUFFER controls how case folding is done (according to the value of `case-fold-search' in that buffer and that buffer's case tables) and defaults to the current buffer. -*/ ) - (regexp, string, start, buffer) - Lisp_Object regexp, string, start, buffer; +*/ + (regexp, string, start, buffer)) { return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 1); } @@ -846,7 +842,7 @@ } } -DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 3, 0 /* +DEFUN ("skip-chars-forward", Fskip_chars_forward, 1, 3, 0, /* Move point forward, stopping before a char not in STRING, or at pos LIM. STRING is like the inside of a `[...]' in a regular expression except that `]' is never special and `\\' quotes `^', `-' or `\\'. @@ -855,28 +851,26 @@ Returns the distance traveled, either zero or positive. Optional argument BUFFER defaults to the current buffer. -*/ ) - (string, lim, buffer) - Lisp_Object string, lim, buffer; +*/ + (string, lim, buffer)) { return skip_chars (decode_buffer (buffer, 0), 1, 0, string, lim); } -DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 3, 0 /* +DEFUN ("skip-chars-backward", Fskip_chars_backward, 1, 3, 0, /* Move point backward, stopping after a char not in STRING, or at pos LIM. See `skip-chars-forward' for details. Returns the distance traveled, either zero or negative. Optional argument BUFFER defaults to the current buffer. -*/ ) - (string, lim, buffer) - Lisp_Object string, lim, buffer; +*/ + (string, lim, buffer)) { return skip_chars (decode_buffer (buffer, 0), 0, 0, string, lim); } -DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 3, 0 /* +DEFUN ("skip-syntax-forward", Fskip_syntax_forward, 1, 3, 0, /* Move point forward across chars in specified syntax classes. SYNTAX is a string of syntax code characters. Stop before a char whose syntax is not in SYNTAX, or at position LIM. @@ -884,14 +878,13 @@ This function returns the distance traveled, either zero or positive. Optional argument BUFFER defaults to the current buffer. -*/ ) - (syntax, lim, buffer) - Lisp_Object syntax, lim, buffer; +*/ + (syntax, lim, buffer)) { return skip_chars (decode_buffer (buffer, 0), 1, 1, syntax, lim); } -DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 3, 0 /* +DEFUN ("skip-syntax-backward", Fskip_syntax_backward, 1, 3, 0, /* Move point backward across chars in specified syntax classes. SYNTAX is a string of syntax code characters. Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM. @@ -899,9 +892,8 @@ This function returns the distance traveled, either zero or negative. Optional argument BUFFER defaults to the current buffer. -*/ ) - (syntax, lim, buffer) - Lisp_Object syntax, lim, buffer; +*/ + (syntax, lim, buffer)) { return skip_chars (decode_buffer (buffer, 0), 0, 1, syntax, lim); } @@ -1554,8 +1546,7 @@ } } -DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 5, - "sSearch backward: " /* +DEFUN ("search-backward", Fsearch_backward, 1, 5, "sSearch backward: ", /* Search backward from point for STRING. Set point to the beginning of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -1566,14 +1557,13 @@ Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. See also the functions `match-beginning', `match-end' and `replace-match'. -*/ ) - (string, bound, no_error, count, buffer) - Lisp_Object string, bound, no_error, count, buffer; +*/ + (string, bound, no_error, count, buffer)) { return search_command (string, bound, no_error, count, buffer, -1, 0, 0); } -DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 5, "sSearch: " /* +DEFUN ("search-forward", Fsearch_forward, 1, 5, "sSearch: ", /* Search forward from point for STRING. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -1585,16 +1575,14 @@ Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. See also the functions `match-beginning', `match-end' and `replace-match'. -*/ ) - (string, bound, no_error, count, buffer) - Lisp_Object string, bound, no_error, count, buffer; +*/ + (string, bound, no_error, count, buffer)) { return search_command (string, bound, no_error, count, buffer, 1, 0, 0); } -DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, - 1, 5, - "sWord search backward: " /* +DEFUN ("word-search-backward", Fword_search_backward, 1, 5, + "sWord search backward: ", /* Search backward from point for STRING, ignoring differences in punctuation. Set point to the beginning of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -1604,16 +1592,14 @@ Optional fourth argument is repeat count--search for successive occurrences. Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. -*/ ) - (string, bound, no_error, count, buffer) - Lisp_Object string, bound, no_error, count, buffer; +*/ + (string, bound, no_error, count, buffer)) { return search_command (wordify (buffer, string), bound, no_error, count, buffer, -1, 1, 0); } -DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 5, - "sWord search: " /* +DEFUN ("word-search-forward", Fword_search_forward, 1, 5, "sWord search: ", /* Search forward from point for STRING, ignoring differences in punctuation. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -1623,16 +1609,15 @@ Optional fourth argument is repeat count--search for successive occurrences. Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. -*/ ) - (string, bound, no_error, count, buffer) - Lisp_Object string, bound, no_error, count, buffer; +*/ + (string, bound, no_error, count, buffer)) { return search_command (wordify (buffer, string), bound, no_error, count, buffer, 1, 1, 0); } -DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 5, - "sRE search backward: " /* +DEFUN ("re-search-backward", Fre_search_backward, 1, 5, + "sRE search backward: ", /* Search backward from point for match for regular expression REGEXP. Set point to the beginning of the match, and return point. The match found is the one starting last in the buffer @@ -1645,15 +1630,13 @@ Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. See also the functions `match-beginning', `match-end' and `replace-match'. -*/ ) - (regexp, bound, no_error, count, buffer) - Lisp_Object regexp, bound, no_error, count, buffer; +*/ + (regexp, bound, no_error, count, buffer)) { return search_command (regexp, bound, no_error, count, buffer, -1, 1, 0); } -DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 5, - "sRE search: " /* +DEFUN ("re-search-forward", Fre_search_forward, 1, 5, "sRE search: ", /* Search forward from point for regular expression REGEXP. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -1664,16 +1647,14 @@ Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. See also the functions `match-beginning', `match-end' and `replace-match'. -*/ ) - (regexp, bound, no_error, count, buffer) - Lisp_Object regexp, bound, no_error, count, buffer; +*/ + (regexp, bound, no_error, count, buffer)) { return search_command (regexp, bound, no_error, count, buffer, 1, 1, 0); } -DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, - 1, 5, - "sPosix search backward: " /* +DEFUN ("posix-search-backward", Fposix_search_backward, 1, 5, + "sPosix search backward: ", /* Search backward from point for match for regular expression REGEXP. Find the longest match in accord with Posix regular expression rules. Set point to the beginning of the match, and return point. @@ -1687,16 +1668,14 @@ Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. See also the functions `match-beginning', `match-end' and `replace-match'. -*/ ) - (regexp, bound, no_error, count, buffer) - Lisp_Object regexp, bound, no_error, count, buffer; +*/ + (regexp, bound, no_error, count, buffer)) { return search_command (regexp, bound, no_error, count, buffer, -1, 1, 1); } -DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, - 1, 5, - "sPosix search: " /* +DEFUN ("posix-search-forward", Fposix_search_forward, 1, 5, + "sPosix search: ", /* Search forward from point for regular expression REGEXP. Find the longest match in accord with Posix regular expression rules. Set point to the end of the occurrence found, and return point. @@ -1708,9 +1687,8 @@ Optional fifth argument BUFFER specifies the buffer to search in and defaults to the current buffer. See also the functions `match-beginning', `match-end' and `replace-match'. -*/ ) - (regexp, bound, no_error, count, buffer) - Lisp_Object regexp, bound, no_error, count, buffer; +*/ + (regexp, bound, no_error, count, buffer)) { return search_command (regexp, bound, no_error, count, buffer, 1, 1, 1); } @@ -1727,7 +1705,7 @@ return Qnil; } -DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0 /* +DEFUN ("replace-match", Freplace_match, 1, 5, 0, /* Replace text matched by last search with NEWTEXT. If second arg FIXEDCASE is non-nil, do not alter case of replacement text. Otherwise maybe capitalize the whole text, or maybe just word initials, @@ -1761,9 +1739,8 @@ defaults to the current buffer. (When fourth argument is not a string, the buffer that the match occurred in has automatically been remembered and you do not need to specify it.) -*/ ) - (newtext, fixedcase, literal, string, strbuffer) - Lisp_Object newtext, fixedcase, literal, string, strbuffer; +*/ + (newtext, fixedcase, literal, string, strbuffer)) { /* This function has been Mule-ized. */ /* This function can GC */ @@ -2203,38 +2180,36 @@ : search_regs.end[n])); } -DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0 /* +DEFUN ("match-beginning", Fmatch_beginning, 1, 1, 0, /* Return position of start of text matched by last regexp search. NUM, specifies which parenthesized expression in the last regexp. Value is nil if NUMth pair didn't match, or there were less than NUM pairs. Zero means the entire text matched by the whole regexp or whole string. -*/ ) - (num) - Lisp_Object num; +*/ + (num)) { return match_limit (num, 1); } -DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0 /* +DEFUN ("match-end", Fmatch_end, 1, 1, 0, /* Return position of end of text matched by last regexp search. NUM specifies which parenthesized expression in the last regexp. Value is nil if NUMth pair didn't match, or there were less than NUM pairs. Zero means the entire text matched by the whole regexp or whole string. -*/ ) - (num) - Lisp_Object num; +*/ + (num)) { return match_limit (num, 0); } -DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0 /* +DEFUN ("match-data", Fmatch_data, 0, 0, 0, /* Return a list containing all info on what the last regexp search matched. Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'. All the elements are markers or nil (nil if the Nth pair didn't match) if the last match was on a buffer; integers or nil if a string was matched. Use `store-match-data' to reinstate the data in this list. -*/ ) - () +*/ + ()) { /* This function has been Mule-ized. */ Lisp_Object *data; @@ -2282,12 +2257,11 @@ } -DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0 /* +DEFUN ("store-match-data", Fstore_match_data, 1, 1, 0, /* Set internal data on last search match from elements of LIST. LIST should have been created by calling `match-data' previously. -*/ ) - (list) - Lisp_Object list; +*/ + (list)) { /* This function has been Mule-ized. */ register int i; @@ -2409,11 +2383,10 @@ /* Quote a string to inactivate reg-expr chars */ -DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0 /* +DEFUN ("regexp-quote", Fregexp_quote, 1, 1, 0, /* Return a regexp string which matches exactly STRING and nothing else. -*/ ) - (str) - Lisp_Object str; +*/ + (str)) { /* This function has been Mule-ized. */ register Bufbyte *in, *out, *end; @@ -2454,28 +2427,28 @@ deferror (&Qsearch_failed, "search-failed", "Search failed", Qerror); deferror (&Qinvalid_regexp, "invalid-regexp", "Invalid regexp", Qerror); - defsubr (&Slooking_at); - defsubr (&Sposix_looking_at); - defsubr (&Sstring_match); - defsubr (&Sposix_string_match); - defsubr (&Sskip_chars_forward); - defsubr (&Sskip_chars_backward); - defsubr (&Sskip_syntax_forward); - defsubr (&Sskip_syntax_backward); - defsubr (&Ssearch_forward); - defsubr (&Ssearch_backward); - defsubr (&Sword_search_forward); - defsubr (&Sword_search_backward); - defsubr (&Sre_search_forward); - defsubr (&Sre_search_backward); - defsubr (&Sposix_search_forward); - defsubr (&Sposix_search_backward); - defsubr (&Sreplace_match); - defsubr (&Smatch_beginning); - defsubr (&Smatch_end); - defsubr (&Smatch_data); - defsubr (&Sstore_match_data); - defsubr (&Sregexp_quote); + DEFSUBR (Flooking_at); + DEFSUBR (Fposix_looking_at); + DEFSUBR (Fstring_match); + DEFSUBR (Fposix_string_match); + DEFSUBR (Fskip_chars_forward); + DEFSUBR (Fskip_chars_backward); + DEFSUBR (Fskip_syntax_forward); + DEFSUBR (Fskip_syntax_backward); + DEFSUBR (Fsearch_forward); + DEFSUBR (Fsearch_backward); + DEFSUBR (Fword_search_forward); + DEFSUBR (Fword_search_backward); + DEFSUBR (Fre_search_forward); + DEFSUBR (Fre_search_backward); + DEFSUBR (Fposix_search_forward); + DEFSUBR (Fposix_search_backward); + DEFSUBR (Freplace_match); + DEFSUBR (Fmatch_beginning); + DEFSUBR (Fmatch_end); + DEFSUBR (Fmatch_data); + DEFSUBR (Fstore_match_data); + DEFSUBR (Fregexp_quote); } void
--- a/src/signal.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/signal.c Mon Aug 13 08:50:05 2007 +0200 @@ -343,16 +343,14 @@ } #endif -DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, - Swaiting_for_user_input_p, - 0, 0, 0 /* +DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, 0, 0, 0, /* Return non-nil if XEmacs is waiting for input from the user. This is intended for use by asynchronous timeout callbacks and by asynchronous process output filters and sentinels (not yet implemented in XEmacs). It will always be nil if XEmacs is not inside of an asynchronout timeout or process callback. -*/ ) - () +*/ + ()) { return ((waiting_for_user_input_p) ? Qt : Qnil); } @@ -740,7 +738,7 @@ void syms_of_signal (void) { - defsubr (&Swaiting_for_user_input_p); + DEFSUBR (Fwaiting_for_user_input_p); } void
--- a/src/sound.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/sound.c Mon Aug 13 08:50:05 2007 +0200 @@ -66,16 +66,14 @@ Lisp_Object Qnas; #endif -DEFUN ("play-sound-file", Fplay_sound_file, Splay_sound_file, - 1, 3, "fSound file name: " /* +DEFUN ("play-sound-file", Fplay_sound_file, 1, 3, "fSound file name: ", /* Play the named sound file on DEVICE's speaker at the specified volume (0-100, default specified by the `bell-volume' variable). The sound file must be in the Sun/NeXT U-LAW format except under Linux where WAV files are also supported. DEVICE defaults to the selected device. -*/ ) - (file, volume, device) - Lisp_Object file, volume, device; +*/ + (file, volume, device)) { /* This function can GC */ int vol; @@ -227,12 +225,11 @@ } } -DEFUN ("play-sound", Fplay_sound, Splay_sound, 1, 3, 0 /* +DEFUN ("play-sound", Fplay_sound, 1, 3, 0, /* Play a sound of the provided type. See the variable `sound-alist'. -*/ ) - (sound, volume, device) - Lisp_Object sound, volume, device; +*/ + (sound, volume, device)) { int looking_for_default = 0; /* variable `sound' is anything that can be a cdr in sound-alist */ @@ -308,11 +305,10 @@ return Qnil; } -DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, Sdevice_sound_enabled_p, 0, 1, 0 /* +DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, 0, 1, 0, /* Return T iff DEVICE is able to play sound. Defaults to selected device. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device(device); @@ -327,16 +323,15 @@ return Qnil; } -DEFUN ("ding", Fding, Sding, 0, 3, 0 /* +DEFUN ("ding", Fding, 0, 3, 0, /* Beep, or flash the frame. Also, unless an argument is given, terminate any keyboard macro currently executing. When called from lisp, the second argument is what sound to make, and the third argument is the device to make it in (defaults to the selected device). -*/ ) - (arg, sound, device) - Lisp_Object arg, sound, device; +*/ + (arg, sound, device)) { struct device *d = decode_device (device); @@ -352,13 +347,10 @@ return Qnil; } -DEFUN ("wait-for-sounds", Fwait_for_sounds, Swait_for_sounds, - 0, 1, 0 /* +DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /* Wait for all sounds to finish playing on DEVICE. -*/ ) - (device) - Lisp_Object device; - +*/ + (device)) { #ifdef HAVE_NAS_SOUND struct device *d = decode_device (device); @@ -371,12 +363,10 @@ return Qnil; } -DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, Sconnected_to_nas_p, - 0, 1, 0 /* +DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, 0, 1, 0, /* t if connected to NAS server for sounds on DEVICE. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { #ifdef HAVE_NAS_SOUND struct device *d = decode_device (device); @@ -501,12 +491,12 @@ defsymbol (&Qnas, "nas"); #endif - defsubr (&Splay_sound_file); - defsubr (&Splay_sound); - defsubr (&Sding); - defsubr (&Swait_for_sounds); - defsubr (&Sconnected_to_nas_p); - defsubr (&Sdevice_sound_enabled_p); + DEFSUBR (Fplay_sound_file); + DEFSUBR (Fplay_sound); + DEFSUBR (Fding); + DEFSUBR (Fwait_for_sounds); + DEFSUBR (Fconnected_to_nas_p); + DEFSUBR (Fdevice_sound_enabled_p); }
--- a/src/specifier.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/specifier.c Mon Aug 13 08:50:05 2007 +0200 @@ -364,14 +364,12 @@ return 0; } -DEFUN ("valid-specifier-type-p", Fvalid_specifier_type_p, - Svalid_specifier_type_p, 1, 1, 0 /* +DEFUN ("valid-specifier-type-p", Fvalid_specifier_type_p, 1, 1, 0, /* Given a SPECIFIER-TYPE, return non-nil if it is valid. Valid types are 'generic, 'integer, boolean, 'color, 'font, 'image, 'face-boolean, and 'toolbar. -*/ ) - (specifier_type) - Lisp_Object specifier_type; +*/ + (specifier_type)) { if (valid_specifier_type_p (specifier_type)) return Qt; @@ -379,11 +377,10 @@ return Qnil; } -DEFUN ("specifier-type-list", Fspecifier_type_list, Sspecifier_type_list, - 0, 0, 0 /* +DEFUN ("specifier-type-list", Fspecifier_type_list, 0, 0, 0, /* Return a list of valid specifier types. -*/ ) - () +*/ + ()) { return Fcopy_sequence (Vspecifier_type_list); } @@ -429,7 +426,7 @@ return specifier; } -DEFUN ("make-specifier", Fmake_specifier, Smake_specifier, 1, 1, 0 /* +DEFUN ("make-specifier", Fmake_specifier, 1, 1, 0, /* Create a new specifier. A specifier is an object that can be used to keep track of a property @@ -451,9 +448,8 @@ `generic-specifier-p', `integer-specifier-p', `boolean-specifier-p', `color-specifier-p', `font-specifier-p', `image-specifier-p', `face-boolean-specifier-p', and `toolbar-specifier-p'. -*/ ) - (type) - Lisp_Object type; +*/ + (type)) { /* This function can GC */ struct specifier_methods *meths = decode_specifier_type (type, @@ -462,27 +458,25 @@ return make_specifier (meths); } -DEFUN ("specifierp", Fspecifierp, Sspecifierp, 1, 1, 0 /* +DEFUN ("specifierp", Fspecifierp, 1, 1, 0, /* Return non-nil if OBJECT is a specifier. A specifier is an object that can be used to keep track of a property whose value can be per-buffer, per-window, per-frame, or per-device, and can further be restricted to a particular console-type or device-class. See `make-specifier'. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { if (!SPECIFIERP (object)) return Qnil; return Qt; } -DEFUN ("specifier-type", Fspecifier_type, Sspecifier_type, 1, 1, 0 /* +DEFUN ("specifier-type", Fspecifier_type, 1, 1, 0, /* Return the type of SPECIFIER. -*/ ) - (specifier) - Lisp_Object specifier; +*/ + (specifier)) { CHECK_SPECIFIER (specifier); return intern (XSPECIFIER (specifier)->methods->name); @@ -493,14 +487,12 @@ /* Locales and domains */ /************************************************************************/ -DEFUN ("valid-specifier-locale-p", Fvalid_specifier_locale_p, - Svalid_specifier_locale_p, 1, 1, 0 /* +DEFUN ("valid-specifier-locale-p", Fvalid_specifier_locale_p, 1, 1, 0, /* Return non-nil if LOCALE is a valid specifier locale. Valid locales are a device, a frame, a window, a buffer, and 'global. (nil is not valid.) -*/ ) - (locale) - Lisp_Object locale; +*/ + (locale)) { /* This cannot GC. */ if ((DEVICEP (locale) && DEVICE_LIVE_P (XDEVICE (locale))) || @@ -515,16 +507,13 @@ return Qnil; } -DEFUN ("valid-specifier-domain-p", - Fvalid_specifier_domain_p, - Svalid_specifier_domain_p, 1, 1, 0 /* +DEFUN ("valid-specifier-domain-p", Fvalid_specifier_domain_p, 1, 1, 0, /* Return non-nil if DOMAIN is a valid specifier domain. A domain is used to instance a specifier (i.e. determine the specifier's value in that domain). Valid domains are a window, frame, or device. (nil is not valid.) -*/ ) - (domain) - Lisp_Object domain; +*/ + (domain)) { /* This cannot GC. */ if ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) || @@ -535,16 +524,13 @@ return Qnil; } -DEFUN ("valid-specifier-locale-type-p", - Fvalid_specifier_locale_type_p, - Svalid_specifier_locale_type_p, 1, 1, 0 /* +DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1, 1, 0, /* Given a specifier LOCALE-TYPE, return non-nil if it is valid. Valid locale types are 'global, 'device, 'frame, 'window, and 'buffer. (Note, however, that in functions that accept either a locale or a locale type, 'global is considered an individual locale.) -*/ ) - (locale_type) - Lisp_Object locale_type; +*/ + (locale_type)) { /* This cannot GC. */ if (EQ (locale_type, Qglobal) || @@ -568,13 +554,10 @@ signal_simple_error ("Invalid specifier locale or locale type", locale); } -DEFUN ("specifier-locale-type-from-locale", - Fspecifier_locale_type_from_locale, - Sspecifier_locale_type_from_locale, 1, 1, 0 /* +DEFUN ("specifier-locale-type-from-locale", Fspecifier_locale_type_from_locale, 1, 1, 0, /* Given a specifier LOCALE, return its type. -*/ ) - (locale) - Lisp_Object locale; +*/ + (locale)) { /* This cannot GC. */ if (NILP (Fvalid_specifier_locale_p (locale))) @@ -664,14 +647,11 @@ /* Tags */ /************************************************************************/ -DEFUN ("valid-specifier-tag-p", Fvalid_specifier_tag_p, - Svalid_specifier_tag_p, - 1, 1, 0 /* +DEFUN ("valid-specifier-tag-p", Fvalid_specifier_tag_p, 1, 1, 0, /* Return non-nil if TAG is a valid specifier tag. See also `valid-specifier-tag-set-p'. -*/ ) - (tag) - Lisp_Object tag; +*/ + (tag)) { if (valid_console_type_p (tag) || valid_device_class_p (tag) || @@ -680,9 +660,7 @@ return Qnil; } -DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, - Svalid_specifier_tag_set_p, - 1, 1, 0 /* +DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, 1, 1, 0, /* Return non-nil if TAG-SET is a valid specifier tag set. A specifier tag set is an entity that is attached to an instantiator @@ -707,9 +685,8 @@ Most of the time, a tag set is not specified, and the instantiator gets a null tag set, which matches all devices. -*/ ) - (tag_set) - Lisp_Object tag_set; +*/ + (tag_set)) { Lisp_Object rest; @@ -785,15 +762,13 @@ return Flist (j, tags); } -DEFUN ("canonicalize-tag-set", Fcanonicalize_tag_set, - Scanonicalize_tag_set, 1, 1, 0 /* +DEFUN ("canonicalize-tag-set", Fcanonicalize_tag_set, 1, 1, 0, /* Canonicalize the given tag set. Two canonicalized tag sets can be compared with `equal' to see if they represent the same tag set. (Specifically, canonicalizing involves sorting by symbol name and removing duplicates.) -*/ ) - (tag_set) - Lisp_Object tag_set; +*/ + (tag_set)) { if (NILP (Fvalid_specifier_tag_set_p (tag_set))) signal_simple_error ("Invalid tag set", tag_set); @@ -826,17 +801,13 @@ return 1; } -DEFUN ("device-matches-specifier-tag-set-p", - Fdevice_matches_specifier_tag_set_p, - Sdevice_matches_specifier_tag_set_p, - 2, 2, 0 /* +DEFUN ("device-matches-specifier-tag-set-p", Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /* Return non-nil if DEVICE matches specifier tag set TAG-SET. This means that DEVICE matches each tag in the tag set. (Every tag recognized by XEmacs has a predicate associated with it that specifies which devices match it.) -*/ ) - (device, tag_set) - Lisp_Object device, tag_set; +*/ + (device, tag_set)) { CHECK_LIVE_DEVICE (device); @@ -846,8 +817,7 @@ return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil; } -DEFUN ("define-specifier-tag", Fdefine_specifier_tag, Sdefine_specifier_tag, - 1, 2, 0 /* +DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /* Define a new specifier tag. If PREDICATE is specified, it should be a function of one argument (a device) that specifies whether the tag matches that particular @@ -856,9 +826,8 @@ You can redefine an existing user-defined specifier tag. However, you cannot redefine the built-in specifier tags (the device types and classes) or the symbols nil, t, 'all, or 'global. -*/ ) - (tag, predicate) - Lisp_Object tag, predicate; +*/ + (tag, predicate)) { Lisp_Object assoc, devcons, concons; int recompute = 0; @@ -944,15 +913,11 @@ } } -DEFUN ("device-matching-specifier-tag-list", - Fdevice_matching_specifier_tag_list, - Sdevice_matching_specifier_tag_list, - 0, 1, 0 /* +DEFUN ("device-matching-specifier-tag-list", Fdevice_matching_specifier_tag_list, 0, 1, 0, /* Return a list of all specifier tags matching DEVICE. DEVICE defaults to the selected device if omitted. -*/ ) - (device) - Lisp_Object device; +*/ + (device)) { struct device *d = decode_device (device); Lisp_Object rest, list = Qnil; @@ -973,12 +938,11 @@ RETURN_UNGCPRO (list); } -DEFUN ("specifier-tag-list", Fspecifier_tag_list, Sspecifier_tag_list, - 0, 0, 0 /* +DEFUN ("specifier-tag-list", Fspecifier_tag_list, 0, 0, 0, /* Return a list of all currently-defined specifier tags. This includes the built-in ones (the device types and classes). -*/ ) - () +*/ + ()) { Lisp_Object list = Qnil, rest; struct gcpro gcpro1; @@ -995,13 +959,10 @@ RETURN_UNGCPRO (list); } -DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, - Sspecifier_tag_predicate, - 1, 1, 0 /* +DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, 1, 1, 0, /* Return the predicate for the given specifier tag. -*/ ) - (tag) - Lisp_Object tag; +*/ + (tag)) { /* The return value of this function must be GCPRO'd. */ CHECK_SYMBOL (tag); @@ -1100,13 +1061,10 @@ return Qt; } -DEFUN ("check-valid-instantiator", Fcheck_valid_instantiator, - Scheck_valid_instantiator, - 2, 2, 0 /* +DEFUN ("check-valid-instantiator", Fcheck_valid_instantiator, 2, 2, 0, /* Signal an error if INSTANTIATOR is invalid for SPECIFIER-TYPE. -*/ ) - (instantiator, specifier_type) - Lisp_Object instantiator, specifier_type; +*/ + (instantiator, specifier_type)) { struct specifier_methods *meths = decode_specifier_type (specifier_type, ERROR_ME); @@ -1114,12 +1072,10 @@ return check_valid_instantiator (instantiator, meths, ERROR_ME); } -DEFUN ("valid-instantiator-p", Fvalid_instantiator_p, Svalid_instantiator_p, - 2, 2, 0 /* +DEFUN ("valid-instantiator-p", Fvalid_instantiator_p, 2, 2, 0, /* Return non-nil if INSTANTIATOR is valid for SPECIFIER-TYPE. -*/ ) - (instantiator, specifier_type) - Lisp_Object instantiator, specifier_type; +*/ + (instantiator, specifier_type)) { struct specifier_methods *meths = decode_specifier_type (specifier_type, ERROR_ME); @@ -1156,24 +1112,20 @@ return Qt; } -DEFUN ("check-valid-inst-list", Fcheck_valid_inst_list, Scheck_valid_inst_list, - 2, 2, 0 /* +DEFUN ("check-valid-inst-list", Fcheck_valid_inst_list, 2, 2, 0, /* Signal an error if INST-LIST is invalid for specifier type TYPE. -*/ ) - (inst_list, type) - Lisp_Object inst_list, type; +*/ + (inst_list, type)) { struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME); return check_valid_inst_list (inst_list, meths, ERROR_ME); } -DEFUN ("valid-inst-list-p", Fvalid_inst_list_p, Svalid_inst_list_p, - 2, 2, 0 /* +DEFUN ("valid-inst-list-p", Fvalid_inst_list_p, 2, 2, 0, /* Return non-nil if INST-LIST is valid for specifier type TYPE. -*/ ) - (inst_list, type) - Lisp_Object inst_list, type; +*/ + (inst_list, type)) { struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME); @@ -1209,24 +1161,20 @@ return Qt; } -DEFUN ("check-valid-spec-list", Fcheck_valid_spec_list, Scheck_valid_spec_list, - 2, 2, 0 /* +DEFUN ("check-valid-spec-list", Fcheck_valid_spec_list, 2, 2, 0, /* Signal an error if SPEC-LIST is invalid for specifier type TYPE. -*/ ) - (spec_list, type) - Lisp_Object spec_list, type; +*/ + (spec_list, type)) { struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME); return check_valid_spec_list (spec_list, meths, ERROR_ME); } -DEFUN ("valid-spec-list-p", Fvalid_spec_list_p, Svalid_spec_list_p, - 2, 2, 0 /* +DEFUN ("valid-spec-list-p", Fvalid_spec_list_p, 2, 2, 0, /* Return non-nil if SPEC-LIST is valid for specifier type TYPE. -*/ ) - (spec_list, type) - Lisp_Object spec_list, type; +*/ + (spec_list, type)) { struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME); @@ -1776,8 +1724,7 @@ return retval; } -DEFUN ("add-spec-to-specifier", Fadd_spec_to_specifier, Sadd_spec_to_specifier, - 2, 5, 0 /* +DEFUN ("add-spec-to-specifier", Fadd_spec_to_specifier, 2, 5, 0, /* Add a specification to SPECIFIER. The specification maps from LOCALE (which should be a buffer, window, frame, device, or 'global, and defaults to 'global) to INSTANTIATOR, @@ -1815,9 +1762,8 @@ You can retrieve the specifications for a particular locale or locale type with the function `specifier-spec-list' or `specifier-specs'. -*/ ) - (specifier, instantiator, locale, tag_set, how_to_add) - Lisp_Object specifier, instantiator, locale, tag_set, how_to_add; +*/ + (specifier, instantiator, locale, tag_set, how_to_add)) { enum spec_add_meth add_meth; Lisp_Object inst_list; @@ -1841,8 +1787,7 @@ RETURN_UNGCPRO (Qnil); } -DEFUN ("add-spec-list-to-specifier", Fadd_spec_list_to_specifier, - Sadd_spec_list_to_specifier, 2, 3, 0 /* +DEFUN ("add-spec-list-to-specifier", Fadd_spec_list_to_specifier, 2, 3, 0, /* Add a spec-list (a list of specifications) to SPECIFIER. The format of a spec-list is @@ -1868,9 +1813,8 @@ In many circumstances, the higher-level function `set-specifier' is more convenient and should be used instead. -*/ ) - (specifier, spec_list, how_to_add) - Lisp_Object specifier, spec_list, how_to_add; +*/ + (specifier, spec_list, how_to_add)) { enum spec_add_meth add_meth; Lisp_Object rest; @@ -1949,8 +1893,7 @@ violate our assertion that the specs contained in the actual specifier lists are all valid. */ -DEFUN ("specifier-spec-list", Fspecifier_spec_list, Sspecifier_spec_list, - 1, 4, 0 /* +DEFUN ("specifier-spec-list", Fspecifier_spec_list, 1, 4, 0, /* Return the spec-list of specifications for SPECIFIER in LOCALE. If LOCALE is a particular locale (a buffer, window, frame, device, @@ -1974,9 +1917,8 @@ no instantiators will be screened out.) If EXACT-P is non-nil, however, TAG-SET must be equal to an instantiator's tag set for the instantiator to be returned. -*/ ) - (specifier, locale, tag_set, exact_p) - Lisp_Object specifier, locale, tag_set, exact_p; +*/ + (specifier, locale, tag_set, exact_p)) { struct specifier_spec_list_closure cl; struct gcpro gcpro1, gcpro2; @@ -1991,8 +1933,7 @@ } -DEFUN ("specifier-specs", Fspecifier_specs, Sspecifier_specs, - 1, 4, 0 /* +DEFUN ("specifier-specs", Fspecifier_specs, 1, 4, 0, /* Return the specification(s) for SPECIFIER in LOCALE. If LOCALE is a single locale or is a list of one element containing a @@ -2013,9 +1954,8 @@ 'any, a one-element list containing nil will be returned rather than just nil, to distinguish this case from there being no instantiators at all. -*/ ) - (specifier, locale, tag_set, exact_p) - Lisp_Object specifier, locale, tag_set, exact_p; +*/ + (specifier, locale, tag_set, exact_p)) { if (!NILP (Fvalid_specifier_locale_p (locale)) || (CONSP (locale) && !NILP (Fvalid_specifier_locale_p (XCAR (locale))) && @@ -2054,8 +1994,7 @@ return 0; } -DEFUN ("remove-specifier", Fremove_specifier, - Sremove_specifier, 1, 4, 0 /* +DEFUN ("remove-specifier", Fremove_specifier, 1, 4, 0, /* Remove specification(s) for SPECIFIER. If LOCALE is a particular locale (a buffer, window, frame, device, @@ -2077,9 +2016,8 @@ no instantiators will be screened out. If EXACT-P is non-nil, however, TAG-SET must be equal to an instantiator's tag set for the instantiator to be removed. -*/ ) - (specifier, locale, tag_set, exact_p) - Lisp_Object specifier, locale, tag_set, exact_p; +*/ + (specifier, locale, tag_set, exact_p)) { CHECK_SPECIFIER (specifier); map_specifier (specifier, locale, remove_specifier_mapfun, tag_set, @@ -2120,8 +2058,7 @@ return 0; } -DEFUN ("copy-specifier", Fcopy_specifier, Scopy_specifier, - 1, 6, 0 /* +DEFUN ("copy-specifier", Fcopy_specifier, 1, 6, 0, /* Copy SPECIFIER to DEST, or create a new one if DEST is nil. If DEST is nil or omitted, a new specifier will be created and the @@ -2147,9 +2084,8 @@ specifications in DEST. If nil, then whichever locales or locale types are copied will first be completely erased in DEST. Otherwise, it is the same as in `add-spec-to-specifier'. -*/ ) - (specifier, dest, locale, tag_set, exact_p, how_to_add) - Lisp_Object specifier, dest, locale, tag_set, exact_p, how_to_add; +*/ + (specifier, dest, locale, tag_set, exact_p, how_to_add)) { struct gcpro gcpro1; struct copy_specifier_closure cl; @@ -2234,14 +2170,11 @@ } } -DEFUN ("check-valid-specifier-matchspec", Fcheck_valid_specifier_matchspec, - Scheck_valid_specifier_matchspec, - 2, 2, 0 /* +DEFUN ("check-valid-specifier-matchspec", Fcheck_valid_specifier_matchspec, 2, 2, 0, /* Signal an error if MATCHSPEC is invalid for SPECIFIER-TYPE. See `specifier-matching-instance' for a description of matchspecs. -*/ ) - (matchspec, specifier_type) - Lisp_Object matchspec, specifier_type; +*/ + (matchspec, specifier_type)) { struct specifier_methods *meths = decode_specifier_type (specifier_type, ERROR_ME); @@ -2249,14 +2182,11 @@ return check_valid_specifier_matchspec (matchspec, meths, ERROR_ME); } -DEFUN ("valid-specifier-matchspec-p", Fvalid_specifier_matchspec_p, - Svalid_specifier_matchspec_p, - 2, 2, 0 /* +DEFUN ("valid-specifier-matchspec-p", Fvalid_specifier_matchspec_p, 2, 2, 0, /* Return non-nil if MATCHSPEC is valid for SPECIFIER-TYPE. See `specifier-matching-instance' for a description of matchspecs. -*/ ) - (matchspec, specifier_type) - Lisp_Object matchspec, specifier_type; +*/ + (matchspec, specifier_type)) { struct specifier_methods *meths = decode_specifier_type (specifier_type, ERROR_ME); @@ -2282,8 +2212,7 @@ recompute_cached_specifier_everywhere (specifier); } -DEFUN ("specifier-fallback", Fspecifier_fallback, Sspecifier_fallback, - 1, 1, 0 /* +DEFUN ("specifier-fallback", Fspecifier_fallback, 1, 1, 0, /* Return the fallback value for SPECIFIER. Fallback values are provided by the C code for certain built-in specifiers to make sure that instancing won't fail even if all @@ -2302,9 +2231,8 @@ When you instance a specifier, you can explicitly request that the fallback not be consulted. (The C code does this, for example, when merging faces.) See `specifier-instance'. -*/ ) - (specifier) - Lisp_Object specifier; +*/ + (specifier)) { CHECK_SPECIFIER (specifier); return Fcopy_tree (XSPECIFIER (specifier)->fallback, Qt); @@ -2495,8 +2423,7 @@ 1, no_fallback, depth); } -DEFUN ("specifier-instance", Fspecifier_instance, Sspecifier_instance, - 1, 4, 0 /* +DEFUN ("specifier-instance", Fspecifier_instance, 1, 4, 0, /* Instantiate SPECIFIER (return its value) in DOMAIN. If no instance can be generated for this domain, return DEFAULT. @@ -2542,9 +2469,8 @@ will be a string, pixmap, or subwindow. See also `specifier-matching-instance'. -*/ ) - (specifier, domain, defalt, no_fallback) - Lisp_Object specifier, domain, defalt, no_fallback; +*/ + (specifier, domain, defalt, no_fallback)) { Lisp_Object instance; @@ -2558,8 +2484,7 @@ return instance; } -DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, - Sspecifier_matching_instance, 2, 5, 0 /* +DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /* Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC. If no instance can be generated for this domain, return DEFAULT. @@ -2581,9 +2506,8 @@ (This only makes sense with Mule support.) This makes it easy to choose a font that can display a particular character. (This is what redisplay does, in fact.) -*/ ) - (specifier, matchspec, domain, defalt, no_fallback) - Lisp_Object specifier, matchspec, domain, defalt, no_fallback; +*/ + (specifier, matchspec, domain, defalt, no_fallback)) { Lisp_Object instance; @@ -2599,16 +2523,15 @@ return instance; } -DEFUN ("specifier-instance-from-inst-list", Fspecifier_instance_from_inst_list, - Sspecifier_instance_from_inst_list, 3, 4, 0 /* +DEFUN ("specifier-instance-from-inst-list", + Fspecifier_instance_from_inst_list, 3, 4, 0, /* Attempt to convert a particular inst-list into an instance. This attempts to instantiate INST-LIST in the given DOMAIN, as if INST-LIST existed in a specification in SPECIFIER. If the instantiation fails, DEFAULT is returned. In most circumstances, you should not use this function; use `specifier-instance' instead. -*/ ) - (specifier, domain, inst_list, defalt) - Lisp_Object specifier, domain, inst_list, defalt; +*/ + (specifier, domain, inst_list, defalt)) { Lisp_Object val = Qunbound; struct Lisp_Specifier *sp = XSPECIFIER (specifier); @@ -2631,8 +2554,7 @@ } DEFUN ("specifier-matching-instance-from-inst-list", - Fspecifier_matching_instance_from_inst_list, - Sspecifier_matching_instance_from_inst_list, 4, 5, 0 /* + Fspecifier_matching_instance_from_inst_list, 4, 5, 0, /* Attempt to convert a particular inst-list into an instance. This attempts to instantiate INST-LIST in the given DOMAIN (as if INST-LIST existed in a specification in SPECIFIER), @@ -2642,9 +2564,8 @@ but allows for specification-matching as in `specifier-matching-instance'. See that function for a description of exactly how the matching process works. -*/ ) - (specifier, matchspec, domain, inst_list, defalt) - Lisp_Object specifier, matchspec, domain, inst_list, defalt; +*/ + (specifier, matchspec, domain, inst_list, defalt)) { Lisp_Object val = Qunbound; struct Lisp_Specifier *sp = XSPECIFIER (specifier); @@ -2814,8 +2735,7 @@ } } -DEFUN ("set-specifier-dirty-flag", Fset_specifier_dirty_flag, - Sset_specifier_dirty_flag, 1, 1, 0 /* +DEFUN ("set-specifier-dirty-flag", Fset_specifier_dirty_flag, 1, 1, 0, /* Force recomputation of any caches associated with SPECIFIER. Note that this automatically happens whenever you change a specification in SPECIFIER; you do not have to call this function then. @@ -2824,9 +2744,8 @@ evaluated. Calling `set-specifier-dirty-flag' on the toolbar specifier will force the `active-p' fields to be recomputed. -*/ ) - (specifier) - Lisp_Object specifier; +*/ + (specifier)) { CHECK_SPECIFIER (specifier); recompute_cached_specifier_everywhere (specifier); @@ -2885,15 +2804,13 @@ #endif /* 0 */ -DEFUN ("generic-specifier-p", Fgeneric_specifier_p, - Sgeneric_specifier_p, 1, 1, 0 /* +DEFUN ("generic-specifier-p", Fgeneric_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a generic specifier. A generic specifier allows any kind of Lisp object as an instantiator, and returns back the Lisp object unchanged when it is instantiated. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (GENERIC_SPECIFIERP (object) ? Qt : Qnil); } @@ -2911,12 +2828,10 @@ CHECK_INT (instantiator); } -DEFUN ("integer-specifier-p", Finteger_specifier_p, - Sinteger_specifier_p, 1, 1, 0 /* +DEFUN ("integer-specifier-p", Finteger_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is an integer specifier. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (INTEGER_SPECIFIERP (object) ? Qt : Qnil); } @@ -2933,12 +2848,10 @@ CHECK_NATNUM (instantiator); } -DEFUN ("natnum-specifier-p", Fnatnum_specifier_p, - Snatnum_specifier_p, 1, 1, 0 /* +DEFUN ("natnum-specifier-p", Fnatnum_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a natnum (non-negative-integer) specifier. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (NATNUM_SPECIFIERP (object) ? Qt : Qnil); } @@ -2956,12 +2869,10 @@ signal_simple_error ("Must be t or nil", instantiator); } -DEFUN ("boolean-specifier-p", Fboolean_specifier_p, - Sboolean_specifier_p, 1, 1, 0 /* +DEFUN ("boolean-specifier-p", Fboolean_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is an boolean specifier. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (BOOLEAN_SPECIFIERP (object) ? Qt : Qnil); } @@ -2982,52 +2893,52 @@ /* Qinteger, Qboolean, Qgeneric defined in general.c */ defsymbol (&Qnatnum, "natnum"); - defsubr (&Svalid_specifier_type_p); - defsubr (&Sspecifier_type_list); - defsubr (&Smake_specifier); - defsubr (&Sspecifierp); - defsubr (&Sspecifier_type); - - defsubr (&Svalid_specifier_locale_p); - defsubr (&Svalid_specifier_domain_p); - defsubr (&Svalid_specifier_locale_type_p); - defsubr (&Sspecifier_locale_type_from_locale); - - defsubr (&Svalid_specifier_tag_p); - defsubr (&Svalid_specifier_tag_set_p); - defsubr (&Scanonicalize_tag_set); - defsubr (&Sdevice_matches_specifier_tag_set_p); - defsubr (&Sdefine_specifier_tag); - defsubr (&Sdevice_matching_specifier_tag_list); - defsubr (&Sspecifier_tag_list); - defsubr (&Sspecifier_tag_predicate); - - defsubr (&Scheck_valid_instantiator); - defsubr (&Svalid_instantiator_p); - defsubr (&Scheck_valid_inst_list); - defsubr (&Svalid_inst_list_p); - defsubr (&Scheck_valid_spec_list); - defsubr (&Svalid_spec_list_p); - defsubr (&Sadd_spec_to_specifier); - defsubr (&Sadd_spec_list_to_specifier); - defsubr (&Sspecifier_spec_list); - defsubr (&Sspecifier_specs); - defsubr (&Sremove_specifier); - defsubr (&Scopy_specifier); - - defsubr (&Scheck_valid_specifier_matchspec); - defsubr (&Svalid_specifier_matchspec_p); - defsubr (&Sspecifier_fallback); - defsubr (&Sspecifier_instance); - defsubr (&Sspecifier_matching_instance); - defsubr (&Sspecifier_instance_from_inst_list); - defsubr (&Sspecifier_matching_instance_from_inst_list); - defsubr (&Sset_specifier_dirty_flag); - - defsubr (&Sgeneric_specifier_p); - defsubr (&Sinteger_specifier_p); - defsubr (&Snatnum_specifier_p); - defsubr (&Sboolean_specifier_p); + DEFSUBR (Fvalid_specifier_type_p); + DEFSUBR (Fspecifier_type_list); + DEFSUBR (Fmake_specifier); + DEFSUBR (Fspecifierp); + DEFSUBR (Fspecifier_type); + + DEFSUBR (Fvalid_specifier_locale_p); + DEFSUBR (Fvalid_specifier_domain_p); + DEFSUBR (Fvalid_specifier_locale_type_p); + DEFSUBR (Fspecifier_locale_type_from_locale); + + DEFSUBR (Fvalid_specifier_tag_p); + DEFSUBR (Fvalid_specifier_tag_set_p); + DEFSUBR (Fcanonicalize_tag_set); + DEFSUBR (Fdevice_matches_specifier_tag_set_p); + DEFSUBR (Fdefine_specifier_tag); + DEFSUBR (Fdevice_matching_specifier_tag_list); + DEFSUBR (Fspecifier_tag_list); + DEFSUBR (Fspecifier_tag_predicate); + + DEFSUBR (Fcheck_valid_instantiator); + DEFSUBR (Fvalid_instantiator_p); + DEFSUBR (Fcheck_valid_inst_list); + DEFSUBR (Fvalid_inst_list_p); + DEFSUBR (Fcheck_valid_spec_list); + DEFSUBR (Fvalid_spec_list_p); + DEFSUBR (Fadd_spec_to_specifier); + DEFSUBR (Fadd_spec_list_to_specifier); + DEFSUBR (Fspecifier_spec_list); + DEFSUBR (Fspecifier_specs); + DEFSUBR (Fremove_specifier); + DEFSUBR (Fcopy_specifier); + + DEFSUBR (Fcheck_valid_specifier_matchspec); + DEFSUBR (Fvalid_specifier_matchspec_p); + DEFSUBR (Fspecifier_fallback); + DEFSUBR (Fspecifier_instance); + DEFSUBR (Fspecifier_matching_instance); + DEFSUBR (Fspecifier_instance_from_inst_list); + DEFSUBR (Fspecifier_matching_instance_from_inst_list); + DEFSUBR (Fset_specifier_dirty_flag); + + DEFSUBR (Fgeneric_specifier_p); + DEFSUBR (Finteger_specifier_p); + DEFSUBR (Fnatnum_specifier_p); + DEFSUBR (Fboolean_specifier_p); /* Symbols pertaining to specifier creation. Specifiers are created in the syms_of() functions. */
--- a/src/sunpro.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/sunpro.c Mon Aug 13 08:50:05 2007 +0200 @@ -39,19 +39,14 @@ #include <ut.h> #endif -DEFUN ("ut-log-text", - Fut_log_text, - Sut_log_text, - 1, MANY, 0 /* +DEFUN ("ut-log-text", Fut_log_text, 1, MANY, 0, /* Log a usage-tracking message if `usage-tracking' is non-nil. Args are the same as to `format'. Returns whether the message was actually logged. If usage-tracking support was not compiled in, this function has no effect and always returns `nil'. See function `has-usage-tracking-p'. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { #ifdef USAGE_TRACKING Lisp_Object xs; @@ -78,7 +73,7 @@ void syms_of_sunpro (void) { - defsubr (&Sut_log_text); + DEFSUBR (Fut_log_text); } void
--- a/src/symbols.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/symbols.c Mon Aug 13 08:50:05 2007 +0200 @@ -164,14 +164,13 @@ obarray); } -DEFUN ("intern", Fintern, Sintern, 1, 2, 0 /* +DEFUN ("intern", Fintern, 1, 2, 0, /* Return the canonical symbol whose name is STRING. If there is none, one is created by this function and returned. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. -*/ ) - (str, obarray) - Lisp_Object str, obarray; +*/ + (str, obarray)) { Lisp_Object sym, *ptr; Bytecount len; @@ -201,13 +200,12 @@ return sym; } -DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0 /* +DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /* Return the canonical symbol whose name is STRING, or nil if none exists. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. -*/ ) - (str, obarray) - Lisp_Object str, obarray; +*/ + (str, obarray)) { Lisp_Object tem; @@ -222,15 +220,14 @@ return Qnil; } -DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0 /* +DEFUN ("unintern", Funintern, 1, 2, 0, /* Delete the symbol named NAME, if any, from OBARRAY. The value is t if a symbol was found and deleted, nil otherwise. NAME may be a string or a symbol. If it is a symbol, that symbol is deleted, if it belongs to OBARRAY--no other symbol is deleted. OBARRAY defaults to the value of the variable `obarray' -*/ ) - (name, obarray) - Lisp_Object name, obarray; +*/ + (name, obarray)) { Lisp_Object string, tem; int hash; @@ -378,12 +375,11 @@ call1 (function, sym); } -DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0 /* +DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /* Call FUNCTION on every symbol in OBARRAY. OBARRAY defaults to the value of `obarray'. -*/ ) - (function, obarray) - Lisp_Object function, obarray; +*/ + (function, obarray)) { if (NILP (obarray)) obarray = Vobarray; @@ -415,14 +411,13 @@ *accumulation = Fcons (symbol, *accumulation); } -DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0 /* +DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /* Show all symbols whose names contain match for REGEXP. If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done for each symbol and a symbol is mentioned only if that returns non-nil. Return list of symbols found. -*/ ) - (string, pred) - Lisp_Object string, pred; +*/ + (string, pred)) { struct gcpro gcpro1; Lisp_Object accumulation; @@ -445,32 +440,29 @@ Lisp_Object new_alist_el, int set_it_p); -DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0 /* +DEFUN ("boundp", Fboundp, 1, 1, 0, /* T if SYMBOL's value is not void. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { CHECK_SYMBOL (sym); return (UNBOUNDP (find_symbol_value (sym)) ? Qnil : Qt); } -DEFUN ("globally-boundp", Fglobally_boundp, Sglobally_boundp, 1, 1, 0 /* +DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /* T if SYMBOL has a global (non-bound) value. This is for the byte-compiler; you really shouldn't be using this. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { CHECK_SYMBOL (sym); return (UNBOUNDP (top_level_value (sym)) ? Qnil : Qt); } -DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0 /* +DEFUN ("fboundp", Ffboundp, 1, 1, 0, /* T if SYMBOL's function definition is not void. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { CHECK_SYMBOL (sym); return ((UNBOUNDP (XSYMBOL (sym)->function)) ? Qnil : Qt); @@ -559,21 +551,19 @@ sym)); } -DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0 /* +DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /* Make SYMBOL's value be void. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { Fset (sym, Qunbound); return sym; } -DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0 /* +DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /* Make SYMBOL's function definition be void. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { CHECK_SYMBOL (sym); reject_constant_symbols (sym, Qunbound, 1, Qt); @@ -581,11 +571,10 @@ return sym; } -DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0 /* +DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /* Return SYMBOL's function definition. Error if that is void. -*/ ) - (symbol) - Lisp_Object symbol; +*/ + (symbol)) { CHECK_SYMBOL (symbol); if (UNBOUNDP (XSYMBOL (symbol)->function)) @@ -593,21 +582,19 @@ return XSYMBOL (symbol)->function; } -DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0 /* +DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /* Return SYMBOL's property list. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { CHECK_SYMBOL (sym); return XSYMBOL (sym)->plist; } -DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0 /* +DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /* Return SYMBOL's name, a string. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { Lisp_Object name; @@ -616,11 +603,10 @@ return name; } -DEFUN ("fset", Ffset, Sfset, 2, 2, 0 /* +DEFUN ("fset", Ffset, 2, 2, 0, /* Set SYMBOL's function definition to NEWVAL, and return NEWVAL. -*/ ) - (sym, newdef) - Lisp_Object sym, newdef; +*/ + (sym, newdef)) { /* This function can GC */ CHECK_SYMBOL (sym); @@ -640,12 +626,11 @@ } /* FSFmacs */ -DEFUN ("define-function", Fdefine_function, Sdefine_function, 2, 2, 0 /* +DEFUN ("define-function", Fdefine_function, 2, 2, 0, /* Set SYMBOL's function definition to NEWVAL, and return NEWVAL. Associates the function with the current load file, if any. -*/ ) - (sym, newdef) - Lisp_Object sym, newdef; +*/ + (sym, newdef)) { /* This function can GC */ CHECK_SYMBOL (sym); @@ -655,11 +640,10 @@ } -DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0 /* +DEFUN ("setplist", Fsetplist, 2, 2, 0, /* Set SYMBOL's property list to NEWVAL, and return NEWVAL. -*/ ) - (sym, newplist) - Lisp_Object sym, newplist; +*/ + (sym, newplist)) { CHECK_SYMBOL (sym); XSYMBOL (sym)->plist = newplist; @@ -1559,11 +1543,10 @@ find_it_p); } -DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0 /* +DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /* Return SYMBOL's value. Error if that is void. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { Lisp_Object val = find_symbol_value (sym); @@ -1573,11 +1556,10 @@ return val; } -DEFUN ("set", Fset, Sset, 2, 2, 0 /* +DEFUN ("set", Fset, 2, 2, 0, /* Set SYMBOL's value to NEWVAL, and return NEWVAL. -*/ ) - (sym, newval) - Lisp_Object sym, newval; +*/ + (sym, newval)) { REGISTER Lisp_Object valcontents; /* remember, we're called by Fmakunbound() as well */ @@ -1824,13 +1806,12 @@ RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */ } -DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0 /* +DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /* Return T if SYMBOL has a non-void default value. This is the value that is seen in buffers that do not have their own values for this variable. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { Lisp_Object value; @@ -1838,14 +1819,13 @@ return (UNBOUNDP (value) ? Qnil : Qt); } -DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0 /* +DEFUN ("default-value", Fdefault_value, 1, 1, 0, /* Return SYMBOL's default value. This is the value that is seen in buffers that do not have their own values for this variable. The default value is meaningful for variables with local bindings in certain buffers. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { Lisp_Object value; @@ -1855,13 +1835,12 @@ return value; } -DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0 /* +DEFUN ("set-default", Fset_default, 2, 2, 0, /* Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated. The default value is seen in buffers that do not have their own values for this variable. -*/ ) - (sym, value) - Lisp_Object sym, value; +*/ + (sym, value)) { Lisp_Object valcontents; @@ -1917,7 +1896,7 @@ RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */ } -DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0 /* +DEFUN ("setq-default", Fsetq_default, 2, UNEVALLED, 0, /* Set the default value of variable VAR to VALUE. VAR, the variable name, is literal (not evaluated); VALUE is an expression and it is evaluated. @@ -1929,9 +1908,8 @@ This sets each SYM's default value to the corresponding VALUE. The VALUE for the Nth SYM can refer to the new default values of previous SYMs. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object args_left; @@ -1959,9 +1937,8 @@ /* Lisp functions for creating and removing buffer-local variables. */ -DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, - Smake_variable_buffer_local, - 1, 1, "vMake Variable Buffer Local: " /* +DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, + "vMake Variable Buffer Local: ", /* Make VARIABLE have a separate value for each buffer. At any time, the value for the current buffer is in effect. There is also a default value which is seen in any buffer which has not yet @@ -1970,9 +1947,8 @@ for the current buffer if it was previously using the default value. The function `default-value' gets the default value and `set-default' sets it. -*/ ) - (variable) - Lisp_Object variable; +*/ + (variable)) { Lisp_Object valcontents; @@ -2057,8 +2033,7 @@ } } -DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable, - 1, 1, "vMake Local Variable: " /* +DEFUN ("make-local-variable", Fmake_local_variable, 1, 1, "vMake Local Variable: ", /* Make VARIABLE have a separate value in the current buffer. Other buffers will continue to share a common default value. \(The buffer-local value of VARIABLE starts out as the same value @@ -2071,9 +2046,8 @@ Do not use `make-local-variable' to make a hook variable buffer-local. Use `make-local-hook' instead. -*/ ) - (variable) - Lisp_Object variable; +*/ + (variable)) { Lisp_Object valcontents; struct symbol_value_buffer_local *bfwd; @@ -2211,13 +2185,11 @@ return (variable); } -DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable, - 1, 1, "vKill Local Variable: " /* +DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1, "vKill Local Variable: ", /* Make VARIABLE no longer have a separate value in the current buffer. From now on the default value will apply in this buffer. -*/ ) - (variable) - Lisp_Object variable; +*/ + (variable)) { Lisp_Object valcontents; @@ -2305,14 +2277,11 @@ } -DEFUN ("kill-console-local-variable", Fkill_console_local_variable, - Skill_console_local_variable, - 1, 1, "vKill Console Local Variable: " /* +DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1, "vKill Console Local Variable: ", /* Make VARIABLE no longer have a separate value in the selected console. From now on the default value will apply in this console. -*/ ) - (variable) - Lisp_Object variable; +*/ + (variable)) { Lisp_Object valcontents; @@ -2435,12 +2404,10 @@ } -DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, - Ssymbol_value_in_buffer, 2, 3, 0 /* +DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /* Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound. -*/ ) - (symbol, buffer, unbound_value) - Lisp_Object symbol, buffer, unbound_value; +*/ + (symbol, buffer, unbound_value)) { Lisp_Object value; CHECK_SYMBOL (symbol); @@ -2452,12 +2419,10 @@ return (value); } -DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, - Ssymbol_value_in_console, 2, 3, 0 /* +DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /* Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound. -*/ ) - (symbol, console, unbound_value) - Lisp_Object symbol, console, unbound_value; +*/ + (symbol, console, unbound_value)) { Lisp_Object value; CHECK_SYMBOL (symbol); @@ -2469,8 +2434,7 @@ return (value); } -DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, - Sbuilt_in_variable_type, 1, 1, 0 /* +DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /* If SYM is a built-in variable, return info about this; else return nil. The returned info will be a symbol, one of @@ -2489,9 +2453,8 @@ `const-selected-console' Same, but cannot be set. `default-console' Forwards to the default value of a built-in console-local variable. -*/ ) - (sym) - Lisp_Object sym; +*/ + (sym)) { REGISTER Lisp_Object valcontents; @@ -2573,7 +2536,7 @@ } -DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, 2, 3, 0 /* +DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /* Return t if SYMBOL's value is local to BUFFER. If optional third arg AFTER-SET is true, return t if SYMBOL would be buffer-local after it is set, regardless of whether it is so presently. @@ -2587,9 +2550,8 @@ -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that the variable has had `make-variable-buffer-local' applied to it. -*/ ) - (symbol, buffer, after_set) - Lisp_Object symbol, buffer, after_set; +*/ + (symbol, buffer, after_set)) { int local_info; @@ -2883,15 +2845,13 @@ } DEFUN ("dontusethis-set-symbol-value-handler", - Fdontusethis_set_symbol_value_handler, - Sdontusethis_set_symbol_value_handler, 3, 5, 0 /* + Fdontusethis_set_symbol_value_handler, 3, 5, 0, /* Don't you dare use this. If you do, suffer the wrath of Ben, who is likely to rename this function (or change the semantics of its arguments) without pity, thereby invalidating your code. -*/ ) - (variable, handler_type, handler, harg, keep_existing) - Lisp_Object variable, handler_type, handler, harg, keep_existing; +*/ + (variable, handler_type, handler, harg, keep_existing)) { Lisp_Object valcontents; struct symbol_value_lisp_magic *bfwd; @@ -3002,7 +2962,7 @@ return hare; } -DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 2, 0 /* +DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /* Define a variable as an alias for another variable. Thenceforth, any operations performed on VARIABLE will actually be performed on ALIAS. Both VARIABLE and ALIAS should be symbols. @@ -3014,9 +2974,8 @@ Currently VARIABLE cannot be a built-in variable, a variable that has a buffer-local value in any buffer, or the symbols nil or t. (ALIAS, however, can be any type of variable.) -*/ ) - (variable, alias) - Lisp_Object variable, alias; +*/ + (variable, alias)) { struct symbol_value_varalias *bfwd; Lisp_Object valcontents; @@ -3061,14 +3020,13 @@ return Qnil; } -DEFUN ("variable-alias", Fvariable_alias, Svariable_alias, 1, 2, 0 /* +DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /* If VARIABLE is aliased to another variable, return that variable. VARIABLE should be a symbol. If VARIABLE is not aliased, return nil. Variable aliases are created with `defvaralias'. See also `indirect-variable'. -*/ ) - (variable, follow_past_lisp_magic) - Lisp_Object variable, follow_past_lisp_magic; +*/ + (variable, follow_past_lisp_magic)) { Lisp_Object valcontents; @@ -3089,7 +3047,7 @@ return Qnil; } -DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 2, 0 /* +DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /* Return the variable at the end of OBJECT's variable-alias chain. If OBJECT is a symbol, follow all variable aliases and return the final (non-aliased) symbol. Variable aliases are created with @@ -3097,9 +3055,8 @@ If OBJECT is not a symbol, just return it. Signal a cyclic-variable-indirection error if there is a loop in the variable chain of symbols. -*/ ) - (object, follow_past_lisp_magic) - Lisp_Object object, follow_past_lisp_magic; +*/ + (object, follow_past_lisp_magic)) { if (!SYMBOLP (object)) return object; @@ -3283,41 +3240,41 @@ defsymbol (&Qselected_console, "selected-console"); defsymbol (&Qconst_selected_console, "const-selected-console"); - defsubr (&Sintern); - defsubr (&Sintern_soft); - defsubr (&Sunintern); - defsubr (&Smapatoms); - defsubr (&Sapropos_internal); - - defsubr (&Ssymbol_function); - defsubr (&Ssymbol_plist); - defsubr (&Ssymbol_name); - defsubr (&Smakunbound); - defsubr (&Sfmakunbound); - defsubr (&Sboundp); - defsubr (&Sglobally_boundp); - defsubr (&Sfboundp); - defsubr (&Sfset); - defsubr (&Sdefine_function); - defsubr (&Ssetplist); - defsubr (&Ssymbol_value_in_buffer); - defsubr (&Ssymbol_value_in_console); - defsubr (&Sbuilt_in_variable_type); - defsubr (&Ssymbol_value); - defsubr (&Sset); - defsubr (&Sdefault_boundp); - defsubr (&Sdefault_value); - defsubr (&Sset_default); - defsubr (&Ssetq_default); - defsubr (&Smake_variable_buffer_local); - defsubr (&Smake_local_variable); - defsubr (&Skill_local_variable); - defsubr (&Skill_console_local_variable); - defsubr (&Slocal_variable_p); - defsubr (&Sdefvaralias); - defsubr (&Svariable_alias); - defsubr (&Sindirect_variable); - defsubr (&Sdontusethis_set_symbol_value_handler); + DEFSUBR (Fintern); + DEFSUBR (Fintern_soft); + DEFSUBR (Funintern); + DEFSUBR (Fmapatoms); + DEFSUBR (Fapropos_internal); + + DEFSUBR (Fsymbol_function); + DEFSUBR (Fsymbol_plist); + DEFSUBR (Fsymbol_name); + DEFSUBR (Fmakunbound); + DEFSUBR (Ffmakunbound); + DEFSUBR (Fboundp); + DEFSUBR (Fglobally_boundp); + DEFSUBR (Ffboundp); + DEFSUBR (Ffset); + DEFSUBR (Fdefine_function); + DEFSUBR (Fsetplist); + DEFSUBR (Fsymbol_value_in_buffer); + DEFSUBR (Fsymbol_value_in_console); + DEFSUBR (Fbuilt_in_variable_type); + DEFSUBR (Fsymbol_value); + DEFSUBR (Fset); + DEFSUBR (Fdefault_boundp); + DEFSUBR (Fdefault_value); + DEFSUBR (Fset_default); + DEFSUBR (Fsetq_default); + DEFSUBR (Fmake_variable_buffer_local); + DEFSUBR (Fmake_local_variable); + DEFSUBR (Fkill_local_variable); + DEFSUBR (Fkill_console_local_variable); + DEFSUBR (Flocal_variable_p); + DEFSUBR (Fdefvaralias); + DEFSUBR (Fvariable_alias); + DEFSUBR (Findirect_variable); + DEFSUBR (Fdontusethis_set_symbol_value_handler); } /* Create and initialize a variable whose value is forwarded to C data */
--- a/src/syntax.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/syntax.c Mon Aug 13 08:50:05 2007 +0200 @@ -91,7 +91,7 @@ find_defun_start (struct buffer *buf, Bufpos pos) { Bufpos tem; - Lisp_Object table = buf->syntax_table; + Lisp_Object syntaxtab = buf->syntax_table; /* Use previous finding, if it's valid and applies to this inquiry. */ if (buf == find_start_buffer @@ -110,7 +110,7 @@ while (tem > BUF_BEGV (buf)) { /* Open-paren at start of line means we found our defun-start. */ - if (SYNTAX (table, BUF_FETCH_CHAR (buf, tem)) == Sopen) + if (SYNTAX (syntaxtab, BUF_FETCH_CHAR (buf, tem)) == Sopen) break; /* Move to beg of previous line. */ tem = find_next_newline (buf, tem, -2); @@ -126,12 +126,11 @@ return find_start_value; } -DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0 /* +DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /* Return t if ARG is a syntax table. Any vector of 256 elements will do. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { if (VECTORP (obj) && vector_length (XVECTOR (obj)) == 0400) return Qt; @@ -148,33 +147,30 @@ return (obj); } -DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 1, 0 /* +DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /* Return the current syntax table. This is the one specified by the current buffer, or by BUFFER if it is non-nil. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { return decode_buffer (buffer, 0)->syntax_table; } -DEFUN ("standard-syntax-table", Fstandard_syntax_table, - Sstandard_syntax_table, 0, 0, 0 /* +DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /* Return the standard syntax table. This is the one used for new buffers. -*/ ) - () +*/ + ()) { return Vstandard_syntax_table; } -DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0 /* +DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /* Construct a new syntax table and return it. It is a copy of the TABLE, which defaults to the standard syntax table. -*/ ) - (table) - Lisp_Object table; +*/ + (table)) { if (NILP (Vstandard_syntax_table)) /* Can only be null during initialization */ @@ -184,13 +180,12 @@ return Fcopy_sequence (table); } -DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 2, 0 /* +DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /* Select a new syntax table for BUFFER. One argument, a syntax table. BUFFER defaults to the current buffer if omitted. -*/ ) - (table, buffer) - Lisp_Object table, buffer; +*/ + (table, buffer)) { struct buffer *buf = decode_buffer (buffer, 0); table = check_syntax_table (table, Qnil); @@ -232,27 +227,25 @@ 'e', '\0' }; -DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, - Ssyntax_designator_chars, 0, 0, 0 /* +DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /* Return a string of the recognized syntax designator chars. The chars are ordered by their internal syntax codes, which are numbered starting at 0. -*/ ) - () +*/ + ()) { return Vsyntax_designator_chars_string; } -DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 2, 0 /* +DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /* Return the syntax code of CHAR, described by a character. For example, if CHAR is a word constituent, the character `?w' is returned. The characters that correspond to various syntax codes are listed in the documentation of `modify-syntax-entry'. Optional second argument TABLE defaults to the current buffer's syntax table. -*/ ) - (ch, table) - Lisp_Object ch, table; +*/ + (ch, table)) { CHECK_CHAR_COERCE_INT (ch); table = check_syntax_table (table, current_buffer->syntax_table); @@ -272,13 +265,12 @@ return make_char (stringterm); } -DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 2, 0 /* +DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /* Return the matching parenthesis of CHAR, or nil if none. Optional second argument TABLE defaults to the current buffer's syntax table. -*/ ) - (ch, table) - Lisp_Object ch, table; +*/ + (ch, table)) { int code; CHECK_CHAR_COERCE_INT (ch); @@ -382,14 +374,13 @@ return from; } -DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 2, "_p" /* +DEFUN ("forward-word", Fforward_word, 1, 2, "_p", /* Move point forward ARG words (backward if ARG is negative). Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned. -*/ ) - (count, buffer) - Lisp_Object count, buffer; +*/ + (count, buffer)) { Bufpos val; struct buffer *buf = decode_buffer (buffer, 0); @@ -586,7 +577,7 @@ ever complains about this function not working properly, take a look at those changes. --ben */ -DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 2, 0 /* +DEFUN ("forward-comment", Fforward_comment, 1, 2, 0, /* Move forward across up to N comments. If N is negative, move backward. Stop scanning if we find something other than a comment or whitespace. Set point to where scanning stops. @@ -594,9 +585,8 @@ between them, return t; otherwise return nil. Point is set in either case. Optional argument BUFFER defaults to the current buffer. -*/ ) - (n, buffer) - Lisp_Object n, buffer; +*/ + (n, buffer)) { Bufpos from; Bufpos stop; @@ -1090,7 +1080,7 @@ return quoted; } -DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 5, 0 /* +DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /* Scan from character number FROM by COUNT lists. Returns the character number of the position thus found. @@ -1110,9 +1100,8 @@ If optional arg NOERROR is non-nil, scan-lists will return nil instead of signalling an error. -*/ ) - (from, count, depth, buffer, no_error) - Lisp_Object from, count, depth, buffer, no_error; +*/ + (from, count, depth, buffer, no_error)) { struct buffer *buf; @@ -1125,7 +1114,7 @@ !NILP (no_error)); } -DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 4, 0 /* +DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /* Scan from character number FROM by COUNT balanced expressions. If COUNT is negative, scan backwards. Returns the character number of the position thus found. @@ -1142,9 +1131,8 @@ If optional arg NOERROR is non-nil, scan-sexps will return nil instead of signalling an error. -*/ ) - (from, count, buffer, no_error) - Lisp_Object from, count, buffer, no_error; +*/ + (from, count, buffer, no_error)) { struct buffer *buf = decode_buffer (buffer, 0); CHECK_INT (from); @@ -1153,15 +1141,13 @@ return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (no_error)); } -DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, - 0, 1, 0 /* +DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /* Move point backward over any number of chars with prefix syntax. This includes chars with \"quote\" or \"prefix\" syntax (' or p). Optional arg BUFFER defaults to the current buffer. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); Bufpos beg = BUF_BEGV (buf); @@ -1452,7 +1438,7 @@ *stateptr = state; } -DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 7, 0 /* +DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /* Parse Lisp syntax starting at FROM until TO; return status of parse at TO. Parsing stops at TO or when certain criteria are met; point is set to where parsing stops. @@ -1476,9 +1462,8 @@ It is used to initialize the state of the parse. Its second and third elements are ignored. Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. -*/ ) - (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer) - Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop, buffer; +*/ + (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer)) { struct lisp_parse_state state; int target; @@ -1532,24 +1517,24 @@ { defsymbol (&Qsyntax_table_p, "syntax-table-p"); - defsubr (&Ssyntax_table_p); - defsubr (&Ssyntax_table); - defsubr (&Sstandard_syntax_table); - defsubr (&Scopy_syntax_table); - defsubr (&Sset_syntax_table); - defsubr (&Ssyntax_designator_chars); - defsubr (&Schar_syntax); - defsubr (&Smatching_paren); - /* defsubr (&Smodify_syntax_entry); now in Lisp. */ - /* defsubr (&Sdescribe_syntax); now in Lisp. */ + DEFSUBR (Fsyntax_table_p); + DEFSUBR (Fsyntax_table); + DEFSUBR (Fstandard_syntax_table); + DEFSUBR (Fcopy_syntax_table); + DEFSUBR (Fset_syntax_table); + DEFSUBR (Fsyntax_designator_chars); + DEFSUBR (Fchar_syntax); + DEFSUBR (Fmatching_paren); + /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */ + /* DEFSUBR (Fdescribe_syntax); now in Lisp. */ - defsubr (&Sforward_word); + DEFSUBR (Fforward_word); - defsubr (&Sforward_comment); - defsubr (&Sscan_lists); - defsubr (&Sscan_sexps); - defsubr (&Sbackward_prefix_chars); - defsubr (&Sparse_partial_sexp); + DEFSUBR (Fforward_comment); + DEFSUBR (Fscan_lists); + DEFSUBR (Fscan_sexps); + DEFSUBR (Fbackward_prefix_chars); + DEFSUBR (Fparse_partial_sexp); } void
--- a/src/toolbar.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/toolbar.c Mon Aug 13 08:50:05 2007 +0200 @@ -104,11 +104,10 @@ 0, 0, 0, struct toolbar_button); -DEFUN ("toolbar-button-p", Ftoolbar_button_p, Stoolbar_button_p, 1, 1, 0 /* +DEFUN ("toolbar-button-p", Ftoolbar_button_p, 1, 1, 0, /* Return non-nil if OBJECT is a toolbar button. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (TOOLBAR_BUTTONP (object) ? Qt : Qnil); } @@ -123,48 +122,40 @@ way for this to get us in trouble (like if someone decides to change the toolbar from a toolbar callback). */ -DEFUN ("toolbar-button-callback", Ftoolbar_button_callback, - Stoolbar_button_callback, 1, 1, 0 /* +DEFUN ("toolbar-button-callback", Ftoolbar_button_callback, 1, 1, 0, /* Return the callback function associated with the toolbar BUTTON. -*/ ) - (button) - Lisp_Object button; +*/ + (button)) { CHECK_TOOLBAR_BUTTON (button); return (XTOOLBAR_BUTTON (button)->callback); } -DEFUN ("toolbar-button-help-string", Ftoolbar_button_help_string, - Stoolbar_button_help_string, 1, 1, 0 /* +DEFUN ("toolbar-button-help-string", Ftoolbar_button_help_string, 1, 1, 0, /* Return the help string function associated with the toolbar BUTTON. -*/ ) - (button) - Lisp_Object button; +*/ + (button)) { CHECK_TOOLBAR_BUTTON (button); return (XTOOLBAR_BUTTON (button)->help_string); } -DEFUN ("toolbar-button-enabled-p", Ftoolbar_button_enabled_p, - Stoolbar_button_enabled_p, 1, 1, 0 /* +DEFUN ("toolbar-button-enabled-p", Ftoolbar_button_enabled_p, 1, 1, 0, /* Return t if BUTTON is active. -*/ ) - (button) - Lisp_Object button; +*/ + (button)) { CHECK_TOOLBAR_BUTTON (button); return (XTOOLBAR_BUTTON (button)->enabled ? Qt : Qnil); } -DEFUN ("set-toolbar-button-down-flag", Fset_toolbar_button_down_flag, - Sset_toolbar_button_down_flag, 2, 2, 0 /* +DEFUN ("set-toolbar-button-down-flag", Fset_toolbar_button_down_flag, 2, 2, 0, /* Don't touch. -*/ ) - (button, flag) - Lisp_Object button, flag; +*/ + (button, flag)) { struct toolbar_button *tb; char old_flag; @@ -261,14 +252,12 @@ return TOP_TOOLBAR; /* not reached */ } -DEFUN ("set-default-toolbar-position", Fset_default_toolbar_position, - Sset_default_toolbar_position, 1, 1, 0 /* +DEFUN ("set-default-toolbar-position", Fset_default_toolbar_position, 1, 1, 0, /* Set the position that the `default-toolbar' will be displayed at. Valid positions are 'top, 'bottom, 'left and 'right. See `default-toolbar-position'. -*/ ) - (position) - Lisp_Object position; +*/ + (position)) { enum toolbar_pos cur = decode_toolbar_position (Vdefault_toolbar_position); enum toolbar_pos new = decode_toolbar_position (position); @@ -297,13 +286,12 @@ return position; } -DEFUN ("default-toolbar-position", Fdefault_toolbar_position, - Sdefault_toolbar_position, 0, 0, 0 /* +DEFUN ("default-toolbar-position", Fdefault_toolbar_position, 0, 0, 0, /* Return the position that the `default-toolbar' will be displayed at. The `default-toolbar' will only be displayed here if the corresponding position-specific toolbar specifier does not provide a value. -*/ ) - () +*/ + ()) { return Vdefault_toolbar_position; } @@ -1044,14 +1032,12 @@ /* toolbar button spec is [pixmap-pair function enabled-p help] or [:style 2d-or-3d :size width-or-height] */ -DEFUN ("check-toolbar-button-syntax", Fcheck_toolbar_button_syntax, - Scheck_toolbar_button_syntax, 1, 2, 0 /* +DEFUN ("check-toolbar-button-syntax", Fcheck_toolbar_button_syntax, 1, 2, 0, /* Verify the syntax of entry BUTTON in a toolbar description list. If you want to verify the syntax of a toolbar description list as a whole, use `check-valid-instantiator' with a specifier type of 'toolbar. -*/ ) - (button, no_error) - Lisp_Object button, no_error; +*/ + (button, no_error)) { Lisp_Object *elt, glyphs, value; int len; @@ -1203,8 +1189,7 @@ MARK_TOOLBAR_CHANGED; } -DEFUN ("toolbar-specifier-p", Ftoolbar_specifier_p, - Stoolbar_specifier_p, 1, 1, 0 /* +DEFUN ("toolbar-specifier-p", Ftoolbar_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a toolbar specifier. Toolbar specifiers are used to specify the format of a toolbar. The values of the variables `default-toolbar', `top-toolbar', @@ -1214,9 +1199,8 @@ Valid toolbar instantiators are called \"toolbar descriptors\" and are lists of vectors. See `default-toolbar' for a description of the exact format. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (TOOLBAR_SPECIFIERP (object) ? Qt : Qnil); } @@ -1328,15 +1312,15 @@ defsymbol (&Q_size, ":size"); Fset (Q_size, Q_size); defsymbol (&Qinit_toolbar_from_resources, "init-toolbar-from-resources"); - defsubr (&Stoolbar_button_p); - defsubr (&Stoolbar_button_callback); - defsubr (&Stoolbar_button_help_string); - defsubr (&Stoolbar_button_enabled_p); - defsubr (&Sset_toolbar_button_down_flag); - defsubr (&Scheck_toolbar_button_syntax); - defsubr (&Sset_default_toolbar_position); - defsubr (&Sdefault_toolbar_position); - defsubr (&Stoolbar_specifier_p); + DEFSUBR (Ftoolbar_button_p); + DEFSUBR (Ftoolbar_button_callback); + DEFSUBR (Ftoolbar_button_help_string); + DEFSUBR (Ftoolbar_button_enabled_p); + DEFSUBR (Fset_toolbar_button_down_flag); + DEFSUBR (Fcheck_toolbar_button_syntax); + DEFSUBR (Fset_default_toolbar_position); + DEFSUBR (Fdefault_toolbar_position); + DEFSUBR (Ftoolbar_specifier_p); } void
--- a/src/tooltalk.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/tooltalk.c Mon Aug 13 08:50:05 2007 +0200 @@ -203,11 +203,10 @@ return XTOOLTALK_MESSAGE (msg)->m; } -DEFUN ("tooltalk-message-p", Ftooltalk_message_p, Stooltalk_message_p, 1, 1, 0 /* +DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /* Return non-nil if OBJECT is a tooltalk message. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (TOOLTALK_MESSAGEP (object) ? Qt : Qnil); } @@ -281,11 +280,10 @@ return XTOOLTALK_PATTERN (pattern)->p; } -DEFUN ("tooltalk-pattern-p", Ftooltalk_pattern_p, Stooltalk_pattern_p, 1, 1, 0 /* +DEFUN ("tooltalk-pattern-p", Ftooltalk_pattern_p, 1, 1, 0, /* Return non-nil if OBJECT is a tooltalk pattern. -*/ ) - (object) - Lisp_Object object; +*/ + (object)) { return (TOOLTALK_PATTERNP (object) ? Qt : Qnil); } @@ -312,15 +310,11 @@ Fcons (build_string (tt_status_message (st)), Qnil)); } -DEFUN ("receive-tooltalk-message", - Freceive_tooltalk_message, - Sreceive_tooltalk_message, - 0, 2, 0 /* +DEFUN ("receive-tooltalk-message", Freceive_tooltalk_message, 0, 2, 0, /* Run tt_message_receive(). This function is the process handler for the ToolTalk connection process. -*/ ) - (ignore1, ignore2) - Lisp_Object ignore1, ignore2; /* filters are called with two arguments. */ +*/ + (ignore1, ignore2)) { /* This function can GC */ Tt_message mess = tt_message_receive (); @@ -549,10 +543,7 @@ return make_string (value, len); } -DEFUN ("get-tooltalk-message-attribute", - Fget_tooltalk_message_attribute, - Sget_tooltalk_message_attribute, - 2, 3, 0 /* +DEFUN ("get-tooltalk-message-attribute", Fget_tooltalk_message_attribute, 2, 3, 0, /* Return the indicated Tooltalk message attribute. Attributes are identified by symbols with the same name (underscores and all) as the suffix of the Tooltalk tt_message_<attribute> function that extracts the value. @@ -581,11 +572,8 @@ \"string\" is used for strings and \"int\" for 32 bit integers. Note that Emacs Lisp stores the lengths of strings explicitly (unlike C) so treating the value returned by 'arg_bval like a string is fine. -*/ ) - (msg, attribute, argn) - Lisp_Object msg; - Lisp_Object attribute; - Lisp_Object argn; +*/ + (msg, attribute, argn)) { Tt_message m = unbox_tooltalk_message (msg); int n = 0; @@ -696,10 +684,8 @@ return Qnil; } -DEFUN ("set-tooltalk-message-attribute", - Fset_tooltalk_message_attribute, - Sset_tooltalk_message_attribute, - 3, 4, 0 /* +DEFUN ("set-tooltalk-message-attribute", + Fset_tooltalk_message_attribute, 3, 4, 0, /* Initialize one Tooltalk message attribute. Attribute names and values are the same as for @@ -716,12 +702,8 @@ If one of the argument attributes is specified, 'arg_val, 'arg_ival, or 'arg_bval then argn must be the number of an already created argument. New arguments can be added to a message with add-tooltalk-message-arg. -*/ ) - (value, msg, attribute, argn) - Lisp_Object value; - Lisp_Object msg; - Lisp_Object attribute; - Lisp_Object argn; +*/ + (value, msg, attribute, argn)) { Tt_message m = unbox_tooltalk_message (msg); int n = 0; @@ -861,17 +843,13 @@ return Qnil; } -DEFUN ("return-tooltalk-message", - Freturn_tooltalk_message, - Sreturn_tooltalk_message, - 1, 2, 0 /* +DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /* Send a reply to this message. The second argument can be 'reply, 'reject or 'fail; the default is 'reply. Before sending a reply all message arguments whose mode is TT_INOUT or TT_OUT should have been filled in - see set-tooltalk-message-attribute. -*/ ) - (msg, mode) - Lisp_Object msg, mode; +*/ + (msg, mode)) { Tt_message m = unbox_tooltalk_message (msg); @@ -892,10 +870,7 @@ return Qnil; } -DEFUN ("create-tooltalk-message", - Fcreate_tooltalk_message, - Screate_tooltalk_message, - 0, 1, 0 /* +DEFUN ("create-tooltalk-message", Fcreate_tooltalk_message, 0, 1, 0, /* Create a new tooltalk message. The messages session attribute is initialized to the default session. Other attributes can be initialized with `set-tooltalk-message-attribute'. @@ -904,9 +879,8 @@ Optional arg NO-CALLBACK says don't add a C-level callback at all. Normally don't do that; just don't specify the Lisp callback when calling `make-tooltalk-message'. -*/ ) - (no_callback) - Lisp_Object no_callback; +*/ + (no_callback)) { Tt_message m = tt_message_create (); Lisp_Object msg = make_tooltalk_message (m); @@ -919,17 +893,13 @@ return msg; } -DEFUN ("destroy-tooltalk-message", - Fdestroy_tooltalk_message, - Sdestroy_tooltalk_message, - 1, 1, 0 /* +DEFUN ("destroy-tooltalk-message", Fdestroy_tooltalk_message, 1, 1, 0, /* Apply tt_message_destroy() to the message. It's not necessary to destroy messages after they've been processed by a message or pattern callback; the Lisp/Tooltalk callback machinery does this for you. -*/ ) - (msg) - Lisp_Object msg; +*/ + (msg)) { Tt_message m = unbox_tooltalk_message (msg); @@ -955,10 +925,7 @@ } -DEFUN ("add-tooltalk-message-arg", - Fadd_tooltalk_message_arg, - Sadd_tooltalk_message_arg, - 3, 4, 0 /* +DEFUN ("add-tooltalk-message-arg", Fadd_tooltalk_message_arg, 3, 4, 0, /* Append one new argument to the message. MODE must be one of TT_IN, TT_INOUT, or TT_OUT; VTYPE must be a string; and VALUE can be a string or an integer. Tooltalk doesn't @@ -969,9 +936,8 @@ `set-tooltalk-message-attribute'. The latter is neccessary if you want to initialize the argument with a string that can contain embedded nulls (use 'arg_bval). -*/ ) - (msg, mode, vtype, value) - Lisp_Object msg, mode, vtype, value; +*/ + (msg, mode, vtype, value)) { Tt_message m = unbox_tooltalk_message (msg); Tt_mode n; @@ -1002,16 +968,12 @@ return Qnil; } -DEFUN ("send-tooltalk-message", - Fsend_tooltalk_message, - Ssend_tooltalk_message, - 1, 1, 0 /* +DEFUN ("send-tooltalk-message", Fsend_tooltalk_message, 1, 1, 0, /* Send the message on its way. Once the message has been sent it's almost always a good idea to get rid of it with `destroy-tooltalk-message'. -*/ ) - (msg) - Lisp_Object msg; +*/ + (msg)) { Tt_message m = unbox_tooltalk_message (msg); @@ -1024,14 +986,11 @@ return Qnil; } -DEFUN ("create-tooltalk-pattern", - Fcreate_tooltalk_pattern, - Screate_tooltalk_pattern, - 0, 0, 0 /* +DEFUN ("create-tooltalk-pattern", Fcreate_tooltalk_pattern, 0, 0, 0, /* Create a new Tooltalk pattern. Its session attribute is initialized to be the default session. -*/ ) - () +*/ + ()) { Tt_pattern p = tt_pattern_create (); Lisp_Object pattern = make_tooltalk_pattern (p); @@ -1044,15 +1003,11 @@ } -DEFUN ("destroy-tooltalk-pattern", - Fdestroy_tooltalk_pattern, - Sdestroy_tooltalk_pattern, - 1, 1, 0 /* +DEFUN ("destroy-tooltalk-pattern", Fdestroy_tooltalk_pattern, 1, 1, 0, /* Apply tt_pattern_destroy() to the pattern. This effectively unregisters the pattern. -*/ ) - (pattern) - Lisp_Object pattern; +*/ + (pattern)) { Tt_pattern p = unbox_tooltalk_pattern (pattern); @@ -1066,19 +1021,13 @@ } -DEFUN ("add-tooltalk-pattern-attribute", - Fadd_tooltalk_pattern_attribute, - Sadd_tooltalk_pattern_attribute, - 3, 3, 0 /* +DEFUN ("add-tooltalk-pattern-attribute", Fadd_tooltalk_pattern_attribute, 3, 3, 0, /* Add one value to the indicated pattern attribute. All Tooltalk pattern attributes are supported except 'user. The names of attributes are the same as the Tooltalk accessors used to set them less the \"tooltalk_pattern_\" prefix and the \"_add\" ... -*/ ) - (value, pattern, attribute) - Lisp_Object value; - Lisp_Object pattern; - Lisp_Object attribute; +*/ + (value, pattern, attribute)) { Tt_pattern p = unbox_tooltalk_pattern (pattern); @@ -1176,18 +1125,14 @@ } -DEFUN ("add-tooltalk-pattern-arg", - Fadd_tooltalk_pattern_arg, - Sadd_tooltalk_pattern_arg, - 3, 4, 0 /* +DEFUN ("add-tooltalk-pattern-arg", Fadd_tooltalk_pattern_arg, 3, 4, 0, /* Add one fully specified argument to a tooltalk pattern. Mode must be one of TT_IN, TT_INOUT, or TT_OUT, type must be a string. Value can be an integer, string or nil. If value is an integer then an integer argument (tt_pattern_iarg_add) added otherwise a string argument is added. At present there's no way to add a binary data argument. -*/ ) - (pattern, mode, vtype, value) - Lisp_Object pattern, mode, vtype, value; +*/ + (pattern, mode, vtype, value)) { Tt_pattern p = unbox_tooltalk_pattern (pattern); Tt_mode n; @@ -1220,14 +1165,10 @@ } -DEFUN ("register-tooltalk-pattern", - Fregister_tooltalk_pattern, - Sregister_tooltalk_pattern, - 1, 1, 0 /* +DEFUN ("register-tooltalk-pattern", Fregister_tooltalk_pattern, 1, 1, 0, /* Emacs will begin receiving messages that match this pattern. -*/ ) - (pattern) - Lisp_Object pattern; +*/ + (pattern)) { Tt_pattern p = unbox_tooltalk_pattern (pattern); @@ -1241,14 +1182,10 @@ } -DEFUN ("unregister-tooltalk-pattern", - Funregister_tooltalk_pattern, - Sunregister_tooltalk_pattern, - 1, 1, 0 /* +DEFUN ("unregister-tooltalk-pattern", Funregister_tooltalk_pattern, 1, 1, 0, /* Emacs will stop receiving messages that match this pattern. -*/ ) - (pattern) - Lisp_Object pattern; +*/ + (pattern)) { Tt_pattern p = unbox_tooltalk_pattern (pattern); @@ -1262,57 +1199,42 @@ } -DEFUN ("tooltalk-pattern-prop-get", - Ftooltalk_pattern_prop_get, - Stooltalk_pattern_prop_get, - 2, 2, 0 /* +DEFUN ("tooltalk-pattern-prop-get", Ftooltalk_pattern_prop_get, 2, 2, 0, /* Return the value of PROPERTY in tooltalk pattern PATTERN. This is the last value set with `tooltalk-pattern-prop-set'. -*/ ) - (pattern, property) - Lisp_Object pattern, property; +*/ + (pattern, property)) { CHECK_TOOLTALK_PATTERN (pattern); return Fget (XTOOLTALK_PATTERN (pattern)->plist_sym, property, Qnil); } -DEFUN ("tooltalk-pattern-prop-set", - Ftooltalk_pattern_prop_set, - Stooltalk_pattern_prop_set, - 3, 3, 0 /* +DEFUN ("tooltalk-pattern-prop-set", Ftooltalk_pattern_prop_set, 3, 3, 0, /* Set the value of PROPERTY to VALUE in tooltalk pattern PATTERN. It can be retrieved with `tooltalk-pattern-prop-get'. -*/ ) - (pattern, property, value) - Lisp_Object pattern, property, value; +*/ + (pattern, property, value)) { CHECK_TOOLTALK_PATTERN (pattern); return Fput (XTOOLTALK_PATTERN (pattern)->plist_sym, property, value); } -DEFUN ("tooltalk-pattern-plist-get", - Ftooltalk_pattern_plist_get, - Stooltalk_pattern_plist_get, - 1, 1, 0 /* +DEFUN ("tooltalk-pattern-plist-get", Ftooltalk_pattern_plist_get, 1, 1, 0, /* Return the a list of all the properties currently set in PATTERN. -*/ ) - (pattern) - Lisp_Object pattern; +*/ + (pattern)) { CHECK_TOOLTALK_PATTERN (pattern); return Fcopy_sequence (Fsymbol_plist (XTOOLTALK_PATTERN (pattern)->plist_sym)); } -DEFUN ("tooltalk-default-procid", - Ftooltalk_default_procid, - Stooltalk_default_procid, - 0, 0, 0 /* +DEFUN ("tooltalk-default-procid", Ftooltalk_default_procid, 0, 0, 0, /* Return current default process identifier for your process. -*/ ) - () +*/ + ()) { char *procid = tt_default_procid (); if (!procid) @@ -1320,13 +1242,10 @@ return build_string (procid); } -DEFUN ("tooltalk-default-session", - Ftooltalk_default_session, - Stooltalk_default_session, - 0, 0, 0 /* +DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /* Return current default session identifier for the current default procid. -*/ ) - () +*/ + ()) { char *session = tt_default_session (); if (!session) @@ -1356,7 +1275,7 @@ { /* Don't ask the user for confirmation when exiting Emacs */ Fprocess_kill_without_query (lp, Qnil); - XSETSUBR (fil, &Sreceive_tooltalk_message); + XSETSUBR (fil, &SFreceive_tooltalk_message); set_process_filter (lp, fil, 1); } else @@ -1382,13 +1301,11 @@ #endif } -DEFUN ("tooltalk-open-connection", - Ftooltalk_open_connection, Stooltalk_open_connection, - 0, 0, 0 /* +DEFUN ("tooltalk-open-connection", Ftooltalk_open_connection, 0, 0, 0, /* Opens a connection to the ToolTalk server. Returns t if successful, nil otherwise. -*/ ) - () +*/ + ()) { if (!NILP (Vtooltalk_fd)) error ("Already connected to ToolTalk."); @@ -1403,34 +1320,34 @@ syms_of_tooltalk (void) { defsymbol (&Qtooltalk_messagep, "tooltalk-message-p"); - defsubr (&Stooltalk_message_p); + DEFSUBR (Ftooltalk_message_p); defsymbol (&Qtooltalk_patternp, "tooltalk-pattern-p"); - defsubr (&Stooltalk_pattern_p); + DEFSUBR (Ftooltalk_pattern_p); defsymbol (&Qtooltalk_message_handler_hook, "tooltalk-message-handler-hook"); defsymbol (&Qtooltalk_pattern_handler_hook, "tooltalk-pattern-handler-hook"); defsymbol (&Qtooltalk_unprocessed_message_hook, "tooltalk-unprocessed-message-hook"); - defsubr (&Sreceive_tooltalk_message); - defsubr (&Screate_tooltalk_message); - defsubr (&Sdestroy_tooltalk_message); - defsubr (&Sadd_tooltalk_message_arg); - defsubr (&Sget_tooltalk_message_attribute); - defsubr (&Sset_tooltalk_message_attribute); - defsubr (&Ssend_tooltalk_message); - defsubr (&Sreturn_tooltalk_message); - defsubr (&Screate_tooltalk_pattern); - defsubr (&Sdestroy_tooltalk_pattern); - defsubr (&Sadd_tooltalk_pattern_attribute); - defsubr (&Sadd_tooltalk_pattern_arg); - defsubr (&Sregister_tooltalk_pattern); - defsubr (&Sunregister_tooltalk_pattern); - defsubr (&Stooltalk_pattern_plist_get); - defsubr (&Stooltalk_pattern_prop_set); - defsubr (&Stooltalk_pattern_prop_get); - defsubr (&Stooltalk_default_procid); - defsubr (&Stooltalk_default_session); - defsubr (&Stooltalk_open_connection); + DEFSUBR (Freceive_tooltalk_message); + DEFSUBR (Fcreate_tooltalk_message); + DEFSUBR (Fdestroy_tooltalk_message); + DEFSUBR (Fadd_tooltalk_message_arg); + DEFSUBR (Fget_tooltalk_message_attribute); + DEFSUBR (Fset_tooltalk_message_attribute); + DEFSUBR (Fsend_tooltalk_message); + DEFSUBR (Freturn_tooltalk_message); + DEFSUBR (Fcreate_tooltalk_pattern); + DEFSUBR (Fdestroy_tooltalk_pattern); + DEFSUBR (Fadd_tooltalk_pattern_attribute); + DEFSUBR (Fadd_tooltalk_pattern_arg); + DEFSUBR (Fregister_tooltalk_pattern); + DEFSUBR (Funregister_tooltalk_pattern); + DEFSUBR (Ftooltalk_pattern_plist_get); + DEFSUBR (Ftooltalk_pattern_prop_set); + DEFSUBR (Ftooltalk_pattern_prop_get); + DEFSUBR (Ftooltalk_default_procid); + DEFSUBR (Ftooltalk_default_session); + DEFSUBR (Ftooltalk_open_connection); defsymbol (&Qreceive_tooltalk_message, "receive-tooltalk-message"); defsymbol (&Qtt_address, "address");
--- a/src/undo.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/undo.c Mon Aug 13 08:50:05 2007 +0200 @@ -243,12 +243,12 @@ #endif /* FSFmacs */ -DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0 /* +DEFUN ("undo-boundary", Fundo_boundary, 0, 0, 0, /* Mark a boundary between units of undo. An undo command will stop at this point, but another undo command will undo to the previous boundary. -*/ ) - () +*/ + ()) { if (EQ (current_buffer->undo_list, Qt)) return Qnil; @@ -360,12 +360,11 @@ return Qnil; } -DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0 /* +DEFUN ("primitive-undo", Fprimitive_undo, 2, 2, 0, /* Undo COUNT records from the front of the list LIST. Return what remains of the list. -*/ ) - (count, list) - Lisp_Object count, list; +*/ + (count, list)) { struct gcpro gcpro1, gcpro2; Lisp_Object next = Qnil; @@ -544,8 +543,8 @@ void syms_of_undo (void) { - defsubr (&Sprimitive_undo); - defsubr (&Sundo_boundary); + DEFSUBR (Fprimitive_undo); + DEFSUBR (Fundo_boundary); defsymbol (&Qinhibit_read_only, "inhibit-read-only"); }
--- a/src/vmsfns.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/vmsfns.c Mon Aug 13 08:50:05 2007 +0200 @@ -265,24 +265,20 @@ extern int process_ef; /* Event flag for subprocess operations */ -DEFUN ("default-subprocess-input-handler", - Fdefault_subproc_input_handler, Sdefault_subproc_input_handler, - 2, 2, 0 /* +DEFUN ("default-subprocess-input-handler", Fdefault_subproc_input_handler, 2, 2, 0, /* Default input handler for input from spawned subprocesses. -*/ ) - (name, input) - Lisp_Object name, input; +*/ + (name, input)) { /* Just insert in current buffer */ buffer_insert1 (current_buffer, input); buffer_insert_c_char ('\n'); } -DEFUN ("spawn-subprocess", Fspawn_subprocess, Sspawn_subprocess, 1, 3, 0 /* +DEFUN ("spawn-subprocess", Fspawn_subprocess, 1, 3, 0, /* Spawn an asynchronous VMS suprocess for command processing. -*/ ) - (name, input_handler, exit_handler) - Lisp_Object name, input_handler, exit_handler; +*/ + (name, input_handler, exit_handler)) { /* This function can GC */ int status; @@ -359,13 +355,11 @@ write_to_mbx (ptr, msg, strlen (msg)); } -DEFUN ("send-command-to-subprocess", - Fsend_command_to_subprocess, Ssend_command_to_subprocess, 2, 2, - "sSend command to subprocess: \nsSend subprocess %s command: " /* +DEFUN ("send-command-to-subprocess", Fsend_command_to_subprocess, 2, 2, + "sSend command to subprocess: \nsSend subprocess %s command: ", /* Send to VMS subprocess named NAME the string COMMAND. -*/ ) - (name, command) - Lisp_Object name, command; +*/ + (name, command)) { struct process_list * ptr; @@ -380,12 +374,10 @@ return Qnil; } -DEFUN ("stop-subprocess", Fstop_subprocess, Sstop_subprocess, 1, 1, - "sStop subprocess: " /* +DEFUN ("stop-subprocess", Fstop_subprocess, 1, 1, "sStop subprocess: ", /* Stop VMS subprocess named NAME. -*/ ) - (name) - Lisp_Object name; +*/ + (name)) { struct process_list * ptr; @@ -574,15 +566,14 @@ 0, 0, buf, len, 0, 0, 0, 0); } -DEFUN ("setprv", Fsetprv, Ssetprv, 1, 3, 0 /* +DEFUN ("setprv", Fsetprv, 1, 3, 0, /* Set or reset a VMS privilege. First arg is privilege name. Second arg is t or nil, indicating whether the privilege is to be set or reset. Default is nil. Returns t if success, nil if not. If third arg is non-nil, does not change privilege, but returns t or nil depending upon whether the privilege is already enabled. -*/ ) - (priv, value, getprv) - Lisp_Object priv, value, getprv; +*/ + (priv, value, getprv)) { int prvmask[2], prvlen, newmask[2]; char * prvname; @@ -631,7 +622,7 @@ #ifdef VMS4_4 /* I don't know whether these functions work in old versions */ -DEFUN ("vms-system-info", Fvms_system_info, Svms_system_info, 1, 3, 0 /* +DEFUN ("vms-system-info", Fvms_system_info, 1, 3, 0, /* Retrieve VMS process and system information. The first argument (a string) specifies the type of information desired. The other arguments depend on the type you select. @@ -653,9 +644,8 @@ logical Translates VMS logical name (second argument) dcl-symbol Translates DCL symbol (second argument) proclist Returns list of all PIDs on system (needs WORLD privilege). -*/ ) - (type, arg1, arg2) - Lisp_Object type, arg1, arg2; +*/ + (type, arg1, arg2)) { int i, typelen; char * typename; @@ -916,10 +906,10 @@ return (Fsort (retval, intern ("<"))); } -DEFUN ("shrink-to-icon", Fshrink_to_icon, Sshrink_to_icon, 0, 0, 0 /* +DEFUN ("shrink-to-icon", Fshrink_to_icon, 0, 0, 0, /* If emacs is running in a workstation window, shrink to an icon. -*/ ) - () +*/ + ()) { static char result[128]; static $DESCRIPTOR (result_descriptor, result); @@ -953,14 +943,14 @@ syms_of_vmsfns (void) { - defsubr (&Sdefault_subproc_input_handler); - defsubr (&Sspawn_subprocess); - defsubr (&Ssend_command_to_subprocess); - defsubr (&Sstop_subprocess); - defsubr (&Ssetprv); + DEFSUBR (Fdefault_subproc_input_handler); + DEFSUBR (Fspawn_subprocess); + DEFSUBR (Fsend_command_to_subprocess); + DEFSUBR (Fstop_subprocess); + DEFSUBR (Fsetprv); #ifdef VMS4_4 - defsubr (&Svms_system_info); - defsubr (&Sshrink_to_icon); + DEFSUBR (Fvms_system_info); + DEFSUBR (Fshrink_to_icon); #endif /* VMS4_4 */ defsymbol (&Qdefault_subproc_input_handler, "default-subprocess-input-handler");
--- a/src/vmsproc.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/vmsproc.c Mon Aug 13 08:50:05 2007 +0200 @@ -398,8 +398,7 @@ chdir (XSTRING_DATA (current_buffer->directory)); } -DEFUN ("call-process-internal", Fcall_process_internal, - Scall_process_internal, 1, MANY, 0 /* +DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /* Call PROGRAM synchronously in a separate process. Program's input comes from file INFILE (nil means null device, `NLA0:'). Insert output in BUFFER before point; t means current buffer; @@ -408,10 +407,8 @@ Remaining arguments are strings passed as command arguments to PROGRAM. This function waits for PROGRAM to terminate, unless BUFFER is 0; if you quit, the process is killed. -*/ ) - (nargs, args) - int nargs; - Lisp_Object *args; +*/ + (int nargs, Lisp_Object *args)) { /* This function can GC */ Lisp_Object display, buffer, path; @@ -762,7 +759,7 @@ void syms_of_vmsproc (void) { - defsubr (&Scall_process_internal); + DEFSUBR (Fcall_process_internal); } void
--- a/src/window.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/window.c Mon Aug 13 08:50:05 2007 +0200 @@ -1119,34 +1119,31 @@ } -DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0 /* +DEFUN ("windowp", Fwindowp, 1, 1, 0, /* Return t if OBJ is a window. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return (WINDOWP (obj) ? Qt : Qnil); } -DEFUN ("window-live-p", Fwindow_live_p, Swindow_live_p, 1, 1, 0 /* +DEFUN ("window-live-p", Fwindow_live_p, 1, 1, 0, /* Return t if OBJ is a window which is currently visible. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return (WINDOWP (obj) && WINDOW_LIVE_P (XWINDOW (obj)) ? Qt : Qnil); } -DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 1, 0 /* +DEFUN ("selected-window", Fselected_window, 0, 1, 0, /* Return the window that the cursor now appears in and commands apply to. If the optional argument CON-DEV-OR-FRAME is specified and is a frame, return the selected window used by that frame. If CON-DEV-OR-FRAME is a device, then the selected frame on that device will be used. If CON-DEV-OR-FRAME is a console, the selected frame on that console's selected device will be used. Otherwise, the selected frame is used. -*/ ) - (con_dev_or_frame) - Lisp_Object con_dev_or_frame; +*/ + (con_dev_or_frame)) { struct frame *f; @@ -1157,136 +1154,117 @@ return FRAME_SELECTED_WINDOW (f); } -DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 1, 0 /* +DEFUN ("minibuffer-window", Fminibuffer_window, 0, 1, 0, /* Return the window used now for minibuffers. If the optional argument CON-DEV-OR-FRAME is specified and is a frame, return the minibuffer window used by that frame. If CON-DEV-OR-FRAME is a device, then the selected frame on that device will be used. If CON-DEV-OR-FRAME is a console, the selected frame on that console's selected device will be used. Otherwise, the selected frame is used. -*/ ) - (con_dev_or_frame) - Lisp_Object con_dev_or_frame; +*/ + (con_dev_or_frame)) { struct frame *f = decode_frame_or_selected (con_dev_or_frame); return FRAME_MINIBUF_WINDOW (f); } -DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, Swindow_minibuffer_p, 1, 1, 0 /* +DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, 1, 1, 0, /* Return non-nil if WINDOW is a minibuffer window. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return (MINI_WINDOW_P (w) ? Qt : Qnil); } -DEFUN ("window-first-hchild", Fwindow_first_hchild, Swindow_first_hchild, - 1, 1, 0 /* +DEFUN ("window-first-hchild", Fwindow_first_hchild, 1, 1, 0, /* Return the first horizontal child of WINDOW, or nil. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return w->hchild; } -DEFUN ("window-first-vchild", Fwindow_first_vchild, Swindow_first_vchild, - 1, 1, 0 /* +DEFUN ("window-first-vchild", Fwindow_first_vchild, 1, 1, 0, /* Return the first vertical child of WINDOW, or nil. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return w->vchild; } -DEFUN ("window-next-child", Fwindow_next_child, Swindow_next_child, - 1, 1, 0 /* +DEFUN ("window-next-child", Fwindow_next_child, 1, 1, 0, /* Return the next window on the same level as WINDOW, or nil. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return w->next; } -DEFUN ("window-previous-child", Fwindow_previous_child, Swindow_previous_child, - 1, 1, 0 /* +DEFUN ("window-previous-child", Fwindow_previous_child, 1, 1, 0, /* Return the previous window on the same level as WINDOW, or nil. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return w->prev; } -DEFUN ("window-parent", Fwindow_parent, Swindow_parent, - 1, 1, 0 /* +DEFUN ("window-parent", Fwindow_parent, 1, 1, 0, /* Return the parent of WINDOW, or nil. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return w->parent; } -DEFUN ("window-lowest-p", Fwindow_lowest_p, Swindow_lowest_p, 1, 1, 0 /* +DEFUN ("window-lowest-p", Fwindow_lowest_p, 1, 1, 0, /* Return non-nil if WINDOW is along the bottom of its frame. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return window_is_lowest (w) ? Qt : Qnil; } -DEFUN ("window-highest-p", Fwindow_highest_p, Swindow_highest_p, 1, 1, 0 /* +DEFUN ("window-highest-p", Fwindow_highest_p, 1, 1, 0, /* Return non-nil if WINDOW is along the top of its frame. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return window_is_highest (w) ? Qt : Qnil; } -DEFUN ("window-leftmost-p", Fwindow_leftmost_p, Swindow_leftmost_p, 1, 1, 0 /* +DEFUN ("window-leftmost-p", Fwindow_leftmost_p, 1, 1, 0, /* Return non-nil if WINDOW is along the left edge of its frame. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return window_is_leftmost (w) ? Qt : Qnil; } -DEFUN ("window-rightmost-p", Fwindow_rightmost_p, Swindow_rightmost_p, - 1, 1, 0 /* +DEFUN ("window-rightmost-p", Fwindow_rightmost_p, 1, 1, 0, /* Return non-nil if WINDOW is along the right edge of its frame. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return window_is_rightmost (w) ? Qt : Qnil; } -DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p, - Spos_visible_in_window_p, 0, 2, 0 /* +DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p, 0, 2, 0, /* Return t if position POS is currently on the frame in WINDOW. Returns nil if that position is scrolled vertically out of view. POS defaults to point in WINDOW's buffer; WINDOW, to the selected window. -*/ ) - (pos, window) - Lisp_Object pos, window; +*/ + (pos, window)) { struct window *w; Bufpos top; @@ -1330,25 +1308,23 @@ return XWINDOW (window); } -DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0 /* +DEFUN ("window-buffer", Fwindow_buffer, 0, 1, 0, /* Return the buffer that WINDOW is displaying. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return decode_window (window)->buffer; } -DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 0, 1, 0 /* +DEFUN ("window-frame", Fwindow_frame, 0, 1, 0, /* Return the frame that window WINDOW is on. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return decode_window (window)->frame; } -DEFUN ("window-height", Fwindow_height, Swindow_height, 0, 1, 0 /* +DEFUN ("window-height", Fwindow_height, 0, 1, 0, /* Return the number of default lines in WINDOW. This actually works by dividing the window's pixel height (including the modeline and horizontal scrollbar, if any) by the height of the @@ -1357,15 +1333,13 @@ Use `window-height' to get consistent results in geometry calculations. Use `window-displayed-height' to get the actual number of lines currently displayed in a window. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return make_int (window_char_height (decode_window (window), 1)); } -DEFUN ("window-displayed-height", Fwindow_displayed_height, - Swindow_displayed_height, 0, 1, 0 /* +DEFUN ("window-displayed-height", Fwindow_displayed_height, 0, 1, 0, /* Return the number of lines currently displayed in WINDOW. This counts the actual number of lines displayed in WINDOW (as opposed to `window-height'). The modeline and horizontal @@ -1373,60 +1347,52 @@ between the end of the buffer and the end of the window, this function pretends that there are lines of text in the default font there. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return make_int (window_displayed_height (decode_window (window))); } -DEFUN ("window-pixel-height", Fwindow_pixel_height, Swindow_pixel_height, - 0, 1, 0 /* +DEFUN ("window-pixel-height", Fwindow_pixel_height, 0, 1, 0, /* Return the height of WINDOW in pixels. Defaults to current window. This includes the window's modeline and horizontal scrollbar (if any). -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return (make_int (decode_window (window)->pixel_height)); } -DEFUN ("window-width", Fwindow_width, Swindow_width, 0, 1, 0 /* +DEFUN ("window-width", Fwindow_width, 0, 1, 0, /* Return the number of display columns in WINDOW. This is the width that is usable columns available for text in WINDOW. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return (make_int (window_char_width (w, 0))); } -DEFUN ("window-pixel-width", Fwindow_pixel_width, Swindow_pixel_width, - 0, 1, 0 /* +DEFUN ("window-pixel-width", Fwindow_pixel_width, 0, 1, 0, /* Return the width of WINDOW in pixels. Defaults to current window. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return (make_int (decode_window (window)->pixel_width)); } -DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0 /* +DEFUN ("window-hscroll", Fwindow_hscroll, 0, 1, 0, /* Return the number of columns by which WINDOW is scrolled from left margin. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return (make_int (decode_window (window)->hscroll)); } -DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0 /* +DEFUN ("set-window-hscroll", Fset_window_hscroll, 2, 2, 0, /* Set number of columns WINDOW is scrolled from left margin to NCOL. NCOL should be zero or positive. -*/ ) - (window, ncol) - Lisp_Object window, ncol; +*/ + (window, ncol)) { struct window *w; int ncols; @@ -1475,14 +1441,12 @@ #endif /* 0 */ -DEFUN ("window-pixel-edges", Fwindow_pixel_edges, Swindow_pixel_edges, - 0, 1, 0 /* +DEFUN ("window-pixel-edges", Fwindow_pixel_edges, 0, 1, 0, /* Return a list of the pixel edge coordinates of WINDOW. \(LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at top left corner of frame. The frame toolbars and menubars are considered to be outside of this area. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); struct frame *f = XFRAME (w->frame); @@ -1497,7 +1461,7 @@ make_int (top + w->pixel_height)); } -DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0 /* +DEFUN ("window-point", Fwindow_point, 0, 1, 0, /* Return current value of point in WINDOW. For a nonselected window, this is the value point would have if that window were selected. @@ -1507,9 +1471,8 @@ It would be more strictly correct to return the `top-level' value of point, outside of any save-excursion forms. But that is hard to define. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); @@ -1521,17 +1484,16 @@ return Fmarker_position (w->pointm[CURRENT_DISP]); } -DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0 /* +DEFUN ("window-start", Fwindow_start, 0, 1, 0, /* Return position at which display currently starts in WINDOW. This is updated by redisplay or by calling `set-window-start'. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return Fmarker_position (decode_window (window)->start[CURRENT_DISP]); } -DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 2, 0 /* +DEFUN ("window-end", Fwindow_end, 0, 2, 0, /* Return position at which display currently ends in WINDOW. This is updated by redisplay, when it runs to completion. Simply changing the buffer text or setting `window-start' @@ -1540,9 +1502,8 @@ the value of window-end at the end of the next full redisplay assuming nothing else changes in the meantime. This function is potentially much slower with this flag set. -*/ ) - (window, guarantee) - Lisp_Object window, guarantee; +*/ + (window, guarantee)) { Lisp_Object value; struct window *w = decode_window (window); @@ -1564,11 +1525,10 @@ } } -DEFUN ("set-window-point", Fset_window_point, Sset_window_point, 2, 2, 0 /* +DEFUN ("set-window-point", Fset_window_point, 2, 2, 0, /* Make point value in WINDOW be at position POS in WINDOW's buffer. -*/ ) - (window, pos) - Lisp_Object window, pos; +*/ + (window, pos)) { struct window *w = decode_window (window); @@ -1582,13 +1542,12 @@ return pos; } -DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0 /* +DEFUN ("set-window-start", Fset_window_start, 2, 3, 0, /* Make display in WINDOW start at position POS in WINDOW's buffer. Optional third arg NOFORCE non-nil inhibits next redisplay from overriding motion of point in order to display at this exact start. -*/ ) - (window, pos, noforce) - Lisp_Object window, pos, noforce; +*/ + (window, pos, noforce)) { struct window *w = decode_window (window); @@ -1607,27 +1566,23 @@ return pos; } -DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p, - 1, 1, 0 /* +DEFUN ("window-dedicated-p", Fwindow_dedicated_p, 1, 1, 0, /* Return WINDOW's dedicated object, usually t or nil. See also `set-window-dedicated-p'. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { return decode_window (window)->dedicated; } -DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p, - Sset_window_dedicated_p, 2, 2, 0 /* +DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p, 2, 2, 0, /* Control whether WINDOW is dedicated to the buffer it displays. If it is dedicated, Emacs will not automatically change which buffer appears in it. The second argument is the new value for the dedication flag; non-nil means yes. -*/ ) - (window, arg) - Lisp_Object window, arg; +*/ + (window, arg)) { register struct window *w = decode_window (window); @@ -1759,16 +1714,15 @@ finalize_window ((void *) w, 0); } -DEFUN ("delete-window", Fdelete_window, Sdelete_window, 0, 2, "" /* +DEFUN ("delete-window", Fdelete_window, 0, 2, "", /* Remove WINDOW from the display. Default is selected window. If window is the only one on the frame, the frame is destroyed. Normally, you cannot delete the last non-minibuffer-only frame (you must use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional second argument FORCE is non-nil, you can delete the last frame. (This will automatically call `save-buffers-kill-emacs'.) -*/ ) - (window, force) - Lisp_Object window, force; +*/ + (window, force)) { /* This function can GC if this is the only window in the frame */ struct window *w; @@ -1934,7 +1888,7 @@ } -DEFUN ("next-window", Fnext_window, Snext_window, 0, 4, 0 /* +DEFUN ("next-window", Fnext_window, 0, 4, 0, /* Return next window after WINDOW in canonical ordering of windows. If omitted, WINDOW defaults to the selected window. @@ -1968,9 +1922,8 @@ can use `next-window' to iterate through the entire cycle of acceptable windows, eventually ending up back at the window you started with. `previous-window' traverses the same cycle, in the reverse order. -*/ ) - (window, minibuf, all_frames, console) - Lisp_Object window, minibuf, all_frames, console; +*/ + (window, minibuf, all_frames, console)) { Lisp_Object tem; Lisp_Object start_window; @@ -2078,7 +2031,7 @@ return window; } -DEFUN ("previous-window", Fprevious_window, Sprevious_window, 0, 4, 0 /* +DEFUN ("previous-window", Fprevious_window, 0, 4, 0, /* Return the window preceeding WINDOW in canonical ordering of windows. If omitted, WINDOW defaults to the selected window. @@ -2112,9 +2065,8 @@ can use `previous-window' to iterate through the entire cycle of acceptable windows, eventually ending up back at the window you started with. `next-window' traverses the same cycle, in the reverse order. -*/ ) - (window, minibuf, all_frames, console) - Lisp_Object window, minibuf, all_frames, console; +*/ + (window, minibuf, all_frames, console)) { Lisp_Object tem; Lisp_Object start_window; @@ -2240,12 +2192,10 @@ return window; } -DEFUN ("next-vertical-window", Fnext_vertical_window, Snext_vertical_window, - 0, 1, 0 /* +DEFUN ("next-vertical-window", Fnext_vertical_window, 0, 1, 0, /* Return the next window which is vertically after WINDOW. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { Lisp_Object root; struct window *w = decode_window (window); @@ -2291,7 +2241,7 @@ return window; } -DEFUN ("other-window", Fother_window, Sother_window, 1, 3, "p" /* +DEFUN ("other-window", Fother_window, 1, 3, "p", /* Select the N'th different window on this frame. All windows on current frame are arranged in a cyclic order. This command selects the window N steps away in that order. @@ -2311,9 +2261,8 @@ window-system consoles. If CONSOLE is nil or omitted, return windows only on FRAME'S console, or on the selected console if FRAME is not a frame. Otherwise, all windows are considered. -*/ ) - (n, frame, console) - Lisp_Object n, frame, console; +*/ + (n, frame, console)) { int i; Lisp_Object w; @@ -2685,7 +2634,7 @@ #endif -DEFUN ("get-lru-window", Fget_lru_window, Sget_lru_window, 0, 2, 0 /* +DEFUN ("get-lru-window", Fget_lru_window, 0, 2, 0, /* Return the window least recently selected or used for display. If optional argument FRAME is `visible', search all visible frames. If FRAME is 0, search all visible and iconified frames. @@ -2701,9 +2650,8 @@ window-system consoles. If CONSOLE is nil or omitted, return windows only on FRAME'S console, or on the selected console if FRAME is not a frame. Otherwise, all windows are considered. -*/ ) - (frame, console) - Lisp_Object frame, console; +*/ + (frame, console)) { Lisp_Object w; /* First try for a non-dedicated window that is full-width */ @@ -2736,7 +2684,7 @@ return (w); } -DEFUN ("get-largest-window", Fget_largest_window, Sget_largest_window, 0, 2, 0 /* +DEFUN ("get-largest-window", Fget_largest_window, 0, 2, 0, /* Return the window largest in area. If optional argument FRAME is `visible', search all visible frames. If FRAME is 0, search all visible and iconified frames. @@ -2752,9 +2700,8 @@ window-system consoles. If CONSOLE is nil or omitted, return windows only on FRAME'S console, or on the selected console if FRAME is not a frame. Otherwise, all windows are considered. -*/ ) - (frame, console) - Lisp_Object frame, console; +*/ + (frame, console)) { /* Don't search dedicated windows because FSFmacs doesn't. This stuff is all black magic so don't try to apply common @@ -2762,7 +2709,7 @@ return window_loop (GET_LARGEST_WINDOW, Qnil, 0, frame, 0, console); } -DEFUN ("get-buffer-window", Fget_buffer_window, Sget_buffer_window, 1, 3, 0 /* +DEFUN ("get-buffer-window", Fget_buffer_window, 1, 3, 0, /* Return a window currently displaying BUFFER, or nil if none. If optional argument FRAME is `visible', search all visible frames. If optional argument FRAME is 0, search all visible and iconified frames. @@ -2778,9 +2725,8 @@ window-system consoles. If CONSOLE is nil or omitted, return windows only on FRAME'S console, or on the selected console if FRAME is not a frame. Otherwise, all windows are considered. -*/ ) - (buffer, frame, console) - Lisp_Object buffer, frame, console; +*/ + (buffer, frame, console)) { buffer = Fget_buffer (buffer); if (BUFFERP (buffer)) @@ -2794,34 +2740,31 @@ but there is no sensible way to implement those functions, since you can't in general derive a window from a buffer. */ -DEFUN ("window-left-margin-pixel-width", Fwindow_left_margin_pixel_width, - Swindow_left_margin_pixel_width, 0, 1, 0 /* +DEFUN ("window-left-margin-pixel-width", + Fwindow_left_margin_pixel_width, 0, 1, 0, /* Return the width in pixels of the left outside margin of window WINDOW. If WINDOW is nil, the selected window is assumed. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return (make_int (window_left_margin_width (w))); } -DEFUN ("window-right-margin-pixel-width", Fwindow_right_margin_pixel_width, - Swindow_right_margin_pixel_width, 0, 1, 0 /* +DEFUN ("window-right-margin-pixel-width", + Fwindow_right_margin_pixel_width, 0, 1, 0, /* Return the width in pixels of the right outside margin of window WINDOW. If WINDOW is nil, the selected window is assumed. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); return (make_int (window_right_margin_width (w))); } -DEFUN ("delete-other-windows", Fdelete_other_windows, Sdelete_other_windows, - 0, 1, "" /* +DEFUN ("delete-other-windows", Fdelete_other_windows, 0, 1, "", /* Make WINDOW (or the selected window) fill its frame. Only the frame WINDOW is on is affected. This function tries to reduce display jumps @@ -2830,9 +2773,8 @@ 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. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w = decode_window (window); struct buffer *b = XBUFFER (w->buffer); @@ -2873,8 +2815,8 @@ return Qnil; } -DEFUN ("delete-windows-on", Fdelete_windows_on, Sdelete_windows_on, - 1, 3, "bDelete windows on (buffer): " /* +DEFUN ("delete-windows-on", Fdelete_windows_on, 1, 3, + "bDelete windows on (buffer): ", /* Delete all windows showing BUFFER. Optional second argument FRAME controls which frames are affected. If nil or omitted, delete all windows showing BUFFER in any frame. @@ -2890,9 +2832,8 @@ window-system consoles. If CONSOLE is nil or omitted, return windows only on FRAME'S console, or on the selected console if FRAME is not a frame. Otherwise, all windows are considered. -*/ ) - (buffer, frame, console) - Lisp_Object buffer, frame, console; +*/ + (buffer, frame, console)) { /* This function can GC */ /* FRAME uses t and nil to mean the opposite of what window_loop @@ -2910,13 +2851,11 @@ return Qnil; } -DEFUN ("replace-buffer-in-windows", Freplace_buffer_in_windows, - Sreplace_buffer_in_windows, - 1, 1, "bReplace buffer in windows: " /* +DEFUN ("replace-buffer-in-windows", Freplace_buffer_in_windows, 1, 1, + "bReplace buffer in windows: ", /* Replace BUFFER with some other buffer in all windows showing it. -*/ ) - (buffer) - Lisp_Object buffer; +*/ + (buffer)) { /* This function can GC */ if (!NILP (buffer)) @@ -3098,12 +3037,11 @@ static int window_select_count; -DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 2, 0 /* +DEFUN ("set-window-buffer", Fset_window_buffer, 2, 2, 0, /* Make WINDOW display BUFFER as its contents. BUFFER can be a buffer or buffer name. -*/ ) - (window, buffer) - Lisp_Object window, buffer; +*/ + (window, buffer)) { Lisp_Object tem; struct window *w = decode_window (window); @@ -3167,13 +3105,12 @@ return Qnil; } -DEFUN ("select-window", Fselect_window, Sselect_window, 1, 1, 0 /* +DEFUN ("select-window", Fselect_window, 1, 1, 0, /* Select WINDOW. Most editing will apply to WINDOW's buffer. The main editor command loop selects the buffer of the selected window before each command. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window *w; Lisp_Object old_selected_window = Fselected_window (Qnil); @@ -3338,14 +3275,13 @@ p->buffer = Qnil; } -DEFUN ("split-window", Fsplit_window, Ssplit_window, 0, 3, "" /* +DEFUN ("split-window", Fsplit_window, 0, 3, "", /* 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 HOR-FLAG is non-nil, split side by side and put SIZE columns in the first of the pair. -*/ ) - (window, chsize, horflag) - Lisp_Object window, chsize, horflag; +*/ + (window, chsize, horflag)) { Lisp_Object new; struct window *o, *p; @@ -3477,14 +3413,13 @@ } -DEFUN ("enlarge-window", Fenlarge_window, Senlarge_window, 1, 3, "_p" /* +DEFUN ("enlarge-window", Fenlarge_window, 1, 3, "_p", /* Make the selected window ARG lines bigger. From program, optional second arg non-nil means grow sideways ARG columns, and optional third ARG specifies the window to change instead of the selected window. -*/ ) - (n, side, window) - Lisp_Object n, side, window; +*/ + (n, side, window)) { struct window *w = decode_window (window); CHECK_INT (n); @@ -3492,14 +3427,13 @@ return Qnil; } -DEFUN ("shrink-window", Fshrink_window, Sshrink_window, 1, 3, "_p" /* +DEFUN ("shrink-window", Fshrink_window, 1, 3, "_p", /* Make the selected window ARG lines smaller. From program, optional second arg non-nil means shrink sideways ARG columns, and optional third ARG specifies the window to change instead of the selected window. -*/ ) - (n, side, window) - Lisp_Object n, side, window; +*/ + (n, side, window)) { struct window *w = decode_window (window); CHECK_INT (n); @@ -4107,40 +4041,38 @@ } -DEFUN ("scroll-up", Fscroll_up, Sscroll_up, 0, 1, "_P" /* +DEFUN ("scroll-up", Fscroll_up, 0, 1, "_P", /* Scroll text of current window upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil. -*/ ) - (n) - Lisp_Object n; +*/ + (n)) { window_scroll (Fselected_window (Qnil), n, 1, ERROR_ME); return Qnil; } -DEFUN ("scroll-down", Fscroll_down, Sscroll_down, 0, 1, "_P" /* +DEFUN ("scroll-down", Fscroll_down, 0, 1, "_P", /* Scroll text of current window downward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil. -*/ ) - (n) - Lisp_Object n; +*/ + (n)) { window_scroll (Fselected_window (Qnil), n, -1, ERROR_ME); return Qnil; } -DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, Sother_window_for_scrolling, 0, 0, 0 /* +DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, 0, 0, 0, /* Return the other window for \"other window scroll\" commands. If in the minibuffer, `minibuffer-scroll-window' if non-nil specifies the window. If `other-window-scroll-buffer' is non-nil, a window showing that buffer is used. -*/ ) - () +*/ + ()) { Lisp_Object window; Lisp_Object selected_window = Fselected_window (Qnil); @@ -4178,7 +4110,7 @@ return window; } -DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "_P" /* +DEFUN ("scroll-other-window", Fscroll_other_window, 0, 1, "_P", /* Scroll next window upward ARG lines; or near full frame if no ARG. The next window is the one below the current one; or the one at the top if the current one is at the bottom. Negative ARG means scroll downward. @@ -4188,20 +4120,18 @@ specifies the window to scroll. If `other-window-scroll-buffer' is non-nil, scroll the window showing that buffer, popping the buffer up if necessary. -*/ ) - (n) - Lisp_Object n; +*/ + (n)) { window_scroll (Fother_window_for_scrolling (), n, 1, ERROR_ME); return Qnil; } -DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 1, "_P" /* +DEFUN ("scroll-left", Fscroll_left, 0, 1, "_P", /* Scroll selected window display ARG columns left. Default for ARG is window width minus 2. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { Lisp_Object window = Fselected_window (Qnil); struct window *w = XWINDOW (window); @@ -4215,12 +4145,11 @@ Fset_window_hscroll (window, make_int (w->hscroll + XINT (arg))); } -DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 1, "_P" /* +DEFUN ("scroll-right", Fscroll_right, 0, 1, "_P", /* Scroll selected window display ARG columns right. Default for ARG is window width minus 2. -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { Lisp_Object window = Fselected_window (Qnil); struct window *w = XWINDOW (window); @@ -4234,16 +4163,15 @@ Fset_window_hscroll (window, make_int (w->hscroll - XINT (arg))); } -DEFUN ("recenter", Frecenter, Srecenter, 0, 2, "_P" /* +DEFUN ("recenter", Frecenter, 0, 2, "_P", /* Center point in WINDOW and redisplay frame. With ARG, put point on line ARG. The desired position of point is always relative to the window. Just C-u as prefix means put point in the center of the window. No arg (i.e., it is nil) erases the entire frame and then redraws with point in the center of the window. If WINDOW is nil, the selected window is used. -*/ ) - (n, window) - Lisp_Object n, window; +*/ + (n, window)) { struct window *w; struct buffer *b; @@ -4287,16 +4215,14 @@ return Qnil; } -DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line, - 1, 2, "_P" /* +DEFUN ("move-to-window-line", Fmove_to_window_line, 1, 2, "_P", /* Position point relative to WINDOW. With no argument, position text at center of window. An argument specifies window line; zero means top of window, negative means relative to bottom of window. If WINDOW is nil, the selected window is used. -*/ ) - (arg, window) - Lisp_Object arg, window; +*/ + (arg, window)) { struct window *w; struct buffer *b; @@ -4512,8 +4438,7 @@ compute_window_mirror_usage (find_window_mirror (w), stats, ovstats); } -DEFUN ("window-memory-usage", Fwindow_memory_usage, Swindow_memory_usage, - 1, 1, 0 /* +DEFUN ("window-memory-usage", Fwindow_memory_usage, 1, 1, 0, /* Return stats about the memory usage of window WINDOW. The values returned are in the form an alist of usage types and byte counts. The byte counts attempt to encompass all the memory used @@ -4531,9 +4456,8 @@ particular way of partitioning it into groups. Within a slice, there is no overlap between the groups of memory, and each slice collectively represents all the memory concerned. -*/ ) - (window) - Lisp_Object window; +*/ + (window)) { struct window_stats stats; struct overhead_stats ovstats; @@ -4778,12 +4702,10 @@ return 1; } -DEFUN ("window-configuration-p", Fwindow_configuration_p, - Swindow_configuration_p, 1, 1, 0 /* +DEFUN ("window-configuration-p", Fwindow_configuration_p, 1, 1, 0, /* T if OBJECT is a window-configuration object. -*/ ) - (obj) - Lisp_Object obj; +*/ + (obj)) { return (WINDOW_CONFIGURATIONP (obj) ? Qt : Qnil); } @@ -4853,15 +4775,12 @@ return Qnil; } -DEFUN ("set-window-configuration", - Fset_window_configuration, Sset_window_configuration, - 1, 1, 0 /* +DEFUN ("set-window-configuration", Fset_window_configuration, 1, 1, 0, /* Set the configuration of windows and buffers as specified by CONFIGURATION. CONFIGURATION must be a value previously returned by `current-window-configuration' (which see). -*/ ) - (configuration) - Lisp_Object configuration; +*/ + (configuration)) { struct window *w; struct window_config *config; @@ -5343,17 +5262,15 @@ */ #endif -DEFUN ("current-window-configuration", - Fcurrent_window_configuration, Scurrent_window_configuration, 0, 1, 0 /* +DEFUN ("current-window-configuration", Fcurrent_window_configuration, 0, 1, 0, /* Return an object representing the current window configuration of FRAME. If FRAME is nil or omitted, use the selected frame. This describes the number of windows, their sizes and current buffers, and for each displayed buffer, where display starts, and the positions of point and mark. An exception is made for point in the current buffer: its value is -not- saved. -*/ ) - (frame) - Lisp_Object frame; +*/ + (frame)) { Lisp_Object result = Qnil; struct frame *f; @@ -5403,15 +5320,13 @@ return val; } -DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion, - 0, UNEVALLED, 0 /* +DEFUN ("save-window-excursion", Fsave_window_excursion, 0, UNEVALLED, 0, /* Execute body, preserving window sizes and contents. Restores which buffer appears in which window, where display starts, as well as the current buffer. Does not restore the value of point in current buffer. -*/ ) - (args) - Lisp_Object args; +*/ + (args)) { /* This function can GC */ Lisp_Object val; @@ -5495,75 +5410,75 @@ /* Qother in general.c */ #endif - defsubr (&Sselected_window); - defsubr (&Sminibuffer_window); - defsubr (&Swindow_minibuffer_p); - defsubr (&Swindowp); - defsubr (&Swindow_live_p); - defsubr (&Swindow_first_hchild); - defsubr (&Swindow_first_vchild); - defsubr (&Swindow_next_child); - defsubr (&Swindow_previous_child); - defsubr (&Swindow_parent); - defsubr (&Swindow_lowest_p); - defsubr (&Swindow_highest_p); - defsubr (&Swindow_leftmost_p); - defsubr (&Swindow_rightmost_p); - defsubr (&Spos_visible_in_window_p); - defsubr (&Swindow_buffer); - defsubr (&Swindow_frame); - defsubr (&Swindow_height); - defsubr (&Swindow_displayed_height); - defsubr (&Swindow_width); - defsubr (&Swindow_pixel_height); - defsubr (&Swindow_pixel_width); - defsubr (&Swindow_hscroll); + DEFSUBR (Fselected_window); + DEFSUBR (Fminibuffer_window); + DEFSUBR (Fwindow_minibuffer_p); + DEFSUBR (Fwindowp); + DEFSUBR (Fwindow_live_p); + DEFSUBR (Fwindow_first_hchild); + DEFSUBR (Fwindow_first_vchild); + DEFSUBR (Fwindow_next_child); + DEFSUBR (Fwindow_previous_child); + DEFSUBR (Fwindow_parent); + DEFSUBR (Fwindow_lowest_p); + DEFSUBR (Fwindow_highest_p); + DEFSUBR (Fwindow_leftmost_p); + DEFSUBR (Fwindow_rightmost_p); + DEFSUBR (Fpos_visible_in_window_p); + DEFSUBR (Fwindow_buffer); + DEFSUBR (Fwindow_frame); + DEFSUBR (Fwindow_height); + DEFSUBR (Fwindow_displayed_height); + DEFSUBR (Fwindow_width); + DEFSUBR (Fwindow_pixel_height); + DEFSUBR (Fwindow_pixel_width); + DEFSUBR (Fwindow_hscroll); #if 0 /* bogus RMS crock */ - defsubr (&Swindow_redisplay_end_trigger); - defsubr (&Sset_window_redisplay_end_trigger); + DEFSUBR (Fwindow_redisplay_end_trigger); + DEFSUBR (Fset_window_redisplay_end_trigger); #endif - defsubr (&Sset_window_hscroll); - defsubr (&Swindow_pixel_edges); - defsubr (&Swindow_point); - defsubr (&Swindow_start); - defsubr (&Swindow_end); - defsubr (&Sset_window_point); - defsubr (&Sset_window_start); - defsubr (&Swindow_dedicated_p); - defsubr (&Sset_window_dedicated_p); - defsubr (&Snext_window); - defsubr (&Sprevious_window); - defsubr (&Snext_vertical_window); - defsubr (&Sother_window); - defsubr (&Sget_lru_window); - defsubr (&Sget_largest_window); - defsubr (&Sget_buffer_window); - defsubr (&Swindow_left_margin_pixel_width); - defsubr (&Swindow_right_margin_pixel_width); - defsubr (&Sdelete_other_windows); - defsubr (&Sdelete_windows_on); - defsubr (&Sreplace_buffer_in_windows); - defsubr (&Sdelete_window); - defsubr (&Sset_window_buffer); - defsubr (&Sselect_window); - defsubr (&Ssplit_window); - defsubr (&Senlarge_window); - defsubr (&Sshrink_window); - defsubr (&Sscroll_up); - defsubr (&Sscroll_down); - defsubr (&Sscroll_left); - defsubr (&Sscroll_right); - defsubr (&Sother_window_for_scrolling); - defsubr (&Sscroll_other_window); - defsubr (&Srecenter); - defsubr (&Smove_to_window_line); + DEFSUBR (Fset_window_hscroll); + DEFSUBR (Fwindow_pixel_edges); + DEFSUBR (Fwindow_point); + DEFSUBR (Fwindow_start); + DEFSUBR (Fwindow_end); + DEFSUBR (Fset_window_point); + DEFSUBR (Fset_window_start); + DEFSUBR (Fwindow_dedicated_p); + DEFSUBR (Fset_window_dedicated_p); + DEFSUBR (Fnext_window); + DEFSUBR (Fprevious_window); + DEFSUBR (Fnext_vertical_window); + DEFSUBR (Fother_window); + DEFSUBR (Fget_lru_window); + DEFSUBR (Fget_largest_window); + DEFSUBR (Fget_buffer_window); + DEFSUBR (Fwindow_left_margin_pixel_width); + DEFSUBR (Fwindow_right_margin_pixel_width); + DEFSUBR (Fdelete_other_windows); + DEFSUBR (Fdelete_windows_on); + DEFSUBR (Freplace_buffer_in_windows); + DEFSUBR (Fdelete_window); + DEFSUBR (Fset_window_buffer); + DEFSUBR (Fselect_window); + DEFSUBR (Fsplit_window); + DEFSUBR (Fenlarge_window); + DEFSUBR (Fshrink_window); + DEFSUBR (Fscroll_up); + DEFSUBR (Fscroll_down); + DEFSUBR (Fscroll_left); + DEFSUBR (Fscroll_right); + DEFSUBR (Fother_window_for_scrolling); + DEFSUBR (Fscroll_other_window); + DEFSUBR (Frecenter); + DEFSUBR (Fmove_to_window_line); #ifdef MEMORY_USAGE_STATS - defsubr (&Swindow_memory_usage); + DEFSUBR (Fwindow_memory_usage); #endif - defsubr (&Swindow_configuration_p); - defsubr (&Sset_window_configuration); - defsubr (&Scurrent_window_configuration); - defsubr (&Ssave_window_excursion); + DEFSUBR (Fwindow_configuration_p); + DEFSUBR (Fset_window_configuration); + DEFSUBR (Fcurrent_window_configuration); + DEFSUBR (Fsave_window_excursion); } void
--- a/src/xselect.c Mon Aug 13 08:49:44 2007 +0200 +++ b/src/xselect.c Mon Aug 13 08:50:05 2007 +0200 @@ -1053,12 +1053,10 @@ static Lisp_Object Qx_selection_reply_timeout_internal; DEFUN ("x-selection-reply-timeout-internal", - Fx_selection_reply_timeout_internal, - Sx_selection_reply_timeout_internal, 1, 1, 0 /* + Fx_selection_reply_timeout_internal, 1, 1, 0, /* -*/ ) - (arg) - Lisp_Object arg; +*/ + (arg)) { selection_reply_timed_out = 1; reading_selection_reply = 0; @@ -1652,16 +1650,13 @@ } -DEFUN ("x-own-selection-internal", - Fx_own_selection_internal, Sx_own_selection_internal, - 2, 2, 0 /* +DEFUN ("x-own-selection-internal", Fx_own_selection_internal, 2, 2, 0, /* Assert an X selection of the given TYPE with the given VALUE. TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. VALUE is typically a string, or a cons of two markers, but may be anything that the functions on selection-converter-alist know about. -*/ ) - (selection_name, selection_value) - Lisp_Object selection_name, selection_value; +*/ + (selection_name, selection_value)) { CHECK_SYMBOL (selection_name); if (NILP (selection_value)) error ("selection-value may not be nil."); @@ -1674,14 +1669,12 @@ simply return our selection value. If we are not the owner, this will block until all of the data has arrived. */ -DEFUN ("x-get-selection-internal", - Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0 /* +DEFUN ("x-get-selection-internal", Fx_get_selection_internal, 2, 2, 0, /* Return text selected from some X window. SELECTION is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. TYPE is the type of data desired, typically STRING. -*/ ) - (selection_symbol, target_type) - Lisp_Object selection_symbol, target_type; +*/ + (selection_symbol, target_type)) { /* This function can GC */ Lisp_Object val = Qnil; @@ -1723,13 +1716,10 @@ return val; } -DEFUN ("x-disown-selection-internal", - Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0 /* +DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, 1, 2, 0, /* If we own the named selection, then disown it (make there be no selection). -*/ ) - (selection, timeval) - Lisp_Object selection; - Lisp_Object timeval; +*/ + (selection, timeval)) { struct device *d = decode_x_device (Qnil); Display *display = DEVICE_X_DISPLAY (d); @@ -1773,15 +1763,13 @@ } -DEFUN ("x-selection-owner-p", - Fx_selection_owner_p, Sx_selection_owner_p, 0, 1, 0 /* +DEFUN ("x-selection-owner-p", Fx_selection_owner_p, 0, 1, 0, /* 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. (For convenience, the symbol nil is the same as PRIMARY, and t is the same as SECONDARY.) -*/ ) - (selection) - Lisp_Object selection; +*/ + (selection)) { CHECK_SYMBOL (selection); if (EQ (selection, Qnil)) selection = QPRIMARY; @@ -1792,15 +1780,13 @@ return Qt; } -DEFUN ("x-selection-exists-p", - Fx_selection_exists_p, Sx_selection_exists_p, 0, 1, 0 /* +DEFUN ("x-selection-exists-p", Fx_selection_exists_p, 0, 1, 0, /* 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. (For convenience, the symbol nil is the same as PRIMARY, and t is the same as SECONDARY.) -*/ ) - (selection) - Lisp_Object selection; +*/ + (selection)) { Window owner; struct device *d = decode_x_device (Qnil); @@ -1846,12 +1832,10 @@ (symbol))); \ } -DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, - Sx_get_cutbuffer_internal, 1, 1, 0 /* +DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /* Return the value of the named CUTBUFFER (typically CUT_BUFFER0). -*/ ) - (cutbuffer) - Lisp_Object cutbuffer; +*/ + (cutbuffer)) { struct device *d = decode_x_device (Qnil); Display *display = DEVICE_X_DISPLAY (d); @@ -1885,12 +1869,10 @@ } -DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, - Sx_store_cutbuffer_internal, 2, 2, 0 /* +DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /* Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING. -*/ ) - (cutbuffer, string) - Lisp_Object cutbuffer, string; +*/ + (cutbuffer, string)) { struct device *d = decode_x_device (Qnil); Display *display = DEVICE_X_DISPLAY (d); @@ -1927,13 +1909,11 @@ } -DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, - Sx_rotate_cutbuffers_internal, 1, 1, 0 /* +DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /* Rotate the values of the cutbuffers by the given number of steps; positive means move values forward, negative means backward. -*/ ) - (n) - Lisp_Object n; +*/ + (n)) { struct device *d = decode_x_device (Qnil); Display *display = DEVICE_X_DISPLAY (d); @@ -1967,22 +1947,22 @@ void syms_of_xselect (void) { - defsubr (&Sx_get_selection_internal); - defsubr (&Sx_own_selection_internal); - defsubr (&Sx_disown_selection_internal); - defsubr (&Sx_selection_owner_p); - defsubr (&Sx_selection_exists_p); + DEFSUBR (Fx_get_selection_internal); + DEFSUBR (Fx_own_selection_internal); + DEFSUBR (Fx_disown_selection_internal); + DEFSUBR (Fx_selection_owner_p); + DEFSUBR (Fx_selection_exists_p); #ifdef CUT_BUFFER_SUPPORT - defsubr (&Sx_get_cutbuffer_internal); - defsubr (&Sx_store_cutbuffer_internal); - defsubr (&Sx_rotate_cutbuffers_internal); + DEFSUBR (Fx_get_cutbuffer_internal); + DEFSUBR (Fx_store_cutbuffer_internal); + DEFSUBR (Fx_rotate_cutbuffers_internal); #endif /* CUT_BUFFER_SUPPORT */ /* Unfortunately, timeout handlers must be lisp functions. */ defsymbol (&Qx_selection_reply_timeout_internal, "x-selection-reply-timeout-internal"); - defsubr (&Sx_selection_reply_timeout_internal); + DEFSUBR (Fx_selection_reply_timeout_internal); defsymbol (&QPRIMARY, "PRIMARY"); defsymbol (&QSECONDARY, "SECONDARY");