March 2006 - xemacs-cvs＠xemacs.org - XEmacs Mailing List Archives

CVS update by youngs packages/xemacs-packages/gnus/texi, emacs-mime.texi ... 18 years, 2 months

CVS Monitor

User: youngs Date: 06/03/16 05:19:53 Modified: packages/xemacs-packages/gnus/texi ChangeLog.upstream emacs-mime.texi gnus.texi message.texi Added: packages/xemacs-packages/gnus/etc/gnus attach.xpm compose.xpm connect.xpm contact.xpm copy.xpm delete.xpm describe.xpm disconnect.xpm exit.xpm forward.xpm inbox.xpm lock-broken.xpm lock-ok.xpm lock.xpm move.xpm next-page.xpm not-spam.xpm outbox.xpm refresh.xpm reply-all.xpm save-draft.xpm save.xpm send.xpm separator.xpm sort-ascending.xpm sort-column-ascending.xpm sort-criteria.xpm sort-descending.xpm sort-row-ascending.xpm spam.xpm toggle-subscription.xpm Log: * Sync with upstream stable branch. Please see the ChangeLog.upstream files for details. Revision Changes Path 1.100 +5 -0 XEmacs/packages/xemacs-packages/gnus/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v retrieving revision 1.99 retrieving revision 1.100 diff -u -p -r1.99 -r1.100 --- ChangeLog 2006/01/04 07:45:56 1.99 +++ ChangeLog 2006/03/16 04:16:56 1.100 ＠＠ -1,3 +1,8 ＠＠ +2006-03-16 Steve Youngs <steve(a)sxemacs.org> + + * Sync with upstream stable branch. + Please see the ChangeLog.upstream files for details. + 2006-01-04 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.89 released. 1.5 +3 -2 XEmacs/packages/xemacs-packages/gnus/etc/gnus-tut.txt Index: gnus-tut.txt =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/etc/gnus-tut.txt,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-tut.txt 2005/11/15 03:45:40 1.4 +++ gnus-tut.txt 2006/03/16 04:17:03 1.5 ＠＠ -25,7 +25,8 ＠＠ Ingebrigtsen. If you have a WWW browser heart's delight at <URL:http://www.gnus.org/> and <URL:http://quimby.gnus.org/lmi/>. -;; Copyright (C) 1995, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)ifi.uio.no> ;; Keywords: news ＠＠ -223,7 +224,7 ＠＠ want this is beyond me, but here goes: Create the group by saying -`G V my.virtual.newsgroup<RET>nnvirtual<RET>^rec\.aquaria\.*<RET>' +`G m my.virtual.newsgroup<RET>nnvirtual<RET>^rec\.aquaria\.*<RET>' This will create the group "nnvirtual:my.virtual.newsgroup", which will collect all articles from all the groups in the "rec.aquaria" 1.2 +177 -32 XEmacs/packages/xemacs-packages/gnus/etc/gnus/preview.xpm Index: preview.xpm =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/etc/gnus/preview.xpm,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- preview.xpm 2003/05/02 00:26:58 1.1 +++ preview.xpm 2006/03/16 04:17:11 1.2 ＠＠ -1,33 +1,178 ＠＠ /* XPM */ -static char *prev1[]={ -"24 24 6 1", -". c None", -"# c #000000", -"d c #46463e", -"a c #676663", -"c c #a8a7a3", -"b c #ebeae4", -"........................", -"........................", -"........................", -"........................", -"........................", -"..............####......", -".........#####abbc#.....", -"....#####acbbbbbbc#.....", -"...#acbbbbbbbbbbacc#....", -"...#baabbbbbbbbcacb#....", -"...#cbcaabbd##dacbb#....", -"....#bbbccdcbbcdabbc#...", -"....#bbbbdccaaccdacb#...", -"....#cbbb#abbbbb#bac#...", -".....#bbb#cbbbbc#bbac#..", -".....#bbbdcbbbbddbbc##..", -".....#cbccdcbbd#####....", -"......#babbd##dd##......", -"......#acbc###.####.....", -"......#aa##......###....", -".......##.........###...", -"...................##...", -"........................", -"........................"}; +static char * mail_preview_xpm[] = { +"24 24 151 2", +" c None", +". c #343434", +"+ c #2D2D2D", +"＠ c #292929", +"# c #262626", +"$ c #2E2E2E", +"% c #303030", +"& c #737373", +"* c #A1A1A1", +"= c #B4B4B4", +"- c #B2B2B2", +"; c #9D9D9D", +"> c #676767", +", c #202020", +"' c #1C1C1C", +") c #272727", +"! c #616161", +"~ c #CACACA", +"{ c #CFCFCF", +"] c #D0D0D0", +"^ c #CECECE", +"/ c #C9C9C9", +"( c #C1C1C1", +"_ c #A7A7A7", +": c #4C4C4C", +"< c #131313", +"[ c #222222", +"} c #757575", +"| c #D3D3D3", +"1 c #DBDBDB", +"2 c #E7E7E7", +"3 c #EFEFEF", +"4 c #F3F3F3", +"5 c #F1F1F1", +"6 c #E5E5E5", +"7 c #D2D2D2", +"8 c #BCBCBC", +"9 c #5E5E5E", +"0 c #101010", +"a c #212121", +"b c #5B5B5B", +"c c #CCCCCC", +"d c #D7D7D7", +"e c #F5F5F5", +"f c #FAFAFA", +"g c #FBFBFB", +"h c #F8F8F8", +"i c #F0F0F0", +"j c #E1E1E1", +"k c #C2C2C2", +"l c #434343", +"m c #0F0F0F", +"n c #1F1F1F", +"o c #B9B9B9", +"p c #D4D4D4", +"q c #F7F7F7", +"r c #F9F9F9", +"s c #F6F6F6", +"t c #EAEAEA", +"u c #E2E2E2", +"v c #ABABAB", +"w c #0E0E0E", +"x c #000000", +"y c #111111", +"z c #686868", +"A c #9C9C9C", +"B c #808080", +"C c #8E8E8E", +"D c #919191", +"E c #929292", +"F c #949494", +"G c #939393", +"H c #8B8B8B", +"I c #838383", +"J c #A3A3A3", +"K c #555555", +"L c #080808", +"M c #535353", +"N c #333333", +"O c #AFAFAF", +"P c #E6E6E6", +"Q c #FDFDFD", +"R c #FEFEFE", +"S c #FCFCFC", +"T c #A8A8A8", +"U c #8D8D8D", +"V c #050505", +"W c #EEEEEE", +"X c #A6A6A6", +"Y c #C8C8C8", +"Z c #FFFFFF", +"` c #B6B6B6", +" . c #F4F4F4", +".. c #F2F2F2", +"+. c #A9A9A9", +"＠. c #040404", +"#. c #2A2A2A", +"$. c #AAAAAA", +"%. c #ECECEC", +"&. c #A5A5A5", +"*. c #C7C7C7", +"=. c #D8D8D8", +"-. c #CDCDCD", +";. c #858585", +">. c #010101", +",. c #606060", +"'. c #646464", +"). c #C3C3C3", +"!. c #DADADA", +"~. c #494949", +"{. c #ADADAD", +"]. c #0A0A0A", +"^. c #BABABA", +"/. c #DCDCDC", +"(. c #989898", +"_. c #E9E9E9", +":. c #EBEBEB", +"<. c #A4A4A4", +"[. c #B7B7B7", +"}. c #D1D1D1", +"|. c #414141", +"1. c #3D3D3D", +"2. c #969696", +"3. c #A0A0A0", +"4. c #BEBEBE", +"5. c #D9D9D9", +"6. c #C5C5C5", +"7. c #515151", +"8. c #C0C0C0", +"9. c #959595", +"0. c #DDDDDD", +"a. c #484848", +"b. c #030303", +"c. c #454545", +"d. c #060606", +"e. c #B5B5B5", +"f. c #C6C6C6", +"g. c #C4C4C4", +"h. c #A2A2A2", +"i. c #828282", +"j. c #1E1E1E", +"k. c #191919", +"l. c #7C7C7C", +"m. c #E4E4E4", +"n. c #9E9E9E", +"o. c #525252", +"p. c #B0B0B0", +"q. c #6C6C6C", +"r. c #565656", +"s. c #797979", +"t. c #3A3A3A", +" ", +" ", +" . + ＠ # # # ", +" $ % & * = - ; > , ' ", +" ) ! = ~ { ] ^ / ( _ : < ", +" [ } ~ | 1 2 3 4 5 6 7 8 9 0 ", +" a b c d 6 e f g f h e i j k l m ", +" n o p 6 q r g g f r s i t u v w ", +" x y z A B C D E F F G G D C H I J K L ", +"x M N O P e r g Q R R Q S f h e i T U V ", +"x W y ~ t 5 q q g r S r f q e i X Y _ V ", +"x Z y ` t 3 4 e s q q q s ...+.~ ] J ＠. ", +"x Z #.$.v %.i .. .e e e 4 5 &.*.=.-.;.>. ", +"x Z ,.'.1 ; %.3 i 5 5 i i T ).=.!./ ~.x ", +"x Z {.].^./.(._.:.%.%.%.<.[.}.!.p &.>. ", +"x Z /.|.1.7 +.2.6 6 6 3.$.4.=.5.).% x ", +"x Z e 6.L 7.8.( 9.0.(.= Y J ).( a.b.x ", +"x Z g d c.d.. 3.( F e.8.~ f.U + b.].x x ", +"x Z e & ^.g.1.b.a.I h.&.i.l x j.[.k.x x x ", +"x Z l.p m.m.Y n.o.j.b.b.j.o.n.p.q.O j.n x x ", +"x & 8 8 8 8 8 8 &.&.&.&.&.&.&.8 8 r.x > N x x ", +" x x x x x x x x x x x x x x x x x x x s.t.x x ", +" x z n x ", +" x x "}; 1.2 +88 -25 XEmacs/packages/xemacs-packages/gnus/etc/gnus/reply.xpm Index: reply.xpm =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/etc/gnus/reply.xpm,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- reply.xpm 2003/05/02 00:26:58 1.1 +++ reply.xpm 2006/03/16 04:17:11 1.2 ＠＠ -1,31 +1,94 ＠＠ /* XPM */ -static char * reply_xpm[] = { -"24 24 4 1", +static char * stock_mail_reply_xpm[] = { +"24 24 67 1", " c None", -". c #000000000000", -"X c #E1E1E0E0E0E0", -"O c #FFFFFFFFFFFF", +". c #000000", +"+ c #535353", +"＠ c #FFFFFF", +"# c #FEFEFE", +"$ c #FDFDFD", +"% c #FCFCFC", +"& c #FBFBFB", +"* c #F9F9F9", +"= c #F8F8F8", +"- c #F7F7F7", +"; c #F6F6F6", +"> c #F5F5F5", +", c #F4F4F4", +"' c #E3E3E3", +") c #EEEEEE", +"! c #4F4F4F", +"~ c #F3F3F3", +"{ c #F2F2F2", +"] c #F1F1F1", +"^ c #F0F0F0", +"/ c #EFEFEF", +"( c #EDEDED", +"_ c #AEAEAE", +": c #E4E4E4", +"< c #434343", +"[ c #ACACAC", +"} c #C8C8C8", +"| c #A0A0A0", +"1 c #D4D4D4", +"2 c #ECECEC", +"3 c #959595", +"4 c #3E3E3E", +"5 c #4D4D4D", +"6 c #818181", +"7 c #C6C6C6", +"8 c #3D1A13", +"9 c #6A6A6A", +"0 c #636363", +"a c #B9B9B9", +"b c #737373", +"c c #EAC0BA", +"d c #7C7C7C", +"e c #DF9E95", +"f c #E0A198", +"g c #E1A59D", +"h c #E2A79E", +"i c #E3ABA3", +"j c #E3AAA2", +"k c #CC6253", +"l c #DD978D", +"m c #DF9F97", +"n c #DE9A90", +"o c #DD968C", +"p c #DD948A", +"q c #B14334", +"r c #BCBCBC", +"s c #431913", +"t c #EAC2BC", +"u c #DF9C92", +"v c #DD998F", +"w c #B54535", +"x c #65261D", +"y c #983A2C", +"z c #7C2F24", +"A c #63251D", +"B c #6C291F", " ", " ", " ", -" .... ", -" ..XXX.. ", -" ..XXXXX.. ", -" .O.XXXXXXX.. ", -" ..O.XXXXXXXXX.. ", -" .OO.XXXXXXXXXX... ", -" .OO.XXXXXXXXXX.OO.. ", -" ..OO.XXXXXXXXXX.OOOO.. ", -" .....XXXXXXXXX.OOO.... ", -" .OOO.XXXXXXXX.OO..OOO. ", -" .OOOO...XXXXX...OOOOO. ", -" .OOOOOOO..XX..OOOOOOO. ", -" .OOOOOOO......OOOOOOO. ", -" .OOOOOO.OO..O..OOOOOO. ", -" .OOOOO.OOOOOOOO.OOOOO. ", -" .OOOO.OOOOOOOOOO.OOOO. ", -" .OOO.OOOOOOOOOOOO.OOO. ", -" .O..OOOOOOOOOOOOOO..O. ", -" ..OOOOOOOOOOOOOOOOOO.. ", -" ...................... ", +" ................. ", +" .+＠＠＠＠#$%&*=-;>,'+. ", +" .)!＠>,~{{]^^/)('!_. ", +" .＠:<$~{{]^/))('![}. ", +" .＠>:!&]^^/)(('<|1}. ", +" .＠&>:<=^/)(2'!31:}. ", +" .＠>>>:4>)(2'567::}. ", +" .＠&8>:9<~2'!977>:}. ", +" .＠..:0＠a!^!37b7>:}. ", +" ..c.0＠>:1![7::d::}. ", +" .ce.......:>>>:d:}. ", +" .cfghihjek.::::::d}. ", +" .clmenoonpq.rrrrrrr0. ", +"stnuvvlnnnnw.......... ", +" .xyyyyyyyyz. ", +" .xyyAAAAAB. ", +" .xy....... ", +" .x. ", +" .. ", +" . ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/attach.xpm Index: attach.xpm =================================================================== /* XPM */ static char * stock_attach_xpm[] = { "24 24 99 2", " c None", ". c #000000", "+ c #010101", "＠ c #515151", "# c #9A9A9A", "$ c #CFCFCF", "% c #6F6F6F", "& c #464646", "* c #A5A5A5", "= c #E2E2E2", "- c #FFFFFF", "; c #F6F6F6", "> c #8A8A8A", ", c #393939", "' c #1C1C1C", ") c #8B8B8B", "! c #E6E6E6", "~ c #EEEEEE", "{ c #E1E1E1", "] c #F8F8F8", "^ c #F7F7F7", "/ c #CCCCCC", "( c #565656", "_ c #3E3E3E", ": c #818181", "< c #D4D4D4", "[ c #E7E7E7", "} c #D7D7D7", "| c #FAFAFA", "1 c #F9F9F9", "2 c #C2C2C2", "3 c #CBCBCB", "4 c #F5F5F5", "5 c #D9D9D9", "6 c #030303", "7 c #545454", "8 c #DEDEDE", "9 c #B3B3B3", "0 c #797979", "a c #F4F4F4", "b c #9D9D9D", "c c #282828", "d c #FBFBFB", "e c #A6A6A6", "f c #C5C5C5", "g c #F0F0F0", "h c #CACACA", "i c #C7C7C7", "j c #F2F2F2", "k c #CECECE", "l c #C4C4C4", "m c #D5D5D5", "n c #DADADA", "o c #F3F3F3", "p c #858585", "q c #BEBEBE", "r c #D3D3D3", "s c #DCDCDC", "t c #9C9C9C", "u c #484848", "v c #A7A7A7", "w c #D6D6D6", "x c #C8C8C8", "y c #C6C6C6", "z c #4C4C4C", "A c #EAEAEA", "B c #E5E5E5", "C c #D8D8D8", "D c #ADADAD", "E c #BCBCBC", "F c #E0E0E0", "G c #F1F1F1", "H c #909090", "I c #686868", "J c #A2A2A2", "K c #C0C0C0", "L c #C1C1C1", "M c #787878", "N c #AEAEAE", "O c #151515", "P c #D0D0D0", "Q c #979797", "R c #727272", "S c #4A4A4A", "T c #ECECEC", "U c #ACACAC", "V c #BABABA", "W c #DDDDDD", "X c #DBDBDB", "Y c #B1B1B1", "Z c #232323", "` c #696969", " . c #B7B7B7", ".. c #828282", "+. c #404040", "＠. c #969696", "#. c #323232", "$. c #E8E8E8", "%. c #121212", " ", " . . . . . ", " . . . . ", " . + ＠ # $ % . ", " . . & * = - - ; > , ", " . ' ) ! ~ { - ] ^ ; / ( ", " . _ : < ' [ } | 1 ] 2 3 4 5 : . ", " 6 7 ! - - - . } 8 9 0 . = ; 4 a b c ", " . ; - - | | d . e f g ] . = 2 h a i ( ", " . j ] 1 k l f . m 1 ] ] . 9 n a o o 0 . ", " p - ] q 1 1 . r s 2 2 . = 4 a o j t c ", " u - ^ ^ ] ] . v w ^ ; . = a l x j y z ", " . A - ; q 2 . B C ; 4 . D E A F G A H . ", " I - 4 ; ; J . K L . M w o j G G m N O ", " , - a 4 4 n # . . 0 w j j G w P Q R S ", " . T - a U V W o k X T } w Y : ( Z . ", " ` - o o o o j j } ...+.Z . . ", " c - o j j } q ＠.#.Z . ", " . ! $./ # +.Z . . ", " , .., %.. ", " . . ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/compose.xpm Index: compose.xpm =================================================================== /* XPM */ static char * stock_mail_compose_xpm[] = { "24 24 198 2", " c None", ". c #000000", "+ c #D1AF61", "＠ c #F1E3AC", "# c #FBA90F", "$ c #FFFFFF", "% c #B5B5B5", "& c #A06B09", "* c #816000", "= c #E0E0E0", "- c #C1C1C1", "; c #F4F4F4", "> c #FDFDFD", ", c #E6C370", "' c #F1D387", ") c #D58F0C", "! c #B2B2B2", "~ c #C3C3C3", "{ c #FBFBFB", "] c #A8A8A8", "^ c #F6F6F6", "/ c #B3B3B3", "( c #FAFAFA", "_ c #ADADAD", ": c #767676", "< c #5D5D5D", "[ c #404040", "} c #F8F8F8", "| c #F1D07E", "1 c #ACACAC", "2 c #F8F8F6", "3 c #E2E2E2", "4 c #858585", "5 c #4B4B49", "6 c #161616", "7 c #FBFBFA", "8 c #7D7D7D", "9 c #F2F2F2", "0 c #F0F0F0", "a c #EFEFEF", "b c #D5D5D5", "c c #F9F9F9", "d c #F6F6F3", "e c #F3F3F3", "f c #878786", "g c #E5E5E5", "h c #DFDFDF", "i c #EBEBEB", "j c #AEAEAE", "k c #7B5307", "l c #EDEDED", "m c #EBEBE9", "n c #E9E9E7", "o c #E0E0DE", "p c #BFBFBF", "q c #F0F0ED", "r c #F1D284", "s c #CA870B", "t c #9E9E9C", "u c #DCDCD9", "v c #D9D9D9", "w c #D9D9D6", "x c #D6D6D4", "y c #E5E5E4", "z c #D9D9D7", "A c #BABABA", "B c #AAAAAA", "C c #E7E7E5", "D c #E4E4E2", "E c #E2E2E0", "F c #EEEEEC", "G c #979796", "H c #D4D4D1", "I c #DEDEDC", "J c #DEDEDB", "K c #BDBDBC", "L c #E7E7E7", "M c #EFEFED", "N c #A6A6A5", "O c #BA7C0A", "P c #7A5B00", "Q c #DBDBD9", "R c #D5D5D3", "S c #BCBCBC", "T c #E3E3E3", "U c #F2E6B6", "V c #7B7B7B", "W c #704B05", "X c #676764", "Y c #CBCBC7", "Z c #C9C9C7", "` c #DBDBD7", " . c #D7D7D5", ".. c #D7D7D3", "+. c #B4B4B4", "＠. c #E4E4E4", "#. c #DBD5C1", "$. c #7E6F57", "%. c #755800", "&. c #D9D9D5", "*. c #D5D5D1", "=. c #D0D0CE", "-. c #BABAB8", ";. c #DDDDDB", ">. c #D1D1CF", ",. c #0E0E0E", "'. c #535353", "). c #8D8D8B", "!. c #C4C4C1", "~. c #C4C4BF", "{. c #C1C1BC", "]. c #D3D3D0", "^. c #D1D1D0", "/. c #DCDCDB", "(. c #E0E0DC", "_. c #898987", ":. c #C9C9C6", "<. c #CDCDCA", "[. c #D0D0CD", "}. c #CECECB", "|. c #CFCFCC", "1. c #D0D0CC", "2. c #B6B6B6", "3. c #D4D4D0", "4. c #C3C3C0", "5. c #5B5B5B", "6. c #91918D", "7. c #91918F", "8. c #9F9F9D", "9. c #AFAFAC", "0. c #B9B9B6", "a. c #BEBEBB", "b. c #C5C5C2", "c. c #C8C8C5", "d. c #CACAC7", "e. c #CBCBC8", "f. c #CCCCC9", "g. c #CCCCC8", "h. c #D2D2D0", "i. c #D2D2CF", "j. c #BFBFBD", "k. c #9F9F9C", "l. c #888886", "m. c #878785", "n. c #8C8C8A", "o. c #959593", "p. c #9C9C9A", "q. c #A8A8A5", "r. c #B1B1AE", "s. c #B5B5B3", "t. c #BBBBB8", "u. c #BFBFBC", "v. c #C2C2BE", "w. c #D1D1CE", "x. c #AEAEAB", "y. c #9D9D9A", "z. c #979794", "A. c #949491", "B. c #9A9A97", "C. c #A3A3A0", "D. c #AAAAA7", "E. c #B0B0AC", "F. c #B8B8B5", "G. c #B0B0AE", "H. c #CFCFCD", "I. c #BEBEBC", "J. c #B4B4B0", "K. c #ACACA8", "L. c #A4A4A2", "M. c #A0A09C", "N. c #A4A4A0", "O. c #A8A8A6", "P. c #ABABA7", "Q. c #B2B2AE", "R. c #A4A4A4", "S. c #CECECC", "T. c #CECECA", "U. c #C6C6C2", "V. c #BCBCB9", "W. c #B3B3AF", "X. c #ABABA9", "Y. c #A6A6A3", "Z. c #A0A09D", "`. c #ACACA9", " + c #A1A1A1", ".+ c #B1B1AF", "++ c #B4B4B3", "＠+ c #B4B4B1", "#+ c #B3B3B1", "$+ c #AEAEAA", "%+ c #A7A7A4", "&+ c #A2A2A0", "*+ c #A5A5A1", "=+ c #999997", "-+ c #929290", ";+ c #949490", ">+ c #9D9D9B", ",+ c #858583", " . . . ", " . . . . . . . . . . . . + ＠ # . . . ", " . $ $ $ $ $ $ $ $ $ % & ＠ # * . = - . ", " . $ ; $ $ $ $ $ > > . , ' ) . ! ~ { ] . ", " . $ ^ $ $ $ > > > / & ＠ # * . ( _ : < [ . ", " . $ ^ $ { { { { } . , | ) . 1 2 3 4 5 6 . ", " . $ ; > > { { 7 8 & ＠ # * . ; 9 0 a b _ . ", " . $ 9 c ^ ^ d e . , | ) . f g 3 h i 3 - . ", " . $ 0 } } } 2 j k ＠ # * . l i m n n o p . ", " . $ a e 0 q l . , r s . t u v w x y z A . ", " . $ l ; ; 9 B & ＠ # * . C y y D o E z A . ", " . $ i F C g . , r s . G H E o I J I z K . ", " . $ L M i N O # # P . E o I J u Q Q R S . ", " . $ g T v . U V W . X Y Z u ` z .z ..+.. ", " . $ E y ＠.. #.$.%.. u Q ` &...R *...=.-.. ", " . $ I ;.>.,.'.. . ).!.~.{.*.*.].^.].=.-.. ", " . $ /.(.;.. . _.:.<.[.}.[.[.[.[.|.[.1.2.. ", " . $ Q 3.4.5.6.7.8.9.0.a.4.b.c.d.e.f.g.! . ", " . $ h.i.|.j.k.l.m.n.o.p.q.r.s.t.a.u.v.! . ", " . $ w.1.f.|.4.x.y.z.z.A.B.k.C.q.D.E.F.G.. ", " . $ i.w.w.w.H.e.I.J.K.L.M.M.N.L.O.P.Q.R.. ", " . $ ^.w.=.S.T.T.g.U.V.W.J.X.Y.Z.Y.D.`. +. ", " . $ .+++＠+＠+(a)+#+#+Q.$+%+&+*+*+=+-+;+>+,+. ", " . . . . . . . . . . . . . . . . . . . . "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/connect.xpm Index: connect.xpm =================================================================== /* XPM */ static char * stock_connect_xpm[] = { "24 24 58 1", " c None", ". c #000000", "+ c #989389", "＠ c #807D74", "# c #C6C2BA", "$ c #34332D", "% c #B7B3AA", "& c #C4C2BD", "* c #EAE8E3", "= c #9C978D", "- c #BCB9B2", "; c #363433", "> c #E2E1DD", ", c #F0EFEC", "' c #AAA7A0", ") c #F0EEEB", "! c #B2B0AB", "~ c #F9F9F8", "{ c #C5C3BD", "] c #0F0F0D", "^ c #F2F0ED", "/ c #EBEAE6", "( c #8A857B", "_ c #ECEBE8", ": c #EEECEA", "< c #9F9C93", "[ c #F3F2F0", "} c #E8E7E4", "| c #E3E1DD", "1 c #78756B", "2 c #BEBBB5", "3 c #B3B1AA", "4 c #7D786E", "5 c #E1DFDB", "6 c #D1D0CC", "7 c #938E84", "8 c #C8C5BF", "9 c #A7A298", "0 c #010101", "a c #8C8981", "b c #A6A29B", "c c #726D63", "d c #CECAC3", "e c #A7A49E", "f c #7E7A70", "g c #A09D94", "h c #817D73", "i c #6C685E", "j c #3C3933", "k c #8B877E", "l c #706C62", "m c #B1ADA4", "n c #97938A", "o c #625E54", "p c #6A655B", "q c #37342D", "r c #646056", "s c #8B877D", " ", " ", " ", " ", " ", " ", " .. .. ", " ..+＠.#＠.. ", " $%&*＠.*＠=-; ", " .>,'*＠.)＠!~{] ", "......＠>,'*＠.)＠!~{＠.....", "*******^/(_＠.:＠<[}|*****", "＠＠＠＠＠1123451.6＠789＠＠＠＠(a)＠", ".....01abcd1.e＠fghi.....", " ]abcd1.e＠fgh] ", " ]jklmi.n＠opq. ", " ]]+r.s＠.. ", " ]] ]. ", " ", " ", " ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/contact.xpm Index: contact.xpm =================================================================== /* XPM */ static char * stock_contact_xpm[] = { "24 24 102 2", " c None", ". c #000000", "+ c #E3E1DE", "＠ c #ECEBE7", "# c #F0EEEB", "$ c #D2CFC9", "% c #81817F", "& c #4C4C4A", "* c #ECEAE6", "= c #ECEAE5", "- c #EBE9E5", "; c #D2CEC8", "> c #D9C7B8", ", c #D9C7B9", "' c #D8C5B8", ") c #D1C0B3", "! c #D6C5B7", "~ c #EBEAE5", "{ c #D3D0C9", "] c #CDBCAC", "^ c #AFA093", "/ c #3A3531", "( c #443F3A", "_ c #AE9F93", ": c #CBBAAB", "< c #4E4E4C", "[ c #595957", "} c #595857", "| c #7D7C7A", "1 c #D3D0CA", "2 c #C6B5A4", "3 c #3D3833", "4 c #433D37", "5 c #C2B0A2", "6 c #D4D1CA", "7 c #B0A08E", "8 c #261F18", "9 c #D37D1E", "0 c #D68021", "a c #B26616", "b c #27241F", "c c #9C8E7F", "d c #EAE9E5", "e c #A29281", "f c #2E2012", "g c #CC751A", "h c #CC761A", "i c #BF6C16", "j c #24211C", "k c #8E8170", "l c #EAE8E3", "m c #E9E8E3", "n c #E9E7E3", "o c #8E7F6C", "p c #221E17", "q c #C56D14", "r c #7D450D", "s c #AF5F11", "t c #221E19", "u c #7F7260", "v c #E9E7E2", "w c #E8E6E1", "x c #E7E5E1", "y c #E7E5E0", "z c #D5D1CB", "A c #3E372C", "B c #1C1F1F", "C c #301B06", "D c #542D07", "E c #291B0E", "F c #151412", "G c #473F33", "H c #E8E6E2", "I c #546371", "J c #849CB4", "K c #56687C", "L c #343332", "M c #495868", "N c #566D85", "O c #293643", "P c #E6E4DF", "Q c #E5E4DE", "R c #EEEDE9", "S c #7B95AF", "T c #7B96B0", "U c #68819B", "V c #8999AA", "W c #5A7088", "X c #607A96", "Y c #5B7691", "Z c #E5E3DE", "` c #4B4A48", " . c #757471", ".. c #E6E3DE", "+. c #3B3A39", "＠. c #747371", "#. c #D3CFC8", "$. c #E2E1DD", "%. c #E7E4E0", "&. c #D2CFC8", "*. c #D1D0CA", "=. c #C2C0B9", " ", " ", " ", " . . . . . . . . . . . . . . . . . . . . ", " . + ＠ # # # # # # # # # # # # # # # # # $ . ", " . # % . . . . . . . & * = - - - - - - - ; . ", " . # . > , ' ) ! > , . * * ~ ~ ~ ~ - - ~ { . ", " . # . ] ^ / . ( _ : . * < [ ~ } } | - ~ 1 . ", " . # . 2 3 . . . 4 5 . * * ~ ~ - - - - - 6 . ", " . # . 7 8 9 0 a b c . * [ < | [ - } | d 6 . ", " . # . e f g h i j k . * * l l m n n n n 6 . ", " . # . o p q r s t u . v v w w w x y y y z . ", " . # . A B C D E F G . H H y y y y y y y 6 . ", " . # . I J K L M N O . y y P P P P P P Q { . ", " . R . S T U V W X Y . y y P P P P Z Z Z { . ", " . d ` . . . . . . . ` y y ...+.+.Z ＠.Z #.. ", " . $.y y y y y y y y y %.P Z Z Z Z Z Z Z &.. ", " . *.6 z 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 =.. ", " . . . . . . . . . . . . . . . . . . . . . ", " ", " ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/copy.xpm Index: copy.xpm =================================================================== /* XPM */ static char * stock_mail_copy_xpm[] = { "24 24 77 1", " c None", ". c #010101", "+ c #2F2F2F", "＠ c #E3E2E1", "# c #FCFCFC", "$ c #B3B2B1", "% c #95938E", "& c #F7F7F7", "* c #F5F4F2", "= c #F8F8F8", "- c #F7F6F6", "; c #EAE9E5", "> c #7B7976", ", c #D2CFCA", "' c #E1E0DD", ") c #908E8B", "! c #EBEAEA", "~ c #F1F0EE", "{ c #E2E0DD", "] c #7C7B78", "^ c #C6C3C0", "/ c #E5E3DE", "( c #DCDAD7", "_ c #8F8C88", ": c #EBEBEA", "< c #EFEDEA", "[ c #DFDDDA", "} c #787774", "| c #C1BEBA", "1 c #E6E3E0", "2 c #EFEEEC", "3 c #CBCAC6", "4 c #ECECEC", "5 c #F3F2F0", "6 c #DCDCDC", "7 c #7D7C79", "8 c #B4B2AE", "9 c #E7E5E1", "0 c #F0EFEB", "a c #E4E2DD", "b c #7B7874", "c c #AFACA6", "d c #ABA8A3", "e c #F9F8F6", "f c #EAE9E8", "g c #B0ADA7", "h c #F5F3F0", "i c #B9B8B6", "j c #CBC9C4", "k c #DEDBD5", "l c #9D9994", "m c #DBD9D6", "n c #747370", "o c #A09C97", "p c #DAD8D5", "q c #E7E6E3", "r c #E8E6E1", "s c #E0DED9", "t c #F7F6F4", "u c #D3D1CF", "v c #868480", "w c #C2BFBD", "x c #DAD9D5", "y c #F6F5F1", "z c #D8D6D1", "A c #F7F5F2", "B c #92908B", "C c #CCCAC5", "D c #F7F6F2", "E c #F5F4F0", "F c #EAE8E3", "G c #D2D0CB", "H c #D9D7D2", "I c #DAD8D3", "J c #D5D3CE", "K c #D6D4CF", "L c #040404", " ", " ", " ", " .+........... ", " .＠###########$. ", " .#%&*=*-*-*;>,. ", " .#')!~-*-*{]^/. ", " .#~(_:~<~[}|1/. ", " .#~23]4567890a. ", " .#22~b.+........... ", " .#~2c.＠###########$. ", " .#2de.#%&*=*-*-*;>,. ", " .fgeh.#')!~-*-*{]^/. ", " .ijkk.#~(_:~<~[}|1/. ", " .....#~23]4567890a. ", " .#22~l]mnopqrs. ", " .#~2ctuvwxoy0z. ", " .#2deetptAABrC. ", " .fgehDEAEAhFBG. ", " .ijkkkHIJKGGGB. ", " ............L ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/delete.xpm Index: delete.xpm =================================================================== /* XPM */ static char * stock_delete_xpm[] = { "24 24 243 2", " c None", ". c #000000", "+ c #1C1C1C", "＠ c #767676", "# c #E6E6E6", "$ c #D3D3D3", "% c #C3C3C3", "& c #909090", "* c #494949", "= c #48473D", "- c #BAB8A6", "; c #E2E2DF", "> c #F1F1F0", ", c #EAE9E6", "' c #F2F2EE", ") c #EBEAE5", "! c #C1C0B5", "~ c #57564A", "{ c #525146", "] c #A8A68F", "^ c #BDBBA1", "/ c #C0BEA3", "( c #A3A18A", "_ c #6D6C5C", ": c #7C7C72", "< c #4C4C49", "[ c #45453F", "} c #44433A", "| c #6F6F67", "1 c #C6C5B9", "2 c #B6B59B", "3 c #6D6C5D", "4 c #B3B19B", "5 c #A7A68E", "6 c #908F7A", "7 c #AAA993", "8 c #CCCBB5", "9 c #D0CEBA", "0 c #D5D3C1", "a c #AEADA3", "b c #94938A", "c c #454442", "d c #232321", "e c #353431", "f c #292823", "g c #1E1E1A", "h c #535246", "i c #ADAC93", "j c #929189", "k c #C2C1AF", "l c #B1AF96", "m c #ACAA92", "n c #93927D", "o c #080808", "p c #D1D0C1", "q c #D6D5C4", "r c #DFDED1", "s c #CECDC0", "t c #ACACA6", "u c #908F8A", "v c #7E7D77", "w c #5C5C55", "x c #47463E", "y c #656456", "z c #777665", "A c #807E6F", "B c #BEBDA7", "C c #B5B39A", "D c #A19F88", "E c #D9D8CC", "F c #F6F5F2", "G c #DBDAD1", "H c #DAD9CE", "I c #E5E4D9", "J c #D0CFC3", "K c #D3D3C9", "L c #CAC9BC", "M c #B7B6A6", "N c #B8B6A1", "O c #B0AF96", "P c #B9B89D", "Q c #B9B79D", "R c #B8B69C", "S c #C4C2A9", "T c #AFAD97", "U c #8B8976", "V c #AAA998", "W c #B6B6B2", "X c #F9F9F7", "Y c #FAFAF8", "Z c #F4F4F0", "` c #E2E1DA", " . c #D9D9CE", ".. c #DBDACF", "+. c #D3D1BE", "＠. c #C5C4AC", "#. c #D6D5C3", "$. c #CDCCBF", "%. c #BBBAAD", "&. c #7C7A69", "*. c #717060", "=. c #131313", "-. c #999882", ";. c #AFAE9D", ">. c #C3C3BE", ",. c #DEDEDC", "'. c #E9E9E8", "). c #FBFBFA", "!. c #FDFDFC", "~. c #FDFDFD", "{. c #FCFBFA", "]. c #F2F2EF", "^. c #EAE9E3", "/. c #C0BFB1", "(. c #959484", "_. c #787766", ":. c #6E6D5D", "<. c #5B5B4D", "[. c #5D5C4F", "}. c #A3A293", "|. c #B8B7A6", "1. c #D8D7D0", "2. c #DBDBD4", "3. c #D3D2CA", "4. c #C8C8C3", "5. c #C6C5BD", "6. c #BDBCAD", "7. c #BAB8A8", "8. c #9F9E8B", "9. c #8E8C78", "0. c #8C8B77", "a. c #7A7968", "b. c #6C6B5D", "c. c #4E4D45", "d. c #424242", "e. c #7B7B73", "f. c #9F9F96", "g. c #D2D1C7", "h. c #DCDBD2", "i. c #CCCBBE", "j. c #D1D0C2", "k. c #C4C3B6", "l. c #9A9883", "m. c #807F6D", "n. c #7D7C6B", "o. c #6A695E", "p. c #40403E", "q. c #37372D", "r. c #0F0F0F", "s. c #383734", "t. c #787875", "u. c #999893", "v. c #8A897E", "w. c #B3B2A4", "x. c #AAAA9E", "y. c #878673", "z. c #8F8D79", "A. c #626155", "B. c #545451", "C. c #31312E", "D. c #2B2B23", "E. c #71715D", "F. c #57574B", "G. c #42423A", "H. c #262620", "I. c #212121", "J. c #1B1B1B", "K. c #242424", "L. c #161613", "M. c #2A2A22", "N. c #303027", "O. c #3F3F34", "P. c #7A7A65", "Q. c #5B5B51", "R. c #858576", "S. c #76766B", "T. c #98988E", "U. c #75756B", "V. c #515146", "W. c #7F7F74", "X. c #6A6A58", "Y. c #404035", "Z. c #626251", "`. c #545445", " + c #3E3E33", ".+ c #555546", "++ c #34342B", "＠+ c #515143", "#+ c #85856E", "$+ c #5D5D54", "%+ c #919182", "&+ c #828278", "*+ c #AAAAA3", "=+ c #7A7A71", "-+ c #4E4E45", ";+ c #8A8A80", ">+ c #7C7C6D", ",+ c #424237", "'+ c #606052", ")+ c #5A5A4A", "!+ c #3C3C32", "~+ c #4E4E41", "{+ c #35352C", "]+ c #ACAC9C", "^+ c #85857B", "/+ c #BBBBB3", "(+ c #A3A39A", "_+ c #54544B", ":+ c #93938A", "<+ c #919185", "[+ c #686856", "}+ c #414136", "|+ c #434337", "1+ c #A4A493", "2+ c #C1C1B6", "3+ c #B1B1A2", "4+ c #6B6B5F", "5+ c #9D9D8B", "6+ c #848470", "7+ c #71715E", "8+ c #A5A594", "9+ c #C2C2B7", "0+ c #7B7B65", "a+ c #5F5F4F", "b+ c #666654", "c+ c #49493C", "d+ c #575748", "e+ c #57574A", "f+ c #7D7D6D", "g+ c #767669", "h+ c #B3B3A8", "i+ c #A1A194", "j+ c #6D6D61", "k+ c #B3B3A5", "l+ c #696957", "m+ c #414135", "n+ c #565647", "o+ c #444438", "p+ c #595951", "q+ c #585849", "r+ c #4E4E40", "s+ c #747467", "t+ c #616153", " . . . . . . ", " . + ＠ # $ % & * . . ", " . . . = - ; > , ' ) ! ~ { . . . ", " . ] ^ / ( _ : < [ } | 1 2 3 4 5 6 . ", " . 7 8 9 0 a b c d e f g h i j k l m n . ", " o p 8 q r s t u v w x y z A B C 2 C D . ", " . E F G H I J K L M N O D P Q R S T U . ", " . V W X Y Z ` ...0 +.S / ＠.#.$.%.&.*.. ", " =.-.;.>.,.'.).!.~.{.X ].^.G /.(._.:.<.. ", " . [.n }.|.1.2.3.4.5.6.7.8.9.0.9.a.b.c. ", " . d.e.f.g.h.i.j.k.l l l l.m.n.o.p.. ", " . q.r.s.t.u.v.w.x.( y.z.A.B.C.. D.. ", " . E.F.G.H.I.J.. K.. . . . L.M.N.O.. ", " . P.Q.R.S.T.U.V.W.X.Y.Z.`. +.+++＠+. ", " . #+$+%+&+*+=+-+;+>+,+'+)+!+~+{+`.. ", " . #+Q.]+^+/+(+_+:+<+,+'+[+}+X.|+X.. ", " . #+Q.1+^+2+3+4+3+5+`.6+7+|+X.|+X.. ", " . #+Q.8+^+9+3+4+3+5+`.6+7+|+X.|+X.. ", " . #+Q.5+^+2+3+4+3+5+`.6+7+|+X.|+X.. ", " . 0+Q.1+^+2+3+4+3+5+`.6+7+|+X.|+a+. ", " . b+Q.1+&+2+3+4+3+5+`.6+7+|+X.c+d+. ", " . e+f+g+h+i+j+k+5+`.6+l+m+n+o+. . ", " . . . p+q+r+s+t+~+c+c+. . . ", " . . . . . . . . . . "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/describe.xpm Index: describe.xpm =================================================================== /* XPM */ static char * stock_properties_xpm[] = { "24 24 68 1", " c None", ". c #000000", "+ c #74716E", "＠ c #C9C4BD", "# c #DFDAD2", "$ c #F4EFE5", "% c #F2ECE1", "& c #FFFFFF", "* c #4C4B48", "= c #EEE5D4", "- c #ECE2CF", "; c #EADFC9", "> c #F9F9F9", ", c #E2D2B1", "' c #F4F4F4", ") c #EEEEEE", "! c #959595", "~ c #F5F5F5", "{ c #F6F6F6", "] c #D9D9D9", "^ c #C7B99C", "/ c #E9E9E9", "( c #787878", "_ c #E1E1E1", ": c #E2E2E2", "< c #C8C8C8", "[ c #877E69", "} c #9A8F78", "| c #DEDEDE", "1 c #E3E3E3", "2 c #929292", "3 c #AFA389", "4 c #ACACAC", "5 c #A2A2A2", "6 c #E4E4E4", "7 c #BCBCBC", "8 c #939393", "9 c #EDEDED", "0 c #EFEFEF", "a c #F0F0F0", "b c #E5E5E5", "c c #E7E7E7", "d c #E8E8E8", "e c #EAEAEA", "f c #EBEBEB", "g c #BEBEBE", "h c #F1F1F1", "i c #DFDFDF", "j c #F3F3F3", "k c #E0E0E0", "l c #ABABAB", "m c #AEAEAE", "n c #AFAFAF", "o c #ADADAD", "p c #B0B0B0", "q c #B1B1B1", "r c #F7F7F7", "s c #B3B3B3", "t c #F8F8F8", "u c #B4B4B4", "v c #B5B5B5", "w c #B6B6B6", "x c #FAFAFA", "y c #FBFBFB", "z c #DCDCDC", "A c #DDDDDD", "B c #E6E6E6", "C c #969696", " ", " ", " ", " ......... ", " .+(a)#$%.&&. ", " *=---;.&>. ", " .......;.,,,,.'). ", " !~~{].;.^.,^^./(.. ", " .~_:<.;.[.^.}..|].. ", " .~:1.;.2.[.3.4...5. ", " .{16..7/8.[.49)0a|. ", " .{6bcd/ef8.g9)0ahi. ", " .{bcd/ef9ef9)0ahjk. ", " .{cllefmnomnppqj'_. ", " .rd/ef9)09)0ahj'~:. ", " .r/4o9)ppnppqss~{1. ", " .tef9)0ah0ahj'~{rb. ", " .>9npahssqssuvw>xc. ", " .>)0ahj'~j'~{r>xyd. ", " .nzA|ik_:k_:1bBcdC. ", " ................. ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/disconnect.xpm Index: disconnect.xpm =================================================================== /* XPM */ static char * stock_disconnect_xpm[] = { "24 24 42 1", " c None", ". c #000000", "+ c #989389", "＠ c #807D74", "# c #C6C2BA", "$ c #43423C", "% c #B7B3AA", "& c #C4C2BD", "* c #EAE8E3", "= c #E2E1DD", "- c #F0EFEC", "; c #AAA7A0", "> c #C5D2C8", ", c #E9EEEA", "' c #F0EEEB", ") c #F2F0ED", "! c #EBEAE6", "~ c #8A857B", "{ c #ECEBE8", "] c #EEECEA", "^ c #78756B", "/ c #BEBBB5", "( c #B3B1AA", "_ c #7D786E", ": c #E1DFDB", "< c #D1D0CC", "[ c #010101", "} c #8C8981", "| c #A6A29B", "1 c #726D63", "2 c #CECAC3", "3 c #A7A49E", "4 c #0F0F0D", "5 c #F0F3F1", "6 c #272622", "7 c #8B877E", "8 c #706C62", "9 c #B1ADA4", "0 c #6C685E", "a c #97938A", "b c #646056", "c c #8B877D", " ", " ", " ", " ", " ", " ", " .. ..", " ..+＠. .#＠", " $%&*＠.... .*＠", " .=-;*＠.>>,. .'＠", ".....＠=-;*＠.... .'＠", "******)!~{＠. .]＠", "＠＠＠＠^^/(_:^. .<＠", "....[^}|12^.... .3＠", " 4}|12^.>>5. .3＠", " 67890.... .a＠", " 44+b. .c＠", " 44 4.", " ", " ", " ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/exit.xpm Index: exit.xpm =================================================================== /* XPM */ static char * stock_exit_xpm[] = { "24 24 140 2", " c None", ". c #000000", "+ c #D6D6D4", "＠ c #BDBDBC", "# c #A8A8A4", "$ c #92928F", "% c #727370", "& c #61615E", "* c #20201F", "= c #F1F1EF", "- c #E6E6E4", "; c #DADAD7", "> c #CFCFCD", ", c #C4C4C1", "' c #A8A8A5", ") c #767674", "! c #777774", "~ c #1E1E1D", "{ c #B9B9B7", "] c #AEAEAC", "^ c #8F8F8D", "/ c #262626", "( c #414140", "_ c #E9836C", ": c #DEDEDC", "< c #C5C5C2", "[ c #636362", "} c #040504", "| c #040604", "1 c #050705", "2 c #E87B62", "3 c #E67056", "4 c #D5D5D3", "5 c #DBDBD8", "6 c #D0D0CE", "7 c #080A07", "8 c #0A0C09", "9 c #0A0D09", "0 c #0B0E0A", "a c #F0B0A1", "b c #EB8D77", "c c #DF421E", "d c #E97E66", "e c #CBCBC8", "f c #0C0F0B", "g c #0F130D", "h c #10140E", "i c #11150F", "j c #EFA392", "k c #BFBFBD", "l c #5D5D5C", "m c #10150F", "n c #141912", "o c #161C14", "p c #171D15", "q c #B7B7B4", "r c #0C0C0C", "s c #192017", "t c #1C2319", "u c #1D241A", "v c #CD8484", "w c #990000", "x c #701616", "y c #A6A6A5", "z c #181E16", "A c #1E261B", "B c #212A1E", "C c #222B1F", "D c #4F0000", "E c #AEAEAB", "F c #1D261B", "G c #242E21", "H c #273224", "I c #283325", "J c #580000", "K c #B5B5B3", "L c #293426", "M c #2D3929", "N c #2E3A2A", "O c #7C4343", "P c #6A0000", "Q c #720000", "R c #BDBDBB", "S c #232C20", "T c #2A3526", "U c #303C2B", "V c #33402E", "W c #C5C5C3", "X c #1E261C", "Y c #303D2C", "Z c #374532", "` c #394834", " . c #500000", ".. c #CDCDCB", "+. c #1B2319", "＠. c #253022", "#. c #303E2D", "$. c #394934", "%. c #3D4E38", "&. c #9D9D9B", "*. c #565655", "=. c #2C3828", "-. c #40503A", ";. c #43553E", ">. c #BABAB7", ",. c #777776", "'. c #323830", "). c #232C1F", "!. c #313E2D", "~. c #3B4A36", "{. c #43553D", "]. c #485B42", "^. c #4A5E44", "/. c #F0F0EE", "(. c #E5E5E3", "_. c #C6C6C3", ":. c #ACACAB", "<. c #8B8B8A", "[. c #32392F", "}. c #2C3728", "|. c #3F503A", "1. c #465840", "2. c #4B5E44", "3. c #4E6347", "4. c #506549", "5. c #DADAD8", "6. c #7A7D78", "7. c #333C30", "8. c #475A41", "9. c #4F6348", "0. c #53694C", "a. c #566C4E", "b. c #576D4F", "c. c #91968F", "d. c #3B4736", "e. c #42543C", "f. c #51674A", "g. c #586F50", "h. c #5B7353", "i. c #5C7454", " ", " . . . . . . . . . . . . . . . . ", " . + ＠ # $ % & & & * . . . . . . ", " . = - ; > , ' ) ! ~ . . . . . . ", " . . = - ; > , { ] ^ / . . . . . . ", " . . . = - ; > , { { { ( . . . . . . ", " . _ . : - ; > < { { { [ } | 1 1 1 . ", ". . . . . . 2 3 . 4 5 6 < { { { [ 7 8 9 0 0 . ", ". a 2 2 2 2 b c d . e 6 < { { { [ f g h i i . ", ". j c c c c c c c 3 . k < { l { [ m n o p p . ", ". j c c c c c c c c 3 . q { l r [ n s t u u . ", ". v w w w w w w w w w x . y r { [ z A B C C . ", ". v w w w w w w w w D . E { { { [ F G H I I . ", ". v w w w w w w w J . K < { { { [ C L M N N . ", ". O P P P P Q w J . R 6 < { { { [ S T U V V . ", ". . . . . . Q J . W 5 6 < { { { [ X H Y Z ` . ", " . .. ..- 5 6 < { { { [ +.＠.#.$.%.. ", " . . . = - 5 6 < { ] &.*.B =.Z -.;.. ", " . . = - 5 6 >.&.,.'.).!.~.{.].^.. ", " . /.(._.:.<.[.}.Z |.1.2.3.4.4.. ", " . 5.k 6.7.Z -.8.9.0.a.a.b.b.b.. ", " . c.d.e.^.f.g.h.i.i.i.i.i.i.i.. ", " . . . . . . . . . . . . . . . . ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/forward.xpm Index: forward.xpm =================================================================== /* XPM */ static char * stock_mail_forward_xpm[] = { "24 24 65 1", " c None", ". c #000000", "+ c #535353", "＠ c #FFFFFF", "# c #FEFEFE", "$ c #FDFDFD", "% c #FCFCFC", "& c #FBFBFB", "* c #F9F9F9", "= c #F8F8F8", "- c #F7F7F7", "; c #F6F6F6", "> c #F5F5F5", ", c #F4F4F4", "' c #E3E3E3", ") c #EEEEEE", "! c #4F4F4F", "~ c #F3F3F3", "{ c #F2F2F2", "] c #F1F1F1", "^ c #F0F0F0", "/ c #EFEFEF", "( c #EDEDED", "_ c #AEAEAE", ": c #E4E4E4", "< c #434343", "[ c #ACACAC", "} c #C8C8C8", "| c #A0A0A0", "1 c #D4D4D4", "2 c #ECECEC", "3 c #959595", "4 c #3E3E3E", "5 c #4D4D4D", "6 c #818181", "7 c #C6C6C6", "8 c #6A6A6A", "9 c #636363", "0 c #B9B9B9", "a c #737373", "b c #7C7C7C", "c c #5B88B2", "d c #9EB8D1", "e c #5080AD", "f c #B5C9DC", "g c #AFC5DA", "h c #B2C7DB", "i c #B6CADD", "j c #A4BDD5", "k c #9CB7D1", "l c #080D11", "m c #BCBCBC", "n c #9BB6D0", "o c #A0BAD3", "p c #9AB5CF", "q c #97B3CE", "r c #5F8BB4", "s c #91B0CC", "t c #95B2CE", "u c #4C79A3", "v c #49749C", "w c #3F6588", "x c #2A435B", "y c #456F96", "z c #375978", " ", " ", " ", " ................. ", " .+＠＠＠＠#$%&*=-;>,'+. ", " .)!＠>,~{{]^^/)('!_. ", " .＠:<$~{{]^/))('![}. ", " .＠>:!&]^^/)(('<|1}. ", " .＠&>:<=^/)(2'!31:}. ", " .＠>>>:4>)(2'567::}. ", " .＠&>>:8<~2'!877>.}. ", " .＠>>:9＠0!^!37a7>... ", " .＠&:9＠>:1![7::b:.c. ", " .＠:a＠>>>>:.......de. ", " .＠b＠::::::.fghiiijkel ", " .ammmmmmmm.nokknpokqr. ", " ..........sdppnkkkotu.", " .vwwwwwwwwx. ", " .yzzzzzwwx. ", " .......wx. ", " .x. ", " .. ", " . ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/inbox.xpm Index: inbox.xpm =================================================================== /* XPM */ static char * stock_inbox_xpm[] = { "24 24 76 1", " c None", ". c #000000", "+ c #B5CADD", "＠ c #BFD1E1", "# c #C3D4E3", "$ c #C7D7E5", "% c #B0C6DA", "& c #6B94BB", "* c #131E29", "= c #739ABF", "- c #7EA2C4", "; c #9AB6D0", "> c #E4EBF2", ", c #DDE6EF", "' c #8CACCA", ") c #5C8AB4", "! c #090F15", "~ c #B1C7DB", "{ c #D0DDEA", "] c #D9E3ED", "^ c #88A9C8", "/ c #4D7CA7", "( c #030405", "_ c #41688D", ": c #32506C", "< c #C4D5E4", "[ c #A5BED5", "} c #456F97", "| c #3B5F81", "1 c #C8D8E6", "2 c #9CB8D2", "3 c #395B7B", "4 c #C6D6E4", "5 c #BBCEDF", "6 c #3D6183", "7 c #B6CBDE", "8 c #426A90", "9 c #E2C6A9", "0 c #E5CDB4", "a c #D5AA7F", "b c #9D6733", "c c #CB9967", "d c #ADC4D9", "e c #B99877", "f c #CFBAA4", "g c #9A7149", "h c #CDA378", "i c #D2A87E", "j c #608DB6", "k c #AA7B4B", "l c #C2A588", "m c #996633", "n c #BB9978", "o c #C3976B", "p c #D2A980", "q c #D1A77D", "r c #E0C4A8", "s c #C9B097", "t c #D7B38E", "u c #DAC2A9", "v c #BD9063", "w c #CEA57C", "x c #E5CFBB", "y c #393633", "z c #E0C8B1", "A c #C9A480", "B c #D1A87E", "C c #D0A67B", "D c #E1CAB4", "E c #52504D", "F c #D8C6B5", "G c #CBA988", "H c #CCAF93", "I c #D2B496", "J c #A67D51", "K c #E2CFBD", " ...... ", " .+＠#$%&*. ", " .=-;$>,')! ", " ...=~{]^/( ", " .=+#$_:. ", " .<[＠}|. ", " .12＠}3. ", " ....425}6.... ", " .=2527}8}:. ", " ..9.=227}}:. ", " ..0abb.=2~}:.. ", " ..0abbbbc.=d:.ef.. ", ".0abbbbghii.j.kkklf.. ", ".mnabgopqqqi.iokkkkef. ", ".mmmnrooqiqqqiiiokkkks. ", ".mmmmmnrooqiqqqiiiokkl. ", " ..mmmmmnrooqiqqiiituf. ", " ..mmmmmnrvwiqqtxxy. ", " ..mmmmmzABCDxE.. ", " ...mmmFGHIE.. ", " ...mJK... ", " ..... ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/lock-broken.xpm Index: lock-broken.xpm =================================================================== /* XPM */ static char * stock_lock_broken_xpm[] = { "24 24 204 2", " c None", ". c #0E0E0E", "+ c #262626", "＠ c #464646", "# c #3C3C3C", "$ c #3B3B3B", "% c #212121", "& c #252525", "* c #ADADAD", "= c #F0F0F0", "- c #EAEAEA", "; c #1A1A1A", "> c #000000", ", c #FAFAFA", "' c #F4F4F4", ") c #4D4D4D", "! c #303030", "~ c #D8D8D8", "{ c #E5E5E5", "] c #B0B0B0", "^ c #414141", "/ c #484848", "( c #030303", "_ c #DADADA", ": c #E4E4E4", "< c #353535", "[ c #070707", "} c #A6A6A6", "| c #E6E6E6", "1 c #686868", "2 c #020202", "3 c #3E3E3E", "4 c #EFEFEF", "5 c #9B9B9B", "6 c #343434", "7 c #F8F8F8", "8 c #999999", "9 c #F1F1F1", "0 c #C4C4C4", "a c #232323", "b c #535353", "c c #AEAEAE", "d c #F3F3F3", "e c #D3D3D3", "f c #242424", "g c #4E4E4E", "h c #EEEEEE", "i c #B5B5B5", "j c #0F0601", "k c #200E03", "l c #765E49", "m c #7D6A56", "n c #38291D", "o c #180A03", "p c #D6CBC1", "q c #A09E9D", "r c #1D1109", "s c #2A1E13", "t c #3D2E21", "u c #3F3123", "v c #47423D", "w c #DBB98E", "x c #D6B183", "y c #D3AC7E", "z c #CFA573", "A c #CD9E67", "B c #C39056", "C c #46270A", "D c #281F14", "E c #675643", "F c #A48367", "G c #D8AB7C", "H c #BF9E7C", "I c #DCBB93", "J c #DCB786", "K c #D1A872", "L c #231B12", "M c #7B6C58", "N c #C69B63", "O c #C39860", "P c #C09257", "Q c #BD8A4A", "R c #B9803D", "S c #AA6E28", "T c #412409", "U c #100B07", "V c #CDB598", "W c #E8CCA9", "X c #DAB587", "Y c #D4AC7D", "Z c #D1A775", "` c #C99F6A", " . c #AF8B5B", ".. c #2E2517", "+. c #1E1910", "＠. c #0B0805", "#. c #594B39", "$. c #2A2015", "%. c #C2975E", "&. c #BE8D50", "*. c #BB823F", "=. c #AE722C", "-. c #422409", ";. c #0E0B07", ">. c #AB957E", ",. c #E9CEAC", "'. c #DBB68A", "). c #D5AD7E", "!. c #D0A975", "~. c #C9A26F", "{. c #B99667", "]. c #AA895F", "^. c #31291C", "/. c #322A1C", "(. c #54493B", "_. c #C69C64", ":. c #C2965E", "<. c #BE8E50", "[. c #C29156", "}. c #9E692A", "|. c #1A150D", "1. c #887762", "2. c #EAD1AF", "3. c #DDB98E", "4. c #D4AC7E", "5. c #D2A876", "6. c #C39E6D", "7. c #927751", "8. c #15110C", "9. c #988468", "0. c #C2945A", "a. c #BE8F51", "b. c #BC8544", "c. c #BE8A4F", "d. c #9A6526", "e. c #70604D", "f. c #EFD6B5", "g. c #DEBD93", "h. c #D4AC7C", "i. c #D0A672", "j. c #C9A069", "k. c #9D7E53", "l. c #140F09", "m. c #1F1710", "n. c #EFD8B9", "o. c #E3C39C", "p. c #D7B080", "q. c #D4AC79", "r. c #CDA46F", "s. c #3A2C1B", "t. c #FFFFFF", "u. c #1C160D", "v. c #B29E85", "w. c #E6C8A3", "x. c #D7B081", "y. c #D1A874", "z. c #CBA16A", "A. c #BA905A", "B. c #251C10", "C. c #DF421E", "D. c #F7F7F7", "E. c #DFDFDF", "F. c #2F2619", "G. c #92806A", "H. c #E6C7A2", "I. c #D6AF7E", "J. c #CCA26C", "K. c #53422A", "L. c #211910", "M. c #2A2014", "N. c #E1E1E1", "O. c #6A5C4A", "P. c #EAD0AD", "Q. c #DAB68B", "R. c #D2A978", "S. c #CEA56E", "T. c #C89D66", "U. c #856740", "V. c #534026", "W. c #F9F9F9", "X. c #FBFBFB", "Y. c #E2E2E2", "Z. c #42362B", "`. c #D1BA9B", " + c #DCBA8E", ".+ c #D1A773", "++ c #C4975C", "＠+ c #BE8C4C", "#+ c #B4813F", "$+ c #281B0B", "%+ c #E3E3E3", "&+ c #372416", "*+ c #74654F", "=+ c #B68E5C", "-+ c #926231", ";+ c #452B11", ">+ c #341E09", ",+ c #221205", "'+ c #150802", ")+ c #FDFDFD", "!+ c #030000", "~+ c #050000", "{+ c #010000", "]+ c #C3C3C3", " ", " ", " . + ＠ # $ % ", " & * = - ; > , ' ) > ", " ! ~ { ] ^ / ( $ _ : < ", " [ } | 1 2 3 4 5 > ", " 6 7 8 > > 9 0 a ", " b 9 c > > d e f ", " g h i > j k l m n o ", " ^ p q r s t u > v w x y z A B C ", " D E F G H I J K L > M N O P Q R S T ", " U V W X Y Z ` ...+. ＠.#.$.%.&.*.=.-. ", " ;.>.,.'.).!.~.{.].^./. (._.:.<.[.}.-. ", " |.1.2.3.4.5.6.7.8. > 9.0.a.b.c.d.T ", " e.f.g.h.i.j.k.l.> > > > > > > > > > ", " m.n.o.p.q.r._.s. > t.t.t.t.t.t.t.> ", " u.v.w.x.y.z.A.B.> > t.C.C.D.C.C.E.> ", " F.G.H.I.i.J.K.L.M. > t.C.C.C.C.C.N.> ", " O.P.Q.R.S.T.U.V. > t.W.C.C.C.X.Y.> ", " Z.`. +.+z.++＠+#+$+> > t.C.C.C.C.C.%+> ", " &+*+=+-+;+>+,+'+ > t.C.C.)+C.C.{ > ", " !+~+{+> > - %+%+: { { ]+> ", " > > > > > > > > > ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/lock-ok.xpm Index: lock-ok.xpm =================================================================== /* XPM */ static char * stock_lock_ok_xpm[] = { "24 24 188 2", " c None", ". c #000000", "+ c #212121", "＠ c #9E9E9E", "# c #E6E6E6", "$ c #E7E7E7", "% c #C8C8C8", "& c #A0A0A0", "* c #131313", "= c #5F5F5F", "- c #EDEDED", "; c #D6D6D6", "> c #D5D5D5", ", c #DDDDDD", "' c #D8D8D8", ") c #A1A1A1", "! c #3C3C3C", "~ c #353535", "{ c #EFEFEF", "] c #CFCFCF", "^ c #4C4C4C", "/ c #141414", "( c #6A6A6A", "_ c #D0D0D0", ": c #B2B2B2", "< c #454545", "[ c #E2E2E2", "} c #292929", "| c #0F0F0F", "1 c #949494", "2 c #E9E9E9", "3 c #C3C3C3", "4 c #1C1C1C", "5 c #E1E1E1", "6 c #272727", "7 c #DEDEDE", "8 c #B6B6B6", "9 c #B7B6B6", "0 c #150902", "a c #2E2419", "b c #251D15", "c c #616160", "d c #5E5A56", "e c #29211A", "f c #15100C", "g c #2F251B", "h c #1D1710", "i c #4A392B", "j c #656361", "k c #565352", "l c #392B1D", "m c #322110", "n c #0C0500", "o c #EFDBBF", "p c #EDD9C0", "q c #E9D5BE", "r c #E7D2B9", "s c #E5D0B3", "t c #DCC09D", "u c #D9BE99", "v c #DABE99", "w c #D7BB95", "x c #D5B68E", "y c #D2AF85", "z c #CFA77C", "A c #9A5E1B", "B c #F0DABF", "C c #E4C6A0", "D c #D6AF80", "E c #D3AC7B", "F c #D0A570", "G c #C99F68", "H c #C69B64", "I c #C69C64", "J c #C89D66", "K c #C79C65", "L c #C39860", "M c #C09256", "N c #BC8645", "O c #B67C36", "P c #985E1A", "Q c #EED8BC", "R c #E3C39C", "S c #D3AA7B", "T c #CFA670", "U c #CA9F68", "V c #C89E66", "W c #C89F68", "X c #C49961", "Y c #C09358", "Z c #BC8746", "` c #B77D39", " . c #EED8BB", ".. c #E2C29B", "+. c #D6AE7F", "＠. c #CA9E6D", "#. c #C69861", "$. c #BF925A", "%. c #BB8E56", "&. c #BD8E56", "*. c #5C7354", "=. c #EFDABE", "-. c #E4C49D", ";. c #D7B080", ">. c #DAB685", ",. c #D4B07C", "'. c #D0A971", "). c #CEA46B", "!. c #CDA46D", "~. c #FFFFFF", "{. c #DBE0D9", "]. c #52684B", "^. c #4E6346", "/. c #52674A", "(. c #EFD8BB", "_. c #E0C199", ":. c #D3AA7A", "<. c #C89B67", "[. c #C3965F", "}. c #BC8E56", "|. c #BA8B52", "1. c #BA8C54", "2. c #F6F6F6", "3. c #F7F7F7", "4. c #F8F8F8", "5. c #E6E9E5", "6. c #6B8064", "7. c #4B5F45", "8. c #44553D", "9. c #E3C29C", "0. c #D9B484", "a. c #D4AE77", "b. c #CFA770", "c. c #CCA46B", "d. c #CBA36B", "e. c #B6BEB3", "f. c #4E6047", "g. c #788274", "h. c #CBD2C9", "i. c #6A8063", "j. c #384834", "k. c #EDD6B8", "l. c #E1BD94", "m. c #D1A874", "n. c #BD9058", "o. c #B7874E", "p. c #B48349", "q. c #B5844C", "r. c #8F9C8A", "s. c #53684B", "t. c #475841", "u. c #657C5E", "v. c #4A5D44", "w. c #626E5D", "x. c #EED8BA", "y. c #E0C099", "z. c #D8B37F", "A. c #D2AD76", "B. c #CEA66F", "C. c #CCA46D", "D. c #FAFAFA", "E. c #6A7E63", "F. c #63715E", "G. c #E3E3E3", "H. c #EED5B7", "I. c #DFC096", "J. c #D2A776", "K. c #CEA46E", "L. c #C89D65", "M. c #C49960", "N. c #C1955C", "O. c #C2955C", "P. c #FBFBFB", "Q. c #FCFCFC", "R. c #80937A", "S. c #6D796A", "T. c #FEFEFE", "U. c #E5E5E5", "V. c #AC8C65", "W. c #CFA772", "X. c #C49256", "Y. c #C08D51", "Z. c #BA8849", "`. c #B78342", " + c #B48240", ".+ c #B68241", "++ c #EAEAEA", "＠+ c #E4E4E4", " ", " ", " . . . . . ", " . + ＠ # $ % & * ", " . = - # ; > , ' ) ! . ", " ~ { ] ^ . . / ( _ : < ", " . [ ' } . | ( % 1 . ", " * 2 3 . 4 5 ＠ . ", " 6 7 8 . . $ 9 . ", " 0 a b c d e f g b h b i j k l m n ", " . o p q r s t u u v u w x y z A . ", " . B C D E F G H I J K L M N O P . ", " . Q R D S T U I V W V X Y Z ` A . ", " . ...+.＠.#.$.%.&.. . . . . . . . . *. ", " . =.-.;.>.,.'.).!.. ~.~.~.~.~.~.{.].^./.", " . (._.:.<.[.}.|.1.. ~.2.3.3.4.5.6.7.8. ", " . Q 9.+.0.a.b.c.d.. ~.e.f.g.h.i.7.j. ", " . k.l.m.#.n.o.p.q.. ~.r.s.t.u.v.w.. ", " . x.y.S z.A.B.c.C.. ~.D.E.s./.F.G.. ", " . H.I.J.K.L.M.N.O.. ~.P.Q.R.S.T.U.. ", " . V.W.X.Y.Z.`. +.+. ++G.G.(a)+U.U.3 . ", " . . . . . . . . . . . . . . . . . ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/lock.xpm Index: lock.xpm =================================================================== /* XPM */ static char * stock_lock_xpm[] = { "24 24 200 2", " c None", ". c #000000", "+ c #212121", "＠ c #9E9E9E", "# c #E6E6E6", "$ c #E7E7E7", "% c #C8C8C8", "& c #A0A0A0", "* c #131313", "= c #5F5F5F", "- c #EDEDED", "; c #D6D6D6", "> c #D5D5D5", ", c #DDDDDD", "' c #D8D8D8", ") c #A1A1A1", "! c #3C3C3C", "~ c #353535", "{ c #EFEFEF", "] c #CFCFCF", "^ c #4C4C4C", "/ c #141414", "( c #6A6A6A", "_ c #D0D0D0", ": c #B2B2B2", "< c #454545", "[ c #E2E2E2", "} c #292929", "| c #0F0F0F", "1 c #949494", "2 c #E9E9E9", "3 c #C3C3C3", "4 c #1C1C1C", "5 c #E1E1E1", "6 c #272727", "7 c #DEDEDE", "8 c #B6B6B6", "9 c #B7B6B6", "0 c #150902", "a c #2E2419", "b c #251D15", "c c #616160", "d c #5E5A56", "e c #29211A", "f c #15100C", "g c #2F251B", "h c #1D1710", "i c #4A392B", "j c #656361", "k c #565352", "l c #392B1D", "m c #322110", "n c #0C0500", "o c #EFDBBF", "p c #EDD9C0", "q c #E9D5BE", "r c #E7D2B9", "s c #E5D0B3", "t c #DCC09D", "u c #D9BE99", "v c #DABE99", "w c #D7BB95", "x c #D5B68E", "y c #D2AF85", "z c #CFA77C", "A c #9A5E1B", "B c #F0DABF", "C c #E4C6A0", "D c #D6AF80", "E c #D3AC7B", "F c #D0A570", "G c #C99F68", "H c #C69B64", "I c #C69C64", "J c #C89D66", "K c #C79C65", "L c #C39860", "M c #C09256", "N c #BC8645", "O c #B67C36", "P c #985E1A", "Q c #EED8BC", "R c #E3C39C", "S c #D3AA7B", "T c #CFA670", "U c #CA9F68", "V c #C89E66", "W c #C89F68", "X c #C49961", "Y c #C09358", "Z c #BC8746", "` c #B77D39", " . c #EED8BB", ".. c #E2C29B", "+. c #D6AE7F", "＠. c #CA9E6D", "#. c #C69861", "$. c #BF925A", "%. c #BB8E56", "&. c #BD8E56", "*. c #BD9058", "=. c #BC8F58", "-. c #B9884E", ";. c #B48145", ">. c #BA8442", ",. c #B47834", "'. c #975C1A", "). c #EFDABE", "!. c #E4C49D", "~. c #D7B080", "{. c #DAB685", "]. c #D4B07C", "^. c #D0A971", "/. c #CEA46B", "(. c #CDA46D", "_. c #CCA66D", ":. c #CCA46B", "<. c #CA9F63", "[. c #C79858", "}. c #B9813F", "|. c #B37834", "1. c #975D1A", "2. c #EFD8BB", "3. c #E0C199", "4. c #D3AA7A", "5. c #C89B67", "6. c #C3965F", "7. c #BC8E56", "8. c #BA8B52", "9. c #BA8C54", "0. c #BB8D55", "a. c #BA8C55", "b. c #B6864C", "c. c #B47F43", "d. c #BA833F", "e. c #B37934", "f. c #9B601E", "g. c #E3C29C", "h. c #D9B484", "i. c #D4AE77", "j. c #CFA770", "k. c #CBA36B", "l. c #CCA46C", "m. c #CA9D61", "n. c #C69856", "o. c #BA813E", "p. c #B27733", "q. c #A36B2F", "r. c #EDD6B8", "s. c #E1BD94", "t. c #D1A874", "u. c #B7874E", "v. c #B48349", "w. c #B5844C", "x. c #B5884D", "y. c #B48146", "z. c #B27A3C", "A. c #B67D3A", "B. c #B07530", "C. c #A67137", "D. c #EED8BA", "E. c #E0C099", "F. c #D8B37F", "G. c #D2AD76", "H. c #CEA66F", "I. c #CCA46D", "J. c #CCA56D", "K. c #C99D61", "L. c #C69858", "M. c #B9803D", "N. c #B67D38", "O. c #AB783F", "P. c #EED5B7", "Q. c #DFC096", "R. c #D2A776", "S. c #CEA46E", "T. c #C89D65", "U. c #C49960", "V. c #C1955C", "W. c #C2955C", "X. c #C2965C", "Y. c #C09155", "Z. c #BC8A4B", "`. c #BE8A4C", " + c #A9773C", ".+ c #AC8C65", "++ c #CFA772", "＠+ c #C49256", "#+ c #C08D51", "$+ c #BA8849", "%+ c #B78342", "&+ c #B48240", "*+ c #B68241", "=+ c #B88544", "-+ c #BB8949", ";+ c #BC8748", ">+ c #BA874A", ",+ c #B98548", "'+ c #B27B3B", ")+ c #6D4215", " ", " ", " . . . . . ", " . + ＠ # $ % & * ", " . = - # ; > , ' ) ! . ", " ~ { ] ^ . . / ( _ : < ", " . [ ' } . | ( % 1 . ", " * 2 3 . 4 5 ＠ . ", " 6 7 8 . . $ 9 . ", " 0 a b c d e f g b h b i j k l m n ", " . o p q r s t u u v u w x y z A . ", " . B C D E F G H I J K L M N O P . ", " . Q R D S T U I V W V X Y Z ` A . ", " . ...+.＠.#.$.%.&.*.=.-.;.>.,.'.. ", " . ).!.~.{.].^./.(._.:.<.[.}.|.1.. ", " . 2.3.4.5.6.7.8.9.0.a.b.c.d.e.f.. ", " . Q g.+.h.i.j.:.k.l.k.m.n.o.p.q.. ", " . r.s.t.#.*.u.v.w.x.b.y.z.A.B.C.. ", " . D.E.S F.G.H.:.I.J.l.K.L.M.N.O.. ", " . P.Q.R.S.T.U.V.W.X.X.Y.Z.>.`. +. ", " . .+++＠+#+$+%+&+*+=+-+;+>+,+'+)+. ", " . . . . . . . . . . . . . . . ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/move.xpm Index: move.xpm =================================================================== /* XPM */ static char * stock_mail_move_xpm[] = { "24 24 76 1", " c None", ". c #010101", "+ c #2F2F2F", "＠ c #E3E2E1", "# c #FCFCFC", "$ c #B3B2B1", "% c #95938E", "& c #F7F7F7", "* c #F5F4F2", "= c #F8F8F8", "- c #F7F6F6", "; c #EAE9E5", "> c #7B7976", ", c #D2CFCA", "' c #E1E0DD", ") c #908E8B", "! c #EBEAEA", "~ c #F1F0EE", "{ c #E2E0DD", "] c #7C7B78", "^ c #C6C3C0", "/ c #E5E3DE", "( c #DCDAD7", "_ c #8F8C88", ": c #EBEBEA", "< c #EFEDEA", "[ c #DFDDDA", "} c #787774", "| c #C1BEBA", "1 c #E6E3E0", "2 c #EFEEEC", "3 c #CBCAC6", "4 c #ECECEC", "5 c #F3F2F0", "6 c #DCDCDC", "7 c #7D7C79", "8 c #B4B2AE", "9 c #E7E5E1", "0 c #F0EFEB", "a c #E4E2DD", "b c #9D9994", "c c #DBD9D6", "d c #747370", "e c #A09C97", "f c #DAD8D5", "g c #E7E6E3", "h c #E8E6E1", "i c #E0DED9", "j c #AFACA6", "k c #F7F6F4", "l c #D3D1CF", "m c #868480", "n c #C2BFBD", "o c #DAD9D5", "p c #F6F5F1", "q c #D8D6D1", "r c #ABA8A3", "s c #F9F8F6", "t c #F7F5F2", "u c #92908B", "v c #CCCAC5", "w c #EAE9E8", "x c #B0ADA7", "y c #F5F3F0", "z c #F7F6F2", "A c #F5F4F0", "B c #EAE8E3", "C c #D2D0CB", "D c #B9B8B6", "E c #CBC9C4", "F c #DEDBD5", "G c #D9D7D2", "H c #DAD8D3", "I c #D5D3CE", "J c #D6D4CF", "K c #040404", " ", " ", " ", " . . . . . . . ", " . . ", " ", " . . ", " ", " . . ", " .+........... ", " . .＠###########$. ", " .#%&*=*-*-*;>,. ", " . .#')!~-*-*{]^/. ", " .#~(_:~<~[}|1/. ", " . . .#~23]4567890a. ", " .#22~b]cdefghi. ", " .#~2jklmnoep0q. ", " .#2rsskfkttuhv. ", " .wxsyzAtAtyBuC. ", " .DEFFFGHIJCCCu. ", " ............K ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/next-page.xpm Index: next-page.xpm =================================================================== /* XPM */ static char * stock_next_page_xpm[] = { "24 24 92 2", " c None", ". c #000000", "+ c #5B7289", "＠ c #FFFFFF", "# c #F2F2F2", "$ c #E5E5E5", "% c #D8D8D8", "& c #CCCCCC", "* c #B0B0B0", "= c #8B8B8B", "- c #6A6A6A", "; c #494949", "> c #888888", ", c #C9C9C9", "' c #E3E3E3", ") c #EEEEEE", "! c #E6E6E6", "~ c #DEDEDE", "{ c #D6D6D6", "] c #ADADAD", "^ c #556D85", "/ c #47617B", "( c #BFBFBF", "_ c #B2B2B2", ": c #ACACAC", "< c #A6A6A6", "[ c #F6F6F6", "} c #384F66", "| c #3A5067", "1 c #DADADA", "2 c #3A5168", "3 c #D3D3D3", "4 c #3B5269", "5 c #47617C", "6 c #3D526A", "7 c #48627D", "8 c #B6B6B6", "9 c #959595", "0 c #7C7C7C", "a c #616161", "b c #464646", "c c #262626", "d c #C5C5C5", "e c #3E546A", "f c #49637D", "g c #3F556B", "h c #4B647E", "i c #40566C", "j c #4C647F", "k c #41576D", "l c #4C657F", "m c #42586E", "n c #4E6780", "o c #44586F", "p c #4F6881", "q c #B5B5B5", "r c #45596F", "s c #506982", "t c #77838F", "u c #9C9FA1", "v c #91969C", "w c #91979C", "x c #92979C", "y c #92979D", "z c #A2A3A4", "A c #9D9FA2", "B c #8F9296", "C c #8F9396", "D c #8F9397", "E c #909397", "F c #868788", "G c #465B70", "H c #526A83", "I c #3E5975", "J c #3F5A76", "K c #415B77", "L c #425C78", "M c #435E79", "N c #445F7A", "O c #46607B", "P c #68727D", "Q c #7D8185", "R c #616A73", "S c #3B4F63", "T c #3C5064", "U c #3C5065", "V c #3E5166", "W c #3F5266", "X c #405367", "Y c #405468", "Z c #344353", "` c #2F4050", " ", " ", " . . . . . . . . . . . . . . . . ", " . + ＠ # $ % & * = - ; > , ' ) ! ~ { ] ^ . ", " . / ＠ # $ % & ( _ : < ＠＠ [ ) ! ~ { _ } . ", " . / ＠ # $ % & ( _ : < ＠ ' [ ) ! ~ { _ | . ", " . / ＠ # $ % & ( _ : < ＠ . 1 ) ! ~ { * 2 . ", " . / ＠ # $ % & ( _ : < ＠ . . 3 ! ~ { * 4 . ", " . 5 ＠ # $ % & ( _ : < ＠ . . . & ~ { * 6 . ", " . 7 ＠ # $ 8 9 0 a b c . . . . . d { * e . ", " . f ＠ # $ % & ( _ : < ＠ . . . & ~ { * g . ", " . h ＠ # $ % & ( _ : < ＠ . . 3 ! ~ { * i . ", " . j ＠ # $ % & ( _ : < ＠ . 1 ) ! ~ { * k . ", " . l ＠ # $ % & ( _ : < ＠ ' [ ) ! ~ { * m . ", " . n ＠ # $ % & ( _ : < ＠＠ [ ) ! ~ { * o . ", " . p ＠ # $ % & ( _ : < ＠＠ [ ) ! ~ { q r . ", " . s t u v w x y y z < A B C C D D E F G . ", " . H I J K L M N O P Q R S T U V W X Y Z . ", " . . . . . . . . . ` . . . . . . . . . . ", " . . . ", " ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/not-spam.xpm Index: not-spam.xpm =================================================================== /* XPM */ static char * stock_not_spam_xpm[] = { "24 24 122 2", " c None", ". c #1D1E1E", "+ c #333839", "＠ c #393F40", "# c #171819", "$ c #B2B8B9", "% c #D5E3E7", "& c #AABABD", "* c #64696A", "= c #0C0D0D", "- c #929C9E", "; c #E7F0F3", "> c #EDF0F1", ", c #E5EDEF", "' c #C5D9DD", ") c #2E3132", "! c #3F4343", "~ c #1F2121", "{ c #DFEBEE", "] c #B7C4C8", "^ c #D2D9DA", "/ c #E1EFF2", "( c #B6CBCF", "_ c #3C4547", ": c #1E2223", "< c #191E1F", "[ c #2D2E2F", "} c #191A1A", "| c #252829", "1 c #7E8E92", "2 c #B7C2C3", "3 c #C3D9DD", "4 c #9CACB0", "5 c #C3CDCE", "6 c #C7E1E7", "7 c #668F97", "8 c #90ACB2", "9 c #CDDDE1", "0 c #485559", "a c #88A6AC", "b c #1F2223", "c c #3F4545", "d c #242728", "e c #313B3E", "f c #A8C2C8", "g c #B2BDC0", "h c #CFE5E9", "i c #C2D9DE", "j c #81989C", "k c #A2C0C5", "l c #85A9B1", "m c #E5ECEE", "n c #E7F2F4", "o c #9BAEB3", "p c #C8E1E7", "q c #3A3E3F", "r c #0C0E0E", "s c #000000", "t c #333737", "u c #B3C2C5", "v c #DDEDF0", "w c #D8E4E6", "x c #DAECEF", "y c #D5E9ED", "z c #D2E7EC", "A c #95ADB2", "B c #DBE2E2", "C c #EDEFF0", "D c #A2B1B3", "E c #8FA4A8", "F c #D7E2E5", "G c #798F94", "H c #151819", "I c #F3B5A7", "J c #865E55", "K c #AFB9BB", "L c #F1F8F9", "M c #F7FBFB", "N c #D9EBEF", "O c #ECF4F6", "P c #F3F7F7", "Q c #E9F2F4", "R c #EEF2F3", "S c #E9EDEE", "T c #C5C8C9", "U c #C2C6C8", "V c #E0E7E7", "W c #DDEAED", "X c #7A9DA5", "Y c #EB8169", "Z c #B83618", "` c #924E3C", " . c #9FA5A6", ".. c #E3EEF0", "+. c #ECF5F7", "＠. c #D6EAED", "#. c #CBE4E9", "$. c #747C7D", "%. c #B43518", "&. c #E76A4D", "*. c #B53F24", "=. c #CB705A", "-. c #C4D8DB", ";. c #D2E6E9", ">. c #CAE3E8", ",. c #A9C8CF", "'. c #EC927D", "). c #E66F54", "!. c #D26951", "~. c #F1A897", "{. c #E76547", "]. c #C58B7D", "^. c #A8ABAC", "/. c #70A1AB", "(. c #DF421E", "_. c #C43A1A", ":. c #E17055", "<. c #DD8D7A", "[. c #FFFFFF", "}. c #030505", "|. c #A2432E", "1. c #AC3316", " ", " ", " . + ＠ ", " # $ % & * . ", " = - ; > , ' ) ! ", " ~ { ] ^ / ( _ : < [ } ", " | 1 2 3 4 5 6 7 8 9 0 a b ", " c d e f g h i j k l m n o p q r ", " s t u v w / x y z A B C D E F G H ", " s s I J K L M N O P Q R S T U V W X < ", "s I Y Z ` ...+.＠.#.$.s s s s s s s s s s s s ", "s %.&.Y *.=.-.;.>.,.s '.).).).).).).).).).).!.s ", "s %.%.%.&.~.{.].^./.s ).(.(.(.(.(.(.(.(.(.(._.s ", "s %.%.%.%.%.&.~.:.<.s ).(.[.[.(.(.(.(.[.[.(._.s ", " s s %.%.%.%.%.&.~.s ).(.[.[.[.(.(.[.[.[.(._.s ", " s s %.%.%.%.%.s ).(.(.[.[.[.[.[.[.(.(._.s ", " s s %.%.%.s ).(.(.(.[.[.[.[.(.(.(._.s ", " }.s s |.s ).(.(.(.[.[.[.[.(.(.(._.s ", " s s s ).(.(.[.[.[.[.[.[.(.(._.s ", " s ).(.[.[.[.(.(.[.[.[.(._.s ", " s ).(.[.[.(.(.(.(.[.[.(._.s ", " s ).(.(.(.(.(.(.(.(.(.(._.s ", " s !._._._._._._._._._._.1.s ", " s s s s s s s s s s s s "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/outbox.xpm Index: outbox.xpm =================================================================== /* XPM */ static char * stock_outbox_xpm[] = { "24 24 69 1", " c None", ". c #000000", "+ c #E66040", "＠ c #EE937E", "# c #E55E3F", "$ c #E1431F", "% c #EC8770", "& c #F0A08E", "* c #F3B7A9", "= c #EF9985", "- c #E76749", "; c #ED8C75", "> c #F5BEB1", ", c #F3B4A5", "' c #F4B8AA", ") c #F1A593", "! c #E55B3B", "~ c #E45534", "{ c #F4BDB0", "] c #F4BAAC", "^ c #EF9C89", "/ c #E34E2B", "( c #C0391A", "_ c #8A2912", ": c #3E3E3C", "< c #D4D3D2", "[ c #DB411D", "} c #F1A999", "| c #D23E1C", "1 c #812611", "2 c #C7C7C5", "3 c #ACABA8", "4 c #6A6966", "5 c #E9775D", "6 c #CECDCC", "7 c #A93217", "8 c #9B9A97", "9 c #494846", "0 c #9A9996", "a c #BBBBB9", "b c #747370", "c c #A5A4A1", "d c #AAA9A6", "e c #686765", "f c #7D7C79", "g c #686764", "h c #9C9B98", "i c #999895", "j c #ABAAA7", "k c #A9A8A5", "l c #AF3417", "m c #E55D3D", "n c #C5C5C3", "o c #8D8C89", "p c #626260", "q c #B2B1AE", "r c #A7A6A3", "s c #B4B4B2", "t c #C3C3C1", "u c #92918E", "v c #D1D0CF", "w c #373735", "x c #CACAC8", "y c #A8A7A4", "z c #CCCCCA", "A c #52514E", "B c #C8C8C6", "C c #B5B5B3", "D c #7E7D7A", " . ", " .. ", " .+. ", " ....＠#. ", " .$%&*=＠-. ", " .;>,')＠＠＠!. ", " .~{]*^＠＠＠＠＠-.", " ...＠>/((((((_. ", " .:<.[}|((((((1. ", " ..234.5+(_...(1. ", " ..63444.＠(7...._. ", " ..6344448.(a)(.90a.. ", ".634444bcd.#$.eff.a.. ", ".gh34bijkk.lm.iffff0a. ", ".ggghniikdo..pddiffffq. ", ".ggggghniikdkkkdddiffr. ", " ..ggggghniikdkkdddsta. ", " ..ggggghnurdkksvvw. ", " ..gggggxrdyzvA.. ", " ...gggB3qCA.. ", " ...gDv... ", " ..... ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/refresh.xpm Index: refresh.xpm =================================================================== /* XPM */ static char * stock_refresh_xpm[] = { "24 24 86 1", " c None", ". c #000000", "+ c #F3F6F8", "＠ c #C8D4DF", "# c #F7F9FA", "$ c #0D110C", "% c #6286A5", "& c #A0B6C9", "* c #C9D5E0", "= c #F2F5F7", "- c #172116", "; c #819EB6", "> c #CAD6E1", ", c #CCD7E1", "' c #CED9E3", ") c #F6F8F9", "! c #7192AE", "~ c #587B99", "{ c #CDD8E2", "] c #CFDAE4", "^ c #D3DDE6", "/ c #D5DEE6", "( c #ADC0D0", "_ c #90A9BF", ": c #537490", "< c #23323E", "[ c #85A1B8", "} c #5E83A3", "| c #6084A3", "1 c #6689A7", "2 c #678AA8", "3 c #48657D", "4 c #A8BCCD", "5 c #7393AE", "6 c #6B8DAA", "7 c #5C81A1", "8 c #5D82A2", "9 c #6588A6", "0 c #435F76", "a c #B1C3D2", "b c #50718D", "c c #9FB5C8", "d c #94ACC1", "e c #425D73", "f c #435E74", "g c #B4C5D3", "h c #6C8EAB", "i c #C4D2DD", "j c #5B80A0", "k c #456178", "l c #7595B0", "m c #BFCEDA", "n c #597D9C", "o c #A3B8CA", "p c #B0C2D1", "q c #86A2B9", "r c #6E8FAB", "s c #E1E8EE", "t c #B9C9D6", "u c #6387A6", "v c #4C6B85", "w c #7F9DB6", "x c #BCCCD9", "y c #DDE5EC", "z c #E4EAEF", "A c #D8E1E9", "B c #D1DBE4", "C c #C7D3DE", "D c #B7C8D6", "E c #7091AD", "F c #537592", "G c #9DB3C6", "H c #8CA7BD", "I c #304353", "J c #4E6E89", "K c #829FB7", "L c #92ABC0", "M c #C5D3DE", "N c #7C9AB3", "O c #5A7E9D", "P c #47647C", "Q c #6185A4", "R c #5B7F9E", "S c #4F6F8A", "T c #405A71", "U c #283926", " . ", " .. ", " .+. ", " ....＠#. ", " $%&＠＠**=. .. ", " -;＠＠**>,'). .!~. ", " .%＠**>,{]^/(. ._:. ", " <&＠[}}|%123. .4. ", ".5＠678|%920. .ab. ", ".cd7e...1f. . .gh. ", ".ijb. .k. .. .al. ", ".mn. .. .'. .op5. ", ".qr. . .*s...at4u. ", ".vw. .xyzyABCDEF. ", " .G. .p'B,＠ixaH2I. ", " .JK. .LM＠,>>MmNOP. ", " .F9. .9|%Q|}7RS.. ", " .. .|R~~nJT.. ", " .j~.... ", " UO. ", " .. ", " . ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/reply-all.xpm Index: reply-all.xpm =================================================================== /* XPM */ static char * stock_mail_reply_to_all_xpm[] = { "24 24 149 2", " c None", ". c #000000", "+ c #ADA99C", "＠ c #E6E1D0", "# c #F0EAD9", "$ c #A9A598", "% c #141416", "& c #161618", "* c #080809", "= c #DBD6C7", "- c #1B1B1C", "; c #050505", "> c #5A5A5A", ", c #676767", "' c #020202", ") c #807D76", "! c #D49A3E", "~ c #D2973B", "{ c #040402", "] c #6D6B6B", "^ c #7A7979", "/ c #030100", "( c #040100", "_ c #282724", ": c #DD9831", "< c #DA962F", "[ c #1A0E01", "} c #BC6D1B", "| c #BE6E13", "1 c #BE6D13", "2 c #BD6C13", "3 c #3E3C36", "4 c #D69029", "5 c #D18D27", "6 c #737067", "7 c #110900", "8 c #CF791C", "9 c #CE791C", "0 c #CD761A", "a c #C47013", "b c #4A4136", "c c #A0731E", "d c #96691A", "e c #000100", "f c #291703", "g c #BA6613", "h c #8C4E0D", "i c #844A0D", "j c #BF6D13", "k c #1F2A0D", "l c #306220", "m c #4F7242", "n c #448D44", "o c #2E802E", "p c #3A6F3A", "q c #FFFFFF", "r c #535353", "s c #171009", "t c #AC600C", "u c #713F0A", "v c #693A0A", "w c #AA5F0A", "x c #192B10", "y c #275926", "z c #68A769", "A c #358A36", "B c #2D812D", "C c #FBFBFB", "D c #F7F7F7", "E c #FAFAFA", "F c #F5F5F5", "G c #4F4F4F", "H c #AEAEAE", "I c #141517", "J c #6F767C", "K c #534C46", "L c #241609", "M c #23180E", "N c #484644", "O c #354A4D", "P c #050B07", "Q c #4F7E4F", "R c #399239", "S c #2D852D", "T c #297F29", "U c #ACACAC", "V c #C8C8C8", "W c #151618", "X c #6C7C8B", "Y c #728EA9", "Z c #5D6B78", "` c #C8CBCD", " . c #C3C7CD", ".. c #8090A2", "+. c #5A728B", "＠. c #4E6479", "#. c #111714", "$. c #328732", "%. c #2B7F2C", "&. c #2B772C", "*. c #434343", "=. c #A0A0A0", "-. c #D4D4D4", ";. c #25282A", ">. c #8A9EB4", ",. c #6A86A1", "'. c #596A7C", "). c #DDE1E4", "!. c #DCE2E7", "~. c #899CAC", "{. c #687E96", "]. c #546D87", "^. c #10161D", "/. c #8C8C8C", "(. c #959595", "_. c #E4E4E4", ":. c #23282D", "<. c #8096AB", "[. c #5D7996", "}. c #53687D", "|. c #CDD3D9", "1. c #CBD2DC", "2. c #899BAB", "3. c #CCD4DC", "4. c #5C748C", "5. c #111820", "6. c #4D4D4D", "7. c #818181", "8. c #C6C6C6", "9. c #1F252B", "0. c #6B8197", "a. c #536D89", "b. c #4A5D6F", "c. c #81919F", "d. c #8293A4", "e. c #5A7087", "f. c #496481", "g. c #445D79", "h. c #0E151B", "i. c #6A6A6A", "j. c #0E141A", "k. c #0D1319", "l. c #0E141B", "m. c #0E131A", "n. c #0F141A", "o. c #636363", "p. c #737373", "q. c #7C7C7C", "r. c #BCBCBC", " ", " . . ", " + ＠ # $ . ", " % & * = # # # . ", " - ; > , ' ) ! ~ # . ", " { ] ^ / ( _ : < # . ", " [ } | 1 2 3 4 5 # 6 ", " 7 8 9 0 a b c d # # . e . . . . . . ", " f g h i j k l m n o p . q q q q q r . ", " s t u v w x y z A o B . C D E F G H . ", " I J K L M N O P Q R S T . F F F G U V . ", " W X Y Z ` ...+.＠.#.$.%.&.. F F *.=.-.V . ", " ;.>.,.'.).!.~.{.].^.. . . /.F G (.-._.V . ", ":.<.[.}.|.1.2.3.4.5.F F F F 6.7.8._._.V . ", " 9.0.a.b.c.d.e.f.g.h.F F F G i.=._.F _.V . ", " j.k.l.l.l.j.m.n.o.G F G (.8.p.8.F _.V . ", " . q C F o.8.F _.-.G U 8._.F q._._.V . ", " . q F p.-.F F F F _._.F F F F q._.V . ", " . q q.-._._._._._._._._._._._._.q.V . ", " . p.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.o.. ", " . . . . . . . . . . . . . . . . . . ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/save-draft.xpm Index: save-draft.xpm =================================================================== /* XPM */ static char * stock_mail_handling_xpm[] = { "24 24 72 1", " c None", ". c #000000", "+ c #BCBCBC", "＠ c #FFFFFF", "# c #535353", "$ c #EEEEEE", "% c #4F4F4F", "& c #F5F5F5", "* c #FBFBFB", "= c #F7F7F7", "- c #FAFAFA", "; c #AEAEAE", "> c #E4E4E4", ", c #434343", "' c #ACACAC", ") c #C8C8C8", "! c #A0A0A0", "~ c #D4D4D4", "{ c #959595", "] c #3E3E3E", "^ c #4D4D4D", "/ c #818181", "( c #C6C6C6", "_ c #6A6A6A", ": c #636363", "< c #B9B9B9", "[ c #737373", "} c #010101", "| c #AAAAAA", "1 c #0B0B0B", "2 c #0C0C0C", "3 c #060606", "4 c #E4E3E1", "5 c #050505", "6 c #B3B3B1", "7 c #484641", "8 c #9F9D96", "9 c #888781", "0 c #7C7C7C", "a c #B0AFAD", "b c #A8A7A1", "c c #908E86", "d c #97958E", "e c #807D74", "f c #969696", "g c #090909", "h c #595854", "i c #605E57", "j c #898883", "k c #76746B", "l c #43423F", "m c #282724", "n c #363430", "o c #6D6B63", "p c #E2E2E1", "q c #B6B5AF", "r c #21201E", "s c #0A0908", "t c #181816", "u c #E6E6E4", "v c #65635C", "w c #161614", "x c #8C8B89", "y c #DFDEDC", "z c #B0AFA9", "A c #D5D4D1", "B c #93918B", "C c #D6D5D2", "D c #ABA9A3", "E c #5D5C55", "F c #494943", "G c #42413C", " ", " ................. ", " .+＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠#. ", " .$%&*&*=*&*&*=-&%;. ", " .＠>,&&&&&&&&&&&%'). ", " .＠&>%&&&&&&&&&,!~). ", " .＠*&>,&&&&&&&%{~>). ", " .＠&&&>]&&&&&^/(>>). ", " .＠*&&&_,&&&%_!>&>). ", " .＠&&&:<<%&%{([(}}}. ", " .＠*&:(&>~%'|12:345... ", " .(a)&[~&&&&>>2>62787.9.. ", " .＠0~>>>>>>>1ab888cde7. ", " .[+++++++++fg88hijek. ", " ...........78ilmn8o7..", " .pq8hrstuevi.", " ..78jnwxyv7..", " .zequABv. ", " .CD8eekkE7. ", " ..h.7k7.F.. ", " .. .G. .. ", " ... ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/save.xpm Index: save.xpm =================================================================== /* XPM */ static char * mail_save_xpm[] = { "24 24 264 2", " c None", ". c #000000", "+ c #141414", "＠ c #262626", "# c #212121", "$ c #1F1F1F", "% c #1E1E1E", "& c #1D1D1D", "* c #202020", "= c #232323", "- c #292929", "; c #171717", "> c #121212", ", c #B8B8B8", "' c #FFFFFF", ") c #A8A8A8", "! c #0E0E0E", "~ c #595959", "{ c #444444", "] c #4F4F4F", "^ c #050505", "/ c #222222", "( c #3D3D3D", "_ c #FEFEFE", ": c #FCFCFC", "< c #FDFDFD", "[ c #CACACA", "} c #191919", "| c #B3B1B0", "1 c #EEECEB", "2 c #F0DCAA", "3 c #E5C470", "4 c #DFB84F", "5 c #8A681F", "6 c #100E09", "7 c #FBFBFB", "8 c #515151", "9 c #F0F0F0", "0 c #D6D6D6", "a c #EEECE9", "b c #E6D498", "c c #EED682", "d c #EED680", "e c #E3C15E", "f c #D29815", "g c #976E15", "h c #7F5B0A", "i c #1C190F", "j c #D9D9D9", "k c #424242", "l c #F1F1F1", "m c #F3F3F3", "n c #EBE9E5", "o c #CBB771", "p c #735817", "q c #C6A546", "r c #E3C05D", "s c #BC8710", "t c #AD7C10", "u c #6B6B6B", "v c #A0A0A0", "w c #535353", "x c #505050", "y c #AE9C5C", "z c #292928", "A c #CECDCA", "B c #CAC9C7", "C c #1A1917", "D c #9C7E2B", "E c #AB7C12", "F c #242012", "G c #555555", "H c #DEDEDE", "I c #E8E8E8", "J c #3B3B3B", "K c #D7D6D6", "L c #656462", "M c #DAD9D7", "N c #E1E0DF", "O c #1A1A19", "P c #3D351F", "Q c #A37819", "R c #231F13", "S c #282828", "T c #898989", "U c #EFEFEF", "V c #FAFAFA", "W c #E8E7E6", "X c #8B8B8A", "Y c #0B0B06", "Z c #A97C1A", "` c #1B1B1B", " . c #C9C9C9", ".. c #DFDFDF", "+. c #EBEBEB", "＠. c #ECECEC", "#. c #E1E1E1", "$. c #221E11", "%. c #EAE8E3", "&. c #C58F13", "*. c #B68411", "=. c #826321", "-. c #302C19", ";. c #131313", ">. c #1A1A1A", ",. c #161616", "'. c #151515", "). c #181818", "!. c #1B1B1A", "~. c #141413", "{. c #363220", "]. c #916F25", "^. c #322F1E", "/. c #98B4C8", "(. c #25313B", "_. c #A9CCE0", ":. c #545A68", "<. c #BC6A60", "[. c #AD5A51", "}. c #A4574D", "|. c #2B2719", "1. c #353120", "2. c #5A4D51", "3. c #6E8DA2", "4. c #0C1820", "5. c #BAE5FF", "6. c #696E6F", "7. c #F9F9F9", "8. c #EBEBEA", "9. c #937025", "0. c #CDCAC1", "a. c #73726E", "b. c #7496AF", "c. c #0A131A", "d. c #BAE0FD", "e. c #6A6E71", "f. c #ECEDEC", "g. c #DEDFDF", "h. c #DBDDDD", "i. c #D8DBDB", "j. c #CDCFCF", "k. c #312E1B", "l. c #2F2C19", "m. c #B2B3B0", "n. c #C0C0BE", "o. c #6F6D6B", "p. c #7C9FBB", "q. c #050F15", "r. c #B7DDFC", "s. c #54575A", "t. c #F4F4F3", "u. c #ECECEB", "v. c #F3F3F2", "w. c #7F7D7A", "x. c #7EA0BB", "y. c #020A10", "z. c #B1D7F7", "A. c #FDFCFB", "B. c #EFEFEE", "C. c #EDEDEC", "D. c #EBECEB", "E. c #EBECEC", "F. c #F7F7F6", "G. c #7D7977", "H. c #7F9FB9", "I. c #050B0E", "J. c #B3DDF7", "K. c #685050", "L. c #847F7C", "M. c #7E9DB7", "N. c #0A0B0C", "O. c #A9D3F0", "P. c #7B99AB", "Q. c #6B6E70", "R. c #63696C", "S. c #60666B", "T. c #5E6569", "U. c #555E67", "V. c #5D6267", "W. c #61676B", "X. c #64696D", "Y. c #62666A", "Z. c #6B747E", "`. c #7D9CB4", " + c #000508", ".+ c #A8CBED", "++ c #7498B7", "＠+ c #6F92B0", "#+ c #3F5160", "$+ c #4A5E70", "%+ c #566E82", "&+ c #4D6779", "*+ c #52697C", "=+ c #52697A", "-+ c #54687A", ";+ c #455E70", ">+ c #7697B4", ",+ c #92A9BC", "'+ c #000205", ")+ c #A8CEEB", "!+ c #7196B3", "~+ c #4D5152", "{+ c #D7D2CB", "]+ c #F1EEEA", "^+ c #FAF8F5", "/+ c #F9F8F5", "(+ c #E8E4DF", "_+ c #D8D4CD", ":+ c #9D968B", "<+ c #425563", "[+ c #446783", "}+ c #A7C4DA", "|+ c #000101", "1+ c #A5CDEA", "2+ c #7196B1", "3+ c #57595C", "4+ c #534F46", "5+ c #2E281F", "6+ c #CAC7C2", "7+ c #C9C4BD", "8+ c #C2BBB1", "9+ c #E3E0DC", "0+ c #314353", "a+ c #40647C", "b+ c #B6C9DA", "c+ c #A3CDEB", "d+ c #7695B1", "e+ c #525455", "f+ c #474239", "g+ c #3B372D", "h+ c #C0BCB5", "i+ c #C7C2BA", "j+ c #E2DFD9", "k+ c #F8F6F3", "l+ c #344652", "m+ c #406479", "n+ c #A6C3DA", "o+ c #010000", "p+ c #708798", "q+ c #6A8DA7", "r+ c #4F5052", "s+ c #F7F2EC", "t+ c #59534B", "u+ c #57524A", "v+ c #C1BCB4", "w+ c #EBE9E4", "x+ c #FFFFFD", "y+ c #30414E", "z+ c #415C6F", "A+ c #A2C4DC", "B+ c #020000", "C+ c #030406", "D+ c #141A1F", "E+ c #151718", "F+ c #35332F", "G+ c #393634", "H+ c #41403E", "I+ c #3F3E3D", "J+ c #454344", "K+ c #434241", "L+ c #312F2C", "M+ c #02070A", "N+ c #070E12", "O+ c #465A69", ". + ＠ # $ % & & & % * = - ; . ", "> , ' ' ' ' ' ' ' ' ' ' ' ) ! ", "＠ ' ~ ' ' ' ' ' ' ' ' ' { ] ^ . . . ", "/ ' ' ( ' _ : < < ' [ } | 1 2 3 4 5 . 6 ", "* ' ' 7 8 9 < 7 _ 0 ＠ a b c d d e f g h i ", "$ ' ' ' j k l : m $ n o . . . p q r s t i ", "* ' ' ' u v w ' x . y z A B C D d f E F ", "/ ' ' G H 7 I J , K > L M N O P d f Q R ", "S ' T U ' ' ' _ V ' < W X Y . . . d f Z . . . ", "` ...U +.+.+.＠.＠.+.＠.+.#.$.%.d d d f &.*.=.-.. ", ". ;.>.; ,.'.'.'.'.'.,.).!.~.{.%.d d f f ].^./.(.", " . _.:.<.[.}.|.%.d f ].1.2.3.4.", " . 5.6.' ' 7.8.-.%.9.^.0.a.b.c.", " . d.e.f.g.h.i.j.k.l.m.n.o.p.q.", " . r.s.' ' ' ' ' ' t.u.v.w.x.y.", " . z.6.A.B.C.D.+.E.C.U F.G.H.I.", " . J.K.' ' ' ' ' ' ' ' ' L.M.N.", " . O.P.Q.R.S.T.U.V.W.X.Y.Z.`. +", " . .+++＠+#+$+%+&+*+=+-+;+>+,+'+", " . )+!+~+{+]+^+/+(+_+:+<+[+}+|+", " . 1+2+3+' 4+5+6+7+8+9+0+a+b+. ", " . c+d+e+' f+g+h+i+j+k+l+m+n+o+", " . p+q+r+s+t+u+v+w+x+]+y+z+A+B+", " C+D+E+F+G+H+I+J+K+L+M+N+O+. "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/send.xpm Index: send.xpm =================================================================== /* XPM */ static char * stock_mail_send_xpm[] = { "24 24 58 1", " c None", ". c #4F3F0A", "+ c #000000", "＠ c #F4E6B5", "# c #F4E5B3", "$ c #EDD684", "% c #755F10", "& c #EDD580", "* c #EED685", "= c #AF8D18", "- c #EFD98C", "; c #EED88B", "> c #EDD582", ", c #EED889", "' c #EFDA92", ") c #F0DB93", "! c #735D10", "~ c #535353", "{ c #FFFFFF", "] c #F0DC97", "^ c #F6F6F6", "/ c #F5F5F5", "( c #F4F4F4", "_ c #E3E3E3", ": c #EEEEEE", "< c #4F4F4F", "[ c #EDD37C", "} c #EDEDED", "| c #AEAEAE", "1 c #E4E4E4", "2 c #434343", "3 c #FDFDFD", "4 c #F3F3F3", "5 c #E4BF3D", "6 c #CBA41C", "7 c #D1A81C", "8 c #907413", "9 c #7C6411", "0 c #ACACAC", "a c #C8C8C8", "b c #FBFBFB", "c c #A0A0A0", "d c #D4D4D4", "e c #F8F8F8", "f c #F0F0F0", "g c #EFEFEF", "h c #ECECEC", "i c #959595", "j c #3E3E3E", "k c #4D4D4D", "l c #818181", "m c #C6C6C6", "n c #6A6A6A", "o c #636363", "p c #B9B9B9", "q c #737373", "r c #7C7C7C", "s c #BCBCBC", " ", " . ", " +＠+ ", " +#$%+ ", " +#&*=%+ ", " +#-;>==%+ ", " +#,',>===%+ ", " ++++++)$&=!++++++ ", " +~{{{{+]$$=!+^/(_~+ ", " +:<{/(+,[$=!+:}_<|+ ", " +{1234+56789+}_<0a+ ", " +{/1<b+++++++_2cda+ ", " +{b/12efg:}h_<id1a+ ", " +{///1j/:}h_klm11a+ ", " +{b//1n24h_<nmm/1a+ ", " +{//1o{p<f<imqm/1a+ ", " +{b1o{/1d<0m11r11a+ ", " +{1q{////11///1r1a+ ", " +{r{111111111111ra+ ", " +qssssssssssssssso+ ", " ++++++++++++++++++ ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/separator.xpm Index: separator.xpm =================================================================== /* XPM */ static char * sep_xpm[] = { "1 24 2 1", " c None s backgroundToolBarColor", ". c #776758", " ", " ", " ", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", ".", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/sort-ascending.xpm Index: sort-ascending.xpm =================================================================== /* XPM */ static char * stock_sort_ascending_xpm[] = { "23 23 7 1", " c None", ". c #314E6C", "+ c #000000", "＠ c #D1DECF", "# c #7DA377", "$ c #E4ECE3", "% c #B3C9AF", " ", " .... ", " .. .. ", " .. .. ", " ...... ", " .. .. ", " .. .. ", " ", " + ", " ", " + ", " ", " + + ", " +＠+ + ", " +＠##+ ++ ++++++ ", " +###+$+ +++ ", " +##%#+ +++ ", " +%##+ +++ ", " +$###+ +++ ", " +++++++ ++++++ ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/sort-column-ascending.xpm Index: sort-column-ascending.xpm =================================================================== /* XPM */ static char * stock_sort_column_ascending_xpm[] = { "24 24 2 1", " c None", ". c #000000", " ", " ", " ... ", " . .. ", " .. ", " .. ", " .. ", " .. ", " .. ", " ..... . ", " ", " . ", " ", " . ", " .... ", " .. .. ", " .. .. ", " .. .. ", " ..... ", " .. ", " . ... ", " ..... ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/sort-criteria.xpm Index: sort-criteria.xpm =================================================================== /* XPM */ static char * stock_sort_criteria_xpm[] = { "24 24 28 1", " c None", ". c #000000", "+ c #FFFFFF", "＠ c #D3D3D3", "# c #F2ECE1", "$ c #F4EFE5", "% c #DFDAD2", "& c #C9C4BD", "* c #74716E", "= c #FAFAFA", "- c #EADFC9", "; c #ECE2CF", "> c #EEE5D4", ", c #4C4B48", "' c #F5F5F5", ") c #C9C9C9", "! c #E2D2B1", "~ c #CFC4B1", "{ c #BFBFBF", "] c #C0C0C0", "^ c #C7B99C", "/ c #F0F0F0", "( c #B7B7B7", "_ c #9A8F78", ": c #877E69", "< c #AFA389", "[ c #A09889", "} c #314E6C", " ", " ", " ...... ", " ... ", " ... ", " ... ", " ......... ... ", " .+＠.#$%&*. ...... ", " .=＠.-;;;>, ", " .').!!!!.~. ", " .{].^^!.^.~. ", " ./(.._.^.:.~. ", " .....<.:...[. ", " .:.. .. ", " .. ", " ", " }}}} ", " }} }} ", " }} }} ", " }}}}}} ", " }} }} ", " }} }} ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/sort-descending.xpm Index: sort-descending.xpm =================================================================== /* XPM */ static char * stock_sort_descending_xpm[] = { "24 23 7 1", " c None", ". c #000000", "+ c #D1DECF", "＠ c #7DA377", "# c #314E6C", "$ c #E4ECE3", "% c #B3C9AF", " ", " ", " ...... ", " ... ", " ... ", " ... ", " ... ", " ...... ", " . ", " ", " . ", " ", " . . ", " .+. . ", " .+＠＠. .. #### ", " .＠＠＠.$. ## ## ", " .＠＠%＠. ## ## ", " .%＠＠. ###### ", " .$＠＠＠. ## ## ", " ....... ## ## ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/sort-row-ascending.xpm Index: sort-row-ascending.xpm =================================================================== /* XPM */ static char * stock_sort_row_ascending_xpm[] = { "21 17 2 1", " c None", ". c #000000", " ", " ", " ", " ", " ... .... ", " . .. .. .. ", " .. .. .. ", " .. .. .. ", " .. ..... ", " .. .. ", " .. . .. ", " ..... . . . ..... ", " ", " ", " ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/spam.xpm Index: spam.xpm =================================================================== /* XPM */ static char * stock_spam_xpm[] = { "24 24 190 2", " c None", ". c #1D1E1E", "+ c #333839", "＠ c #393F40", "# c #171819", "$ c #B2B8B9", "% c #D5E3E7", "& c #AABABD", "* c #64696A", "= c #0C0D0D", "- c #929C9E", "; c #E7F0F3", "> c #EDF0F1", ", c #E5EDEF", "' c #C5D9DD", ") c #2E3132", "! c #3F4343", "~ c #1F2121", "{ c #DFEBEE", "] c #B7C4C8", "^ c #D2D9DA", "/ c #E1EFF2", "( c #B6CBCF", "_ c #3C4547", ": c #1E2223", "< c #191E1F", "[ c #2D2E2F", "} c #191A1A", "| c #252829", "1 c #7E8E92", "2 c #B7C2C3", "3 c #C3D9DD", "4 c #9CACB0", "5 c #C3CDCE", "6 c #C7E1E7", "7 c #668F97", "8 c #90ACB2", "9 c #CDDDE1", "0 c #485559", "a c #88A6AC", "b c #1F2223", "c c #3F4545", "d c #242728", "e c #313B3E", "f c #A8C2C8", "g c #B2BDC0", "h c #CFE5E9", "i c #C2D9DE", "j c #81989C", "k c #A2C0C5", "l c #85A9B1", "m c #E5ECEE", "n c #E7F2F4", "o c #9BAEB3", "p c #C8E1E7", "q c #3A3E3F", "r c #0C0E0E", "s c #000000", "t c #333737", "u c #B3C2C5", "v c #DDEDF0", "w c #D8E4E6", "x c #DAECEF", "y c #D5E9ED", "z c #D2E7EC", "A c #95ADB2", "B c #DBE2E2", "C c #EDEFF0", "D c #A2B1B3", "E c #8FA4A8", "F c #D7E2E5", "G c #798F94", "H c #151819", "I c #F3B5A7", "J c #865E55", "K c #AFB9BB", "L c #F1F8F9", "M c #F7FBFB", "N c #D9EBEF", "O c #ECF4F6", "P c #F3F7F7", "Q c #E9F2F4", "R c #EEF2F3", "S c #E9EDEE", "T c #C5C8C9", "U c #C2C6C8", "V c #E0E7E7", "W c #DDEAED", "X c #7A9DA5", "Y c #EB8169", "Z c #B83618", "` c #924E3C", " . c #9FA5A6", ".. c #E3EEF0", "+. c #ECF5F7", "＠. c #D6EAED", "#. c #CBE4E9", "$. c #D9E7E9", "%. c #E1EBED", "&. c #B8CBD0", "*. c #BDCBCF", "=. c #ABB3B5", "-. c #E3E5E5", ";. c #DCEBEF", ">. c #6A979F", ",. c #131819", "'. c #B43518", "). c #E76A4D", "!. c #B53F24", "~. c #CB705A", "{. c #C4D8DB", "]. c #D2E6E9", "^. c #CAE3E8", "/. c #A9C8CF", "(. c #7FA4AA", "_. c #82B4BE", ":. c #E2EFF0", "<. c #D3E7EA", "[. c #AFD5DE", "}. c #C7E2E7", "|. c #E7F1F2", "1. c #97C3CB", "2. c #637F86", "3. c #191311", "4. c #EF9985", "5. c #F1A897", "6. c #E76547", "7. c #C58B7D", "8. c #A8ABAC", "9. c #70A1AB", "0. c #88B5BE", "a. c #95C7D1", "b. c #ADD4DC", "c. c #DCEAEF", "d. c #B5D8E0", "e. c #CAE4E9", "f. c #95BEC6", "g. c #6696A0", "h. c #585857", "i. c #51190C", "j. c #D9401D", "k. c #EC8A74", "l. c #E17055", "m. c #DD8D7A", "n. c #D8E7EA", "o. c #D8E9ED", "p. c #D6EAEE", "q. c #D9EBEE", "r. c #E4F0F3", "s. c #CFE3E8", "t. c #5B94A0", "u. c #5C7E85", "v. c #3D221D", "w. c #782310", "x. c #EA7A60", "y. c #E5A293", "z. c #EBD9D5", "A. c #C6D3D6", "B. c #799FA8", "C. c #558C98", "D. c #45686E", "E. c #27201F", "F. c #5D3228", "G. c #B86F5D", "H. c #F1A593", "I. c #E58D78", "J. c #C0C0C1", "K. c #32464B", "L. c #4A6E75", "M. c #282121", "N. c #4A2E27", "O. c #C6968B", "P. c #DDA89B", "Q. c #5F1C0D", "R. c #F2AFA0", "S. c #A36F63", "T. c #341C17", "U. c #301A15", "V. c #674C45", "W. c #E4AEA1", "X. c #8D2A13", "Y. c #030505", "Z. c #A2432E", "`. c #E4A799", " + c #D97C67", ".+ c #B66A59", "++ c #B26C5C", "＠+ c #882812", "#+ c #DB411D", "$+ c #F4BAAC", " ", " ", " ", " ", " . + ＠ ", " # $ % & * . ", " = - ; > , ' ) ! ", " ~ { ] ^ / ( _ : < [ } ", " | 1 2 3 4 5 6 7 8 9 0 a b ", " c d e f g h i j k l m n o p q r ", " s t u v w / x y z A B C D E F G H ", " s s I J K L M N O P Q R S T U V W X < ", "s I Y Z ` ...+.＠.#.$.%.h &.*.=.-.;.>.,.s ", "s '.).Y !.~.{.].^./.(._.:.<.[.}.|.1.2.3.4.s ", "s '.'.'.).5.6.7.8.9.0.a.b.c.d.e.f.g.h.i.j.k.s ", "s '.'.'.'.'.).5.l.m.n.o.p.q.r.s.t.u.v.w.j.x.s ", " s s '.'.'.'.'.).5.6.y.z.A.B.C.D.E.F.G.H.4.s ", " s s '.'.'.'.'.).5.I.J.K.L.M.N.O.P.Q.s ", " s s '.'.'.'.'.R.S.T.U.V.W.X.s s ", " Y.s s Z.'.'.`. +.+++＠+s s ", " s s s '.#+$+s s s ", " s s s s s ", " ", " "}; 1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/toggle-subscription.xpm Index: toggle-subscription.xpm =================================================================== /* XPM */ static char * stock_task_recurring_xpm[] = { "24 24 31 1", " c None", ". c #000000", "+ c #FFFFFF", "＠ c #F4E2BC", "# c #F4D597", "$ c #434343", "% c #F0CC84", "& c #EBB13D", "* c #4B4B4B", "= c #535353", "- c #C8C8C8", "; c #7D7D7D", "> c #7C7C7C", ", c #858585", "' c #5C5C5C", ") c #949494", "! c #F2F2F2", "~ c #B6B6B6", "{ c #BDBDBD", "] c #818181", "^ c #878787", "/ c #B2B2B2", "( c #FDFDFD", "_ c #DBDBDB", ": c #CCCCCC", "< c #ECECEC", "[ c #7F7F99", "} c #333366", "| c #8F8FA9", "1 c #59597F", "2 c #EEEEEE", " ", " . . . . . . . ", " .+.+.+.+.+.+.+. ", " .＠.#.#.#.#.#.#. ", " .$%$&*&*&=&=&$&*. ", " .-*;*>*>*>*>=,'). ", " .!>~>{]{]{]{]{^/. ", " .(_:::::::::::_/. ", " .+<<<<<<<<<<<<</. ", " .+_::[}::}}}}:_/. ", " .+<<|}<<<}}}<<</. ", " .+_:}[:::}}1[:_/. ", " .+<<}<<<<}<|}<</. ", " .+_:}[:}::::}:_/. ", " .+<<|}}}<<<|}<</. ", " .+_::}}}:::}[:_/. ", " .+<<}}}}<<}|<<</. ", " .+_:::::::::::_/. ", " .+<<<<<<<<<<<<</. ", " .2//////////////. ", " ................. ", " ", " ", " "}; 1.2 +34 -34 XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.2.upstream Index: ChangeLog.2.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.2.upstream,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- ChangeLog.2.upstream 2004/09/28 02:21:00 1.1 +++ ChangeLog.2.upstream 2006/03/16 04:17:40 1.2 ＠＠ -50,7 +50,7 ＠＠ * gnus-sum.el (gnus-select-newsgroup): Use cat. * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): New - cat. + cat. * gnus.el (gnus-user-agent): Moved here. ＠＠ -108,7 +108,7 ＠＠ 2003-12-31 Jeremy Maitin-Shepard <jbms(a)attbi.com> * mml.el (mml-generate-mime-1): Use mml-compute-boundary (tiny - change). + change). 2003-12-30 Reiner Steib <Reiner.Steib(a)gmx.de> ＠＠ -391,7 +391,7 ＠＠ * gnus-cus.el (gnus-agent-customize-category): Added missing agent-disable-undownloaded-faces parameter. - + * gnus-start.el (gnus-activate-group): Backed out my 2003-11-29 patch as it was too late at adjusting the active range. (gnus-get-unread-articles-in-group): Added call to new ＠＠ -401,7 +401,7 ＠＠ * message.el (message-get-reply-headers): Narrow to headers. -2003-12-10 Teodor Zlatanov <tzz(a)lifelogs.com> +2003-12-10 Teodor Zlatanov <tzz(a)lifelogs.com> * spam.el (spam-disable-spam-split-during-ham-respool): new variable. From lorentey(a)elte.hu (L,Bu(Brentey K,Ba(Broly) ＠＠ -557,7 +557,7 ＠＠ 2003-11-30 Lars Magne Ingebrigtsen <larsi(a)gnus.org> - * gnus-agent.el (gnus-agent-covered-methods): Remove nil methods. + * gnus-agent.el (gnus-agent-covered-methods): Remove nil methods. 2003-11-29 Kevin Greiner <kgreiner(a)xpediantsolutions.com> * gnus-start.el (gnus-activate-group): The active range of the ＠＠ -813,16 +813,16 ＠＠ nnmail-cache-insert * nnmh.el (nnmh-request-accept-article): pass sender to - nnmail-cache-insert + nnmail-cache-insert * nnmbox.el (nnmbox-request-accept-article): pass sender to - nnmail-cache-insert + nnmail-cache-insert * nnfolder.el (nnfolder-request-accept-article): pass sender to - nnmail-cache-insert + nnmail-cache-insert * nnbabyl.el (nnbabyl-request-accept-article): pass sender to - nnmail-cache-insert + nnmail-cache-insert * nnmail.el (nnmail-cache-insert): accept sender parameter and pass it to the nnmail-spool-hook ＠＠ -887,7 +887,7 ＠＠ * gnus.el (gnus-group-guess-full-name-from-command-method): new function * gnus-registry.el (gnus-registry-fetch-group): use long names if - requested + requested (gnus-registry-split-fancy-with-parent): when long names are in use, strip the name if we're in the native server, or else return nothing (gnus-registry-spool-action, gnus-registry-action): use ＠＠ -990,7 +990,7 ＠＠ 2003-10-27 Romain FRANCOISE <romain(a)orebokech.com> - * gnus-art.el (gnus-article-goto-prev-page): Doc fix. + * gnus-art.el (gnus-article-goto-prev-page): Doc fix. 2003-10-27 Simon Josefsson <jas(a)extundo.com> ＠＠ -1069,7 +1069,7 ＠＠ building with XEmacs so byte-compile it. (dgnushack-make-load): When building with XEmacs do nothing except byte-compile the autoload file and create a dummy gnus-load.el - file. + file. 2003-10-23 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -1128,7 +1128,7 ＠＠ 2003-10-21 Lars Magne Ingebrigtsen <larsi(a)gnus.org> * gnus-picon.el (gnus-picon-transform-address): Protect against - errors. + errors. 2003-10-20 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -1140,12 +1140,12 ＠＠ 2003-10-20 Lars Magne Ingebrigtsen <larsi(a)gnus.org> * spam-report.el (spam-report-url-ping-plain): Include a - User-Agent. + User-Agent. * gnus-msg.el (gnus-extended-version): Use it. * gnus-util.el (gnus-emacs-version): Separated out into own - function. + function. 2003-10-19 Reiner Steib <Reiner.Steib(a)gmx.de> ＠＠ -1181,15 +1181,15 ＠＠ 2003-10-18 Lars Magne Ingebrigtsen <larsi(a)gnus.org> * pop3.el (pop3-read-response): Check whether the process is - alive. + alive. * gnus-sum.el (gnus-summary-refer-article): Strip spaces. * rfc2047.el (rfc2047-encode-region): Do error out on invalid - strings. + strings. * nntp.el (nntp-retrieve-headers-with-xover): Get error messages - right. + right. * gnus-agent.el (gnus-agent-read-servers): Remove sit-for. ＠＠ -1198,14 +1198,14 ＠＠ * message.el (message-field-value): New function. (message-insert-disposition-notification-to): Use Reply-To, too. - * imap.el (imap-mailbox-status): Upcase STATUS commands. + * imap.el (imap-mailbox-status): Upcase STATUS commands. * gnus-sum.el (gnus-remove-odd-characters): New function. (gnus-nov-parse-line): Use it. 2003-10-18 Matt Swift <swift(a)alum.mit.edu> - * mm-decode.el (mm-inline-media-tests): Recognize pjpeg as jpeg. + * mm-decode.el (mm-inline-media-tests): Recognize pjpeg as jpeg. 2003-10-18 Romain FRANCOISE <romain(a)orebokech.com> ＠＠ -1269,14 +1269,14 ＠＠ 2003-10-17 Lars Magne Ingebrigtsen <larsi(a)gnus.org> * gnus-sum.el (gnus-summary-enter-digest-group): ogroup, nor - group. + group. * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the parent name for gcc-self. (gnus-inews-insert-archive-gcc): Paren mistake. * gnus-sum.el (gnus-summary-enter-digest-group): Add - parent-group. + parent-group. * gnus-art.el (gnus-ignored-headers): Add more headers. ＠＠ -1297,7 +1297,7 ＠＠ (mail-source-fetch-imap): Use them. * nndraft.el (nndraft-request-move-article): Fix infinite - recursion. + recursion. * gnus-group.el (gnus-group-mark-regexp): Jump to groups. ＠＠ -1310,7 +1310,7 ＠＠ * message.el (message-inserted-headers): New variable. (message-mode): Make local. - (message-mode): Set all the local action variables to nil. + (message-mode): Set all the local action variables to nil. 2003-10-16 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -1368,7 +1368,7 ＠＠ found (idea from Adrian Lanz <lanz(a)fowi.ethz.ch>) (spam-check-bogofilter-headers, spam-check-blackholes, spam-check-BBDB) (spam-from-listed-p): use nnmail-fetch-field instead of message-fetch-field - + 2003-10-03 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -1439,7 +1439,7 ＠＠ to MML. MIME -> MML -> MIME does not work for PGP/MIME. * message.el (message-bounce, message-forward-show-mml): do. - + 2003-09-13 Jesper Harder <harder(a)ifa.au.dk> * rfc2047.el (rfc2047-charset-encoding-alist): Add viscii. ＠＠ -1760,7 +1760,7 ＠＠ 2003-07-25 Teodor Zlatanov <tzz(a)lifelogs.com> - * spam.el (spam-use-regex-body, spam-regex-body-spam) + * spam.el (spam-use-regex-body, spam-regex-body-spam) (spam-regex-body-ham): new variables, default to nil/empty/empty (spam-install-hooks): added spam-use-regex-body to list or pre-install conditions ＠＠ -1947,7 +1947,7 ＠＠ 2003-06-24 Lars Magne Ingebrigtsen <larsi(a)gnus.org> * gnus-ems.el (gnus-put-image): Mark the right text segment with - gnus-image-category. + gnus-image-category. * gnus-srvr.el (gnus-browse-unsubscribe-group): Strip prefix from native groups. ＠＠ -2916,7 +2916,7 ＠＠ * spam-report.el (spam-report-gmane): gnus-summary-article-number is not necessary, just use the function parameter -2003-04-29 Karl Pflysterer <sigurd(a)12move.de> +2003-04-29 Karl Pfl,Ad(Bsterer <sigurd(a)12move.de> * spam-stat.el (spam-stat-save): No longer font-locks the file when saving ＠＠ -4809,7 +4809,7 ＠＠ 2003-02-20 Jesper Harder <harder(a)ifa.au.dk> * gnus-spec.el (gnus-xmas-format): Use insert instead of - insert-string which is obsolete in Emacs 21.4. + insert-string which is obsolete in Emacs 22.1. * message.el (message-cross-post-followup-to-header): do. ＠＠ -7390,7 +7390,7 ＠＠ instead of mm-auto-save-coding-system for the draft or delayed group. -2002-10-28 Josh <huber(a)alum.wpi.edu> +2002-10-28 Josh Huber <huber(a)alum.wpi.edu> * mml.el (mml-mode-map): Fixed keybindings for mml-secure-* functions. ＠＠ -7658,7 +7658,7 ＠＠ * spam.el: more compilation fixes for BBDB - * spam-stat.el added code from Alex Schroeder <alex(a)gnu.org> + * spam-stat.el: added code from Alex Schroeder <alex(a)gnu.org> (spam-stat-reduce-size): Interactive. (spam-stat-reset): New function. (spam-stat-save): Interactive. ＠＠ -12404,7 +12404,7 ＠＠ 2001-12-05 Katsumi Yamaoka <yamaoka(a)jpl.org> - * mm-view.wl (mm-inline-text): Decode a charset-encoded rich text. + * mm-view.el (mm-inline-text): Decode a charset-encoded rich text. 2001-12-04 08:00:00 ShengHuo ZHU <zsh(a)cs.rochester.edu> ＠＠ -12604,7 +12604,7 ＠＠ * nnfolder.el (nnfolder-read-folder): Use group instead of nnfolder-current-group. - Suggested by Lorentey Karoly <lorentey(a)elte.hu>. + Suggested by K,Ba(Broly L,Bu(Brentey <lorentey(a)elte.hu>. 2001-11-17 Simon Josefsson <jas(a)extundo.com> 1.10 +574 -47 XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.upstream Index: ChangeLog.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.upstream,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- ChangeLog.upstream 2006/01/04 07:05:29 1.9 +++ ChangeLog.upstream 2006/03/16 04:17:41 1.10 ＠＠ -1,9 +1,527 ＠＠ -2006-01-03 Steve Youngs <steve(a)sxemacs.org> +2006-03-15 Andreas Seltenreich <uwi7(a)rz.uni-karlsruhe.de> - * gnus-xmas.el (gnus-xmas-group-startup-message): Typo + * gnus-art.el (gnus-article-only-boring-p): Bind + inhibit-point-motion-hooks to avoid infinite loop when entering + intangible text. Reported by Ralf Wachinger + <rwnewsmampfer(a)geekmail.de>. + +2006-03-14 Simon Josefsson <jas(a)extundo.com> + + * message.el (message-unique-id): Don't use message-number-base36 + if (user-uid) is a float. Reported by Bjorn Solberg + <bjorn_ding1(a)hekneby.org>. + +2006-03-13 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-uu.el (mm-uu-dissect): Dissect all parts correctly. + + * gnus-art.el (gnus-mime-display-single): Make sure there is an + empty line between a part and a message part. + +2006-03-10 Reiner Steib <Reiner.Steib(a)gmx.de> + + * smiley.el: Add more test smileys. + (smiley-data-directory, smiley-regexp-alist) + (gnus-smiley-file-types): Fix doc strings. + (smiley-update-cache): Clear smiley-cached-regexp-alist before + adding new elements. + (smiley-mouse-map): Unused code. Make it a comment. + +2006-03-10 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-nocem.el (gnus-nocem-scan-groups): Add autoload cookie; + scan latest NoCeM messages instead of old ones. + (gnus-nocem-check-article): Fix regexps so as to match to PGP + delimiters that are recently used. + (gnus-nocem-load-cache): Add autoload cookie. + + * gnus.el (gnus-use-nocem): Enable it to be set to also a number. + + * gnus-start.el (gnus-setup-news): Scan NoCeM messages if a group + level which is larger than gnus-use-nocem is specified. + + * gnus-group.el (gnus-group-get-new-news): Ditto. + +2006-03-08 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-util.el (gnus-tool-bar-update): New function. + + * gnus-group.el (gnus-group-update-tool-bar): New variable. + (gnus-group-insert-group-line): Add gnus-tool-bar-update. + + * gnus-topic.el (gnus-topic-prepare-topic): Add gnus-tool-bar-update. + +2006-03-08 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnmail.el (nnmail-split-it): Invert match-partial-words behavior + if optional last element is specified in splits (FIELD VALUE...). + +2006-03-06 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-view.el (mm-w3m-cid-retrieve-1): Check carefully whether + handle is multipart when calling it recursively. + (mm-w3m-cid-retrieve): Display warning if retrieving fails. + +2006-03-03 Reiner Steib <Reiner.Steib(a)gmx.de> + + * mm-util.el (mm-with-unibyte-current-buffer): Change "Emacs 23" + to "Emacs 23 (unicode)" in doc string. + + * gnus-sum.el (gnus-summary-set-display-table): Change "Emacs 23" to + "Emacs 23 (unicode)" in comment. + +2006-03-03 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-decode.el (mm-get-part): Don't use + mm-with-unibyte-current-buffer. + + * gnus-sum.el (gnus-summary-set-display-table): Don't nix out + characters 160 through 255 in Emacs 23. + +2006-03-02 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mml.el (mml-generate-mime-1): Encode parts other than text/* or + message/* containing non-ASCII text properly. + +2006-02-28 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-util.el (mm-with-unibyte-current-buffer): Add note. + +2006-02-28 Andreas Seltenreich <uwi7(a)rz.uni-karlsruhe.de> + + * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M. + +2006-02-28 Reiner Steib <Reiner.Steib(a)gmx.de> + + * nnweb.el (nnweb-type-definition, nnweb-gmane-search): Use new + nov.php. + +2006-02-28 Andreas Seltenreich <uwi7(a)stud.uni-karlsruhe.de> + + * nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping) + (nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web + groups. Kudos to Olly Betts <olly(a)survex.com> for providing NOV + output on the server side. + (nnweb-google-create-mapping): Update regexps and add some + progress indication. + +2006-02-28 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.el (message-user-fqdn): Remove useless * in doc string. + + * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid + unnecessary interaction when sending queued mails. Reported by + TAKAHASHI Yoshio <tkh(a)jp.fujitsu.com>. + +2006-02-28 Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * gnus-int.el (gnus-open-server): Respect gnus-batch-mode. + Merge of 2006-02-20 change from the trunk. + +2006-02-28 Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * dns.el (query-dns): Protect more against buggy tcp output. + Merge of 2006-02-20 change from the trunk. + +2006-02-27 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if + first or last are nil. + +2006-02-24 Simon Josefsson <jas(a)extundo.com> + + * flow-fill.el (fill-flowed): Flow-fill unquoted lines too. + Merge of 2005-10-26 change from the trunk. + +2006-02-23 Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil. + Remove space stuffing, and only do quotes that actually start with + ">" at the beginning of the lines. + Merge of 2005-11-17 and 2004-07-25 from the trunk. + +2006-02-23 Reiner Steib <Reiner.Steib(a)gmx.de> + + * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is + also available in Emacs 21.3. + + * message.el (message-fix-before-sending): Change "Emacs 22" to + "Emacs 23 (unicode)" in comment. + + * qp.el (quoted-printable-encode-region): Change "Emacs 22" to + "Emacs 23 (unicode)" in comment. + + * mm-util.el: Change "Emacs 22" to "Emacs 23 (unicode)" in + comment. + (mm-coding-system-p): Add comment about no-MULE XEmacs. + + * mm-view.el (mm-fill-flowed): Add :version. + +2006-02-23 Ralf Angeli <angeli(a)iwi.uni-sb.de> + + * mm-view.el (mm-fill-flowed): New variable. + (mm-inline-text): Use it. + +2006-02-21 Wolfram Fenske <wolfram.fenske(a)student.uni-magdeburg.de> + (tiny change) + + * nnimap.el (nnimap-request-move-article): Change folder back to + source group before deleting. + +2006-02-20 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * rfc2047.el (rfc2047-charset-to-coding-system): Don't check the + coding system which mm-charset-to-coding-system returns for a + given charset is valid. + +2006-02-16 Juanma Barranquero <lekktu(a)gmail.com> + + * html2text.el (html2text-remove-tag-list): + * spam-stat.el (spam-stat-buffer-words): Fix typo in docstring. + +2006-02-14 Chong Yidong <cyd(a)stupidchicken.com> + + * gnus-cus.el: Revert 2005-10-17 change. + +2006-02-17 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (article-strip-banner): Call + article-really-strip-banner only when the regexp match is made. + +2006-02-16 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (article-strip-banner): Use + gnus-extract-address-components instead of + mail-header-parse-addresses to make it work with non-ASCII text. + + * rfc2231.el (rfc2231-parse-string): Attempt to parse parameter + values which are surrounded with \"...\"; make it never cause a + Lisp error; give up parsing of parameters if it failed in + extracting type. + +2006-02-15 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of + make-temp-file; make it work with Emacs 20 and XEmacs as well. + + * mm-decode.el (mm-display-external): Use the 3rd arg of + mm-make-temp-file. + (mm-create-image-xemacs): Ditto. + +2006-02-14 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-draft.el (gnus-draft-send): Replace message-narrow-to-head + with message-narrow-to-headers. + (gnus-draft-setup): Narrow to header to run message-fetch-field. + (gnus-draft-check-draft-articles): New function. + (gnus-draft-edit-message, gnus-draft-send-message): Use it. + +2006-02-13 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnoo.el (nnoo-declare): Don't generate duplicate entries when + re-loading nn* modules. + +2006-02-10 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.el: Remove bogus comment. + +2006-02-09 Daiki Ueno <ueno(a)unixuser.org> + + * pgg-gpg.el (pgg-gpg-encrypt-region): Don't convert line-endings + in elisp. + (pgg-gpg-encrypt-symmetric-region): Ditto. + (pgg-gpg-sign-region): Ditto. + + * pgg-def.el (pgg-text-mode): New variable. + + * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode. + (mml2015-pgg-encrypt): Ditto. + + * mml1991.el (mml1991-pgg-sign): Enable pgg-text-mode. + (mml1991-pgg-encrypt): Ditto. + +2006-02-08 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnfolder.el (nnfolder-insert-newsgroup-line): Use + message-make-date instead of current-time-string. + + * mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset + to gnus-decoded which mm-uu might set. + +2006-02-08 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * rfc2231.el (rfc2231-parse-string): Sort segmented parameters; + don't decode quoted parameters; remove misimported Emacs code. + Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp>. + (rfc2231-decode-encoded-string): Don't use split-string which + behaves differently according to Emacs version; use + mm-decode-coding-region to convert charset to coding-system. + Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp>. + (rfc2231-encode-string): Remove misimported Emacs code. + +2006-02-07 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (article-decode-charset): Don't use ignore-errors + when calling mail-header-parse-content-type. + (article-de-quoted-unreadable): Ditto. + (article-de-base64-unreadable): Ditto. + (article-wash-html): Ditto. + + * mm-decode.el (mm-dissect-buffer): Don't use ignore-errors when + calling mail-header-parse-content-type and + mail-header-parse-content-disposition. + (mm-find-raw-part-by-type): Don't use ignore-errors when calling + mail-header-parse-content-type. + + * mml.el (mml-insert-mime-headers): Use mml-insert-parameter to + insert charset and format parameters; encode description after + inserting it to buffer. + (mml-insert-parameter): Fold lines properly even if a parameter is + segmented into two or more lines; change the max column to 76. + + * rfc1843.el (rfc1843-decode-article-body): Don't use + ignore-errors when calling mail-header-parse-content-type. + + * rfc2231.el (rfc2231-parse-string): Return at least type if + possible; don't cause an error even if it fails in parsing of + parameters. Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp>. + (rfc2231-encode-string): Don't break lines at the beginning, leave + it to mml-insert-parameter. + + * webmail.el (webmail-yahoo-article): Don't use ignore-errors when + calling mail-header-parse-content-type. + +2006-02-06 Reiner Steib <Reiner.Steib(a)gmx.de> + + * spam-report.el (spam-report-gmane-use-article-number): Improve + doc string. + (spam-report-gmane-internal): Check if a suitable header was found + in the article. + +2006-02-04 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * rfc2231.el (rfc2231-parse-string): Revert 2006-02-03 change. + (rfc2231-encode-string): Make param*=value always begin with LWSP. + +2006-02-05 Romain Francoise <romain(a)orebokech.com> + + Update copyright notices of all files in the gnus directory. + +2006-02-03 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-util.el (gnus-error): Describe `args'. + +2006-02-03 Andreas Seltenreich <uwi7(a)stud.uni-karlsruhe.de> + + * nnweb.el (nnweb-request-group): Avoid growing overview files. + +2006-02-03 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * rfc2231.el (rfc2231-parse-string): Add missing semicolons to + segmented lines of parameter value to cope with Thunderbird 1.5 + bug (cf. https://bugzilla.mozilla.org/show_bug.cgi?id=323318). + Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp>. + (rfc2231-encode-string): Don't make lines exceeding 76 column. + +2006-02-01 Max Froumentin <max(a)lapin-bleu.net> (tiny change) + + * mml.el (mml-generate-mime-1): Correct the order of inline signed + parts. + +2006-01-31 Andreas Seltenreich <uwi7(a)stud.uni-karlsruhe.de> + + * nnweb.el (nnweb-group-alist): Use defvar instead of defvoo, + there's only one active file for all servers. + (nnweb-request-scan): Make sure nnweb-articles is initialized on + solid groups. Gnus might have used a FAST request to select the + group. + (nnweb-request-group, nnweb-google-parse-1): Don't keep nnweb-type + and nnweb-search redundantly in the active file. + (nnweb-request-list): Don't list bogus groups. There can only be + one. + (nnweb-request-create-group): Don't use ARGS. + (nnweb-possibly-change-server, nnweb-request-group): Remove some + initialisations. Let nnoo do the work. + +2006-01-31 Romain Francoise <romain(a)orebokech.com> + + * message.el (message-alternative-emails): Improve docstring. + (message-setup-1): Call `message-use-alternative-email-as-from' + after `message-setup-hook' to give it precedence over posting + styles, etc. + (message-use-alternative-email-as-from): Add docstring. Remove + the original From header if present. + +2006-01-31 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-uu.el (mm-uu-emacs-sources-extract): Say the part has been + decoded. + (mm-uu-diff-extract): Ditto. + +2006-01-31 Kevin Ryde <user42(a)zip.com.au> + + * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into + mailcap-viewer-test-cache when there's no 'test clause, since that + will invert the meaning of a "nil" test previously determined by + mailcap-mailcap-entry-passes-test. + +2006-01-30 Reiner Steib <Reiner.Steib(a)gmx.de> + + * nnweb.el (nnweb-google-parse-1): Clarify some comments. + +2006-01-30 Andreas Seltenreich <uwi7(a)stud.uni-karlsruhe.de> + + * nnweb.el (nnweb-type-definition, nnweb-google-parse-1) + (nnweb-google-create-mapping, nnweb-google-search): Adapt to + current Google Groups. + +2006-01-26 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * Makefile.in (clean): New rule. + (distclean): Use it. + +2006-01-25 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part + is dissected into a single part of which the type is the same as + the given one; decode charset. + +2006-01-21 Kevin Ryde <user42(a)zip.com.au> + + * mailcap.el (mailcap-parse-mailcap-extras): "test" key must go + into alists as symbol not string, since that's what + mailcap-viewer-passes-test and mailcap-mailcap-entry-passes-test + look for. + +2006-01-24 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-uu.el (mm-uu-dissect-text-parts): Reduce the number of + recursive calls. + +2006-01-24 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-view.el (mm-w3m-standalone-supports-m17n-p): New variable. + (mm-w3m-standalone-supports-m17n-p): New function. + (mm-inline-text-html-render-with-w3m-standalone): Use it to alter + w3m usage. + + * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use + mm-w3m-standalone-supports-m17n-p to alter w3m usage. + +2006-01-23 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-uu.el (mm-uu-dissect-text-parts): Decode content transfer + encoding. + +2006-01-20 Reiner Steib <Reiner.Steib(a)gmx.de> + + * mml.el (mml-attach-file): Describe `description' in doc string. + (mml-menu): Add Emacs MIME manual and PGG manual. + +2006-01-19 Reiner Steib <Reiner.Steib(a)gmx.de> + + * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) + (spam-group-spam-marks, spam-list-articles, spam-group-ham-marks): + Revert 2006-01-08 change because the functions will be used in No + Gnus. + +2006-01-19 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-bodies.el (mm-decode-body): Don't decode decoded body. + + * mm-uu.el (mm-uu-dissect-text-parts): Dissect dissected parts. + +2006-01-17 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-decode.el (mm-inlined-types): Add application/pgp. + (mm-automatic-display): Ditto. + + * mm-uu.el (mm-uu-dissect-text-parts): Recognize application/pgp + part as text. + +2006-01-16 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnrss.el: Update copyright. + (nnrss-opml-import): Query whether to subscribe to each entry. + + * gnus-art.el: + * gnus-cus.el: + * gnus-group.el: + * gnus-start.el: + * gnus-sum.el: + * gnus-xmas.el: + * messagexmas.el: + * mm-uu.el: + * mm-view.el: Update copyright. + +2006-01-16 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.el (message-info): New function. + (message-mode-menu): Add it. + Update copyright. + + * ChangeLog: Fix and update copyright. + +2006-01-16 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-uu.el (mm-uu-text-plain-type): New variable. + (mm-uu-pgp-signed-extract-1): Use it. + (mm-uu-pgp-encrypted-extract-1): Use it. + (mm-uu-dissect): Use it; allow two optional arguments; one is a + flag specifying whether there's no message header; the other is + for a MIME type and parameters; bind mm-uu-text-plain-type with + the later one. + (mm-uu-dissect-text-parts): New function. + + * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to + dissect text parts. + +2006-01-13 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (article-wash-html): Use + gnus-summary-show-article-charset-alist if a numeric arg is given. + (gnus-article-wash-html-with-w3m-standalone): New function. + + * mm-view.el (mm-text-html-renderer-alist): Map w3m-standalone to + mm-inline-text-html-render-with-w3m-standalone. + (mm-text-html-washer-alist): Map w3m-standalone to + gnus-article-wash-html-with-w3m-standalone. + (mm-inline-text-html-render-with-w3m-standalone): New function. + +2006-01-10 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable. + (nnrss-request-article): Render text/plain parts as HTML. + + * gnus-art.el (gnus-article-wash-html-with-w3m): No need to narrow + the buffer. + +2006-01-08 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-cus.el (gnus-group-parameters): Sync posting-style with + custom definition of `gnus-posting-styles'. + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind + print-circle. Suggested by Kalle Olavi Niemitalo <kon(a)iki.fi>. + +2006-01-05 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-group.el (gnus-useful-groups): Use Gmane for ding. + Use nntp for bug archive. + +2006-01-05 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnrss.el (nnrss-request-article): Fix the way to fill text/plain + parts. + (nnrss-normalize-date): New function converts ISO 8601 date into + RFC822 style. Suggested by Mark Plaksin <happy(a)mcplaksin.org>. + (nnrss-check-group): Use it. + +2006-01-03 Rodrigo Ventura <yoda(a)isr.ist.utl.pt> (tiny change) + + * gnus-xmas.el (gnus-xmas-group-startup-message): Typo gnus-splash-face -> gnus-splash. Fixes starting from a TTY in - XEmacs. - From Rodrigo Ventura <yoda(a)isr.ist.utl.pt> + XEmacs. 2006-01-01 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -34,7 +552,7 ＠＠ * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons associated with multipart/alternative parts. -2005-12-19 Mark Plaksin <happy(a)mcplaksin.org> (tiny change) +2005-12-19 Mark Plaksin <happy(a)mcplaksin.org> (tiny change) * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the article. ＠＠ -44,6 +562,13 ＠＠ * dns.el (query-dns): Make sure we check the buffer size before removing tcp headers. +2006-01-08 Chong Yidong <cyd(a)stupidchicken.com> + + * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) + (spam-group-spam-marks): Delete functions. + (spam-list-articles): Just call spam-group-ham-marks directly. + (spam-group-ham-marks): Simplify. + 2005-12-16 Katsumi Yamaoka <yamaoka(a)jpl.org> * gnus-art.el (gnus-signature-separator): Fix custom type. ＠＠ -99,8 +624,12 ＠＠ string. 2005-12-09 ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp> (tiny change) + + * mm-decode.el (mm-display-external): Add missing cdr. + +2005-12-12 Richard M. Stallman <rms(a)gnu.org> - * mm-decode.el (mm-display-external): Add lacked cdr. + * mm-url.el (mm-url-load-url): Require url-parse and url-vars. 2005-12-08 Reiner Steib <Reiner.Steib(a)gmx.de> ＠＠ -166,7 +695,7 ＠＠ * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid date header. -2005-11-16 Boris Samorodov <bsam(a)ipt.ru> (tiny patch) +2005-11-16 Boris Samorodov <bsam(a)ipt.ru> (tiny patch) * imap.el (imap-kerberos4-open): Ignore SSL stuff. ＠＠ -207,7 +736,7 ＠＠ error. (nntp-retrieve-data): Rethrow new error condition to break out of recursive call to nntp-send-authinfo. - + 2005-11-13 Katsumi Yamaoka <yamaoka(a)jpl.org> * gnus-start.el (gnus-dribble-read-file): Use make-local-variable ＠＠ -284,7 +813,7 ＠＠ (pgg-decrypt): Convey provided passphrase in subordinate call to pgg-decrypt-region. -2005-10-20 Ken Manheimer <ken.manheimer+emacs(a)gmail.com> +2005-10-20 Ken Manheimer <ken.manheimer+emacs(a)gmail.com> * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region) (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region) ＠＠ -371,8 +900,8 ＠＠ (message-insert-courtesy-copy, message-fill-address) (message-fill-header, message-shorten-references) (message-setup-1, message-cancel-news) - (message-forward-make-body-plain) (message-forward-make-body-mime) - (message-forward-make-body-mml) (message-encode-message-body) + (message-forward-make-body-plain, message-forward-make-body-mime) + (message-forward-make-body-mml, message-encode-message-body) (message-forward-make-body-digest-plain) (message-forward-make-body-digest-mime) (message-use-alternative-email-as-from): Insert `hard-newline' ＠＠ -404,7 +933,7 ＠＠ whitespace removed in revision 7.8. Use concatenated string to protect trailing whitespace. -2005-10-27 Jouni K Seppanen <jks(a)iki.fi> (tiny change) +2005-10-27 Jouni K Seppanen <jks(a)iki.fi> (tiny change) * nnimap.el (nnimap-search-uids-not-since-is-evil): Add variable. (nnimap-request-expire-articles): Use it to avoid sending 'UID ＠＠ -489,11 +1018,11 ＠＠ * message.el (message-expand-group): Pass the common prefix substring of completion to `display-completion-list'. -2005-10-09 Daniel Brockman <daniel(a)brockman.se> +2005-10-09 Daniel Brockman <daniel(a)brockman.se> * format-spec.el (format-spec): Propagate text properties of % spec. -2005-01-21 Derek Atkins <warlord(a)MIT.EDU> (tiny change) +2005-01-21 Derek Atkins <warlord(a)MIT.EDU> (tiny change) * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache. ＠＠ -502,10 +1031,9 ＠＠ * pgg-parse.el (top-level): Don't require custom, it is autoloaded. (To sync with No Gnus.) -2005-05-09 Simon Josefsson <jas(a)extundo.com> +2005-05-09 Georg C. F. Greve <greve(a)gnu.org> (tiny change) - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching, - tiny patch from "Georg C. F. Greve" <greve(a)gnu.org>. + * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching. 2005-10-08 Simon Josefsson <jas(a)extundo.com> ＠＠ -964,7 +1492,7 ＠＠ * gnus-topic.el (gnus-topic-mode): Ditto. -2005-07-08 Ralf Angeli <angeli(a)iwi.uni-sb.de> (tiny change) +2005-07-08 Ralf Angeli <angeli(a)iwi.uni-sb.de> * gnus-art.el (gnus-article-next-page, gnus-article-next-page-1) (gnus-article-prev-page): Take scroll-margin into consideration. ＠＠ -1810,11 +2338,11 ＠＠ * nnimap.el (nnimap-retrieve-headers-from-server): Fix last change. -2005-03-10 Arne J,Ax(Brgensen <arne(a)arnested.dk> (tiny change) +2005-03-10 Arne J,Ax(Brgensen <arne(a)arnested.dk> (tiny change) * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one flaw. -2005-03-08 Bjorn Solberg <bjorn_ding(a)hekneby.org> (tiny change) +2005-03-08 Bjorn Solberg <bjorn_ding(a)hekneby.org> (tiny change) * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV buffer (since IMAP server might return FETCH response out of ＠＠ -2270,11 +2798,13 ＠＠ * deuglify.el (gnus-outlook-deuglify): Add :version. - * html2text.el: Beautify code. Improve doc strings. Some checkdoc - cleanup. + * html2text.el: Beautify code. Improve doc strings. Some + checkdoc cleanup. (html2text-get-attr, html2text-fix-paragraph): Simplify code. - (html2text-format-tag-list): Add "strong" and "em". - From "Alfred M. Szmidt" <ams(a)kemisten.nu> (tiny change). + +2004-11-01 Alfred M. Szmidt <ams(a)kemisten.nu> (tiny change) + + * html2text.el (html2text-format-tag-list): Add "strong" and "em". 2004-10-29 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -2390,7 +2920,7 ＠＠ * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt): - New function. Used internally to only display 'gnus converting + New function. Used internally to only display 'gnus converting files' message when actually necessary. * gnus-sum.el: Remove (require 'gnus-agent) as required ＠＠ -2407,7 +2937,7 ＠＠ (gnus-agent-unfetch-articles): New function. (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate article numbers even when local .overview file is missing. - (gnus-agent-read-article-number): New function. Only accepts + (gnus-agent-read-article-number): New function. Only accepts 27-bit article numbers. (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use gnus-agent-read-article-number. ＠＠ -2503,12 +3033,12 ＠＠ * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to error. -2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion message to newsrc-dribble when an actual conversion is performed. -2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> * gnus-agent.el (gnus-agent-read-local): Bind nnheader-file-coding-system to gnus-agent-file-coding-system to ＠＠ -2517,9 +3047,9 ＠＠ coding-system-for-write, as the with-temp-file macro first prints to a buffer then saves the buffer. -2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> +2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> - * legacy-gnus-agent.el (): New. Provides converters that are only + * legacy-gnus-agent.el (): New. Provides converters that are only loaded when gnus-convert-old-newsrc needs to call them. * gnus-agent.el (gnus-agent-read-agentview): Remove support for ＠＠ -2537,7 +3067,7 ＠＠ should be protected from potentially irreversable changes by the function. -2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> +2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> * gnus-int.el (gnus-request-accept-article): Inform the agent that articles are being added to a group. ＠＠ -2550,7 +3080,7 ＠＠ (gnus-agent-regenerate-group): The REREAD parameter can now be a list of articles that will be marked as unread. -2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> * gnus-range.el (gnus-sorted-range-intersection): Now accepts single-interval range of the form (min . max). Previously the ＠＠ -2562,18 +3092,18 ＠＠ * gnus-sum.el (gnus-summary-highlight-line): Articles stored in the cache, but not the agent, now appear with their usual face. -2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of marks consisting of a single range {for example, (3 . 5)} rather than a list of a single range { ((3 . 5)) }. -2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the uncompressed list. -2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> * gnus-draft.el (gnus-group-send-queue): Pass the group name "nndraft:queue" along to gnus-draft-send. ＠＠ -3152,21 +3682,18 ＠＠ * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache): Add :group 'nnimap. -2004-08-30 Simon Josefsson <jas(a)extundo.com> +2004-08-30 Andreas Schwab <schwab(a)suse.de> * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for - ?* and ?\; (tiny patch). From Andreas Schwab <schwab(a)suse.de>. + ?* and ?\;. -2004-08-30 Simon Josefsson <jas(a)extundo.com> - - * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; - and ?\' to symbol instead of whitespace (tiny patch). - From Andreas Schwab <schwab(a)suse.de>. +2004-08-30 Andreas Schwab <schwab(a)suse.de> -2004-08-30 Simon Josefsson <jas(a)extundo.com> + * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for + ?* and ?\;. - * message.el, gnus-art.el: Sync IDNA fixes against HEAD, include - entries until 2004-08-30 below. + * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; + and ?\' to symbol instead of whitespace. 2004-06-23 Jesper Harder <harder(a)ifa.au.dk> ＠＠ -3369,7 +3896,7 ＠＠ * gnus-msg.el (gnus-summary-followup-with-original): Document yanking of region when active. -2004-04-13 Kevin Greiner <kgreiner(a)xpediantsolutions.com> +2004-04-13 Kevin Greiner <kgreiner(a)xpediantsolutions.com> * gnus-agent.el: Merged 7.3 through 7.7 updates into branch. Revision 7.2 changes excluded to maintain compatibility with all ＠＠ -3380,7 +3907,7 ＠＠ See ChangeLog.2 for earlier changes. - Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. + Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted provided the copyright notice and this notice are preserved. 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/binhex.el Index: binhex.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/binhex.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- binhex.el 2005/11/15 03:45:41 1.4 +++ binhex.el 2006/03/16 04:17:41 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; binhex.el --- elisp native binhex decode ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: binhex news 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/canlock.el Index: canlock.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/canlock.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- canlock.el 2005/11/15 03:45:42 1.5 +++ canlock.el 2006/03/16 04:17:42 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; canlock.el --- functions for Cancel-Lock feature ;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Katsumi Yamaoka <yamaoka(a)jpl.org> ;; Keywords: news, cancel-lock, hmac, sha1, rfc2104 1.4 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/compface.el Index: compface.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/compface.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- compface.el 2005/11/15 03:45:42 1.3 +++ compface.el 2006/03/16 04:17:42 1.4 ＠＠ -1,6 +1,6 ＠＠ ;;; compface.el --- functions for converting X-Face headers -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/deuglify.el Index: deuglify.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/deuglify.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- deuglify.el 2005/11/15 03:45:42 1.5 +++ deuglify.el 2006/03/16 04:17:42 1.6 ＠＠ -1,6 +1,6 ＠＠ ;;; deuglify.el --- deuglify broken Outlook (Express) articles -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2002 Raymond Scholz ;; Author: Raymond Scholz <rscholz(a)zonix.de> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/earcon.el Index: earcon.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/earcon.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- earcon.el 2005/11/15 03:45:42 1.4 +++ earcon.el 2006/03/16 04:17:42 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; earcon.el --- Sound effects for messages ;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Steven L. Baur <steve(a)miranova.com> 1.7 +8 -2 XEmacs/packages/xemacs-packages/gnus/lisp/flow-fill.el Index: flow-fill.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/flow-fill.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- flow-fill.el 2005/11/15 03:45:42 1.6 +++ flow-fill.el 2006/03/16 04:17:42 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; flow-fill.el --- interpret RFC2646 "flowed" text ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas(a)pdc.kth.se> ;; Keywords: mail ＠＠ -113,6 +113,11 ＠＠ RFC 2646 suggests 66 characters for read (save-excursion (set-buffer (or (current-buffer) buffer)) (goto-char (point-min)) + ;; Remove space stuffing. + (while (re-search-forward "^ " nil t) + (delete-char -1) + (forward-line 1)) + (goto-char (point-min)) (while (re-search-forward " $" nil t) (when (save-excursion (beginning-of-line) ＠＠ -146,7 +151,8 ＠＠ RFC 2646 suggests 66 characters for read (condition-case nil (let ((fill-prefix (when quote (concat quote " "))) (fill-column (eval fill-flowed-display-column)) - filladapt-mode) + filladapt-mode + adaptive-fill-mode) (fill-region (fill-flowed-point-at-bol) (min (1+ (fill-flowed-point-at-eol)) (point-max)) 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/format-spec.el Index: format-spec.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/format-spec.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- format-spec.el 2005/11/15 03:45:43 1.4 +++ format-spec.el 2006/03/16 04:17:43 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; format-spec.el --- functions for formatting arbitrary formatting strings ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: tools 1.10 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-agent.el Index: gnus-agent.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-agent.el,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- gnus-agent.el 2005/12/19 13:35:24 1.9 +++ gnus-agent.el 2006/03/16 04:17:43 1.10 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-agent.el --- unplugged support for Gnus ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. 1.10 +127 -94 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-art.el Index: gnus-art.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-art.el,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- gnus-art.el 2006/01/04 07:05:29 1.9 +++ gnus-art.el 2006/03/16 04:17:43 1.10 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-art.el --- article mode commands for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -2267,38 +2267,37 ＠＠ If PROMPT (the prefix), prompt for a cod (error)) gnus-newsgroup-ignored-charsets)) ct cte ctl charset format) - (save-excursion - (save-restriction - (article-narrow-to-head) - (setq ct (message-fetch-field "Content-Type" t) - cte (message-fetch-field "Content-Transfer-Encoding" t) - ctl (and ct (ignore-errors - (mail-header-parse-content-type ct))) - charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ctl - (mail-content-type-get ctl 'charset))) - format (and ctl (mail-content-type-get ctl 'format))) - (when cte - (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max))) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (point-max)) - (when (and (eq mail-parse-charset 'gnus-decoded) - (eq (mm-body-7-or-8) '8bit)) - ;; The text code could have been decoded. - (setq charset mail-parse-charset)) - (when (and (or (not ctl) - (equal (car ctl) "text/plain")) - (not format)) ;; article with format will decode later. - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) + (save-excursion + (save-restriction + (article-narrow-to-head) + (setq ct (message-fetch-field "Content-Type" t) + cte (message-fetch-field "Content-Transfer-Encoding" t) + ctl (and ct (mail-header-parse-content-type ct)) + charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset))) + format (and ctl (mail-content-type-get ctl 'format))) + (when cte + (setq cte (mail-header-strip cte))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max))) + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (when (and (eq mail-parse-charset 'gnus-decoded) + (eq (mm-body-7-or-8) '8bit)) + ;; The text code could have been decoded. + (setq charset mail-parse-charset)) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not format)) ;; article with format will decode later. + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." ＠＠ -2390,9 +2389,7 ＠＠ If READ-CHARSET, ask for a coding system (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) ＠＠ -2420,9 +2417,7 ＠＠ If READ-CHARSET, ask for a coding system (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) ＠＠ -2467,25 +2462,34 ＠＠ If READ-CHARSET, ask for a coding system (defun article-wash-html (&optional read-charset) "Format an HTML article. -If READ-CHARSET, ask for a coding system." +If READ-CHARSET, ask for a coding system. If it is a number, the +charset defined in `gnus-summary-show-article-charset-alist' is used." (interactive "P") (save-excursion (let ((inhibit-read-only t) charset) - (when (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (when (stringp charset) - (setq charset (intern (downcase charset))))))) - (when read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) - (unless charset - (setq charset gnus-newsgroup-charset)) + (if read-charset + (if (or (and (numberp read-charset) + (setq charset + (cdr + (assq read-charset + gnus-summary-show-article-charset-alist)))) + (setq charset (mm-read-coding-system "Charset: "))) + (let ((gnus-summary-show-article-charset-alist + (list (cons 1 charset)))) + (with-current-buffer gnus-summary-buffer + (gnus-summary-show-article 1))) + (error "No charset is given")) + (when (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (let* ((ct (gnus-fetch-field "content-type")) + (ctl (and ct (mail-header-parse-content-type ct)))) + (setq charset (and ctl + (mail-content-type-get ctl 'charset))) + (when (stringp charset) + (setq charset (intern (downcase charset))))))) + (unless charset + (setq charset gnus-newsgroup-charset))) (article-goto-body) (save-window-excursion (save-restriction ＠＠ -2514,19 +2518,34 ＠＠ If READ-CHARSET, ask for a coding system (defun gnus-article-wash-html-with-w3m () "Wash the current buffer with emacs-w3m." (mm-setup-w3m) - (save-restriction - (narrow-to-region (point) (point-max)) - (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) - w3m-force-redisplay) - (w3m-region (point-min) (point-max))) - (when (and mm-inline-text-html-with-w3m-keymap - (boundp 'w3m-minor-mode-map) - w3m-minor-mode-map) - (add-text-properties - (point-min) (point-max) - (list 'keymap w3m-minor-mode-map - ;; Put the mark meaning this part was rendered by emacs-w3m. - 'mm-inline-text-html-with-w3m t))))) + (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) + w3m-force-redisplay) + (w3m-region (point-min) (point-max))) + (when (and mm-inline-text-html-with-w3m-keymap + (boundp 'w3m-minor-mode-map) + w3m-minor-mode-map) + (add-text-properties + (point-min) (point-max) + (list 'keymap w3m-minor-mode-map + ;; Put the mark meaning this part was rendered by emacs-w3m. + 'mm-inline-text-html-with-w3m t)))) + +(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'. + +(defun gnus-article-wash-html-with-w3m-standalone () + "Wash the current buffer with w3m." + (if (mm-w3m-standalone-supports-m17n-p) + (progn + (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'. + ;; The default. + (setq charset 'iso-8859-1)) + (let ((coding-system-for-write charset) + (coding-system-for-read charset)) + (call-process-region + (point-min) (point-max) + "w3m" t t nil "-dump" "-T" "text/html" + "-I" (symbol-name charset) "-O" (symbol-name charset)))) + (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html"))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. ＠＠ -2589,18 +2608,22 ＠＠ always hide." (article-really-strip-banner (gnus-parameter-banner gnus-newsgroup-name))) (when gnus-article-address-banner-alist - (article-really-strip-banner - (let ((from (save-restriction - (widen) - (article-narrow-to-head) - (mail-fetch-field "from")))) - (when (and from - (setq from - (caar (mail-header-parse-addresses from)))) - (catch 'found - (dolist (pair gnus-article-address-banner-alist) - (when (string-match (car pair) from) - (throw 'found (cdr pair))))))))))))) + ;; Note that the From header is decoded here, so it is + ;; required that the *-extract-address-components function + ;; supports non-ASCII text. + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (cadr (funcall gnus-extract-address-components + from)))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found + (article-really-strip-banner (cdr pair))))))))))))) (defun article-really-strip-banner (banner) "Strip the banner specified by the argument." ＠＠ -4720,11 +4743,15 ＠＠ N is the numerical prefix." ;; We have to do this since selecting the window ;; may change the point. So we set the window point. (set-window-point window point))) - (let* ((handles (or ihandles - (mm-dissect-buffer nil gnus-article-loose-mime) - (and gnus-article-emulate-mime - (mm-uu-dissect)))) - (inhibit-read-only t) handle name type b e display) + (let ((handles ihandles) + (inhibit-read-only t) + handle) + (cond (handles) + ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime)) + (when gnus-article-emulate-mime + (mm-uu-dissect-text-parts handles))) + (gnus-article-emulate-mime + (setq handles (mm-uu-dissect)))) (when (and (not ihandles) (not gnus-displaying-mime)) ;; Top-level call; we clean up. ＠＠ -4862,13 +4889,18 ＠＠ If displaying \"text/html\" is discourag (let ((id (1+ (length gnus-article-mime-handle-alist))) beg) (push (cons id handle) gnus-article-mime-handle-alist) + (when (and display + (equal (mm-handle-media-supertype handle) "message")) + (insert-char + ?\n + (cond ((not (bolp)) 2) + ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0) + (t 1)))) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) - ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) (gnus-article-insert-newline) - ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) ＠＠ -5286,14 +5318,15 ＠＠ not have a face in `gnus-article-boring- (boundp 'gnus-article-boring-faces) (symbol-value 'gnus-article-boring-faces)) (save-excursion - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (gnus-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) - (throw 'only-boring nil))) - (throw 'only-boring t))))) + (let ((inhibit-point-motion-hooks t)) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces))) + (throw 'only-boring nil))) + (throw 'only-boring t)))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-async.el Index: gnus-async.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-async.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-async.el 2005/11/15 03:45:43 1.5 +++ gnus-async.el 2006/03/16 04:17:44 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-async.el --- asynchronous support for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-audio.el Index: gnus-audio.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-audio.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-audio.el 2005/11/15 03:45:43 1.4 +++ gnus-audio.el 2006/03/16 04:17:44 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-audio.el --- Sound effects for Gnus ;; Copyright (C) 1996, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Steven L. Baur <steve(a)miranova.com> ;; Keywords: news, mail, multimedia 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-bcklg.el Index: gnus-bcklg.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-bcklg.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-bcklg.el 2005/11/15 03:45:44 1.4 +++ gnus-bcklg.el 2006/03/16 04:17:44 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-bcklg.el --- backlog functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cache.el Index: gnus-cache.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cache.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- gnus-cache.el 2005/12/19 13:35:24 1.7 +++ gnus-cache.el 2006/03/16 04:17:44 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-cache.el --- cache interface for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cite.el Index: gnus-cite.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cite.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-cite.el 2005/11/15 03:45:44 1.6 +++ gnus-cite.el 2006/03/16 04:17:44 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-cite.el --- parse citations in articles for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Per Abhiddenware 1.8 +9 -14 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cus.el Index: gnus-cus.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cus.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- gnus-cus.el 2005/11/15 03:45:44 1.7 +++ gnus-cus.el 2006/03/16 04:17:45 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-cus.el --- customization commands for Gnus ;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <abraham(a)dina.kvl.dk> ;; Keywords: news ＠＠ -36,14 +36,6 ＠＠ ;;; Widgets: -(defvar gnus-custom-map - (let ((map (make-keymap))) - (set-keymap-parent map widget-keymap) - (suppress-keymap map) - (define-key map [mouse-1] 'widget-move-and-invoke) - map) - "Keymap for editing Gnus customization buffers.") - (defun gnus-custom-mode () "Major mode for editing Gnus customization buffers. ＠＠ -59,7 +51,7 ＠＠ if that value is non-nil." (kill-all-local-variables) (setq major-mode 'gnus-custom-mode mode-name "Gnus Customize") - (use-local-map gnus-custom-map) + (use-local-map widget-keymap) ;; Emacs 21 stuff: (when (and (facep 'custom-button-face) (facep 'custom-button-pressed-face)) ＠＠ -235,8 +227,11 ＠＠ See `gnus-emphasis-alist'.") (const signature-file) (const organization) (const address) + (const x-face-file) (const name) - (const body)) + (const body) + (symbol) + (string :tag "Header")) (string :format "%v")))) "post style. See `gnus-posting-styles'.")) ＠＠ -487,7 +482,7 ＠＠ form, but who cares?" (widget-create 'sexp :tag "Method" :value (gnus-info-method info)))) - (use-local-map gnus-custom-map) + (use-local-map widget-keymap) (widget-setup) (buffer-enable-undo) (goto-char (point-min)))) ＠＠ -881,7 +876,7 ＠＠ articles in the thread. '(repeat :inline t :tag "Unknown entries" sexp))) - (use-local-map gnus-custom-map) + (use-local-map widget-keymap) (widget-setup))) (defun gnus-score-customize-done (&rest ignore) ＠＠ -1058,7 +1053,7 ＠＠ articles in the thread. (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces) - (use-local-map gnus-custom-map) + (use-local-map widget-keymap) (widget-setup) (buffer-enable-undo)))) 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-delay.el Index: gnus-delay.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-delay.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-delay.el 2005/12/19 13:35:24 1.5 +++ gnus-delay.el 2006/03/16 04:17:45 1.6 ＠＠ -1,6 +1,6 ＠＠ ;;; gnus-delay.el --- Delayed posting of articles -;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Kai Großjohann <Kai.Grossjohann(a)CS.Uni-Dortmund.DE> ;; Keywords: mail, news, extensions 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-demon.el Index: gnus-demon.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-demon.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-demon.el 2005/11/15 03:45:44 1.4 +++ gnus-demon.el 2006/03/16 04:17:45 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-demon.el --- daemonic Gnus behaviour ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-diary.el Index: gnus-diary.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-diary.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-diary.el 2005/11/15 03:45:45 1.4 +++ gnus-diary.el 2006/03/16 04:17:45 1.5 ＠＠ -1,6 +1,6 ＠＠ ;;; gnus-diary.el --- Wrapper around the NNDiary Gnus backend -;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1999, 2000, 2001 Didier Verna. ;; Author: Didier Verna <didier(a)xemacs.org> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-dired.el Index: gnus-dired.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-dired.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-dired.el 2005/11/15 03:45:45 1.4 +++ gnus-dired.el 2006/03/16 04:17:46 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-dired.el --- utility functions where gnus and dired meet ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Authors: Benjamin Rutt <brutt(a)bloomington.in.us>, ;; Shenghuo Zhu <zsh(a)cs.rochester.edu> 1.7 +36 -3 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-draft.el Index: gnus-draft.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-draft.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-draft.el 2005/11/15 03:45:45 1.6 +++ gnus-draft.el 2006/03/16 04:17:46 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-draft.el --- draft message support for Gnus ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -98,6 +98,7 ＠＠ (interactive) (let ((article (gnus-summary-article-number)) (group gnus-newsgroup-name)) + (gnus-draft-check-draft-articles (list article)) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-draft-setup article group t) (set-buffer-modified-p t) ＠＠ -122,6 +123,7 ＠＠ (let* ((articles (gnus-summary-work-articles n)) (total (length articles)) article) + (gnus-draft-check-draft-articles articles) (while (setq article (pop articles)) (gnus-summary-remove-process-mark article) (unless (memq article gnus-newsgroup-unsendable) ＠＠ -144,6 +146,8 ＠＠ message-send-hook)) (message-setup-hook (and (not is-queue) message-setup-hook)) + (message-signature (and (not is-queue) + message-signature)) (gnus-agent-queue-mail (and (not is-queue) gnus-agent-queue-mail)) (rfc2047-encode-encoded-words nil) ＠＠ -152,7 +156,7 ＠＠ ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction - (message-narrow-to-head) + (message-narrow-to-headers) (when (re-search-forward (concat "^" (regexp-quote gnus-agent-target-move-group-header) ":") nil t) ＠＠ -258,9 +262,12 ＠＠ (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) + (save-restriction + (narrow-to-region (point-min) (point)) + (setq ga + (message-fetch-field gnus-draft-meta-information-header))) (insert mail-header-separator) (forward-line 1) - (setq ga (message-fetch-field gnus-draft-meta-information-header)) (message-set-auto-save-file-name)))) (gnus-backlog-remove-article group narticle) (when (and ga ＠＠ -284,6 +291,32 ＠＠ (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." (not (memq article gnus-newsgroup-unsendable))) + +(defun gnus-draft-check-draft-articles (articles) + "Check whether the draft articles ARTICLES are under edit." + (when (equal gnus-newsgroup-name "nndraft:drafts") + (let ((buffers (buffer-list)) + file buffs buff) + (save-current-buffer + (while (and articles + (not buff)) + (setq file (nndraft-article-filename (pop articles)) + buffs buffers) + (while buffs + (set-buffer (setq buff (pop buffs))) + (if (and buffer-file-name + (string-equal (file-truename buffer-file-name) + (file-truename file)) + (buffer-modified-p)) + (setq buffs nil) + (setq buff nil))))) + (when buff + (let* ((window (get-buffer-window buff t)) + (frame (and window (window-frame window)))) + (if frame + (gnus-select-frame-set-input-focus frame) + (pop-to-buffer buff t))) + (error "The draft %s is under edit" file))))) (provide 'gnus-draft) 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-dup.el Index: gnus-dup.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-dup.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-dup.el 2005/11/15 03:45:45 1.4 +++ gnus-dup.el 2006/03/16 04:17:46 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-dup.el --- suppression of duplicate articles in Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-eform.el Index: gnus-eform.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-eform.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-eform.el 2005/11/15 03:45:45 1.4 +++ gnus-eform.el 2006/03/16 04:17:46 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-eform.el --- a mode for editing forms for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-ems.el Index: gnus-ems.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-ems.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-ems.el 2005/11/15 03:45:45 1.6 +++ gnus-ems.el 2006/03/16 04:17:47 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-fun.el Index: gnus-fun.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-fun.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-fun.el 2005/11/15 03:45:45 1.6 +++ gnus-fun.el 2006/03/16 04:17:47 1.7 ＠＠ -1,6 +1,6 ＠＠ ;;; gnus-fun.el --- various frivolous extension functions to Gnus -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-gl.el Index: gnus-gl.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-gl.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-gl.el 2005/11/15 03:45:46 1.4 +++ gnus-gl.el 2006/03/16 04:17:47 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-gl.el --- an interface to GroupLens for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Brad Miller <bmiller(a)cs.umn.edu> ;; Keywords: news, score 1.7 +34 -10 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-group.el Index: gnus-group.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-group.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-group.el 2005/11/15 03:45:46 1.6 +++ gnus-group.el 2006/03/16 04:17:47 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-group.el --- group mode commands for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -284,14 +284,15 ＠＠ variable." :type 'hook) (defcustom gnus-useful-groups - '(("(ding) mailing list mirrored at sunsite.auc.dk" - "emacs.ding" - (nntp "sunsite.auc.dk" - (nntp-address "sunsite.auc.dk"))) - ("gnus-bug archive" - "gnus-bug" - (nndir "/ftp＠ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/")) - ("Gnus help group" + '(("(ding) mailing list mirrored at gmane.org" + "gmane.emacs.gnus.general" + (nntp "Gmane" + (nntp-address "news.gmane.org"))) + ("Gnus bug archive" + "gnus.gnus-bug" + (nntp "news.gnus.org" + (nntp-address "news.gnus.org"))) + ("Local Gnus help group" "gnus-help" (nndoc "gnus-help" (nndoc-article-type mbox) ＠＠ -1378,6 +1379,18 ＠＠ if it is a string, only list groups matc (gnus-range-difference (list active) (gnus-info-read info)) seen)))))) +(defcustom gnus-group-update-tool-bar + (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) + tool-bar-mode + ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might + ;; be confusing, so maybe we shouldn't call it by default. + (fboundp 'force-window-update)) + "Force updating the group buffer tool bar." +:group 'gnus-group +:version "22.1" +:type 'boolean) + (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) ＠＠ -1446,8 +1459,10 ＠＠ if it is a string, only list groups matc (bbb-grouplens-group-p gnus-tmp-group)) "")) (buffer-read-only nil) + beg end header gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) + (setq beg (point)) (gnus-add-text-properties (point) (prog1 (1+ (point)) ＠＠ -1462,6 +1477,12 ＠＠ if it is a string, only list groups matc gnus-marked ,gnus-tmp-marked-mark gnus-indentation ,gnus-group-indentation gnus-level ,gnus-tmp-level)) + (setq end (point)) + (when gnus-group-update-tool-bar + (gnus-put-text-property beg end 'point-entered + 'gnus-tool-bar-update) + (gnus-put-text-property beg end 'point-left + 'gnus-tool-bar-update)) (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-run-hooks 'gnus-group-update-hook)) ＠＠ -3601,7 +3622,10 ＠＠ re-scanning. If ARG is non-nil and not ;; We might read in new NoCeM messages here. (when (and gnus-use-nocem - (null arg)) + (or (and (numberp gnus-use-nocem) + (numberp arg) + (>= arg gnus-use-nocem)) + (not arg))) (gnus-nocem-scan-groups)) ;; If ARG is not a number, then we read the active file. (when (and arg (not (numberp arg))) 1.8 +7 -5 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-int.el Index: gnus-int.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-int.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- gnus-int.el 2005/11/15 03:45:46 1.7 +++ gnus-int.el 2006/03/16 04:17:48 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-int.el --- backend interface functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -250,10 +250,12 ＠＠ If it is down, start it up (again)." ;; recurse to open the agent's backend. (setq open-offline (eq gnus-server-unopen-status 'offline)) gnus-server-unopen-status) - ((gnus-y-or-n-p - (format "Unable to open %s:%s, go offline? " - (car gnus-command-method) - (cadr gnus-command-method))) + ((and + (not gnus-batch-mode) + (gnus-y-or-n-p + (format "Unable to open %s:%s, go offline? " + (car gnus-command-method) + (cadr gnus-command-method)))) (setq open-offline t) 'offline) (t 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-kill.el Index: gnus-kill.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-kill.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-kill.el 2005/11/15 03:45:46 1.4 +++ gnus-kill.el 2006/03/16 04:17:48 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-kill.el --- kill commands for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-logic.el Index: gnus-logic.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-logic.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-logic.el 2005/11/15 03:45:46 1.5 +++ gnus-logic.el 2006/03/16 04:17:48 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-logic.el --- advanced scoring code for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.4 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-mh.el Index: gnus-mh.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-mh.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- gnus-mh.el 2005/11/15 03:45:47 1.3 +++ gnus-mh.el 2006/03/16 04:17:48 1.4 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-mh.el --- mh-e interface for Gnus ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-ml.el Index: gnus-ml.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-ml.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-ml.el 2005/11/15 03:45:47 1.4 +++ gnus-ml.el 2006/03/16 04:17:49 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-ml.el --- Mailing list minor mode for Gnus ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Julien Gilles <jgilles(a)free.fr> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-mlspl.el Index: gnus-mlspl.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-mlspl.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-mlspl.el 2005/11/15 03:45:47 1.4 +++ gnus-mlspl.el 2006/03/16 04:17:49 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-mlspl.el --- a group params-based mail splitting mechanism ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Alexandre Oliva <oliva(a)lsd.ic.unicamp.br> ;; Keywords: news, mail 1.4 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-move.el Index: gnus-move.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-move.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- gnus-move.el 2005/11/15 03:45:47 1.3 +++ gnus-move.el 2006/03/16 04:17:49 1.4 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-move.el --- commands for moving Gnus from one server to another ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.9 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-msg.el Index: gnus-msg.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-msg.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- gnus-msg.el 2006/01/04 07:05:29 1.8 +++ gnus-msg.el 2006/03/16 04:17:49 1.9 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-msg.el --- mail and post interface for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.6 +13 -7 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-nocem.el Index: gnus-nocem.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-nocem.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-nocem.el 2005/11/15 03:45:47 1.5 +++ gnus-nocem.el 2006/03/16 04:17:50 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -136,6 +136,7 ＠＠ valid issuer, which is much faster if yo (gnus-sethash group t gnus-nocem-real-group-hashtb)) gnus-newsrc-alist)) +;;;###autoload (defun gnus-nocem-scan-groups () "Scan all NoCeM groups for new NoCeM messages." (interactive) ＠＠ -206,10 +207,10 ＠＠ valid issuer, which is much faster if yo (not (member (mail-header-message-id header) gnus-nocem-seen-message-ids)))) (push header check-headers))) - (let* ((i 0) - (check-headers - (last check-headers gnus-nocem-check-article-limit)) - (len (length check-headers))) + (setq check-headers (last (nreverse check-headers) + gnus-nocem-check-article-limit)) + (let ((i 0) + (len (length check-headers))) (dolist (h check-headers) (gnus-message 7 "Checking article %d in %s for NoCeM (%d of %d)..." ＠＠ -235,9 +236,13 ＠＠ valid issuer, which is much faster if yo (days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) (goto-char (point-min)) - (when (re-search-forward "-----BEGIN PGP MESSAGE-----" nil t) + (when (re-search-forward + "-----BEGIN PGP\$ SIGNED\$? MESSAGE-----" + nil t) (delete-region (point-min) (match-beginning 0))) - (when (re-search-forward "-----END PGP MESSAGE-----\n?" nil t) + (when (re-search-forward + "-----END PGP \$MESSAGE\\|SIGNATURE\$-----\n?" + nil t) (delete-region (match-end 0) (point-max))) (goto-char (point-min)) ;; The article has to have proper NoCeM headers. ＠＠ -334,6 +339,7 ＠＠ valid issuer, which is much faster if yo gnus-nocem-alist)) t))) +;;;###autoload (defun gnus-nocem-load-cache () "Load the NoCeM cache." (interactive) 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-picon.el Index: gnus-picon.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-picon.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- gnus-picon.el 2005/11/15 03:45:47 1.7 +++ gnus-picon.el 2006/03/16 04:17:50 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-picon.el --- displaying pretty icons in Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news xpm annotation glyph faces 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-range.el Index: gnus-range.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-range.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-range.el 2005/11/15 03:45:47 1.5 +++ gnus-range.el 2006/03/16 04:17:50 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-range.el --- range and sequence functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-registry.el Index: gnus-registry.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-registry.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-registry.el 2005/11/15 03:45:48 1.6 +++ gnus-registry.el 2006/03/16 04:17:50 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-registry.el --- article registry for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz(a)lifelogs.com> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-salt.el Index: gnus-salt.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-salt.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-salt.el 2005/11/15 03:45:48 1.4 +++ gnus-salt.el 2006/03/16 04:17:51 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-score.el Index: gnus-score.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-score.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-score.el 2005/11/15 03:45:48 1.6 +++ gnus-score.el 2006/03/16 04:17:51 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-score.el --- scoring code for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <amanda(a)iesd.auc.dk> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-setup.el Index: gnus-setup.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-setup.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-setup.el 2005/11/15 03:45:48 1.4 +++ gnus-setup.el 2006/03/16 04:17:51 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 ;; Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Steven L. Baur <steve(a)miranova.com> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sieve.el Index: gnus-sieve.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sieve.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-sieve.el 2005/11/15 03:45:48 1.4 +++ gnus-sieve.el 2006/03/16 04:17:52 1.5 ＠＠ -1,6 +1,6 ＠＠ ;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus -;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: NAGY Andras <nagya(a)inf.elte.hu>, ;; Simon Josefsson <simon(a)josefsson.org> 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-soup.el Index: gnus-soup.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-soup.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-soup.el 2005/11/15 03:45:48 1.5 +++ gnus-soup.el 2006/03/16 04:17:52 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-soup.el --- SOUP packet writing support for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <abraham(a)iesd.auc.dk> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-spec.el Index: gnus-spec.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-spec.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-spec.el 2005/11/15 03:45:48 1.6 +++ gnus-spec.el 2006/03/16 04:17:52 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-spec.el --- format spec functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-srvr.el Index: gnus-srvr.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-srvr.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- gnus-srvr.el 2005/11/15 03:45:49 1.6 +++ gnus-srvr.el 2006/03/16 04:17:52 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-srvr.el --- virtual server support for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.9 +8 -4 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-start.el Index: gnus-start.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-start.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- gnus-start.el 2005/12/19 13:35:25 1.8 +++ gnus-start.el 2006/03/16 04:17:53 1.9 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-start.el --- startup functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -1047,9 +1047,12 ＠＠ If LEVEL is non-nil, the news will be se (gnus-check-bogus-newsgroups)) ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (not level) - (not dont-connect)) + (when (and (not dont-connect) + gnus-use-nocem + (or (and (numberp gnus-use-nocem) + (numberp level) + (>= level gnus-use-nocem)) + (not level))) (gnus-nocem-scan-groups)) ;; Read any slave files. ＠＠ -2818,6 +2821,7 ＠＠ If FORCE is non-nil, the .newsrc file is (print-escape-nonascii t) (print-length nil) (print-level nil) + (print-circle nil) (print-escape-newlines t) (gnus-killed-list (if (and gnus-save-killed-list 1.10 +12 -7 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sum.el Index: gnus-sum.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sum.el,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- gnus-sum.el 2006/01/04 07:05:29 1.9 +++ gnus-sum.el 2006/03/16 04:17:53 1.10 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-sum.el --- summary mode commands for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -3098,8 +3098,11 ＠＠ display only a single character." (aset table ?\r nil) ;; We keep TAB as well. (aset table ?\t nil) - ;; We nix out any glyphs over 126 that are not set already. - (let ((i 256)) + ;; We nix out any glyphs 127 through 255, or 127 through 159 in + ;; Emacs 23 (unicode), that are not set already. + (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160)) + 160 + 256))) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. (unless (aref table i) ＠＠ -6452,10 +6455,12 ＠＠ displayed, no centering will be performe (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) (setq read (cdr read))))) ;; And add the last unread articles. - (cond ((< first last) - (push (cons first last) unread)) - ((= first last) - (push first unread))) + (cond ((not (and first last)) + nil) + ((< first last) + (push (cons first last) unread)) + ((= first last) + (push first unread))) ;; Return the sequence of unread articles. (delq 0 (nreverse unread)))) 1.6 +6 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-topic.el Index: gnus-topic.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-topic.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-topic.el 2005/11/15 03:45:49 1.5 +++ gnus-topic.el 2006/03/16 04:17:54 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Ilja Weis <kult(a)uni-paderborn.de> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -585,6 +585,11 ＠＠ articles in the topic and its subtopics. (not (eq (nth 2 type) 'hidden)) level all-entries unread)) (gnus-topic-update-unreads (car type) unread) + (when gnus-group-update-tool-bar + (gnus-put-text-property beg end 'point-entered + 'gnus-tool-bar-update) + (gnus-put-text-property beg end 'point-left + 'gnus-tool-bar-update)) (goto-char end) unread)) 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-undo.el Index: gnus-undo.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-undo.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-undo.el 2005/11/15 03:45:49 1.4 +++ gnus-undo.el 2006/03/16 04:17:54 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-undo.el --- minor mode for undoing in Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.12 +21 -3 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el Index: gnus-util.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el,v retrieving revision 1.11 retrieving revision 1.12 diff -u -p -r1.11 -r1.12 --- gnus-util.el 2005/11/15 03:45:50 1.11 +++ gnus-util.el 2006/03/16 04:17:54 1.12 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -497,7 +497,8 ＠＠ inside loops." (apply 'format args))) (defun gnus-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gnus-verbose'." + "Beep an error if LEVEL is equal to or less than `gnus-verbose'. +ARGS are passed to `message'." (when (<= (floor level) gnus-verbose) (apply 'message args) (ding) ＠＠ -1457,6 +1458,23 ＠＠ Return nil otherwise." (string-match "\\`[^:]*:[0-9]+\$\\.[0-9]+\$?\\'" display)) display))))) + +(defun gnus-tool-bar-update (&rest ignore) + "Update the tool bar." + (when (and (boundp 'tool-bar-mode) + tool-bar-mode) + (let* ((args nil) + (func (cond ((featurep 'xemacs) + 'ignore) + ((fboundp 'tool-bar-update) + 'tool-bar-update) + ((fboundp 'force-window-update) + 'force-window-update) + ((fboundp 'redraw-frame) + (setq args (list (selected-frame))) + 'redraw-frame) + (t 'ignore)))) + (apply func args)))) ;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile. (defmacro gnus-mapcar (function seq1 &rest seqs2_n) 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-uu.el Index: gnus-uu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-uu.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-uu.el 2005/11/15 03:45:50 1.5 +++ gnus-uu.el 2006/03/16 04:17:54 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Created: 2 Oct 1993 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-vm.el Index: gnus-vm.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-vm.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- gnus-vm.el 2005/11/15 03:45:50 1.4 +++ gnus-vm.el 2006/03/16 04:17:54 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-vm.el --- vm interface for Gnus ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Per Persson <pp(a)gnu.ai.mit.edu> ;; Keywords: news, mail 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-win.el Index: gnus-win.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-win.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- gnus-win.el 2005/11/15 03:45:50 1.5 +++ gnus-win.el 2006/03/16 04:17:55 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-win.el --- window configuration functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.10 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-xmas.el Index: gnus-xmas.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-xmas.el,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- gnus-xmas.el 2006/01/04 07:05:30 1.9 +++ gnus-xmas.el 2006/03/16 04:17:55 1.10 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.11 +17 -6 XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el Index: gnus.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el,v retrieving revision 1.10 retrieving revision 1.11 diff -u -p -r1.10 -r1.11 --- gnus.el 2005/12/19 13:35:25 1.10 +++ gnus.el 2006/03/16 04:17:55 1.11 ＠＠ -1,7 +1,7 ＠＠ ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -1580,9 +1580,23 ＠＠ articles. This is not a good idea." :value t))) (defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages." + "*If non-nil, Gnus will read NoCeM cancel messages. +You can also set this variable to a positive number as a group level. +In that case, Gnus scans NoCeM messages when checking new news if this +value is not exceeding a group level that you specify as the prefix +argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc. +Otherwise, Gnus does not scan NoCeM messages if you specify a group +level to those commands." :group 'gnus-meta -:type 'boolean) +:type '(choice + (const :tag "off" nil) + (const :tag "on" t) + (list :convert-widget + (lambda (widget) + (list 'integer :tag "group level" + :value (if (boundp 'gnus-level-default-subscribed) + gnus-level-default-subscribed + 3)))))) (defcustom gnus-suppress-duplicates nil "*If non-nil, Gnus will mark duplicate copies of the same article as read." ＠＠ -4256,9 +4270,6 ＠＠ current display is used." (cdr (frame-list))) (delete-frame gnus-other-frame-object)) (setq gnus-other-frame-object nil))))))) - -;;(setq thing ? ; this is a comment -;; more 'yes) ;;;###autoload (defun gnus (&optional arg dont-connect slave) 1.6 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/html2text.el Index: html2text.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/html2text.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- html2text.el 2005/11/15 03:45:51 1.5 +++ html2text.el 2006/03/16 04:17:56 1.6 ＠＠ -1,6 +1,6 ＠＠ ;;; html2text.el --- a simple html to plain text converter -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Joakim Hove <hove(a)phys.ntnu.no> ＠＠ -59,7 +59,7 ＠＠ completely verbatim - without any use of This is a list of tags which should be removed, without any formatting. Note that tags in the list are presented *without* -any \"<\" or \">\". All occurences of a tag appearing in this +any \"<\" or \">\". All occurrences of a tag appearing in this list are removed, irrespective of whether it is a closing or opening tag, or if the tag has additional attributes. The deletion is done by the function `html2text-remove-tags'. 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/ietf-drums.el Index: ietf-drums.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/ietf-drums.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- ietf-drums.el 2005/11/15 03:45:51 1.5 +++ ietf-drums.el 2006/03/16 04:17:56 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; ietf-drums.el --- Functions for parsing RFC822bis headers ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/imap.el Index: imap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/imap.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- imap.el 2005/12/19 13:35:25 1.7 +++ imap.el 2006/03/16 04:17:56 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; imap.el --- imap library ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas(a)pdc.kth.se> ;; Keywords: mail 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mail-parse.el Index: mail-parse.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mail-parse.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- mail-parse.el 2005/11/15 03:45:52 1.4 +++ mail-parse.el 2006/03/16 04:17:56 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; mail-parse.el --- Interface functions for parsing mail ;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mail-prsvr.el Index: mail-prsvr.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mail-prsvr.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- mail-prsvr.el 2005/11/15 03:45:52 1.4 +++ mail-prsvr.el 2006/03/16 04:17:56 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; mail-prsvr.el --- Interface variables for parsing mail ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mail-source.el Index: mail-source.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mail-source.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- mail-source.el 2005/11/15 03:45:52 1.7 +++ mail-source.el 2006/03/16 04:17:56 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; mail-source.el --- functions for fetching mail ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news, mail 1.7 +32 -26 XEmacs/packages/xemacs-packages/gnus/lisp/mailcap.el Index: mailcap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mailcap.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- mailcap.el 2005/11/15 03:45:52 1.6 +++ mailcap.el 2006/03/16 04:17:56 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; mailcap.el --- MIME media types configuration ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: William M. Perry <wmperry(a)aventail.com> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -528,7 +528,12 ＠＠ MAILCAPS if set; otherwise (on Unix) use (skip-chars-forward ";")) (setq done t)))) (setq value (buffer-substring val-pos (point)))) - (setq results (cons (cons name value) results)) + ;; `test' as symbol, others like "copiousoutput" and "needsx11" as + ;; strings + (setq results (cons (cons (if (string-equal name "test") + 'test + name) + value) results)) (skip-chars-forward " \";\n\t")) results))) ＠＠ -635,30 +640,31 ＠＠ to supply to the test." (viewer (cdr (assoc 'viewer viewer-info))) (default-directory (expand-file-name "~/")) status parsed-test cache result) - (if (setq cache (assoc test mailcap-viewer-test-cache)) - (cadr cache) - (setq - result - (cond - ((not test-info) t) ; No test clause - ((not test) nil) ; Already failed test - ((eq test t) t) ; Already passed test - ((functionp test) ; Lisp function as test - (funcall test type-info)) - ((and (symbolp test) ; Lisp variable as test - (boundp test)) - (symbol-value test)) - ((and (listp test) ; List to be eval'd - (symbolp (car test))) - (eval test)) - (t - (setq test (mailcap-unescape-mime-test test type-info) - test (list shell-file-name nil nil nil - shell-command-switch test) - status (apply 'call-process test)) - (eq 0 status)))) - (push (list otest result) mailcap-viewer-test-cache) - result))) + (cond ((setq cache (assoc test mailcap-viewer-test-cache)) + (cadr cache)) + ((not test-info) t) ; No test clause + (t + (setq + result + (cond + ((not test) nil) ; Already failed test + ((eq test t) t) ; Already passed test + ((functionp test) ; Lisp function as test + (funcall test type-info)) + ((and (symbolp test) ; Lisp variable as test + (boundp test)) + (symbol-value test)) + ((and (listp test) ; List to be eval'd + (symbolp (car test))) + (eval test)) + (t + (setq test (mailcap-unescape-mime-test test type-info) + test (list shell-file-name nil nil nil + shell-command-switch test) + status (apply 'call-process test)) + (eq 0 status)))) + (push (list otest result) mailcap-viewer-test-cache) + result)))) (defun mailcap-add-mailcap-entry (major minor info) (let ((old-major (assoc major mailcap-mime-data))) 1.9 +37 -11 XEmacs/packages/xemacs-packages/gnus/lisp/message.el Index: message.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/message.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- message.el 2005/12/19 13:35:25 1.8 +++ message.el 2006/03/16 04:17:57 1.9 ＠＠ -1,7 +1,7 ＠＠ ;;; message.el --- composing mail and news messages ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: mail, news ＠＠ -1388,8 +1388,13 ＠＠ should be sent in several parts. If it (integer 1000000))) (defcustom message-alternative-emails nil - "A regexp to match the alternative email addresses. -The first matched address (not primary one) is used in the From field." + "*Regexp matching alternative email addresses. +The first address in the To, Cc or From headers of the original +article matching this variable is used as the From field of +outgoing messages. + +This variable has precedence over posting styles and anything that runs +off `message-setup-hook'." :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "Always use primary" nil) ＠＠ -2185,6 +2190,15 ＠＠ Point is left at the beginning of the na (1+ max))))) (message-sort-headers-1)))) +(defun message-info (&optional arg) + "Display the Message manual. + +Prefixed with one \\[universal-argument], display the Emacs MIME manual. +Prefixed with two \\[universal-argument]'s, display the PGG manual." + (interactive "p") + (cond ((eq arg 16) (Info-goto-node "(pgg)Top")) + ((eq arg 4) (Info-goto-node "(emacs-mime)Top")) + (t (Info-goto-node "(message)Top")))) ＠＠ -2312,7 +2326,11 ＠＠ Point is left at the beginning of the na '(:help "Ask, then arrange to send message at that time"))] ["Kill Message" message-kill-buffer ,＠(if (featurep 'xemacs) '(t) - '(:help "Delete this message without sending"))])) + '(:help "Delete this message without sending"))] + "----" + ["Message manual" message-info + ,＠(if (featurep 'xemacs) '(t) + '(:help "Display the Message manual"))])) (easy-menu-define message-mode-field-menu message-mode-map "" ＠＠ -3597,8 +3615,8 ＠＠ It should typically alter the sending me (when (let ((char (char-after))) (or (< (mm-char-int char) 128) (and (mm-multibyte-p) - ;; Fixme: Wrong for Emacs 22 and for things - ;; like undecable utf-8. Should at least + ;; FIXME: Wrong for Emacs 23 (unicode) and for + ;; things like undecable utf-8. Should at least ;; use find-coding-systems-region. (memq (char-charset char) '(eight-bit-control eight-bit-graphic ＠＠ -4653,7 +4671,9 ＠＠ If NOW, use that time instead." (* 25 25))) (let ((tm (current-time))) (concat - (if (memq system-type '(ms-dos emx vax-vms)) + (if (or (memq system-type '(ms-dos emx vax-vms)) + ;; message-number-base36 doesn't handle bigints. + (floatp (user-uid))) (let ((user (downcase (user-login-name)))) (while (string-match "[^a-z0-9_]" user) (aset user (match-beginning 0) ?_)) ＠＠ -5533,10 +5553,6 ＠＠ are not included." (when message-default-mail-headers (insert message-default-mail-headers) (or (bolp) (insert ?\n))) - (save-restriction - (message-narrow-to-headers) - (if message-alternative-emails - (message-use-alternative-email-as-from))) (when message-generate-headers-first (message-generate-headers (message-headers-to-generate ＠＠ -5552,6 +5568,12 ＠＠ are not included." (set-buffer-modified-p nil) (setq buffer-undo-list nil) (run-hooks 'message-setup-hook) + ;; Do this last to give it precedence over posting styles, etc. + (when (message-mail-p) + (save-restriction + (message-narrow-to-headers) + (if message-alternative-emails + (message-use-alternative-email-as-from)))) (message-position-point) (undo-boundary)) ＠＠ -6835,6 +6857,9 ＠＠ regexp VARSTR." (read-string prompt initial-contents)))) (defun message-use-alternative-email-as-from () + "Set From field of the outgoing message to the first matching +address in `message-alternative-emails', looking at To, Cc and +From headers in the original article." (require 'mail-utils) (let* ((fields '("To" "Cc")) (emails ＠＠ -6849,6 +6874,7 ＠＠ regexp VARSTR." emails nil)) (pop emails)) (unless (or (not email) (equal email user-mail-address)) + (message-remove-header "From") (goto-char (point-max)) (insert "From: " email "\n")))) 1.6 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/messagexmas.el Index: messagexmas.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/messagexmas.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- messagexmas.el 2005/12/19 13:35:25 1.5 +++ messagexmas.el 2006/03/16 04:17:57 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; messagexmas.el --- XEmacs extensions to message -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003, +;; 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: mail, news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/messcompat.el Index: messcompat.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/messcompat.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- messcompat.el 2005/11/15 03:45:53 1.4 +++ messcompat.el 2006/03/16 04:17:57 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; messcompat.el --- making message mode compatible with mail mode ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: mail, news 1.9 +4 -4 XEmacs/packages/xemacs-packages/gnus/lisp/mm-bodies.el Index: mm-bodies.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-bodies.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- mm-bodies.el 2005/12/19 13:35:25 1.8 +++ mm-bodies.el 2006/03/16 04:17:57 1.9 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-bodies.el --- Functions for decoding MIME things ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; MORIOKA Tomohiko <morioka(a)jaist.ac.jp> ＠＠ -249,7 +249,8 ＠＠ decoding. If it is nil, default to `mai (save-excursion (when encoding (mm-decode-content-transfer-encoding encoding type)) - (when (featurep 'mule) ; Fixme: Wrong test for unibyte session. + (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session. + (not (eq charset 'gnus-decoded))) (let ((coding-system (mm-charset-to-coding-system charset))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) ＠＠ -262,8 +263,7 ＠＠ decoding. If it is nil, default to `mai ;;in XEmacs (mm-multibyte-p) (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset)) - (not (eq coding-system 'gnus-decoded))) + (setq coding-system mail-parse-charset))) (mm-decode-coding-region (point-min) (point-max) coding-system)) (setq buffer-file-coding-system 1.9 +39 -37 XEmacs/packages/xemacs-packages/gnus/lisp/mm-decode.el Index: mm-decode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-decode.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- mm-decode.el 2005/12/19 13:35:25 1.8 +++ mm-decode.el 2006/03/16 04:17:58 1.9 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-decode.el --- Functions for decoding MIME things ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; MORIOKA Tomohiko <morioka(a)jaist.ac.jp> ＠＠ -279,7 +279,9 ＠＠ before the external MIME handler is invo "application/x-emacs-lisp" "application/pgp-signature" "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" - "application/pkcs7-mime") + "application/pkcs7-mime" + ;; Mutt still uses this even though it has already been withdrawn. + "application/pgp") "List of media types that are to be displayed inline. See also `mm-inline-media-tests', which says how to display a media type inline." ＠＠ -302,7 +304,9 ＠＠ when selecting a different article." "application/emacs-lisp" "application/x-emacs-lisp" "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" - "application/pkcs7-mime") + "application/pkcs7-mime" + ;; Mutt still uses this even though it has already been withdrawn. + "application/pgp") "A list of MIME types to be displayed automatically." :type '(repeat regexp) :group 'mime-display) ＠＠ -530,13 +534,13 ＠＠ Postpone undisplaying of viewers for typ loose-mime (mail-fetch-field "mime-version")) (setq ct (mail-fetch-field "content-type") - ctl (ignore-errors (mail-header-parse-content-type ct)) + ctl (and ct (mail-header-parse-content-type ct)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") id (mail-fetch-field "content-id")) (unless from - (setq from (mail-fetch-field "from"))) + (setq from (mail-fetch-field "from"))) ;; FIXME: In some circumstances, this code is running within ;; an unibyte macro. mail-extract-address-components ;; creates unibyte buffers. This `if', though not a perfect ＠＠ -553,7 +557,7 ＠＠ Postpone undisplaying of viewers for typ (mail-header-remove-comments cte))))) no-strict-mime - (and cd (ignore-errors (mail-header-parse-content-disposition cd))) + (and cd (mail-header-parse-content-disposition cd)) description) (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) ＠＠ -588,8 +592,7 ＠＠ Postpone undisplaying of viewers for typ (mail-header-remove-comments cte))))) no-strict-mime - (and cd (ignore-errors - (mail-header-parse-content-disposition cd))) + (and cd (mail-header-parse-content-disposition cd)) description id) ctl)))) (when id ＠＠ -766,19 +769,18 ＠＠ external if displayed external." (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)) dir)) - (setq file (mm-make-temp-file (expand-file-name "mm." dir))) - (let ((newname - ;; Use nametemplate (defined in RFC1524) if it is - ;; specified in mailcap. - (if (assoc "nametemplate" mime-info) - (format (cdr (assoc "nametemplate" mime-info)) file) - ;; Add a suffix according to `mailcap-mime-extensions'. - (concat file (car (rassoc (mm-handle-media-type handle) - mailcap-mime-extensions)))))) - (unless (string-equal file newname) - (when (file-exists-p file) - (rename-file file newname)) - (setq file newname)))) + ;; Use nametemplate (defined in RFC1524) if it is specified + ;; in mailcap. + (let ((suffix (cdr (assoc "nametemplate" mime-info)))) + (if (and suffix + (string-match "\\`%s\$\\..+\$\\'" suffix)) + (setq suffix (match-string 1 suffix)) + ;; Otherwise, use a suffix according to + ;; `mailcap-mime-extensions'. + (setq suffix (car (rassoc (mm-handle-media-type handle) + mailcap-mime-extensions)))) + (setq file (mm-make-temp-file (expand-file-name "mm." dir) + nil suffix)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) (message "Viewing with %s" method) ＠＠ -1082,14 +1084,16 ＠＠ external if displayed external." (defun mm-get-part (handle) "Return the contents of HANDLE as a string." - (mm-with-unibyte-buffer - (insert (with-current-buffer (mm-handle-buffer handle) - (mm-with-unibyte-current-buffer - (buffer-string)))) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - (buffer-string))) + (let ((default-enable-multibyte-characters + (with-current-buffer (mm-handle-buffer handle) + (mm-multibyte-p)))) + (with-temp-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-disable-multibyte) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + (buffer-string)))) (defun mm-insert-part (handle) "Insert the contents of HANDLE in the current buffer." ＠＠ -1309,8 +1313,8 ＠＠ be determined." ;; out to a file, and then create a file ;; specifier. (let ((file (mm-make-temp-file - (expand-file-name "emm.xbm" - mm-tmp-directory)))) + (expand-file-name "emm" mm-tmp-directory) + nil ".xbm"))) (unwind-protect (progn (write-region (point-min) (point-max) file) ＠＠ -1397,9 +1401,8 ＠＠ If RECURSIVE, search recursively." (save-excursion (save-restriction (narrow-to-region start (1- (point))) - (when (let ((ctl (ignore-errors - (mail-header-parse-content-type - (mail-fetch-field "content-type"))))) + (when (let* ((ct (mail-fetch-field "content-type")) + (ctl (and ct (mail-header-parse-content-type ct)))) (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) ＠＠ -1410,9 +1413,8 ＠＠ If RECURSIVE, search recursively." (save-excursion (save-restriction (narrow-to-region start end) - (when (let ((ctl (ignore-errors - (mail-header-parse-content-type - (mail-fetch-field "content-type"))))) + (when (let* ((ct (mail-fetch-field "content-type")) + (ctl (and ct (mail-header-parse-content-type ct)))) (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mm-encode.el Index: mm-encode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-encode.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- mm-encode.el 2005/11/15 03:45:53 1.5 +++ mm-encode.el 2006/03/16 04:17:58 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-encode.el --- Functions for encoding MIME things ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; MORIOKA Tomohiko <morioka(a)jaist.ac.jp> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mm-extern.el Index: mm-extern.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-extern.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- mm-extern.el 2005/11/15 03:45:54 1.4 +++ mm-extern.el 2006/03/16 04:17:58 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-extern.el --- showing message/external-body ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: message external-body 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mm-partial.el Index: mm-partial.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-partial.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- mm-partial.el 2005/11/15 03:45:54 1.4 +++ mm-partial.el 2006/03/16 04:17:58 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-partial.el --- showing message/partial ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: message partial 1.6 +5 -2 XEmacs/packages/xemacs-packages/gnus/lisp/mm-url.el Index: mm-url.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-url.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- mm-url.el 2005/11/15 03:45:54 1.5 +++ mm-url.el 2006/03/16 04:17:58 1.6 ＠＠ -1,6 +1,6 ＠＠ ;;; mm-url.el --- a wrapper of url functions/commands for Gnus -;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ＠＠ -276,7 +276,10 ＠＠ This is taken from RFC 2396.") (defun mm-url-load-url () "Load `url-insert-file-contents'." (unless (condition-case () - (require 'url-handlers) + (progn + (require 'url-handlers) + (require 'url-parse) + (require 'url-vars)) (error nil)) ;; w3-4.0pre0.46 or earlier version. (require 'w3-vars) 1.10 +83 -15 XEmacs/packages/xemacs-packages/gnus/lisp/mm-util.el Index: mm-util.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-util.el,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- mm-util.el 2005/11/15 03:45:54 1.9 +++ mm-util.el 2006/03/16 04:17:58 1.10 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-util.el --- Utility functions for Mule and low level things ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; MORIOKA Tomohiko <morioka(a)jaist.ac.jp> ＠＠ -99,16 +99,6 ＠＠ (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) string ""))) (multibyte-string-p . ignore) - ;; It is not a MIME function, but some MIME functions use it. - (make-temp-file . (lambda (prefix &optional dir-flag) - (let ((file (expand-file-name - (make-temp-name prefix) - (if (fboundp 'temp-directory) - (temp-directory) - temporary-file-directory)))) - (if dir-flag - (make-directory file)) - file))) (insert-byte . insert-char) (multibyte-char-to-unibyte . identity)))) ＠＠ -184,7 +174,7 ＠＠ system object in XEmacs." (if (fboundp 'coding-system-p) (when (coding-system-p cs) cs) - ;; Is this branch ever actually useful? + ;; no-MULE XEmacs: (car (memq cs (mm-get-coding-system-list)))))) (defvar mm-charset-synonym-alist ＠＠ -341,7 +331,7 ＠＠ with Mule charsets. It is completely us cs mime mule alist) (while css (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset) ; Emacs 22 + mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) (coding-system-get cs 'mime-charset))) (when (and mime (not (eq t (setq mule ＠＠ -806,11 +796,18 ＠＠ Use multibyte mode for this." (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS with current buffer temporarily made unibyte. Also bind `default-enable-multibyte-characters' to nil. -Equivalent to `progn' in XEmacs" +Equivalent to `progn' in XEmacs + +NOTE: Use this macro with caution in multibyte buffers (it is not +worth using this macro in unibyte buffers of course). Use of +`(set-buffer-multibyte t)', which is run finally, is generally +harmful since it is likely to modify existing data in the buffer. +For instance, it converts \"\\300\\255\" into \"\\255\" in +Emacs 23 (unicode)." (let ((multibyte (make-symbol "multibyte")) (buffer (make-symbol "buffer"))) `(if mm-emacs-mule - (let ((,multibyte enable-multibyte-characters) + (let ((,multibyte enable-multibyte-characters) (,buffer (current-buffer))) (unwind-protect (let (default-enable-multibyte-characters) ＠＠ -970,6 +967,77 ＠＠ If INHIBIT is non-nil, inhibit `mm-inhib inhibit-file-name-handlers) inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) + +;; It is not a MIME function, but some MIME functions use it. +(if (and (fboundp 'make-temp-file) + (ignore-errors + (let ((def (symbol-function 'make-temp-file))) + (and (byte-code-function-p def) + (setq def (if (fboundp 'compiled-function-arglist) + ;; XEmacs + (eval (list 'compiled-function-arglist def)) + (aref def 0))) + (>= (length def) 4) + (eq (nth 3 def) 'suffix))))) + (defalias 'mm-make-temp-file 'make-temp-file) + ;; Stolen (and modified for Emacs 20 and XEmacs) from Emacs 22. + (defun mm-make-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file. +The returned file name (created by appending some random characters at the end +of PREFIX, and expanding against `temporary-file-directory' if necessary), +is guaranteed to point to a newly created empty file. +You can then use `write-region' to write new data into the file. + +If DIR-FLAG is non-nil, create a new empty directory instead of a file. + +If SUFFIX is non-nil, add that at the end of the file name." + (let ((umask (default-file-modes)) + file) + (unwind-protect + (progn + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (set-default-file-modes 448) + (while (condition-case err + (progn + (setq file + (make-temp-name + (expand-file-name + prefix + (if (fboundp 'temp-directory) + ;; XEmacs + (temp-directory) + temporary-file-directory)))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (if (or (featurep 'xemacs) + (= emacs-major-version 20)) + ;; NOTE: This is unsafe if Emacs 20 + ;; users and XEmacs users don't use + ;; a secure temp directory. + (if (file-exists-p file) + (signal 'file-already-exists + (list "File exists" file)) + (write-region "" nil file nil 'silent)) + (write-region "" nil file nil 'silent + nil 'excl))) + nil) + (file-already-exists t) + ;; The Emacs 20 and XEmacs versions of + ;; `make-directory' issue `file-error'. + (file-error (or (and (or (featurep 'xemacs) + (= emacs-major-version 20)) + (file-exists-p file)) + (signal (car err) (cdr err))))) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file) + ;; Reset the umask. + (set-default-file-modes umask))))) (defun mm-image-load-path (&optional package) (let (dir result) 1.7 +84 -18 XEmacs/packages/xemacs-packages/gnus/lisp/mm-uu.el Index: mm-uu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-uu.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- mm-uu.el 2005/11/15 03:45:54 1.6 +++ mm-uu.el 2006/03/16 04:17:59 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-uu.el --- Return uu stuff as mm handles ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp ＠＠ -174,6 +174,10 ＠＠ To disable dissecting shar codes, for in mm-uu-type-alist) :group 'gnus-article-mime) +(defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded)) + "MIME type and parameters for text/plain parts. +`gnus-decoded' is a fake charset, which means no further decoding.") + ;; functions (defsubst mm-uu-type (entry) ＠＠ -262,7 +266,7 ＠＠ Return that buffer." (defun mm-uu-emacs-sources-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("application/emacs-lisp") + '("application/emacs-lisp" (charset . gnus-decoded)) nil nil (list mm-dissect-disposition (cons 'filename file-name)))) ＠＠ -278,7 +282,7 ＠＠ Return that buffer." (defun mm-uu-diff-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("text/x-patch"))) + '("text/x-patch" (charset . gnus-decoded)))) (defun mm-uu-diff-test () (and gnus-newsgroup-name ＠＠ -375,7 +379,7 ＠＠ Return that buffer." (while (re-search-forward "^- " nil t) (replace-match "" t t) (forward-line 1))) - (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded)))))) + (list (mm-make-handle buf mm-uu-text-plain-type)))) (defun mm-uu-pgp-signed-extract () (let ((mm-security-handle (list (format "multipart/signed")))) ＠＠ -407,9 +411,7 ＠＠ Return that buffer." (with-current-buffer buf (mml2015-clean-buffer) (funcall (mml2015-clear-decrypt-function)))) - (list - (mm-make-handle buf - '("text/plain" (charset . gnus-decoded)))))) + (list (mm-make-handle buf mm-uu-text-plain-type)))) (defun mm-uu-pgp-encrypted-extract () (let ((mm-security-handle (list (format "multipart/encrypted")))) ＠＠ -443,25 +445,27 ＠＠ Return that buffer." '("application/pgp-keys")))) ;;;###autoload -(defun mm-uu-dissect () - "Dissect the current buffer and return a list of uu handles." +(defun mm-uu-dissect (&optional noheader mime-type) + "Dissect the current buffer and return a list of uu handles. +The optional NOHEADER means there's no header in the buffer. +MIME-TYPE specifies a MIME type and parameters, which defaults to the +value of `mm-uu-text-plain-type'." (let ((case-fold-search t) - text-start start-point end-point file-name result - text-plain-type entry func) + (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type)) + text-start start-point end-point file-name result entry func) (save-excursion (goto-char (point-min)) (cond + (noheader) ((looking-at "\n") (forward-line)) ((search-forward "\n\n" nil t) t) (t (goto-char (point-max)))) - ;;; gnus-decoded is a fake charset, which means no further - ;;; decoding. - (setq text-start (point) - text-plain-type '("text/plain" (charset . gnus-decoded))) + (setq text-start (point)) (while (re-search-forward mm-uu-beginning-regexp nil t) - (setq start-point (match-beginning 0)) + (setq start-point (match-beginning 0) + entry nil) (let ((alist mm-uu-type-alist) (beginning-regexp (match-string 0))) (while (not entry) ＠＠ -488,7 +492,7 ＠＠ Return that buffer." (re-search-forward "." start-point t))) (push (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - text-plain-type) + mm-uu-text-plain-type) result)) (push (funcall (mm-uu-function-extract entry)) ＠＠ -501,10 +505,72 ＠＠ Return that buffer." (re-search-forward "." nil t))) (push (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - text-plain-type) + mm-uu-text-plain-type) result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) + +;;;###autoload +(defun mm-uu-dissect-text-parts (handle &optional decoded) + "Dissect text parts and put uu handles into HANDLE. +Assume text has been decoded if DECODED is non-nil." + (let ((buffer (mm-handle-buffer handle))) + (cond ((stringp buffer) + (dolist (elem (cdr handle)) + (mm-uu-dissect-text-parts elem decoded))) + ((bufferp buffer) + (let ((type (mm-handle-media-type handle)) + (case-fold-search t) ;; string-match + children charset encoding) + (when (and + (stringp type) + ;; Mutt still uses application/pgp even though + ;; it has already been withdrawn. + (string-match "\\`text/\\|\\`application/pgp\\'" type) + (setq + children + (with-current-buffer buffer + (cond + ((or decoded + (eq (setq charset (mail-content-type-get + (mm-handle-type handle) + 'charset)) + 'gnus-decoded)) + (setq decoded t) + (mm-uu-dissect + t (cons type '((charset . gnus-decoded))))) + (charset + (setq decoded t) + (mm-with-multibyte-buffer + (insert (mm-decode-string (mm-get-part handle) + charset)) + (mm-uu-dissect + t (cons type '((charset . gnus-decoded)))))) + ((setq encoding (mm-handle-encoding handle)) + (setq decoded nil) + ;; Inherit the multibyteness of the `buffer'. + (with-temp-buffer + (insert-buffer-substring buffer) + (mm-decode-content-transfer-encoding + encoding type) + (mm-uu-dissect t (list type)))) + (t + (setq decoded nil) + (mm-uu-dissect t (list type))))))) + ;; Ignore it if a given part is dissected into a single + ;; part of which the type is the same as the given one. + (if (and (<= (length children) 2) + (string-equal (mm-handle-media-type (cadr children)) + type)) + (kill-buffer (mm-handle-buffer (cadr children))) + (kill-buffer buffer) + (setcdr handle (cdr children)) + (setcar handle (car children)) ;; "multipart/mixed" + (dolist (elem (cdr children)) + (mm-uu-dissect-text-parts elem decoded)))))) + (t + (dolist (elem handle) + (mm-uu-dissect-text-parts elem decoded)))))) (provide 'mm-uu) 1.8 +80 -18 XEmacs/packages/xemacs-packages/gnus/lisp/mm-view.el Index: mm-view.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-view.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- mm-view.el 2005/12/19 13:35:25 1.7 +++ mm-view.el 2006/03/16 04:17:59 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; mm-view.el --- functions for viewing MIME objects ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. ＠＠ -51,8 +51,7 ＠＠ (defvar mm-text-html-renderer-alist '((w3 . mm-inline-text-html-render-with-w3) (w3m . mm-inline-text-html-render-with-w3m) - (w3m-standalone mm-inline-render-with-stdin nil - "w3m" "-dump" "-T" "text/html") + (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) (links mm-inline-render-with-file mm-links-remove-leading-blank "links" "-dump" file) ＠＠ -64,8 +63,7 ＠＠ (defvar mm-text-html-washer-alist '((w3 . gnus-article-wash-html-with-w3) (w3m . gnus-article-wash-html-with-w3m) - (w3m-standalone mm-inline-wash-with-stdin nil - "w3m" "-dump" "-T" "text/html") + (w3m-standalone . gnus-article-wash-html-with-w3m-standalone) (links mm-inline-wash-with-file mm-links-remove-leading-blank "links" "-dump" file) ＠＠ -74,6 +72,12 ＠＠ (html2text html2text)) "The attributes of washer types for text/html.") +(defcustom mm-fill-flowed t + "If non-nil an format=flowed article will be displayed flowed." +:type 'boolean +:version "22.1" +:group 'mime-display) + ;;; Internal variables. ;;; ＠＠ -209,21 +213,25 ＠＠ (defun mm-w3m-cid-retrieve-1 (url handle) (dolist (elem handle) - (when (listp elem) - (if (equal url (mm-handle-id elem)) - (progn - (mm-insert-part elem) - (throw 'found-handle (mm-handle-media-type elem)))) - (if (equal "multipart" (mm-handle-media-supertype elem)) - (mm-w3m-cid-retrieve-1 url elem))))) + (when (consp elem) + (when (equal url (mm-handle-id elem)) + (mm-insert-part elem) + (throw 'found-handle (mm-handle-media-type elem))) + (when (and (stringp (car elem)) + (equal "multipart" (mm-handle-media-supertype elem))) + (mm-w3m-cid-retrieve-1 url elem))))) (defun mm-w3m-cid-retrieve (url &rest args) "Insert a content pointed by URL if it has the cid: scheme." (when (string-match "\\`cid:" url) - (catch 'found-handle - (mm-w3m-cid-retrieve-1 (concat "<" (substring url (match-end 0)) ">") - (with-current-buffer w3m-current-buffer - gnus-article-mime-handles))))) + (or (catch 'found-handle + (mm-w3m-cid-retrieve-1 + (setq url (concat "<" (substring url (match-end 0)) ">")) + (with-current-buffer w3m-current-buffer + gnus-article-mime-handles))) + (prog1 + nil + (message "Failed to find \"Content-ID: %s\"" url))))) (defun mm-inline-text-html-render-with-w3m (handle) "Render a text/html part using emacs-w3m." ＠＠ -264,6 +272,58 ＠＠ (delete-region ,(point-min-marker) ,(point-max-marker))))))))) +(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided) + "*T means the w3m command supports the m17n feature.") + +(defun mm-w3m-standalone-supports-m17n-p () + "Say whether the w3m command supports the m17n feature." + (cond ((eq mm-w3m-standalone-supports-m17n-p t) t) + ((eq mm-w3m-standalone-supports-m17n-p nil) nil) + ((not (featurep 'mule)) (setq mm-w3m-standalone-supports-m17n-p nil)) + ((condition-case nil + (let ((coding-system-for-write 'iso-2022-jp) + (coding-system-for-read 'iso-2022-jp) + (str (mm-decode-coding-string "\ +\e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t#s!!#m#1#7#n!)\e(B" 'iso-2022-jp))) + (mm-with-multibyte-buffer + (insert str) + (call-process-region + (point-min) (point-max) "w3m" t t nil "-dump" + "-T" "text/html" "-I" "iso-2022-jp" "-O" "iso-2022-jp") + (goto-char (point-min)) + (search-forward str nil t))) + (error nil)) + (setq mm-w3m-standalone-supports-m17n-p t)) + (t + ;;(message "You had better upgrade your w3m command") + (setq mm-w3m-standalone-supports-m17n-p nil)))) + +(defun mm-inline-text-html-render-with-w3m-standalone (handle) + "Render a text/html part using w3m." + (if (mm-w3m-standalone-supports-m17n-p) + (let ((source (mm-get-part handle)) + (charset (mail-content-type-get (mm-handle-type handle) 'charset)) + cs) + (unless (and charset + (setq cs (mm-charset-to-coding-system charset)) + (not (eq cs 'ascii))) + ;; The default. + (setq charset "iso-8859-1" + cs 'iso-8859-1)) + (mm-insert-inline + handle + (mm-with-unibyte-buffer + (insert source) + (mm-enable-multibyte) + (let ((coding-system-for-write 'binary) + (coding-system-for-read cs)) + (call-process-region + (point-min) (point-max) + "w3m" t t nil "-dump" "-T" "text/html" + "-I" charset "-O" charset)) + (buffer-string)))) + (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html"))) + (defun mm-links-remove-leading-blank () ;; Delete the annoying three spaces preceding each line of links ;; output. ＠＠ -357,7 +417,8 ＠＠ (mm-insert-part handle) (goto-char (point-max))) (insert (mm-decode-string (mm-get-part handle) charset))) - (when (and (equal type "plain") + (when (and mm-fill-flowed + (equal type "plain") (equal (cdr (assoc 'format (mm-handle-type handle))) "flowed")) (save-restriction ＠＠ -436,7 +497,8 ＠＠ ;; disable prepare hook gnus-article-prepare-hook (gnus-newsgroup-charset - (or charset gnus-newsgroup-charset))) + (unless (eq charset 'gnus-decoded) ;; mm-uu might set it. + (or charset gnus-newsgroup-charset)))) (let ((gnus-original-article-buffer (mm-handle-buffer handle))) (run-hooks 'gnus-article-decode-hook)) (gnus-article-prepare-display) 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mml-sec.el Index: mml-sec.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml-sec.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- mml-sec.el 2005/11/15 03:45:54 1.5 +++ mml-sec.el 2006/03/16 04:17:59 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; mml-sec.el --- A package with security functions for MML documents ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org> 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mml-smime.el Index: mml-smime.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml-smime.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- mml-smime.el 2005/11/15 03:45:54 1.7 +++ mml-smime.el 2006/03/16 04:17:59 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; mml-smime.el --- S/MIME support for MML ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org> ;; Keywords: Gnus, MIME, S/MIME, MML 1.7 +48 -19 XEmacs/packages/xemacs-packages/gnus/lisp/mml.el Index: mml.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- mml.el 2005/11/15 03:45:54 1.6 +++ mml.el 2006/03/16 04:17:59 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; mml.el --- A package for parsing and validating MML documents ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. ＠＠ -38,6 +38,7 ＠＠ (autoload 'gnus-add-minor-mode "gnus-ems") (autoload 'gnus-make-local-hook "gnus-util") (autoload 'message-fetch-field "message") + (autoload 'message-info "message") (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message")) ＠＠ -506,7 +507,15 ＠＠ If MML is non-nil, return the buffer up (let ((coding-system-for-read mm-binary-coding-system)) (mm-insert-file-contents filename nil nil nil nil t))) (t - (insert (cdr (assq 'contents cont))))) + (let ((contents (cdr (assq 'contents cont)))) + (if (if (featurep 'xemacs) + (string-match "[^\000-\377]" contents) + (mm-multibyte-string-p contents)) + (progn + (mm-enable-multibyte) + (insert contents) + (setq charset (mm-encode-body))) + (insert contents))))) (setq encoding (mm-encode-buffer type) coded (mm-string-as-multibyte (buffer-string)))) (mml-insert-mime-headers cont type charset encoding nil) ＠＠ -577,7 +586,8 ＠＠ If MML is non-nil, return the buffer up ;; Skip `multipart' and attributes. (when (and (consp part) (consp (cdr part))) (insert "\n--" mml-boundary "\n") - (mml-generate-mime-1 part)))) + (mml-generate-mime-1 part) + (goto-char (point-max))))) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) ＠＠ -662,10 +672,10 ＠＠ If MML is non-nil, return the buffer up "Can't encode a part with several charsets")) (insert "Content-Type: " type) (when charset - (insert "; " (mail-header-encode-parameter - "charset" (symbol-name charset)))) + (mml-insert-parameter + (mail-header-encode-parameter "charset" (symbol-name charset)))) (when flowed - (insert "; format=flowed")) + (mml-insert-parameter "format=flowed")) (when parameters (mml-insert-parameter-string cont mml-content-type-parameters)) ＠＠ -685,8 +695,11 ＠＠ If MML is non-nil, return the buffer up (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (when (setq description (cdr (assq 'description cont))) - (insert "Content-Description: " - (mail-encode-encoded-word-string description) "\n")))) + (insert "Content-Description: ") + (setq description (prog1 + (point) + (insert description "\n"))) + (mail-encode-encoded-word-region description (point))))) (defun mml-parameter-string (cont types) (let ((string "") ＠＠ -839,14 +852,20 ＠＠ If HANDLES is non-nil, use it instead re (defun mml-insert-parameter (&rest parameters) "Insert PARAMETERS in a nice way." - (dolist (param parameters) - (insert ";") - (let ((point (point))) + (let (start end) + (dolist (param parameters) + (insert ";") + (setq start (point)) (insert " " param) - (when (> (current-column) 71) - (goto-char point) - (insert "\n ") - (end-of-line))))) + (setq end (point)) + (goto-char start) + (end-of-line) + (if (> (current-column) 76) + (progn + (goto-char start) + (insert "\n") + (goto-char (1+ end))) + (goto-char end))))) ;;; ;;; Mode for inserting and editing MML forms ＠＠ -917,7 +936,14 ＠＠ If HANDLES is non-nil, use it instead re ;;["Narrow" mml-narrow-to-part t] ["Quote MML" mml-quote-region t] ["Validate MML" mml-validate t] - ["Preview" mml-preview t])) + ["Preview" mml-preview t] + "----" + ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) + ,＠(if (featurep 'xemacs) '(t) + '(:help "Display the Emacs MIME manual"))] + ["PGG manual" (lambda () (interactive) (message-info 16)) + ,＠(if (featurep 'xemacs) '(t) + '(:help "Display the PGG manual"))])) (defvar mml-mode nil "Minor mode for editing MML.") ＠＠ -1036,9 +1062,12 ＠＠ See Info node `(emacs-mime)Composing'. The file is not inserted or encoded until you send the message with `\\[message-send-and-exit]' or `\\[message-send]'. -FILE is the name of the file to attach. TYPE is its content-type, a -string of the form \"type/subtype\". DESCRIPTION is a one-line -description of the attachment." +FILE is the name of the file to attach. TYPE is its +content-type, a string of the form \"type/subtype\". DESCRIPTION +is a one-line description of the attachment. The DISPOSITION +specifies how the attachment is intended to be displayed. It can +be either \"inline\" (displayed automatically within the message +body) or \"attachment\" (separate from the body)." (interactive (let* ((file (mml-minibuffer-read-file "Attach file: ")) (type (mml-minibuffer-read-type file)) 1.6 +5 -3 XEmacs/packages/xemacs-packages/gnus/lisp/mml1991.el Index: mml1991.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml1991.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- mml1991.el 2005/11/15 03:45:55 1.5 +++ mml1991.el 2006/03/16 04:18:00 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Sascha Lüdecke <sascha(a)meta-x.de>, ;; Simon Josefsson <simon(a)josefsson.org> (Mailcrypt interface, Gnus glue) ＠＠ -229,7 +229,8 ＠＠ (defvar pgg-output-buffer)) (defun mml1991-pgg-sign (cont) - (let (headers cte) + (let ((pgg-text-mode t) + headers cte) ;; Don't sign headers. (goto-char (point-min)) (while (not (looking-at "^$")) ＠＠ -261,7 +262,8 ＠＠ t)) (defun mml1991-pgg-encrypt (cont &optional sign) - (let (cte) + (let ((pgg-text-mode t) + cte) ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") 1.7 +3 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mml2015.el Index: mml2015.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml2015.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- mml2015.el 2005/11/15 03:45:55 1.6 +++ mml2015.el 2006/03/16 04:18:00 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: PGP MIME MML ＠＠ -814,6 +814,7 ＠＠ (boundary (mml-compute-boundary cont)) (pgg-default-user-id (or (message-options-get 'mml-sender) pgg-default-user-id)) + (pgg-text-mode t) entry) (unless (pgg-sign-region (point-min) (point-max)) (pop-to-buffer mml2015-result-buffer) ＠＠ -841,6 +842,7 ＠＠ (defun mml2015-pgg-encrypt (cont &optional sign) (let ((pgg-errors-buffer mml2015-result-buffer) + (pgg-text-mode t) (boundary (mml-compute-boundary cont))) (unless (pgg-encrypt-region (point-min) (point-max) (split-string 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnagent.el Index: nnagent.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnagent.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- nnagent.el 2005/11/15 03:45:55 1.5 +++ nnagent.el 2006/03/16 04:18:00 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; nnagent.el --- offline backend for Gnus ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news, mail 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnbabyl.el Index: nnbabyl.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnbabyl.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- nnbabyl.el 2005/11/15 03:45:55 1.5 +++ nnbabyl.el 2006/03/16 04:18:00 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; nnbabyl.el --- rmail mbox access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nndb.el Index: nndb.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndb.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nndb.el 2005/11/15 03:45:55 1.4 +++ nndb.el 2006/03/16 04:18:01 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nndb.el --- nndb access for Gnus ;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Kai Grossjohann <grossjohann(a)ls6.informatik.uni-dortmund.de> 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nndiary.el Index: nndiary.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndiary.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- nndiary.el 2005/11/15 03:45:55 1.5 +++ nndiary.el 2006/03/16 04:18:01 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; nndiary.el --- A diary backend for Gnus ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Didier Verna <didier(a)xemacs.org> ;; Maintainer: Didier Verna <didier(a)xemacs.org> 1.4 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nndir.el Index: nndir.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndir.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- nndir.el 2005/11/15 03:45:55 1.3 +++ nndir.el 2006/03/16 04:18:01 1.4 ＠＠ -1,7 +1,7 ＠＠ ;;; nndir.el --- single directory newsgroup access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nndoc.el Index: nndoc.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndoc.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- nndoc.el 2005/11/15 03:45:55 1.6 +++ nndoc.el 2006/03/16 04:18:01 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; nndoc.el --- single file access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nndraft.el Index: nndraft.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndraft.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- nndraft.el 2005/11/15 03:45:56 1.5 +++ nndraft.el 2006/03/16 04:18:01 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; nndraft.el --- draft article access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nneething.el Index: nneething.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nneething.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nneething.el 2005/11/15 03:45:56 1.4 +++ nneething.el 2006/03/16 04:18:02 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nneething.el --- arbitrary file access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> 1.7 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/nnfolder.el Index: nnfolder.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnfolder.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- nnfolder.el 2005/11/15 03:45:56 1.6 +++ nnfolder.el 2006/03/16 04:18:02 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; nnfolder.el --- mail folder access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org> (adding MARKS) ;; ShengHuo Zhu <zsh(a)cs.rochester.edu> (adding NOV) ＠＠ -826,7 +826,7 ＠＠ deleted. Point is left where the delete (insert "\n")) (forward-char -1) (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string))))) + (cdr group-art) (message-make-date))))) (defun nnfolder-active-number (group) ;; Find the next article number in GROUP. 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nngateway.el Index: nngateway.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nngateway.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nngateway.el 2005/11/15 03:45:56 1.4 +++ nngateway.el 2006/03/16 04:18:02 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nngateway.el --- posting news via mail gateways ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news, mail 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnheader.el Index: nnheader.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnheader.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- nnheader.el 2005/11/15 03:45:56 1.7 +++ nnheader.el 2006/03/16 04:18:02 1.8 ＠＠ -2,7 +2,7 ＠＠ ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, ;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.7 +2 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnimap.el Index: nnimap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnimap.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- nnimap.el 2005/11/15 03:45:56 1.6 +++ nnimap.el 2006/03/16 04:18:02 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; nnimap.el --- imap backend for Gnus ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas(a)pdc.kth.se> ;; Jim Radford <radford(a)robby.caltech.edu> ＠＠ -1492,6 +1492,7 ＠＠ function is generally only called when G (setq result (eval accept-form)) (kill-buffer buf) result) + (nnimap-possibly-change-group group server) (imap-message-flags-add (imap-range-to-message-set (list article)) "\\Deleted" 'silent nnimap-server-buffer)) 1.3 +14 -13 XEmacs/packages/xemacs-packages/gnus/lisp/nnir.el Index: nnir.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnir.el,v retrieving revision 1.2 retrieving revision 1.3 diff -u -p -r1.2 -r1.3 --- nnir.el 2005/11/15 03:45:56 1.2 +++ nnir.el 2006/03/16 04:18:03 1.3 ＠＠ -690,18 +690,8 ＠＠ that it is for Namazu, not Glimpse." 'gnus-group-make-nnir-group)) (add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) -(defmacro nnir-group-server (group) - "Return the server for a foreign newsgroup GROUP. -The returned format is as `gnus-server-to-method' needs it. See -`gnus-group-real-prefix' and `gnus-group-real-name'." - `(let ((gname ,group)) - (if (string-match "^\$[^:]+\$:" gname) - (setq gname (match-string 1 gname)) - nil) - (if (string-match "^\$[^+]+\$\\+\$.+\$$" gname) - (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) - (concat gname ":")))) + ;; Summary mode commands. (defun gnus-summary-nnir-goto-thread () ＠＠ -873,7 +863,7 ＠＠ pairs (also vectors, actually)." (let ((artlist nil) (groupspec (cdr (assq 'group query))) (qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-glimpse-remove-prefix server)) + (prefix (nnir-read-server-parm 'nnir-glimps-remove-prefix server)) artno dirnam) (when (and group groupspec) (error (concat "It does not make sense to use a group spec" ＠＠ -1202,7 +1192,7 ＠＠ Tested with swish-e-2.0.1 on Windows NT (error "Missing parameter `nnir-swish-e-index-file'"))) (additional-switches (nnir-read-server-parm - 'nnir-swish-e-additional-switches server)) + 'nnir-swish++-additional-switches server)) (cp-list `(,nnir-swish-e-program nil ; input from /dev/null t ; output ＠＠ -1493,6 +1483,17 ＠＠ form 'backend:name'." ;; (symbol-value key)) ;; (symbol-value key)) ;; )) + +(defmacro nnir-group-server (group) + "Returns the server for a foreign newsgroup in the format as gnus-server-to-method needs it. Compare to gnus-group-real-prefix and gnus-group-real-name." + `(let ((gname ,group)) + (if (string-match "^\$[^:]+\$:" gname) + (setq gname (match-string 1 gname)) + nil) + (if (string-match "^\$[^+]+\$\\+\$.+\$$" gname) + (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) + (concat gname ":")) + )) (defun nnir-group-full-name (shortname server) "For the given group name, return a full Gnus group name. 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnkiboze.el Index: nnkiboze.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnkiboze.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnkiboze.el 2005/11/15 03:45:57 1.4 +++ nnkiboze.el 2006/03/16 04:18:03 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnkiboze.el --- select virtual news access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnlistserv.el Index: nnlistserv.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnlistserv.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnlistserv.el 2005/11/15 03:45:57 1.4 +++ nnlistserv.el 2006/03/16 04:18:03 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnlistserv.el --- retrieving articles via web mailing list archives ;; Copyright (C) 1997, 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news, mail 1.8 +15 -8 XEmacs/packages/xemacs-packages/gnus/lisp/nnmail.el Index: nnmail.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnmail.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- nnmail.el 2005/12/19 13:35:26 1.7 +++ nnmail.el 2006/03/16 04:18:03 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; nnmail.el --- mail support functions for the Gnus mail backends ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news, mail ＠＠ -1425,11 +1425,12 ＠＠ See the documentation for the variable ` ;; Not in cache, compute a regexp for the field/value pair. (t - (let* ((field (nth 0 split)) - (value (nth 1 split)) - partial-front - partial-rear - regexp) + (let ((field (nth 0 split)) + (value (nth 1 split)) + (split-rest (cddr split)) + partial-front + partial-rear + regexp) (if (symbolp value) (setq value (cdr (assq value nnmail-split-abbrev-alist)))) (if (and (>= (length value) 2) ＠＠ -1441,7 +1442,13 ＠＠ See the documentation for the variable ` (string= ".*" (substring value -2))) (setq value (substring value 0 -2) partial-rear "")) - (when nnmail-split-fancy-match-partial-words + ;; Invert the match-partial-words behavior if the optional + ;; last element is specified. + (while (eq (car split-rest) '-) + (setq split-rest (cddr split-rest))) + (when (if (cadr split-rest) + (not nnmail-split-fancy-match-partial-words) + nnmail-split-fancy-match-partial-words) (setq partial-front "" partial-rear "")) (setq regexp (concat "^\\(\\(" ＠＠ -1456,7 +1463,7 ＠＠ See the documentation for the variable ` (or partial-rear "\\>"))) (push (cons split regexp) nnmail-split-cache) ;; Now that it's in the cache, just call nnmail-split-it again - ;; on the same split, which will find it immediately in the cache. + ;; on the same split, which will find it immediately in the cache. (nnmail-split-it split)))))) (defun nnmail-expand-newtext (newtext) 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnmbox.el Index: nnmbox.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnmbox.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- nnmbox.el 2005/11/15 03:45:57 1.5 +++ nnmbox.el 2006/03/16 04:18:03 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; nnmbox.el --- mail mbox access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> 1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnmh.el Index: nnmh.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnmh.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- nnmh.el 2005/11/15 03:45:57 1.5 +++ nnmh.el 2006/03/16 04:18:04 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; nnmh.el --- mhspool access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnml.el Index: nnml.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnml.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- nnml.el 2005/11/15 03:45:57 1.6 +++ nnml.el 2006/03/16 04:18:04 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; nnml.el --- mail spool access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org> (adding MARKS) ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.5 +11 -7 XEmacs/packages/xemacs-packages/gnus/lisp/nnoo.el Index: nnoo.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnoo.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnoo.el 2005/11/15 03:45:58 1.4 +++ nnoo.el 2006/03/16 04:18:04 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnoo.el --- OO Gnus Backends ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -61,12 +61,16 ＠＠ (defmacro nnoo-declare (backend &rest parents) `(eval-and-compile - (push (list ',backend - (mapcar (lambda (p) (list p)) ',parents) - nil nil) - nnoo-definition-alist) - (push (list ',backend "*internal-non-initialized-backend*") - nnoo-state-alist))) + (if (assq ',backend nnoo-definition-alist) + (setcar (cdr (assq ',backend nnoo-definition-alist)) + (mapcar 'list ',parents)) + (push (list ',backend + (mapcar 'list ',parents) + nil nil) + nnoo-definition-alist)) + (unless (assq ',backend nnoo-state-alist) + (push (list ',backend "*internal-non-initialized-backend*") + nnoo-state-alist)))) (put 'nnoo-declare 'lisp-indent-function 1) (defun nnoo-parents (backend) 1.8 +145 -32 XEmacs/packages/xemacs-packages/gnus/lisp/nnrss.el Index: nnrss.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnrss.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- nnrss.el 2006/01/04 07:05:30 1.7 +++ nnrss.el 2006/03/16 04:18:04 1.8 ＠＠ -1,6 +1,7 ＠＠ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: RSS ＠＠ -87,9 +88,14 ＠＠ ARTICLE is the article number of the cur (defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252)) "Alist of encodings and those supersets. The cdr of each element is used to decode data if it is available when -the car is what the data specify as the encoding. Or, the car is used +the car is what the data specify as the encoding. Or, the car is used for decoding when the cdr that the data specify is not available.") +(defvar nnrss-wash-html-in-text-plain-parts nil + "*Non-nil means render text in text/plain parts as HTML. +The function specified by the `mm-text-html-renderer' variable will be +used to render text. If it is nil, text will simply be folded.") + (nnoo-define-basics nnrss) ;;; Interface functions ＠＠ -169,6 +175,10 ＠＠ for decoding when the cdr that the data (deffoo nnrss-close-group (group &optional server) t) +(eval-when-compile + (defvar mm-text-html-renderer) + (defvar mm-text-html-washer-alist)) + (deffoo nnrss-request-article (article &optional group server buffer) (setq group (nnrss-decode-group-name group)) (when (stringp article) ＠＠ -191,10 +201,7 ＠＠ for decoding when the cdr that the data (if (nth 5 e) (insert "Date: " (nnrss-format-string (nth 5 e)) "\n")) (let ((header (buffer-string)) - (text (if (nth 6 e) - (mapconcat 'identity - (delete "" (split-string (nth 6 e) "\n+")) - " "))) + (text (nth 6 e)) (link (nth 2 e)) (enclosure (nth 7 e)) (comments (nth 8 e)) ＠＠ -205,7 +212,7 ＠＠ for decoding when the cdr that the data (cons '("Newsgroups" . utf-8) rfc2047-header-encoding-alist) rfc2047-header-encoding-alist)) - rfc2047-encode-encoded-words body) + rfc2047-encode-encoded-words body fn) (when (or text link enclosure comments) (insert "\n") (insert "<#multipart type=alternative>\n" ＠＠ -214,23 +221,46 ＠＠ for decoding when the cdr that the data (when text (insert text) (goto-char body) - ;; See `nnrss-check-group', which inserts " ". - (if (search-forward " " nil t) + (if (and nnrss-wash-html-in-text-plain-parts + (progn + (require 'mm-view) + (setq fn (or (cdr (assq mm-text-html-renderer + mm-text-html-washer-alist)) + mm-text-html-renderer)))) + (progn + (narrow-to-region body (point-max)) + (if (functionp fn) + (funcall fn) + (apply (car fn) (cdr fn))) + (widen) + (goto-char body) + (re-search-forward "[^\t\n ]" nil t) + (beginning-of-line) + (delete-region body (point)) + (goto-char (point-max)) + (skip-chars-backward "\t\n ") + (end-of-line) + (delete-region (point) (point-max)) + (insert "\n")) + (while (re-search-forward "\n+" nil t) + (replace-match " ")) + (goto-char body) + ;; See `nnrss-check-group', which inserts " ". + (when (search-forward " " nil t) (if (eobp) (replace-match "\n") - (replace-match "\n\n") - (let ((fill-column default-fill-column) - (window (get-buffer-window nntp-server-buffer))) - (when window - (setq fill-column - (max 1 (/ (* (window-width window) 7) 8)))) - (fill-region (point) (point-max)) - (goto-char (point-max)) - ;; XEmacs version of `fill-region' inserts newline. - (unless (bolp) - (insert "\n")))) - (goto-char (point-max)) - (insert "\n")) + (replace-match "\n\n"))) + (unless (eobp) + (let ((fill-column default-fill-column) + (window (get-buffer-window nntp-server-buffer))) + (when window + (setq fill-column + (max 1 (/ (* (window-width window) 7) 8)))) + (fill-region (point) (point-max)) + (goto-char (point-max)) + ;; XEmacs version of `fill-region' inserts newline. + (unless (bolp) + (insert "\n"))))) (when (or link enclosure) (insert "\n"))) (when link ＠＠ -436,6 +466,74 ＠＠ nnrss: %s: Not valid XML %s and w3-parse (unless (assoc (car elem) nnrss-group-alist) (insert (prin1-to-string (car elem)) " 0 1 y\n"))))) +(eval-and-compile (autoload 'timezone-parse-date "timezone")) + +(defun nnrss-normalize-date (date) + "Return a date string of DATE in the RFC822 style. +This function handles the ISO 8601 date format described in +<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style +which RSS 2.0 allows." + (let (case-fold-search vector year month day time zone cts) + (cond ((null date)) + ;; RFC822 + ((string-match " [0-9]+ " date) + (setq vector (timezone-parse-date date) + year (string-to-number (aref vector 0))) + (when (>= year 1969) + (setq month (string-to-number (aref vector 1)) + day (string-to-number (aref vector 2))) + (unless (>= (length (setq time (aref vector 3))) 3) + (setq time "00:00:00")) + (when (and (setq zone (aref vector 4)) + (not (string-match "\\`[A-Z+-]" zone))) + (setq zone nil)))) + ;; ISO 8601 + ((string-match + (eval-when-compile + (concat + ;; 1. year + "\$199[0-9]\\|20[0-9][0-9]\$" + "\$-" + ;; 3. month + "\\([01][0-9]\$" + "\$-" + ;; 5. day + "\\([0-3][0-9]\$" + "\\)?\\)?\$T" + ;; 7. hh:mm + "\\([012][0-9]:[0-5][0-9]\$" + "\$" + ;; 9. :ss + "\\(:[0-5][0-9]\$" + "\$\\.[0-9]+\$?\\)?\\)?" + ;; 13+14,15,16. zone + "\$\\(\\([+-][012][0-9]\$:\$[0-5][0-9]\$\\)" + "\\|\$[+-][012][0-9][0-5][0-9]\$" + "\\|\$Z\$\\)?")) + date) + (setq year (string-to-number (match-string 1 date)) + month (string-to-number (or (match-string 3 date) "1")) + day (string-to-number (or (match-string 5 date) "1")) + time (if (match-beginning 9) + (substring date (match-beginning 7) (match-end 9)) + (concat (or (match-string 7 date) "00:00") ":00")) + zone (cond ((match-beginning 13) + (concat (match-string 13 date) + (match-string 14 date))) + ((match-beginning 16) ;; Z + "+0000") + (t ;; nil if zone is not provided. + (match-string 15 date)))))) + (if month + (progn + (setq cts (current-time-string (encode-time 0 0 0 day month year))) + (format "%s, %02d %s %04d %s%s" + (substring cts 0 3) day (substring cts 4 7) year time + (if zone + (concat " " zone) + ""))) + (message-make-date)))) + ;;; data functions (defun nnrss-read-server-data (server) ＠＠ -606,9 +704,9 ＠＠ nnrss: %s: Not valid XML %s and w3-parse (setq author (or (nnrss-node-text rss-ns 'author item) (nnrss-node-text dc-ns 'creator item) (nnrss-node-text dc-ns 'contributor item))) - (setq date (or (nnrss-node-text dc-ns 'date item) - (nnrss-node-text rss-ns 'pubDate item) - (message-make-date))) + (setq date (nnrss-normalize-date + (or (nnrss-node-text dc-ns 'date item) + (nnrss-node-text rss-ns 'pubDate item)))) (setq comments (nnrss-node-text rss-ns 'comments item)) (when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item))) (let ((url (cdr (assq 'url enclosure))) ＠＠ -658,14 +756,29 ＠＠ nnrss: %s: Not valid XML %s and w3-parse "OPML subscriptions import. Read the file and attempt to subscribe to each Feed in the file." (interactive "fImport file: ") - (mapcar - (lambda (node) (gnus-group-make-rss-group - (cdr (assq 'xmlUrl (cadr node))))) + (mapc + (lambda (node) + (let ((xmlurl (cdr (assq 'xmlUrl (cadr node))))) + (when (and xmlurl + (not (string-match "\\`[\t ]*\\'" xmlurl)) + (prog1 + (y-or-n-p (format "Subscribe to %s " xmlurl)) + (message ""))) + (condition-case err + (progn + (gnus-group-make-rss-group xmlurl) + (forward-line 1)) + (error + (message + "Failed to subscribe to %s (%s); type any key to continue: " + xmlurl + (error-message-string err)) + (let ((echo-keystrokes 0)) + (read-char))))))) (nnrss-find-el 'outline - (progn - (find-file opml-file) - (xml-parse-region (point-min) - (point-max)))))) + (mm-with-multibyte-buffer + (insert-file-contents opml-file) + (xml-parse-region (point-min) (point-max)))))) (defun nnrss-opml-export () "OPML subscription export. 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnslashdot.el Index: nnslashdot.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnslashdot.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnslashdot.el 2005/11/15 03:45:58 1.4 +++ nnslashdot.el 2006/03/16 04:18:04 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnslashdot.el --- interfacing with Slashdot ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnsoup.el Index: nnsoup.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnsoup.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnsoup.el 2005/11/15 03:45:58 1.4 +++ nnsoup.el 2006/03/16 04:18:04 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnsoup.el --- SOUP access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnspool.el Index: nnspool.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnspool.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- nnspool.el 2005/11/15 03:45:58 1.6 +++ nnspool.el 2006/03/16 04:18:05 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; nnspool.el --- spool access for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2000, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin(a)flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nntp.el Index: nntp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nntp.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- nntp.el 2005/12/19 13:35:26 1.7 +++ nntp.el 2006/03/16 04:18:05 1.8 ＠＠ -2,7 +2,7 ＠＠ ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, ;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnultimate.el Index: nnultimate.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnultimate.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnultimate.el 2005/11/15 03:45:59 1.4 +++ nnultimate.el 2006/03/16 04:18:05 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnvirtual.el Index: nnvirtual.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnvirtual.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnvirtual.el 2005/11/15 03:45:59 1.4 +++ nnvirtual.el 2006/03/16 04:18:05 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnvirtual.el --- virtual newsgroups access for Gnus ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: David Moore <dmoore(a)ucsd.edu> ;; Lars Magne Ingebrigtsen <larsi(a)gnus.org> 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnwarchive.el Index: nnwarchive.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnwarchive.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnwarchive.el 2005/11/15 03:45:59 1.4 +++ nnwarchive.el 2006/03/16 04:18:06 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; nnwarchive.el --- interfacing with web archives ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: news egroups mail-archive 1.7 +113 -96 XEmacs/packages/xemacs-packages/gnus/lisp/nnweb.el Index: nnweb.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnweb.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- nnweb.el 2005/11/15 03:45:59 1.6 +++ nnweb.el 2006/03/16 04:18:06 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; nnweb.el --- retrieving articles via web search engines ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news ＠＠ -27,12 +27,6 ＠＠ ;; Note: You need to have `w3' installed for some functions to work. -;; FIXME: Due to changes in the HTML output of Google Groups and Gmane, stuff -;; related to web groups (gnus-group-make-web-group) doesn't work anymore. - -;; Fetching an article by MID (cf. gnus-refer-article-method) over Google -;; Groups should work. - ;;; Code: (eval-when-compile (require 'cl)) ＠＠ -61,6 +55,7 ＠＠ Valid types include `google', `dejanews' (defvar nnweb-type-definition '((google (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) ＠＠ -69,8 +64,9 ＠＠ Valid types include `google', `dejanews' (base . "http://groups.google.com") (identifier . nnweb-google-identity)) (dejanews ;; alias of google - (article . ignore) - (id . "http://groups.google.com/groups?selm=%s&output=gplain") + (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") + (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) ＠＠ -83,7 +79,7 ＠＠ Valid types include `google', `dejanews' (reference . identity) (map . nnweb-gmane-create-mapping) (search . nnweb-gmane-search) - (address . "http://gmane.org/") + (address . "http://search.gmane.org/nov.php") (identifier . nnweb-gmane-identity))) "Type-definition alist.") ＠＠ -123,25 +119,20 ＠＠ Valid types include `google', `dejanews' (deffoo nnweb-request-scan (&optional group server) (nnweb-possibly-change-server group server) (if nnweb-ephemeral-p - (setq nnweb-hashtb (gnus-make-hashtable 4095))) + (setq nnweb-hashtb (gnus-make-hashtable 4095)) + (unless nnweb-articles + (nnweb-read-overview group))) (funcall (nnweb-definition 'map)) (unless nnweb-ephemeral-p (nnweb-write-active) (nnweb-write-overview group))) (deffoo nnweb-request-group (group &optional server dont-check) - (nnweb-possibly-change-server nil server) - (when (and group - (not (equal group nnweb-group)) - (not nnweb-ephemeral-p)) - (setq nnweb-group group - nnweb-articles nil) - (let ((info (assoc group nnweb-group-alist))) - (when info - (setq nnweb-type (nth 2 info)) - (setq nnweb-search (nth 3 info)) - (unless dont-check - (nnweb-read-overview group))))) + (nnweb-possibly-change-server group server) + (unless (or nnweb-ephemeral-p + dont-check + nnweb-articles) + (nnweb-read-overview group)) (cond ((not nnweb-articles) (nnheader-report 'nnweb "No matching articles")) ＠＠ -205,7 +196,7 ＠＠ Valid types include `google', `dejanews' (nnweb-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) - (nnmail-generate-active nnweb-group-alist) + (nnmail-generate-active (list (assoc server nnweb-group-alist))) t)) (deffoo nnweb-request-update-info (group info &optional server) ＠＠ -217,7 +208,7 ＠＠ Valid types include `google', `dejanews' (deffoo nnweb-request-create-group (group &optional server args) (nnweb-possibly-change-server nil server) (nnweb-request-delete-group group) - (push `(,group ,(cons 1 0) ,＠args) nnweb-group-alist) + (push `(,group ,(cons 1 0)) nnweb-group-alist) (nnweb-write-active) t) ＠＠ -287,18 +278,16 ＠＠ Valid types include `google', `dejanews' def)) (defun nnweb-possibly-change-server (&optional group server) - (nnweb-init server) (when server (unless (nnweb-server-opened server) - (nnweb-open-server server))) + (nnweb-open-server server)) + (nnweb-init server)) (unless nnweb-group-alist (nnweb-read-active)) (unless nnweb-hashtb (setq nnweb-hashtb (gnus-make-hashtable 4095))) (when group - (when (and (not nnweb-ephemeral-p) - (equal group nnweb-group)) - (nnweb-request-group group nil t)))) + (setq nnweb-group group))) (defun nnweb-init (server) "Initialize buffers and such." ＠＠ -317,42 +306,51 ＠＠ Valid types include `google', `dejanews' (defun nnweb-google-wash-article () ;; We have Google's masked e-mail addresses here. :-/ - (let ((case-fold-search t)) + (let ((case-fold-search t) + (start-re "<pre>\n *") + (end-re "\n *</pre>")) (goto-char (point-min)) (if (save-excursion (or (re-search-forward "The requested message.*could not be found." nil t) - (not (and (re-search-forward "^<pre>" nil t) - (re-search-forward "^</pre>" nil t))))) + (not (and (re-search-forward start-re nil t) + (re-search-forward end-re nil t))))) ;; FIXME: Don't know how to indicate "not found". ;; Should this function throw an error? --rsteib (progn (gnus-message 3 "Requested article not found") (erase-buffer)) (delete-region (point-min) - (1+ (re-search-forward "^<pre>" nil t))) + (re-search-forward start-re)) (goto-char (point-min)) - (delete-region (- (re-search-forward "^</pre>" nil t) (length "</pre>")) + (delete-region (progn + (re-search-forward end-re) + (match-beginning 0)) (point-max)) (mm-url-decode-entities)))) (defun nnweb-google-parse-1 (&optional Message-ID) + "Parse search result in current buffer." (let ((i 0) (case-fold-search t) (active (cadr (assoc nnweb-group nnweb-group-alist))) Subject Score Date Newsgroups From map url mid) (unless active - (push (list nnweb-group (setq active (cons 1 0)) - nnweb-type nnweb-search) + (push (list nnweb-group (setq active (cons 1 0))) nnweb-group-alist)) ;; Go through all the article hits on this page. (goto-char (point-min)) - (while (re-search-forward - "a href=/groups\$\\?[^ \">]*selm=\\([^ &\">]+\$\\)" nil t) - (setq mid (match-string 2) + (while + (re-search-forward + "a +href=\"/group/\$[^>\"]+\$/browse_thread/[^>]+#\$[0-9a-f]+\$" + nil t) + (setq Newsgroups (match-string-no-properties 1) + ;; Note: Starting with Google Groups 2, `mid' is a Google-internal + ;; ID, not a proper Message-ID. + mid (match-string-no-properties 2) url (format - (nnweb-definition 'id) mid)) + (nnweb-definition 'result) Newsgroups mid)) (narrow-to-region (search-forward ">" nil t) (search-forward "</a>" nil t)) (mm-url-remove-markup) ＠＠ -360,25 +358,22 ＠＠ Valid types include `google', `dejanews' (setq Subject (buffer-string)) (goto-char (point-max)) (widen) - (forward-line 2) - (when (looking-at " <font[^>]+>") - (goto-char (match-end 0))) - (if (not (looking-at "<a[^>]+>")) - (skip-chars-forward " \t") - (narrow-to-region (point) - (search-forward "</a>" nil t)) - (mm-url-remove-markup) - (mm-url-decode-entities) - (setq Newsgroups (buffer-string)) - (goto-char (point-max)) - (widen) - (skip-chars-forward "- \t")) + (narrow-to-region (point) + (search-forward "</td" nil t)) + + (mm-url-remove-markup) + (mm-url-decode-entities) + (search-backward " - ") (when (looking-at - "\$[0-9]+\$[/ ]\$[A-Za-z]+\$[/ ]\$[0-9]+\$[ \t]*by[ \t]*\$[^<]*\$ - <a") + " - \$[a-zA-Z]+\$ \$[0-9]+\$\$?: \\([0-9]\\{4\\}\$\\)?, [^\n]+by \$[^<\n]+\$\n") (setq From (match-string 4) Date (format "%s %s 00:00:00 %s" - (match-string 2) (match-string 1) - (match-string 3)))) + (match-string 1) + (match-string 2) + (or (match-string 3) + (substring (current-time-string) -4))))) + + (widen) (forward-line 1) (incf i) (unless (nnweb-get-hashtb url) ＠＠ -409,6 +404,7 ＠＠ Valid types include `google', `dejanews' (save-excursion (set-buffer nnweb-buffer) (erase-buffer) + (nnheader-message 7 "Searching google...") (when (funcall (nnweb-definition 'search) nnweb-search) (let ((more t) (i 0)) ＠＠ -419,15 +415,18 ＠＠ Valid types include `google', `dejanews' (goto-char (point-min)) (incf i 100) (if (or (not (re-search-forward - "<td nowrap><a href=\$[^>]+\$.*Next" nil t)) + "<a href=\"\n\$[^>\"]+\$\"><img src=\"[^\"]+next" + nil t)) (>= i nnweb-max-hits)) (setq more nil) ;; Yup, there are more articles (setq more (concat (nnweb-definition 'base) (match-string 1))) (when more (erase-buffer) + (nnheader-message 7 "Searching google...(%d)" i) (mm-url-insert more)))) ;; Return the articles in the right order. + (nnheader-message 7 "Searching google...done") (setq nnweb-articles (sort nnweb-articles 'car-less-than-car)))))) ＠＠ -443,7 +442,8 ＠＠ Valid types include `google', `dejanews' ("hl" . "en") ("lr" . "") ("safe" . "off") - ("sites" . "groups"))))) + ("sites" . "groups") + ("filter" . "0"))))) t) (defun nnweb-google-identity (url) ＠＠ -459,46 +459,61 ＠＠ Valid types include `google', `dejanews' "Perform the search and create a number-to-url alist." (save-excursion (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - subject group url - map) - ;; Remove stuff from the beginning of results - (goto-char (point-min)) - (search-forward "Search Results</h1><ul>" nil t) - (delete-region (point-min) (point)) + (let ((case-fold-search t) + (active (or (cadr (assoc nnweb-group nnweb-group-alist)) + (cons 1 0))) + map) + (erase-buffer) + (nnheader-message 7 "Searching Gmane..." ) + (when (funcall (nnweb-definition 'search) nnweb-search) (goto-char (point-min)) - ;; Iterate over the actual hits - (while (re-search-forward ".*href=\"\$[^\"]+\$\">\$.*\$" nil t) - (setq url (concat "http://gmane.org/" (match-string 1))) - (setq subject (match-string 2)) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" group ") " subject) nil nil - nil nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car)))))) + ;; Skip the status line + (forward-line 1) + ;; Thanks to Olly Betts we now have NOV lines in our buffer! + (while (not (eobp)) + (unless (or (eolp) (looking-at "\x0d")) + (let ((header (nnheader-parse-nov))) + (let ((xref (mail-header-xref header)) + (from (mail-header-from header)) + (subject (mail-header-subject header)) + (rfc2047-encoding-type 'mime)) + (when (string-match " \$[^:]+\$:\$[0-9]+\$" xref) + (mail-header-set-xref + header + (format "http://article.gmane.org/%s/%s/raw" + (match-string 1 xref) + (match-string 2 xref)))) + + ;; Add host part to gmane-encrypted addresses + (when (string-match "＠$" from) + (mail-header-set-from header + (concat from "public.gmane.org"))) + + (mail-header-set-subject header + (rfc2047-encode-string subject)) + + (unless (nnweb-get-hashtb (mail-header-xref header)) + (push + (list + (incf (cdr active)) + header) + map) + (nnweb-set-hashtb (cadar map) (car map)))))) + (forward-line 1))) + (nnheader-message 7 "Searching Gmane...done") + (setq nnweb-articles + (sort (nconc nnweb-articles map) 'car-less-than-car))))) (defun nnweb-gmane-wash-article () (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "" nil t) - (delete-region (point-min) (point)) (goto-char (point-min)) - (while (looking-at "^<li>\$[^ ]+\$.*</li>") - (replace-match "\\1\\2" t) - (forward-line 1)) - (mm-url-remove-markup))) + (when (search-forward "" nil t) + (delete-region (point-min) (point)) + (goto-char (point-min)) + (while (looking-at "^<li>\$[^ ]+\$.*</li>") + (replace-match "\\1\\2" t) + (forward-line 1)) + (mm-url-remove-markup)))) (defun nnweb-gmane-search (search) (mm-url-insert ＠＠ -506,10 +521,12 ＠＠ Valid types include `google', `dejanews' (nnweb-definition 'address) "?" (mm-url-encode-www-form-urlencoded - `(("query" . ,search))))) + `(("query" . ,search) + ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits)))))) (setq buffer-file-name nil) + (set-buffer-multibyte t) + (mm-decode-coding-region (point-min) (point-max) 'utf-8) t) - (defun nnweb-gmane-identity (url) "Return a unique identifier based on URL." 1.5 +2 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnwfm.el Index: nnwfm.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnwfm.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- nnwfm.el 2005/11/15 03:45:59 1.4 +++ nnwfm.el 2006/03/16 04:18:06 1.5 ＠＠ -1,6 +1,7 ＠＠ ;;; nnwfm.el --- interfacing with a web forum -;; Copyright (C) 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news 1.5 +2 -1 XEmacs/packages/xemacs-packages/gnus/lisp/parse-time.el Index: parse-time.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/parse-time.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- parse-time.el 2005/11/15 03:45:59 1.4 +++ parse-time.el 2006/03/16 04:18:06 1.5 ＠＠ -1,6 +1,7 ＠＠ ;;; parse-time.el --- Parsing time strings -;; Copyright (C) 1996, 2000, 2002 by Free Software Foundation, Inc. +;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, 2005, 2006 +;; Free Software Foundation, Inc. ;; Author: Erik Naggum <erik(a)naggum.no> ;; Keywords: util 1.6 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/qp.el Index: qp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/qp.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- qp.el 2005/11/15 03:45:59 1.5 +++ qp.el 2006/03/16 04:18:06 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; qp.el --- Quoted-Printable functions ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: mail, extensions ＠＠ -118,7 +118,7 ＠＠ encode lines starting with \"From\"." (not (eobp))) (insert (prog1 - ;; To unibyte in case of Emacs 22 eight-bit. + ;; To unibyte in case of Emacs 23 (unicode) eight-bit. (format "=%02X" (mm-multibyte-char-to-unibyte (char-after))) (delete-char 1)))) ;; Encode white space at the end of lines. 1.5 +2 -3 XEmacs/packages/xemacs-packages/gnus/lisp/rfc1843.el Index: rfc1843.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc1843.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- rfc1843.el 2005/11/15 03:45:59 1.4 +++ rfc1843.el 2006/03/16 04:18:06 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; rfc1843.el --- HZ (rfc1843) decoding ;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: news HZ HZ+ mail i18n ＠＠ -149,8 +149,7 ＠＠ ftp://ftp.math.psu.edu/pub/simpson/chine (let* ((inhibit-point-motion-hooks t) (case-fold-search t) (ct (message-fetch-field "Content-Type" t)) - (ctl (and ct (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (if (and ctl (not (string-match "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max)) 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/rfc2045.el Index: rfc2045.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2045.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- rfc2045.el 2005/11/15 03:46:00 1.4 +++ rfc2045.el 2006/03/16 04:18:06 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; rfc2045.el --- Functions for decoding rfc2045 headers ;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. 1.9 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/rfc2047.el Index: rfc2047.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2047.el,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- rfc2047.el 2005/12/19 13:35:26 1.8 +++ rfc2047.el 2006/03/16 04:18:07 1.9 ＠＠ -1,7 +1,7 ＠＠ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages ;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; MORIOKA Tomohiko <morioka(a)jaist.ac.jp> ＠＠ -835,7 +835,7 ＠＠ If your Emacs implementation can't decod (cond ((eq cs 'ascii) (setq cs (or (mm-charset-to-coding-system mail-parse-charset) 'raw-text))) - ((setq cs (mm-coding-system-p cs))) + ((mm-coding-system-p cs)) ((and charset (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) 1.8 +176 -110 XEmacs/packages/xemacs-packages/gnus/lisp/rfc2231.el Index: rfc2231.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2231.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- rfc2231.el 2005/12/19 13:35:26 1.7 +++ rfc2231.el 2006/03/16 04:18:07 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; rfc2231.el --- Functions for decoding rfc2231 headers -;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; This file is part of GNU Emacs. ＠＠ -41,20 +41,51 ＠＠ N.B. This is in violation with RFC2047, but it seem to be in common use." (rfc2231-parse-string (rfc2047-decode-string string))) -(defun rfc2231-parse-string (string) +(defun rfc2231-parse-string (string &optional signal-error) "Parse STRING and return a list. The list will be on the form - `(name (attribute . value) (attribute . value)...)" + `(name (attribute . value) (attribute . value)...)'. + +If the optional SIGNAL-ERROR is non-nil, signal an error when this +function fails in parsing of parameters. Otherwise, this function +must never cause a Lisp error." (with-temp-buffer (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token)) (stoken (ietf-drums-token-to-list ietf-drums-tspecials)) (ntoken (ietf-drums-token-to-list "0-9")) - (prev-value "") - display-name mailbox c display-string parameters - attribute value type subtype number encoded - prev-attribute prev-encoded) - (ietf-drums-init (mail-header-remove-whitespace - (mail-header-remove-comments string))) + c type attribute encoded number prev-attribute vals + prev-encoded parameters value) + (ietf-drums-init + (condition-case nil + (mail-header-remove-whitespace + (mail-header-remove-comments string)) + ;; The most likely cause of an error is unbalanced parentheses + ;; or double-quotes. If all parentheses and double-quotes are + ;; quoted meaninglessly with backslashes, removing them might + ;; make it parseable. Let's try... + (error + (let (mod) + (when (and (string-match "\\\\\"" string) + (not (string-match "\\`\"\\|[^\\]\"" string))) + (setq string (mm-replace-in-string string "\\\\\"" "\"") + mod t)) + (when (and (string-match "\\\$" string) + (string-match "\\\$" string) + (not (string-match "\\`(\\|[^\\][()]" string))) + (setq string (mm-replace-in-string string "\\\\\$[()]\$" "\\1") + mod t)) + (or (and mod + (ignore-errors + (mail-header-remove-whitespace + (mail-header-remove-comments string)))) + ;; Finally, attempt to extract only type. + (if (string-match + (concat "\\`[\t\n ]*\$[^" ietf-drums-tspecials "\t\n ]+" + "\\(/[^" ietf-drums-tspecials + "\t\n ]+\$?\\)\$[\t\n ;]\\|\\'\$") + string) + (match-string 1 string) + "")))))) (let ((table (copy-syntax-table ietf-drums-syntax-table))) (modify-syntax-entry ?\' "w" table) (modify-syntax-entry ?* " " table) ＠＠ -66,67 +97,83 ＠＠ The list will be on the form (set-syntax-table table)) (setq c (char-after)) (when (and (memq c ttoken) - (not (memq c stoken))) - (setq type (downcase (buffer-substring - (point) (progn (forward-sexp 1) (point))))) + (not (memq c stoken)) + (setq type (ignore-errors + (downcase + (buffer-substring (point) (progn + (forward-sexp 1) + (point))))))) ;; Do the params - (while (not (eobp)) - (setq c (char-after)) - (unless (eq c ?\;) - (error "Invalid header: %s" string)) - (forward-char 1) - ;; If c in nil, then this is an invalid header, but - ;; since elm generates invalid headers on this form, - ;; we allow it. - (when (setq c (char-after)) - (if (and (memq c ttoken) - (not (memq c stoken))) - (setq attribute - (intern - (downcase - (buffer-substring - (point) (progn (forward-sexp 1) (point)))))) - (error "Invalid header: %s" string)) - (setq c (char-after)) - (when (eq c ?*) - (forward-char 1) - (setq c (char-after)) - (if (not (memq c ntoken)) - (setq encoded t - number nil) - (setq number - (string-to-number - (buffer-substring - (point) (progn (forward-sexp 1) (point))))) + (condition-case err + (progn + (while (not (eobp)) (setq c (char-after)) - (when (eq c ?*) - (setq encoded t) + (unless (eq c ?\;) + (error "Invalid header: %s" string)) + (forward-char 1) + ;; If c in nil, then this is an invalid header, but + ;; since elm generates invalid headers on this form, + ;; we allow it. + (when (setq c (char-after)) + (if (and (memq c ttoken) + (not (memq c stoken))) + (setq attribute + (intern + (downcase + (buffer-substring + (point) (progn (forward-sexp 1) (point)))))) + (error "Invalid header: %s" string)) + (setq c (char-after)) + (if (eq c ?*) + (progn + (forward-char 1) + (setq c (char-after)) + (if (not (memq c ntoken)) + (setq encoded t + number nil) + (setq number + (string-to-number + (buffer-substring + (point) (progn (forward-sexp 1) (point))))) + (setq c (char-after)) + (when (eq c ?*) + (setq encoded t) + (forward-char 1) + (setq c (char-after))))) + (setq number nil + encoded nil)) + ;; See if we have any previous continuations. + (when (and prev-attribute + (not (eq prev-attribute attribute))) + (setq vals + (mapconcat 'cdr (sort vals 'car-less-than-car) "")) + (push (cons prev-attribute + (if prev-encoded + (rfc2231-decode-encoded-string vals) + vals)) + parameters) + (setq prev-attribute nil + vals nil + prev-encoded nil)) + (unless (eq c ?=) + (error "Invalid header: %s" string)) (forward-char 1) - (setq c (char-after))))) - ;; See if we have any previous continuations. - (when (and prev-attribute - (not (eq prev-attribute attribute))) - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string prev-value) - prev-value)) - parameters) - (setq prev-attribute nil - prev-value "" - prev-encoded nil)) - (unless (eq c ?=) - (error "Invalid header: %s" string)) - (forward-char 1) - (setq c (char-after)) - (cond - ((eq c ?\") - (setq value - (buffer-substring (1+ (point)) - (progn (forward-sexp 1) (1- (point)))))) - ((and (or (memq c ttoken) - (> c ?\177)) ;; EXTENSION: Support non-ascii chars. - (not (memq c stoken))) - (setq value (buffer-substring + (setq c (char-after)) + (cond + ((eq c ?\") + (setq value (buffer-substring (1+ (point)) + (progn + (forward-sexp 1) + (1- (point))))) + (when encoded + (setq value (mapconcat (lambda (c) (format "%%%02x" c)) + value "")))) + ((and (or (memq c ttoken) + ;; EXTENSION: Support non-ascii chars. + (> c ?\177)) + (not (memq c stoken))) + (setq value + (buffer-substring (point) (progn (forward-sexp) ＠＠ -138,59 +185,72 ＠＠ The list will be on the form (forward-char 1) (forward-sexp)) (point))))) - (t - (error "Invalid header: %s" string))) - (if number - (setq prev-attribute attribute - prev-value (concat prev-value value) - prev-encoded encoded) - (push (cons attribute - (if encoded - (rfc2231-decode-encoded-string value) - value)) - parameters)))) - - ;; Take care of any final continuations. - (when prev-attribute - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string prev-value) - prev-value)) - parameters)) + (t + (error "Invalid header: %s" string))) + (if number + (progn + (push (cons number value) vals) + (setq prev-attribute attribute + prev-encoded encoded)) + (push (cons attribute + (if encoded + (rfc2231-decode-encoded-string value) + value)) + parameters)))) + + ;; Take care of any final continuations. + (when prev-attribute + (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) "")) + (push (cons prev-attribute + (if prev-encoded + (rfc2231-decode-encoded-string vals) + vals)) + parameters))) + (error + (setq parameters nil) + (if signal-error + (signal (car err) (cdr err)) + ;;(message "%s" (error-message-string err)) + ))) - (when type - `(,type ,＠(nreverse parameters))))))) + (cons type (nreverse parameters)))))) (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. -These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"." - (with-temp-buffer - (let ((elems (split-string string "'"))) - ;; The encoded string may contain zero to two single-quote - ;; marks. This should give us the encoded word stripped - ;; of any preceding values. - (insert (car (last elems))) +These look like: + \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or + \"This is ***fun***\"." + (string-match "\\`\$\\([^']+\$?'\$[^']+\$?'\\)?\$.+\$" string) + (let ((coding-system (mm-charset-to-coding-system (match-string 2 string))) + ;;(language (match-string 3 string)) + (value (match-string 4 string))) + (mm-with-multibyte-buffer + (insert value) (goto-char (point-min)) (while (search-forward "%" nil t) (insert (prog1 (string-to-number (buffer-substring (point) (+ (point) 2)) 16) (delete-region (1- (point)) (+ (point) 2))))) - ;; Encode using the charset, if any. - (when (and (mm-multibyte-p) - (> (length elems) 1) - (not (equal (intern (downcase (car elems))) 'us-ascii))) - (mm-decode-coding-region (point-min) (point-max) - (intern (downcase (car elems))))) + ;; Decode using the charset, if any. + (unless (memq coding-system '(nil ascii)) + (mm-decode-coding-region (point-min) (point-max) coding-system)) (buffer-string)))) (defun rfc2231-encode-string (param value) - "Return and PARAM=VALUE string encoded according to RFC2231." + "Return and PARAM=VALUE string encoded according to RFC2231. +Use `mml-insert-parameter' or `mml-insert-parameter-string' to insert +the result of this function." (let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token)) (tspecial (ietf-drums-token-to-list ietf-drums-tspecials)) (special (ietf-drums-token-to-list "*'%\n\t")) (ascii (ietf-drums-token-to-list ietf-drums-text-token)) (num -1) + ;; Don't make lines exceeding 76 column. + (limit (- 74 (length param))) spacep encodep charsetp charset broken) (with-temp-buffer (insert value) ＠＠ -209,28 +269,34 ＠＠ These look like \"us-ascii'en-us'This%20 (when charsetp (setq charset (mm-encode-body))) (cond - ((or encodep charsetp) + ((or encodep charsetp + (progn + (end-of-line) + (> (current-column) (if spacep (- limit 2) limit)))) + (setq limit (- limit 6)) (goto-char (point-min)) + (insert (symbol-name (or charset 'us-ascii)) "''") (while (not (eobp)) - (when (> (current-column) 60) - (insert ";\n") - (setq broken t)) (if (or (not (memq (following-char) ascii)) (memq (following-char) control) (memq (following-char) tspecial) (memq (following-char) special) (eq (following-char) ? )) (progn + (when (>= (current-column) (1- limit)) + (insert ";\n") + (setq broken t)) (insert "%" (format "%02x" (following-char))) (delete-char 1)) + (when (> (current-column) limit) + (insert ";\n") + (setq broken t)) (forward-char 1))) (goto-char (point-min)) - (insert (symbol-name (or charset 'us-ascii)) "''") - (goto-char (point-min)) (if (not broken) (insert param "*=") (while (not (eobp)) - (insert (if (>= num 0) " " "\n ") + (insert (if (>= num 0) " " "") param "*" (format "%d" (incf num)) "*=") (forward-line 1)))) (spacep 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/score-mode.el Index: score-mode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/score-mode.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- score-mode.el 2005/11/15 03:46:00 1.4 +++ score-mode.el 2006/03/16 04:18:07 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; score-mode.el --- mode for editing Gnus score files ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: news, mail 1.5 +29 -13 XEmacs/packages/xemacs-packages/gnus/lisp/smiley.el.upstream Index: smiley.el.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/smiley.el.upstream,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- smiley.el.upstream 2005/11/15 03:46:00 1.4 +++ smiley.el.upstream 2006/03/16 04:18:07 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; smiley.el --- displaying smiley faces ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Dave Love <fx(a)gnu.org> ;; Keywords: news mail multimedia ＠＠ -31,8 +31,21 ＠＠ ;; I'm not sure we need that degree of rococoness and defaults like a ;; yellow background. Also, using PBM means we can display the images ;; more generally. -- fx +;; `smiley.el' was replaced by `smiley-ems.el' on 2002-01-26 (after fx' +;; comment). -;;; Test smileys: :-) :-\ :-( :-/ +;; Test smileys: +;; smile ^:-) ^:) +;; blink ;-) ;) +;; forced :-] +;; braindamaged 8-) +;; indifferent :-| +;; wry :-/ :-\ +;; sad :-( +;; evil >:-) +;; cry ;-( +;; dead X-) +;; grin :-D ;;; Code: ＠＠ -45,8 +58,9 ＠＠ :group 'gnus-visual) ;; Maybe this should go. -(defcustom smiley-data-directory (nnheader-find-etc-directory "images/smilies") - "*Location of the smiley faces files." +(defcustom smiley-data-directory + (nnheader-find-etc-directory "images/smilies") + "Location of the smiley faces files." :type 'directory :group 'smiley) ＠＠ -61,8 +75,8 ＠＠ ("\$:-(\$\\W" 1 "sad") ("\$:-{\$\\W" 1 "frown")) "*A list of regexps to map smilies to images. -The elements are (REGEXP MATCH FILE), where MATCH is the submatch in -regexp to replace with IMAGE. IMAGE is the name of a PBM file in +The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in +regexp to replace with IMAGE. IMAGE is the name of an image file in `smiley-data-directory'." :type '(repeat (list regexp (integer :tag "Regexp match number") ＠＠ -78,7 +92,7 ＠＠ regexp to replace with IMAGE. IMAGE is (when (gnus-image-type-available-p 'xpm) (push "xpm" types)) types) - "*List of suffixes on picon file names to try." + "*List of suffixes on smiley file names to try." :version "22.1" :type '(repeat string) :group 'smiley) ＠＠ -86,6 +100,7 ＠＠ regexp to replace with IMAGE. IMAGE is (defvar smiley-cached-regexp-alist nil) (defun smiley-update-cache () + (setq smiley-cached-regexp-alist nil) (dolist (elt (if (symbolp smiley-regexp-alist) (symbol-value smiley-regexp-alist) smiley-regexp-alist)) ＠＠ -104,12 +119,13 ＠＠ regexp to replace with IMAGE. IMAGE is (push (list (car elt) (cadr elt) image) smiley-cached-regexp-alist))))))) -(defvar smiley-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [down-mouse-2] 'ignore) ; override widget - (define-key map [mouse-2] - 'smiley-mouse-toggle-buffer) - map)) +;; Not implemented: +;; (defvar smiley-mouse-map +;; (let ((map (make-sparse-keymap))) +;; (define-key map [down-mouse-2] 'ignore) ; override widget +;; (define-key map [mouse-2] +;; 'smiley-mouse-toggle-buffer) +;; map)) ;;;###autoload (defun smiley-region (start end) 1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/smime.el Index: smime.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/smime.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -p -r1.7 -r1.8 --- smime.el 2005/11/15 03:46:00 1.7 +++ smime.el 2006/03/16 04:18:07 1.8 ＠＠ -1,7 +1,7 ＠＠ ;;; smime.el --- S/MIME support library ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org> ;; Keywords: SMIME X.509 PEM OpenSSL 1.7 +6 -2 XEmacs/packages/xemacs-packages/gnus/lisp/spam-report.el Index: spam-report.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam-report.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- spam-report.el 2005/11/15 03:46:00 1.6 +++ spam-report.el 2006/03/16 04:18:08 1.7 ＠＠ -1,6 +1,6 ＠＠ ;;; spam-report.el --- Reporting spam -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Teodor Zlatanov <tzz(a)lifelogs.com> ;; Keywords: network ＠＠ -50,7 +50,11 ＠＠ instead." :group 'spam-report) (defcustom spam-report-gmane-use-article-number t - "Whether the article number (faster!) or the header should be used." + "Whether the article number (faster!) or the header should be used. + +You must set this to nil if you don't read Gmane groups directly +from news.gmane.org, e.g. when using local newsserver such as +leafnode." :type 'boolean :group 'spam-report) 1.6 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/spam-stat.el Index: spam-stat.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam-stat.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- spam-stat.el 2005/11/15 03:46:00 1.5 +++ spam-stat.el 2006/03/16 04:18:08 1.6 ＠＠ -1,6 +1,6 ＠＠ ;;; spam-stat.el --- detecting spam based on statistics -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex(a)gnu.org> ;; Keywords: network ＠＠ -323,7 +323,7 ＠＠ Use `spam-stat-ngood', `spam-stat-nbad', ,＠body)) (defun spam-stat-buffer-words () - "Return a hash table of words and number of occurences in the buffer." + "Return a hash table of words and number of occurrences in the buffer." (with-spam-stat-max-buffer-size (with-syntax-table spam-stat-syntax-table (goto-char (point-min)) 1.7 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/spam.el Index: spam.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- spam.el 2005/11/15 03:46:01 1.6 +++ spam.el 2006/03/16 04:18:08 1.7 ＠＠ -1,6 +1,6 ＠＠ ;;; spam.el --- Identifying spam -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Keywords: network 1.5 +3 -2 XEmacs/packages/xemacs-packages/gnus/lisp/time-date.el Index: time-date.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/time-date.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- time-date.el 2005/11/15 03:46:01 1.4 +++ time-date.el 2006/03/16 04:18:08 1.5 ＠＠ -1,6 +1,7 ＠＠ ;;; time-date.el --- Date and time handling functions -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; Masanobu Umeda <umerin(a)mse.kyutech.ac.jp> 1.6 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/utf7.el Index: utf7.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/utf7.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -p -r1.5 -r1.6 --- utf7.el 2005/11/15 03:46:01 1.5 +++ utf7.el 2006/03/16 04:18:08 1.6 ＠＠ -1,7 +1,7 ＠＠ ;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*- ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Jon K Hellan <hellan(a)acm.org> ;; Maintainer: bugs(a)gnus.org ＠＠ -80,7 +80,7 ＠＠ (defconst utf7-utf-16-coding-system (cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS 'utf-16-be-no-signature) - ((and (mm-coding-system-p 'utf-16-be) ; Emacs 22.1 + ((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.3, Emacs 22 ;; Avoid versions with BOM. (= 2 (length (encode-coding-string "a" 'utf-16-be)))) 'utf-16-be) 1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/uudecode.el Index: uudecode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/uudecode.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- uudecode.el 2005/11/15 03:46:01 1.4 +++ uudecode.el 2006/03/16 04:18:08 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; uudecode.el -- elisp native uudecode ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: uudecode news 1.5 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/webmail.el Index: webmail.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/webmail.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- webmail.el 2005/11/15 03:46:01 1.4 +++ webmail.el 2006/03/16 04:18:08 1.5 ＠＠ -1,7 +1,7 ＠＠ ;;; webmail.el --- interface of web mail ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh(a)cs.rochester.edu> ;; Keywords: hotmail netaddress my-deja netscape ＠＠ -637,7 +637,7 ＠＠ (goto-char (point-min)) (delete-blank-lines) (setq ct (mail-fetch-field "content-type") - ctl (ignore-errors (mail-header-parse-content-type ct)) + ctl (and ct (mail-header-parse-content-type ct)) ;;cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") 1.4 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/yenc.el Index: yenc.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/yenc.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- yenc.el 2005/11/15 03:46:02 1.3 +++ yenc.el 2006/03/16 04:18:09 1.4 ＠＠ -1,6 +1,6 ＠＠ ;;; yenc.el --- elisp native yenc decoder -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Jesper Harder <harder(a)ifa.au.dk> ;; Keywords: yenc news 1.10 +104 -28 XEmacs/packages/xemacs-packages/gnus/texi/ChangeLog.upstream Index: ChangeLog.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/ChangeLog.upstream,v retrieving revision 1.9 retrieving revision 1.10 diff -u -p -r1.9 -r1.10 --- ChangeLog.upstream 2006/01/04 07:05:34 1.9 +++ ChangeLog.upstream 2006/03/16 04:19:47 1.10 ＠＠ -1,3 +1,79 ＠＠ +2006-03-10 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi (NoCeM): Mention gnus-use-nocem can also be a number. + +2006-03-10 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.texi (Fancy Mail Splitting): Improve sentences so as to be + easy to understand. + +2006-03-09 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi: Markup fix. + (Fancy Mail Splitting): Specify new feature. + +2006-03-08 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi (Fancy Mail Splitting): Improve descriptions about + partial-words matching. + +2006-03-07 Reiner Steib <Reiner.Steib(a)gmx.de> + + * emacs-mime.texi (Display Customization): Reword image/.* stuff. + + * gnus.texi (Oort Gnus): Add note about `gnus-load'. + (MIME Commands): Fix mm-discouraged-alternatives. + +2006-03-03 Reiner Steib <Reiner.Steib(a)gmx.de> + + * xemacs.mak: Remove outdated file. Use make.bat instead. + + * gnus.texi (Oort Gnus): Add `mm-fill-flowed'. + +2006-02-27 Simon Josefsson <jas(a)extundo.com> + + * emacs-mime.texi (Flowed text): Add mm-fill-flowed. (Sync + 2004-01-27 from the trunk). + +2006-02-09 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.texi (Gnus Versions): Add history beyond start of Oort. + +2006-01-31 Romain Francoise <romain(a)orebokech.com> + + * message.texi (Message Headers): Explain what + `message-alternative-emails' does in more detail. + Update copyright year. + +2006-01-26 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * ps/Makefile.in (distclean): Remove Makefile. + + * Makefile.in (almost-clean): Rename from clean. + (clean): Rename from veryclean. + (distclean): Use clean. + (pspackage): Use almost-clean. + +2006-01-16 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi: Update copyright. + +2006-01-13 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi (Article Washing): Additions. + +2006-01-08 Alex Schroeder <alex(a)gnu.org> + + * pgg.texi (Caching passphrase): Rewording. + +2006-01-10 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi (RSS): Document nnrss-wash-html-in-text-plain-parts. + +2006-01-06 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi (RSS): Addition. + 2005-12-22 Katsumi Yamaoka <yamaoka(a)jpl.org> * gnus.texi (Summary Post Commands): Fix function bound to `S O p'. ＠＠ -83,7 +159,7 ＠＠ 2005-11-01 Katsumi Yamaoka <yamaoka(a)jpl.org> - * gnus.texi (Group Parameters): Mention new varable + * gnus.texi (Group Parameters): Mention new variable gnus-parameters-case-fold-search. (Home Score File): Addition. ＠＠ -272,7 +348,7 ＠＠ * gnus.texi (RSS): Fix the keystroke. -2005-01-16 Xavier Maillard <zedek(a)gnu-rox.org> (tiny change) +2005-01-16 Xavier Maillard <zedek(a)gnu-rox.org> (tiny change) * gnus-faq.texi ([4.1]): Typo. ＠＠ -546,7 +622,7 ＠＠ * gnus.texi (Group Parameters): Clarify. -2003-12-11 Kevin Greiner <kgreiner(a)xpediantsolutions.com> +2003-12-11 Kevin Greiner <kgreiner(a)xpediantsolutions.com> * gnus.texi (Agent Parameters): Added references in Topic and Group Parameters. Added gnus-agent-cat-disable-undownloaded-faces ＠＠ -793,11 +869,13 ＠＠ * gnus.texi (Filtering Spam Using The Spam ELisp Package): mentioned the spam-install-hooks mess +2003-07-11 Matthias Andree <ma(a)dt.e-technik.uni-dortmund.de> (tiny change) + + * gnus.texi (Splitting in IMAP): Typos. + 2003-07-11 Simon Josefsson <jas(a)extundo.com> - * gnus.texi (Splitting in IMAP): Typos, tiny patch from Matthias - Andree <ma(a)dt.e-technik.uni-dortmund.de>. - (Splitting in IMAP): Mention Sieve. + * gnus.texi (Splitting in IMAP): Mention Sieve. 2003-07-10 Simon Josefsson <jas(a)extundo.com> ＠＠ -923,12 +1001,11 ＠＠ * message.texi (Insertion Variables): do. -2003-05-13 Simon Josefsson <jas(a)extundo.com> +2003-05-13 Niklas Morberg <niklas.morberg(a)axis.com> (tiny change) - * gnus.texi (IMAP, Agent and IMAP, Oort Gnus): s/a/an/. Tiny - patch from Niklas Morberg <niklas.morberg(a)axis.com>. + * gnus.texi (IMAP, Agent and IMAP, Oort Gnus): s/a/an/. -2003-05-12 Kevin Greiner <kgreiner(a)xpediantsolutions.com> +2003-05-12 Kevin Greiner <kgreiner(a)xpediantsolutions.com> * gnus.texi (Agent Visuals): Add. ＠＠ -1183,7 +1260,7 ＠＠ * message.texi (IDNA): New. -2003-03-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> +2003-03-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> * gnus.texi (Gnus Unplugged): Refer to new agent Group/Topic parameters. ＠＠ -1221,10 +1298,9 ＠＠ * gnus.texi (Required Back End Functions): Add. -2003-03-17 Simon Josefsson <jas(a)extundo.com> +2003-03-17 Frank Haun <pille3003(a)fhaun.de> (tiny change) - * pgg.texi: Fix setfilename. Tiny patch by Frank Haun - <pille3003(a)fhaun.de>. + * pgg.texi: Fix setfilename. 2003-03-09 Paul Jarc <prj(a)po.cwru.edu> ＠＠ -1260,7 +1336,7 ＠＠ (Document Server Internals, Score Variables, Adaptive Scoring) (X-Face, Hashcash): do. -2003-02-28 Vasily Korytov <deskpot(a)myrealbox.com> +2003-02-28 Vasily Korytov <deskpot(a)myrealbox.com> * gnus.texi: New values, 'to-list and 'cc-list, for gnus-boring-article-headers. ＠＠ -2142,7 +2218,7 ＠＠ * gnus.texi (Mail Spool): Add cindex for marks. (Mail Folders): Add cindex for marks. -2002-03-24 Raymond Scholz <rscholz(a)zonix.de> +2002-03-24 Raymond Scholz <rscholz(a)zonix.de> * gnus.texi (Summary Buffer Lines): Fix doc. ＠＠ -2150,7 +2226,7 ＠＠ * Makefile.in (booklet.dvi, booklet.pdf): Support booklet. -2002-03-24 Felix Natter <fnatter(a)gmx.net> +2002-03-24 Felix Natter <fnatter(a)gmx.net> * booklet.tex, bk-at.tex, bk-lt.tex, gnuslog-booklet.eps: New file. * gnusref.tex, refcard.tex: Support booklet. ＠＠ -2180,7 +2256,7 ＠＠ * message.texi (Security): Add mml-unsecure-message. (Mailing Lists): Index message-goto-mail-followup-to. -2002-03-23 Jesper Harder <harder(a)ifa.au.dk> +2002-03-23 Jesper Harder <harder(a)ifa.au.dk> * gnusref.tex, refcard.tex: Addition. ＠＠ -2259,7 +2335,7 ＠＠ * gnus.texi (Mail Source Specifiers): Use ＠uref. -2002-02-13 Jesper Harder <harder(a)ifa.au.dk> +2002-02-13 Jesper Harder <harder(a)ifa.au.dk> * message.texi, gnus.texi, emacs-mime.texi: Use small caps consistently. MIME, NOV, NNTP, HTML, IMAP are written with ＠sc ＠＠ -3329,11 +3405,11 ＠＠ * gnus.texi (Sorting Groups): Note `C-k' and `C-y' for manually moving groups around. -2001-04-07 Ryan Yeske <rcyeske(a)vcn.bc.ca> +2001-04-07 Ryan Yeske <rcyeske(a)vcn.bc.ca> * gnus.texi (Splitting in IMAP): Fix. -2001-04-07 Jesper Harder <harder(a)ifa.au.dk> +2001-04-07 Jesper Harder <harder(a)ifa.au.dk> * gnus.texi (More Threading): Fix. ＠＠ -3456,7 +3532,7 ＠＠ * gnus.texi (Top): Add Using GPG. -2001-02-02 David Masterson <dmasters(a)Rational.Com> +2001-02-02 David Masterson <dmasters(a)Rational.Com> * gnus.texi (The Server is Down): Add link to Group Levels. ＠＠ -3475,7 +3551,7 ＠＠ * message.texi (message-ignored-news-headers): Add "X-Draft-From:". (message-ignored-mail-headers): Ditto. -2001-01-21 Raymond Scholz <ray-2001(a)zonix.de> +2001-01-21 Raymond Scholz <ray-2001(a)zonix.de> * message.texi: Rename X-Mailer and X-Newsreader to User-Agent. ＠＠ -3491,7 +3567,7 ＠＠ * emacs-mime.texi: Set dircategory to Emacs. -2001-01-16 Jesper Harder <harder(a)ifa.au.dk> +2001-01-16 Jesper Harder <harder(a)ifa.au.dk> * gnus.texi (Group Line Specification): Add. ＠＠ -3660,7 +3736,7 ＠＠ group names as target, where `gnus-split-methods' uses file names. Suggested by Nevin Kapur. -2000-11-07 Martin Buchholz <martin(a)xemacs.org> +2000-11-07 Martin Buchholz <martin(a)xemacs.org> * gnus.texi: Doc fix. ＠＠ -3673,7 +3749,7 ＠＠ * gnus.texi (Finding the News): ＠env is not supported in texinfo 3.12. -2000-10-31 Jorge Godoy <godoy(a)conectiva.com> +2000-10-31 Jorge Godoy <godoy(a)conectiva.com> * gnus.texi: gnus-gpg document. ＠＠ -3812,7 +3888,7 ＠＠ Explain interaction between these. Add Lisp example for setting `nnmail-expiry-target'. -2000-08-04 Andreas Oeldenberger <andreas.oeldenberger(a)gmx.net> +2000-08-04 Andreas Oeldenberger <andreas.oeldenberger(a)gmx.net> * message.texi (Forwarding): Fix. ＠＠ -3969,7 +4045,7 ＠＠ * gnus.texi (MIME Commands): Fix. -2000-01-03 Karl Kleinpaste <karl(a)justresearch.com> +2000-01-03 Karl Kleinpaste <karl(a)justresearch.com> * gnus.texi (Splitting in IMAP): Add '.' after ＠xref. 1.9 +13 -8 XEmacs/packages/xemacs-packages/gnus/texi/emacs-mime.texi Index: emacs-mime.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/emacs-mime.texi,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- emacs-mime.texi 2006/01/04 07:05:35 1.8 +++ emacs-mime.texi 2006/03/16 04:19:47 1.9 ＠＠ -9,7 +9,7 ＠＠＠copying This file documents the Emacs MIME interface functionality. -Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ＠quotation ＠＠ -322,13 +322,14 ＠＠ you could say something like: (remove "text/html" mm-automatic-display)) ＠end lisp -Adding ＠code{"image/.*"} might also be useful. Spammers use it as the -prefered part of ＠samp{multipart/alternative} messages, and you might +Adding ＠code{"image/.*"} might also be useful. Spammers use images as +the prefered part of ＠samp{multipart/alternative} messages, so you might not notice there are other parts. See also -＠code{gnus-buttonized-mime-types} (＠pxref{MIME Commands, ,MIME Commands, -gnus, Gnus Manual}), to which adding ＠code{"multipart/alternative"} -enables you to choose manually one of two types those mails include. -For example, you can set those variables like: +＠code{gnus-buttonized-mime-types}, ＠ref{MIME Commands, ,MIME Commands, +gnus, Gnus Manual}. After adding ＠code{"multipart/alternative"} to +＠code{gnus-buttonized-mime-types} you can choose manually which +alternative you'd like to view. For example, you can set those +variables like: ＠lisp (setq gnus-buttonized-mime-types ＠＠ -983,7 +984,11 ＠＠ together and wrapped after the column de ＠code{fill-flowed-display-column}. The default is to wrap after ＠code{fill-column}. - +＠table ＠code +＠item mm-fill-flowed +＠vindex mm-fill-flowed +If non-＠code{nil} a format=flowed article will be displayed flowed. +＠end table ＠node Interface Functions 1.12 +139 -47 XEmacs/packages/xemacs-packages/gnus/texi/gnus.texi Index: gnus.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnus.texi,v retrieving revision 1.11 retrieving revision 1.12 diff -u -p -r1.11 -r1.12 --- gnus.texi 2006/01/04 07:05:35 1.11 +++ gnus.texi 2006/03/16 04:19:47 1.12 ＠＠ -8,7 +8,7 ＠＠＠copying Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, - 2002, 2003, 2004, 2005 Free Software Foundation, Inc. + 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ＠quotation Permission is granted to copy, distribute and/or modify this document ＠＠ -8571,7 +8571,9 ＠＠ Treat ＠acronym{HTML} (＠code{gnus-article usually done automatically by Gnus if the message in question has a ＠code{Content-Type} header that says that the message is ＠acronym{HTML}. -If a prefix is given, a charset will be asked for. +If a prefix is given, a charset will be asked for. If it is a number, +the charset defined in ＠code{gnus-summary-show-article-charset-alist} +(＠pxref{Paging the Article}) will be used. ＠vindex gnus-article-wash-function The default is to use the function specified by ＠＠ -8582,12 +8584,15 ＠＠ Customization, emacs-mime, The Emacs MIM can use include: ＠table ＠code -＠item W3 +＠item w3 Use Emacs/W3. ＠item w3m Use ＠uref{http://emacs-w3m.namazu.org/, emacs-w3m}. +＠item w3m-standalone +Use ＠uref{http://w3m.sourceforge.net/, w3m}. + ＠item links Use ＠uref{http://links.sf.net/, Links}. ＠＠ -9364,10 +9369,10 ＠＠ Display "multipart/alternative" parts as Display "multipart/related" parts as "multipart/mixed". If displaying "text/html" is discouraged, see -＠code{mm-discouraged-alternatives} in ＠ref{Display Customization, -Display Customization, , emacs-mime, Emacs-Mime Manual}. Images or -other material inside a "multipart/related" part might be overlooked -when this variable is ＠code{nil}. +＠code{mm-discouraged-alternatives}, images or other material inside a +"multipart/related" part might be overlooked when this variable is +＠code{nil}. ＠ref{Display Customization, Display Customization, , +emacs-mime, Emacs-Mime Manual}. ＠vindex gnus-mime-display-multipart-as-mixed ＠item gnus-mime-display-multipart-as-mixed ＠＠ -14001,13 +14006,22 ＠＠ splits. Here are the possible split syn If the split is a string, that will be taken as a group name. Normal regexp match expansion will be done. See below for examples. -＠item (＠var{field} ＠var{value} [- ＠var{restrict} [＠dots{}] ] ＠var{split}) -If the split is a list, the first element of which is a string, then -store the message as specified by ＠var{split}, if header ＠var{field} -(a regexp) contains ＠var{value} (also a regexp). If ＠var{restrict} -(yet another regexp) matches some string after ＠var{field} and before -the end of the matched ＠var{value}, the ＠var{split} is ignored. If -none of the ＠var{restrict} clauses match, ＠var{split} is processed. +＠c Don't fold this line. +＠item (＠var{field} ＠var{value} [- ＠var{restrict} [＠dots{}] ] ＠var{split} [＠var{invert-partial}]) +The split can be a list containing at least three elements. If the +first element ＠var{field} (a regexp matching a header) contains +＠var{value} (also a regexp) then store the message as specified by +＠var{split}. + +If ＠var{restrict} (yet another regexp) matches some string after +＠var{field} and before the end of the matched ＠var{value}, the +＠var{split} is ignored. If none of the ＠var{restrict} clauses match, +＠var{split} is processed. + +The last element ＠var{invert-partial} is optional. If it is +non-＠code{nil}, the match-partial-words behavior controlled by the +variable ＠code{nnmail-split-fancy-match-partial-words} (see below) is +be inverted. (New in Gnus 5.10.7) ＠item (| ＠var{split} ＠dots{}) If the split is a list, and the first element is ＠code{|} (vertical ＠＠ -14062,11 +14076,50 ＠＠ If the split is ＠code{nil}, it is ignore ＠end table In these splits, ＠var{field} must match a complete field name. -＠var{value} must match a complete word according to the fundamental mode -syntax table. You can use ＠code{.*} in the regexps to match partial -field names or words. In other words, all ＠var{value}'s are wrapped in -＠samp{\<} and ＠samp{\>} pairs. +Normally, ＠var{value} in these splits must match a complete ＠emph{word} +according to the fundamental mode syntax table. In other words, all +＠var{value}'s will be implicitly surrounded by ＠code{\<...\>} markers, +which are word delimiters. Therefore, if you use the following split, +for example, + +＠example +(any "joe" "joemail") +＠end example + +＠noindent +messages sent from ＠samp{joedavis＠(a)foo.org} will normally not be filed +in ＠samp{joemail}. If you want to alter this behavior, you can use any +of the following three ways: + +＠enumerate +＠item +＠vindex nnmail-split-fancy-match-partial-words +You can set the ＠code{nnmail-split-fancy-match-partial-words} variable +to non-＠code{nil} in order to ignore word boundaries and instead the +match becomes more like a grep. This variable controls whether partial +words are matched during fancy splitting. The default value is +＠code{nil}. + +Note that it influences all ＠var{value}'s in your split rules. + +＠item +＠var{value} beginning with ＠code{.*} ignores word boundaries in front of +a word. Similarly, if ＠var{value} ends with ＠code{.*}, word boundaries +in the rear of a word will be ignored. For example, the ＠var{value} +＠code{"＠(a)example\\.com"} does not match ＠samp{foo＠(a)example.com} but +＠code{".*＠(a)example\\.com"} does. + +＠item +You can set the ＠var{invert-partial} flag in your split rules of the +＠samp{(＠var{field} ＠var{value} ＠dots{})} types, aforementioned in this +section. If the flag is set, word boundaries on both sides of a word +are ignored even if ＠code{nnmail-split-fancy-match-partial-words} is +＠code{nil}. Contrarily, if the flag is set, word boundaries are not +ignored even if ＠code{nnmail-split-fancy-match-partial-words} is +non-＠code{nil}. (New in Gnus 5.10.7) +＠end enumerate + ＠vindex nnmail-split-abbrev-alist ＠var{field} and ＠var{value} can also be Lisp symbols, in that case they are expanded as specified by the variable ＠＠ -14113,25 +14166,6 ＠＠ groups when users send to an address usi (i.e. mailing-list＠＠domain vs Mailing-List＠＠Domain). The default value is ＠code{t}. -＠vindex nnmail-split-fancy-match-partial-words -＠code{nnmail-split-fancy-match-partial-words} controls whether partial -words are matched during fancy splitting. - -Normally, regular expressions given in ＠code{nnmail-split-fancy} are -implicitly surrounded by ＠code{\<...\>} markers, which are word -delimiters. If this variable is true, they are not implicitly -surrounded by anything. - -＠example -(any "joe" "joemail") -＠end example - -In this example, messages sent from ＠samp{joedavis＠(a)foo.org} will -normally not be filed in ＠samp{joemail}. With -＠code{nnmail-split-fancy-match-partial-words} set to ＠code{t}, -however, the match will happen. In effect, the requirement of a word -boundary is removed and instead the match becomes more like a grep. - ＠findex nnmail-split-fancy-with-parent ＠code{nnmail-split-fancy-with-parent} is a function which allows you to split followups into the same groups their parents are in. Sometimes ＠＠ -15886,6 +15920,10 ＠＠ the value of ＠code{default-file-name-cod XEmacs and want to use non-＠acronym{ASCII} group names, you should set the value for the ＠code{nnmail-pathname-coding-system} variable properly. +The ＠code{nnrss} back end generates ＠samp{multipart/alternative} +＠acronym{MIME} articles in which each contains a ＠samp{text/plain} part +and a ＠samp{text/html} part. + ＠cindex OPML You can also use the following commands to import and export your subscriptions from a file in ＠acronym{OPML} format (Outline Processor ＠＠ -15923,6 +15961,15 ＠＠ If you set ＠code{nnrss-use-local} to ＠co the feeds from local files in ＠code{nnrss-directory}. You can use the command ＠code{nnrss-generate-download-script} to generate a download script using ＠command{wget}. + +＠item nnrss-wash-html-in-text-plain-parts +Non-＠code{nil} means that ＠code{nnrss} renders text in ＠samp{text/plain} +parts as ＠acronym{HTML}. The function specified by the +＠code{mm-text-html-renderer} variable (＠pxref{Display Customization, +,Display Customization, emacs-mime, The Emacs MIME Manual}) will be used +to render text. If it is ＠code{nil}, which is the default, text will +simply be folded. Leave it ＠code{nil} if you prefer to see +＠samp{text/html} parts. ＠end table The following code may be helpful, if you want to show the description in ＠＠ -15940,6 +15987,7 ＠＠ the summary buffer. The following code may be useful to open an nnrss url directly from the summary buffer. + ＠lisp (require 'browse-url) ＠＠ -15962,6 +16010,31 ＠＠ summary buffer. (add-to-list 'nnmail-extra-headers nnrss-url-field) ＠end lisp +Even if you have added ＠code{"text/html"} to the +＠code{mm-discouraged-alternatives} variable (＠pxref{Display +Customization, ,Display Customization, emacs-mime, The Emacs MIME +Manual}) since you don't want to see ＠acronym{HTML} parts, it might be +more useful especially in ＠code{nnrss} groups to display +＠samp{text/html} parts. Here's an example of setting +＠code{mm-discouraged-alternatives} as a group parameter (＠pxref{Group +Parameters}) in order to display ＠samp{text/html} parts only in +＠code{nnrss} groups: + +＠lisp +;; ＠r{Set the default value of ＠code{mm-discouraged-alternatives}.} +(eval-after-load "gnus-sum" + '(add-to-list + 'gnus-newsgroup-variables + '(mm-discouraged-alternatives + . '("text/html" "image/.*")))) + +;; ＠r{Display ＠samp{text/html} parts in ＠code{nnrss} groups.} +(add-to-list + 'gnus-parameters + '("\\`nnrss:" (mm-discouraged-alternatives nil))) +＠end lisp + + ＠node Customizing W3 ＠subsection Customizing W3 ＠cindex W3 ＠＠ -21722,6 +21795,15 ＠＠ There are some variables to customize, o Set this variable to ＠code{t} to set the ball rolling. It is ＠code{nil} by default. +You can also set this variable to a positive number as a group level. +In that case, Gnus scans NoCeM messages when checking new news if this +value is not exceeding a group level that you specify as the prefix +argument to some commands, e.g. ＠code{gnus}, +＠code{gnus-group-get-new-news}, etc. Otherwise, Gnus does not scan +NoCeM messages if you specify a group level to those commands. For +example, if you use 1 or 2 on the mail groups and the levels on the news +groups remain the default, 3 is the best choice. + ＠item gnus-nocem-groups ＠vindex gnus-nocem-groups Gnus will look for NoCeM messages in the groups in this list. The ＠＠ -22251,11 +22333,11 ＠＠ default. ＠item gnus-use-toolbar ＠vindex gnus-use-toolbar This variable specifies the position to display the toolbar. If -＠code{nil}, don't display toolbars. If it is non-nil, it should be one -of the symbols ＠code{default}, ＠code{top}, ＠code{bottom}, ＠code{right}, -and ＠code{left}. ＠code{default} means to use the default toolbar, the -rest mean to display the toolbar on the place which those names show. -The default is ＠code{default}. +＠code{nil}, don't display toolbars. If it is non-＠code{nil}, it should +be one of the symbols ＠code{default}, ＠code{top}, ＠code{bottom}, +＠code{right}, and ＠code{left}. ＠code{default} means to use the default +toolbar, the rest mean to display the toolbar on the place which those +names show. The default is ＠code{default}. ＠item gnus-toolbar-thickness ＠vindex gnus-toolbar-thickness ＠＠ -24502,15 +24584,18 ＠＠ It was released as ``Gnus 5.6'' on March Gnus 5.6 begat Pterodactyl Gnus on August 29th 1998 and was released as ``Gnus 5.8'' (after 99 releases and a CVS repository) on December 3rd 1999. + +On the 26th of October 2000, Oort Gnus was begun and was released as +Gnus 5.10 on May 1st 2003 (24 releases). -On the 26th of October 2000, Oort Gnus was begun. +On the January 4th 2004, No Gnus was begun. If you happen upon a version of Gnus that has a prefixed name -- ``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'', -``Pterodactyl Gnus'', ``Oort Gnus'' -- don't panic. Don't let it know -that you're frightened. Back away. Slowly. Whatever you do, don't -run. Walk away, calmly, until you're out of its reach. Find a proper -released version of Gnus and snuggle up to that instead. +``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic. +Don't let it know that you're frightened. Back away. Slowly. Whatever +you do, don't run. Walk away, calmly, until you're out of its reach. +Find a proper released version of Gnus and snuggle up to that instead. ＠node Other Gnus Versions ＠＠ -26174,6 +26259,8 ＠＠ groups. A new file from Raymond Scholz ＠email{rscholz＠(a)zonix.de} for deuglifying broken Outlook (Express) articles. +＠c FIXME: `gnus-load' is mentioned in README, which is not included in +＠c CVS. We should find a better place for this item. ＠item ＠code{(require 'gnus-load)} ＠＠ -26260,6 +26347,11 ＠＠ Gnus supports the ``format=flowed'' (RFC composing messages, it is enabled by ＠code{use-hard-newlines}. Decoding format=flowed was present but not documented in earlier versions. + +＠item +The option ＠code{mm-fill-flowed} can be used to disable treatment of +``format=flowed'' messages. Also, flowed text is disabled when sending +inline PGP signed messages. (New in Gnus 5.10.7) ＠item Gnus supports the generation of RFC 2298 Disposition Notification requests. 1.9 +18 -3 XEmacs/packages/xemacs-packages/gnus/texi/message.texi Index: message.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/message.texi,v retrieving revision 1.8 retrieving revision 1.9 diff -u -p -r1.8 -r1.9 --- message.texi 2005/12/19 13:35:33 1.8 +++ message.texi 2006/03/16 04:19:49 1.9 ＠＠ -9,7 +9,7 ＠＠ This file documents Message, the Emacs message composition mode. Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. ＠quotation Permission is granted to copy, distribute and/or modify this document ＠＠ -1386,8 +1386,23 ＠＠ trailing old subject. In this case, ＠item message-alternative-emails ＠vindex message-alternative-emails -A regexp to match the alternative email addresses. The first matched -address (not primary one) is used in the ＠code{From} field. +Regexp matching alternative email addresses. The first address in the +To, Cc or From headers of the original article matching this variable is +used as the From field of outgoing messages, replacing the default From +value. + +For example, if you have two secondary email addresses john＠(a)home.net +and john.doe＠(a)work.com and want to use them in the From field when +composing a reply to a message addressed to one of them, you could set +this variable like this: + +＠lisp +(setq message-alternative-emails + (regexp-opt '("john＠(a)home.net" "john.doe＠(a)work.com"))) +＠end lisp + +This variable has precedence over posting styles and anything that runs +off ＠code{message-setup-hook}. ＠item message-allow-no-recipients ＠vindex message-allow-no-recipients

1 participants
0 comments

CVS update by viteno xemacs ... 18 years, 2 months

CVS Monitor

User: viteno Date: 06/03/15 23:51:44 Modified: xemacs version.sh Log: Update xemacs_extra_name. Revision Changes Path 1.1469 +1 -1 XEmacs/xemacs/version.sh Index: version.sh =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/version.sh,v retrieving revision 1.1468 retrieving revision 1.1469 diff -u -p -r1.1468 -r1.1469 --- version.sh 2006/03/14 22:51:13 1.1468 +++ version.sh 2006/03/15 22:51:42 1.1469 ＠＠ -8,5 +8,5 ＠＠ emacs_kit_version= infodock_major_version=4 infodock_minor_version=0 infodock_build_version=8 -xemacs_extra_name="(+CVS-20060314)" +xemacs_extra_name="(+CVS-20060315)" xemacs_release_date="2006-02-26"

1 participants
0 comments

CVS update by viteno xemacs-builds/viteno ... 18 years, 2 months

CVS Monitor

User: viteno Date: 06/03/15 07:10:16 Modified: xemacs-builds/viteno package-index setup-packages.ini Log: Package database backup: - haskell-mode-1.08 Revision Changes Path 1.283 +8 -8 XEmacs/xemacs-builds/viteno/package-index Index: package-index =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/package-index,v retrieving revision 1.282 retrieving revision 1.283 diff -u -p -r1.282 -r1.283 --- package-index 2006/03/14 08:54:24 1.282 +++ package-index 2006/03/15 06:10:15 1.283 ＠＠ -524,20 +524,20 ＠＠ (package-get-update-base-entry (quote (haskell-mode (standards-version 1.1 - version "1.07" - author-version "1.45" - date "2004-06-16" - build-date "2004-06-16" + version "1.08" + author-version "2.1" + date "2006-03-15" + build-date "2006-03-15" maintainer "Jerry James <james(a)xemacs.org>" distribution xemacs priority low category "standard" dump nil description "Haskell editing support." - filename "haskell-mode-1.07-pkg.tar.gz" - md5sum "20d1ff41a4b753a276affd60850b08e7" - size 97642 - provides (haskell-decl-scan haskell-doc haskell-font-lock haskell-indent haskell-mode haskell-simple-indent) + filename "haskell-mode-1.08-pkg.tar.gz" + md5sum "c82d384e06ddd0fe6ed4ffba7fb2208a" + size 109952 + provides (haskell-decl-scan haskell-doc haskell-font-lock haskell-ghci haskell-hugs haskell-indent haskell-mode haskell-simple-indent inf-haskell) requires (dired mail-lib xemacs-base edit-utils) type regular )) 1.271 +2 -2 XEmacs/xemacs-builds/viteno/setup-packages.ini Index: setup-packages.ini =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/setup-packages.ini,v retrieving revision 1.270 retrieving revision 1.271 diff -u -p -r1.270 -r1.271 --- setup-packages.ini 2006/03/14 08:54:24 1.270 +++ setup-packages.ini 2006/03/15 06:10:16 1.271 ＠＠ -364,8 +364,8 ＠＠ version: 1.09 install: packages/xslide-1.09-pkg.tar.gz 39199 ＠ haskell-mode -version: 1.07 -install: packages/haskell-mode-1.07-pkg.tar.gz 97642 +version: 1.08 +install: packages/haskell-mode-1.08-pkg.tar.gz 109952 ＠ sml-mode version: 0.12

1 participants
0 comments

CVS update by viteno packages/xemacs-packages/haskell-mode ... 18 years, 2 months

CVS Monitor

User: viteno Date: 06/03/15 07:07:25 Modified: packages/xemacs-packages/haskell-mode ChangeLog Makefile Log: Increment VERSION in Makefile Revision Changes Path 1.23 +4 -0 XEmacs/packages/xemacs-packages/haskell-mode/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/ChangeLog,v retrieving revision 1.22 retrieving revision 1.23 diff -u -p -r1.22 -r1.23 --- ChangeLog 2006/03/15 05:18:22 1.22 +++ ChangeLog 2006/03/15 06:07:24 1.23 ＠＠ -1,3 +1,7 ＠＠ +2006-03-15 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.08 released. + 2006-03-14 Jerry James <james(a)xemacs.org> * .emacs: Remove. 1.21 +1 -1 XEmacs/packages/xemacs-packages/haskell-mode/Makefile Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/Makefile,v retrieving revision 1.20 retrieving revision 1.21 diff -u -p -r1.20 -r1.21 --- Makefile 2006/03/15 05:18:22 1.20 +++ Makefile 2006/03/15 06:07:24 1.21 ＠＠ -17,7 +17,7 ＠＠ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -VERSION = 1.07 +VERSION = 1.08 AUTHOR_VERSION = 2.1 MAINTAINER = Jerry James <james(a)xemacs.org> PACKAGE = haskell-mode

1 participants
0 comments

CVS update by viteno packages ... 18 years, 2 months

CVS Monitor

User: viteno Date: 06/03/15 07:07:08 Modified: packages ChangeLog Log: Package release Revision Changes Path 1.607 +4 -0 XEmacs/packages/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/ChangeLog,v retrieving revision 1.606 retrieving revision 1.607 diff -u -p -r1.606 -r1.607 --- ChangeLog 2006/03/14 08:46:24 1.606 +++ ChangeLog 2006/03/15 06:07:08 1.607 ＠＠ -1,3 +1,7 ＠＠ +2006-03-15 Norbert Koch <viteno(a)xemacs.org> + + * Packages released: haskell-mode. + 2006-03-14 Norbert Koch <viteno(a)xemacs.org> * Packages released: jde.

1 participants
0 comments

CVS update by james packages/xemacs-packages/haskell-mode, fontlock.hs, haskell-font-lock.el, haskell-hugs.el, haskell-simple-indent.el, installation-guide.html ... 18 years, 2 months

CVS Monitor

User: james Date: 06/03/15 06:18:28 Modified: packages/xemacs-packages/haskell-mode ChangeLog Makefile fontlock.hs haskell-decl-scan.el haskell-doc.el haskell-font-lock.el haskell-ghci.el haskell-hugs.el haskell-indent.el haskell-mode.el haskell-simple-indent.el indent.hs index.html installation-guide.html package-info.in Added: packages/xemacs-packages/haskell-mode ChangeLog.upstream Makefile.upstream NEWS inf-haskell.el Removed: packages/xemacs-packages/haskell-mode .emacs Log: Update haskell-mode to upstream version 2.1. See the xemacs-patches message with message ID <m37j6w70gs.fsf(a)jerrypc.cs.usu.edu>. Revision Changes Path 1.22 +25 -0 XEmacs/packages/xemacs-packages/haskell-mode/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/ChangeLog,v retrieving revision 1.21 retrieving revision 1.22 diff -u -p -r1.21 -r1.22 --- ChangeLog 2004/06/16 15:52:15 1.21 +++ ChangeLog 2006/03/15 05:18:22 1.22 ＠＠ -1,3 +1,28 ＠＠ +2006-03-14 Jerry James <james(a)xemacs.org> + + * .emacs: Remove. + * ChangeLog.upstream: New file. + * Makefile: Update AUTHOR_VERSION. Add rule for new + inf-haskell.el. Put text files in EXTRA_SOURCES. + * Makefile.upstream: New file. + * NEWS: New file. + * package-info.in: Update provides. + + * fontlock.hs: + * haskell-decl-scan.el: + * haskell-doc.el: + * haskell-font-lock.el: + * haskell-ghci.el: + * haskell-hugs.el: + * haskell-indent.el: + * haskell-mode.el: + * haskell-simple-indent.el: + * inf-haskell.el: + * indent.hs: Sync with upstream version 2.1. + + * index.html: Ditto, with small changes to make onsgmls like it. + * installation-guide.html: Ditto, also with small changes. + 2004-06-16 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.07 released. 1.20 +4 -2 XEmacs/packages/xemacs-packages/haskell-mode/Makefile Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/Makefile,v retrieving revision 1.19 retrieving revision 1.20 diff -u -p -r1.19 -r1.20 --- Makefile 2004/06/16 15:52:15 1.19 +++ Makefile 2006/03/15 05:18:22 1.20 ＠＠ -18,7 +18,7 ＠＠ # Boston, MA 02111-1307, USA. VERSION = 1.07 -AUTHOR_VERSION = 1.45 +AUTHOR_VERSION = 2.1 MAINTAINER = Jerry James <james(a)xemacs.org> PACKAGE = haskell-mode PKG_TYPE = regular ＠＠ -27,10 +27,12 ＠＠ CATEGORY = standard ELCS = haskell-decl-scan.elc haskell-doc.elc haskell-font-lock.elc \ haskell-ghci.elc haskell-hugs.elc haskell-indent.elc haskell-mode.elc \ - haskell-simple-indent.elc + haskell-simple-indent.elc inf-haskell.elc DATA_FILES = fontlock.hs indent.hs index.html installation-guide.html DATA_DEST = $(PACKAGE) + +EXTRA_SOURCES = ChangeLog.upstream Makefile.upstream NEWS PRELOADS = -l comint -l cus-face -l font-lock -l func-menu -l imenu \ -l haskell-mode -l haskell-indent 1.2 +12 -0 XEmacs/packages/xemacs-packages/haskell-mode/fontlock.hs Index: fontlock.hs =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/fontlock.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- fontlock.hs 2002/04/24 09:45:06 1.1 +++ fontlock.hs 2006/03/15 05:18:22 1.2 ＠＠ -12,8 +12,20 ＠＠ data Maybe a = Nothing | Just a -- and module names are coloured -- closer to ordinary code. +recognize +++ infix :: Operator Declarations +as `well` as = This Form +(+) and this one = as well + +instance Show Toto where + fun1 arg1 = foo -- FIXME: `fun1' should be highlighted. + +constStr = "hello \ + \asdgfasgf\ + \asf" + {- map :: (a -> b) -> [a] -> [b] -- Commenting out large sections of map f [] = [] -- code can be misleading. Coloured map f (x:xs) = f x : map f xs -- comments reveal unused definitions. -} + 1.3 +69 -122 XEmacs/packages/xemacs-packages/haskell-mode/haskell-decl-scan.el Index: haskell-decl-scan.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-decl-scan.el,v retrieving revision 1.2 retrieving revision 1.3 diff -u -p -r1.2 -r1.3 --- haskell-decl-scan.el 2004/06/16 15:16:49 1.2 +++ haskell-decl-scan.el 2006/03/15 05:18:22 1.3 ＠＠ -1,13 +1,13 ＠＠ ;;; haskell-decl-scan.el --- Declaration scanning module for Haskell Mode +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; Copyright (C) 1997-1998 Graeme E Moss ;; Authors: 1997-1998 Graeme E Moss <gem(a)cs.york.ac.uk> ;; Keywords: declarations menu files Haskell -;; Version: 1.2 -;; URL: http://www.cs.york.ac.uk/~gem/haskell-mode/decl-scan.html +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/e... -;;; This file is not part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ＠＠ -52,11 +52,11 ＠＠ ;; ;; If you have any problems or suggestions, after consulting the list ;; below, email gem(a)cs.york.ac.uk quoting the version of the library -;; you are using, the version of emacs you are using, and a small +;; you are using, the version of Emacs you are using, and a small ;; example of the problem or suggestion. Note that this library ;; requires a reasonably recent version of Emacs. ;; -;; Uses `imenu' under FSF Emacs, and `func-menu' under XEmacs. +;; Uses `imenu' under Emacs, and `func-menu' under XEmacs. ;; ;; Version 1.2: ;; Added support for LaTeX-style literate scripts. ＠＠ -110,7 +110,7 ＠＠ ;; with spaces okay. ;; ;; . Would like to extend the goto functions given by `func-menu' -;; under XEmacs to FSF Emacs. Would have to implement these +;; under XEmacs to Emacs. Would have to implement these ;; ourselves as `imenu' does not provide them. ;; ;; . `func-menu' uses its own syntax table when grabbing a declaration ＠＠ -119,15 +119,20 ＠＠ ;; eg. "fib'" will be grabbed as "fib" since "'" is not a word or ;; symbol constituent under the syntax table `func-menu' uses. -;;; All functions/variables start with -;;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'. +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'. -;;; The imenu support is based on code taken from `hugs-mode', -;;; thanks go to Chris Van Humbeeck. +;; The imenu support is based on code taken from `hugs-mode', +;; thanks go to Chris Van Humbeeck. ;; Version. -(defconst haskell-decl-scan-version "1.1" - "haskell-decl-scan version number.") + +;;; Code: + +(require 'haskell-mode) + +(defconst haskell-decl-scan-version "1.9" + "Version number of haskell-decl-scan.") (defun haskell-decl-scan-version () "Echo the current version of haskell-decl-scan in the minibuffer." (interactive) ＠＠ -137,23 +142,20 ＠＠ ;; As `cl' defines macros that `imenu' uses, we must require them at ;; compile time. (eval-when-compile - ;; `imenu' isn't used in XEmacs. - (if (not (string-match "Lucid\\|XEmacs" emacs-version)) - (progn - (require 'cl) - (require 'imenu)))) - -;; Are we running FSF Emacs or XEmacs? -(defvar haskell-ds-running-xemacs - (string-match "Lucid\\|XEmacs" emacs-version) - "non-nil if we are running XEmacs, nil otherwise.") + (require 'cl) + (condition-case nil + (require 'imenu) + (error nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; General declaration scanning functions. -(defun haskell-ds-match-string (num) - "As `match-string' except that the string is stripped of properties." - (format "%s" (match-string num))) +(defalias 'haskell-ds-match-string + (if (fboundp 'match-string-no-properties) + 'match-string-no-properties + (lambda (num) + "As `match-string' except that the string is stripped of properties." + (format "%s" (match-string num))))) (defvar haskell-ds-start-keywords-re (concat "\$\\<" ＠＠ -162,36 +164,14 ＠＠ "\$\\>") "Keywords that may start a declaration.") -(defvar haskell-ds-syntax-table nil +(defvar haskell-ds-syntax-table + (let ((table (copy-syntax-table haskell-mode-syntax-table))) + (modify-syntax-entry ?\' "w" table) + (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?\\ "_" table) + table) "Syntax table used for Haskell declaration scanning.") -(if (not haskell-ds-syntax-table) - (progn - (setq haskell-ds-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\ " " haskell-ds-syntax-table) - (modify-syntax-entry ?\t " " haskell-ds-syntax-table) - (modify-syntax-entry ?\" "\"" haskell-ds-syntax-table) - (modify-syntax-entry ?\' "w" haskell-ds-syntax-table) - (modify-syntax-entry ?_ "w" haskell-ds-syntax-table) - (modify-syntax-entry ?$ "()" haskell-ds-syntax-table) - (modify-syntax-entry ?$ ")(" haskell-ds-syntax-table) - (modify-syntax-entry ?[ "(]" haskell-ds-syntax-table) - (modify-syntax-entry ?] ")[" haskell-ds-syntax-table) - (modify-syntax-entry ?{ "(}1" haskell-ds-syntax-table) - (modify-syntax-entry ?} "){4" haskell-ds-syntax-table) - (modify-syntax-entry ?- "_ 23" haskell-ds-syntax-table) - (modify-syntax-entry ?\` "$`" haskell-ds-syntax-table) - (mapcar (lambda (x) - (modify-syntax-entry x "_" haskell-ds-syntax-table)) - (concat "!#$%&*+./:<=>?＠\\^|~" - (haskell-enum-from-to ?\241 ?\277) - "\327\367")) - (mapcar (lambda (x) - (modify-syntax-entry x "w" haskell-ds-syntax-table)) - (concat (haskell-enum-from-to ?\300 ?\326) - (haskell-enum-from-to ?\330 ?\337) - (haskell-enum-from-to ?\340 ?\366) - (haskell-enum-from-to ?\370 ?\377))))) (defun haskell-ds-get-variable (prefix) "Assuming point is looking at the regexp PREFIX followed by the ＠＠ -392,6 +372,10 ＠＠ then point does not move if already at t ;; Return the result. result)) +(defun haskell-ds-bird-p () + (if (boundp 'haskell-literate) + (eq haskell-literate 'bird) nil)) + (defun haskell-ds-backward-decl () "Move point backward to the first character preceeding the current point that starts a top-level declaration. A series of declarations ＠＠ -403,18 +387,12 ＠＠ declaration. Returns point if point is declaration, and nil otherwise, ie. because point is at the beginning of the buffer and no declaration starts there." (interactive) - (haskell-ds-move-to-decl nil - (if (boundp 'haskell-literate) - (eq haskell-literate 'bird) nil) - nil)) + (haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil)) (defun haskell-ds-forward-decl () "As `haskell-ds-backward-decl' but forward." (interactive) - (haskell-ds-move-to-decl t - (if (boundp 'haskell-literate) - (eq haskell-literate 'bird) nil) - nil)) + (haskell-ds-move-to-decl t (haskell-ds-bird-p) nil)) (defun haskell-ds-generic-find-next-decl (bird-literate) "Find the name, position and type of the declaration at or after ＠＠ -524,21 +502,13 ＠＠ positions and the type is one of the sym ;; Declaration scanning via `imenu'. (defun haskell-ds-create-imenu-index () - "Non-literate Haskell version of `haskell-ds-generic-create-menu-index'." - (haskell-ds-generic-create-imenu-index nil)) - -(defun literate-haskell-ds-create-imenu-index () - "Bird-style literate Haskell version of -`haskell-ds-generic-create-menu-index'." - (haskell-ds-generic-create-imenu-index t)) - -(defun haskell-ds-generic-create-imenu-index (bird-literate) - "Function for finding `imenu' declarations in (BIRD-LITERATE) Haskell mode. + "Function for finding `imenu' declarations in Haskell mode. Finds all declarations (classes, variables, imports, instances and datatypes) in a Haskell file for the `imenu' package." ;; Each list has elements of the form `(INDEX-NAME . INDEX-POSITION)'. ;; These lists are nested using `(INDEX-TITLE . INDEX-ALIST)'. - (let* ((index-alist '()) + (let* ((bird-literate (haskell-ds-bird-p)) + (index-alist '()) (index-class-alist '()) ;; Classes (index-var-alist '()) ;; Variables (index-imp-alist '()) ;; Imports ＠＠ -603,20 +573,9 ＠＠ datatypes) in a Haskell file for the `im `haskell-ds-create-imenu-index'." (string< (car el1) (car el2))) -(defun haskell-ds-imenu (bird-literate) - "Install `imenu' for (BIRD-LITERATE) Haskell scripts." - ;; Would prefer to toggle imenu but can't see how to turn it off... - (require 'imenu) - ;; In emacs-20's imenu we have to bind some functions first -- HWL - (if (and (not haskell-ds-running-xemacs) - (>= (string-to-number (substring emacs-version 0 2)) 20) - (not (fboundp 'imenu-extract-index-name-function))) - (setq imenu-extract-index-name-function - (if bird-literate (function literate-haskell-ds-create-imenu-index) - (function haskell-ds-create-imenu-index)))) - (setq imenu-create-index-function - (if bird-literate (function literate-haskell-ds-create-imenu-index) - (function haskell-ds-create-imenu-index))) +(defun haskell-ds-imenu () + "Install `imenu' for Haskell scripts." + (setq imenu-create-index-function 'haskell-ds-create-imenu-index) (if (fboundp 'imenu-add-to-menubar) (imenu-add-to-menubar "Declarations"))) ＠＠ -625,14 +584,10 ＠＠ datatypes) in a Haskell file for the `im (defun haskell-ds-func-menu-next (buffer) "Non-literate Haskell version of `haskell-ds-generic-func-menu-next'." - (haskell-ds-generic-func-menu-next nil buffer)) - -(defun literate-haskell-ds-func-menu-next (buffer) - "Bird-style literate Haskell version of `haskell-ds-generic-func-menu-next'." - (haskell-ds-generic-func-menu-next t buffer)) + (haskell-ds-generic-func-menu-next (haskell-ds-bird-p) buffer)) (defun haskell-ds-generic-func-menu-next (bird-literate buffer) - "Returns `(name . pos)' of next declaration." + "Return `(name . pos)' of next declaration." (set-buffer buffer) (let ((result (haskell-ds-generic-find-next-decl bird-literate))) (if result ＠＠ -640,18 +595,18 ＠＠ datatypes) in a Haskell file for the `im (name (car name-posns)) (posns (cdr name-posns)) (name-pos (cdr posns)) - ;(type (cdr result)) + ;;(type (cdr result)) ) (cons ;(concat ;; func-menu has problems with spaces, and adding a ;; qualifying keyword will not allow the "goto fn" ;; functions to work properly. Sigh. -; (cond -; ((eq type 'variable) "") -; ((eq type 'datatype) "datatype ") -; ((eq type 'class) "class ") -; ((eq type 'import) "import ") -; ((eq type 'instance) "instance ")) + ;; (cond + ;; ((eq type 'variable) "") + ;; ((eq type 'datatype) "datatype ") + ;; ((eq type 'class) "class ") + ;; ((eq type 'import) "import ") + ;; ((eq type 'instance) "instance ")) name;) name-pos)) nil))) ＠＠ -664,22 +619,16 ＠＠ datatypes) in a Haskell file for the `im (concat "^" literate-haskell-ds-start-decl-re) "As `haskell-ds-func-menu-regexp' but for Bird-style literate scripts.") -(defun haskell-ds-func-menu (bird-literate) - "Uses `func-menu' to establish declaration scanning for (BIRD-LITERATE) -Haskell scripts." +(defun haskell-ds-func-menu () + "Use `func-menu' to establish declaration scanning for Haskell scripts." (require 'func-menu) - (make-local-variable 'fume-menubar-menu-name) - (setq fume-menubar-menu-name "Declarations") - (make-local-variable 'fume-function-name-regexp-alist) - (setq fume-function-name-regexp-alist - (if bird-literate - '((haskell-mode . literate-haskell-ds-func-menu-regexp)) - '((haskell-mode . haskell-ds-func-menu-regexp)))) - (make-local-variable 'fume-find-function-name-method-alist) - (setq fume-find-function-name-method-alist - (if bird-literate - '((haskell-mode . literate-haskell-ds-func-menu-next)) - '((haskell-mode . haskell-ds-func-menu-next)))) + (set (make-local-variable 'fume-menubar-menu-name) "Declarations") + (set (make-local-variable 'fume-function-name-regexp-alist) + (if (haskell-ds-bird-p) + '((haskell-mode . literate-haskell-ds-func-menu-regexp)) + '((haskell-mode . haskell-ds-func-menu-regexp)))) + (set (make-local-variable 'fume-find-function-name-method-alist) + '((haskell-mode . haskell-ds-func-menu-next))) (fume-add-menubar-entry) (local-set-key "\C-cl" 'fume-list-functions) (local-set-key "\C-cg" 'fume-prompt-function-goto) ＠＠ -706,7 +655,7 ＠＠ Under XEmacs, the following keys are als \\[fume-prompt-function-goto] prompts for a declaration to move to, and \\[fume-mouse-function-goto] moves to the declaration whose name is at point. -This may link with `haskell-doc' (only for FSF Emacs currently). +This may link with `haskell-doc' (only for Emacs currently). For non-literate and LaTeX-style literate scripts, we assume the common convention that top-level declarations start at the first ＠＠ -737,15 +686,13 ＠＠ Invokes `haskell-decl-scan-hook' if not Use `haskell-decl-scan-version' to find out what version this is." (interactive) (haskell-ds-keys) - (let ((bird-literate (if (boundp 'haskell-literate) - (eq haskell-literate 'bird) nil))) - (if haskell-ds-running-xemacs - (haskell-ds-func-menu bird-literate) - (haskell-ds-imenu bird-literate))) + (if (fboundp 'imenu) + (haskell-ds-imenu) + (haskell-ds-func-menu)) (run-hooks 'haskell-decl-scan-hook)) -;;; Provide ourselves: +;; Provide ourselves: (provide 'haskell-decl-scan) -;;; haskell-decl-scan ends here. +;;; haskell-decl-scan.el ends here 1.5 +508 -547 XEmacs/packages/xemacs-packages/haskell-mode/haskell-doc.el Index: haskell-doc.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-doc.el,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- haskell-doc.el 2003/01/08 22:03:45 1.4 +++ haskell-doc.el 2006/03/15 05:18:22 1.5 ＠＠ -1,19 +1,13 ＠＠ ;;; haskell-doc.el --- show function types in echo area -;; Time-stamp: <Thu Dec 10 1998 17:26:21 Stardate: [-30]2203.42 hwloidl> - +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; Copyright (C) 1997 Hans-Wolfgang Loidl ;; Author: Hans-Wolfgang Loidl <hwloidl(a)dcs.glasgow.ac.uk> -;; Maintainer: Hans-Wolfgang Loidl <hwloidl(a)dcs.glasgow.ac.uk> ;; Temporary Maintainer and Hacker: Graeme E Moss <gem(a)cs.york.ac.uk> ;; Keywords: extensions, minor mode, language mode, Haskell ;; Created: 1997-06-17 -;; Revision: $Revision: 1.4 $ -;; FTP archive: /ftp＠ftp.dcs.gla.ac.uk:/pub/glasgow-fp/authors/Hans_Loidl/Elisp/haskell-doc.el -;; Status: Beta version - -;; $Id: haskell-doc.el,v 1.4 2002/10/14 09:55:03 simonmar Exp $ +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/e... ;;; Copyright: ;; ========== ＠＠ -37,21 +31,21 ＠＠ ;; =========== ;; This program shows the type of the Haskell function under the cursor in the -;; minibuffer. It acts as a kind of "emacs background process", by regularly +;; minibuffer. It acts as a kind of "emacs background process", by regularly ;; checking the word under the cursor and matching it against a list of ;; prelude, library, local and global functions. ;; The preferred usage of this package is in combination with ;; `haskell-hugs-mode'. ;; In that case `haskell-doc-mode' checks an internal variable updated by -;; `imenu' to access the types of all local functions. In `haskell-mode' this -;; is not possible. However, types of prelude functions are still shown. +;; `imenu' to access the types of all local functions. In `haskell-mode' this +;; is not possible. However, types of prelude functions are still shown. -;; To show types of global functions, i.e. functions defined in a module -;; imported by the current module, call the function -;; `turn-on-haskell-doc-global-types'. This automatically loads all modules -;; and builds `imenu' tables to get the types of all functions (again this -;; currently requires `haskell-hugs-mode'). +;; To show types of global functions, i.e. functions defined in a module +;; imported by the current module, call the function +;; `turn-on-haskell-doc-global-types'. This automatically loads all modules +;; and builds `imenu' tables to get the types of all functions (again this +;; currently requires `haskell-hugs-mode'). ;; Note: The modules are loaded recursively, so you might pull in ;; many modules by just turning on global function support. ;; This features is currently not very well supported. ＠＠ -83,20 +77,20 ＠＠ ;; `haskell-doc-show-user-defined' (default: t) ;; If you want to define your own strings for some identifiers define an -;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. +;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. ;; E.g: ;; ;; (setq haskell-doc-show-user-defined t) -;; (setq haskell-doc-user-defined-ids -;; (list +;; (setq haskell-doc-user-defined-ids +;; (list ;; '("main" . "just another pathetic main function") ;; '("foo" . "a very dummy name") ;; '("bar" . "another dummy name"))) ;; The following two variables are useful to make the type fit on one line: ;; If `haskell-doc-chop-off-context' is non-nil the context part of the type -;; of a local fct will be eliminated (default: t). -;; If `haskell-doc-chop-off-fctname' is non-nil the function name is not +;; of a local fct will be eliminated (default: t). +;; If `haskell-doc-chop-off-fctname' is non-nil the function name is not ;; shown together with the type (default: nil). ;;; Internals: ＠＠ -118,14 +112,14 ＠＠ ;; `haskell-doc-show-prelude' ... toggle echoing of prelude id's types ;; `haskell-doc-show-strategy' ... toggle echoing of strategy id's types ;; `haskell-doc-show-user-defined' ... toggle echoing of user def id's types -;; `haskell-doc-check-active' ... check whether haskell-doc is active via the -;; `post-command-idle-hook' (for testing); +;; `haskell-doc-check-active' ... check whether haskell-doc is active via the +;; `post-command-idle-hook' (for testing); ;; Key: CTRL-c ESC-/ ;;; ToDo: ;; ===== -;; - Fix byte-compile problems in `haskell-doc-prelude-types' for getArgs etc +;; - Fix byte-compile problems in `haskell-doc-prelude-types' for getArgs etc ;; - Write a parser for .hi files and make haskell-doc independent from ;; hugs-mode. Read library interfaces via this parser. ;; - Indicate kind of object with colours ＠＠ -136,13 +130,81 ＠＠ ;;; Bugs: ;; ===== -;; - Some prelude fcts aren't displayed properly. This might be due to a +;; - Some prelude fcts aren't displayed properly. This might be due to a ;; name clash of Haskell and Elisp functions (e.g. length) which ;; confuses emacs when reading `haskell-doc-prelude-types' ;;; Changelog: ;; ========== -;; $Log: haskell-doc.el,v $ +;; haskell-doc.el,v +;; Revision 1.16 2005/11/07 01:28:16 monnier +;; (haskell-doc-xemacs-p, haskell-doc-emacs-p) +;; (haskell-doc-message): Remove. +;; (haskell-doc-is-id-char-at): Remove. +;; (haskell-doc-get-current-word): Rewrite. +;; +;; Revision 1.15 2005/11/04 17:11:12 monnier +;; Add arch-tag. +;; +;; Revision 1.14 2005/08/24 11:36:32 monnier +;; (haskell-doc-message): Paren typo. +;; +;; Revision 1.13 2005/08/23 19:23:27 monnier +;; (haskell-doc-show-type): Assume that the availability +;; of display-message won't change at runtime. +;; +;; Revision 1.12 2005/07/18 21:04:14 monnier +;; (haskell-doc-message): Remove. +;; (haskell-doc-show-type): inline it. Do nothing for if there's no doc to show. +;; +;; Revision 1.11 2004/12/10 17:33:18 monnier +;; (haskell-doc-minor-mode-string): Make it dynamic. +;; (haskell-doc-install-keymap): Remove conflicting C-c C-o binding. +;; (haskell-doc-mode): Make a nil arg turn the mode ON. +;; (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode. +;; (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string. +;; (haskell-doc-show-global-types): Don't touch +;; haskell-doc-minor-mode-string. Call haskell-doc-make-global-fct-index. +;; (haskell-doc-check-active): Fix message. +;; (define-key-after): Don't define. +;; (haskell-doc-install-keymap): Check existence of define-key-after. +;; +;; Revision 1.10 2004/11/25 23:03:23 monnier +;; (haskell-doc-sym-doc): Make even the last char bold. +;; +;; Revision 1.9 2004/11/24 22:14:36 monnier +;; (haskell-doc-install-keymap): Don't blindly assume there's a Hugs menu. +;; +;; Revision 1.8 2004/11/22 10:45:35 simonmar +;; Fix type of getLine +;; +;; Revision 1.7 2004/10/14 22:27:47 monnier +;; (turn-off-haskell-doc-mode, haskell-doc-current-info): Don't autoload. +;; +;; Revision 1.6 2004/10/13 22:45:22 monnier +;; (haskell-doc): New group. +;; (haskell-doc-show-reserved, haskell-doc-show-prelude) +;; (haskell-doc-show-strategy, haskell-doc-show-user-defined) +;; (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname): +;; Make them custom vars. +;; (haskell-doc-keymap): Declare and fill it right there. +;; (haskell-doc-mode): Simplify. +;; (haskell-doc-toggle-var): Make it into what it was supposed to be. +;; (haskell-doc-mode-print-current-symbol-info): Simplify. +;; (haskell-doc-current-info): New autoloaded function. +;; (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type. +;; (haskell-doc-show-type): Use it. +;; (haskell-doc-wrapped-type-p): Remove unused var `lim'. +;; (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): Remove. Unused. +;; (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded. +;; (haskell-doc-install-keymap): Simplify. +;; +;; Revision 1.5 2003/01/09 11:56:26 simonmar +;; Patches from Ville Skyttä <scop(a)xemacs.org>, the XEmacs maintainer of +;; the haskell-mode: +;; +;; - Make the auto-mode-alist modifications autoload-only. +;; ;; Revision 1.4 2002/10/14 09:55:03 simonmar ;; Patch to update the Prelude/libraries function names and to remove ;; support for older versions of Haskell. ＠＠ -187,65 +249,63 ＠＠ ;;; Code: ;; ===== -;＠menu -;* Constants and Variables:: -;* Install as minor mode:: -;* Menubar Support:: -;* Haskell Doc Mode:: -;* Switch it on or off:: -;* Check:: -;* Top level function:: -;* Mouse interface:: -;* Print fctsym:: -;* Movement:: -;* Bug Reports:: -;* Visit home site:: -;* Index:: -;* Token:: -;＠end menu - -;＠node top, Constants and Variables, (dir), (dir) -;＠top - -;＠node Constants and Variables, Install as minor mode, top, top -;＠section Constants and Variables - -;＠menu -;* Emacs portability:: -;* Maintenance stuff:: -;* Mode Variable:: -;* Variables:: -;* Prelude types:: -;* Test membership:: -;＠end menu - -;＠node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables -;＠subsection Emacs portability - -(defconst haskell-doc-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version) - "Running under XEmacs?") - -(defconst haskell-doc-emacs-p (and (or (string-match "^19" emacs-version) - (string-match "^20" emacs-version)) - (not haskell-doc-xemacs-p)) - "Running under Emacs?") +;;＠menu +;;* Constants and Variables:: +;;* Install as minor mode:: +;;* Menubar Support:: +;;* Haskell Doc Mode:: +;;* Switch it on or off:: +;;* Check:: +;;* Top level function:: +;;* Mouse interface:: +;;* Print fctsym:: +;;* Movement:: +;;* Bug Reports:: +;;* Visit home site:: +;;* Index:: +;;* Token:: +;;＠end menu + +;;＠node top, Constants and Variables, (dir), (dir) +;;＠top + +;;＠node Constants and Variables, Install as minor mode, top, top +;;＠section Constants and Variables + +;;＠menu +;;* Emacs portability:: +;;* Maintenance stuff:: +;;* Mode Variable:: +;;* Variables:: +;;* Prelude types:: +;;* Test membership:: +;;＠end menu + +;;＠node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables +;;＠subsection Emacs portability + +(defgroup haskell-doc nil + "Show Haskell function types in echo area." +:group 'haskell +:prefix "haskell-doc-") -;＠node Maintenance stuff, Mode Variable, Emacs portability, Constants and Variables -;＠subsection Maintenance stuff +;;＠node Maintenance stuff, Mode Variable, Emacs portability, Constants and Variables +;;＠subsection Maintenance stuff -(defconst haskell-doc-version "$Revision: 1.4 $" +(defconst haskell-doc-version "1.16" "Version of `haskell-doc-mode' as RCS Revision.") -(defconst haskell-doc-maintainer "Hans-Wolfgang Loidl <hwloidl(a)dcs.glasgow.ac.uk>" +(defconst haskell-doc-maintainer + "Hans-Wolfgang Loidl <hwloidl(a)dcs.glasgow.ac.uk>" "Maintainer of `haskell-doc-mode'.") -(defconst haskell-doc-ftp-site "/ftp＠ftp.dcs.gla.ac.uk:/pub/glasgow-fp/authors/Hans_Loidl/Elisp/" +(defconst haskell-doc-ftp-site + "/ftp＠ftp.dcs.gla.ac.uk:/pub/glasgow-fp/authors/Hans_Loidl/Elisp/" "Main FTP site with latest version of `haskell-doc-mode' and sample files.") -;＠node Mode Variable, Variables, Maintenance stuff, Constants and Variables -;＠subsection Mode Variable +;;＠node Mode Variable, Variables, Maintenance stuff, Constants and Variables +;;＠subsection Mode Variable -;;;###autoload (defvar haskell-doc-mode nil "*If non-nil, show the type of the function near point or a related comment. ＠＠ -253,15 +313,15 ＠＠ If the identifier near point is a Haskel `haskell-doc-show-reserved' is non-nil show a one line summary of the syntax. -If the identifier near point is a Prelude or one of the standard library +If the identifier near point is a Prelude or one of the standard library functions and `haskell-doc-show-prelude' is non-nil show its type. If the identifier near point is local $i.e. defined in this module$ check the `imenu' list of functions for the type. This obviously requires that your language mode uses `imenu' $`haskell-hugs-mode' 0.6 for example$. -If the identifier near point is global $i.e. defined in an imported module$ -and the variable `haskell-doc-show-global-types' is non-nil show the type of its +If the identifier near point is global $i.e. defined in an imported module$ +and the variable `haskell-doc-show-global-types' is non-nil show the type of its function. If the identifier near point is a standard strategy or a function, type related ＠＠ -270,7 +330,7 ＠＠ of the function. Strategies are special If you're not interested in that just turn it off. If the identifier near point is a user defined function that occurs as key -in the alist `haskell-doc-user-defined-ids' and the variable +in the alist `haskell-doc-user-defined-ids' and the variable `haskell-doc-show-user-defined' is non-nil show the type of the function. This variable is buffer-local.") ＠＠ -286,42 +346,49 ＠＠ The function `haskell-doc-make-global-fc This variable is buffer-local.") (make-variable-buffer-local 'haskell-doc-index) -(defvar haskell-doc-show-global-types nil - "*If non-nil, search for the types of global functions by loading the files. -This variable is buffer-local.") +(defcustom haskell-doc-show-global-types nil + "If non-nil, search for the types of global functions by loading the files. +This variable is buffer-local." +:type 'boolean) (make-variable-buffer-local 'haskell-doc-show-global-types) -(defvar haskell-doc-show-reserved t - "*If non-nil, show a documentation string for reserved ids. -This variable is buffer-local.") +(defcustom haskell-doc-show-reserved t + "If non-nil, show a documentation string for reserved ids. +This variable is buffer-local." +:type 'boolean) (make-variable-buffer-local 'haskell-doc-show-reserved) -(defvar haskell-doc-show-prelude t - "*If non-nil, show a documentation string for prelude functions. -This variable is buffer-local.") +(defcustom haskell-doc-show-prelude t + "If non-nil, show a documentation string for prelude functions. +This variable is buffer-local." +:type 'boolean) (make-variable-buffer-local 'haskell-doc-show-prelude) -(defvar haskell-doc-show-strategy t - "*If non-nil, show a documentation string for strategies. -This variable is buffer-local.") +(defcustom haskell-doc-show-strategy t + "If non-nil, show a documentation string for strategies. +This variable is buffer-local." +:type 'boolean) (make-variable-buffer-local 'haskell-doc-show-strategy) -(defvar haskell-doc-show-user-defined t - "*If non-nil, show a documentation string for user defined ids. -This variable is buffer-local.") +(defcustom haskell-doc-show-user-defined t + "If non-nil, show a documentation string for user defined ids. +This variable is buffer-local." +:type 'boolean) (make-variable-buffer-local 'haskell-doc-show-user-defined) -(defvar haskell-doc-chop-off-context t - "*If non-nil eliminate the context part in a Haskell type.") +(defcustom haskell-doc-chop-off-context t + "If non-nil eliminate the context part in a Haskell type." +:type 'boolean) + +(defcustom haskell-doc-chop-off-fctname nil + "If non-nil omit the function name and show only the type." +:type 'boolean) -(defvar haskell-doc-chop-off-fctname nil - "*If non-nil omit the function name and show only the type.") - (defvar haskell-doc-search-distance 40 ; distance in characters "*How far to search when looking for the type declaration of fct under cursor.") -;＠node Variables, Prelude types, Mode Variable, Constants and Variables -;＠subsection Variables +;;＠node Variables, Prelude types, Mode Variable, Constants and Variables +;;＠subsection Variables (defvar haskell-doc-idle-delay 0.50 "*Number of seconds of idle time to wait before printing. ＠＠ -347,36 +414,35 ＠＠ candidates. It is probably best to manipulate this data structure with the commands `haskell-doc-add-command' and `haskell-doc-remove-command'.") -;(cond ((null haskell-doc-mode-message-commands) -; ;; If you increase the number of buckets, keep it a prime number. -; (setq haskell-doc-mode-message-commands (make-vector 31 0)) -; (let ((list '("self-insert-command" -; "next-" "previous-" -; "forward-" "backward-" -; "beginning-of-" "end-of-" -; "goto-" -; "recenter" -; "scroll-")) -; (syms nil)) -; (while list -; (setq syms (all-completions (car list) obarray 'fboundp)) -; (setq list (cdr list)) -; (while syms -; (set (intern (car syms) haskell-doc-mode-message-commands) t) -; (setq syms (cdr syms))))))) +;;(cond ((null haskell-doc-mode-message-commands) +;; ;; If you increase the number of buckets, keep it a prime number. +;; (setq haskell-doc-mode-message-commands (make-vector 31 0)) +;; (let ((list '("self-insert-command" +;; "next-" "previous-" +;; "forward-" "backward-" +;; "beginning-of-" "end-of-" +;; "goto-" +;; "recenter" +;; "scroll-")) +;; (syms nil)) +;; (while list +;; (setq syms (all-completions (car list) obarray 'fboundp)) +;; (setq list (cdr list)) +;; (while syms +;; (set (intern (car syms) haskell-doc-mode-message-commands) t) +;; (setq syms (cdr syms))))))) ;; Bookkeeping; the car contains the last symbol read from the buffer. ;; The cdr contains the string last displayed in the echo area, so it can ;; be printed again if necessary without reconsing. (defvar haskell-doc-last-data '(nil . nil)) -(defvar haskell-doc-minor-mode-string " Doc" ; " Haskell-Doc" +(defvar haskell-doc-minor-mode-string + '(haskell-doc-show-global-types " DOC" " Doc") "*String to display in mode line when Haskell-Doc Mode is enabled.") (defconst haskell-doc-varlist (list - 'haskell-doc-xemacs-p - 'haskell-doc-emacs-p 'haskell-doc-version 'haskell-doc-mode 'haskell-doc-mode-hook ＠＠ -392,10 +458,10 ＠＠ It is probably best to manipulate this d ) "List of variables sent via `haskell-doc-submit-bug-report'.") -;＠node Prelude types, Test membership, Variables, Constants and Variables -;＠subsection Prelude types +;;＠node Prelude types, Test membership, Variables, Constants and Variables +;;＠subsection Prelude types -;＠cindex haskell-doc-reserved-ids +;;＠cindex haskell-doc-reserved-ids (defvar haskell-doc-reserved-ids (list ＠＠ -426,7 +492,7 ＠＠ It is probably best to manipulate this d ) "An alist of reserved identifiers and a string describing the construct they are used in.") -;＠cindex haskell-doc-prelude-types +;;＠cindex haskell-doc-prelude-types (defvar haskell-doc-prelude-types (list ＠＠ -513,7 +579,7 ＠＠ It is probably best to manipulate this d '("gcd" . "(Integral a) => a -> a -> a") '("getChar" . "IO Char") '("getContents" . "IO String") - '("getLine" . "IO Char") + '("getLine" . "IO String") '("head" . "[a] -> a") '("id" . "a -> a") '("init" . "[a] -> [a]") ＠＠ -899,7 +965,7 ＠＠ It is probably best to manipulate this d '("getStdRandom" . "(StdGen -> (a, StdGen)) -> IO a")) "alist of prelude functions and their types.") -;＠cindex haskell-doc-strategy-ids +;;＠cindex haskell-doc-strategy-ids (defvar haskell-doc-strategy-ids (list ＠＠ -961,16 +1027,16 ＠＠ It is probably best to manipulate this d (defvar haskell-doc-user-defined-ids nil "alist of functions and strings defined by the user.") -;＠node Test membership, , Prelude types, Constants and Variables -;＠subsection Test membership +;;＠node Test membership, , Prelude types, Constants and Variables +;;＠subsection Test membership -;＠cindex haskell-doc-is-of +;;＠cindex haskell-doc-is-of (defsubst haskell-doc-is-of (fn types) "Check whether FN is one of the functions in the alist TYPES and return the type." (assoc fn types) ) -;＠node Install as minor mode, Menubar Support, Constants and Variables, top -;＠section Install as minor mode +;;＠node Install as minor mode, Menubar Support, Constants and Variables, top +;;＠section Install as minor mode ;; Put this minor mode on the global minor-mode-alist. (or (assq 'haskell-doc-mode (default-value 'minor-mode-alist)) ＠＠ -978,253 +1044,191 ＠＠ It is probably best to manipulate this d (append (default-value 'minor-mode-alist) '((haskell-doc-mode haskell-doc-minor-mode-string))))) -;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages are -;; recorded in a log. Do not put haskell-doc messages in that log since -;; they are Legion. - -;＠cindex haskell-doc-message - -(defmacro haskell-doc-message (&rest args) - (if (fboundp 'display-message) - ;; XEmacs 19.13 way of preventing log messages. - ;(list 'display-message '(quote no-log) (apply 'list 'format args)) - ;; XEmacs 19.15 seems to be a bit different - (list 'display-message '(quote message) (apply 'list 'format args)) - (list 'let (list (list 'message-log-max 'nil)) - (apply 'list 'message args)))) - -;＠node Menubar Support, Haskell Doc Mode, Install as minor mode, top -;＠section Menubar Support +;;＠node Menubar Support, Haskell Doc Mode, Install as minor mode, top +;;＠section Menubar Support -; get imenu +;; get imenu (require 'imenu) -; a dummy definition needed for xemacs (I know, it's horrible :-( -(if (and (string-match "XEmacs" emacs-version) - (not (functionp 'define-key-after))) - (defun define-key-after (map seq con name))) +;; a dummy definition needed for xemacs (I know, it's horrible :-( -;＠cindex haskell-doc-install-keymap +;;＠cindex haskell-doc-install-keymap +(defvar haskell-doc-keymap + (let ((map (make-sparse-keymap))) + (define-key map [visit] + '("Visit FTP home site" . haskell-doc-visit-home)) + (define-key map [submit] + '("Submit bug report" . haskell-doc-submit-bug-report)) + (define-key map [dummy] '("---" . nil)) + (define-key map [make-index] + '("Make global fct index" . haskell-doc-make-global-fct-index)) + (define-key map [global-types-on] + '("Toggle display of global types" . haskell-doc-show-global-types)) + (define-key map [strategy-on] + '("Toggle display of strategy ids" . haskell-doc-show-strategy)) + (define-key map [user-defined-on] + '("Toggle display of user defined ids" . haskell-doc-show-user-defined)) + (define-key map [prelude-on] + '("Toggle display of prelude functions" . haskell-doc-show-prelude)) + (define-key map [reserved-ids-on] + '("Toggle display of reserved ids" . haskell-doc-show-reserved)) + (define-key map [haskell-doc-on] + '("Toggle haskell-doc mode" . haskell-doc-mode)) + map)) + (defun haskell-doc-install-keymap () "Install a menu for `haskell-doc-mode' as a submenu of \"Hugs\"." - (interactive) - ; define a keymap `haskell-doc-keymap' for the derive menu - (if nil ; (keymapp haskell-doc-keymap) - nil - (setq haskell-doc-keymap (make-sparse-keymap)) - (define-key haskell-doc-keymap [visit] - '("Visit FTP home site" . haskell-doc-visit-home)) - (define-key haskell-doc-keymap [submit] - '("Submit bug report" . haskell-doc-submit-bug-report)) - (define-key haskell-doc-keymap [dummy] - '("---" . nil)) - (define-key haskell-doc-keymap [make-index] - '("Make global fct index" . haskell-doc-make-global-fct-index)) - (define-key haskell-doc-keymap [global-types-on] - '("Toggle display of global types" . haskell-doc-show-global-types)) - (define-key haskell-doc-keymap [strategy-on] - '("Toggle display of strategy ids" . haskell-doc-show-strategy)) - (define-key haskell-doc-keymap [user-defined-on] - '("Toggle display of user defined ids" . haskell-doc-show-user-defined)) - (define-key haskell-doc-keymap [prelude-on] - '("Toggle display of prelude functions" . haskell-doc-show-prelude)) - (define-key haskell-doc-keymap [reserved-ids-on] - '("Toggle display of reserved ids" . haskell-doc-show-reserved)) - (define-key haskell-doc-keymap [haskell-doc-on] - '("Toggle haskell-doc mode" . haskell-doc-mode)) - ) - - ; add the menu to the hugs menu as last entry - (cond - ((eq major-mode 'haskell-hugs-mode) - (let ((hugsmap (lookup-key haskell-hugs-mode-map [menu-bar Hugs]))) - (if (and (not haskell-doc-xemacs-p) ; XEmacs has problems here - (not (lookup-key hugsmap [haskell-doc]))) - (define-key-after hugsmap [haskell-doc] (cons "Haskell-doc" haskell-doc-keymap) - [Haskell-doc mode])) - ; add shortcuts for these commands - (define-key haskell-hugs-mode-map "\C-c\e/" 'haskell-doc-check-active) ; for testing - (define-key haskell-hugs-mode-map "\C-c\C-o" 'haskell-doc-mode) - (if (not haskell-doc-xemacs-p) - (define-key haskell-hugs-mode-map [C-S-M-mouse-3] 'haskell-doc-ask-mouse-for-type)))) - ((eq major-mode 'haskell-mode) - ; add shortcuts for these commands - (local-set-key "\C-c\e/" 'haskell-doc-check-active) ; for testing - (local-set-key "\C-c\C-o" 'haskell-doc-mode) - (if (not haskell-doc-xemacs-p) - (local-set-key [C-S-M-mouse-3] 'haskell-doc-ask-mouse-for-type)) ) )) + (interactive) + ;; Add the menu to the hugs menu as last entry. + (let ((hugsmap (lookup-key (current-local-map) [menu-bar Hugs]))) + (if (not (or (featurep 'xemacs) ; XEmacs has problems here + (not (keymapp hugsmap)) + (lookup-key hugsmap [haskell-doc]))) + (if (functionp 'define-key-after) + (define-key-after hugsmap [haskell-doc] + (cons "Haskell-doc" haskell-doc-keymap) + [Haskell-doc mode])))) + ;; Add shortcuts for these commands. + (local-set-key "\C-c\e/" 'haskell-doc-check-active) + ;; Conflicts with the binding of haskell-insert-otherwise. + ;; (local-set-key "\C-c\C-o" 'haskell-doc-mode) + (local-set-key [(control shift meta mouse-3)] + 'haskell-doc-ask-mouse-for-type)) -;＠node Haskell Doc Mode, Switch it on or off, Menubar Support, top -;＠section Haskell Doc Mode +;;＠node Haskell Doc Mode, Switch it on or off, Menubar Support, top +;;＠section Haskell Doc Mode -;＠cindex haskell-doc-mode +;;＠cindex haskell-doc-mode ;;;###autoload -(defun haskell-doc-mode (&optional prefix) +(defun haskell-doc-mode (&optional arg) "Enter `haskell-doc-mode' for showing fct types in the echo area. See variable docstring." - (interactive "P") + (interactive (list (or current-prefix-arg 'toggle))) ;; Make sure it's on the post-command-idle-hook if defined, otherwise put ;; it on post-command-hook. The former first appeared in Emacs 19.30. (setq haskell-doc-mode - (if prefix - (or (listp prefix);; C-u alone - (> (prefix-numeric-value prefix) 0)) - (not haskell-doc-mode))) - - (and haskell-doc-mode-hook - haskell-doc-mode - (run-hooks 'haskell-doc-mode-hook)) + (cond + ((eq arg 'toggle) (not haskell-doc-mode)) + (arg (> (prefix-numeric-value arg) 0)) + (t))) + + (cond + (haskell-doc-mode + ;; Turning the mode ON. + + ;; ToDo: replace binding of `post-command-idle-hook' by + ;; `run-with-idle-timer' + (add-hook (if (boundp 'post-command-idle-hook) + 'post-command-idle-hook + 'post-command-hook) + 'haskell-doc-mode-print-current-symbol-info nil 'local) + (and haskell-doc-show-global-types + (haskell-doc-make-global-fct-index)) ; build type index for global fcts - ;; ToDo: replace binding of `post-command-idle-hook' by `run-with-idle-timer' - (and haskell-doc-mode - (not (memq 'haskell-doc-mode-print-current-symbol-info - (if (boundp 'post-command-idle-hook) - post-command-idle-hook - post-command-hook))) - (add-hook (if (boundp 'post-command-idle-hook) - 'post-command-idle-hook - 'post-command-hook) - 'haskell-doc-mode-print-current-symbol-info)) + (haskell-doc-install-keymap) - (and (not haskell-doc-mode) - (memq 'haskell-doc-mode-print-current-symbol-info - (if (boundp 'post-command-idle-hook) - post-command-idle-hook - post-command-hook)) - (remove-hook (if (boundp 'post-command-idle-hook) - 'post-command-idle-hook - 'post-command-hook) - 'haskell-doc-mode-print-current-symbol-info)) + (run-hooks 'haskell-doc-mode-hook)) - (and haskell-doc-mode - haskell-doc-show-global-types - (progn - (setq haskell-doc-minor-mode-string " Haskell-DOC") - (haskell-doc-make-global-fct-index)) ; build type index for global fcts - (setq haskell-doc-minor-mode-string " Haskell-Doc")) + ((not haskell-doc-mode) - (if haskell-doc-mode - (haskell-doc-install-keymap)) + (remove-hook (if (boundp 'post-command-idle-hook) + 'post-command-idle-hook + 'post-command-hook) + 'haskell-doc-mode-print-current-symbol-info 'local))) (and (interactive-p) - (if haskell-doc-mode - (message "haskell-doc-mode is enabled") - (message "haskell-doc-mode is disabled"))) + (message "haskell-doc-mode is %s" + (if haskell-doc-mode "enabled" "disabled"))) haskell-doc-mode) -;;＠cindex haskell-doc-show-global-types - -;;;;###autoload -;(defun haskell-doc-show-global-types (&optional prefix) -; "*If non-nil, then enable display of global types in `haskell-doc-mode'." -; (interactive "P") -; ;; toggle mode or set it based on prefix value -; (setq haskell-doc-show-global-types -; (if prefix -; (>= (prefix-numeric-value prefix) 0) -; (not haskell-doc-show-global-types))) - -; (cond (haskell-doc-show-global-types -; ;; set mode string to reflect value of `haskell-doc-show-global-types' -; (setq haskell-doc-minor-mode-string " Haskell-DOC") -; ;; build index (note: this can be quite expensive) -; (haskell-doc-make-global-fct-index)) -; (t -; (setq haskell-doc-minor-mode-string " Haskell-Doc")) ) ) - - (defmacro haskell-doc-toggle-var (id prefix) ;; toggle variable or set it based on prefix value - (setq id - (if prefix - (>= (prefix-numeric-value prefix) 0) - (not id))) ) + `(setq ,id + (if ,prefix + (>= (prefix-numeric-value ,prefix) 0) + (not ,id))) ) -;＠cindex haskell-doc-show-global-types +;;＠cindex haskell-doc-show-global-types (defun haskell-doc-show-global-types (&optional prefix) "Turn on global types information in `haskell-doc-mode'." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-global-types prefix) (if haskell-doc-show-global-types - (setq haskell-doc-minor-mode-string " Haskell-DOC") - (setq haskell-doc-minor-mode-string " Haskell-Doc")) ) + (haskell-doc-make-global-fct-index))) -;＠cindex haskell-doc-show-reserved +;;＠cindex haskell-doc-show-reserved (defun haskell-doc-show-reserved (&optional prefix) "Toggle the automatic display of a doc string for reserved ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-reserved prefix)) -;＠cindex haskell-doc-show-prelude +;;＠cindex haskell-doc-show-prelude (defun haskell-doc-show-prelude (&optional prefix) "Toggle the automatic display of a doc string for reserved ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-prelude prefix)) -;＠cindex haskell-doc-show-strategy +;;＠cindex haskell-doc-show-strategy (defun haskell-doc-show-strategy (&optional prefix) "Toggle the automatic display of a doc string for strategy ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-strategy prefix)) -;＠cindex haskell-doc-show-user-defined +;;＠cindex haskell-doc-show-user-defined (defun haskell-doc-show-user-defined (&optional prefix) "Toggle the automatic display of a doc string for user defined ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-user-defined prefix)) -;＠node Switch it on or off, Check, Haskell Doc Mode, top -;＠section Switch it on or off +;;＠node Switch it on or off, Check, Haskell Doc Mode, top +;;＠section Switch it on or off -;＠cindex turn-on-haskell-doc-mode +;;＠cindex turn-on-haskell-doc-mode ;;;###autoload -(defun turn-on-haskell-doc-mode () - "Unequivocally turn on `haskell-doc-mode' (see variable documentation)." - (interactive) - (haskell-doc-mode 1)) +(defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode) -;＠cindex turn-off-haskell-doc-mode +;;＠cindex turn-off-haskell-doc-mode -;;;###autoload (defun turn-off-haskell-doc-mode () "Unequivocally turn off `haskell-doc-mode' (see variable documentation)." (interactive) (haskell-doc-mode 0)) -;＠node Check, Top level function, Switch it on or off, top -;＠section Check +;;＠node Check, Top level function, Switch it on or off, top +;;＠section Check -;＠cindex haskell-doc-check-active +;;＠cindex haskell-doc-check-active (defun haskell-doc-check-active () - "Check whether the print function is hooked in. -Should be the same as the value of `haskell-doc-mode' but alas currently it + "Check whether the print function is hooked in. +Should be the same as the value of `haskell-doc-mode' but alas currently it is not." - (interactive) - (message - (if (memq 'haskell-doc-mode-print-current-symbol-info - (if (boundp 'post-command-idle-hook) - post-command-idle-hook - post-command-hook)) - "haskell-doc is ACTIVE" - "haskell-doc is not ACTIVE $Use C-u C-c C-o to turn it on$"))) + (interactive) + (message + (if (memq 'haskell-doc-mode-print-current-symbol-info + (if (boundp 'post-command-idle-hook) + post-command-idle-hook + post-command-hook)) + "haskell-doc is ACTIVE" + (substitute-command-keys + "haskell-doc is not ACTIVE $Use C-u \\[haskell-doc-mode] to turn it on$")))) -;＠node Top level function, Mouse interface, Check, top -;＠section Top level function +;;＠node Top level function, Mouse interface, Check, top +;;＠section Top level function -;＠cindex haskell-doc-mode-print-current-symbol-info +;;＠cindex haskell-doc-mode-print-current-symbol-info ;; This is the function hooked into the elisp command engine (defun haskell-doc-mode-print-current-symbol-info () - "Print the type of the symbol under the cursor. + "Print the type of the symbol under the cursor. This function is hooked into the `post-command-idle-hook' to print the type -automatically if `haskell-doc-mode' is turned on. It can also be called +automatically if `haskell-doc-mode' is turned on. It can also be called directly to ask for the type of a function." (interactive) (and haskell-doc-mode ＠＠ -1232,25 +1236,27 ＠＠ directly to ask for the type of a functi ;; Having this mode operate in the minibuffer makes it impossible to ;; see what you're doing. (not (eq (selected-window) (minibuffer-window))) - ; take a nap + ;; take a nap (sit-for haskell-doc-idle-delay) - ; good morning! read the word under the cursor for breakfast - (let ((current-symbol (haskell-doc-get-current-word)) ); (haskell-doc-current-symbol)) ) - ; (current-fnsym (haskell-doc-fnsym-in-current-sexp))) - (haskell-doc-show-type current-symbol)) )) - -; ; ToDo: find surrounding fct -; (cond ((eq current-symbol current-fnsym) -; (haskell-doc-show-type current-fnsym)) -; (t -; (or nil ; (haskell-doc-print-var-docstring current-symbol) -; (haskell-doc-show-type current-fnsym))))))) + ;; good morning! read the word under the cursor for breakfast + (haskell-doc-show-type))) + ;; ;; ToDo: find surrounding fct + ;; (cond ((eq current-symbol current-fnsym) + ;; (haskell-doc-show-type current-fnsym)) + ;; (t + ;; (or nil ; (haskell-doc-print-var-docstring current-symbol) + ;; (haskell-doc-show-type current-fnsym))))))) + +(defun haskell-doc-current-info () + "Return the info about symbol at point. +Meant for `eldoc-print-current-symbol-info-function'." + (haskell-doc-sym-doc (haskell-doc-get-current-word))) -;＠node Mouse interface, Print fctsym, Top level function, top -;＠section Mouse interface for interactive query +;;＠node Mouse interface, Print fctsym, Top level function, top +;;＠section Mouse interface for interactive query -;＠cindex haskell-doc-ask-mouse-for-type +;;＠cindex haskell-doc-ask-mouse-for-type (defun haskell-doc-ask-mouse-for-type (event) "Read the identifier under the mouse and echo its type. This uses the same underlying function `haskell-doc-show-type' as the hooked ＠＠ -1259,36 +1265,56 ＠＠ function. Only the user interface is dif (save-excursion (select-window (posn-window (event-end event))) (goto-char (posn-point (event-end event))) - (haskell-doc-show-type ))) - + (haskell-doc-show-type))) -;＠node Print fctsym, Movement, Mouse interface, top -;＠section Print fctsym -;＠menu -;* Show type:: -;* Aux:: -;* Global fct type:: -;* Local fct type:: -;＠end menu +;;＠node Print fctsym, Movement, Mouse interface, top +;;＠section Print fctsym -;＠node Show type, Aux, Print fctsym, Print fctsym -;＠subsection Show type +;;＠menu +;;* Show type:: +;;* Aux:: +;;* Global fct type:: +;;* Local fct type:: +;;＠end menu -;＠cindex haskell-doc-show-type +;;＠node Show type, Aux, Print fctsym, Print fctsym +;;＠subsection Show type +;;＠cindex haskell-doc-show-type + ;;;###autoload -(defun haskell-doc-show-type (&optional symbol) +(defun haskell-doc-show-type (&optional sym) "Show the type of the function near point. For the function under point, show the type in the echo area. This information is extracted from the `haskell-doc-prelude-types' alist of prelude functions and their types, or from the local functions in the current buffer." (interactive) - (let* ((sym (or symbol (haskell-doc-get-current-word))) - ; (haskell-doc-current-symbol))); (haskell-doc-fnsym-in-current-sexp))) - (printit t) - (i-am-prelude nil) + (unless sym (setq sym (haskell-doc-get-current-word))) + ;; if printed before do not print it again + (unless (string= sym (car haskell-doc-last-data)) + (let ((doc (haskell-doc-sym-doc sym))) + (when doc + ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all + ;; messages are recorded in a log. Do not put haskell-doc messages + ;; in that log since they are legion. + (if (eval-when-compile (fboundp 'display-message)) + ;; XEmacs 19.13 way of preventing log messages. + ;;(display-message 'no-log (format <args>)) + ;; XEmacs 19.15 seems to be a bit different. + (display-message 'message (format "%s" doc)) + (let ((message-log-max nil)) + (message "%s" doc))))))) + + +(defun haskell-doc-sym-doc (sym) + "Show the type of the function near point. +For the function under point, show the type in the echo area. +This information is extracted from the `haskell-doc-prelude-types' alist +of prelude functions and their types, or from the local functions in the +current buffer." + (let ((i-am-prelude nil) (i-am-fct nil) (type nil) (is-reserved (haskell-doc-is-of sym haskell-doc-reserved-ids)) ＠＠ -1297,10 +1323,6 ＠＠ current buffer." (is-user-defined (haskell-doc-is-of sym haskell-doc-user-defined-ids)) (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types))) (cond - ;; if printed before do not print it again - ((string= sym (car haskell-doc-last-data)) - (setq printit nil) - (setq type (cdr haskell-doc-last-data))) ;; if reserved id (i.e. Haskell keyword ((and haskell-doc-show-reserved is-reserved) ＠＠ -1322,7 +1344,7 ＠＠ current buffer." (setcdr haskell-doc-last-data type)) ((and haskell-doc-show-user-defined is-user-defined) - ; (setq i-am-fct t) + ;; (setq i-am-fct t) (setq type (cdr is-user-defined)) (setcdr haskell-doc-last-data type)) (t ＠＠ -1336,53 +1358,52 ＠＠ current buffer." (setcdr haskell-doc-last-data type)))) ) ;; ToDo: encode i-am-fct info into alist of types (and type - printit - ; drop `::' if it's not a fct + ;; drop `::' if it's not a fct (let ( (str (cond ((and i-am-fct (not haskell-doc-chop-off-fctname)) (format "%s :: %s" sym type)) - (t + (t (format "%s" type)))) ) (if i-am-prelude - (add-text-properties 0 (1- (length str)) '(face bold) str)) - (haskell-doc-message "%s" str)))) ) + (add-text-properties 0 (length str) '(face bold) str)) + str)))) ;; ToDo: define your own notion of `near' to find surrounding fct -;(defun haskell-doc-fnsym-in-current-sexp () -; (let* ((p (point)) -; (sym (progn -; (forward-word -1) +;;(defun haskell-doc-fnsym-in-current-sexp () +;; (let* ((p (point)) +;; (sym (progn +;; (forward-word -1) ;; (while (and (forward-word -1) ; (haskell-doc-forward-sexp-safe -1) ;; (> (point) (point-min)))) -; (cond ((or (= (point) (point-min)) -; (memq (or (char-after (point)) 0) -; '(?\( ?\")) -; ;; If we hit a quotation mark before a paren, we -; ;; are inside a specific string, not a list of -; ;; symbols. -; (eq (or (char-after (1- (point))) 0) ?\")) -; nil) -; (t (condition-case nil -; (read (current-buffer)) -; (error nil))))))) -; (goto-char p) -; (if sym -; (format "%s" sym) -; sym) ) ) +;; (cond ((or (= (point) (point-min)) +;; (memq (or (char-after (point)) 0) +;; '(?$ ?\")) +;; ;; If we hit a quotation mark before a paren, we +;; ;; are inside a specific string, not a list of +;; ;; symbols. +;; (eq (or (char-after (1- (point))) 0) ?\")) +;; nil) +;; (t (condition-case nil +;; (read (current-buffer)) +;; (error nil))))))) +;; (goto-char p) +;; (if sym +;; (format "%s" sym) +;; sym))) ;; (and (symbolp sym) ;; sym))) -;＠node Aux, Global fct type, Show type, Print fctsym -;＠subsection Aux +;;＠node Aux, Global fct type, Show type, Print fctsym +;;＠subsection Aux ;; ToDo: handle open brackets to decide if it's a wrapped type -;＠cindex haskell-doc-grab-line +;;＠cindex haskell-doc-grab-line (defun haskell-doc-grab-line (fct-and-pos) "Get the type of an \(FCT POSITION$ pair from the current buffer." -; (if (null fct-and-pos) -; "" ; fn is not a local fct + ;; (if (null fct-and-pos) + ;; "" ; fn is not a local fct (let ( (str "")) (goto-char (cdr fct-and-pos)) (beginning-of-line) ＠＠ -1396,28 +1417,28 ＠＠ current buffer." (skip-chars-forward " \t") (setq str (concat str (haskell-doc-grab)))) (haskell-doc-string-nub-ws ; squeeze string - (if haskell-doc-chop-off-context ; no context + (if haskell-doc-chop-off-context ; no context (haskell-doc-chop-off-context str) str))))) - ; (concat (car fct-and-pos) "::" (haskell-doc-string-nub-ws str)))) + ;; (concat (car fct-and-pos) "::" (haskell-doc-string-nub-ws str)))) -;＠cindex haskell-doc-wrapped-type-p +;;＠cindex haskell-doc-wrapped-type-p (defun haskell-doc-wrapped-type-p () "Check whether the type under the cursor is wrapped over several lines. The cursor must be at the end of a line, which contains the type. Currently, only the following is checked: -If this line ends with a `->' or the next starts with an `->' it is a +If this line ends with a `->' or the next starts with an `->' it is a multi-line type $same for `=>'$. `--' comments are ignored. ToDo: Check for matching parenthesis!. " (save-excursion (let ( (here (point)) (lim (progn (beginning-of-line) (point))) - ; (foo "") + ;; (foo "") (res nil) ) (goto-char here) - (search-backward "--" lim t) ; skip over `--' comment + (search-backward "--" lim t) ; skip over `--' comment (skip-chars-backward " \t") (if (bolp) ; skip empty lines (progn ＠＠ -1425,15 +1446,13 ＠＠ ToDo: Check for matching parenthesis!. " (end-of-line) (setq res (haskell-doc-wrapped-type-p))) (forward-char -1) - ; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) + ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) (if (or (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) (char-equal (following-char) ?>)) ; (or -!> =!> (char-equal (following-char) ?,)) ; !,) (setq res t) (forward-line) - (let ( (here (point)) - (lim (progn (end-of-line) (point))) - ) + (let ((here (point))) (goto-char here) (skip-chars-forward " \t") (if (looking-at "--") ; it is a comment line ＠＠ -1442,14 +1461,14 ＠＠ ToDo: Check for matching parenthesis!. " (end-of-line) (setq res (haskell-doc-wrapped-type-p))) (forward-char 1) - ; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) - ; (message "|%s|" foo) + ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) + ;; (message "|%s|" foo) (if (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) (char-equal (following-char) ?>)) ; -!> or =!> (setq res t)))))) res))) -;＠cindex haskell-doc-grab +;;＠cindex haskell-doc-grab (defun haskell-doc-grab () "Return the text from point to the end of the line, chopping off comments. Leaves point at end of line." ＠＠ -1459,7 +1478,7 ＠＠ Leaves point at end of line." str (substring str 0 i)))) -;＠cindex haskell-doc-string-nub-ws +;;＠cindex haskell-doc-string-nub-ws (defun haskell-doc-string-nub-ws (str) "Replace all sequences of whitespaces in STR by just one whitespace. ToDo: Also eliminate leading and trainling whitespace." ＠＠ -1467,66 +1486,65 ＠＠ ToDo: Also eliminate leading and trainli (let ( (res str) (i 0) - ) + ) (setq i (string-match "\$\\s-+\$" res i)) (while (not (null i)) (setq res (replace-match " " t t res)) (setq i (string-match "\$\\s-+\$" res (1+ i))) ) res) ) -; ToDo: make this more efficient!! -;(defun haskell-doc-string-nub-ws (str) -; "Replace all sequences of whitespaces in STR by just one whitespace." -; (let ( (res "") -; (l (length str)) -; (i 0) -; (j 0) -; (in-ws nil)) -; (while (< i l) -; (let* ( (c (string-to-char (substring str i (1+ i)))) -; (is-ws (eq (char-syntax c) ? )) ) -; (if (not (and in-ws is-ws)) -; (setq res (concat res (char-to-string c)))) -; (setq in-ws is-ws) -; (setq i (1+ i)))) -; res)) +;; ToDo: make this more efficient!! +;;(defun haskell-doc-string-nub-ws (str) +;; "Replace all sequences of whitespaces in STR by just one whitespace." +;; (let ( (res "") +;; (l (length str)) +;; (i 0) +;; (j 0) +;; (in-ws nil)) +;; (while (< i l) +;; (let* ( (c (string-to-char (substring str i (1+ i)))) +;; (is-ws (eq (char-syntax c) ? )) ) +;; (if (not (and in-ws is-ws)) +;; (setq res (concat res (char-to-string c)))) +;; (setq in-ws is-ws) +;; (setq i (1+ i)))) +;; res)) -;＠cindex haskell-doc-chop-off-context +;;＠cindex haskell-doc-chop-off-context (defun haskell-doc-chop-off-context (str) "Eliminate the contex in a type represented by the string STR." - (let ((i (string-match "=>" str)) ) + (let ((i (string-match "=>" str)) ) (if (null i) str (substring str (+ i 2))))) -;＠cindex haskell-doc-get-imenu-info +;;＠cindex haskell-doc-get-imenu-info (defun haskell-doc-get-imenu-info (obj kind) "Returns a string describing OBJ of KIND $Variables, Types, Data$." (cond ((or (eq major-mode 'haskell-hugs-mode) ;; GEM: Haskell Mode does not work with Haskell Doc ;; under XEmacs 20.x (and (eq major-mode 'haskell-mode) - (not (and haskell-doc-xemacs-p + (not (and (featurep 'xemacs) (string-match "^20" emacs-version))))) - (let* ( (imenu-info-alist (cdr (assoc kind imenu--index-alist))) - ; (names (mapcar (lambda (x) (car x)) imenu-info-alist)) - (x (assoc obj imenu-info-alist)) - ) + (let* ((imenu-info-alist (cdr (assoc kind imenu--index-alist))) + ;; (names (mapcar 'car imenu-info-alist)) + (x (assoc obj imenu-info-alist))) (if x (haskell-doc-grab-line x) - nil)) ) + nil))) (t - ; (error "Cannot get local functions in %s mode, sorry" major-mode))) ) + ;; (error "Cannot get local functions in %s mode, sorry" major-mode))) ) nil))) -;＠node Global fct type, Local fct type, Aux, Print fctsym -;＠subsection Global fct type +;;＠node Global fct type, Local fct type, Aux, Print fctsym +;;＠subsection Global fct type ;; ToDo: ;; - modular way of defining a mapping of module name to file ;; - use a path to search for file (not just current directory) -;＠cindex haskell-doc-imported-list +;;＠cindex haskell-doc-imported-list (defun haskell-doc-imported-list (outer-file) "Return a list of the imported modules in OUTER-FILE." ＠＠ -1552,12 +1570,12 ＠＠ ToDo: Also eliminate leading and trainli (cons file imported-file-list)))) ) (nreverse imported-file-list) - ;(message imported-file-list) -))) + ;;(message imported-file-list) + ))) ;; ToDo: generalise this to "Types" etc (not just "Variables") -;＠cindex haskell-doc-rescan-files +;;＠cindex haskell-doc-rescan-files (defun haskell-doc-rescan-files (filelist) "Does an `imenu' rescan on every file in FILELIST and returns the fct-list. ＠＠ -1572,7 +1590,7 ＠＠ This function switches to and potentiall fn-alist)) ) ) filelist ) ) -;＠cindex haskell-doc-make-global-fct-index +;;＠cindex haskell-doc-make-global-fct-index (defun haskell-doc-make-global-fct-index () "Scan imported files for types of global fcts and update `haskell-doc-index'." ＠＠ -1586,17 +1604,17 ＠＠ This function switches to and potentiall ;; ToDo: use a separate munge-type function to format type concisely -;＠cindex haskell-doc-get-global-fct-type +;;＠cindex haskell-doc-get-global-fct-type (defun haskell-doc-get-global-fct-type (&optional sym) "Get type for function symbol SYM by examining `haskell-doc-index'." (interactive) ; "fName of outer `include' file: \nsFct:") (save-excursion - ; (switch-to-buffer "*scratch*") - ; (goto-char (point-max)) - ;; Produces a list of fct-type alists -; (if (null sym) -; (setq sym (progn (forward-word -1) (read (current-buffer))))) + ;; (switch-to-buffer "*scratch*") + ;; (goto-char (point-max)) + ;; ;; Produces a list of fct-type alists + ;; (if (null sym) + ;; (setq sym (progn (forward-word -1) (read (current-buffer))))) (or sym (current-word)) (let* ( (fn sym) ; (format "%s" sym)) ＠＠ -1616,10 +1634,10 ＠＠ This function switches to and potentiall (setq fal (cdr fal)))) res))) ; (message res)) ) -;＠node Local fct type, , Global fct type, Print fctsym -;＠subsection Local fct type +;;＠node Local fct type, , Global fct type, Print fctsym +;;＠subsection Local fct type -;＠cindex haskell-doc-get-and-format-fct-type +;;＠cindex haskell-doc-get-and-format-fct-type (defun haskell-doc-get-and-format-fct-type (fn) "Get the type and kind of FN by checking local and global functions." ＠＠ -1628,100 +1646,46 ＠＠ This function switches to and potentiall (let ((docstring "") (doc nil) ) - ; is it a local function? + ;; is it a local function? (setq docstring (haskell-doc-get-imenu-info fn "Variables")) (if (not (null docstring)) - ; (string-match (format "^%s\\s-+::\\s-+\$.*\$$" fn) docstring)) + ;; (string-match (format "^%s\\s-+::\\s-+\$.*\$$" fn) docstring)) (setq doc `(,docstring . "Variables"))) ; `(,(match-string 1 docstring) . "Variables") )) - ; is it a type declaration? + ;; is it a type declaration? (setq docstring (haskell-doc-get-imenu-info fn "Types")) (if (not (null docstring)) - ; (string-match (format "^\\s-*type\\s-+%s.*$" fn) docstring)) + ;; (string-match (format "^\\s-*type\\s-+%s.*$" fn) docstring)) (setq doc `(,docstring . "Types"))) ; `(,(match-string 0 docstring) . "Types")) ) (if (not (null docstring)) - ; (string-match (format "^\\s-*data.*%s.*$" fn) docstring)) + ;; (string-match (format "^\\s-*data.*%s.*$" fn) docstring)) (setq doc `(,docstring . "Data"))) ; (setq doc `(,(match-string 0 docstring) . "Data")) ) - ; return the result + ;; return the result doc )))) -;＠node Movement, Bug Reports, Print fctsym, top -;＠section Movement -; Functions for moving in text and extracting the current word under the cursor - -; prbly nukable - -;; forward-sexp calls scan-sexps, which returns an error if it hits the -;; beginning or end of the sexp. This returns nil instead. -(defun haskell-doc-forward-sexp-safe (&optional count) - "Move forward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -COUNT means -move backward across COUNT balanced expressions. -Return distance in buffer moved, or nil." - (or count (setq count 1)) - (condition-case err - (- (- (point) (progn - (let ((parse-sexp-ignore-comments t)) - (forward-sexp count)) - (point)))) - (error nil))) - -;; Do indirect function resolution if possible. -;(defun haskell-doc-symbol-function (fsym) -; (let ((defn (and (fboundp fsym) -; (symbol-function fsym)))) -; (and (symbolp defn) -; (condition-case err -; (setq defn (indirect-function fsym)) -; (error (setq defn nil)))) -; defn)) - -;; HWL: currently unused; this is taken from eldoc - -(defun haskell-doc-current-symbol () - (let ((c (char-after (point)))) - (and c - (memq (char-syntax c) '(?w ?_)) - (current-word)))) +;;＠node Movement, Bug Reports, Print fctsym, top +;;＠section Movement +;; Functions for moving in text and extracting the current word under the cursor ;; HWL: my attempt at more efficient (current-word) -;＠cindex haskell-doc-is-id-char-at -(defsubst haskell-doc-is-id-char-at (x) - (let ( (c (char-syntax (char-after x))) ) - (or (eq c ?w) (eq c ?_))) ) - ;; NB: this function is called from within the hooked print function; ;; therefore this function must not fail, otherwise the function will ;; be de-installed; ;; if no word under the cursor return an empty string -;＠cindex haskell-doc-get-current-word +;;＠cindex haskell-doc-get-current-word (defun haskell-doc-get-current-word () - "Return the word under the cursor, or empty string if no word found." - ; (interactive) - (if (bobp) - "" - (let ((x (1- (point))) - (beg) - (end) - ) - ; go back to first non-word char - (while (and (> x (point-min)) (haskell-doc-is-id-char-at x)) ; (not (bobp)) - (setq x (1- x)) ) - (if (= x (point-min)) - (setq beg x) - (setq beg (1+ x))) - (setq x (1+ x)) - (while (and (< x (point-max)) (haskell-doc-is-id-char-at x)) ; (not (eobp)) - (setq x (1+ x)) ) - (setq end x) - (buffer-substring-no-properties beg end)))) + "Return the word under the cursor, or empty string if no word found." + (save-excursion + (buffer-substring-no-properties + (progn (skip-syntax-backward "w_") (point)) + (progn (skip-syntax-forward "w_") (point))))) -;＠node Bug Reports, Visit home site, Movement, top -;＠section Bug Reports +;;＠node Bug Reports, Visit home site, Movement, top +;;＠section Bug Reports -;＠cindex haskell-doc-submit-bug-report -; send a bug report +;;＠cindex haskell-doc-submit-bug-report +;; send a bug report (defun haskell-doc-submit-bug-report () "Send email to the maintainer of `haskell-doc-mode'." (interactive) ＠＠ -1741,63 +1705,60 ＠＠ Return distance in buffer moved, or nil. (beep) (message "Sorry, reporter.el not found.")))) -;＠node Visit home site, Index, Bug Reports, top -;＠section Visit home site +;;＠node Visit home site, Index, Bug Reports, top +;;＠section Visit home site -;＠cindex haskell-doc-visit-home +;;＠cindex haskell-doc-visit-home (defun haskell-doc-visit-home () "Jump to the main FTP site for `haskell-doc-mode'." (interactive) - (if haskell-doc-xemacs-p - (require 'efs) - (require 'ange-ftp)) + (if (featurep 'xemacs) + (require 'efs)) (require 'dired) (dired-other-window haskell-doc-ftp-site)) -;＠appendix +;;＠appendix -;＠node Index, Token, Visit home site, top -;＠section Index +;;＠node Index, Token, Visit home site, top +;;＠section Index -;＠index -;* haskell-doc-ask-mouse-for-type:: -;* haskell-doc-check-active:: -;* haskell-doc-chop-off-context:: -;* haskell-doc-get-and-format-fct-type:: -;* haskell-doc-get-current-word:: -;* haskell-doc-get-global-fct-type:: -;* haskell-doc-get-imenu-info:: -;* haskell-doc-grab:: -;* haskell-doc-grab-line:: -;* haskell-doc-imported-list:: -;* haskell-doc-install-keymap:: -;* haskell-doc-is-id-char-at:: -;* haskell-doc-is-of:: -;* haskell-doc-make-global-fct-index:: -;* haskell-doc-message:: -;* haskell-doc-mode:: -;* haskell-doc-mode-print-current-symbol-info:: -;* haskell-doc-prelude-types:: -;* haskell-doc-rescan-files:: -;* haskell-doc-reserved-ids:: -;* haskell-doc-show-global-types:: -;* haskell-doc-show-prelude:: -;* haskell-doc-show-reserved:: -;* haskell-doc-show-strategy:: -;* haskell-doc-show-type:: -;* haskell-doc-show-user-defined:: -;* haskell-doc-strategy-ids:: -;* haskell-doc-string-nub-ws:: -;* haskell-doc-submit-bug-report:: -;* haskell-doc-visit-home:: -;* haskell-doc-wrapped-type-p:: -;* turn-off-haskell-doc-mode:: -;* turn-on-haskell-doc-mode:: -;＠end index +;;＠index +;;* haskell-doc-ask-mouse-for-type:: +;;* haskell-doc-check-active:: +;;* haskell-doc-chop-off-context:: +;;* haskell-doc-get-and-format-fct-type:: +;;* haskell-doc-get-current-word:: +;;* haskell-doc-get-global-fct-type:: +;;* haskell-doc-get-imenu-info:: +;;* haskell-doc-grab:: +;;* haskell-doc-grab-line:: +;;* haskell-doc-imported-list:: +;;* haskell-doc-install-keymap:: +;;* haskell-doc-is-of:: +;;* haskell-doc-make-global-fct-index:: +;;* haskell-doc-mode:: +;;* haskell-doc-mode-print-current-symbol-info:: +;;* haskell-doc-prelude-types:: +;;* haskell-doc-rescan-files:: +;;* haskell-doc-reserved-ids:: +;;* haskell-doc-show-global-types:: +;;* haskell-doc-show-prelude:: +;;* haskell-doc-show-reserved:: +;;* haskell-doc-show-strategy:: +;;* haskell-doc-show-type:: +;;* haskell-doc-show-user-defined:: +;;* haskell-doc-strategy-ids:: +;;* haskell-doc-string-nub-ws:: +;;* haskell-doc-submit-bug-report:: +;;* haskell-doc-visit-home:: +;;* haskell-doc-wrapped-type-p:: +;;* turn-off-haskell-doc-mode:: +;;* turn-on-haskell-doc-mode:: +;;＠end index -;＠node Token, , Index, top -;＠section Token +;;＠node Token, , Index, top +;;＠section Token (provide 'haskell-doc) 1.4 +267 -380 XEmacs/packages/xemacs-packages/haskell-mode/haskell-font-lock.el Index: haskell-font-lock.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-font-lock.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- haskell-font-lock.el 2004/06/16 15:16:49 1.3 +++ haskell-font-lock.el 2006/03/15 05:18:22 1.4 ＠＠ -1,15 +1,14 ＠＠ ;;; haskell-font-lock.el --- Font locking module for Haskell Mode +;; Copyright 2003, 2004, 2005 Free Software Foundation, Inc. ;; Copyright 1997-1998 Graeme E Moss, and Tommy Thorn -;; Copyright 2003 Free Software Foundation, Inc. ;; Authors: 1997-1998 Graeme E Moss <gem(a)cs.york.ac.uk> and ;; Tommy Thorn <thorn(a)irisa.fr> ;; 2003 Dave Love <fx(a)gnu.org> ;; Keywords: faces files Haskell -;; Version: 1.2 -;;; This file is not part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ＠＠ -55,7 +54,7 ＠＠ ;; ;; If you have any problems or suggestions, after consulting the list ;; below, email gem(a)cs.york.ac.uk and thorn(a)irisa.fr quoting the -;; version of the mode you are using, the version of emacs you are +;; version of the mode you are using, the version of Emacs you are ;; using, and a small example of the problem or suggestion. Note that ;; this module requires a reasonably recent version of Emacs. It ;; requires Emacs 21 to cope with Unicode characters and to do proper ＠＠ -95,198 +94,184 ＠＠ ;; . Support for GreenCard? ;; -;;; All functions/variables start with -;;; `(turn-(on/off)-)haskell-font-lock' or `haskell-fl-'. +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-font-lock' or `haskell-fl-'. -(eval-when-compile (require 'haskell-mode)) +;;; Code: + +(eval-when-compile + (require 'haskell-mode) + (require 'cl)) (require 'font-lock) ;; Version. -(defconst haskell-font-lock-version "1.3" - "haskell-font-lock version number.") +(defconst haskell-font-lock-version "1.17" + "Version number of haskell-font-lock.") (defun haskell-font-lock-version () "Echo the current version of haskell-font-lock in the minibuffer." (interactive) (message "Using haskell-font-lock version %s" haskell-font-lock-version)) - -(defvar haskell-font-lock-keywords () - "The default definitions used by font lock for fontification of -non-literate Haskell scripts. This variable is set by -`turn-on-haskell-font-lock' and then used by `font-lock-defaults'.") - -(defvar haskell-font-lock-keywords-1 () - "Medium level font lock definitions for non-literate Haskell.") - -(defvar haskell-font-lock-keywords-2 () - "High level font lock definitions for non-literate Haskell.") - -(defvar bird-literate-haskell-font-lock-keywords () - "The default definitions used by font lock for fontification of -Bird-style literate Haskell scripts. This variable is set by -`turn-on-haskell-font-lock' and then used by `font-lock-defaults'.") - -(defvar bird-literate-haskell-font-lock-keywords-1 () - "Medium level font lock definitions for Bird-style literate Haskell.") -(defvar bird-literate-haskell-font-lock-keywords-2 () - "High level font lock definitions for Bird-style literate Haskell.") +(defcustom haskell-font-lock-symbols nil + "Display \\ and -> and such using symbols in fonts. +This may sound like a neat trick, but be extra careful: it changes the +alignment and can thus lead to nasty surprises w.r.t layout. +If t, try to use whichever font is available. Otherwise you can +set it to a particular font of your preference among `japanese-jisx0208' +and `unicode'." +:group 'haskell +:type '(choice (const nil) + (const t) + (const unicode) + (const japanese-jisx0208))) -(defvar latex-literate-haskell-font-lock-keywords () - "The default definitions used by font lock for fontification of -LaTeX-style literate Haskell scripts. This variable is set by -`turn-on-haskell-font-lock' and then used by `font-lock-defaults'.") - -(defvar latex-literate-haskell-font-lock-keywords-1 () - "Medium level font lock definitions for LaTeX-style literate Haskell.") - -(defvar latex-literate-haskell-font-lock-keywords-2 () - "High level font lock definitions for LaTeX-style literate Haskell.") +(defconst haskell-font-lock-symbols-alist + (append + ;; Prefer single-width Unicode font for lambda. + (and (fboundp 'decode-char) + (memq haskell-font-lock-symbols '(t unicode)) + (list (cons "\\" (decode-char 'ucs 955)))) + ;; The symbols can come from a JIS0208 font. + (and (fboundp 'make-char) (charsetp 'japanese-jisx0208) + (memq haskell-font-lock-symbols '(t japanese-jisx0208)) + (list (cons "not" (make-char 'japanese-jisx0208 34 76)) + (cons "\\" (make-char 'japanese-jisx0208 38 75)) + (cons "->" (make-char 'japanese-jisx0208 34 42)) + (cons "<-" (make-char 'japanese-jisx0208 34 43)) + (cons "=>" (make-char 'japanese-jisx0208 34 77)))) + ;; Or a unicode font. + (and (fboundp 'decode-char) + (memq haskell-font-lock-symbols '(t unicode)) + (list (cons "not" (decode-char 'ucs 172)) + (cons "->" (decode-char 'ucs 8594)) + (cons "<-" (decode-char 'ucs 8592)) + (cons "=>" (decode-char 'ucs 8658)) + (cons "~>" (decode-char 'ucs 8669)) ;; Omega language + ;; (cons "~>" (decode-char 'ucs 8605)) ;; less desirable + (cons "-<" (decode-char 'ucs 8610)) ;; Paterson's arrow syntax + ;; (cons "-<" (decode-char 'ucs 10521)) ;; nicer but uncommon + (cons "::" (decode-char 'ucs 8759)) + (cons "." (decode-char 'ucs 9675)))))) + +;; Use new vars for the font-lock faces. The indirection allows people to +;; use different faces than in other modes, as before. +(defvar haskell-keyword-face 'font-lock-keyword-face) +(defvar haskell-constructor-face 'font-lock-type-face) +;; This used to be `font-lock-variable-name-face' but it doesn't result in +;; a highlighting that's consistent with other modes (it's mostly used +;; for function defintions). +(defvar haskell-definition-face 'font-lock-function-name-face) +;; This is probably just wrong, but it used to use +;; `font-lock-function-name-face' with a result that was not consistent with +;; other major modes, so I just exchanged with `haskell-definition-face'. +(defvar haskell-operator-face 'font-lock-variable-name-face) +(defvar haskell-default-face nil) +(defvar haskell-literate-comment-face 'font-lock-doc-face + "Face with which to fontify literate comments. +Set to `default' to avoid fontification of them.") -(eval-and-compile (defconst haskell-emacs21-features (string-match "[[:alpha:]]" "x") "Non-nil if we have regexp char classes. Assume this means we have other useful features from Emacs 21.") - (if haskell-emacs21-features -(defvar haskell-literate-comment-face 'haskell-comment-face - "Face with which to fontify literate comments. -Set to `default' to avoid fontification of them.")) +(defun haskell-font-lock-compose-symbol (alist) + "Compose a sequence of ascii chars into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (cond + ((eq (char-syntax (char-after start)) ?w) '(?w)) + ;; Special case for the . used for qualified names. + ((and (eq (char-after start) ?\.) (= end (1+ start))) + '(?_ ?\\ ?w)) + (t '(?_ ?\\))))) + (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) + (memq (char-syntax (or (char-after end) ?\ )) syntaxes) + (memq (get-text-property start 'face) + '(font-lock-doc-face font-lock-string-face + font-lock-comment-face))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc (match-string 0) alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun haskell-font-lock-symbols-keywords () + (when (fboundp 'compose-region) + (let ((alist nil)) + (dolist (x haskell-font-lock-symbols-alist) + (when (and (if (fboundp 'char-displayable-p) + (char-displayable-p (cdr x)) + t) + (not (assoc (car x) alist))) ;Not yet in alist. + (push x alist))) + (when alist + `((,(regexp-opt (mapcar 'car alist) t) + (0 (haskell-font-lock-compose-symbol ',alist)))))))) ;; The font lock regular expressions. - (if haskell-emacs21-features -(defun haskell-font-lock-keywords-create (bird-literate latex-literate level) - "Creates appropriate LEVEL (1 or 2) of fontification definitions -for (BIRD-LITERATE or LATEX-LITERATE) Haskell scripts. Returns keywords -suitable for `font-lock-keywords'." +(defun haskell-font-lock-keywords-create (literate) + "Create fontification definitions for Haskell scripts. +Returns keywords suitable for `font-lock-keywords'." (let* (;; Bird-style literate scripts start a line of code with ;; "^>", otherwise a line of code starts with "^". - (line-prefix (if bird-literate "^>" "^")) + (line-prefix (if (eq literate 'bird) "^> ?" "^")) ;; Most names are borrowed from the lexical syntax of the Haskell - ;; report. - - ;; We allow _ as the first char to fit GHC - (id "\\b[[:alnum:]'_]+\\b") - (varid "\\b[[:lower:]_][[:alnum:]'_]*\\b") - (conid "\\b[[:upper:]][[:alnum:]'_]*\\b") - (modid (concat "\\b" conid "\$?:\\." conid "\$*\\b")) - (qconid (concat modid "\\." conid)) - (sym - ;; Add backslash to the symbol-syntax chars. This seems to - ;; be thrown for some reason by backslash's escape syntax. - "\$?:\\s_\\|\\\\\$+") - font-lock-keywords) - - (setq font-lock-keywords - `( -;; -;; NOTICE the ordering below is significant -;; - ("^#.*$" 0 'font-lock-warning-face t) - ,(eval-when-compile - (regexp-opt - ;; ?? `as' and `qualified' aren't in the Haskell98 list. - ;; `_' can go in here since it has temporary word syntax. - '("as" "case" "class" "data" "default" "deriving" "do" "else" - "hiding" "if" "import" "in" "infix" "infixl" "infixr" - "instance" "let" "module" "newtype" "of" "qualified" "then" - "type" "where" "_") - 'words)) - (,(eval-when-compile - ;; Would lose at bol. - (concat "\\S_" - (regexp-opt '(".." "::" "=" "\\" "|" "<-" "->" - "＠" "~" "=>") - t) - "\\S_")) - (1 'haskell-operator-face)) - - ;; These four are debatable... - ("()" 0 'haskell-constructor-face) - ("(,*)" 0 'haskell-constructor-face) - ("\\[\\]" 0 'haskell-constructor-face) - ("(->)" 0 'haskell-constructor-face) - ,`(,qconid 0 'haskell-constructor-face) - ,＠(if (eq level 2) - `(,`(,(concat "\`" varid "\`") 0 'haskell-operator-face))) - ;; Expensive. - ,`(,conid 0 'haskell-constructor-face) - ,＠(if (eq level 2) - (list (list (concat "\\S_\$:\\(?:" sym "\$?\\)") - '(1 'haskell-constructor-face)))) - ,＠(if (eq level 2) - (list (list sym '(0 'haskell-operator-face)))) - - ;; Declarations. - (,(concat line-prefix "\$" varid "\$\\s-*\$?:" varid - "\\|::\\|=\\||\$") - (1 'haskell-definition-face)) - (,(concat line-prefix "\$" varid "\$\\s-*\$" sym "\$") - (1 'default) - (2 'haskell-definition-face)) - (,(concat line-prefix "\$" varid "\$\\s-*\\s(") - (1 'haskell-definition-face)) - (,(concat line-prefix "(\$" sym "\$)") - (1 'haskell-definition-face)))) - (if bird-literate - ;; Don't colour the Bird tracks. - (setq font-lock-keywords - (append font-lock-keywords '(("^>" 0 'default t))))) - font-lock-keywords)) -(defun haskell-font-lock-keywords-create (bird-literate latex-literate level) - "Creates appropriate LEVEL (1 or 2) of fontification definitions -for (BIRD-LITERATE or LATEX-LITERATE) Haskell scripts. Returns keywords -suitable for `font-lock-keywords'." - (let* (;; Bird-style literate scripts start a line of code with - ;; "^>", otherwise a line of code starts with "^". - (line-prefix (if bird-literate "^>" "^")) - - ;; Most names are borrowed from the lexical syntax of the Haskell ;; report. ;; Some of these definitions have been superseded by using the ;; syntax table instead. - (ASCsymbol "-!#$%&*+./<=>?＠\\\\^|~") + ;; (ASCsymbol "-!#$%&*+./<=>?＠\\\\^|~") ;; Put the minus first to make it work in ranges. - (ISOsymbol "\241-\277\327\367") + ;; (ISOsymbol "\241-\277\327\367") (ISOlarge "\300-\326\330-\337") (ISOsmall "\340-\366\370-\377") (small - (concat "a-z" ISOsmall)) + (if haskell-emacs21-features "[:lower:]" (concat "a-z" ISOsmall))) (large - (concat "A-Z" ISOlarge)) - (symbol - (concat ASCsymbol ISOsymbol)) + (if haskell-emacs21-features "[:upper:]" (concat "A-Z" ISOlarge))) + (alnum + (if haskell-emacs21-features "[:alnum:]" (concat small large "0-9"))) + ;; (symbol + ;; (concat ASCsymbol ISOsymbol)) ;; We allow _ as the first char to fit GHC - (id - (concat "\\b\$[" small large "0-9'_]+\$\\b")) - (varid - (concat "\\b\$[" small "_][" small large "0-9'_]*\$\\b")) - (conid - (concat "\\b\$[" large "][" small large "0-9'_]*\$\\b")) - (modid - (concat "\\b" conid "\$\\." conid "\$*\\b")) - (qvarid - (concat modid "\\." varid)) - (qconid - (concat modid "\\." conid)) + (varid (concat "\\b[" small "_][" alnum "'_]*\\b")) + (conid (concat "\\b[" large "][" alnum "'_]*\\b")) + (modid (concat "\\b" conid "\$\\." conid "\$*\\b")) + (qvarid (concat modid "\\." varid)) + (qconid (concat modid "\\." conid)) (sym - (concat "[" symbol ":]+")) + ;; We used to use the below for non-Emacs21, but I think the + ;; regexp based on syntax works for other emacsen as well. -- Stef + ;; (concat "[" symbol ":]+") + ;; Add backslash to the symbol-syntax chars. This seems to + ;; be thrown for some reason by backslash's escape syntax. + "\$\\s_\\|\\\\\$+") ;; Reserved operations (reservedsym - '(".." "::" "=" "\\" "|" "<-" "->" "＠" "~" "=>")) + (concat "\\S_" + ;; (regexp-opt '(".." "::" "=" "\\" "|" "<-" "->" + ;; "＠" "~" "=>") t) + "\$->\\|\\.\\.\\|::\\|<-\\|=>\\|[=＠\\|~]\$" + "\\S_")) ;; Reserved identifiers - ;(reservedid - ; '("as" "case" "class" "data" "default" "deriving" "do" "else" - ; "hiding" "if" "import" "in" "infix" "infixl" "infixr" - ; "instance" "let" "module" "newtype" "of" "qualified" "then" - ; "type" "where")) - ;; make-regexp applied to reservedid creates the following - ;; regexp (reservedid - "\\b\$c\\(ase\\|lass\$\\|d\$ata\\|e\\(fault\\|riving\$\\|o\\)\\|else\\|hiding\\|i\$[fn]\\|mport\\|n\\(fix\\(\\|[lr]\$\\|stance\\)\\)\\|let\\|module\\|newtype\\|of\\|qualified\\|t\$hen\\|ype\$\\|where\\)\\b") + (concat "\\b" + ;; ?? `as' and `qualified' aren't in the Haskell98 list. + ;; `_' can go in here since it has temporary word syntax. + ;; (regexp-opt + ;; '("as" "case" "class" "data" "default" "deriving" "do" + ;; "else" "hiding" "if" "import" "in" "infix" "infixl" + ;; "infixr" "instance" "let" "module" "newtype" "of" + ;; "qualified" "then" "type" "where" "_") t) + "\$_\\|as\\|c\\(ase\\|lass\$\\|d\$ata\\|e\\(fault\\|riving\$\\|o\\)\\|else\\|hiding\\|i\$mport\\|n\\(fix[lr]?\\|stance\$\\|[fn]\\)\\|let\\|module\\|newtype\\|of\\|qualified\\|t\$hen\\|ype\$\\|where\\)" + "\\b")) ;; This unreadable regexp matches strings and character ;; constants. We need to do this with one regexp to handle ＠＠ -298,62 +283,68 ＠＠ suitable for `font-lock-keywords'." (concat "\$\\(\"\\|" line-prefix "[ \t]*\\\\\$\$[^\"\\\\\n]\\|\\\\.\$*\$\"\\|\\\\[ \t]*$\$\\|'\$[^'\\\\\n]\\|\\\\.[^'\n]*\$'\\)")) ;; Top-level declarations - ;; These are not included as they don't work well (yet). -; (topdecl1 -; (concat line-prefix "\$" varid "\$\$\\s-\\|::\\|=\\||\$")) -; (topdecl2 -; (concat line-prefix varid "\\s-*\$" sym "\$")) -; (topdecl3 -; (concat line-prefix "(\$" sym "\$)")) - - font-lock-keywords) - - (setq font-lock-keywords - `( -;; -;; NOTICE the ordering below is significant -;; - ("--.*$" 0 'haskell-comment-face t) + (topdecl-var + (concat line-prefix "\$" varid "\$\\s-*\$" + varid "\\|" conid "\\|::\\|=\\||\\|\\s(\$")) + (topdecl-var2 + (concat line-prefix "\$" varid "\\|" conid "\$\\s-*`\$" varid "\$`")) + (topdecl-sym + (concat line-prefix "\$" varid "\\|" conid "\$\\s-*\$" sym "\$")) + (topdecl-sym2 (concat line-prefix "(\$" sym "\$)")) + + keywords) + + (setq keywords + `(;; NOTICE the ordering below is significant + ;; ("^#.*$" 0 'font-lock-warning-face t) - ;; Expensive. - ,`(,string-and-char 1 'haskell-string-char-face) + ,＠(unless haskell-emacs21-features + ;; Expensive. + `((,string-and-char 1 font-lock-string-face))) + + ;; This was originally at the very end (and needs to be after + ;; all the comment/string/doc highlighting) but it seemed to + ;; trigger a bug in Emacs-21.3 which caused the compositions to + ;; be "randomly" dropped. Moving it earlier seemed to reduce + ;; the occurrence of the bug. + ,＠(haskell-font-lock-symbols-keywords) + + (,reservedid 1 (symbol-value 'haskell-keyword-face)) + (,reservedsym 1 (symbol-value 'haskell-operator-face)) + + ;; Toplevel Declarations. + ;; Place them *before* generic id-and-op highlighting. + (,topdecl-var (1 (symbol-value 'haskell-definition-face))) + (,topdecl-var2 (2 (symbol-value 'haskell-definition-face))) + (,topdecl-sym (2 (symbol-value 'haskell-definition-face))) + (,topdecl-sym2 (1 (symbol-value 'haskell-definition-face))) + ;; These four are debatable... - ("()" 0 'haskell-constructor-face) - ("(,*)" 0 'haskell-constructor-face) - ("\\[\\]" 0 'haskell-constructor-face) - ("(->)" 0 'haskell-constructor-face) + ("(\$,*\\|->\$)" 0 (symbol-value 'haskell-constructor-face)) + ("\\[\\]" 0 (symbol-value 'haskell-constructor-face)) ;; Expensive. - ,`(,reservedid 1 'haskell-keyword-face) - ,`(,qvarid 0 'haskell-default-face) - ,`(,qconid 0 'haskell-constructor-face) - ,＠(if (eq level 2) - `(,`(,(concat "\`" varid "\`") 0 'haskell-operator-face)) - '()) + (,qvarid 0 haskell-default-face) + (,qconid 0 (symbol-value 'haskell-constructor-face)) + (,(concat "\`" varid "\`") 0 (symbol-value 'haskell-operator-face)) ;; Expensive. - ,`(,conid 1 'haskell-constructor-face) + (,conid 0 (symbol-value 'haskell-constructor-face)) + ;; Very expensive. - ,`(,sym 0 ,`(let ((match (match-string 0))) - ,`(cond - ,`(,`(member match ',reservedsym) - 'haskell-operator-face) - ((eq (aref match 0) ?:) 'haskell-constructor-face) - ,＠(if (eq level 2) - '((t 'haskell-operator-face)) - '())))) - ;; (list topdecl1 1 ''haskell-definition-face t) - ;; (list topdecl2 1 ''haskell-definition-face t) - ;; (list topdecl3 1 ''haskell-definition-face t) - )) - (if bird-literate - (setq font-lock-keywords - `(("^[^>\n].*$" 0 'haskell-comment-face t) - ,＠font-lock-keywords - ("^>" 0 'haskell-default-face t))) - (if latex-literate - (setq font-lock-keywords - `((haskell-fl-latex-comments 0 'font-lock-comment-face t) - ,＠font-lock-keywords)))) - font-lock-keywords)))) + (,sym 0 (if (eq (char-after (match-beginning 0)) ?:) + haskell-constructor-face + haskell-operator-face)))) + (unless haskell-emacs21-features + (case literate + (bird + (setq keywords + `(("^[^>\n].*$" 0 haskell-comment-face t) + ,＠keywords + ("^>" 0 haskell-default-face t)))) + (latex + (setq keywords + `((haskell-fl-latex-comments 0 'font-lock-comment-face t) + ,＠keywords))))) + keywords)) ;; The next three aren't used in Emacs 21. ＠＠ -404,200 +395,103 ＠＠ that should be commented under LaTeX-sty ;; If one found, mark it as a comment, otherwise finish. (point)))))) -(eval-and-compile - (if haskell-emacs21-features -(defvar haskell-fl-syntax - ;; The mode syntax table will basically DTRT. However, it's - ;; convenient to treat the non-ASCII punctuation characters as - ;; symbol. (We probably have to keep `,' and `;' as - ;; punctuation, so we can't just consider sequences of - ;; punctuation and symbol syntax. We could also use - ;; categories.) - `((?_ . "w") ; in case _ has normal syntax - (?' . "w") - ,＠(let (cs i lim) - (let ((table (make-syntax-table))) - (map-char-table - (lambda (k v) - ;; The current Emacs 22 codebase can pass either a char - ;; or a char range. - (if (consp k) - (setq i (car k) - lim (cdr k)) - (setq i k - lim k)) - (if (<= i lim) - (when (and (> i 127) - (equal v '(1))) - (push (cons i "-") cs)) - (setq i (1+ i)))) - (standard-syntax-table))) - cs)) - "Syntax required for font locking. -Given as a list of pairs for use in `font-lock-defaults'.") -(defvar haskell-fl-syntax - ;; It's easier for us to manually set the ISO Latin1 syntax as I'm - ;; not sure what libraries are available and how they differ from - ;; Haskell, eg. the iso-syntax library of Emacs 19.34 defines \241 - ;; as punctuation for good reasons but this conflicts with Haskell - ;; so we would have to redefine it. It's simpler for us to set the - ;; syntax table according to the Haskell report for all of the 8-bit - ;; characters. - `((?\ . " ") - (?\t . " ") - (?\" . " ") - (?\' . "w") - (?_ . "w") - (?$ . "()") - (?$ . ")(") - (?[ . "(]") - (?] . ")[") - (?{ . "(}1") - (?} . "){4") - (?- . "_ 23") - (?\` . "$`") - ,＠(mapcar (lambda (x) (cons x "_")) - (concat "!#$%&*+./:<=>?＠\\^|~" (haskell-enum-from-to ?\241 ?\277) - "\327\367")) - ,＠(mapcar (lambda (x) (cons x "w")) - (concat (haskell-enum-from-to ?\300 ?\326) (haskell-enum-from-to ?\330 ?\337) - (haskell-enum-from-to ?\340 ?\366) (haskell-enum-from-to ?\370 ?\377)))) - "Syntax required for font locking. Given as a list of pairs for use -in `font-lock-defaults'."))) - (defconst haskell-basic-syntactic-keywords - '( - ;; Character constants (since apostrophe can't have string syntax) - ("\\Sw\$'\$\$[^\\']\\|\\\\[^']+\\|\\\\'\$\$'\$" (1 "|") (3 "|")) + '(;; Character constants (since apostrophe can't have string syntax). + ;; Beware: do not match something like 's-}' or '\n"+' since the first ' + ;; might be inside a comment or a string. + ;; This still gets fooled with "'"'"'"'"'"', but ... oh well. + ("\\Sw\$'\$\$[^\\'\n]\\|\\\\.[^\\'\n \"}]*\$\$'\$" (1 "|") (3 "|")) + ;; The \ is not escaping in $x,y) -> x + y. + ("\\(\\\\\$(" (1 ".")) + ;; The second \ in a gap does not quote the subsequent char. + ;; It's probably not worth the trouble, tho. + ;; ("^[ \t]*\$\\\\\$" (1 ".")) ;; Deal with instances of `--' which don't form a comment. ("\\s_\\{3,\\}" (0 (if (string-match "\\`-*\\'" (match-string 0)) - nil ; Sequence of hyphens. Do nothing in - ; case of things like `{---'. + ;; Sequence of hyphens. Do nothing in + ;; case of things like `{---'. + nil "_"))))) ; other symbol sequence (defconst haskell-bird-syntactic-keywords - (cons '("^\$[^\n>]\$[^\n]*\$\n\$" (1 "!") (2 "!")) + (cons '("^[^\n>]" (0 "<")) haskell-basic-syntactic-keywords)) -(defun haskell-fl-bobp (end) - "Find first non-newline character at beginning of buffer." - (if (= (point) 1) ; not bobp in case of narrowing - (re-search-forward "[^\n]" nil t))) - (defconst haskell-latex-syntactic-keywords (append '(("^\\\\begin{code}\$\n\$" 1 "!") - (haskell-fl-bobp (0 "!")) ; start comment at buffer start + ;; Note: buffer is widened during font-locking. + ("\\`\$.\\|\n\$" (1 "!")) ; start comment at buffer start ("^\$\\\\\$end{code}$" 1 "!")) haskell-basic-syntactic-keywords)) (defun haskell-syntactic-face-function (state) "`font-lock-syntactic-face-function' for Haskell." - (if (nth 3 state) - 'font-lock-string-face ; as normal + (cond + ((nth 3 state) font-lock-string-face) ; as normal ;; Else comment. If it's from syntax table, use default face. - (if (eq 'syntax-table (nth 7 state)) - haskell-literate-comment-face - 'haskell-comment-face))) - -(defun haskell-font-lock-defaults-create (bird-literate latex-literate) - "Locally set `font-lock-defaults' for Haskell. -If BIRD-LITERATE is non-nil then the font locking is made -suitable for Bird-style literate Haskell scripts, and similarly for -LATEX-LITERATE and LaTeX-style literate Haskell scripts." - (setq haskell-font-lock-keywords-1 - (haskell-font-lock-keywords-create nil nil 1)) - (setq haskell-font-lock-keywords-2 - (haskell-font-lock-keywords-create nil nil 2)) - (setq haskell-font-lock-keywords - haskell-font-lock-keywords-1) - (setq bird-literate-haskell-font-lock-keywords-1 - (haskell-font-lock-keywords-create t nil 1)) - (setq bird-literate-haskell-font-lock-keywords-2 - (haskell-font-lock-keywords-create t nil 2)) - (setq bird-literate-haskell-font-lock-keywords - bird-literate-haskell-font-lock-keywords-1) - (setq latex-literate-haskell-font-lock-keywords-1 - (haskell-font-lock-keywords-create nil t 1)) - (setq latex-literate-haskell-font-lock-keywords-2 - (haskell-font-lock-keywords-create nil t 2)) - (setq latex-literate-haskell-font-lock-keywords - latex-literate-haskell-font-lock-keywords-1) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - (if bird-literate - (append (list '(bird-literate-haskell-font-lock-keywords - bird-literate-haskell-font-lock-keywords-1 - bird-literate-haskell-font-lock-keywords-2) - nil nil haskell-fl-syntax) - (if haskell-emacs21-features - (list nil - (cons 'font-lock-syntactic-keywords - haskell-bird-syntactic-keywords) - '(font-lock-syntactic-face-function - . haskell-syntactic-face-function)))) - (if latex-literate - (append - (list '(latex-literate-haskell-font-lock-keywords - latex-literate-haskell-font-lock-keywords-1 - latex-literate-haskell-font-lock-keywords-2) - nil nil haskell-fl-syntax) - (if haskell-emacs21-features - (list nil - (cons 'font-lock-syntactic-keywords - haskell-latex-syntactic-keywords) - '(font-lock-syntactic-face-function - . haskell-syntactic-face-function)))) - (append - (list '(haskell-font-lock-keywords - haskell-font-lock-keywords-1 - haskell-font-lock-keywords-2) - nil nil haskell-fl-syntax) - (if haskell-emacs21-features - (list nil - (cons 'font-lock-syntactic-keywords - haskell-basic-syntactic-keywords)))))))) - -;; Faces required for font locking. -(defun haskell-fl-faces () - "Defines faces required for Haskell font locking." - ;; XEmacs does not have a simple function for making the faces but - ;; makes them when `require'd which was done by - ;; turn-on-haskell-font-lock, so we don't need to explicitly make - ;; them for XEmacs, and in fact we shouldn't as an error will be - ;; produced. - (if (fboundp 'font-lock-make-faces) (font-lock-make-faces)) - (copy-face 'font-lock-keyword-face 'haskell-keyword-face) - (copy-face 'font-lock-type-face 'haskell-constructor-face) - (copy-face 'font-lock-string-face 'haskell-string-char-face) - (copy-face 'font-lock-function-name-face 'haskell-operator-face) - (copy-face 'font-lock-comment-face 'haskell-comment-face) - (copy-face 'default 'haskell-default-face) - (copy-face 'font-lock-variable-name-face 'haskell-definition-face) - ) + ((or (eq 'syntax-table (nth 7 state)) + (and (eq haskell-literate 'bird) + (memq (char-before (nth 8 state)) '(nil ?\n)))) + haskell-literate-comment-face) + (t font-lock-comment-face))) + +(defconst haskell-font-lock-keywords + (haskell-font-lock-keywords-create nil) + "Font lock definitions for non-literate Haskell.") + +(defconst haskell-font-lock-bird-literate-keywords + (haskell-font-lock-keywords-create 'bird) + "Font lock definitions for Bird-style literate Haskell.") + +(defconst haskell-font-lock-latex-literate-keywords + (haskell-font-lock-keywords-create 'latex) + "Font lock definitions for LaTeX-style literate Haskell.") +(defun haskell-font-lock-choose-keywords () + (let ((literate (if (boundp 'haskell-literate) haskell-literate))) + (case literate + (bird haskell-font-lock-bird-literate-keywords) + (latex haskell-font-lock-latex-literate-keywords) + (t haskell-font-lock-keywords)))) + +(defun haskell-font-lock-choose-syntactic-keywords () + (let ((literate (if (boundp 'haskell-literate) haskell-literate))) + (case literate + (bird haskell-bird-syntactic-keywords) + (latex haskell-latex-syntactic-keywords) + (t haskell-basic-syntactic-keywords)))) + +(defun haskell-font-lock-defaults-create () + "Locally set `font-lock-defaults' for Haskell." + (set (make-local-variable 'font-lock-defaults) + '(haskell-font-lock-choose-keywords + nil nil ((?\' . "w") (?_ . "w")) nil + (font-lock-syntactic-keywords + . haskell-font-lock-choose-syntactic-keywords) + (font-lock-syntactic-face-function + . haskell-syntactic-face-function) + ;; Get help from font-lock-syntactic-keywords. + (parse-sexp-lookup-properties . t)))) + ;; The main functions. (defun turn-on-haskell-font-lock () "Turns on font locking in current buffer for Haskell 1.4 scripts. Changes the current buffer's `font-lock-defaults', and adds the -following faces: +following variables: `haskell-keyword-face' for reserved keywords and syntax, `haskell-constructor-face' for data- and type-constructors, class names, and module names, - `haskell-string-char-face' for strings and characters, `haskell-operator-face' for symbolic and alphanumeric operators, - `haskell-comment-face' for comments, and `haskell-default-face' for ordinary code. -The faces are initialised to the following font lock defaults: +The variables are initialised to the following font lock default faces: `haskell-keyword-face' `font-lock-keyword-face' `haskell-constructor-face' `font-lock-type-face' - `haskell-string-char-face' `font-lock-string-face' `haskell-operator-face' `font-lock-function-name-face' - `haskell-comment-face' `font-lock-comment-face' `haskell-default-face' <default face> Two levels of fontification are defined: level one (the default) ＠＠ -641,24 +535,17 ＠＠ Invokes `haskell-font-lock-hook' if not Use `haskell-font-lock-version' to find out what version this is." (interactive) - (require 'font-lock) - (haskell-fl-faces) - (let ((literate (if (boundp 'haskell-literate) haskell-literate))) - (haskell-font-lock-defaults-create (eq literate 'bird) - (eq literate 'latex))) - ;; Get help from font-lock-syntactic-keywords. - (set (make-local-variable 'parse-sexp-lookup-properties) t) + (haskell-font-lock-defaults-create) (run-hooks 'haskell-font-lock-hook) (turn-on-font-lock)) (defun turn-off-haskell-font-lock () "Turns off font locking in current buffer." (interactive) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode -1))) + (font-lock-mode -1)) -;;; Provide ourselves: +;; Provide ourselves: (provide 'haskell-font-lock) -;;; haskell-font-lock ends here. +;;; haskell-font-lock.el ends here 1.4 +71 -61 XEmacs/packages/xemacs-packages/haskell-mode/haskell-ghci.el Index: haskell-ghci.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-ghci.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- haskell-ghci.el 2004/06/16 15:16:49 1.3 +++ haskell-ghci.el 2006/03/15 05:18:23 1.4 ＠＠ -1,11 +1,10 ＠＠ -;; haskell-ghci.el --- A GHCi interaction mode +;;; haskell-ghci.el --- A GHCi interaction mode -;; Copyright (C) 1999 Guy Lapalme, 2001 Chris Webb. +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001 Chris Webb +;; Copyright (C) 1998, 1999 Guy Lapalme -;; Authors: 1998-1999 Guy Lapalme <lapalme(a)iro.umontreal.ca> -;; 2001 Chris Webb <chris(a)arachsys.com> ;; Keywords: inferior mode, GHCi interaction mode, Haskell -;; Version: 1.2 ;;; This file is not part of GNU Emacs. ＠＠ -60,15 +59,17 ＠＠ ;; ;; Arguments can be sent to the GHCi interpreter when it is started by ;; setting haskell-ghci-program-args (empty by default) to a list of -;; string args to pass it. This value can be set interactively by +;; string args to pass it. This value can be set interactively by ;; calling C-c C-s with an argument (i.e. C-u C-c C-s). ;; ;; `haskell-ghci-hook' is invoked in the *ghci* buffer once GHCi is ;; started. ;; -;;; All functions/variables start with `turn-{on,off}-haskell-ghci' or -;;; `haskell-ghci-'. +;; All functions/variables start with `turn-{on,off}-haskell-ghci' or +;; `haskell-ghci-'. +;;; Code: + (defgroup haskell-ghci nil "Major mode for interacting with an inferior GHCi session." :group 'haskell ＠＠ -86,6 +87,7 ＠＠ Maps the following commands in the haske (local-set-key "\C-c\C-s" 'haskell-ghci-start-process) (local-set-key "\C-c\C-l" 'haskell-ghci-load-file) (local-set-key "\C-c\C-r" 'haskell-ghci-reload-file) + (local-set-key "\C-c\C-n" 'haskell-ghci-locate-next-error) (local-set-key "\C-c\C-b" 'haskell-ghci-show-ghci-buffer)) (defun turn-off-haskell-ghci () ＠＠ -96,8 +98,6 ＠＠ Maps the following commands in the haske (local-unset-key "\C-c\C-r") (local-unset-key "\C-c\C-b")) -(defvar haskell-ghci-mode-map nil) - (defun haskell-ghci-mode () "Major mode for interacting with an inferior GHCi session. ＠＠ -134,9 +134,6 ＠＠ The commands available from within a Has (defvar haskell-ghci-process-buffer nil "*Buffer used for communication with GHCi subprocess for current buffer.") -(defvar haskell-ghci-last-loaded-file nil - "The last file loaded into the GHCi process.") - (defcustom haskell-ghci-program-name "ghci" "*The name of the GHCi interpreter program." :type 'string ＠＠ -150,6 +147,9 ＠＠ The commands available from within a Has (defvar haskell-ghci-load-end nil "Position of the end of the last load command.") +(defvar haskell-ghci-error-pos nil + "Position of the end of the last load command.") + (defvar haskell-ghci-send-end nil "Position of the end of the last send command.") ＠＠ -177,7 +177,7 ＠＠ Prompt for a list of args if called with ;; Select GHCi buffer temporarily. (set-buffer haskell-ghci-process-buffer) (haskell-ghci-mode) - (make-variable-buffer-local 'shell-cd-regexp) + (make-local-variable 'shell-cd-regexp) (make-local-variable 'shell-dirtrackp) ;; Track directory changes using the `:cd' command. ＠＠ -221,39 +221,37 ＠＠ loaded: as a new file (\":load \") or as If the second argument CD is non-nil, change directory in the GHCi process to the current buffer's directory before loading the file. -If the variable \"haskell-ghci-command\" is set then its value will be +If the variable `haskell-ghci-command' is set then its value will be sent to the GHCi process after the load command. This can be used for a top-level expression to evaluate." - (let (file) - (hack-local-variables) ; in case they've changed - (save-buffer) - (if (string-equal load-command ":load ") - (progn - (setq file (buffer-file-name)) - (setq haskell-ghci-last-loaded-file file)) - (setq file "")) - (let ((dir (expand-file-name default-directory)) - (cmd (and (boundp 'haskell-ghci-command) - haskell-ghci-command - (if (stringp haskell-ghci-command) - haskell-ghci-command - (symbol-name haskell-ghci-command))))) - (if (and haskell-ghci-process-buffer - (eq (process-status haskell-ghci-process) 'run)) - ;; Ensure the GHCi buffer is selected. - (set-buffer haskell-ghci-process-buffer) - ;; Start Haskell-GHCi process. - (haskell-ghci-start-process nil)) - - (if cd (haskell-ghci-send (concat ":cd " dir))) - ;; Wait until output arrives and go to the last input. - (haskell-ghci-wait-for-output) - (haskell-ghci-send load-command file) - ;; Error message search starts from last load command. - (setq haskell-ghci-load-end (marker-position comint-last-input-end)) - (if cmd (haskell-ghci-send cmd)) - ;; Wait until output arrives and go to the last input. - (haskell-ghci-wait-for-output)))) + (hack-local-variables) ; in case they've changed + (save-buffer) + (let ((file (if (string-equal load-command ":load ") + (concat "\"" buffer-file-name "\"") + "")) + (dir (expand-file-name default-directory)) + (cmd (and (boundp 'haskell-ghci-command) + haskell-ghci-command + (if (stringp haskell-ghci-command) + haskell-ghci-command + (symbol-name haskell-ghci-command))))) + (if (and haskell-ghci-process-buffer + (eq (process-status haskell-ghci-process) 'run)) + ;; Ensure the GHCi buffer is selected. + (set-buffer haskell-ghci-process-buffer) + ;; Start Haskell-GHCi process. + (haskell-ghci-start-process nil)) + + (if cd (haskell-ghci-send (concat ":cd " dir))) + ;; Wait until output arrives and go to the last input. + (haskell-ghci-wait-for-output) + (haskell-ghci-send load-command file) + ;; Error message search starts from last load command. + (setq haskell-ghci-load-end (marker-position comint-last-input-end)) + (setq haskell-ghci-error-pos haskell-ghci-load-end) + (if cmd (haskell-ghci-send cmd)) + ;; Wait until output arrives and go to the last input. + (haskell-ghci-wait-for-output))) (defun haskell-ghci-load-file (cd) "Save a ghci buffer file and load its file. ＠＠ -297,27 +295,38 ＠＠ error line otherwise show the *ghci* buf ;; first error in the file whilst leaving the error visible in the ;; *ghci* buffer. (goto-char haskell-ghci-load-end) - (if (re-search-forward - "^\$[^:\n]+\$:\$[0-9]+\$:" nil t) - (let ((efile (buffer-substring (match-beginning 1) - (match-end 1))) - (eline (string-to-int (buffer-substring (match-beginning 2) - (match-end 2))))) + (haskell-ghci-locate-next-error))) - (recenter 2) - (message "GHCi error on line %d of %s." + +(defun haskell-ghci-locate-next-error () + "Go to the next error shown in the *ghci* buffer." + (interactive) + (if (buffer-live-p haskell-ghci-process-buffer) + (progn (pop-to-buffer haskell-ghci-process-buffer) + (goto-char haskell-ghci-error-pos) + (if (re-search-forward + "^[^\/]*\$[^:\n]+\$:\$[0-9]+\$" nil t) + (let ((efile (buffer-substring (match-beginning 1) + (match-end 1))) + (eline (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2))))) + + (recenter 2) + (setq haskell-ghci-error-pos (point)) + (message "GHCi error on line %d of %s." eline (file-name-nondirectory efile)) - (if (file-exists-p efile) - (progn (find-file-other-window efile) - (goto-line eline) - (recenter)))) + (if (file-exists-p efile) + (progn (find-file-other-window efile) + (goto-line eline) + (recenter)))) ;; We got an error without a file and line number, so put the ;; point at end of the *ghci* buffer ready to deal with it. - (pop-to-buffer haskell-ghci-process-buffer) - (goto-char (point-max)) - (recenter -2) - (message "GHCi error while loading.")))) + (goto-char (point-max)) + (recenter -2) + (message "No more errors found."))) + (message "No *ghci* buffer found."))) (defun haskell-ghci-show-ghci-buffer () "Go to the *ghci* buffer." ＠＠ -327,5 +336,6 ＠＠ error line otherwise show the *ghci* buf (haskell-ghci-start-process nil)) (pop-to-buffer haskell-ghci-process-buffer)) +(provide 'haskell-ghci) ;;; haskell-ghci.el ends here 1.3 +46 -58 XEmacs/packages/xemacs-packages/haskell-mode/haskell-hugs.el Index: haskell-hugs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-hugs.el,v retrieving revision 1.2 retrieving revision 1.3 diff -u -p -r1.2 -r1.3 --- haskell-hugs.el 2004/06/16 15:16:49 1.2 +++ haskell-hugs.el 2006/03/15 05:18:23 1.3 ＠＠ -1,19 +1,18 ＠＠ -;; haskell-hugs.el --- simplistic interaction mode with a +;;; haskell-hugs.el --- simplistic interaction mode with a + +;; Copyright 2004, 2005 Free Software Foundation, Inc. +;; Copyright 1998, 1999 Guy Lapalme + ;; Hugs interpreter for Haskell developped by ;; The University of Nottingham and Yale University, 1994-1997. ;; Web: http://www.haskell.org/hugs. ;; In standard Emacs terminology, this would be called ;; inferior-hugs-mode -;; -;; Copyright 1999 Guy Lapalme - -;; Author:1998, 1999 Guy Lapalme <lapalme(a)iro.umontreal.ca> ;; Keywords: Hugs inferior mode, Hugs interaction mode -;; Version: 1.1 -;; URL: http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/e... -;;; This file is not part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ＠＠ -104,9 +103,7 ＠＠ Maps the followind commands in the haske (local-unset-key "\C-c\C-b") ) -(defvar haskell-hugs-mode-map nil) - -(defun haskell-hugs-mode () +(define-derived-mode haskell-hugs-mode comint-mode "Haskell Hugs" ;; called by haskell-hugs-start-process, ;; itself called by haskell-hugs-load-file ;; only when the file is loaded the first time ＠＠ -131,15 +128,6 ＠＠ imitating normal Unix input editing. subjob if any. \\[comint-stop-subjob] stops, likewise. \\[comint-quit-subjob] sends quit signal." - (interactive) - (comint-mode) - (setq major-mode 'haskell-hugs-mode) - (setq mode-name "Haskell Hugs") - (if haskell-hugs-mode-map - nil - (setq haskell-hugs-mode-map (copy-keymap comint-mode-map)) - ) - (use-local-map haskell-hugs-mode-map) ) ;; Hugs-interface ＠＠ -153,9 +141,6 ＠＠ subjob if any. (defvar haskell-hugs-process-buffer nil "*Buffer used for communication with Hugs subprocess for current buffer.") -(defvar haskell-hugs-last-loaded-file nil - "The last file loaded into the Hugs process.") - (defcustom haskell-hugs-program-name "hugs" "*The name of the command to start the Hugs interpreter." :type 'string ＠＠ -172,6 +157,8 ＠＠ subjob if any. (defvar haskell-hugs-send-end nil "Position of the end of the last send command.") +(defalias 'run-hugs 'haskell-hugs-start-process) + (defun haskell-hugs-start-process (arg) "Start a Hugs process and invokes `haskell-hugs-hook' if not nil. Prompts for a list of args if called with an argument." ＠＠ -190,7 +177,7 ＠＠ Prompts for a list of args if called wit ;; Select Hugs buffer temporarily (set-buffer haskell-hugs-process-buffer) (haskell-hugs-mode) - (make-variable-buffer-local 'shell-cd-regexp) + (make-local-variable 'shell-cd-regexp) (make-local-variable 'shell-dirtrackp) (setq shell-cd-regexp ":cd") (setq shell-dirtrackp t) ＠＠ -205,10 +192,11 ＠＠ Prompts for a list of args if called wit (defun haskell-hugs-wait-for-output () "Wait until output arrives and go to the last input." - (while (progn + (while (progn (goto-char comint-last-input-end) - (not (re-search-forward comint-prompt-regexp nil t))) - (accept-process-output haskell-hugs-process))) + (and + (not (re-search-forward comint-prompt-regexp nil t)) + (accept-process-output haskell-hugs-process))))) (defun haskell-hugs-send (&rest string) "Send `haskell-hugs-process' the arguments (one or more strings). ＠＠ -230,40 +218,36 ＠＠ loaded: as a new file (\":load \") or as If the second argument CD is non-nil, change the Haskell-Hugs process to the current buffer's directory before loading the file. -If the variable \"haskell-hugs-command\" is set then its value will be sent to +If the variable `haskell-hugs-command' is set then its value will be sent to the Hugs process after the load command. This can be used for a top-level expression to evaluate." - (let (file) - (hack-local-variables);; In case they've changed - (save-buffer) - (if (string-equal load-command ":load ") - (progn - (setq file (buffer-file-name)) - (setq haskell-hugs-last-loaded-file file)) - (setq file "")) - (let ((dir (expand-file-name default-directory)) - (cmd (and (boundp 'haskell-hugs-command) - haskell-hugs-command - (if (stringp haskell-hugs-command) - haskell-hugs-command - (symbol-name haskell-hugs-command))))) - (if (and haskell-hugs-process-buffer - (eq (process-status haskell-hugs-process) 'run)) - ;; Ensure the Hugs buffer is selected. - (set-buffer haskell-hugs-process-buffer) - ;; Start Haskell-Hugs process. - (haskell-hugs-start-process nil)) + (hack-local-variables) ;; In case they've changed + (save-buffer) + (let ((file (if (string-equal load-command ":load ") + (concat "\"" buffer-file-name "\"") + "")) + (dir (expand-file-name default-directory)) + (cmd (and (boundp 'haskell-hugs-command) + haskell-hugs-command + (if (stringp haskell-hugs-command) + haskell-hugs-command + (symbol-name haskell-hugs-command))))) + (if (and haskell-hugs-process-buffer + (eq (process-status haskell-hugs-process) 'run)) + ;; Ensure the Hugs buffer is selected. + (set-buffer haskell-hugs-process-buffer) + ;; Start Haskell-Hugs process. + (haskell-hugs-start-process nil)) - (if cd (haskell-hugs-send (concat ":cd " dir))) - ;; Wait until output arrives and go to the last input. - (haskell-hugs-wait-for-output) - (haskell-hugs-send load-command file) - ;; Error message search starts from last load command. - (setq haskell-hugs-load-end (marker-position comint-last-input-end)) - (if cmd (haskell-hugs-send cmd)) - ;; Wait until output arrives and go to the last input. - (haskell-hugs-wait-for-output))) - ) + (if cd (haskell-hugs-send (concat ":cd " dir))) + ;; Wait until output arrives and go to the last input. + (haskell-hugs-wait-for-output) + (haskell-hugs-send load-command file) + ;; Error message search starts from last load command. + (setq haskell-hugs-load-end (marker-position comint-last-input-end)) + (if cmd (haskell-hugs-send cmd)) + ;; Wait until output arrives and go to the last input. + (haskell-hugs-wait-for-output))) (defun haskell-hugs-load-file (cd) "Save a hugs buffer file and load its file. ＠＠ -329,3 +313,7 ＠＠ error line otherwise show the Hugs buffe (haskell-hugs-start-process nil)) (pop-to-buffer haskell-hugs-process-buffer) ) + +(provide 'haskell-hugs) + +;;; haskell-hugs.el ends here 1.4 +704 -608 XEmacs/packages/xemacs-packages/haskell-mode/haskell-indent.el Index: haskell-indent.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-indent.el,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- haskell-indent.el 2004/06/16 15:16:49 1.3 +++ haskell-indent.el 2006/03/15 05:18:23 1.4 ＠＠ -1,6 +1,7 ＠＠ -;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode +;;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode -;; Copyright 1997-1998 Guy Lapalme +;; Copyright 2004, 2005 Free Software Foundation, Inc. +;; Copyright 1997-1998 Guy Lapalme ;; Author: 1997-1998 Guy Lapalme <lapalme(a)iro.umontreal.ca> ＠＠ -35,7 +36,7 ＠＠ ;; the Haskell report. The rationale and the implementation principles ;; are described in an article to appear in Journal of Functional Programming. ;; "Dynamic tabbing for automatic indentation with the layout rule" -;; +;; ;; It supports literate scripts. ;; Haskell indentation is performed ;; within \begin{code}...\end{code} sections of a literate script ＠＠ -43,7 +44,7 ＠＠ ;; TAB aligns to the left column outside of these sections. ;; ;; Installation: -;; +;; ;; To turn indentation on for all Haskell buffers under the Haskell ;; mode of Moss&Thorn <http://www.haskell.org/haskell-mode/> ;; add this to .emacs: ＠＠ -64,118 +65,96 ＠＠ ;; ;; `haskell-indent-hook' is invoked if not nil. ;; -;;; All functions/variables start with -;;; `(turn-(on/off)-)haskell-indent' or `haskell-indent-'. +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-indent' or `haskell-indent-'. ;; This file can also be used as a hook for the Hugs Mode developed by ;; Chris Van Humbeeck <chris.vanhumbeeck(a)cs.kuleuven.ac.be> ;; It can be obtained at: ;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el +;; +;; For the Hugs mode put the following in your .emacs ;; -;; For the Hugs mode put the following in your .emacs -;; -;;(setq auto-mode-alist (append auto-mode-alist '(("\\.hs$" . hugs-mode)))) +;;(setq auto-mode-alist (append auto-mode-alist '(("\\.hs\\'" . hugs-mode)))) ;;(autoload 'hugs-mode "hugs-mode" "Go into hugs mode" t) ;; ;; If only the indentation mode is used then replace the two ;; preceding lines with ;;(setq auto-mode-alist (append auto-mode-alist -;; '(("\\.hs$" . turn-on-haskell-indent)))) +;; '(("\\.hs\\'" . turn-on-haskell-indent)))) ;;(autoload 'turn-on-haskell-indent "hindent" "Indentation mode for Haskell" t) ;; ;; For indentation in both cases then add the following to your .emacs -;;(setq hugs-mode-hook -;; '(lambda () -;; (setq indent-line-function 'haskell-indent-cycle) -;; (define-key hugs-mode-map "\r" 'newline) -;; (define-key hugs-mode-map "\t" 'haskell-indent-cycle) -;; (define-key hugs-mode-map "\C-c=" 'haskell-indent-insert-equal) -;; (define-key hugs-mode-map "\C-c|" 'haskell-indent-insert-guard) -;; (define-key hugs-mode-map "\C-co" 'haskell-indent-insert-otherwise) -;; (define-key hugs-mode-map "\C-cw" 'haskell-indent-insert-where) -;; (define-key hugs-mode-map "\C-c." 'haskell-indent-align-guards-and-rhs))) +;;(add-hook 'hugs-mode-hook 'turn-on-haskell-indent) ;;(autoload 'haskell-indent-cycle "hindent" "Indentation cycle for Haskell" t) ;; -(require 'cl) ;need defs of push and pop +;;; Code: +(eval-when-compile (require 'cl)) ;need defs of push and pop +(defvar haskell-literate) + (defgroup haskell-indent nil "Haskell indentation." :group 'haskell :prefix "haskell-indent-") (defcustom haskell-indent-offset 4 - "*Indentation of Haskell statements with respect to containing block." + "Indentation of Haskell statements with respect to containing block." :type 'integer :group 'haskell-indent) (defcustom haskell-indent-literate-Bird-default-offset 1 - "*Default number of blanks after > in a Bird style literate script." + "Default number of blanks after > in a Bird style literate script." :type 'integer :group 'haskell-indent) - -(defcustom haskell-indent-rhs-align-column 0 - "*Column on which to align right-hand sides (use 0 for ad-hoc alignment)." -:type 'integer -:group 'haskell-indent) -(defsubst haskell-indent-get-beg-of-line (&optional arg) - (save-excursion - (beginning-of-line arg) - (point))) - -(defsubst haskell-indent-get-end-of-line (&optional arg) - (save-excursion - (end-of-line arg) - (point))) +(defcustom haskell-indent-rhs-align-column 0 + "Column on which to align right-hand sides (use 0 for ad-hoc alignment)." +:type 'integer +:group 'haskell-indent) (defun haskell-indent-point-to-col (apoint) - "Returns the column number of APOINT." + "Return the column number of APOINT." (save-excursion (goto-char apoint) (current-column))) -(defconst haskell-indent-start-keywords-re - (concat "\\<\$" - "class\\|data\\|i\\(mport\\|n\\(fix\\(\\|[lr]\$\\|stance\\)\\)\\|" - "module\\|newtype\\|primitive\\|type" - "\\)\\>") +(defconst haskell-indent-start-keywords-re + (concat "\\<" + (regexp-opt '("class" "data" "import" "infix" "infixl" "infixr" + "instance" "module" "newtype" "primitive" "type") t) + "\\>") "Regexp describing keywords to complete when standing at the first word of a line.") -(defconst haskell-running-xemacs - (string-match "Lucid\\|XEmacs" emacs-version) - "t when using XEmacs or Lucid.") - -;;; customizations for different kinds of environments -;;; in which dealing with low-level events are different -(if haskell-running-xemacs - (progn ;;; for XEmacs - (fset 'event-basic-type 'event-key) - (fset 'read-event 'next-command-event) - (defun haskell-indent-mark-active () - (if zmacs-regions - zmacs-region-active-p - t))) - ;; in Gnu Emacs - (defun haskell-indent-mark-active () - mark-active) - ) +;; Customizations for different kinds of environments +;; in which dealing with low-level events are different. +(defun haskell-indent-mark-active () + (if (featurep 'xemacs) + (if zmacs-regions + zmacs-region-active-p + t) + mark-active)) + ;; for pushing indentation information +(defvar haskell-indent-info) ;Used with dynamic scoping. + (defun haskell-indent-push-col (col &optional name) - "Pushes indentation information for the column COL -followed by NAME (if present). Makes sure that the same indentation info -is not pushed twice in a row. Uses free var `indent-info'." + "Push indentation information for the column COL. +The info is followed by NAME (if present). +Makes sure that the same indentation info is not pushed twice. +Uses free var `haskell-indent-info'." (let ((tmp (cons col name))) - (if (and indent-info (equal tmp (car indent-info))) - indent-info - (push tmp indent-info)))) + (if (member tmp haskell-indent-info) + haskell-indent-info + (push tmp haskell-indent-info)))) (defun haskell-indent-push-pos (pos &optional name) "Pushes indentation information for the column corresponding to POS -followed by NAME (if present). " +followed by NAME (if present)." (haskell-indent-push-col (haskell-indent-point-to-col pos) name)) (defun haskell-indent-push-pos-offset (pos &optional offset) ＠＠ -185,17 +164,15 ＠＠ followed by an OFFSET (if present use it (haskell-indent-push-col (+ (haskell-indent-point-to-col pos) (or offset haskell-indent-offset)))) -;;; redefinition of some Emacs function for dealing with -;;; Bird Style literate scripts +;; redefinition of some Emacs function for dealing with +;; Bird Style literate scripts (defun haskell-indent-bolp () "`bolp' but dealing with Bird-style literate scripts." (or (bolp) (and (eq haskell-literate 'bird) (<= (current-column) (1+ haskell-indent-literate-Bird-default-offset)) - (eq (save-excursion (beginning-of-line) (following-char)) ?\>)) - ) - ) + (eq (char-after (line-beginning-position)) ?\>)))) (defun haskell-indent-empty-line-p () "Checks if the current line is empty; deals with Bird style scripts." ＠＠ -204,12 +181,10 ＠＠ followed by an OFFSET (if present use it (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>)) (forward-char 1)) - (looking-at "[ \t]*$")) - ) + (looking-at "[ \t]*$"))) (defun haskell-indent-back-to-indentation () - "`back-to-indentation' function but dealing with Bird-style literate -scripts." + "`back-to-indentation' function but dealing with Bird-style literate scripts." (if (eq haskell-literate 'bird) (progn (beginning-of-line) ＠＠ -217,10 +192,9 ＠＠ scripts." (progn (forward-char 1) (if (not (eolp)) - (skip-chars-forward " \t" (haskell-indent-get-end-of-line)))) + (skip-chars-forward " \t" (line-end-position)))) (back-to-indentation))) - (back-to-indentation)) - ) + (back-to-indentation))) (defun haskell-indent-current-indentation () "`current-indentation' function but dealing with Bird-style literate ＠＠ -229,18 +203,16 ＠＠ scripts." (save-excursion (haskell-indent-back-to-indentation) (current-column)) - (current-indentation)) - ) + (current-indentation))) (defun haskell-indent-backward-to-indentation (n) "`backward-to-indentation' function but dealing with Bird-style literate scripts." (if (eq haskell-literate 'bird) (progn - (forward-line (- n)) + (forward-line (- n)) (haskell-indent-back-to-indentation)) - (backward-to-indentation n)) - ) + (backward-to-indentation n))) (defun haskell-indent-forward-line (&optional n) "`forward-line' function but dealing with Bird-style literate scripts." ＠＠ -248,8 +220,7 ＠＠ scripts." (forward-line n) (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>)) (progn (forward-char 1) ; skip > and initial blanks... - (skip-chars-forward " \t")))) - ) + (skip-chars-forward " \t"))))) (defun haskell-indent-line-to (n) "`indent-line-to' function but dealing with Bird-style literate scripts." ＠＠ -262,10 +233,9 ＠＠ scripts." (indent-line-to n) ; that indent-line only adds spaces (save-excursion (beginning-of-line) - (if (> n 0) (delete-char 1)) ; delete the first space begore + (if (> n 0) (delete-char 1)) ; delete the first space before (insert ?\>))) ; inserting a > - (indent-line-to n)) - ) + (indent-line-to n))) (defun haskell-indent-skip-blanks-and-newlines-forward (end) "Skips forward blanks, tabs and newlines until END taking ＠＠ -274,8 +244,7 ＠＠ account of Bird style literate scripts." (if (eq haskell-literate 'bird) (while (and (bolp) (eq (following-char) ?\>)) (forward-char 1) ; skip > - (skip-chars-forward " \t\n" end))) -) + (skip-chars-forward " \t\n" end)))) (defun haskell-indent-skip-blanks-and-newlines-backward (start) "Skips backward blanks, tabs and newlines upto START ＠＠ -285,8 +254,7 ＠＠ taking account of Bird style literate sc (while (and (eq (current-column) 1) (eq (preceding-char) ?\>)) (forward-char -1) ; skip back > - (skip-chars-backward " \t\n" start))) -) + (skip-chars-backward " \t\n" start)))) ;; specific functions for literate code ＠＠ -296,66 +264,62 ＠＠ returns its start otherwise returns NIL: If it is Bird Style, then returns the position of the > otherwise returns the ending position \\begin{code}." (save-excursion - (if (eq haskell-literate 'bird) - (progn - (beginning-of-line) - (if (or (eq (following-char) ?\>) - (and (bolp) (forward-line -1) (eq (following-char) ?\>))) - (progn - (while (and (zerop (forward-line -1)) - (eq (following-char) ?\>))) - (if (not (eq (following-char) ?\>)) - (forward-line)) - (point)))) - ;; Look for a \begin{code} or \end{code} line. - (if (eq haskell-literate 'latex) - (if (re-search-backward - "^\$\\\\begin{code}$\$\\|\$\\\\end{code}$\$" nil t) - ;; within a literate code part if it was a \\begin{code}. - (match-end 1)) - (error "haskell-indent-within-literate-code: should not happen!") - ))) - ) + (case haskell-literate + (bird + (beginning-of-line) + (if (or (eq (following-char) ?\>) + (and (bolp) (forward-line -1) (eq (following-char) ?\>))) + (progn + (while (and (zerop (forward-line -1)) + (eq (following-char) ?\>))) + (if (not (eq (following-char) ?\>)) + (forward-line)) + (point)))) + ;; Look for a \begin{code} or \end{code} line. + (latex + (if (re-search-backward + "^\$\\\\begin{code}$\$\\|\$\\\\end{code}$\$" nil t) + ;; within a literate code part if it was a \\begin{code}. + (match-end 1))) + (t (error "haskell-indent-within-literate-code: should not happen!"))))) (defun haskell-indent-put-region-in-literate (beg end &optional arg) "Put lines of the region as a piece of literate code. With C-u prefix arg, remove indication that the region is literate code. It deals with both Bird style and non Bird-style scripts." (interactive "r\nP") - (if haskell-literate - (if (eq haskell-literate 'bird) - (let ((comment-start "> "); change dynamic bindings for - (comment-end "")) ; comment-region - (comment-region beg end arg)) - ;; not Bird style - (if (consp arg) ; remove the literate indication - (save-excursion - (goto-char end) ; remove end - (beginning-of-line) - (if (looking-at "\\\\end{code}") - (kill-line 1) - (forward-line -1) ; perhaps the end is at the start of - (if (looking-at "\\\\end{code}") ; of the previous line - (kill-line 1)) - ) - (goto-char beg) ; remove end - (beginning-of-line) - (if (looking-at "\\\\begin{code}") - (kill-line 1)) - ) - (save-excursion ; add the literate indication - (goto-char end) - (insert "\\end{code}\n") - (goto-char beg) - (insert "\\begin{code}\n"))) - ) - (error "Cannot put a region in literate in a non literate script")) - ) + (unless haskell-literate + (error "Cannot put a region in literate in a non literate script")) + (if (eq haskell-literate 'bird) + (let ((comment-start "> ") ; Change dynamic bindings for + (comment-start-skip "^> ?") ; comment-region. + (comment-end "") + (comment-end-skip "\n") + (comment-style 'plain)) + (comment-region beg end arg)) + ;; Not Bird style. + (if arg ; Remove the literate indication. + (save-excursion + (goto-char end) ; Remove end. + (if (re-search-backward "^\\\\end{code}[ \t\n]*\\=" + (line-beginning-position -2) t) + (delete-region (point) (line-beginning-position 2))) + (goto-char beg) ; Remove end. + (beginning-of-line) + (if (looking-at "\\\\begin{code}") + (kill-line 1))) + (save-excursion ; Add the literate indication. + (goto-char end) + (unless (bolp) (newline)) + (insert "\\end{code}\n") + (goto-char beg) + (unless (bolp) (newline)) + (insert "\\begin{code}\n"))))) ;;; Start of indentation code (defun haskell-indent-start-of-def () - "Returns the position of the start of a definition. + "Return the position of the start of a definition. It is at the first character which is not in a comment after nearest preceding non-empty line." (save-excursion ＠＠ -365,7 +329,7 ＠＠ preceding non-empty line." (if (setq start-code (and haskell-literate (haskell-indent-within-literate-code))) (setq start-code (1+ start-code)) - (setq start-code 1)) + (setq start-code (point-min))) ;; go backward until the first preceding empty line (haskell-indent-forward-line -1) (while (and (not (haskell-indent-empty-line-p)) ＠＠ -374,92 +338,76 ＠＠ preceding non-empty line." ;; go forward after the empty line (if (haskell-indent-empty-line-p) (haskell-indent-forward-line 1)) + (setq start-code (point)) ;; find the first line of code which is not a comment - (while (and (haskell-indent-in-comment start-code (point)) - (= 0 (haskell-indent-forward-line 1)))) - (haskell-indent-skip-blanks-and-newlines-forward save-point) - (point))) - ) + (forward-comment (point-max)) + (if (> (point) save-point) + start-code + (point))))) + (defun haskell-indent-open-structure (start end) "If any structure (list or tuple) is not closed, between START and END, returns the location of the opening symbol, nil otherwise." (save-excursion - (let ((pps (parse-partial-sexp start end))) - (if (> (nth 0 pps) 0) - (nth 1 pps)) - ))) + (nth 1 (parse-partial-sexp start end)))) (defun haskell-indent-in-string (start end) "If a string is not closed , between START and END, returns the location of the opening symbol, nil otherwise." (save-excursion (let ((pps (parse-partial-sexp start end))) - (if (nth 3 pps) ; we are within an open string - (progn ; go back to the previous - (goto-char (or (nth 1 pps); open parenthesis - (nth 2 pps); complete sexp - start)) ; otherwise to the start - (skip-chars-forward "^\""); skip upto the start of the string - (point))) - ))) + (if (nth 3 pps) (nth 8 pps))))) (defun haskell-indent-in-comment (start end) - "Checks, starting from START, if END is within a comment, returns -the location of the start of the comment, nil otherwise." - (cond ((> start end) end) - ((= start end) nil) - ( t - (save-excursion - (cond - ((looking-at "{-\\|--") ; on the first char of a comment ? - (point)) - ((and (= (following-char) ?\-) ; on the second char ? - (or (= (preceding-char) ?\-) - (= (preceding-char) ?\{))) - (1- (point))) - (t (let ((pps (parse-partial-sexp start end))) - (if (nth 4 pps) - (re-search-backward "{-" (nth 2 pps) t) - (re-search-backward "--" - (haskell-indent-get-beg-of-line) t)))) - )))) - ) + "Check, starting from START, if END is at or within a comment. +Returns the location of the start of the comment, nil otherwise." + (let (pps) + (assert (<= start end)) + (cond ((= start end) nil) + ((nth 4 (save-excursion (setq pps (parse-partial-sexp start end)))) + (nth 8 pps)) + ;; We also want to say that we are *at* the beginning of a comment. + ((and (not (nth 8 pps)) + (>= (point-max) (+ end 2)) + (nth 4 (save-excursion + (setq pps (parse-partial-sexp end (+ end 2)))))) + (nth 8 pps))))) (defvar haskell-indent-off-side-keywords-re "\\<\$do\\|let\\|of\\|where\$\\>[ \t]*") (defun haskell-indent-type-at-point () - "Returns the type of the line (also puts information in `match-data')." + "Return the type of the line (also puts information in `match-data')." (cond ((haskell-indent-empty-line-p) 'empty) - ((haskell-indent-in-comment 1 (point)) 'comment) - ((looking-at "\$\\([a-zA-Z]\\sw*\$\\|_\\)[ \t\n]*") 'ident) + ((haskell-indent-in-comment (point-min) (point)) 'comment) + ((looking-at "\$\\([a-zA-Z]\\(\\sw\\|'\$*\\)\\|_\\)[ \t\n]*") 'ident) ((looking-at "\$|[^|]\$[ \t\n]*") 'guard) ((looking-at "\$=[^>=]\\|::\\|->\\|<-\$[ \t\n]*") 'rhs) - ( t 'other))) + (t 'other))) (defvar haskell-indent-current-line-first-ident "" "Global variable that keeps track of the first ident of the line to indent.") (defun haskell-indent-contour-line (start end) - "Generates contour information between START and END points." + "Generate contour information between START and END points." (if (< start end) (save-excursion - (let ((cur-col 1024) ; maximum column number + (goto-char end) + (haskell-indent-skip-blanks-and-newlines-backward start) + (let ((cur-col (current-column)) ; maximum column number (fl 0) ; number of lines that forward-line could not advance contour) - (goto-char end) - (haskell-indent-skip-blanks-and-newlines-backward start) (while (and (> cur-col 0) (= fl 0) (>= (point) start)) (haskell-indent-back-to-indentation) + (if (< (point) start) (goto-char start)) (and (not (member (haskell-indent-type-at-point) '(empty comment))) ; skip empty and comment lines (< (current-column) cur-col) ; less indented column found (push (point) contour) ; new contour point found (setq cur-col (current-column))) - (setq fl (haskell-indent-forward-line -1)) - ) + (setq fl (haskell-indent-forward-line -1))) contour)))) (defun haskell-indent-next-symbol (end) ＠＠ -470,8 +418,7 ＠＠ the location of the start of the comment (if (< (point) end) (progn (forward-sexp 1) ; this skips also {- comments !!! - (haskell-indent-skip-blanks-and-newlines-forward end)) - )) + (haskell-indent-skip-blanks-and-newlines-forward end)))) (defun haskell-indent-separate-valdef (start end) "Returns a list of positions for important parts of a valdef." ＠＠ -483,20 +430,19 ＠＠ the location of the start of the comment ;; "parse" a valdef separating important parts (goto-char start) (setq type (haskell-indent-type-at-point)) - (if (or (eq type 'ident) (eq type 'other)) ; possible start of a value def + (if (or (memq type '(ident other))) ; possible start of a value def (progn (if (eq type 'ident) (progn (setq valname (match-beginning 0)) - (setq valname-string (buffer-substring (match-beginning 0) - (match-end 0))) + (setq valname-string (match-string 0)) (goto-char (match-end 0))) (skip-chars-forward " \t" end) (setq valname (point)) ; type = other (haskell-indent-next-symbol end)) (while (and (< (point) end) (setq type (haskell-indent-type-at-point)) - (or (eq type 'ident) (eq type 'other))) + (or (memq type '(ident other)))) (if (null aft-valname) (setq aft-valname (point))) (haskell-indent-next-symbol end)))) ＠＠ -517,7 +463,7 ＠＠ the location of the start of the comment (if (< (point) end) (setq aft-rhs-sign (point))))) (list valname valname-string aft-valname - guard aft-guard rhs-sign aft-rhs-sign)))) + guard aft-guard rhs-sign aft-rhs-sign)))) (defsubst haskell-indent-no-otherwise (guard) "Check if there is no otherwise at GUARD." ＠＠ -529,7 +475,8 ＠＠ the location of the start of the comment (defun haskell-indent-guard (start end end-visible indent-info) "Finds indentation information for a line starting with a guard." (save-excursion - (let* ((sep (haskell-indent-separate-valdef start end)) + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) (valname (nth 0 sep)) (guard (nth 3 sep)) (rhs-sign (nth 5 sep))) ＠＠ -539,13 +486,14 ＠＠ the location of the start of the comment (if rhs-sign (haskell-indent-push-pos rhs-sign) ; probably within a data definition... (if valname - (haskell-indent-push-pos-offset valname)))))) - indent-info) + (haskell-indent-push-pos-offset valname)))) + haskell-indent-info))) (defun haskell-indent-rhs (start end end-visible indent-info) "Finds indentation information for a line starting with a rhs." (save-excursion - (let* ((sep (haskell-indent-separate-valdef start end)) + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) (valname (nth 0 sep)) (guard (nth 3 sep)) (rhs-sign (nth 5 sep))) ＠＠ -555,31 +503,9 ＠＠ the location of the start of the comment (if (and guard (< guard end-visible)) (haskell-indent-push-pos-offset guard) (if valname ; always visible !! - (haskell-indent-push-pos-offset valname)))))) - indent-info) + (haskell-indent-push-pos-offset valname)))) + haskell-indent-info))) -(defun haskell-indent-comment (start end indent-info) - "Finds indentation information for a comment line. -If the previous line (between START and END) is also a comment line - -- comments are aligned on their start - {- comments are aligned on the first non-blank char following the open { -otherwise - indent at the same indentation as the previous line." - (save-excursion - (let ((comment-start (haskell-indent-in-comment start end))) - (if comment-start - (if (eq (char-after comment-start) ?-) - ;; -- style comment - (haskell-indent-push-pos comment-start) - ;; {- style comment - (goto-char (+ 2 comment-start)) - (haskell-indent-skip-blanks-and-newlines-forward end) - (haskell-indent-push-pos (point))) - ;; no previous comment indent with previous line - (haskell-indent-push-col (haskell-indent-current-indentation))))) - indent-info) - - (defconst haskell-indent-decision-table (let ((or "\\)\\|\$")) (concat "\\(" ＠＠ -597,7 +523,7 ＠＠ otherwise "001000" or ;12= gd "000011" or ;13= rh arh "000010" or ;14= rh - "000000" ;15= + "000000" ;15= "\$"))) (defun haskell-indent-find-case (test) ＠＠ -605,32 +531,30 ＠＠ otherwise (if (string-match haskell-indent-decision-table test) ;; use the fact that the resulting match-data is a list of the form ;; (0 6 [2*(n-1) nil] 0 6) where n is the number of the matching regexp - ;; so n= ((length match-date)/2)-1 - (- (/ (length (match-data)) 2) 1) - (error "haskell-indent-find-case: impossible case: %s" test) - )) + ;; so n= ((length match-data)/2)-1 + (- (/ (length (match-data 'integers)) 2) 1) + (error "haskell-indent-find-case: impossible case: %s" test))) (defun haskell-indent-empty (start end end-visible indent-info) "Finds indentation points for an empty line." (save-excursion - (let* - ((sep (haskell-indent-separate-valdef start end)) - (valname (pop sep)) - (valname-string (pop sep)) - (aft-valname (pop sep)) - (guard (pop sep)) - (aft-guard (pop sep)) - (rhs-sign (pop sep)) - (aft-rhs-sign (pop sep)) - (last-line (= end end-visible)) - (test (concat - (if valname "1" "0") - (if (and aft-valname (< aft-valname end-visible)) "1" "0") - (if (and guard (< guard end-visible)) "1" "0") - (if (and aft-guard (< aft-guard end-visible)) "1" "0") - (if (and rhs-sign (< rhs-sign end-visible)) "1" "0") - (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) "1" "0"))) - ) + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) (if (and valname-string ; special case for start keywords (string-match haskell-indent-start-keywords-re valname-string)) (progn ＠＠ -639,8 +563,7 ＠＠ otherwise (if (string-match "\\<data\\>" valname-string) (if rhs-sign (haskell-indent-push-pos rhs-sign) (haskell-indent-push-pos-offset valname)) - (haskell-indent-push-pos-offset valname) - )) + (haskell-indent-push-pos-offset valname))) (case ; general case (haskell-indent-find-case test) ;; "1.1.11" 1= vn gd rh arh ＠＠ -694,15 +617,16 ＠＠ otherwise (13 (haskell-indent-push-pos aft-rhs-sign)) ;; "000010" 14= rh (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2 ))) - ;; "000000" 15= - (t (error "haskell-indent-empty: %s impossible case" test )))))) - indent-info) + ;; "000000" 15= + (t (error "haskell-indent-empty: %s impossible case" test )))) + haskell-indent-info))) (defun haskell-indent-ident (start end end-visible indent-info) "Finds indentation points for a line starting with an identifier." (save-excursion (let* - ((sep (haskell-indent-separate-valdef start end)) + ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) (valname (pop sep)) (valname-string (pop sep)) (aft-valname (pop sep)) ＠＠ -713,18 +637,17 ＠＠ otherwise (last-line (= end end-visible)) (is-where (string-match "where[ \t]*" haskell-indent-current-line-first-ident)) - (diff-first ; not a function def with the same name + (diff-first ; not a function def with the same name (not(string= valname-string haskell-indent-current-line-first-ident))) -; (is-type-def -; (and rhs-sign (eq (char-after rhs-sign) ?\:))) - (test (concat - (if valname "1" "0") - (if (and aft-valname (< aft-valname end-visible)) "1" "0") - (if (and guard (< guard end-visible)) "1" "0") - (if (and aft-guard (< aft-guard end-visible)) "1" "0") - (if (and rhs-sign (< rhs-sign end-visible)) "1" "0") - (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) "1" "0"))) - ) + ;; (is-type-def + ;; (and rhs-sign (eq (char-after rhs-sign) ?\:))) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) (if (and valname-string ; special case for start keywords (string-match haskell-indent-start-keywords-re valname-string)) (progn ＠＠ -736,8 +659,7 ＠＠ otherwise (if (not (string-match haskell-indent-start-keywords-re haskell-indent-current-line-first-ident)) - (haskell-indent-push-pos-offset valname)) - )) + (haskell-indent-push-pos-offset valname)))) (if (string= haskell-indent-current-line-first-ident "::") (if valname (haskell-indent-push-pos valname)) (case ; general case ＠＠ -768,7 +690,7 ＠＠ otherwise ;; "1.0011" 5= vn rh arh (5 (if is-where (haskell-indent-push-pos-offset valname) - (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname) (if diff-first (haskell-indent-push-pos aft-rhs-sign)))) ;; "1.0010" 6= vn rh ＠＠ -807,34 +729,31 ＠＠ otherwise (13 (haskell-indent-push-pos aft-rhs-sign)) ;; "000010" 14= rh (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) - ;; "000000" 15= - (t (error "haskell-indent-ident: %s impossible case" test ))))))) - indent-info) + ;; "000000" 15= + (t (error "haskell-indent-ident: %s impossible case" test ))))) + haskell-indent-info))) (defun haskell-indent-other (start end end-visible indent-info) "Finds indentation points for a non-empty line starting with something other than an identifier, a guard or rhs." (save-excursion - (let* - ((sep (haskell-indent-separate-valdef start end)) - (valname (pop sep)) - (valname-string (pop sep)) - (aft-valname (pop sep)) - (guard (pop sep)) - (aft-guard (pop sep)) - (rhs-sign (pop sep)) - (aft-rhs-sign (pop sep)) - (last-line (= end end-visible)) - (is-where - (string-match "where[ \t]*" haskell-indent-current-line-first-ident)) - (test (concat - (if valname "1" "0") - (if (and aft-valname (< aft-valname end-visible)) "1" "0") - (if (and guard (< guard end-visible)) "1" "0") - (if (and aft-guard (< aft-guard end-visible)) "1" "0") - (if (and rhs-sign (< rhs-sign end-visible)) "1" "0") - (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) "1" "0"))) - ) + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) (if (and valname-string ; special case for start keywords (string-match haskell-indent-start-keywords-re valname-string)) (haskell-indent-push-pos-offset valname) ＠＠ -876,205 +795,418 ＠＠ than an identifier, a guard or rhs." (13 (haskell-indent-push-pos aft-rhs-sign)) ;; "000010" 14= rh (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) - ;; "000000" 15= - (t (error "haskell-indent-other: %s impossible case" test )))))) - indent-info) + ;; "000000" 15= + (t (error "haskell-indent-other: %s impossible case" test )))) + haskell-indent-info))) (defun haskell-indent-valdef-indentation (start end end-visible curr-line-type - indent-info) - "Finds indentation information for a value definition." - (if (< start end-visible) - (case curr-line-type - ('empty (haskell-indent-empty start end end-visible indent-info)) - ('ident (haskell-indent-ident start end end-visible indent-info)) - ('guard (haskell-indent-guard start end end-visible indent-info)) - ('rhs (haskell-indent-rhs start end end-visible indent-info)) - ('comment (error "Comment indent should never happen")) - ('other (haskell-indent-other start end end-visible indent-info))) - indent-info)) + indent-info) + "Find indentation information for a value definition." + (let ((haskell-indent-info indent-info)) + (if (< start end-visible) + (case curr-line-type + (empty (haskell-indent-empty start end end-visible indent-info)) + (ident (haskell-indent-ident start end end-visible indent-info)) + (guard (haskell-indent-guard start end end-visible indent-info)) + (rhs (haskell-indent-rhs start end end-visible indent-info)) + (comment (error "Comment indent should never happen")) + (other (haskell-indent-other start end end-visible indent-info))) + haskell-indent-info))) (defun haskell-indent-line-indentation (line-start line-end end-visible curr-line-type indent-info) - "Separate a line of program into valdefs between offside keywords + "Compute indentation info between LINE-START and END-VISIBLE. +Separate a line of program into valdefs between offside keywords and find indentation info for each part." (save-excursion - (let (end-match beg-match in-string start-comment) - ;; point is (already) at line-start - (setq start-comment (haskell-indent-in-comment line-start line-end)) - (if start-comment ; if comment at the end - (setq line-end (- start-comment 1))) ; end line before it + ;; point is (already) at line-start + (assert (eq (point) line-start)) + (let ((haskell-indent-info indent-info) + (start (or (haskell-indent-in-comment line-start line-end) + (haskell-indent-in-string line-start line-end)))) + (if start ; if comment at the end + (setq line-end start)) ; end line before it ;; loop on all parts separated by off-side-keywords - (while (re-search-forward haskell-indent-off-side-keywords-re line-end t) - (setq beg-match (match-beginning 0)); save beginning of match - (setq end-match (match-end 0)) ; save end of match - (if (haskell-indent-in-comment line-start (point)) ; keyword in a {- comment - (progn - (setq indent-info - (haskell-indent-valdef-indentation - line-start ; end line before comment - (- (search-backward "{-" line-start) 1) - end-visible curr-line-type indent-info)) - ;skip past end of comment - (re-search-forward "-}[ \t]*" line-end 'move) - (setq line-start (point))) - ;; not in a comment - (setq in-string (haskell-indent-in-string line-start (point))) - (if in-string - (re-search-forward ; skip past end of string - ; line-start does not change... - (concat (char-to-string in-string) "[ \t]*") line-end 'move) - ;; not in a string - (if (< line-start beg-match) ; if off-side-keyword at the start - (setq indent-info ; do not try to find indentation points - (haskell-indent-valdef-indentation line-start beg-match - end-visible - curr-line-type indent-info))) - ;; but keep the start of the line if keyword alone on the line - (if (= line-end end-match) - (haskell-indent-push-pos beg-match))) - (setq line-start end-match) - (goto-char line-start))) - (setq indent-info + (while (and (re-search-forward haskell-indent-off-side-keywords-re + line-end t) + (not (or (haskell-indent-in-comment line-start (point)) + (haskell-indent-in-string line-start (point))))) + (let ((beg-match (match-beginning 0)) ; save beginning of match + (end-match (match-end 0))) ; save end of match + ;; Do not try to find indentation points if off-side-keyword at + ;; the start... + (if (or (< line-start beg-match) + ;; Actually, if we're looking at a "let" inside a "do", we + ;; should add the corresponding indentation point. + (eq (char-after beg-match) ?l)) + (setq haskell-indent-info + (haskell-indent-valdef-indentation line-start beg-match + end-visible + curr-line-type + haskell-indent-info))) + ;; ...but keep the start of the line if keyword alone on the line + (if (= line-end end-match) + (haskell-indent-push-pos beg-match)) + (setq line-start end-match) + (goto-char line-start))) + (setq haskell-indent-info (haskell-indent-valdef-indentation line-start line-end end-visible - curr-line-type indent-info)))) - indent-info) + curr-line-type haskell-indent-info)) + haskell-indent-info))) + -(defun haskell-indent-indentation-info () - "Returns a list of possible indentations for the current line that -are then used by `haskell-indent-cycle'." - (let ((start (haskell-indent-start-of-def)) - (end (progn (haskell-indent-back-to-indentation) (point))) - indent-info open follow contour-line pt) - ;; in string? - (if (setq open (haskell-indent-in-string start end)) - (haskell-indent-push-pos-offset open - (if (looking-at "\\\\") 0 1)) - ;; open structure? ie ( { [ - (if (setq open (haskell-indent-open-structure start end)) - ;; there is an open structure to complete - (if (looking-at "\\s)\\|\\s.\\|$ ") - (haskell-indent-push-pos open); align a ) or punct with ( - (progn - (setq follow (save-excursion - (goto-char (1+ open)) - (haskell-indent-skip-blanks-and-newlines-forward end) - (point))) - (if (= follow end) - (haskell-indent-push-pos-offset open 1) - (haskell-indent-push-pos follow)))) - ;; in comment ? - (if (haskell-indent-in-comment start end) - (save-excursion - (end-of-line 0) ; put point at the end of preceding line before - (setq indent-info ; computing comment indentation - (haskell-indent-comment (haskell-indent-get-beg-of-line) - (point) indent-info))) - ;; full indentation - (setq contour-line (haskell-indent-contour-line start end)) - (if contour-line - (let* ((curr-line-type (haskell-indent-type-at-point)) - line-start line-end end-visible) - (save-excursion - (if (eq curr-line-type 'ident) - (progn ; guess the type of line - (setq sep - (haskell-indent-separate-valdef (point) - (haskell-indent-get-end-of-line))) - ;; if the first ident is where or the start of a def - ;; keep it in a global variable - (if (string-match "where[ \t]*" (nth 1 sep)) - (setq haskell-indent-current-line-first-ident (nth 1 sep)) - (if (nth 5 sep) ; is there a rhs-sign - (if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef - (setq haskell-indent-current-line-first-ident "::") - (setq haskell-indent-current-line-first-ident - (nth 1 sep))) - (setq haskell-indent-current-line-first-ident ""))))) - (while contour-line ; explore the contour points - (setq line-start (pop contour-line)) - (goto-char line-start) - (setq line-end (haskell-indent-get-end-of-line)) - (setq end-visible ; visible until the column of the - (if contour-line ; next contour point - (save-excursion - (move-to-column - (haskell-indent-point-to-col (car contour-line))) - (point)) - line-end)) - (if (and (not (haskell-indent-open-structure start line-start)) - (not (haskell-indent-in-comment start line-start))) - (setq indent-info - (haskell-indent-line-indentation line-start line-end - end-visible curr-line-type - indent-info))) - ))) - ;; simple contour just one indentation at start - (if (and (eq haskell-literate 'bird) - (eq (haskell-indent-point-to-col start) 1)) - ;; for a Bird style literate script put default offset - ;; in the case of no indentation - (haskell-indent-push-col - (1+ haskell-indent-literate-Bird-default-offset)) - (haskell-indent-push-pos start))))) - indent-info - ))) - -(defun haskell-indent-event-type (event) - "Checks if EVENT is the TAB or RET key before returning the value -of `event-basic-type'. Needed for dealing with the case that Emacs -is not in a windowing environment." - (cond ((eq event ?\t) 'tab) - ((eq event ?\r) 'return) - (t (event-basic-type event))) - ) - +(defun haskell-indent-layout-indent-info (start contour-line) + (let ((haskell-indent-info nil) + (curr-line-type (haskell-indent-type-at-point)) + line-start line-end end-visible) + (save-excursion + (if (eq curr-line-type 'ident) + (let ; guess the type of line + ((sep + (haskell-indent-separate-valdef + (point) (line-end-position)))) + ;; if the first ident is where or the start of a def + ;; keep it in a global variable + (setq haskell-indent-current-line-first-ident + (if (string-match "where[ \t]*" (nth 1 sep)) + (nth 1 sep) + (if (nth 5 sep) ; is there a rhs-sign + (if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef + "::" (nth 1 sep)) + ""))))) + (while contour-line ; explore the contour points + (setq line-start (pop contour-line)) + (goto-char line-start) + (setq line-end (line-end-position)) + (setq end-visible ; visible until the column of the + (if contour-line ; next contour point + (save-excursion + (move-to-column + (haskell-indent-point-to-col (car contour-line))) + (point)) + line-end)) + (unless (or (haskell-indent-open-structure start line-start) + (haskell-indent-in-comment start line-start)) + (setq haskell-indent-info + (haskell-indent-line-indentation line-start line-end + end-visible curr-line-type + haskell-indent-info))))) + haskell-indent-info)) + +(defun haskell-indent-find-matching-start (regexp limit &optional pred start) + (let ((open (haskell-indent-open-structure limit (point)))) + (if open (setq limit (1+ open)))) + (unless start (setq start (point))) + (when (re-search-backward regexp limit t) + (let ((nestedcase (match-end 1)) + (outer (or (haskell-indent-in-string limit (point)) + (haskell-indent-in-comment limit (point)) + (haskell-indent-open-structure limit (point)) + (if (and pred (funcall pred start)) (point))))) + (cond + (outer + (goto-char outer) + (haskell-indent-find-matching-start regexp limit pred start)) + (nestedcase + ;; Nested case. + (and (haskell-indent-find-matching-start regexp limit pred) + (haskell-indent-find-matching-start regexp limit pred start))) + (t (point)))))) + +(defun haskell-indent-filter-let-no-in (start) + "Return non-nil if point is in front of a `let' that has no `in'. +START is the position of the presumed `in'." + ;; We're looking at either `in' or `let'. + (when (looking-at "let") + (ignore-errors + (save-excursion + (forward-word 1) + (forward-comment (point-max)) + (if (looking-at "{") + (progn + (forward-sexp 1) + (forward-comment (point-max)) + (< (point) start)) + ;; Use the layout rule to see whether this let is already closed + ;; without an `in'. + (let ((col (current-column))) + (while (progn (forward-line 1) (haskell-indent-back-to-indentation) + (< (point) start)) + (when (< (current-column) col) + (setq col nil) + (goto-char start))) + (null col))))))) + +(defun haskell-indent-inside-comment (open start) + "Compute indent info for text inside comment. +OPEN is the start position of the comment in which point is." + ;; Ideally we'd want to guess whether it's commented out code or + ;; whether it's text. Instead, we'll assume it's text. + (save-excursion + (if (= open (point)) + ;; We're actually just in front of a comment: align with following + ;; code or with comment on previous line. + (let ((prev-line-info + (cond + ((eq (char-after) ?\{) nil) ;Align as if it were code. + ((and (forward-comment -1) + (> (line-beginning-position 3) open)) + ;; We're after another comment and there's no empty line + ;; between us. + (list (list (haskell-indent-point-to-col (point))))) + (t nil)))) ;Else align as if it were code + ;; Align with following code. + (forward-comment (point-max)) + ;; There are several possible indentation points for this code-line, + ;; but the only valid indentation point for the comment is the one + ;; that the user will select for the code-line. Obviously we can't + ;; know that, so we just assume that the code-line is already at its + ;; proper place. + ;; Strictly speaking "assume it's at its proper place" would mean + ;; we'd just use (current-column), but since this is using info from + ;; lines further down and it's common to reindent line-by-line, + ;; we'll align not with the current indentation, but with the + ;; one that auto-indentation "will" select. + (append + prev-line-info + (let ((indent-info (save-excursion + (haskell-indent-indentation-info start))) + (col (current-column))) + ;; Sort the indent-info so that the current indentation comes + ;; out first. + (setq indent-info + (sort indent-info + (lambda (x y) + (<= (abs (- col (car x))) (abs (- col (car y))))))) + indent-info))) + + ;; We really are inside a comment. + (if (looking-at "-}") + (progn + (forward-char 2) + (forward-comment -1) + (list (list (1+ (haskell-indent-point-to-col (point)))))) + (let ((offset (if (looking-at "--?") + (- (match-beginning 0) (match-end 0))))) + (forward-line -1) ;Go to previous line. + (haskell-indent-back-to-indentation) + (if (< (point) start) (goto-char start)) + + (list (list (if (looking-at comment-start-skip) + (if offset + (+ 2 offset (haskell-indent-point-to-col (point))) + (haskell-indent-point-to-col (match-end 0))) + (haskell-indent-point-to-col (point)))))))))) + +(defcustom haskell-indent-after-keywords + '(("where" 2 0) + ("of" 2) + ("do" 2) + ("in" 2 0) + "if" + "then" + "else" + "let") + "Keywords after which indentation should be indented by some offset. +Each keyword info can have the following forms: + + KEYWORD | (KEYWORD OFFSET [OFFSET-HANGING]) + +If absent OFFSET-HANGING defaults to OFFSET. +If absent OFFSET defaults to `haskell-indent-offset'. + +OFFSET-HANGING is the offset to use in the case where the keyword +is at the end of an otherwise-non-empty line." +:type '(repeat (choice string + (cons :tag "" (string :tag "keyword:") + (cons :tag "" (integer :tag "offset") + (choice (const nil) + (list :tag "" + (integer :tag "offset-pending")))))))) + +(defun haskell-indent-virtual-indentation (start) + "Compute the \"virtual indentation\" of text at point. +The \"virtual indentation\" is the indentation that text at point would have +had, if it had been placed on its own line." + (let ((col (current-column))) + (if (save-excursion (skip-chars-backward " \t") (bolp)) + ;; If the text is indeed on its own line, than the virtual indent is + ;; the current indentation. + col + ;; Else, compute the indentation that it would have had. + (let ((info (haskell-indent-indentation-info start)) + (max -1)) + ;; `info' is a list of possible indent points. Each indent point is + ;; assumed to correspond to a different parse. So we need to find + ;; the parse that corresponds to the case at hand (where there's no + ;; line break), which is assumed to always be the + ;; deepest indentation. + (dolist (x info) + (setq x (car x)) + ;; Sometimes `info' includes the current indentation (or yet + ;; deeper) by mistake, because haskell-indent-indentation-info + ;; wasn't designed to be called on a piece of text that is not at + ;; BOL. So ignore points past `col'. + (if (and (> x max) (not (>= x col))) + (setq max x))) + ;; In case all the indent points are past `col', just use `col'. + (if (>= max 0) max col))))) + +(defun haskell-indent-indentation-info (&optional start) + "Return a list of possible indentations for the current line. +These are then used by `haskell-indent-cycle'. +START if non-nil is a presumed start pos of the current definition." + (unless start (setq start (haskell-indent-start-of-def))) + (let ((end (point)) + open follow contour-line) + (cond + ;; in string? + ((setq open (haskell-indent-in-string start end)) + (list (list (+ (haskell-indent-point-to-col open) + (if (looking-at "\\\\") 0 1))))) + + ;; in comment ? + ((setq open (haskell-indent-in-comment start end)) + (haskell-indent-inside-comment open start)) + + ;; Closing the declaration part of a `let' or the test exp part of a case. + ((and (looking-at "\$?:in\\|of\\|then\\|else\$\\>") + (setq open (save-excursion + (haskell-indent-find-matching-start + (case (char-after) + (?i "\\<\$?:\\(in\$\\|let\\)\\>") + (?o "\\<\$?:\\(of\$\\|case\\)\\>") + (?t "\\<\$?:\\(then\$\\|if\\)\\>") + (?e "\\<\$?:\\(else\$\\|if\\)\\>")) + start + (if (eq (char-after) ?i) + ;; Filter out the `let's that have no `in'. + 'haskell-indent-filter-let-no-in)))) + ;; For a "dangling let/case/if at EOL" we should use a different + ;; indentation scheme. + (save-excursion + (goto-char open) + (let ((letcol (current-column))) + (forward-word 1) (forward-comment (point-max)) + (>= (current-column) letcol)))) + (list (list (haskell-indent-point-to-col open)))) + + ;; Right after a special keyword. + ((save-excursion + (forward-comment (- (point-max))) + (let ((id (buffer-substring (point) (progn (forward-word -1) (point))))) + (when (setq open (or (assoc id haskell-indent-after-keywords) + (car (member id haskell-indent-after-keywords)))) + (setq open (cdr-safe open)) + (setq open + (if (save-excursion (skip-syntax-backward " \t") (bolp)) + (car open) + (or (cadr open) (car open)))) + (list (list + (+ (haskell-indent-virtual-indentation start) + (or open haskell-indent-offset)))))))) + + ;; open structure? ie ( { [ + ((setq open (haskell-indent-open-structure start end)) + ;; there is an open structure to complete + (if (looking-at "\\s)\\|[;,]") + ;; A close-paren or a , or ; can only correspond syntactically to + ;; the open-paren at `open'. So there is no ambiguity. + (progn + (if (or (and (eq (char-after) ?\;) (eq (char-after open) ?$)) + (and (eq (char-after) ?\,) (eq (char-after open) ?\{))) + (message "Mismatched punctuation: `%c' in %c...%c" + (char-after) (char-after open) + (if (eq (char-after open) ?\() ?$ ?\}))) + (list (list (haskell-indent-point-to-col open)))) + ;; There might still be layout within the open structure. + (let ((basic-indent-info + ;; Anything else than a ) is subject to layout. + (if (looking-at "\\s.\\|$ ") + (haskell-indent-point-to-col open) ; align a punct with ( + (setq follow (save-excursion + (goto-char (1+ open)) + (haskell-indent-skip-blanks-and-newlines-forward end) + (point))) + (if (= follow end) + (1+ (haskell-indent-point-to-col open)) + (haskell-indent-point-to-col follow)))) + (open-column (haskell-indent-point-to-col open)) + (contour-line (haskell-indent-contour-line (1+ open) end))) + (if (null contour-line) + (list (list basic-indent-info)) + (let ((indent-info + (haskell-indent-layout-indent-info + (1+ open) contour-line))) + ;; Fix up indent info. + (let ((base-elem (assoc open-column indent-info))) + (if base-elem + (progn (setcar base-elem basic-indent-info) + (setcdr base-elem nil)) + (setq indent-info + (append indent-info (list (list basic-indent-info))))) + indent-info)))))) + + ;; full indentation + ((setq contour-line (haskell-indent-contour-line start end)) + (haskell-indent-layout-indent-info start contour-line)) + + (t + ;; simple contour just one indentation at start + (list (list (if (and (eq haskell-literate 'bird) + (eq (haskell-indent-point-to-col start) 1)) + ;; for a Bird style literate script put default offset + ;; in the case of no indentation + (1+ haskell-indent-literate-Bird-default-offset) + (haskell-indent-point-to-col start)))))))) + +(defvar haskell-indent-last-info nil) + + (defun haskell-indent-cycle () "Indentation cycle. -We stay in the cycle as long as the TAB key is pressed. -Any other key or mouse click terminates the cycle and is interpreted -with the exception of the RET key which merely exits the cycle." +We stay in the cycle as long as the TAB key is pressed." (interactive "*") (if (and haskell-literate (not (haskell-indent-within-literate-code))) - (indent-to-left-margin) ;; use the ordinary tab for text... - (let (il indent-list com indent-info cdrii marker - (last-insert-length 0)) - (if (> (current-column) (haskell-indent-current-indentation)) - (setq marker (point-marker))) - (setq il (setq indent-list (haskell-indent-indentation-info))) - ;;(message "Indent-list:%s" indent-list) (read-event) ; uncomment for debug!! - (setq indent-info (car il)) - (haskell-indent-line-to (car indent-info)) ; insert indentation - (if (setq cdrii (cdr indent-info)) - (progn - (insert cdrii) - (setq last-insert-length (length cdrii))) - (setq last-insert-length 0)) - (if (= (length indent-list) 1) - (message "Sole indentation") - (message (format "Indent cycle (%d)..." (length indent-list))) - (while (equal (haskell-indent-event-type (setq com (read-event))) 'tab) - (setq il (cdr il)) ; get next insertion - (or il (setq il indent-list)) ; if at the end of insertion, restart - ; from the beginning - (setq indent-info (car il)) - (haskell-indent-line-to (car indent-info)) ; insert indentation - (delete-char last-insert-length) - (if (setq cdrii (cdr indent-info)) - (progn - (insert cdrii) - (setq last-insert-length (length cdrii))) - (setq last-insert-length 0)) - (message "Indenting...")) - (if (not (equal (haskell-indent-event-type com) 'return)) - (setq unread-command-events (list com))) - (message "Done.")) - (if marker - (goto-char (marker-position marker))) - )) - ) -;;; alignment functions -;;; + ;; use the ordinary tab for text... + (funcall (default-value 'indent-line-function)) + (let ((marker (if (> (current-column) (haskell-indent-current-indentation)) + (point-marker))) + (bol (progn (beginning-of-line) (point)))) + (haskell-indent-back-to-indentation) + (unless (and (eq last-command this-command) + (eq bol (car haskell-indent-last-info))) + (save-excursion + (setq haskell-indent-last-info + (list bol (haskell-indent-indentation-info) 0 0)))) + + (let* ((il (nth 1 haskell-indent-last-info)) + (index (nth 2 haskell-indent-last-info)) + (last-insert-length (nth 3 haskell-indent-last-info)) + (indent-info (nth index il))) + + (haskell-indent-line-to (car indent-info)) ; insert indentation + (delete-char last-insert-length) + (setq last-insert-length 0) + (let ((text (cdr indent-info))) + (if text + (progn + (insert text) + (setq last-insert-length (length text))))) + + (setq haskell-indent-last-info + (list bol il (% (1+ index) (length il)) last-insert-length)) + + (if (= (length il) 1) + (message "Sole indentation") + (message "Indent cycle (%d)..." (length il))) + + (if marker + (goto-char (marker-position marker))))))) + +;;; alignment functions + (defun haskell-indent-shift-columns (dest-column region-stack) "Shifts columns in region-stack to go to DEST-COLUMN. Elements of the stack are pairs of points giving the start and end ＠＠ -1094,37 +1226,35 ＠＠ of the regions to move." (end-of-line 2) ; should be (forward-line 1) (if (eobp) ; but it adds line at the end... (throw 'end-of-buffer nil)) - (move-to-column col))) - )) - )) - + (move-to-column col))))))) + (defun haskell-indent-align-def (p-arg type) "Align guards or rhs within the current definition before point. If P-ARG is t align all defs up to the mark. TYPE is either 'guard or 'rhs." (save-excursion (let (start-block end-block - (maxcol (if (eq type 'rhs) haskell-indent-rhs-align-column 0)) + (maxcol (if (eq type 'rhs) haskell-indent-rhs-align-column 0)) contour sep defname defnamepos - defpos defcol pos lastpos + defcol pos lastpos regstack eqns-start start-found) - ;; find the starting and ending boundary points for alignment - (if p-arg + ;; find the starting and ending boundary points for alignment + (if p-arg (if (mark) ; aligning everything in the region (progn (when (> (mark) (point)) (exchange-point-and-mark)) (setq start-block (save-excursion (goto-char (mark)) - (haskell-indent-get-beg-of-line))) + (line-beginning-position))) (setq end-block (progn (if (haskell-indent-bolp) (haskell-indent-forward-line -1)) - (haskell-indent-get-end-of-line)))) + (line-end-position)))) (error "The mark is not set for aligning definitions")) ;; aligning the current definition (setq start-block (haskell-indent-start-of-def)) - (setq end-block (haskell-indent-get-end-of-line))) + (setq end-block (line-end-position))) ;; find the start of the current valdef using the contour line ;; in reverse order because we need the nearest one from the end (setq contour ＠＠ -1148,7 +1278,7 ＠＠ TYPE is either 'guard or 'rhs." (setq defname "\\<\\|(")) (setq defcol (haskell-indent-point-to-col defnamepos)) (goto-char pos) - (setq end-block (haskell-indent-get-end-of-line)) + (setq end-block (line-end-position)) (catch 'top-of-buffer (while (and (not start-found) (>= (point) start-block)) ＠＠ -1165,7 +1295,7 ＠＠ TYPE is either 'guard or 'rhs." (if (and (eq (haskell-indent-type-at-point) 'guard) ; start of a guard (not (haskell-indent-open-structure start-block (point)))) (push (cons (point) 'gd) eqns-start))) - (if (bobp) + (if (bobp) (throw 'top-of-buffer nil) (haskell-indent-backward-to-indentation 1)))) ;; remove the spurious guards before the first equation ＠＠ -1173,15 +1303,14 ＠＠ TYPE is either 'guard or 'rhs." (pop eqns-start)) ;; go through each equation to find the region to indent (while eqns-start - (setq eqn (caar eqns-start)) - (setq lastpos (if (cdr eqns-start) - (save-excursion - (goto-char (caadr eqns-start)) - (haskell-indent-forward-line -1) - (haskell-indent-get-end-of-line)) - end-block)) - (setq sep (haskell-indent-separate-valdef eqn lastpos)) - (setq defpos (nth 0 sep)) + (let ((eqn (caar eqns-start))) + (setq lastpos (if (cdr eqns-start) + (save-excursion + (goto-char (caadr eqns-start)) + (haskell-indent-forward-line -1) + (line-end-position)) + end-block)) + (setq sep (haskell-indent-separate-valdef eqn lastpos))) (if (eq type 'guard) (setq pos (nth 3 sep)) ;; check if what follows a rhs sign is more indented or not ＠＠ -1201,7 +1330,7 ＠＠ TYPE is either 'guard or 'rhs." (goto-char pos) (skip-chars-backward " \t" - (haskell-indent-get-beg-of-line)) + (line-beginning-position)) (if (haskell-indent-bolp) ;;if on an empty prefix (haskell-indent-point-to-col pos) ;keep original indent ＠＠ -1209,18 +1338,18 ＠＠ TYPE is either 'guard or 'rhs." (pop eqns-start)) ;; now shift according to the region stack (if regstack - (haskell-indent-shift-columns maxcol regstack)) - )) - ))) + (haskell-indent-shift-columns maxcol regstack))))))) (defun haskell-indent-align-guards-and-rhs (start end) -"Align the guards and rhs of functions in the region which must be active." + "Align the guards and rhs of functions in the region which must be active." + ;; The `start' and `end' args are dummys right now: they're just there so + ;; we can use the "r" interactive spec which properly signals an error. (interactive "*r") (haskell-indent-align-def t 'guard) (haskell-indent-align-def t 'rhs)) + +;;; insertion functions -;;; insertion functions -;;; (defun haskell-indent-insert-equal () "Insert an = sign and align the previous rhs of the current function." (interactive "*") ＠＠ -1231,8 +1360,7 ＠＠ TYPE is either 'guard or 'rhs." (haskell-indent-align-def (haskell-indent-mark-active) 'rhs)) (defun haskell-indent-insert-guard (&optional text) - "Insert a guard sign (|) followed by optional TEXT and align the -previous guards of the current function. + "Insert and align a guard sign (|) followed by optional TEXT. Alignment works only if all guards are to the south-east of their |." (interactive "*") (let ((pc (if (haskell-indent-bolp) ?\012 ＠＠ -1241,7 +1369,7 ＠＠ Alignment works only if all guards are t ;; check what guard to insert depending on the previous context (if (= pc ?\ ) ; x = any char other than blank or | (if (/= pc1 ?\|) - (insert "| ") ; after " x" + (insert "| ") ; after " x" ()) ; after " |" (if (= pc ?\|) (if (= pc1 ?\|) ＠＠ -1263,64 +1391,59 ＠＠ previous guards of the current function. line with an indentation cycle." (interactive "*") (insert "where ") - (save-excursion - (haskell-indent-cycle))) + (haskell-indent-cycle)) + +;;; haskell-indent-mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; turn-on-haskell-indent to be used in conjunction with -;;; the haskell-mode of Graeme E Moss and Tommy Thorn -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar haskell-indent-mode nil + "Indicates if the semi-intelligent Haskell indentation mode is in effect +in the current buffer.") +(make-variable-buffer-local 'haskell-indent-mode) (defun turn-on-haskell-indent () "Turn on ``intelligent'' haskell indentation mode." (interactive) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'haskell-indent-cycle) -; Removed: remapping DEL seems a bit naughty --SDM -; (local-set-key "\177" 'backward-delete-char-untabify) - (local-set-key "\t" 'haskell-indent-cycle) - (local-set-key "\C-c=" 'haskell-indent-insert-equal) - (local-set-key "\C-c|" 'haskell-indent-insert-guard) - (local-set-key "\C-co" 'haskell-indent-insert-otherwise) - (local-set-key "\C-cw" 'haskell-indent-insert-where) - (local-set-key "\C-c." 'haskell-indent-align-guards-and-rhs) - (local-set-key "\C-c>" 'haskell-indent-put-region-in-literate) + (set (make-local-variable 'indent-line-function) 'haskell-indent-cycle) + ;; Removed: remapping DEL seems a bit naughty --SDM + ;; (local-set-key "\177" 'backward-delete-char-untabify) + ;; The binding to TAB is already handled by indent-line-function. --Stef + ;; (local-set-key "\t" 'haskell-indent-cycle) + (local-set-key [?\C-c ?\C-=] 'haskell-indent-insert-equal) + (local-set-key [?\C-c ?\C-|] 'haskell-indent-insert-guard) + (local-set-key [?\C-c ?\C-o] 'haskell-indent-insert-otherwise) + (local-set-key [?\C-c ?\C-w] 'haskell-indent-insert-where) + (local-set-key [?\C-c ?\C-.] 'haskell-indent-align-guards-and-rhs) + (local-set-key [?\C-c ?\C->] 'haskell-indent-put-region-in-literate) (setq haskell-indent-mode t) - (run-hooks 'haskell-indent-hook) - ) + (run-hooks 'haskell-indent-hook)) (defun turn-off-haskell-indent () "Turn off ``intelligent'' haskell indentation mode that deals with the layout rule of Haskell." (interactive) - (setq indent-line-function 'indent-to-left-margin) - (local-unset-key "\t") - (local-unset-key "\177") - (local-unset-key "\C-c=") - (local-unset-key "\C-c|") - (local-unset-key "\C-co") - (local-unset-key "\C-cw") - (local-unset-key "\C-c.") - (local-unset-key "\C-c>") - (setq haskell-indent-mode nil) - ) + (kill-local-variable 'indent-line-function) + ;; (local-unset-key "\t") + ;; (local-unset-key "\177") + (local-unset-key [?\C-c ?\C-=]) + (local-unset-key [?\C-c ?\C-|]) + (local-unset-key [?\C-c ?\C-o]) + (local-unset-key [?\C-c ?\C-w]) + (local-unset-key [?\C-c ?\C-.]) + (local-unset-key [?\C-c ?\C->]) + (setq haskell-indent-mode nil)) -(defvar haskell-indent-mode nil - "Indicates if the semi-intelligent Haskell indentation mode is in effect -in the current buffer.") -(make-variable-buffer-local 'haskell-indent-mode) - ;; Put this minor mode on the global minor-mode-alist. (or (assq 'haskell-indent-mode (default-value 'minor-mode-alist)) (setq-default minor-mode-alist (append (default-value 'minor-mode-alist) '((haskell-indent-mode " Ind"))))) +;;;###autoload (defun haskell-indent-mode (&optional arg) "``intelligent'' Haskell indentation mode that deals with the layout rule of Haskell. \\[haskell-indent-cycle] starts the cycle -which proposes new possibilities as long as the TAB key is pressed. +which proposes new possibilities as long as the TAB key is pressed. Any other key or mouse click terminates the cycle and is interpreted except for RET which merely exits the cycle. Other special keys are: ＠＠ -1353,80 +1476,53 ＠＠ Invokes `haskell-indent-hook' if not nil (turn-on-haskell-indent) (turn-off-haskell-indent))) -(provide 'haskell-indent) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Haskell-stand-alone- indentation mode (vanilla version of the Hugs-mode) -;;; in the case where only Haskell indentation is used without the hugs-mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar hugs-syntax-table - (let ((table (copy-syntax-table))) - (modify-syntax-entry ?_ "w " table) - (modify-syntax-entry ?` "w " table) - (modify-syntax-entry ?\' "w " table) - (modify-syntax-entry ?$ "()" table) - (modify-syntax-entry ?$ ")(" table) - (modify-syntax-entry ?\[ "(]" table) - (modify-syntax-entry ?\] ")[" table) - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?\\ "\\" table) - - (if haskell-running-xemacs +;;; Haskell stand-alone indentation mode (vanilla version of the Hugs-mode) + +(defvar haskell-indent-stand-alone-mode-syntax-table + (let ((st (copy-syntax-table))) + (modify-syntax-entry ?_ "w " st) + (modify-syntax-entry ?` "w " st) + (modify-syntax-entry ?\' "w " st) + (modify-syntax-entry ?$ "()" st) + (modify-syntax-entry ?$ ")(" st) + (modify-syntax-entry ?\[ "(]" st) + (modify-syntax-entry ?\] ")[" st) + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?\\ "\\" st) + + (if (featurep 'xemacs) ;; XEmacs specific syntax-table. (progn - (modify-syntax-entry ?- ". 2356" table) ; -- starts a comment. - (modify-syntax-entry ?\n "> b " table) ; \n ends a comment. - (modify-syntax-entry ?{ ". 1 " table) ; {- starts a nested comment. - (modify-syntax-entry ?} ". 4 " table) ; -} ends a nested comment. - ) + (modify-syntax-entry ?- ". 2356" st) ; -- starts a comment. + (modify-syntax-entry ?\n "> b " st) ; \n ends a comment. + (modify-syntax-entry ?{ ". 1 " st) ; {- starts a nested comment. + (modify-syntax-entry ?} ". 4 " st)) ; -} ends a nested comment. ;; Emacs specific syntax-table. - (modify-syntax-entry ?{ "(}1 " table) - (modify-syntax-entry ?} "){4 " table) - (modify-syntax-entry ?- "_ 23" table) - ;; No alternative comment-style because they don't share the same - ;; first character. - ) - table) - "Syntax table in use in `hugs-mode'") - -(defvar hugs-mode-map (make-sparse-keymap) - "Keymap used in `hugs-mode'.") - -(defun haskell-stand-alone-indent-mode () + ;; Actually the `b' is ignored, so it only works correctly in Emacs-21 + ;; where the `n' is understood. + (modify-syntax-entry ?{ "(}1nb" st) + (modify-syntax-entry ?} "){4nb" st) + (modify-syntax-entry ?- "_ 123" st) + (modify-syntax-entry ?\n ">" st)) + st) + "Syntax table in use in `haskell-indent-stand-alone-mode'.") + +(defalias 'haskell-stand-alone-indent-mode 'haskell-indent-stand-alone-mode) +(define-derived-mode haskell-indent-stand-alone-mode fundamental-mode + "Haskell-Indent" "Major mode for indenting Haskell source files. COMMANDS -\\{hugs-mode-map}\ +\\{haskell-indent-stand-alone-mode-map}\ TAB indents for Haskell code. Delete converts tabs to spaces as it moves back. Variables controlling indentation/edit style: `haskell-indent-offset' (default 4) - Indentation of Haskell statements with respect to containing block. - -See also the user variables `hugs-type-keywords' and `hugs-start-keywords' + Indentation of Haskell statements with respect to containing block." + (haskell-indent-mode 1)) -Entry to this mode calls the value of `hugs-mode-hook' if that value -is non-nil." - (interactive) - ;; Set up local variables. - (kill-all-local-variables) - (make-local-variable 'comment-start) - (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-end) - (make-local-variable 'indent-line-function) - - (set-syntax-table hugs-syntax-table) - (setq major-mode 'haskell-indent-mode - mode-name "Haskell-Indent" - comment-start "{-" - comment-start-skip "{-[^a-zA-Z0-9]*" - ;; comment-end must be set because it may hold a wrong value if - ;; this buffer had been in another mode before. - comment-end "" - indent-line-function 'haskell-indent-line) - (use-local-map hugs-mode-map) +(provide 'haskell-indent) - (run-hooks 'hugs-mode-hook) -) +;;; haskell-indent.el ends here 1.7 +137 -119 XEmacs/packages/xemacs-packages/haskell-mode/haskell-mode.el Index: haskell-mode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-mode.el,v retrieving revision 1.6 retrieving revision 1.7 diff -u -p -r1.6 -r1.7 --- haskell-mode.el 2004/06/16 15:16:49 1.6 +++ haskell-mode.el 2006/03/15 05:18:23 1.7 ＠＠ -1,7 +1,7 ＠＠ ;;; haskell-mode.el --- A Haskell editing mode -*-coding: iso-8859-1;-*- +;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc ;; Copyright (C) 1992, 1997-1998 Simon Marlow, Graeme E Moss, and Tommy Thorn -;; Copyright (C) 2003 Free Software Foundation, Inc ;; Authors: 1992 Simon Marlow ;; 1997-1998 Graeme E Moss <gem(a)cs.york.ac.uk> and ＠＠ -9,7 +9,7 ＠＠ ;; 2001-2002 Reuben Thomas (>=v1.4) ;; 2003 Dave Love <fx(a)gnu.org> ;; Keywords: faces files Haskell -;; Version: 1.43 +;; Version: v2_1 ;; URL: http://www.haskell.org/haskell-mode/ ;;; This file is not part of GNU Emacs. ＠＠ -52,13 +52,13 ＠＠ ;; `haskell-simple-indent', Graeme E Moss and Heribert Schuetz ;; Simple indentation. ;; -;; `haskell-hugs', Guy Lapalme -;; Interaction with Hugs interpreter. +;; `inf-haskell' +;; Interaction with an inferior Haskell process. +;; It replaces the previous two modules: +;; `haskell-hugs', Guy Lapalme +;; `haskell-ghci', Chris Web ;; -;; `haskell-ghci', Chris Web -;; Interaction with GHCi interpreter. ;; -;; ;; This mode supports full Haskell 1.4 including literate scripts. ;; In some versions of (X)Emacs it may only support Latin-1, not Unicode. ;; ＠＠ -86,12 +86,10 ＠＠ ;; To turn any of the supported modules on for all buffers, add the ;; appropriate line(s) to .emacs: ;; -;; (add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock) ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) -;; (add-hook 'haskell-mode-hook 'turn-on-haskell-hugs) ;; ;; Make sure the module files are also on the load-path. Note that ;; the two indentation modules are mutually exclusive: Use only one. ＠＠ -117,7 +115,7 ＠＠ ;; author to contact via email. For general problems or suggestions, ;; consult the list below, then email gem(a)cs.york.ac.uk and ;; thorn(a)irisa.fr quoting the version of the mode you are using, the -;; version of emacs you are using, and a small example of the problem +;; version of Emacs you are using, and a small example of the problem ;; or suggestion. ;; ;; Version 1.43: ＠＠ -193,11 +191,15 ＠＠ ;; ;; . Support for GreenCard? ;; + +;;; Code: + +(eval-when-compile (require 'cl)) -;;; All functions/variables start with `(literate-)haskell-'. +;; All functions/variables start with `(literate-)haskell-'. ;; Version of mode. -(defconst haskell-version "1.43" +(defconst haskell-version "v2_1" "`haskell-mode' version number.") (defun haskell-version () "Echo the current version of `haskell-mode' in the minibuffer." ＠＠ -209,15 +211,7 ＠＠ :group 'languages :prefix "haskell-") -;; Haskell-like function for creating [from..to]. -(defun haskell-enum-from-to (from to) - (if (> from to) - () - (cons from (haskell-enum-from-to (1+ from) to)))) - ;; Set up autoloads for the modules we supply -(autoload 'turn-on-haskell-font-lock "haskell-font-lock" - "Turn on Haskell font locking." t) (autoload 'turn-on-haskell-decl-scan "haskell-decl-scan" "Turn on Haskell declaration scanning." t) (autoload 'turn-on-haskell-doc-mode "haskell-doc" ＠＠ -226,20 +220,33 ＠＠ "Turn on Haskell indentation." t) (autoload 'turn-on-haskell-simple-indent "haskell-simple-indent" "Turn on simple Haskell indentation." t) -(autoload 'turn-on-haskell-hugs "haskell-hugs" - "Turn on interaction with a Hugs interpreter." t) -(autoload 'turn-on-haskell-ghci "haskell-ghci" - "Turn on interaction with a GHCi interpreter." t) - -;; Are we running FSF Emacs or XEmacs? -(defvar haskell-running-xemacs - (string-match "Lucid\\|XEmacs" emacs-version) - "non-nil if we are running XEmacs, nil otherwise.") +;; Functionality provided in other files. +(autoload 'haskell-ds-create-imenu-index "haskell-decl-scan") +(autoload 'haskell-font-lock-choose-keywords "haskell-font-lock") +(autoload 'haskell-doc-current-info "haskell-doc") + +;; Obsolete functions. +(defun turn-on-haskell-font-lock () + (interactive) + (turn-on-font-lock) + (message "turn-on-haskell-font-lock is obsolete. Use turn-on-font-lock instead.")) +(defun turn-on-haskell-hugs () + (interactive) + (message "haskell-hugs is obsolete.") + (load "haskell-hugs") + (turn-on-haskell-hugs)) +(defun turn-on-haskell-ghci () + (interactive) + (message "haskell-ghci is obsolete.") + (load "haskell-ghci") + (turn-on-haskell-ghci)) + + ;; Are we looking at a literate script? (defvar haskell-literate nil "*If not nil, the current buffer contains a literate Haskell script. -Possible values are: 'bird and 'latex, for Bird-style and LaTeX-style +Possible values are: `bird' and `latex', for Bird-style and LaTeX-style literate scripts respectively. Set by `haskell-mode' and `literate-haskell-mode'. For an ambiguous literate buffer -- ie. does not contain either \"\\begin{code}\" or \"\\end{code}\" on a line on ＠＠ -252,17 +259,26 ＠＠ Always buffer-local.") (defcustom haskell-literate-default 'bird "*Default value for `haskell-literate'. Used if the style of a literate buffer is ambiguous. This variable should -be set to the preferred literate style. For example, place within -.emacs: - - (setq haskell-literate-default 'latex)" -:type '(choice bird latex nil) -:group 'haskell) +be set to the preferred literate style." +:type '(choice (const bird) (const latex) (const nil))) ;; Mode maps. -(defvar haskell-mode-map (let ((keymap (make-sparse-keymap))) - (define-key keymap "\C-c\C-c" 'comment-region) - keymap) +(defvar haskell-mode-map + (let ((map (make-sparse-keymap))) + ;; Bindings for the inferior haskell process: + ;; (define-key map [?\M-C-x] 'inferior-haskell-send-defun) + ;; (define-key map [?\C-x ?\C-e] 'inferior-haskell-send-last-sexp) + ;; (define-key map [?\C-c ?\C-r] 'inferior-haskell-send-region) + (define-key map [?\C-c ?\C-z] 'switch-to-haskell) + (define-key map [?\C-c ?\C-l] 'inferior-haskell-load-file) + ;; Non standard in other inferior-modes, but traditional in haskell. + (define-key map [?\C-c ?\C-r] 'inferior-haskell-reload-file) + (define-key map [?\C-c ?\C-b] 'switch-to-haskell) + ;; (define-key map [?\C-c ?\C-s] 'inferior-haskell-start-process) + + ;; That's what M-; is for. + ;; (define-key map "\C-c\C-c" 'comment-region) + map) "Keymap used in Haskell mode.") ;; Syntax table. ＠＠ -281,20 +297,37 ＠＠ be set to the preferred literate style. (cond ((featurep 'xemacs) ;; I don't know whether this is equivalent to the below ;; (modulo nesting). -- fx - (modify-syntax-entry ?{ "(}1" table) - (modify-syntax-entry ?} "){4" table) - (modify-syntax-entry ?- "_ 23" table)) + (modify-syntax-entry ?{ "(}5" table) + (modify-syntax-entry ?} "){8" table) + (modify-syntax-entry ?- "_ 1267" table)) (t ;; The following get comment syntax right, similarly to C++ - ;; (but the `b' style needs to be the other way round). In - ;; Emacs 21, the `n' indicates that they nest. Proper - ;; treatment of comments requires syntactic font-lock - ;; support. + ;; In Emacs 21, the `n' indicates that they nest. + ;; The `b' annotation is actually ignored because it's only + ;; meaningful on the second char of a comment-starter, so + ;; on Emacs 20 and before we get wrong results. --Stef (modify-syntax-entry ?\{ "(}1nb" table) (modify-syntax-entry ?\} "){4nb" table) - (modify-syntax-entry ?- "_ 123" table) - (modify-syntax-entry ?\n ">" table))) + (modify-syntax-entry ?- "_ 123" table))) + (modify-syntax-entry ?\n ">" table) + (let (i lim) + (map-char-table + (lambda (k v) + (when (equal v '(1)) + ;; The current Emacs 22 codebase can pass either a char + ;; or a char range. + (if (consp k) + (setq i (car k) + lim (cdr k)) + (setq i k + lim k)) + (while (<= i lim) + (when (> i 127) + (modify-syntax-entry i "_" table)) + (setq i (1+ i))))) + (standard-syntax-table))) + (modify-syntax-entry ?\` "$`" table) (modify-syntax-entry ?\\ "\\" table) (mapcar (lambda (x) ＠＠ -305,40 +338,30 ＠＠ be set to the preferred literate style. ;; Non-ASCII syntax should be OK, at least in Emacs. (mapcar (lambda (x) (modify-syntax-entry x "_" table)) - (concat (haskell-enum-from-to ?\241 ?\277) - "\327\367")) + (concat "¡¢£€¥Š§š©ª«¬®¯°±²³Žµ¶·ž¹º»ŒœŸ¿" + "×÷")) (mapcar (lambda (x) (modify-syntax-entry x "w" table)) - (concat (haskell-enum-from-to ?\300 ?\326) - (haskell-enum-from-to ?\330 ?\337) - (haskell-enum-from-to ?\340 ?\366) - (haskell-enum-from-to ?\370 ?\377)))) + (concat "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ" + "ØÙÚÛÜÝÞß" + "àáâãäåæçèéêëìíîïðñòóôõö" + "øùúûüýþÿ"))) table) "Syntax table used in Haskell mode.") ;; Various mode variables. -(defun haskell-vars () - (kill-all-local-variables) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'comment-start) - (setq comment-start "-- ") - (make-local-variable 'comment-padding) - (setq comment-padding 0) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "[-{]- *") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'haskell-comment-indent) - (make-local-variable 'comment-end) - (setq comment-end "")) +(defcustom haskell-mode-hook nil + "Hook run after entering Haskell mode." +:type 'hook +:options '(turn-on-haskell-indent turn-on-font-lock turn-on-eldoc-mode + imenu-add-menubar-index)) + +(defvar eldoc-print-current-symbol-info-function) + ;; The main mode functions ;;;###autoload -(defun haskell-mode () +(define-derived-mode haskell-mode fundamental-mode "Haskell" "Major mode for editing Haskell programs. Last adapted for Haskell 1.4. Blank lines separate paragraphs, comments start with `-- '. ＠＠ -353,9 +376,6 ＠＠ details. Modules can hook in via `haskell-mode-hook'. The following modules are supported with an `autoload' command: - `haskell-font-lock', Graeme E Moss and Tommy Thorn - Fontifies standard Haskell keywords, symbols, functions, etc. - `haskell-decl-scan', Graeme E Moss Scans top-level declarations, and places them in a menu. ＠＠ -368,9 +388,6 ＠＠ are supported with an `autoload' command `haskell-simple-indent', Graeme E Moss and Heribert Schuetz Simple indentation. - `haskell-hugs', Guy Lapalme - Interaction with Hugs interpreter. - Module X is activated using the command `turn-on-X'. For example, `haskell-font-lock' is activated using `turn-on-haskell-font-lock'. For more information on a module, see the help for its `turn-on-X' ＠＠ -380,53 +397,54 ＠＠ that `haskell-doc' is irregular in using Use `haskell-version' to find out what version this is. Invokes `haskell-mode-hook' if not nil." - - (interactive) - (haskell-mode-generic nil)) + (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'comment-start) "-- ") + (set (make-local-variable 'comment-padding) 0) + (set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-end-skip) "[ \t]*\$-}\\|\\s>\$") + (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; Set things up for eldoc-mode. + (set (make-local-variable 'eldoc-print-current-symbol-info-function) + 'haskell-doc-current-info) + ;; Set things up for imenu. + (set (make-local-variable 'imenu-create-index-function) + 'haskell-ds-create-imenu-index) + ;; Set things up for font-lock. + (set (make-local-variable 'font-lock-defaults) + '(haskell-font-lock-choose-keywords + nil nil ((?\' . "w") (?_ . "w")) nil + (font-lock-syntactic-keywords + . haskell-font-lock-choose-syntactic-keywords) + (font-lock-syntactic-face-function + . haskell-syntactic-face-function) + ;; Get help from font-lock-syntactic-keywords. + (parse-sexp-lookup-properties . t))) + ;; Haskell's layout rules mean that TABs have to be handled with extra care. + ;; The safer option is to avoid TABs. The second best is to make sure + ;; TABs stops are 8 chars apart, as mandated by the Haskell Report. --Stef + (set (make-local-variable 'indent-tabs-mode) nil) + (set (make-local-variable 'tab-width) 8) + (setq haskell-literate nil)) ;;;###autoload -(defun literate-haskell-mode () +(define-derived-mode literate-haskell-mode haskell-mode "LitHaskell" "As `haskell-mode' but for literate scripts." + (setq haskell-literate + (save-excursion + (goto-char (point-min)) + (cond + ((re-search-forward "^\\\\\$begin\\|end\${code}$" nil t) 'latex) + ((re-search-forward "^>" nil t) 'bird) + (t haskell-literate-default))))) - (interactive) - (haskell-mode-generic - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^\\\\begin{code}$\\|^\\\\end{code}$" - (point-max) t) - 'latex - (if (re-search-forward "^>" (point-max) t) - 'bird - haskell-literate-default))))) - -(defun haskell-mode-generic (literate) - "Common part of `haskell-mode' and `literate-haskell-mode'. -Former calls this with LITERATE nil. Latter calls with LITERATE `bird' or -`latex'." - - (haskell-vars) - (setq major-mode 'haskell-mode) - (setq mode-name "Haskell") - (setq haskell-literate literate) - (use-local-map haskell-mode-map) - (set-syntax-table haskell-mode-syntax-table) - (run-hooks 'haskell-mode-hook)) - -;; Find the indentation level for a comment. -(defun haskell-comment-indent () - (skip-chars-backward " \t") - ;; if the line is blank, put the comment at the beginning, - ;; else at comment-column - (if (bolp) 0 (max (1+ (current-column)) comment-column))) - -;;;###autoload(add-to-list 'auto-mode-alist '("\\.\$?:[gh]s\\|hi\$$" . haskell-mode)) -;;;###autoload(add-to-list 'auto-mode-alist '("\\.l[gh]s$" . literate-haskell-mode)) -;;;###autoload(add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock) -;;;###autoload(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) +;;;###autoload(add-to-list 'auto-mode-alist '("\\.\$?:[gh]s\\|hi\$\\'" . haskell-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("\\.l[gh]s\\'" . literate-haskell-mode)) ;;;###autoload(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) ;;;###autoload(add-hook 'haskell-mode-hook 'turn-on-haskell-indent) -;;; Provide ourselves: +;; Provide ourselves: (provide 'haskell-mode) 1.2 +57 -63 XEmacs/packages/xemacs-packages/haskell-mode/haskell-simple-indent.el Index: haskell-simple-indent.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/haskell-simple-indent.el,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- haskell-simple-indent.el 2002/04/24 09:45:13 1.1 +++ haskell-simple-indent.el 2006/03/15 05:18:23 1.2 ＠＠ -1,6 +1,6 ＠＠ ;;; haskell-simple-indent.el --- Simple indentation module for Haskell Mode -;; Copyright 1998 Heribert Schuetz, Graeme E Moss +;; Copyright (C) 1998 Heribert Schuetz, Graeme E Moss ;; Authors: ;; 1998 Heribert Schuetz <Heribert.Schuetz(a)informatik.uni-muenchen.de> and ＠＠ -9,7 +9,7 ＠＠ ;; Version: 1.0 ;; URL: http://www.cs.york.ac.uk/~gem/haskell-mode/simple-indent.html -;;; This file is not part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ＠＠ -53,7 +53,7 ＠＠ ;; ;; If you have any problems or suggestions, after consulting the list ;; below, email gem(a)cs.york.ac.uk quoting the version of you are -;; using, the version of emacs you are using, and a small example of +;; using, the version of Emacs you are using, and a small example of ;; the problem or suggestion. ;; ;; Version 1.0: ＠＠ -63,11 +63,13 ＠＠ ;; ;; (None so far.) -;;; All functions/variables start with -;;; `(turn-(on/off)-)haskell-simple-indent'. +;;; Code: +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-simple-indent'. + ;; Version. -(defconst haskell-simple-indent-version "1.1" +(defconst haskell-simple-indent-version "1.2" "`haskell-simple-indent' version number.") (defun haskell-simple-indent-version () "Echo the current version of `haskell-simple-indent' in the minibuffer." ＠＠ -79,83 +81,75 ＠＠ (defun haskell-simple-indent () "Space out to under next visible indent point. Indent points are positions of non-whitespace following whitespace in -lines preceeding point. A position is visible if it is to the left of +lines preceeding point. A position is visible if it is to the left of the first non-whitespace of every nonblank line between the position and -the current line. If there is no visible indent point beyond the current +the current line. If there is no visible indent point beyond the current column, `tab-to-tab-stop' is done instead." (interactive) - (let ((start-column (current-column)) - (invisible-from nil) ; `nil' means infinity here - indent ) - (catch 'haskell-simple-indent-break - (save-excursion - (while (progn (beginning-of-line) - (> (point) (point-min))) - (forward-line -1) - (if (not (looking-at "[ \t]*\n")) - (let ((this-indentation (current-indentation))) - (if (or (not invisible-from) - (< this-indentation invisible-from)) - (if (> this-indentation start-column) - (setq invisible-from this-indentation) - (let ((end (save-excursion (forward-line 1) (point)))) - (move-to-column start-column) - ;; Is start-column inside a tab on this line? - (if (> (current-column) start-column) - (backward-char 1)) - (or (looking-at "[ \t]") - (skip-chars-forward "^ \t" end)) - (skip-chars-forward " \t" end) - (let ((col (current-column))) - (setq indent - (if (or (= (point) end) - (and invisible-from - (> col invisible-from))) - invisible-from - col ) ) ) - (throw 'haskell-simple-indent-break nil))))))))) + (let* ((start-column (current-column)) + (invisible-from nil) ; `nil' means infinity here + (indent + (catch 'haskell-simple-indent-break + (save-excursion + (while (progn (beginning-of-line) + (not (bobp))) + (forward-line -1) + (if (not (looking-at "[ \t]*\n")) + (let ((this-indentation (current-indentation))) + (if (or (not invisible-from) + (< this-indentation invisible-from)) + (if (> this-indentation start-column) + (setq invisible-from this-indentation) + (let ((end (line-beginning-position 2))) + (move-to-column start-column) + ;; Is start-column inside a tab on this line? + (if (> (current-column) start-column) + (backward-char 1)) + (or (looking-at "[ \t]") + (skip-chars-forward "^ \t" end)) + (skip-chars-forward " \t" end) + (let ((col (current-column))) + (throw 'haskell-simple-indent-break + (if (or (= (point) end) + (and invisible-from + (> col invisible-from))) + invisible-from + col))))))))))))) (if indent (let ((opoint (point-marker))) - (delete-region (point) (progn (skip-chars-backward " \t") (point))) - (indent-to indent 0) + (indent-line-to indent) (if (> opoint (point)) (goto-char opoint)) - (move-marker opoint nil)) - (tab-to-tab-stop)) ) ) + (set-marker opoint nil)) + (tab-to-tab-stop)))) + +(defvar haskell-simple-indent-old) ;; The main functions. (defun turn-on-haskell-simple-indent () - "Sets `indent-line-function' to `haskell-simple-indent'---a simple -indentation function. Ensures TAB is bound to -`indent-for-tab-command', and LFD to `newline-and-indent'. TAB will -now move the cursor to the next indent point in the previous nonblank -line. An indent point is a non-whitespace character following + "Set `indent-line-function' to a simple indentation function. +TAB will now move the cursor to the next indent point in the previous +nonblank line. An indent point is a non-whitespace character following whitespace. -Invokes `haskell-simple-indent-hook' if not nil. +Runs `haskell-simple-indent-hook'. Use `haskell-simple-indent-version' to find out what version this is." - (interactive) - (make-local-variable 'haskell-simple-indent-old) - (setq haskell-simple-indent-old indent-line-function) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'haskell-simple-indent) - (local-set-key "\t" 'indent-for-tab-command) - (local-set-key "\n" 'newline-and-indent) + (set (make-local-variable 'haskell-simple-indent-old) indent-line-function) + (set (make-local-variable 'indent-line-function) 'haskell-simple-indent) (run-hooks 'haskell-simple-indent-hook)) (defun turn-off-haskell-simple-indent () - "Returns `indent-line-function' to original value, before -`turn-on-haskell-simple-indent' was called. Leaves TAB and LFD bound -to `indent-for-tab-command' and `newline-and-indent' respectively." - + "Return `indent-line-function' to original value. +I.e. the value before `turn-on-haskell-simple-indent' was called." (interactive) - (if (boundp 'haskell-simple-indent-old) - (setq indent-line-function haskell-simple-indent-old))) + (when (local-variable-p 'haskell-simple-indent-old) + (setq indent-line-function haskell-simple-indent-old) + (kill-local-variable 'haskell-simple-indent-old))) -;;; Provide ourselves: +;; Provide ourselves: (provide 'haskell-simple-indent) -;;; haskell-simple-indent ends here. +;;; haskell-simple-indent.el ends here 1.2 +107 -4 XEmacs/packages/xemacs-packages/haskell-mode/indent.hs Index: indent.hs =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/indent.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- indent.hs 2002/04/24 09:45:13 1.1 +++ indent.hs 2006/03/15 05:18:23 1.2 ＠＠ -1,3 +1,10 ＠＠ +------------------------------------------------------------------------- +-- Comments with allcaps `FIXME' indicate places where the indentation -- +-- fails to find the correct indentation, whereas comments with -- +-- lowercase `fixme' indicate places where impossible indentations -- +-- are uselessly proposed. -- +------------------------------------------------------------------------- + -- compute the list of binary digits corresponding to an integer -- Note: the least significant bit is the first element of the list bdigits :: Int -> [Int] ＠＠ -12,7 +19,103 ＠＠ bdigits n | n>1 = n `mod` 2 : bvalue :: [Int]->Int bvalue [] = error "bvalue of []" bvalue s = bval 1 s - where - bval e [] = 0 - bval e (b:bs) | b==0 || b==1 = b*e + bval (2*e) bs - | otherwise = error "illegal digit" + where + bval e [] = 0 + bval e [] = 0 -- fixme: can't align with `where'. + bval e (b:bs) | b==0 || b=="dd of " = b*e + bval (2*e) bs + | otherwise = error "ill digit" -- Spurious 3rd step. + foo + +-- fixme: tab on the line above should insert `bvalue' at some point. + +{- text + indentation + inside comments + -} +toto a = ( hello + , there -- indentation of leading , and ; + -- indentation of this comment. + , my friends ) + +lili x = do let ofs x = 1 + print x + +titi b = + let -- fixme: can't indent at column 0 + x = let toto = 1 + tata = 2 -- fixme: can't indent lower than `toto'. + in + toto in + do expr1 + {- text + - indentation + - inside comments + -} + let foo s = let fro = 1 + fri = 2 -- fixme: can't indent lower than `fro'. + in + hello + foo2 = bar2 -- fixme: can't align with arg `s' in foo. + foo1 = bar2 -- fixme: Can't be column 0. + expr2 + +tata c = + let bar = case foo -- fixme: can't be col 0. + of 1 -> blabla + 2 -> blibli -- fixme: only one possible indentation here. + bar = case foo of + _ -> blabla + bar' = case foo + of _ -> blabla + toto -> plulu + +turlu d = if test + then + ifturl + else + adfaf + +turlu d = if test then + ifturl + else + sg + +turly fg = toto + where + hello = 2 + + +-- test from John Goerzen + +x myVariableThing = case myVariablething of + Just z -> z + Nothing -> 0 -- fixme: "spurious" additional indents. + +foo = let x = 1 in toto + titi -- FIXME + +foo = let foo x y = toto + where + toto = 2 + +instance Show Toto where + foo x 4 = 50 + +data Toto = Foo + | Bar + deriving (Show) -- FIXME + +foo = let toto x = do let bar = 2 + return 1 + in 3 + + eval env (Llambda x e) = -- FIXME: sole indentation is self??? + Vfun (\v -> eval (\y -> if (x == y) then v else env y) -- FIXME + e) -- FIXME + +foo = case findprop attr props of + Just x -> x + +data T = T { granularity :: (Int, Int, Int, Int) -- FIXME: self indentation? + , items :: Map (Int, Int, Int, Int) [Item] } + 1.5 +54 -52 XEmacs/packages/xemacs-packages/haskell-mode/index.html Index: index.html =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/index.html,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- index.html 2004/06/16 15:16:49 1.4 +++ index.html 2006/03/15 05:18:23 1.5 ＠＠ -1,73 +1,75 ＠＠ -<HTML><HEAD> +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" + "http://www.w3.org/TR/html4/strict.dtd"> +<html><head> -<TITLE>Haskell Mode for Emacs</TITLE> +<title>Haskell Mode for Emacs</title> -</HEAD><BODY> +</head><body> -<H1>Haskell Mode for Emacs</H1> +<h1>Haskell Mode for Emacs</h1> -The Haskell mode itself is very basic, but provides a base on which to -build modules. The currently supported modules are: +The Haskell mode itself is very basic, but provides a base on which to + build modules. The currently supported modules are: -<UL> +<ul> + <li>Font Locking: Colours keywords, comments, strings, etc. -<LI>Font Locking: Colours keywords, comments, strings, etc. + <li>Declaration Scanning: Scans declarations and places them in a + menu. Seems to hang on some files. -<LI>Declaration Scanning: Scans declarations and places them in a -menu. Seems to hang on some files. + <li>Documentation: Echoes types of functions or syntax of keywords + when the cursor is idle. Not up-to-date for Haskell-98. -<LI>Documentation: Echoes types of functions or syntax of keywords -when the cursor is idle. Not up-to-date for Haskell-98. + <li><a HREF="http://www.iro.umontreal.ca/~lapalme/layout/">Indentation</a>: + Provides semi-automatic intelligent indentation. -<LI><A -HREF="http://www.iro.umontreal.ca/~lapalme/layout/">Indentation</A>: -Provides semi-automatic intelligent indentation. + <li>Simple Indentation: Provides simple indentation. -<LI>Simple Indentation: Provides simple indentation. + <li>Interaction with an inferior Haskell interpreter. This module + supersedes the previous two modules: + <ul> + <li><a HREF="http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html"> + Hugs Interaction</a>: Allows interaction with the Hugs interpreter. -<LI><A -HREF="http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html">Hugs -Interaction</A>: Allows interaction with the Hugs interpreter. + <li><a HREF="http://home.arachsys.com/~chris/haskell-ghci.el">GHCi + Interaction</a>: Allows interaction with the GHCi interpreter. + </ul> +</ul> -<LI><A -HREF="http://home.arachsys.com/~chris/haskell-ghci.el">GHCi -Interaction</A>: Allows interaction with the GHCi interpreter. -</UL> +Work on further modules is encouraged! Please + <a HREF="mailto:monnier＠iro.umontreal.ca">mail</a> if you have an idea, or + a module we might hook into. -Work on further modules is encouraged! Please <A -HREF="mailto:simonmar＠microsoft.com">mail</A> if you have an idea, or a -module we might hook into. +<a HREF="haskell-mode-2.1.tar.gz">The latest versions of the basic mode + and the above modules</a>. -<A HREF="haskell-mode-1.45.tar.gz">The latest versions of the basic -mode and the above modules</A>. +The basic mode was written by Graeme E Moss, Tommy Thorn and Simon + Marlow. Modules with their own links above are maintained by their + authors; the rest are looking for a maintainer (please + volunteer!). These modules support Haskell 98, except where stated, and + have been tested on GNU Emacs versions 19.34 and 20.7, and XEmacs versions + 21.1.14 and 21.4.x. Please mail bugs and suggestions to the maintainer of + the appropriate module. General comments can be mailed + to <a HREF="mailto:monnier＠iro.umontreal.ca">Stefan + Monnier</a>. When mailing, quote the version of the module or mode you + are using, the version of Emacs you are using, and a small example of the + problem or suggestion. Please check the list of known problems (towards + the start of each relevant file) before doing so. -The basic mode was written by Graeme E Moss, Tommy Thorn and Simon -Marlow. Modules with their own links above are maintained by their -authors; the rest are looking for a maintainer (please volunteer!). These -modules support Haskell 98, except where stated, and have been tested on -GNU Emacs versions 19.34 and 20.7, and XEmacs versions 21.1.14 and 21.4.x. -Please mail bugs and suggestions to the maintainer of the appropriate -module. General comments can be mailed to <A -HREF="mailto:simonmar＠microsoft.com">Simon Marlow</a>. When mailing, quote -the version of the module or mode you are using, the version of Emacs you -are using, and a small example of the problem or suggestion. Please check -the list of known problems (towards the start of each relevant file) -before doing so. +<a HREF="installation-guide.html">A guide on how to install +and customise the mode</a>. -<A HREF="installation-guide.html">A guide on how to install -and customise the mode</A>. +To test the mode: -To test the mode: +<ul> + <li>To test font locking, declaration scanning, and documentation + modules, try them on <a HREF="fontlock.hs">the Haskell + script</a> used to illustrate these modules in action. -<UL> + <li>To test indentation and simple indentation modules, try them + on <a HREF="indent.hs">this Haskell script</a>. -<LI>To test font locking, declaration scanning, and documentation -modules, try them on <A HREF="fontlock.hs">the Haskell -script</A> used to illustrate these modules in action. +</ul> -<LI>To test indentation and simple indentation modules, try them on <A -HREF="indent.hs">this Haskell script</A>. +</body></html> -</UL> - -</BODY></HTML> 1.5 +130 -128 XEmacs/packages/xemacs-packages/haskell-mode/installation-guide.html Index: installation-guide.html =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/installation-guide.html,v retrieving revision 1.4 retrieving revision 1.5 diff -u -p -r1.4 -r1.5 --- installation-guide.html 2004/06/16 15:16:49 1.4 +++ installation-guide.html 2006/03/15 05:18:23 1.5 ＠＠ -1,138 +1,140 ＠＠ -<HTML><HEAD> +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" + "http://www.w3.org/TR/html4/strict.dtd"> +<html><head> -<TITLE>Haskell Mode for Emacs: Installation Guide</TITLE> +<title>Haskell Mode for Emacs: Installation Guide</title> -</HEAD><BODY> +</head><body> -<H1>Haskell Mode for Emacs: Installation Guide</H1> +<h1>Haskell Mode for Emacs: Installation Guide</h1> -When Emacs is started up, it normally runs an file called -<CODE>.emacs</CODE> located in your home directory. This file should -contain all of your personal customisations written as a series of -Elisp commands. In order to install the Haskell mode, you have to -tell Emacs where to find it. This is done by adding some commands to -the init file. - -<H2>Installation</H2> - -<UL> -<LI>If you are using XEmacs, the haskell-mode package should be -available for installation through the XEmacs package UI.</LI> - -<LI>If you are using Debian, you can install the package haskell-mode with -a command like "apt-get install haskell-mode".</LI> -</UL> - -Otherwise: - -<UL> -<LI>Download the and unpack the basic mode and modules into a -suitable directory, e.g. <CODE>~/lib/emacs</CODE> where <CODE>~</CODE> -stands for your home directory. - -<LI>Assuming you have placed the basic mode -<CODE>haskell-mode.el</CODE> and the modules you want to use in the -directory <CODE>~/lib/emacs</CODE>, add the following commands to your -init file (<CODE>~/.emacs</CODE>): - -<PRE> -(setq load-path (cons "~/lib/emacs" load-path)) -(setq auto-mode-alist - (append auto-mode-alist - '(("\\.[hg]s$" . haskell-mode) - ("\\.hi$" . haskell-mode) - ("\\.l[hg]s$" . literate-haskell-mode)))) -(autoload 'haskell-mode "haskell-mode" - "Major mode for editing Haskell scripts." t) -(autoload 'literate-haskell-mode "haskell-mode" - "Major mode for editing literate Haskell scripts." t) -</PRE> - -adding the following lines according to which modules you want to -use: - -<PRE> -(add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock) -(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) +When Emacs is started up, it normally runs a file + called <code>~/.emacs</code> located in your home directory. This file + should contain all of your personal customisations written as a series of + Elisp commands. In order to install the Haskell mode, you have to tell + Emacs where to find it. This is done by adding some commands to the init + file. + +<h2>Installation</h2> + +<ul> + <li>If you are using XEmacs, the haskell-mode package should be + available for installation through the XEmacs package UI. + + <li>If you are using Debian, you can install the package haskell-mode with + a command like "apt-get install haskell-mode". +</ul> + +Otherwise: + +<ul> + <li>Download and unpack the basic mode and modules into a suitable + directory, e.g. <code>~/lib/emacs</code> where <code>~</code> stands for + your home directory. + + <li>Assuming you have placed the basic + mode <code>haskell-mode.el</code> and the modules you want to use in + the directory <code>~/lib/emacs</code>, add the following command to + your init file (<code>~/.emacs</code>): + + <pre>(load "~/lib/emacs/haskell-site-file")</pre> + + adding the following lines according to which modules you want to + use: + +<pre> (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) -(add-hook 'haskell-mode-hook 'turn-on-haskell-hugs) -(add-hook 'haskell-mode-hook 'turn-on-haskell-ghci) -</PRE> - -Note that the two indentation modules are mutually exclusive - add -at most one. You can download the above <A HREF=".emacs">code</A>. -Note that the line of code for simple indentation is commented out -(using a preceeding <CODE>;</CODE>) in preference for the more -advanced indentation module. Installation is now complete! - -</UL> - -For those interested, each command above shall now be -explained. - -<OL> -<LI>We must ensure that the directory containing -<CODE>haskell-mode.el</CODE> is on the <CODE>load-path</CODE> of -Emacs. You can examine the value of the <CODE>load-path</CODE> by -typing <CODE>C-h v load-path</CODE> in an Emacs session. Supposing -that you've placed <CODE>haskell-mode.el</CODE> in the directory -<CODE>~/lib/emacs</CODE>, if this directory is not on the -<CODE>load-path</CODE> we add it with: - -<PRE>(setq load-path (cons "~/lib/emacs" load-path))</PRE> - -The function <CODE>setq</CODE> sets the value of a variable, and the -function <CODE>cons</CODE> takes an element and a list and creates a -new list with the former as head and the latter as tail, as in -Haskell. - -<LI>It is possible (and desirable) for Emacs to enter a specific -mode according to the name of the file being edited/visited. The -variable <CODE>auto-mode-alist</CODE> tells Emacs what mode to run -according to which regular expression matches the filename. We wish -to run the Haskell mode on all files ending in <CODE>.hs</CODE>, -<CODE>.hi</CODE> (interface file) and <CODE>.gs</CODE> (Gofer file), -and to run the Haskell mode for literate scripts on all files ending -in <CODE>.lhs</CODE> and <CODE>.lgs</CODE>. To do this, we need to -add pairs of the form <CODE>(regexp -. mode-function)</CODE>. We use the function -<CODE>append</CODE> to append a list of three such pairs to the end of -the value of <CODE>auto-mode-alist</CODE>. A list in Elisp is written -within round parantheses with elements separated by whitespace. A -list is treated as a function application unless it is quoted with -<CODE>'</CODE>, which is what we do. - -<LI>In order for Emacs to know where to find the definition of our -mode functions, <CODE>haskell-mode</CODE> and -<CODE>literate-haskell-mode</CODE>, we must use the function -<CODE>autoload</CODE>. Both mode functions can be found in the file -<CODE>haskell-mode.el</CODE> which was downloaded in the first -installation step (the <CODE>.el</CODE> extension is left off and -assumed by Emacs). As we have already ensured that this file is on -the <CODE>load-path</CODE> we need only give the filename and not the -directory. Its use is quite straightforward but for further -information, see its documentation by entering <CODE>C-h f -autoload</CODE> in an Emacs session. - -<LI>Each function <CODE>turn-on-haskell-module</CODE> -turns on the corresponding module. Adding such a function as a hook -to the Haskell mode will turn on that module when the mode is used. -Note that each of these modules may slow down Emacs, especially for -large files. - -</OL> - -<H2>Customisation</H2> - -Most customisations are on the functionality of a particular -module. See the documentation of that module for information on its -customisation. +</pre> + + Note that the two indentation modules are mutually exclusive - add at + most one.  + Note that the line of code for simple indentation is commented out + (using a preceeding <code>;</code>) in preference for the more + advanced indentation module. Installation is now complete! + + The other modules are automatically loaded when needed in the + following way: + <ul> + <li>Font locking: just turn it on + via <code>global-font-lock-mode</code> or do + <pre>(add-hook 'haskell-mode-hook 'font-lock-mode)</pre> + <li>Declaration scanning: just use <code>M-x imenu</code> or + bind <code>imenu</code> to a key. E.g. + <pre>(global-set-key [(control meta down-mouse-3)] 'imenu)</pre> + or you can also add it to the menubar with + <pre>(add-hook 'haskell-mode-hook 'imenu-add-menubar-index)</pre> + <li>Interaction with inferior Haskell interpreter: + just hit <code>C-c C-z</code> or <code>C-c C-l</code>. + </ul> + +</ul> + +For those interested, each command above shall now be explained. + +<ol> + <li>We must ensure that the directory + containing <code>haskell-mode.el</code> is on + the <code>load-path</code> of Emacs. You can examine the value of + the <code>load-path</code> by typing <code>C-h v load-path</code> in + an Emacs session. Supposing that you've + placed <code>haskell-mode.el</code> in the + directory <code>~/lib/emacs</code>, if this directory is not on + the <code>load-path</code> we add it with: + + <pre>(setq load-path (cons "~/lib/emacs" load-path))</pre> + + The function <code>setq</code> sets the value of a variable, and the + function <code>cons</code> takes an element and a list and creates + a new list with the former as head and the latter as tail, as in + Haskell. + + <li>It is possible (and desirable) for Emacs to enter a specific mode + according to the name of the file being edited/visited. + The variable <code>auto-mode-alist</code> tells Emacs what mode to run + according to which regular expression matches the filename. We wish + to run the Haskell mode on all files ending + in <code>.hs</code>, <code>.hi</code> (interface file) + and <code>.gs</code> (Gofer file), and to run the Haskell mode for + literate scripts on all files ending in <code>.lhs</code> + and <code>.lgs</code>. To do this, we need to add pairs of the + form <code>(regexp . mode-function)</code>. We use + the function <code>append</code> to append a list of three such pairs + to the end of the value of <code>auto-mode-alist</code>. A list in + Elisp is written within round parantheses with elements separated by + whitespace. A list is treated as a function application unless it is + quoted with <code>'</code>, which is what we do. + + <li>In order for Emacs to know where to find the definition of our mode + functions, <code>haskell-mode</code> + and <code>literate-haskell-mode</code>, we must use the + function <code>autoload</code>. Both mode functions can be found in + the file <code>haskell-mode.el</code> which was downloaded in the + first installation step (the <code>.el</code> extension is left off + and assumed by Emacs). As we have already ensured that this file is + on the <code>load-path</code> we need only give the filename and not + the directory. Its use is quite straightforward but for further + information, see its documentation by entering <code>C-h + f autoload</code> in an Emacs session. + + <li>Each function <code>turn-on-haskell-module</code> turns on + the corresponding module. Adding such a function as a hook to the + Haskell mode will turn on that module when the mode is used. + Note that each of these modules may slow down Emacs, especially for + large files. + +</ol> + +<h2>Customisation</h2> + +Most customisations are on the functionality of a particular module. + See the documentation of that module for information on its + customisation. -<H2>Support</H2> +<h2>Support</h2> -Any problems, do <A HREF=mailto:simonmar＠microsoft.com>mail</A> and we will -try our best to help you! +Any problems, do <a HREF="mailto:monnier＠iro.umontreal.ca">mail</a> and we + will try our best to help you! -<A HREF="./">Haskell Mode Home Page</A>. +<a HREF="./">Haskell Mode Home Page</a>. 1.2 +1 -1 XEmacs/packages/xemacs-packages/haskell-mode/package-info.in Index: package-info.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/haskell-mode/package-info.in,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- package-info.in 2002/04/24 09:45:15 1.1 +++ package-info.in 2006/03/15 05:18:23 1.2 ＠＠ -13,7 +13,7 ＠＠ filename FILENAME md5sum MD5SUM size SIZE - provides (haskell-decl-scan haskell-doc haskell-font-lock haskell-indent haskell-mode haskell-simple-indent) + provides (haskell-decl-scan haskell-doc haskell-font-lock haskell-ghci haskell-hugs haskell-indent haskell-mode haskell-simple-indent inf-haskell) requires (REQUIRES) type regular )) 1.1 XEmacs/packages/xemacs-packages/haskell-mode/ChangeLog.upstream Index: ChangeLog.upstream =================================================================== 2005-11-07 Stefan Monnier <monnier(a)iro.umontreal.ca> * Release version 2.1. * haskell-indent.el (haskell-indent-inside-comment): Rename `start' arg into `open' and add a new `start' arg. (haskell-indent-after-keywords): Change defaults for `in'. (haskell-indent-indentation-info): Fix confusion between pos and col. (haskell-indent-mode): Autoload. * haskell-indent.el (haskell-indent-find-matching-start): Add `pred' and `start' arguments. (haskell-indent-filter-let-no-in): New fun. (haskell-indent-indentation-info): Use them to correctly match `let's with `in's even when some of the `let's have no matching `in'. 2005-11-06 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el: Reduce the use of dyn-bound haskell-indent-info. (haskell-indent-push-col): Don't duplicate info. (haskell-indent-line-indentation): Handle let-in-do. Remove dead code. (haskell-indent-inside-comment): Move rest of code from haskell-indent-indentation-info. * haskell-indent.el (haskell-literate): Declare. (haskell-running-xemacs, event-basic-type, read-event): Remove. (haskell-indent-get-beg-of-line, haskell-indent-get-end-of-line): Remove. Use line-(beginning|end)-position instead. (haskell-indent-mark-active): Move the xemacs test inside the defun. (haskell-indent-info): Rename from indent-info. Update users. (haskell-indent-bolp, haskell-indent-inside-comment): Use line-beginning-position. (haskell-indent-within-literate-code): Use `case'. (haskell-indent-put-region-in-literate): Bind more comment-* vars. (haskell-indent-virtual-indentation): Add the missing `start' arg. (haskell-indent-mode): Move before first use. (haskell-indent-stand-alone-mode): Use haskell-indent-mode. Rename from haskell-stand-alone-indent-mode. Use define-derived-mode. (hugs-mode-map, hugs-syntax-table): Rename to haskell-stand-alone-indent-mode-(map|syntax-table). * haskell-doc.el (haskell-doc-xemacs-p, haskell-doc-emacs-p) (haskell-doc-message): Remove. (haskell-doc-is-id-char-at): Remove. (haskell-doc-get-current-word): Rewrite. 2005-11-04 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-indentation-info): Fix detection of hanging let/if/case statements. * haskell-mode.el (haskell-mode): Fix typo. 2005-11-04 Stefan Monnier <monnier(a)iro.umontreal.ca> * inf-haskell.el (inferior-haskell-mode): Hide compilation bindings. * haskell-indent.el (haskell-indent-after-keywords): New var. (haskell-indent-virtual-indentation): New fun. (haskell-indent-indentation-info): Use them to indent after keywords. * haskell-simple-indent.el (haskell-simple-indent): Minor simplif. (turn-on-haskell-simple-indent): Don't bind \t and \n. * haskell-mode.el (haskell-vars, haskell-mode-generic): Remove. (haskell-mode-hook): Rename from haskell-mode-hooks. (haskell-mode): Use define-derived-mode. Inline haskell-mode-generic and haskell-vars. (literate-haskell-mode): Use define-derived-mode. * fontlock.hs: Add some entries for infix declarations. 2005-10-12 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-start-keywords-re): Use regexp-opt. (haskell-indent-type-at-point): Accept ' in identifiers. (haskell-indent-find-case): Tell match-data to not generate markers. (haskell-indent-line-indentation): Ignore off-side keywords in comments and strings. (haskell-indent-find-matching-start): Generalize. Rename from haskell-indent-find-let. (haskell-indent-indentation-info): Use it for of, then, and else. 2005-09-28 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-in-comment): Don't fail at EOB. * haskell-font-lock.el (haskell-font-lock-symbols-alist): Add "not". (haskell-font-lock-compose-symbol): Handle alphanum identifiers. Fix incorrect handling of . when used for qualified names. 2005-09-26 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-font-lock.el (haskell-font-lock-symbols-alist): Prefer the unicode version of lambda. Add two symbols from the Omega language and from Paterson's arrow syntax. 2005-08-24 Steve Chamberlain <sac(a)pobox.com> (tiny patch) * haskell-doc.el (haskell-doc-message): Paren typo. 2005-08-23 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-doc.el (haskell-doc-show-type): Assume that the availability of display-message won't change at runtime. * haskell-font-lock.el (haskell-font-lock-keywords-create): Try and work around a bug that seems to be in Emacs-21.3 rather than in haskell-font-lock.el. Reported by Steve Chamberlain <sac(a)pobox.com>. 2005-07-18 Stefan Monnier <monnier(a)iro.umontreal.ca> * inf-haskell.el (haskell-program-name): Fix defcustom delcaration. * haskell-doc.el (haskell-doc-message): Remove. (haskell-doc-show-type): Inline it. Don't do anything for if there's no doc to show. 2005-02-02 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-hugs.el (haskell-hugs-mode-map): * haskell-ghci.el (haskell-ghci-mode-map): Remove. 2005-01-26 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-inside-comment): Don't assume that column(pos+2) = column(pos)+2. (haskell-indent-indentation-info): Fix indentation of , and ;. Add arg `start'. Restrict choice of indentation for comments. (haskell-indent-event-type): Remove. (haskell-indent-last-info): New var. (haskell-indent-cycle): Use it to store info from one invocation to the next, so we can do cycling outside of the function. Don't cycle directly any more. Instead, recognize repeated invocations via last-command and friends. Use indent-line-function rather than hardcoding indent-to-left-margin. (haskell-indent-insert-where): Don't save excursion. (haskell-indent-layout-indent-info): Minor simplifications. (haskell-indent-line-indentation): Don't ignore code on a line before a string. * haskell-hugs.el (haskell-hugs-last-loaded-file): Remove. (haskell-hugs-start-process): Fix misuse of make-variable-buffer-local. (haskell-hugs-go): Quote file name. Simplify. * haskell-ghci.el (haskell-ghci-last-loaded-file): Remove. (haskell-ghci-start-process): Fix misuse of make-variable-buffer-local. (haskell-ghci-go): Quote file name. Simplify. * haskell-mode.el (haskell-version): Keep it up-to-date. * inf-haskell.el (inferior-haskell-load-file): Quote file name. 2004-12-10 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-start-of-def): Only go backward. (haskell-indent-in-string): Simplify. (haskell-indent-in-comment): Simplify. (haskell-indent-comment): Remove. (haskell-indent-inside-comment): New fun. (haskell-indent-indentation-info): Assume we're at the indentation. Handle comments differently. (haskell-indent-cycle): Go to indentation and then save excursion around haskell-indent-indentation-info. * haskell-doc.el (haskell-doc-minor-mode-string): Make it dynamic. (haskell-doc-install-keymap): Remove conflicting C-c C-o binding. (haskell-doc-mode): Make a nil arg turn the mode ON. (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode. (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string. (haskell-doc-show-global-types): Don't touch haskell-doc-minor-mode-string. Call haskell-doc-make-global-fct-index. (haskell-doc-check-active): Fix message. (define-key-after): Don't define. (haskell-doc-install-keymap): Check existence of define-key-after. * haskell-mode.el (haskell-literate-default): Fix custom type. (haskell-vars): Ignore comments when doing C-M-f. * indent.hs: More test cases. * inf-haskell.el (haskell-program-name): Use ghci if hugs is absent. (inferior-haskell-load-file): Reset compilation-parsing-end. 2004-11-25 Stefan Monnier <monnier(a)iro.umontreal.ca> * Release version 2.0. * .emacs: Remove. * haskell-decl-scan.el (haskell-ds-imenu-label-cmp): Undo last idiotic change. * haskell-doc.el (haskell-doc-sym-doc): Make even the last char bold. * haskell-mode.el (haskell-mode-map): Typo. * inf-haskell.el (inferior-haskell-mode): Typo. (inferior-haskell-wait-for-output): Remove. (inferior-haskell-send-command): New function. (inferior-haskell-load-file): Use it. * index.html: * installation-guide.html: Partial fixup. 2004-11-24 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-mode.el (turn-on-haskell-hugs, turn-on-haskell-ghci): Mark them as obsolete. (haskell-mode-map): Add bindings for the inferior-haskell commands. * inf-haskell.el: New file. * haskell-doc.el (haskell-doc-install-keymap): Don't blindly assume there's a Hugs menu. 2004-11-22 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (turn-on-haskell-indent, turn-off-haskell-indent): Use C-c C-foo rather than C-c foo to follow coding conventions. * haskell-font-lock.el (haskell-font-lock-symbols-alist): Add . = â. 2004-10-25 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-indentation-info): Don't use layout for paren-closing elements. 2004-10-20 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-indentation-info): Only use the new `in' indentation rule if the `let' is on the left of the decl. 2004-10-19 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-indent.el (haskell-indent-find-let): New function. (haskell-indent-indentation-info): Use it to indent `in'. * haskell-font-lock.el (haskell-default-face): Add missing declaration. * haskell-indent.el (haskell-indent-open-structure): Simplify. (haskell-indent-contour-line): Work even when `start' is in the middle of a line. (haskell-indent-layout-indent-info): New fun extracted from haskell-indent-indentation-info. (haskell-indent-indentation-info): Use it as before. Use it also to handle layout-within-open-structure. 2004-10-18 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-font-lock.el (haskell-font-lock-keywords-create): Use explicit `symbol-value' to work around limitations in XEmacs's implementation of font-lock. (haskell-basic-syntactic-keywords): Fix up char-constants some more. 2004-10-14 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-doc.el (turn-off-haskell-doc-mode) (haskell-doc-current-info): Don't autoload. * haskell-decl-scan.el (haskell-ds-match-string): Use match-string-no-properties if available. (haskell-ds-syntax-table): Use haskell-mode-syntax-table. (haskell-ds-imenu-label-cmp): Use car-less-than-car if available. (haskell-ds-imenu): Remove obsolete incorrect code. * haskell-mode.el: Set things up so that mode-hook functions are not necessary, and generic functions can be used instead, like global-font-lock-mode. (haskell-enum-from-to): Remove. (turn-on-haskell-font-lock): Make obsolete. (haskell-running-xemacs): Remove. (haskell-mode-syntax-table): Fiddle with non-ascii chars. Fix up comment syntax in XEmacs. (haskell-vars): Improve comment-start-skip. Add comment-end-skip. Setup imenu, eldoc, and font-lock. Tweak handling of tabs to be on the safe side. (haskell-mode-hooks): Declare and mention some useful ideas. (literate-haskell-mode): Simplify. (haskell-comment-indent): Remove. The default works as well. * haskell-font-lock.el: Remove level 1 fontification. (haskell-font-lock-keywords-1, haskell-font-lock-keywords-2) (bird-literate-haskell-font-lock-keywords-1) (bird-literate-haskell-font-lock-keywords-2) (latex-literate-haskell-font-lock-keywords-1) (latex-literate-haskell-font-lock-keywords-2): Remove. (bird-literate-haskell-font-lock-keywords) (latex-literate-haskell-font-lock-keywords): Rename. (haskell-font-lock-keywords-create): Remove `level' arg. (haskell-fl-syntax): Remove. Assume the major modes sets it right. (haskell-font-lock-choose-keywords) (haskell-font-lock-choose-syntactic-keywords): New funs. (haskell-font-lock-defaults-create): Use them. (turn-off-haskell-font-lock, turn-on-haskell-font-lock): Simplify. * haskell-hugs.el (haskell-hugs-mode): Use define-derived-mode. (run-hugs): New alias. (haskell-hugs-wait-for-output): Don't loop if the process is dead. * haskell-font-lock.el (haskell-font-lock-compose-symbol): New fun. (haskell-font-lock-symbols-keywords): Use it. (haskell-string-char-face): Remove. (haskell-font-lock-keywords-create): Hardcode font-lock-string-face. (haskell-fl-syntax): Fix typos. Keep " as a string delimiter. 2004-10-13 Stefan Monnier <monnier(a)iro.umontreal.ca> * haskell-doc.el (haskell-doc): New group. (haskell-doc-show-reserved, haskell-doc-show-prelude) (haskell-doc-show-strategy, haskell-doc-show-user-defined) (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname): Make them custom vars. (haskell-doc-keymap): Declare and fill it right there. (haskell-doc-mode): Simplify. (haskell-doc-toggle-var): Make it into what it was supposed to be. (haskell-doc-mode-print-current-symbol-info): Simplify. (haskell-doc-current-info): New autoloaded function. (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type. (haskell-doc-show-type): Use it. (haskell-doc-wrapped-type-p): Remove unused var `lim'. (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): Remove. Unused. (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded. (haskell-doc-install-keymap): Simplify. * haskell-decl-scan.el (literate-haskell-ds-create-imenu-index) (haskell-ds-generic-create-imenu-index): Remove. (haskell-ds-bird-p): New function. (haskell-ds-backward-decl, haskell-ds-forward-decl): Use it. (haskell-ds-create-imenu-index): Use it to make it generic. (haskell-ds-imenu): Remove now-unused arg. (turn-on-haskell-decl-scan): Fix up call to haskell-ds-imenu. (haskell-ds-running-xemacs): Remove. (haskell-ds-func-menu-next): Make generic. (literate-haskell-ds-func-menu-next): Delete. (haskell-ds-func-menu): Remove unused arg. (turn-on-haskell-decl-scan): Simplify. * haskell-indent.el: Don't load CL at runtime. (haskell-indent-start-of-def, haskell-indent-type-at-point): Don't hardcode point-min == 1. (indent-info): Declare it. (haskell-indent-empty, haskell-indent-ident, haskell-indent-other) (haskell-indent-line-indentation): Use `string'. (haskell-indent-valdef-indentation): Fix `case' arms syntax. (haskell-indent-indentation-info): Remove unused var `pt'. (haskell-indent-align-def): Remove unused var `defpos'. (turn-on-haskell-indent): Don't bind TAB. (turn-off-haskell-indent): Don't unbind TAB and DEL. (hugs-syntax-table): Use the `n' for nested comments. (haskell-stand-alone-indent-mode): Fix `comment-end'. ;; Local Variables: ;; coding: utf-8 ;; End: # arch-tag: a2606dc4-fab7-4b2f-bbe9-0a51db643511 1.1 XEmacs/packages/xemacs-packages/haskell-mode/Makefile.upstream Index: Makefile.upstream =================================================================== EMACS = emacs ELFILES = \ haskell-font-lock.el \ haskell-mode.el \ haskell-doc.el \ haskell-decl-scan.el \ inf-haskell.el \ haskell-indent.el ELCFILES = $(ELFILES:.el=.elc) # AUTOLOADS = $(PACKAGE)-startup.el AUTOLOADS = haskell-site-file.el %.elc: %.el $(EMACS) --batch --eval '(setq load-path (cons "." load-path))' \ -f batch-byte-compile $< all: $(ELCFILES) $(AUTOLOADS) info: # No Texinfo file, sorry. ###################################################################### ### don't look below ### ###################################################################### PACKAGE=haskell-mode $(AUTOLOADS): $(ELFILES) [ -f $＠ ] || echo '' >$＠ $(EMACS) --batch --eval '(setq generated-autoload-file "'`pwd`'/$＠")' -f batch-update-autoloads "." ## TAG = $(shell echo v$(VERSION) | tr '.' '_') ftpdir=/u/monnier/html/elisp/ cvsmodule=$(shell cat CVS/Repository) cvsroot=$(shell cat CVS/Root) dist: cvs tag -F $(TAG) &&\ cd $(TMP) &&\ unset CVSREAD; cvs -d $(cvsroot) export -r $(TAG) -d $(PACKAGE)-$(VERSION) $(cvsmodule) &&\ cd $(PACKAGE)-$(VERSION) &&\ make info $(AUTOLOADS) &&\ cd .. &&\ ztar $(PACKAGE)-$(VERSION) &&\ rm -rf $(PACKAGE)-$(VERSION) mv $(TMP)/$(PACKAGE)-$(VERSION).tar.gz $(ftpdir)/ ln -sf $(PACKAGE)-$(VERSION).tar.gz $(ftpdir)/$(PACKAGE).tar.gz # arch-tag: 1ab314c8-3821-44fb-b533-dd58f5d75ba4 1.1 XEmacs/packages/xemacs-packages/haskell-mode/NEWS Index: NEWS =================================================================== Changes since 2.0: * inf-haskell uses ghci if hugs is absent. * Fix up some binding conflicts (C-c C-o in haskell-doc) * Many (hopefully minor) changes to the indentation. * New symbols in haskell-font-lock-symbols-alist. Changes since 1.45: * keybindings C-c <char> have been replaced by C-c C-<char> so as not to collide with minor modes. * The following modules are now automatically activated without having to add anything to haskell-mode-hook: haskell-font-lock (just turn on global-font-lock-mode). haskell-decl-scan (just bind `imenu' to some key). * In recent Emacsen, haskell-doc hooks into eldoc-mode. * haskell-hugs and haskell-ghci are superceded by inf-haskell. * Indentation rules have been improved when using layout inside parens/braces. * Symbols like -> and \ can be displayed as actual arrows and lambdas. See haskell-font-lock-symbols. * Tweaks to the font-lock settings. Among other things paren-matching with things like \(x,y) should work correctly now. * New maintainer <monnier(a)gnu.org>. # arch-tag: e50204f2-98e4-438a-bcd1-a49afde5efa5 1.1 XEmacs/packages/xemacs-packages/haskell-mode/inf-haskell.el Index: inf-haskell.el =================================================================== ;;; inf-haskell.el --- Interaction with an inferior Haskell process. ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier(a)iro.umontreal.ca> ;; Keywords: Haskell ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with 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. ;;; Commentary: ;; The code is made of 2 parts: a major mode for the buffer that holds the ;; inferior process's session and a minor mode for use in source buffers. ;;; Code: (require 'comint) (require 'shell) ;For directory tracking. (require 'compile) ;; Here I depart from the inferior-haskell- prefix. ;; Not sure if it's a good idea. (defcustom haskell-program-name ;; Arbitrarily give preference to hugs over ghci. (or (cond ((not (fboundp 'executable-find)) nil) ((executable-find "hugs") "hugs \"+.\"") ((executable-find "ghci") "ghci")) "hugs \"+.\"") "The name of the command to start the inferior Haskell process. The command can include arguments." ;; Custom only supports the :options keyword for a few types, e.g. not ;; for string. ;; :options '("hugs \"+.\"" "ghci") :group 'haskell :type '(choice string (repeat string))) (defconst inferior-haskell-error-regexp-alist ;; The format of error messages used by Hugs. '(("^ERROR \"\$.+?\$\"\$:\\| line \$\$[0-9]+\$ - " 1 3) ;; Format of error messages used by GHCi. ("^\$.+?\$:\$[0-9]\$:\$ \\|$\$" 1 3) ) "Regexps for error messages generated by inferior Haskell processes. The format should be the same as for `compilation-error-regexp-alist'.") (define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell" "Major mode for interacting with an inferior Haskell process." (set (make-local-variable 'comint-prompt-regexp) "^\\*?[A-Z][\\._a-zA-Z0-9]*\$ \\*?[A-Z][\\._a-zA-Z0-9]*\$*> ") (set (make-local-variable 'comint-input-autoexpand) nil) ;; Setup directory tracking. (set (make-local-variable 'shell-dirtrackp) t) (set (make-local-variable 'shell-cd-regexp) ":cd") (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local) ;; Setup `compile' support so you can just use C-x ` and friends. (set (make-local-variable 'compilation-error-regexp-alist) inferior-haskell-error-regexp-alist) (if (and (not (boundp 'minor-mode-overriding-map-alist)) (fboundp 'compilation-shell-minor-mode)) ;; If we can't remove compilation-minor-mode bindings, at least try to ;; use compilation-shell-minor-mode, so there are fewer ;; annoying bindings. (compilation-shell-minor-mode 1) ;; Else just use compilation-minor-mode but without its bindings because ;; things like mouse-2 are simply too annoying. (compilation-minor-mode 1) (let ((map (make-sparse-keymap))) (dolist (keys '([menu-bar] [follow-link])) ;; Preserve some of the bindings. (define-key map keys (lookup-key compilation-minor-mode-map keys))) (add-to-list 'minor-mode-overriding-map-alist (cons 'compilation-minor-mode map))))) (defun inferior-haskell-string-to-strings (string &optional separator) "Split the STRING into a list of strings. The SEPARATOR regexp defaults to \"\\s-+\"." (let ((sep (or separator "\\s-+")) (i (string-match "[\"]" string))) (if (null i) (split-string string sep) ; no quoting: easy (append (unless (eq i 0) (split-string (substring string 0 i) sep)) (let ((rfs (read-from-string string i))) (cons (car rfs) (inferior-haskell-string-to-strings (substring string (cdr rfs)) sep))))))) (defun inferior-haskell-command (arg) (inferior-haskell-string-to-strings (if (null arg) haskell-program-name (read-string "Command to run haskell: ")))) (defvar inferior-haskell-buffer nil "The buffer in which the inferior process is running.") (defun inferior-haskell-start-process (command) "Start an inferior haskell process. With universal prefix \\[universal-argument], prompts for a command, otherwise uses `haskell-program-name'. It runs the hook `inferior-haskell-hook' after starting the process and setting up the inferior-haskell buffer." (interactive (list (inferior-haskell-command current-prefix-arg))) (setq inferior-haskell-buffer (apply 'make-comint "haskell" (car command) nil (cdr command))) (with-current-buffer inferior-haskell-buffer (inferior-haskell-mode) (run-hooks 'inferior-haskell-hook))) (defun inferior-haskell-process (&optional arg) (or (if (buffer-live-p inferior-haskell-buffer) (get-buffer-process inferior-haskell-buffer)) (progn (let ((current-prefix-arg arg)) (call-interactively 'inferior-haskell-start-process)) ;; Try again. (inferior-haskell-process arg)))) ;;;###autoload (defalias 'run-haskell 'switch-to-haskell) ;;;###autoload (defun switch-to-haskell (&optional arg) "Show the inferior-haskell buffer. Start the process if needed." (interactive "P") (let ((proc (inferior-haskell-process arg))) (pop-to-buffer (process-buffer proc)))) ;;;###autoload (defun inferior-haskell-load-file (&optional reload) "Pass the current buffer's file to the inferior haskell process." (interactive) (let ((file buffer-file-name) (proc (inferior-haskell-process))) (save-buffer) (with-current-buffer (process-buffer proc) ;; Not sure if it's useful/needed and if it actually works. ;; (unless (equal (file-name-as-directory default-directory) ;; (file-name-directory file)) ;; (inferior-haskell-send-string ;; proc (concat ":cd " (file-name-directory file) "\n"))) (compilation-forget-errors) (if (boundp 'compilation-parsing-end) (if (markerp compilation-parsing-end) (set-marker compilation-parsing-end (point-max)) (setq compilation-parsing-end (point-max)))) (inferior-haskell-send-command proc (if reload ":reload" (concat ":load \"" file "\"")))))) (defun inferior-haskell-send-command (proc str) (setq str (concat str "\n")) (with-current-buffer (process-buffer proc) (while (and (goto-char comint-last-input-end) (not (re-search-forward comint-prompt-regexp nil t)) (accept-process-output proc))) (goto-char (process-mark proc)) (insert-before-markers str) (move-marker comint-last-input-end (point)) (comint-send-string proc str))) (defun inferior-haskell-reload-file () "Tell the inferior haskell process to reread the current buffer's file." (interactive) (inferior-haskell-load-file 'reload)) (provide 'inf-haskell) ;;; inf-haskell.el ends here

1 participants
0 comments

CVS update by adrian xemacsweb/Architecting-XEmacs ... 18 years, 2 months

CVS Monitor

User: adrian Date: 06/03/15 01:14:07 Modified: xemacsweb/Architecting-XEmacs ChangeLog index.content Log: xemacsweb: Add http://www.crestani.de/xemacs to Architecting-XEmacs/ -------------------- ChangeLog entries follow: -------------------- Architecting-XEmacs/ChangeLog addition: 2006-03-15 Adrian Aichner <adrian(a)xemacs.org> * index.content: Add http://www.crestani.de/xemacs under 21.x. Revision Changes Path 1.57 +4 -0 XEmacs/xemacsweb/Architecting-XEmacs/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Architecting-XEmacs/ChangeLog,v retrieving revision 1.56 retrieving revision 1.57 diff -u -p -r1.56 -r1.57 --- ChangeLog 2006/01/20 00:58:32 1.56 +++ ChangeLog 2006/03/15 00:14:05 1.57 ＠＠ -1,3 +1,7 ＠＠ +2006-03-15 Adrian Aichner <adrian(a)xemacs.org> + + * index.content: Add http://www.crestani.de/xemacs under 21.x. + 2006-01-20 Adrian Aichner <adrian(a)xemacs.org> * index.content: texi2html homepage link update. 1.41 +1 -0 XEmacs/xemacsweb/Architecting-XEmacs/index.content Index: index.content =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Architecting-XEmacs/index.content,v retrieving revision 1.40 retrieving revision 1.41 diff -u -p -r1.40 -r1.41 --- index.content 2006/01/20 00:58:32 1.40 +++ index.content 2006/03/15 00:14:06 1.41 ＠＠ -59,6 +59,7 ＠＠ Ben Wing <h2>Short-term (21.x)</h2> <ol> + <li><a href="http://www.crestani.de/xemacs">Marcus Crestani's work on the Lisp memory manager</a></li> <li><a href="unexec.html">Unexec replacement</a></li> <li><a href="faster-elisp.html">Making elisp function calls faster</a></li> <li><a href="windows-key-bindings.html">Better support for Windows style key bindings</a></li>

1 participants
0 comments

CVS update by viteno xemacs ... 18 years, 2 months

CVS Monitor

User: viteno Date: 06/03/14 23:51:13 Modified: xemacs version.sh Log: Update xemacs_extra_name. Revision Changes Path 1.1468 +1 -1 XEmacs/xemacs/version.sh Index: version.sh =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/version.sh,v retrieving revision 1.1467 retrieving revision 1.1468 diff -u -p -r1.1467 -r1.1468 --- version.sh 2006/03/13 22:51:40 1.1467 +++ version.sh 2006/03/14 22:51:13 1.1468 ＠＠ -8,5 +8,5 ＠＠ emacs_kit_version= infodock_major_version=4 infodock_minor_version=0 infodock_build_version=8 -xemacs_extra_name="(+CVS-20060313)" +xemacs_extra_name="(+CVS-20060314)" xemacs_release_date="2006-02-26"

1 participants
0 comments

CVS update by james xemacs/src ... 18 years, 2 months

CVS Monitor

User: james Date: 06/03/14 20:31:46 Modified: xemacs/src ChangeLog profile.h Log: Add a missing do to a do { ... } while(0) macro. See message ID <1141930812.4329.8.camel(a)jerrypc.cs.usu.edu> on the xemacs-patches list. Revision Changes Path 1.927 +4 -0 XEmacs/xemacs/src/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.926 retrieving revision 1.927 diff -u -p -r1.926 -r1.927 --- ChangeLog 2006/03/02 17:11:45 1.926 +++ ChangeLog 2006/03/14 19:31:41 1.927 ＠＠ -1,3 +1,7 ＠＠ +2006-03-09 Jerry James <james(a)xemacs.org> + + * profile.h (RETURN_UNGCPRO_EXIT_PROFILING): Add missing do. + 2006-03-02 Marcus Crestani <crestani(a)xemacs.org> * gc.c (show_gc_cursor_and_message): New. 1.4 +1 -0 XEmacs/xemacs/src/profile.h Index: profile.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.h,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- profile.h 2005/10/25 11:16:27 1.3 +++ profile.h 2006/03/14 19:31:43 1.4 ＠＠ -113,6 +113,7 ＠＠ do \ RETURN_EXIT_PROFILING (tag, Lisp_Object, expr) #define RETURN_UNGCPRO_EXIT_PROFILING(tag, expr) \ +do \ { \ Lisp_Object ret_ungc_val = (expr); \ UNGCPRO; \

1 participants
0 comments

CVS update by viteno xemacs-builds/viteno ... 18 years, 2 months

CVS Monitor

User: viteno Date: 06/03/14 09:54:26 Modified: xemacs-builds/viteno package-index setup-packages.ini Log: Package database backup: - jde-1.51 Revision Changes Path 1.282 +6 -6 XEmacs/xemacs-builds/viteno/package-index Index: package-index =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/package-index,v retrieving revision 1.281 retrieving revision 1.282 diff -u -p -r1.281 -r1.282 --- package-index 2006/03/08 12:56:12 1.281 +++ package-index 2006/03/14 08:54:24 1.282 ＠＠ -745,19 +745,19 ＠＠ (package-get-update-base-entry (quote (jde (standards-version 1.1 - version "1.50" + version "1.51" author-version "2.3.3" - date "2006-03-06" - build-date "2006-03-06" + date "2006-03-14" + build-date "2006-03-14" maintainer "Andy Piper <andy(a)xemacs.org>" distribution xemacs priority medium category "standard" dump nil description "Integrated Development Environment for Java." - filename "jde-1.50-pkg.tar.gz" - md5sum "6e0bb40773e8264d00ee4c27f41a6192" - size 3508244 + filename "jde-1.51-pkg.tar.gz" + md5sum "c65372ce1cb48a354c40b13d29d90a27" + size 3508064 provides (beanshell efc efc-xemacs jde-ant jde-bug jde-checkstyle jde-class jde-compat jde-compile jde-complete jde-db jde-dbo jde-dbs jde-ejb jde-gen jde-help jde-imenu jde-import jde-java-font-lock jde-java-grammar jde-javadoc-gen jde-javadoc jde-jdb jde-make jde-open-source jde-package jde-parse-class jde-parse jde-plugins jde-run jde-setnu jde-stat jde-util jde-which-method jde-widgets jde-wiz jde-xemacs jde-xref jde tree-widget) requires (jde cc-mode semantic debug speedbar edit-utils eterm mail-lib xemacs-base xemacs-devel eieio elib sh-script fsf-compat) type regular 1.270 +2 -2 XEmacs/xemacs-builds/viteno/setup-packages.ini Index: setup-packages.ini =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/setup-packages.ini,v retrieving revision 1.269 retrieving revision 1.270 diff -u -p -r1.269 -r1.270 --- setup-packages.ini 2006/03/08 12:56:12 1.269 +++ setup-packages.ini 2006/03/14 08:54:24 1.270 ＠＠ -328,8 +328,8 ＠＠ version: 1.15 install: packages/fsf-compat-1.15-pkg.tar.gz 18912 ＠ jde -version: 1.50 -install: packages/jde-1.50-pkg.tar.gz 3508244 +version: 1.51 +install: packages/jde-1.51-pkg.tar.gz 3508064 ＠ mail-lib version: 1.76

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

xemacs-cvs March 2006