From 83069cba30a751333b5dffdf6b7b5b535ef503eb Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Thu, 15 Jan 2009 21:56:02 -0800 Subject: [PATCH] removing outdated emacs files (soon to be replaced with recent ones) --- emacs/data/notify.wav | Bin 81441 -> 0 bytes emacs/dot-emacs | 71 - emacs/dot-emacs-parts/basic.el | 7 - emacs/dot-emacs-parts/buffer-switching.el | 8 - emacs/dot-emacs-parts/dotnet.el | 3 - emacs/dot-emacs-parts/git-part.el | 2 - emacs/dot-emacs-parts/goodies.el | 4 - emacs/dot-emacs-parts/irc-setup.el | 39 - emacs/dot-emacs-parts/lang-fsharp.el | 39 - emacs/dot-emacs-parts/lang-js.el | 4 - emacs/dot-emacs-parts/lang-vb.el | 5 - emacs/dot-emacs-parts/look-and-feel.el | 12 - emacs/dot-emacs-parts/org-initialize.el | 7 - emacs/dot-emacs-parts/personal.el | 3 - emacs/dot-emacs-parts/terminal-enhancements.el | 11 - emacs/external/color-theme-eon.el | 1411 -- emacs/external/color-theme-library.el | 13539 ----------- emacs/external/color-theme.el | 1668 -- emacs/external/css-mode.el | 470 - emacs/external/django-html-mode.el | 185 - emacs/external/git-contrib-emacs/.gitignore | 1 - emacs/external/git-contrib-emacs/Makefile | 21 - emacs/external/git-contrib-emacs/git-blame.el | 434 - emacs/external/git-contrib-emacs/git.el | 1588 -- emacs/external/git-contrib-emacs/vc-git.el | 216 - emacs/external/javascript.el | 700 - emacs/external/ljupdate/COPYING | 341 - emacs/external/ljupdate/Makefile | 70 - emacs/external/ljupdate/README | 74 - emacs/external/ljupdate/http-cookies.el | 416 - emacs/external/ljupdate/http-get.el | 448 - emacs/external/ljupdate/http-post.el | 172 - emacs/external/ljupdate/index.html | 56 - emacs/external/ljupdate/lj-acct.el | 230 - emacs/external/ljupdate/lj-acct.elc | Bin 6456 -> 0 bytes emacs/external/ljupdate/lj-compat.el | 48 - emacs/external/ljupdate/lj-compat.elc | Bin 894 -> 0 bytes emacs/external/ljupdate/lj-compose.el | 404 - emacs/external/ljupdate/lj-compose.elc | Bin 13873 -> 0 bytes emacs/external/ljupdate/lj-custom.el | 155 - emacs/external/ljupdate/lj-custom.elc | Bin 5137 -> 0 bytes emacs/external/ljupdate/lj-edit.el | 322 - emacs/external/ljupdate/lj-edit.elc | Bin 6585 -> 0 bytes emacs/external/ljupdate/lj-fill.el | 90 - emacs/external/ljupdate/lj-fill.elc | Bin 2439 -> 0 bytes emacs/external/ljupdate/lj-login.el | 212 - emacs/external/ljupdate/lj-login.elc | Bin 5840 -> 0 bytes emacs/external/ljupdate/lj-maint.el | 63 - emacs/external/ljupdate/lj-pcomplete.el | 123 - emacs/external/ljupdate/lj-pcomplete.elc | Bin 3178 -> 0 bytes emacs/external/ljupdate/lj-protocol.el | 90 - emacs/external/ljupdate/lj-protocol.elc | Bin 2479 -> 0 bytes emacs/external/ljupdate/lj-util.el | 66 - emacs/external/ljupdate/lj-util.elc | Bin 1449 -> 0 bytes emacs/external/ljupdate/ljupdate.el | 165 - emacs/external/ljupdate/ljupdate.elc | Bin 3763 -> 0 bytes emacs/external/ljupdate/ljupdate.el~ | 59 - emacs/external/ljupdate/ljupdate.in | 59 - emacs/external/ml/caml-compat.el | 42 - emacs/external/ml/caml-emacs.el | 43 - emacs/external/ml/caml-emacs.elc | Bin 1754 -> 0 bytes emacs/external/ml/caml-font.el | 140 - emacs/external/ml/caml-help.el | 829 - emacs/external/ml/caml-help.elc | Bin 19348 -> 0 bytes emacs/external/ml/caml-hilit.el | 67 - emacs/external/ml/caml-types.el | 572 - emacs/external/ml/caml-types.elc | Bin 13421 -> 0 bytes emacs/external/ml/caml-xemacs.el | 53 - emacs/external/ml/caml-xemacs.elc | Bin 1929 -> 0 bytes emacs/external/ml/caml.el | 1908 -- emacs/external/ml/caml.elc | Bin 52438 -> 0 bytes emacs/external/ml/camldebug.el | 768 - emacs/external/ml/camldebug.elc | Bin 24280 -> 0 bytes emacs/external/ml/inf-caml.el | 362 - emacs/external/ml/inf-caml.elc | Bin 8949 -> 0 bytes emacs/external/org-install.el | 539 - emacs/external/org.el | 27696 ----------------------- emacs/external/powershell.el | 160 - emacs/external/rcirc-nick-colors.el | 84 - emacs/external/smooth-scrolling.el | 75 - emacs/external/tuareg/camldebug.el | 765 - emacs/external/tuareg/sym-lock.el | 355 - emacs/external/tuareg/tuareg.el | 3448 --- emacs/external/twit.el | 418 - emacs/external/visual-basic-mode.el | 944 - emacs/external/yaml-mode.el | 392 - 86 files changed, 63771 deletions(-) delete mode 100644 emacs/data/notify.wav delete mode 100644 emacs/dot-emacs delete mode 100644 emacs/dot-emacs-parts/basic.el delete mode 100644 emacs/dot-emacs-parts/buffer-switching.el delete mode 100644 emacs/dot-emacs-parts/dotnet.el delete mode 100644 emacs/dot-emacs-parts/git-part.el delete mode 100644 emacs/dot-emacs-parts/goodies.el delete mode 100644 emacs/dot-emacs-parts/irc-setup.el delete mode 100644 emacs/dot-emacs-parts/lang-fsharp.el delete mode 100644 emacs/dot-emacs-parts/lang-js.el delete mode 100644 emacs/dot-emacs-parts/lang-vb.el delete mode 100644 emacs/dot-emacs-parts/look-and-feel.el delete mode 100644 emacs/dot-emacs-parts/org-initialize.el delete mode 100644 emacs/dot-emacs-parts/personal.el delete mode 100644 emacs/dot-emacs-parts/terminal-enhancements.el delete mode 100644 emacs/external/color-theme-eon.el delete mode 100644 emacs/external/color-theme-library.el delete mode 100644 emacs/external/color-theme.el delete mode 100644 emacs/external/css-mode.el delete mode 100644 emacs/external/django-html-mode.el delete mode 100644 emacs/external/git-contrib-emacs/.gitignore delete mode 100644 emacs/external/git-contrib-emacs/Makefile delete mode 100644 emacs/external/git-contrib-emacs/git-blame.el delete mode 100644 emacs/external/git-contrib-emacs/git.el delete mode 100644 emacs/external/git-contrib-emacs/vc-git.el delete mode 100644 emacs/external/javascript.el delete mode 100644 emacs/external/ljupdate/COPYING delete mode 100644 emacs/external/ljupdate/Makefile delete mode 100644 emacs/external/ljupdate/README delete mode 100644 emacs/external/ljupdate/http-cookies.el delete mode 100644 emacs/external/ljupdate/http-get.el delete mode 100644 emacs/external/ljupdate/http-post.el delete mode 100644 emacs/external/ljupdate/index.html delete mode 100644 emacs/external/ljupdate/lj-acct.el delete mode 100644 emacs/external/ljupdate/lj-acct.elc delete mode 100644 emacs/external/ljupdate/lj-compat.el delete mode 100644 emacs/external/ljupdate/lj-compat.elc delete mode 100644 emacs/external/ljupdate/lj-compose.el delete mode 100644 emacs/external/ljupdate/lj-compose.elc delete mode 100644 emacs/external/ljupdate/lj-custom.el delete mode 100644 emacs/external/ljupdate/lj-custom.elc delete mode 100644 emacs/external/ljupdate/lj-edit.el delete mode 100644 emacs/external/ljupdate/lj-edit.elc delete mode 100644 emacs/external/ljupdate/lj-fill.el delete mode 100644 emacs/external/ljupdate/lj-fill.elc delete mode 100644 emacs/external/ljupdate/lj-login.el delete mode 100644 emacs/external/ljupdate/lj-login.elc delete mode 100644 emacs/external/ljupdate/lj-maint.el delete mode 100644 emacs/external/ljupdate/lj-pcomplete.el delete mode 100644 emacs/external/ljupdate/lj-pcomplete.elc delete mode 100644 emacs/external/ljupdate/lj-protocol.el delete mode 100644 emacs/external/ljupdate/lj-protocol.elc delete mode 100644 emacs/external/ljupdate/lj-util.el delete mode 100644 emacs/external/ljupdate/lj-util.elc delete mode 100644 emacs/external/ljupdate/ljupdate.el delete mode 100644 emacs/external/ljupdate/ljupdate.elc delete mode 100644 emacs/external/ljupdate/ljupdate.el~ delete mode 100644 emacs/external/ljupdate/ljupdate.in delete mode 100644 emacs/external/ml/caml-compat.el delete mode 100644 emacs/external/ml/caml-emacs.el delete mode 100644 emacs/external/ml/caml-emacs.elc delete mode 100644 emacs/external/ml/caml-font.el delete mode 100644 emacs/external/ml/caml-help.el delete mode 100644 emacs/external/ml/caml-help.elc delete mode 100644 emacs/external/ml/caml-hilit.el delete mode 100644 emacs/external/ml/caml-types.el delete mode 100644 emacs/external/ml/caml-types.elc delete mode 100644 emacs/external/ml/caml-xemacs.el delete mode 100644 emacs/external/ml/caml-xemacs.elc delete mode 100644 emacs/external/ml/caml.el delete mode 100644 emacs/external/ml/caml.elc delete mode 100644 emacs/external/ml/camldebug.el delete mode 100644 emacs/external/ml/camldebug.elc delete mode 100644 emacs/external/ml/inf-caml.el delete mode 100644 emacs/external/ml/inf-caml.elc delete mode 100644 emacs/external/org-install.el delete mode 100644 emacs/external/org.el delete mode 100644 emacs/external/powershell.el delete mode 100644 emacs/external/rcirc-nick-colors.el delete mode 100644 emacs/external/smooth-scrolling.el delete mode 100644 emacs/external/tuareg/camldebug.el delete mode 100644 emacs/external/tuareg/sym-lock.el delete mode 100644 emacs/external/tuareg/tuareg.el delete mode 100644 emacs/external/twit.el delete mode 100644 emacs/external/visual-basic-mode.el delete mode 100644 emacs/external/yaml-mode.el diff --git a/emacs/data/notify.wav b/emacs/data/notify.wav deleted file mode 100644 index d2076eab796f90c2bba99146ee8ec5f292dcbea9..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 81441 zcwTIL1-R74`*mbyBD;HWx8hdZ-J!T!ai_RD#kIJ$xVyVcf#P1=p*Y-oxw{*gnIzx4 z3-s6j^L)>JhU_M@*<{X~^PZDUXjHR$^=#!up?Rfd)w=c`^h07n5JW)|s%{g6#JeQ{ z35kWy9R_s}ppWY@&-17!2+R|s?dxkn;Lx1t(t|!O^zov7IlSiodF@1(|LybrvtRpt zU2<4Pdb_YD@-Kt;k>>o{v?pY z34LwY{F-4QM*7j{zWBG#y8k(=uV?XfbiS|mzMZZ6f6m2;o|_YWFAAO~!Ki*; z3c}YuJi1i?6a*Omuggf2p<(Dlpka7TqVHV~LHpl(K~SOT-qxH1@5 z8f}qr{f;yHHrC&9u)ksY6&n%uAp`bebj&#{9XNXqqhP~(3tD7J|1;zMJ5TsGtY~zO zd_}|i*4%&p_`k>ebu7MO^!+UVH%4E_Li*2Z934{`##D}utpX#cM&EzM27OzSZ#aG( z|46?G1~P0DqucSnpT*D!{2_Q1X&BZMScjt9BcD^hH5C0L(d`=a)1v)I^mCCtM~()+n-ujt=xY+)ANsdHing!oNfe{6BaHtY^~j&} zt>4!sMgPz@OmOrs((C&eh|x2bzU>J`-+jd;(jr(zSpSu|?l%UU;$iHjhccw;W z0*|)uXYyTfrEgV0`1g#y_WAl<|DApR)4Z=|;(VK7-_PvpsC=Jw-)FS=joaTj|G&|3 zqOT*P9#N3{-g|F`chpPc4f3YD8N85l#vSMkbTc@mUB%LCojV}X(Ct-uuZd0>wEDllJt7?`bI2uxD91qP}U11;71fii01 zKyvk*|CQ3yzgdy|J(L-~Y>Mu?L&oZ3$OkP8sivL4zpG90OXUs9qVz*;NmyQthsu|b zC7JRFDTmC&7SafDnrI5ggke#ME#^)2hPX++lg?^4u~XFT$}c*nSVt!l6PyWjHIK8a z^A2_#yJsz7jjW&8U6auc<{lbv^rBOZJT$lQ*}fG%Xpap~v5SXW+jgj^eKwTDUK|Qr zgF?@()}h;0z0hT=cIcwjG<3!KC3Mf468dQE3}O3KD7&3KT-)vw9%i2kZ?)4I|JW0Z zEHq?vqkZ5zf+k{Ptu`!$eU$CC)AFWt6nE%9d@F0@wBe_n#7+VCA{_U4H8wunj6nl>)>N*7yMiuiJ3YJ$7oA&8f`UBudTr;w3QfZ3-Kp)GQO<# z$E(z4xR+WS7gUqs&&qqWS~-I1D3j1)$xHAEIW5j3&qa47PaZ9GlQT&d zrQ>1_skt~p{487$#tF%Vq(U2SwYS>M>%DOfy1ASxZV!Il+0EKGE{)}N={Ua9PR%WA z4{K%BV;9T>TE<*T4;VFRIm5B9g%8+WVJuO&yuCd{?2e&3)(@d=)<3~%)~;X=YjUuG z)gf5gsv68`6%D4b@&!{^`C(Z+m=V_Huv!O;TVsN?tgXRL*7M*5D}88_)h2Y)+8A;z zJ5?3TKor>3{!}v$~n9pZbol1PC z6U)=P%bn?NBiD9yue)~|h&D*5CS(_P3%A7d;s|Mym_hy^9+GQIwa|L$9-`9ExVC%~ zFP1BiC-Pd74l&XQ#&iN&pzK69l)IqGCd#eG;96=%++NL(`=}-H0JU@!hqh`yTtm%- zbErCYlmv8Dxq}udyHQhR3euF8=n%<;Isi8$a#UUkxRk)9CdY6}` z{rG%a=U=S#thrTlWCABHTIoV-t#>fq zCxgALwZS&l{9q$%MzF3mJ6O+J5^Q4a4tBI|2ZvcKIM2!#+HLg+{cY_Caf^oX+Ks{; z?VaJJc4FhcJ<>=|KN%f>pPT3-m>WM^mDm$&0qbD@!`|8@_y9VaOY99_$SOK{_;Tk@ z&YU*R&n|V2y35>*UU}fqGw+=@R;Ufw>=G`Csl;B=XfcueT-+^Jk?Nui(rbj|;kb>g zkbUwDqQQ8!K;x9<=#%ms)dVb7s15KtbrjC3t;5Z<)A(2I0bZhg#G5q}@6j0E0m~)Y zXITFPx6;nzAGNJGtWLrE)Hb-gS_mgsJ#<9*3pH1!0)MKZQN)uGIVexXy<`oim#3i1 zP$h>+L*%SdoODg>A`KVsi`m3F;uYbvFjy!mWE9qU=e%TIZ*QWT!VAK=wRhUOSGeew z`8j2m`U-rfGho?DAqTdOL2VH&ijxr0)pC!KHPqos`m`(5~iy(&Bp zc-6};8m?!@giF|=P)_@wPzL*1D4qR2l*MMDe0Cb(T%~Yxdq{YweIUHT7K|%)eZ#dk z8%1f1*&leakH(n}?Pb+sv7n_xKvNO@i7%pScwXl4Gwf%lH9z8nd0KatGtAB9-gWI$qY5AjoyjO)W?!N`XA()zLh-J_mNln zLGlom=k<+bv%ZLo(MOY7dTXK=C1*8-^ws{x$+Ts7JHS;zO@l8fH-MJo(OFUe6({%Q zb$GPw$3Mse(P`;{+(9ZYi_!{drRa%e#ZKZA;fgRuC@EwSHhLGmlwMzNiks4-&PlhQ z)7||5RO-slIB(b>r#s8xe5CjJKstvDv=*OdBc9Vf$xd10SUamGLsksiW!|S<%xyH2 zIgY+ETGHJ{2|CHhNIM#SS`UW4iecH64BM_{cy=2@r=x%#8v%|7MkAWS97fxk8|W_c z0rgo)SYMFSr`829j3d@6}2C^<~l-7w1AZjSy6gCRKL@iM}Z3W`-cIL8)~&+#jJwNhRSf>{79FZ z*Xc0xAZ=-`rPa(oXbE!;Eoe@s#XuP=nTu!>SUVum?{JLRY!Ajy6c=NZWZ^V`_66X&Gim@Wnh}U z7N!Yv#h_48YA1e@E{XHyB2sbmhja%jOmEymW_XW0nJ7pH6`KfbF`;^QQ1jx`>Mu~~ zSK)!$9ehf|MAGwodt2eI0qJA0=V^9FcriiRQaakna{?a+$o-Pms&{ zHnK@yOhyBHYUr&9z!~I!Tb|gw2Rg^ zSJU$5@3gqNfR+YGs+r4Z3t-3)^8mndg`PCufgw{_K`Rd%Xfg9)2_uBg z;v)e|<-|?W8nK3~fS~o1rlG4+c3eo1%`d)zN6p7RSBA=nX(fIlu1N+iy8}KQ$Czyu<*aXus6AVLUr5D;svZIpZF&xW0xf-r6{{?2c3Ye5* za$~6|1h-An7BQ{VK%5~Of+H*!x(ii=8{QkQlsDO11xlf~m)+h@PxmJGxh45_XFY2O z1<2yl=~_-`Lp}qPEe#mlt=3Rh-73rCOoeSU@6xVNi1L}UsALYNFO2r|lF@)3H>%S^ zMiqL(s6lTTjp;|DGxeFnX(@9)?Q8C*+s&tdk;W=prP&gzKjYRGDE@ERC71(cXn(#N z=0qMQIqO&hCo^B=tmUyzPN%H9#hK+6a9_Cx-Qr#aZ#ro6Q?Ch>(x<|2LO1b+5CjV} zR+=To$gjm^av3QXnlJ4^AEh$5qI?D~kZY3H@+DFPRaeHL6Ur4-NKJ~Ds7=5)&jk~3 z9&gfY{8`IRa_F^53%v)>VjNkZ&jpGs1-w>3p;-dB%!c*9lArZ%B#&N)#A|uUE=?v~ zq2eS3!+k*QjvK3a@H+@MgOwG?Ax*&?Xef*i$$fA~`7QFxZO|d5C%(`5i*TgLt1-gaw(eO@2Ewl+;@BBT&^2+Kq)W(957Ds2|?%eJ^x zt}bOq^Q0B%iIg1Y1XIvgHt=3KBK_A$F;rL?g61lFP%KDYRWQj5)Q0$}IvQt!`QK8z z1e|(@_rkc}0$#m`a$;-w2-OObPg-vBNXtn6)MCgIFmc_rd$@qM2gj+?@k+HNuC8Xm zACz}!g0ddWM+dZ+q(^DVRe2!0sK1K^Xl6rmdaR#l6cDyUqA9=RWJ}v|-tuxAX}gLKkx%ZOk{?$$2&V9(!Xg zXS1v>th7~#eKJM19=Ov5xRcwQM#DxAdIfm112rQ$)9Sky3(*Z_GI?PB10X8RH zZv7?#C8%@)`yd~YK@g|6g&7UX}h+Rl%B zopY88U@+UcqI=q1^K_ zKv-^!>&nOQTsbqjAxDDZb5c2q&p2fhx(J~~Qyo+T#`RaV8s4gQ#y0_{kUASD)|TVU z+7@sQdvJbexj+lkY3nh8Q2LKL9)fEx2(S$x$mYlCRR!Ns9-+y~W>ioah;EY7s5fzC zksOg{;{I}SoI_rS9!N20sx)3MC?!aD#8zOcPl;*7tl~kaHqC^0p5fK-=6jpm0-oQ! z25zl4U=wgF^S#bK*4oL>6lVu$OHtZ~{|Q#0nf;Q*LjYQ6^=4JAGRy)Su-kk=2bsrc zS#t?!)+lgn9qBn3_uWQ$x*GVi(D;$gfwtHvK-YqkI{;eux6uO3cpsVrc+=i^e`MI%3_6>iuXT=a+xf|<=RR;Y zyZv0%)4Xop2JgIA8Rpzmn0q6{w?Yc3rnp_&C{~fNbVqJ0wSge`0!eav+(^C)cBvY9 zCT}5`Ande4?UXrat8xN;fw}%81kgy>oT1jlyVQ30qS_Zff$;NQoq#_84zB>OJL(X8 z66(q-wK*Q4R={=CtT?qQ;wQ>uv{cy#p>!G|%Fk#Q$$?suSlPk*oy2f{UBf>1%oBkb^QcgHlf%z^Z_(S&X?N`aHk zMtd76Xluhqn}D9RFf?%10Xi7g%>&--Gb+$$Mk{dABWWXZC7o|xqz}z7&12;N+twO% zZ9Xe!Ut=q6Kk%jw@OCzTLGSRUEUj~yb#yB89nLWbprxIf?r~>{TNSL^MYoJs-<#px z_x|zP3uS~4!dzj9_*ziFA1ss>iy7rOakE@iDu#ZS4x#r_30z#>gU8A_$R&9`NrWs? zFB$b}YCr{ZVo2(WwI@G{^_Bq)_q zlVck`yGuER+AFic8ny%vkP+1a2mcJOmIve3pl7M%x#*^p5>1wt%jKl(a)P)8{7YV` zk+@YvkOdA3+rUQW1&^~8s%b87gtyMk?PYWCxvQLsZd%avMf`=6oX>XVv+_<-7S9(z z5KKdx^3}G^3)tt_8EYbI4WZNn&$Y$8OU_kr2}jfTFc;&a!hE3 zUE82`YXj4vpl{0|z+N_LQ_<{0D?_cCYM!L`%s5&Y@R?_I1V6Zzbp>zm$j;9j)8SBe z{^Ipn3h-@RoW^{=bC0WT8<LF*88p}zfrgBngtei)BCU=sCLNcrZzM&F%D0fkQ zLo3ue_$36=9KL6ygMXbeJZ!wbg zIIu{~82CYL>ffMD@MTjrfaf?3wd`-;>vQELdPS93xZ#24pu?+i5BlGu!eP-2QddmvVvJQlhJtq9C-2hT< zE^`tkR)D<+PZ3G6N9ZxW5xm|~{>GW_jB=;BDZFvsPH&`8Qy3t=6uL_z#kO*CsXp2S zUapj!m0Xmu(gZzG9->X^&-fSZCeEZ+BIorjq^qu&zRt=}{{iK_-&N`b%Bt%F{nfa@ zN;OZ+8MSH5Q*}^GygDg{LF4M^n6TO{=B-*G=7y@q>{8DJCaHY`4b?y(wYtK8N6G4+ zto-3Cq)5KIq`lsc?A0W~fRd%v)VP=OJ6c3ipd)y;{1D1yP#!9&@>?;z)EKCBR46HA z6DmT8_{lZhCQci-4L|F2VR@bYbO9e@b2b~S+G_J}df2E+?}ZQBUZ|*@KeWs08Z2UM zNjPmOMyP z^i@^z`==;V{C_Gp{a=(MfmCXhKryvrpeA6@NbMJBqIL>sEs^%Yfe`aY5k`tKx_UXlC?`+op5$qD7IkFpGHC)v;oph_aJbtTZUD82hj zlf;=2fi?1@&*7%zi=5(2cUsc1e6(${br4N%fE3AQKU&rZ*@MF) z?foIeMxjMk^I$G(XTljXc|vD%+!x)X@du1a@jZ?7@wtpsfYSh=O_8`|VG=hc{4usq z_-SmH@N;NiV*7;?$4v~Ei(45U3e-6n_c@#@KASNDDEAtu*XGL?Vq>tg`OzE+;bihPyii_1l159qUuEbdl$D;^b(}~qLN-F|ECOS? z-&a;C2-vLfUsR|cskH(n)mecK>Ysrz>Z`y)H5^#2^1yoaOJJ4ycVM=AU-un9y#2k{j7B|G-z6j(9y zH#z}I&E4>ByKuOU{YU7tg+p_!VZlv)8Ck!aH~N1G8&|&MGm9kjF*ksmWebYdj$kvZ zQfROBD3sD38y;;JFy7j4jh1wSd4u+`YO(V6WtIXW^A~!b|IIo%M|sd$<4kgAxv9Kg zA=dSVAkk91CRCI6S=EgYklBwO^wq>L|) zob**z%K2w2d;Is5^ntYM@IX`ba$t&@JZ7(2Kjxu2GR9DUk5RR)G0C)DF)6k6F)`Zo z7*A~v8kZaN?{#3Yx**V5EfUD9p7Xy~>iAbEmwk1V3O*C!?NXxZB}hB%D&7G$(NJPh z31tN8PXx3M|0-WcwiK2JNU7xyVo|BBSVz1ebQUTLW4t}y?`~#qk2BxB3FSBh7-e8K zuS-Yp$+pYRTa#EKD>;i??>}Kwq*;t-_KfgkTMieor-c5oQihhnn6|PS1T$N1LaccJ zcr_wng;_gcjF~&(7vNZH)1T1XOq|ft%mRF?k}$#?l<>Q`E8&<)0ox|oiB;+c~9&cCU`C+~evzoKN%nvk!Ie|_zexRZ7IlE7IpdAY30gT>QIYJw) zzk>s<8NphBQw}S0P_ev(p!qK0t@$kBx%moOFyWn!Q@u2U@^e7jU|R=T5Ut; ztg|6(M{qd^^`(LlZ{IfR(0=Aln#M}aE?bk?c-vxSX>ab(SNt4n~#dCe(h}+dI(d*c%hv%SS%rPs5KL%cZkR*@HBZ2)S9+ngCoDCy#@QcPBU;by$fOb zWwO|pPss&ZwhcIwC6HO28R(>b3M^O4##~p&#!&S@Oh)ZVObLwx9x;iUX-N__(bPos zv`|b{?RHFIZ9_~dt#?cU@aH06`nx(Z&{|C#NTV+G-%`@~Cn|G%`4z6;B5n2lRjQpp*)9IhhwMW>=J{JeBj{34bR(~EmR;0g)@z3tvAaNReYO|InR zivCR3m*sc1(Ea>_T>)J7Wj5Su$u66pXfAUy{S6Y289s0K1$e@toc1)JP@d2x>t1lM zH9uI}Y8Cv^DiTa)r3-@R3)*HfXqkeNRXUi|Y6qo$F7&w>>}#b9Ew%cGZdkWM0lQqd zzP&g6hh5zGWS=!E(Vxv_)HWry%Id`$*$-F%EWj0*F0)uEry1YpWO0hR@y>qtq+7z9 z>mBksf!Qf09u}}vTD&bC6Ia7|_C-gfl8}5D-YK6TIngL(IV!3q#_s^0McM~kR&PQc z=m$w}Us8qneo@Byk0>UTn)ZQe>WRQOH4#W!-Ixaek)>{kNvs_On9jvy*G|V|1$j#i zZW(LsfHJva&Z}?1-u)5ir&bCSSD*MzrH_A~5`um9^QBUr>nBKcy)D_GG0fC?xEdte z-;^EbGAV%&IWCvP<>l_^n6yYPE&VC&6F-Uh#gyU>p(5m>-XPa2-JIS{zy>>c-HIR? zV_*!<(sMi!ZNl5wZ=eK?W_~Lb>uv6#cZ`O#nqk>T!)xp^;YRkwkl$_>x&kzqXYCHQ zvw8z9N&-ES1-Z!*KAQjsRm6mchG0G4Caht_#imc$`{&VO$)uS;zF6hvG=ea zhY#5u4V?y!E_4PY;R04p_RyNkeglcEO#5<~z2+BLduIWE>U4J6x+UBfuFvb@J@?*u z`-EP?G%-PFB@GgPltZEgGJXohNt5s|(W?fWG(bC)6R3rn8&j~ii?n#052WU(zJ^qS z(s0sOT`BCJsVw*3R6KtowOOEwx*BZtQ=miQn1gDum}_dSn8#{^nCEJ3SeA;psip)e zdkwg33=CIW2WqPd*t_*0k0t!`l{3EDN;RKD4uKWS4&U>e_6bt&6tLCl@l<6yx=zZV z7;;*!hO5fM&^c+nTur(zof1v4w3t!cCsYyg3q8CI-W)fRchp(xe&%W2%zUZSlKtQ; zq1*UNyA&^MUt&|OPV67kiT;?g+bBzO8Sm^(FwgUcYuhJ7#Qr&S!Q#QW)|Oyfu-%2M zAALJ28RB&UWC%v zt-@XH=YUTyBZdlQ54ysSExd4Rk9UG)(^MDi{2a7_WJVwG z4ml5SyE8f>Es@Jh*QC>;CzcoUibsUTLUCb)x7%Ce=JBpL8{9C@4A`u2ny?JcZ*&#E zVCUqKt6^=ds%($>fF?GF(qTqg`XPMA?gq&;4m53i=#`ZvwBEW1IyE9#!73F@VM)P| zc`xCSc^EKRpK#P%4t8u^!eOurXU&@lcfkt8nMH$%p?~S<=dwY`nhB*#4i~T|gh$yv zcl?H8%x6AM?bQkZ%ayf+ zwDM`npT1g3djB}3w|}p)+y6}Y;Fr|2U=zv)imD9*Rn<0uI?!sV^#j$_5@5Ac1Tv{F zq0a{YQ>DFsml6Zm?gZ;s$>)*F`T_Ej-jy8IVn{Y^51yhnz)zL8C_h-W;Y3F#!QOi) zqg)29lLpDTq%G2R@fm1ZGI1N2wI8A0?C>_Y`MvwjPS@uYax3vY&Ine_*+UQWSi2JN z<_a5SwSsyRN3%duA7f;qZ^Nfxj`y_hhtk>|L)U;abF5WhgX;&gT0W>RcM|TI+Y*kO zvlF(Nzk<~s3HEI~EEgnfH}@s{X+8%&rGhxqBADIU5NvLF@cB-mt5AEA*mc6K?OWlU zb_cL)meG~|ZeF5Qtb#1TTFy4uiFrpliDzMy|HB42oA_s^KX9kK`_?61XYZ!>(px69 z6}pIzgnUvnF)UpdkI1#9QJ@*6aTz%XwP!QQgnm|jLs$)=t!f+mlXeQMTRPHC??ayG zM@fC3r0nxmQT+aqQ4TEe-%zglO%zC{iomJ2eypDL$11-=pSJ$3 zN;3agz_y;!!f3cq^$y?szqKRU=Pwwr>c#RaEWzXuywb%I%}0F3)%82>{F=gl<` z_m={1RwW!V_khj5k#Nhj5tJ_)GdXU(M<|UHLgDpHtoqLYzJh=P=FN=QRYKPAzT` zo{BldHPTA3)TyM5XohqjIa1_SnZo2Q*y_^Y4OXI*s)VZ9-vi~tV+T3R&u~79_;g@ zga_u|3AdsC+%sbn-k3?iCsYllwtfwkf&Sg2pX&oP=WZyOT^+DF8Qx%5G(z?zu+y#0 z4b(6Zn{Rbv#eu^w>=Jx2-N+lVG)^Ku)49zR_YY^h+un8E$d%qNp6MMH1`6ZFxaj2@ zzx+zPB)5y*TvCo)I*E)+4y89bs$4)nshROLbug}{oxvBi04bq2B8yOM|p`*JE*ef1U5-%rWypQ=>%FOTvm!js6=%!>XcN@oA0s4qL>tELR{rBSl@-jPVG zX$M;QMf;Hq*Pi3BItzGH5bXpmIi9i3#)W!w-pXfwT=Y4LgcA!bq^M`8i97z3}&=y2Qyhs z!Kd{Mmat|A>sqIRzknXjvZ{s-TZ=;I8B|VZW8yZd(*Az&G(LaO@+e1oo&JsF(+_mwb(^Y zD`f{?@Dz#iY&<|NO&-fnNqICxS%nBh!P#nk90S>7g7yY~hPqu>??yK0%Sl+jLP~;% z8vqO|Zc;_o%(0V=MHL`wl17ax&Z;70OR^iE>(XsMPQkQPWw#D`)o@dxl~UBF3i z@veHG-R53F@T3Es-tHmJ9FI+PYO|EiA9MrcoHD$UeV47a1~Sb`%0`-pr~$QLsF9A! z#^3gm@LcfI&FuG~Z1(CqYIhoP{Z316iR84`8soijCZ7<%cQJh3CLwf6j$Z>rgk$g8u8DE%m_a#zh z__8bOeZ`f%zH-WbUnOOmuY$4+G;F*tlk&4qRdV~@lUV(1^ioaa4h2y!MpncAifae( zNwpU)uV%uBl&ev{xR|6s7Tzy618jDq4-!UWrRH*SX@j&uj2BCZWyHUPDWGeS%L5s` zVO~$DsFBNTx|7HKnV)pFv1SftvAi>#%Fo!@csBdb=r7oU6<|XFpAg_P3VfRm_^bu~ z)C{+>ZJ7J}Lyk2j^weq$vA+oL=!eiMz~T=pRcM8k6FgnT&|a%!=#n)n^wv5TQf&qN zSwqmWwc$CoU|hDl8ybyprZ#x?tL8`A+$zuBS_|1|JIK<~ru;ZP!aK4oj?Sk$hj_^O z#p&dx2iDvGY$kZSyy8Me;hiv3SS(VZy3|EXkZy=e+| zsGKqsomVcQ>S|gTzpl8jwi7SY5-QECcawX6Lk7*^lyyh( zo6ZB)%PGZl$U2+3OzZH0FgEWYYjm`JVlSZfbThZp1jvb#jUQ+>;}z8Kt@e=cFgqXQ zp3kAI_Ti9Z&jGC(5V~h|2wk??LF)>>Zg}Xv^+zZcaM5iil-I5Vnm9c?(S8&@XqPbJ z?B&LfR5$z3k>-9HGCexjs?S_&1DkDo;00RqKk0Ga0Wz4vCp)`&oYTf><@()=?kVsC zLm*4%1}`1CGi-(!6v{|##W&JLagJO_DuNbC*N`c7#!Y1tJX_>4Xyg~o$;uYwfUoYa zmcozK5xBf|2rmV16|dz4U1~~3>Ep-&$dIqWXZw72Np{~`QpgueiumG5Uf)NO-1me8 zp+240caz!rEK(0JmGmNHi{|0l+BwLalki}*5*E}jnxJe%E@_Dd!FRvG+W?z-@)7h| zN`t0L1LPdiCFz8iQEDjm5nl?&gh7HPC_)Qw33%x|p5YvKYdMYGmHeG!fo8N|8J!dK z1kXh~@Wqh-lGuBr+MmKo$yS>;XfenjH;o2#kdcc1V7##Jgm>9D7p(rO-aJY>(y zG_{qA{cd$-ne0Pso1KW41@9R7<+MA?4%keK`sjLaytZ@H-Qec%8hZ=8$Wt?WguX&2 z@v)Fpsv(||_J}>@3{ny_N!p9vOZ9OL`4wIx_aj`kNdq)oS%G4ecc_h80H0I);;hp+67E2L-MP-XIr*6E%%b!E@#Jti`#*4 zF?e0Z&K<4++gjMYA;T_%zW2iW?Tp4VyO-goe*!ky0Grw7IU4z;e2~?M1+6t~q-`=E zt;?4}4J-i1beVN>e&K&PDroR#XSQ444Y{`av$xti>-{9;6TS$Gge9UURFk@kUqILX zkc&eWT`oOGvOEHJk&}>9@*0u~#;O<8ozp0@nh4KP8%D>nxpoO}(HtDq@{q#d-G0#r zLw%o14g!B}>ifw{{WRp&^W@dHyAV(5+sR76W~e@%R0rPZ<;hts2^kC!XVkXf<7z+L zSj~^0E3Z*^Whwed>Y>iWmhZt7sfKIGyMQ{W&}?bAoL_nXG%q1_7U#npiv?l(31Y!2 z?}A6&PF@q2yE~l)Zonzv_TZPDOY9e?5YxaGYyoMj3(^(_X83FEb0Q)D?p^-c6A3(%vX+LMr?IOGn{VjTFZ3(O56z1!k zt6-yhJKe#mU2^xj1-zy}9m}&JhPD$biRXlW#6047X_lBp{vw{18%jT;ozfSSC^}_R zk@EmgT9jSsiPkH}P(~;Tv%t1RZa{3UUBSCx>N{E?QUNU2K!_{Lp!^)uHv>Ee$pifu zc?9h?#Q#&UZY@}|k@{Hj6F`$#uSBkEX~{(GBQ63G`A{7bm9@wvo5ji@h@XAX3ZPDM zasiHGfE+?;*&6#IyXOpdVEGfv&YV!^)WiFtPjOKKLktrH~V#DVk z0i^(Oh8DmRY@6YWpx-YU?};ZNqody}UY0hqBkO@cZ#_uz{Yfhm_xj--e&Kj zR~zPAtgs;ZYiNF{rFcm?B6fu+%H_e*40KaUhjYto@n|^*xhAhC=}-ox3!0l4XRz-hC-j6`nMSgtQ1zv)v+51>~i zy%k9WR`0f!g3Qp~Z=5!ptAH6a3J^KPu6L~@{ax>>a^C?8djTD&!=zfT&1Azl2jd)u&uG{xPvLa9Z ztPL-UTJB}gHij2R*F6aDv$1j2E(LfFhO%`WHAS@;~T$o}D@TFl+8K;Cr3-Jh?m78RF)3A4AZo;td2#kXi@`$A!T{2l0V`rSjr> zX{}gU#?k}1qtp`}lWde+9*2LCWpY>^OB7^~hNz>m5M5CIM!8@N$EwxvEp;ep(nj0? zBFYjijIY6XGbkmQ_3EUo-U6afXRymXNpom5fiH#iCM2m|fxOkSlf4=t!?YK`oBh#v zGexa~bE%2(N#zD=pv*u|NEOtc81iGhUT%yV$`=upN}<)#TDiIukl%~_r77ZdF{_wY zJRwXKS_p5wpjXM8?JWUYU^-{q7EW9DDCbUAzS5b^syYJu%!kn>JOrg@xJ{XE?`LbQ z{;a%Jm_0KoooW6>E0~KQ{`8~=VT{KbnQ0?KqWO%Eb`0>s3SYJ3fKQ*oe@5>J@ZfzK zb@n0p zlvOsq#5u@Kr>@h)eeLXa$GJ(MbPn?V^zM5dgt7t_*9e54uLtXO1+4KW zuyC?o0&u8A(&$x53cWJX^|B-k`gd2$NOk}&W3+d;x^@;LZ5ckI_QBoNk~pA>c#Col zRZ=FP8>BR9PU4{EtOmPQU%rAEl*9GX9=W#kgB&kTmllc%VhOR8cu)9K7$)QZ`#H@! z?0teLTHj4@w>vXj)ye60hLU@hb#Zb-9G?%i0MS}}jBPV)?_i5y+=^O1vX`b!BbN;# zkK;scz!l8i(Z_kN8+D<)SEa|G#7FMV_{;c--h=q^#b`qln*(Wab0+OTK#)-XiPXcDbAeLxFdx{bZouHfDOcEkHMuDSL2 zVdpmM=`?2oO#{5V7FLuS6&IVWwStctzyKR1^v&=KJvAKd~HOEp0 z5%sargkCUe(xXNtdKf&z8KX)xUd9>iXcBV>EoaW9{mq?pi+Pj22aF3^*+DBCvpd!l zRsbUJ0$boBt<3w;Df~IT$y>7Y5Wjjlt@ttLIgfF>J00A3=YTuP4S1^8$(!dL^3n@_ zVFSds$PJeJM4wnvY9k(&c8DcqF7A_SNO{m4X$873CBhlyp}4*L6y|Sb@=RU{*3AST zRYMsUtv`2^2Pl~;M4uiVs+Pq|0jC3MM|=V5QAG1@L%RsL?N__tC2Au)Of84&sM&BT zmEb4JGqgn6kLoGYAl9@%n@JW_m%NwXLLym&--TJ$Wke!~8CbvO;|CqRd09l*8yA;G?M) zDyk;KP1T&ZpIQP>Qmf*5YF)etZ1+6i$t1Np?yZ)_b=5pLr{PZJDBM1`Yca z1tChU0&iA>{3E}`o1oV9kkjD2@^7-a+>MLFmGl*5hOTuAc zh)_WILD=YB@iKWsy~S=8FOhrAo#qU8iIdBn${#t2`CMlis|9gKan8}Ryd#|qp1L02 zYNzC_?3XNweSlrIeq%GNPOPa_iDk92G7I9#Ju`tGHJ{Us=I!X^u?6OZ=v`-PK>zlc z_vuyhJxzf4p8@c;{R6BCo)7XB%tar00vA zIs6&Ko4oEMI8NF9%bnn+@UYj-i|BFyLiHk{jqroGTi7VdVqU44xI@|`7LaXm2h`g< zXo0j6=4=dLGYoX?FDn>6=cT*NcvALz(2mcmAnN%Mx5BzDW{)juP z#iLJP_k-3=EsC2%eyOZx#yQjg768ZF$`iB_e0dk;50nk!=3~&a8L;mXFmDYDIn`ybQ0KDXACRjBxNSwM)&htbO`@wm*Wd;jn}dtGGuROXRHZq zy49Zj47sF;m6s&}k8PQRy*C+s4tn*(H0evz0z4$9STQV%m627oibfw5T?1bEfi;_@ z0-W0d-ka>C5P7Tc#&j6pL-+CIP-}*>g20*nPE+9WMer#VoS)nSkjL`7PuB{mth<$|Gypz{~aWi22HrPpcYtWy_&pnYR*Ed5gA7!;W8 zK|z#CiG#ooyp%49wLv@fz*wY1Q>C%!y!03$xdbjN&xSl2xtvoNv~2|V>JubC;-o3m z@!_bGvH;D1`m;?ri_R*yQRKm#r%+FxD=*M};K+I97TT?xLGzWpsJF5Ll~=|fpVAin z4f?o{q(BY93lefnK7gmo9dR>RfjYMty^?C64bn5YtJGi4Cdu+Mah|kTOfS_J*MYap zBOVua3j?DMS^eof_G)?ay?bsgud6G1LFa@!(HQ|br-Zv3d}>X8$a%*`gP*SE6k{>Y zQ+l7zp&NKLI+(k5O@7SI%twK@u58}{jXTKxv6ir7)_ArGeD-v!3majz0?*Kt4T3s9 z#%dmY&|oWIa>bg)!q!Tb**?k|*^k)_sQs7i>^ufEGxDhQCc2w@^et}zUgQ94;iTn@ zow59m6L}=OrPIv4;;eAXy6@awZXqwXHv(qYIWL`%7}TJZpo<%XF=Ct$4_>XEG)%lA z9T$tqj<{4V137f4)D-QKc7dNJIKA8m=JGN;Tz(0fla*YS+mQr$0gUS@QUt|8Q5K`V$}+%W8EUW0kN&S7kq5LAE1l3=QWG5_dC^4TgBtTzM&v~F zA<;p&qnr&FkgtJf9)ixo{Fot~0FTy2P9cS*JK_{+0eFG>;%306n0Qh+0re(w3F>d} zEmYEF-W$-ge!v?MG<=~m){Q)%c^vekB|qsfHo;lL>Ns^+YKPJ{d?!7~dw_4tNjvk; zc13>B&cG+y4r>mYRM@`ElG%qCwKlT1)-v|cTEzag=0cmz9s{>NS}T}mZDEmzPs`ZX z!7qPczk@zrv2$|_xco$iL;YXRBbhfJlbi{xxbukhaf$um0Q?- z<*sydcmc16H`?0;3SfHeg>s+?6NG9|QxAwq#hg-0aiO$KWYS}?gPczKOKu@$1CKNc z{Pa!GwoEv`+zq#qx8RBLKX|j8hFp?s!nh725?W5uqQfK~xij*6p$C9N6|dYzjcq#{+qOBas(PsJR-NzUbOvXpr@QXE|NHw_y?e{b z&X-tmd@y*R7S<cJ`VE|{d3pEQD$Uc{ zEqD`q1b4mEebBOW%;eo!4sn#V6bbk|(Ut!v&T%O+iIQ@R7$9GZ-LkU$A$Q2UPI9N0 zGs4;7yoKo01j0F>^i|TKoyvIhL-~RVpa!@PI*fOCm)zVYo~NV(E=ZT+3G^Di2l2@W z?9>G`$KA2~4D>Crc8*j4w(bfZev;;+YqgYgKOFlLkP~M>^UgrLj>G4>;Csuoq;wqk zm(E&{l-FL6B=Ea$)eU49#Cia*U{SRM`3-T|L|@^ibPvYhv$g`4G$0AE4c==dUJ0z< z9^FD&P%rdW(b0Nk4d`-7B@5)uJEym^0a&M#vqolf%F563nb;wRiGDJTC@N1u?sVek zMGT)M4zm_ecXEgnEW&Ttm-r0e+gh;B6WERUGph*SXQkq^EX4Z)W4q@mt6C3OX~>Nd z5F>X>Q)TNeYizw>Jt20J!0-QS#qui<)2LOM=Y<^XXiwm4>`nYN_?a9`^8PHJxWL+o zl)#I9`6Y1!*gn4~C+C3X#sfb$mr>_Y_=<7&}Zc( zyytSbEn0z>p%A`_Y5-5KCZ&N3`r^vq|K>tneoQ$|ujU}F!K*J(`;+VHLL$_CBqwNG zZS6Jb0rh;eM(AuUmM+l}!y^gQlSFhn#BHc1fF*u`PkKetLC%HMUE~tv%K~)(JYNHn z8RGteVzP)nz_sXREJ0H@lZv=D@#A=W8_kDWQvkO@H-MjefM=%QZm%z0`Ze5&XY(wF?EsE&>&s88 z6i)-Otz!@1YRqon_TY+j%os5Gq0m2eEg_y%|#iWidNpetQ*A<#B=GRr}z zJz<)FaOdS_BjtwgYznw+D*@mP8Z|4EnQ&!jhA26fLJr0@&h0=->= z{={w2LzE2-M4yx-XtT0S>84avaw^ZAug)N6o0AZ9VVlhFRF}WxCwSj8U~LuPM*h_gm(4(B7Z>n93f3!;S>sD@l1pMPp zD<$w;Qoau2wGlq*LG z1;3e(Zxkc>L*aHmJ$ zPGd9)&q1%<>m)>?siXjYMA|{!nT31OV|Y9LfZckKNi9GcL+*?RkGK;w>8`qh{80Ch zfOdvt(yo&~ppF#RopNp*QYV9aB2S8yP;=Tz9en5x9u!UZX`%7i;sj{S5LQSOXR#g^oVCyL zxlkiI+EaLGyAMwfbpzQo_$Tl{_pO4US-JUnh{b6u13znJftsHiIJpoHTIF~Q_{&@n z&)W82KE$5Kw*s5Jf!L&j*tmlURsuV}X9L6^d=13rHslSJnW5ec5q;%dv03JqZ{!r2 z(s?iI!Rwz6F72Y@4%q9glvU0u!<9_vfLC+g0GXD@ozZe&f_QuvRfjdZl9a?hU=5d` zEAc4cf>SgebDEMAf%?!{ZA#{WwjEWcljrJcVuDWjwG$+zc9CR;7-fe%$_X*asojLH zFF|gdArf-tGqA)pbur}4I5H06+gPnbvOq3=qXDvue#E`$DVz)Z?`z1}1(3Uy;C1}K zchC}eUFC5X^bX}k6H&a94INg_!Rv1eT;qu>ri}P^cvht=CZduYspL z##Cz;i0r!add(_+YD*40Ns>FKPb`tiGQA zu%Gfez=!Vjq)dFJn9E-YEV9XgqL=(C4tm?v?#n7pO=mW|gC|aLsG)ANa(c8|nS-L> zaY~`Scno@hFQQtY@drpPoQh7zqv>V*j_RZe=#D!z&D{c85o*g+V6AJwT|T`9Eu{|! zW?o9?>bvPq{VYAF-=w$oNA!XI47}zOdKEm+QT-BKryrve^ewavFm)l|ZAEWJFT!(7 z(h|_}+FKG2%(fPEuD1FY`9%|v8T3BROc&zAz|nt^IQ#%!TYEeleFSdlf!-^>l*Qn1 zYA6v$f~M_qBC?$`SSEHX@SY<;&ymP2r|{PzA^3{rpksL$5y$M4Q2R&nH^5b+EY8wf zr`S1j66<3&U>VKK>~S<=FNxl;+eEk6`J&Tp8trGli?p(@M{3*0BNgp^k+Sx|NICnA zH;ko${Wa3g4nzmoMWVCp&e0wAD)?P@3R`+JJ?n1PVJFNnEIIhn0T8oC5ci7qKYTCn zdk*ICHIP&8Ih-ZH)u}`gxl&A&ZnO9{na3&UjCKw=cbt++R`3b~lnUs)at0*@Cg_Nc z;oYbRcpaCO-0h!p=^gBV?sQR`kt@IexwTs!n>_{pm_zSPd+N*RHi*kR{S8fG2>Pdy zT&-{9R67|(ymL4I7$wvm#-D0aBcEEvNT;SX3^l0#q^I>8bfUhQR?^2(TWdnMY1zE% z1Gc&!G;ff%W&J4Bp~`dDjF}jG4qcV^`dr?A^6>?_*WR5$icA(3k;Bo3pOP+SU zgZN8s;qf9ftko5)rbx|fzTDo*GeOPYW~JbNTDRF1b0%wR)?{`xz*a>rWN z_L@jhyJf^@r;EI{K7~(P$HN<~CE+>N$naRJZ+MW^GyIR$Cp^#^5gu(V2+yz%gjZWH z!$+;ek;hh@h_L2Ia@sE=P3-*9srJ<98T(sQ+KtU}?5qiH2Y7Ek{QY8fSANVs#;dZ# z;sNU^dh!c`icAorv9dU5-F;cf=?9GC2aQ{&v{y=_)816W&frBOpd%AVZX63dJBQxH zacTxKRqX|}`~c~#G4crFQdS>ISA*X-^)Iv<9P_zGP4$5>P)*=ls+RX1QG59Ac!Q4C z`hx0qA5*u&W4$k|&i8#$|M5LiYxqv7seP-}m&QnSh0#cDU}RGrJxKqB9ILF4qR+rH z_10|Qy1itO+L44HpLzk8JR_YUPCmQ`Z$-&*O*F_G#xfoVC!I3OyOz_)`3tC$L*#2l=dth{r{UK`Ft<6g8sX33e1CR90Dghj_fG1+V_zqT2)aCm`n5U8} zz&lryUu8%(19x!IX{;0g->^bCfPCQd2B83Xh4zu^xH;X9qco1pgt(;F{v+G8^t7Pf z7xe1{%?j&(fl*uK#td&-;Xa>Ki9f$q+uvH7>7S&X^Ka6E{tH^Fz;mrg;Fnf8U~4r4 zLaQENTB$%#%My5}3IBENx_`H}z&}H4;BT)He?iUNE>g{RT76-R^3I!v^dEG9zM6j5 zYSMOEyjQP^s3pl_`UHo`Kw#|{ycVxPK~xl#NB=3)l&0SH!gQc^-6VDPig{9k53S1& ziw&%{kiYs~0awJ#*h<)QE9jL}WMt`-S zkwTrXAEdvudbEc2iL3%I{2lViy$&~;L|6*H69b@SgVv86HW4js8V;34J;*J_s;vN}Y<9-;UeGV2>AlqUWCMKz+}{BkSX}{-x0#6OKEOr{0AfcIpb&Kw_FGp(Fg(Baq4Y2OBhAUh9LylP| zbjplC9NbRpzQI4u^1-xb)}YT!8syPL!Duv9P)73w17@9I26IHPta&il&gAg(bwWqY zt)Y;a5VUYyc(|oRu2|C|>FspU!S>4utC^&L-iLnG-_o^4L$w~%3+BtM zt?o+j`{o9LgY zee`9~D)>&QvyFP{1N{X}rFW%`wI5`f`VToyf8np>Z=8aBMHO);)C;`^AJC(*rOt8?BC(@Q1k!sT6m{` zeq|4BF>eO{F((Bpo3(?P%#1k#l>?dVF66Be3XSS9NYi&_=ISo4k8 zE)U8A&NOGg(^mOYDT0nGIxdeM<1=UzDTn(){VfKb##DC`_ncWb;NYZ&q(_Xd-VnCm zzUoPnPi5!=Sd6PwSt5fjuq#q8FDf$sXyKzcpie?@EW@2g$$CDC&F zcB`X}YU(Xu^wfHH+DZ$0Tz8e4n31748;PJgxGx%rz9`GV$+@xl2z-!G-jd}+9oe7X z@CI&uu%GZeb{9Uxim+?u43^c*&L#j?eT}pSP4n4L!$+((;T}-$GkWbH8AF@Q%MhEf z!AfSuU}`fiXh%QBzl+|8zZX3de>HkG{&Ms-eEtLClq!h5R*}WQy5`s5IP_yt zo9_0|E#XC0p~zS39MqsT(G9i}^|4K6Ki0&0?rj6TXrJR#S!q$99};OrG5K8_l4oQ| zXNhyl>8DguYNE?ZW?Ubc_%XUhTH_V;8SV%^KD&00yw$4GrTPJHSl(M>qB`97R`r+E z=0Q167Uto5WWsZ_v|%Cj+c?iC?7^_QX_wC9;0S#Iip2vO`{Dwn#NW)D#n&KvO?^vm;}b@m>>Gc zm~(o;n0flcKuf((Ahpi@_q5Ue$y(4?P;2jd2uLtQ&0-`{2kQUQb5H{P+Ig_7b;vZZ ztLI5`%5 ziOn>uQ*@Vo3an*Th|N5(E`e}KYi{V9nFUhje6Y9qHnO~9UTRa>G7MQ|HdDQUXQ;668AG&CYaQm7_4YM4h}I(hW48qLSZvixD3R7mX#y& z);b2#)-<}-7EzsThxO6gdd-sCP56ELDqqAZi01s5$Ozc>O&kDeD+H!=ms3N@qa;IH zl;tWf4UjGB7}6eOB#GXRp3$$;?nYtN50+*%#3whb?QQ-QfX5%S zS%KX8XULyYF-!EZkOxO&-st&l4#;tzNa z_w#cgZy(}cMUz2p)eU9`S*vG$3ywFdgpQk=LJVS4&RQ6rZl#R8u-1e9DFN92IQr8b zWj1HItn+|vh4>CA3U|QLa~><#i^;Ml*nvNtao#;M-0t_;D5NyPf1~8&Bf109 zHjCc!=CA!wx0A(MVp>`sOdsh_>EA|4K)3nc{7=8Xgf<4sw%d8rD4>BZmDbHbZ@o;+ zVy_G>g*@6H^HM(>^I1Oyk3BK3^u;kZ^}c}HWn-4=O3Xj{p+IH5V<3^P1|Djw{fo3e z{PnfHK2>w)Rjx5wL2Quvx4w#A)r!&d+Evm`Z9{g^ulP3^fb$WKy5MnWC8Fpqpp6gy zRREhXL?&`}iAC}YPvgxtbfjh?oDf!1`3B(y(-Pg}jh z11%QHZ_NiRE)v>jz7CEw7lO7m3Fh{4NI-tPj(-t-5Pu&Y_o8p%a};!^62zFDgL%!3 z!N%sV;AFEJ=;HQ}X{H4GGc!EJiizB_=0X6n^Hk3h)yUrDuGVoeP|TPjZ4xM_$Q4aE7hT%wtdv9 z(J}f4nh4Nf30V6yz76V9usr@hwSNAg+715!EnDD|)<2M3KM1AcJETMEn9+Lan1yco@kv=z&N3RSn^_%~aHq}2}%iyo>HSXjA3RrKn zRFfG*9j$MoZsjYdy&wzJf#d_EbP>7|4~Lg|4DUxaDvgSvGfE$&vhuHU#d#&`I4R{F zSywcZ)AtWVo_oBb;s?jC(NvPE2BT?&mc$d{N+{cok zg4X&_)NB$uZzc>aHg5qHtc1fpFj(4b4q>Vp%xL}H|CD~7N1)FPOUdryt-Qn^p zSXCf`1Hvz|$qQnow_~b`Gu?4-1$0>%uFOIar2$Y+3i1WH!|WH*d-yN4iZ@PorIv!0 z)Q8gR`XlO&S$%GdR-5=PtLJ@jT23fGkoLnsbNy?e ziyjU1@tQ=x1C2d^@9hgz)W-*M=`{noZUmlbhyB~NcK!jH@D&CO`0ni#od-+6fTb`% zUrV286=@k*BFohgn(E-8s$;7ceQZi0HCH_C2^PQ>BfDC*%dp>s;CkXYoB zfANFDy*I}zK!O5xXFkz#*ei1xt85l$`{7vSj!v?-M2g!5BfqS(;cZsia4*XjE^eI& z>DI8&GqVynmt>)p=I`J{^AVI2w>k6@l%!k1f#$p5SW^wnH}i*f00LY$SA>G*n^1ai zqV>RuPP4+{OIEi?to=UH%Vopp#Ew^GA;8OHeNG%G> z+hU!ZDieG6rwGBnZ9t%%&|@VXu8r>DQ)m+T1DAl*`Al^(PyL(xsXZVMw34)!zLW|* zNGAc=8omYUXx|If9cf(M-$q;IpQnBHpY|HtngvvS3^>UZ;QV(5N_n}o8y@Qe#i6`p z*L#ADl?_BRBXCc<0C5@SAMFiSxeVmo(RWAvZGew4%Ber~pR|j8e2l2dQizTA z9!~6UQ!Mh+x&~;~E8NdY0eEmT6blmf8Jx=vvs~y1 zIG=ybl%Zu_!)^vBOGQK5%|@Zq=J3!Hb4SQFzX6383jbw|4G*)Pg!fxzAl{oJ1?@D^ zVcsPE^k!PN15lv6b&Wl-^6}x|Lfsj07r`O_!!L_WK+^ZbMmbp~aY{jKemX&C4LG;@ z=!T-;QfLR>h?RQrA;{@xC=v;j(O=8$|wozSGq4cZ zw5*E1l@{{l(w6yxYEj=o^@7n?t!Ly=??8#GsZXV+v;s7rcE`KA9fG{6OSgNwbWQvS zRmDBg0>qV9$}A~t>4a!zV_SM~%fJF~&dL_9Wc3X9wT^_>dG~hdA4y`rh%^NExx_vjeQlRF|6mu* z@vM>cjD5C>@p1Mdo{3rfJZmL-@$(|3$nR;|5E*dtIm4Yd&NpX)(n6_T#sja<*+$l~Q>C@;9{UNPnq*wPE?bH;$)#@PMGxa8{`E>qD zS_g2BYy3;St|{Tap`{7D*760ud1pZj1b%?-z11+p?uq}nw#mQJ>)Ofeuco;jB>jEQ z)dcW->y6fG0VA1uP`^lvfR=98a?*_2EixNo<94UCpnLEEQU}M9PpA_fi4LMT0D?72 zeWkFn#<}PULBQ;H-d!SYS$TOC>pr_+j%8KNBJ4)=o82zD z#Wo||?Ilnf%10treE6KT4cuc-$f2U3QND0t>m%sZ4X`e*-W?7h>vTx7?uC+A!BBQ9 zL%4#~INTo4Y?Adle8?&m`ED(WB=n>qYH z$eXVGf(VG*a=(}>+es$loUYC>=Yi7`TxeRfTe*hPqTzTl%0c4MP0|YYr)Rw#)0@>% zq=fdEoCB1ts*k3p0jb@coGXkbs$(6UZz_}1SKEmgB{fD&u{`J~4|1_|Nz-i+wb=+I`?NE9tP0)SNwXz5l12rMBSOBW7p-*ucwJf=>t{~mC5D95D=pcPH z{jL9^?jV$##$dIeZy#Xw7xkepm6i&Qb0dE@Z4%hXt^QToCI2q%x&MUr-n&i31^E29 zcE!I}+X=Cm;-8_lfH-CWyY$+ZRa*#}R?&A_eQ!)vM;U*q34qg<>PKjLy^l9ABB6GH zj8^-QZ!`&MOb_70q%lqf>u4yRf$pPRs31D4OjnvI@0{OG8Q`2nGQ0CzoRoD$Q@NeT z3qQoC56dqefVP#l{{d}F$un4I*b1{Z%VcI?+aNwAqx0;0kw*5gNIE-DK#a zX<8fjIhXamK+dfPes1Ku4!O8kT@4If%t)MjZg(MfYH44{DRlwK@7;OlHO6!d z?nKh!3-~C?jGLh`VAI^XQ%cFMEOyR1QQ6LEDup~Mmdo^_q@2i~fE^v_-3H+bSn|?# ze}2$P&kI9sK46Yw6<}Ro2Yc8qy3(Z|0ycj@c(Bzh+|{ZA zwWwUUDST`JUw5_!!uJ=4XIkgNTPz;FYL$-!t*Mbr_9KXMA+Wg%q8DrtHCS)64tsAd z^>&JWwMy~9_8jhKpZOa0mng-ziKjeHjud~(jPjm5FH1Y!oVAW$p~`lpr&15yRDQt< zoQ@ZuoUkU(kh-`5)ZRB#BYo6XBwpP~`U4mI(5ll8`dn|T#v9`cJQybzRsWtR>(XxWCac?`a)yLJ= zzH8pVh+Re(wT_WXeXoB6j$T8V)|iggG;a`2AGIxcNmWvVZoxZ94V(z-PG39`T}ByD zR&-Dqsnk*KIiH=vz&i6~2IrSJAsdTU@+21`7hmIz+IP=R&j7vm+YR^}ON0D5#kQM6 zSvj*PdmfG0W1`3H9Kdh)B8}~tP&eEgRi%tPwLU=}oeOVapjXs>b(B}1L@Fht1<Iu#v=eca? zl#t)#VlheDJd11xICL58XmOTM?6i;boFFS(K-!8~x7k&52J2$hVAM>=wnv|Mn>~_5 zN7y%D=`W1rw>w4R?2?cUso~HokvrCJurJ>s6mFxt37^M8di@dkY&D8tdqO0GeFki; z4(Zo8y2{=Wy=w=|I0#K0uPLFS^@QE9vhq6iKz`T0#9M)^ePIKIJ9osrmE|TeT~>5A zNXlBySZBABNlB`lQ-&&C(F?`EmC(O<6RJx5_zmff2h;OdhvP9Hta&Q!GFhsnq;Yx& zI#l0C-N6CwyqY;+7oQvB)GWSjYCGR;bsm(D6TVpOl`n&4`wF^q2U7YgYbk){68g(& zj_*(HEky2=FQGQy7gpQ&?y4DmJJiSU6w{14YGEU#dRKn|u4$5BF5 z5qCuY;RD`YsoSJAsMrLH8c)n?=ajUzqj8HmY0xGTwoU*j97C1m&=(6Vaix^hez ztQ1f(D*rlHoz%`CXRgfT(VBZ#OCoZ~G5oPm`E=o4H;H4v_;Py-&uw?$$E^&!vGvmH zeRs*NyjhU_iaPdYSnfT5fZd7Ven^2&krrML@2N;-`$(jmH%8@pX~b`mowYipKgdw~G_)>hWj`pE8CId~MWxc$Wt5jtkJ_8 z)ppMq0%SKpJqcg`YqU@&8&%Xc#vf`vAo2*1pX+FP>&t=6def`$y!|zWCI&j&qD~-X z)e7V~<+u^uiyxCtxH(CT@8dJ5F7AsiqBN)kItLZAhvKIHBImRdaJoD09d3m<P7kp4AG`UO*jj@OQSV<4Gl06OSqJ#umGMcf(-KI2hIro`VpO z|8Vq8`K>Hbx+oQu7tRl-F}Q>4va(ZE{*otw)Jlr#@+h}OIlfa|VO>OXmRbC;U+`)6 zDxS;k#IJ)R9cD$?AJ!%I!Cb*Mz*_GK<)Ik3dBaT1-bHQuLiD4(Gy2G09lh@LhPpkX zZY;J#ew_tMeghN{FcYv6@H>B-b=fv^5c_Ga_4*X%T8MwO{^V7G4maDoc@p-Mk6}fC z9EXYa{ET?SW4!+FTVj)}C&Ti#tm-s^_wdO1;jnNHQW(Nhqc?@+=M8CWf3qyXB= z0l86F?eYKq(4O8MdJC#Gq0|=w_n*)}>IeNZ-LGGUvcHLz)5lQ@w9>uHL<{W~QM99E ztvZ^NQOlA0)WN;zDa^@mJRa7Jk9 zn`TMx233E6eonWS1DQSIby*7G&hN;{mx^WJY!Zmva*`M%r8q4I%NQqKws87@i~i;W zo$g8n3i(smy23){dT&qdOtT~F3iSGJp^c) ziTw8Z4SoX?HKRN5Vfqaxf#cLmZ9&eeGf5KdENQKU$ObI~eXmue>GYo97Ni$xX`e-;gstaGa}1Ih>y`bPDfBwQw(VA6TFzdaArp<|^IceFWkCxFe>i)74oZ z(>s~uW4T)_l$At%`GhBw{Q*_u_yVz)wG=H_R-v#Te3yOH>oZ7gx8M(~f_$On=Wg$s zJJv94ZuI)#x0-|5TsZb)ATI`(O<6y)Asc2kW>d}9kYhdBNr>Y+a}kTPc6m1qbN5K^ zv6AzkRfdU`qUj*;rx8*etwPAvz0rd6go=v)rSrHc9(+7ga^SABt3=l|AM(k_r+jrHlYj6Q;9 zfS8!zEZtG~%YgmbYY~z`yGfp^8$4up$FKjU3CU9W6ql##@H^52PauEb4CE);2WzJa z?ui~iY&xN5$`55ekXj7|D@2*;90g75>#UYJoqY0*JS|p$o;Q^rc{1R&haw}e(FN9C z^kMnDebm?N%Y34}l2@6ANQ`;<*j?nb*IGI!G4%)*h_N>yAPUo*PP8B zne%{=mwG)2?nrTW9!Nv$1)E@TcF0N#oKcqN1sm1Rp3jfkr+5JBOna6|90EN{#OI2? z`89Ey>+(-g8DcX@YVwlo4-EZU)^X}N3n2TSI)#8eH!5AdzW1pptk|dw>Ve0iyZ9U` zPB30c%43I&z|HA?yc@JdQPYr`Y7H_+9YAiV%e{WvV%k&EMT?R-S|W&1c6tR^>z!7O zhP3*?#7({aP}i$Ov_|x!R+HY=%Fshv9=Zr@WgpEUZm&TM?ovoj&CLHq;P}lPTFJ!m=W7(_=5R1#KB*d;RFt|HnZ=xlbJ9om(JsotctlftX z^Wt)xE9@h$!IFxlprzl~2vLde6|12BF`ikr5UqjHmdLd7z8nvH`As%(8Um*sb?$-n zOr}f&tqv-SlosfoavCK^IpKZJ!3$6b-$6~`cpM}(aU2|sKqF-6zeo@4(lXF4mGjP0v7&YB}j?EuYsP>axQD_y%Tvst`$>d1yNhR1D`jAKk?Z0G3z5Hu~OdM zs=nG!_(ppd?_y8oIqZ)7r&WQUv$F6NkUzt%FzaBwXSKo7m$U9bJg#~5q#VS`{a$

cPbXz%sVo)kv4Y_xtx(&WNCuqn> zk{#-BOE^xmaDRFdpP*kcQInI(z))k=&g6(Xg?v#rlN7M_%K;~}(Y}$vnjq6OKV1mS zuoPnDZVqwp{xVi0)a^-h_=02D#R(0mkC@}VQj1!btxN-3d4px(@NjyZXqkH)p@AvbQz_AQ=? znY=U0B6hI`0`ZBW2|pyZgXdI5R@uetd0!^;$VYOvOyPuO6Q?z-u!}&^d6X1D0*#fh zvOsC>#U>6V$2A}}uC5(M*?VmR_O)) zMumE_+PMIlHqp5&t2=*7zmouJ>>e>!HWtmL4I1L!K)L}xCUibcoMNrT5LQ?eWii6E zKk_s71wO~#$lJqlb#FwT#BK!jyaIm+8h6^t%=cQU`4%e~UvDMx9^0&x5W9^0hLwkZ zwn}loU7r_#+TY3^$7kBB`8oS6m+-u0S)3Tl{uKYQ4qnf@tE)SCNNA8Z9Yi~MLM)Xj z1m1^|ksfW9f3^*D2 zhR)&xP!C6=SX>?LK?zV}bYF>ryIBaCQ&>r_+;!eMe>^1EEgTu!r#6c6%OU*WX z3}TSa+wgW4;&BEZ|H0=Ez`uO4N^oRX=jnj;+&a_6p2QbIjIY|~xeB$WJWB|%DJd?o zjv^tSC0g?n5SyPufxKx9zH=w6odB$%PLSs(WeM;A1Dr9y(J!3OPB|r;+qtVSWtGwj zSo%0hj8fw|-uT&@_yo#Ef@m1%{SDBTv~-$Rcm4&>^N#vRdNr>%+heTS&Fk~Lr7k8v zAwEPq?9Cd;0CC8s-Gaw$l1aM;F*`?e?FjtLPVxZq?65lB+vU_9*u11#78oEMxlTKnjq%k0g( zC-|OdAV!(JIRpZTc{>JbDfyK{N8LjGcEX%hX9Evxf}A)>vOu1c(w>u=+B?!n`$F74jrza`)qs`%1Wn5b z^$3CPxpO=BKzzrky-6+L@;Eh%$e>Sce2BKJ1Z+VZQ#8!abB(fMk@#2^Ak@a7xNFIGT$$P zY`oaY8hLX(vNA=yx1aOva2$sKS5*ToOJldIYMJiXnL*M;Yp2!8VnFd79-`wL<-hn4eY-?%;R?q<#> zJXRJImE;^T!kbZ8NB)w#Wqv1#)7u&BY;|5bADt?oXYQRs$?WE!{ z^d>Pw))h^F(=y7nz(@7LlT$uj9A|CBP*zNognHoE-=RKS<12xs2SB}PV2|KMfCp09 ztwE>iLaZwBuU2XP33ThTRg(Vz&u>~)yiL97AeN=<-n@l9mXEX-^G)_1s9m?fZ~lOs zNgyV$;vNSC_)O6lYR!6h4MCnxR)aOO5`1S^9Fz5ANN$yXc(d@@J8Qk3_pC}{WsFiw zd8$lNN}%(~QeXiS{fQdl-soSv9x?n7)guACnv}s`A$JOUxpNwP=tumC`hlx*kQ%@P z{ngfFk=mc^S0|FI;CWuCtGzt>1)3MHZikOs$w&D5F?|1$x{&OJIJ)ut2RNcORC>#cO#SOde`F$+MR$8+VWg>JDwkWPzmt;HSGStb>qQj z&gDz&4WMJk`3L(hPr`ojDlCz3?*e*|HTKTa6z2bm!ThFhchAL&JhG)|34A|YO7O=G zWmvlGqBxzLmdMI-^_PieI@>8v&&Q`D|xgE|5{&ouA6&P~Xp2kJ_1{-k?l z+no))SDg&`GQ>Og(@t#&zgvnV1?Kxm4YC(vK7#&-E71*@0vDbmjqoUv2N!|Ze1zC6 z!z)m2ST{B*i8de=)kn90VOA&`Aa`m(-3f!Xxf{M~Idhz-Z0@X+S)6(@2=D(4@X#D@ zhEy_9SYG3*oXQ`IYJ88-AcroqPF_uD%`%GIpmW0h;LVRXXdebP_!r`|jQ<12zccvL zcJ>5s_E2}=vHtc<@R-Z_8hZ=GC8QD}uK-2Ph=Q>-0_uS*$bbJa{Iw*fC2bI5-7|^wL=#jDu`H?#_ zq8`-UC3qQni!YifRSOKXAD;Avq0sGo9XqyxEQu z(n;9eF*lVI#FdGG8PuE|cnfNShXF&^Ku3Tl-ScU&Xp?vM))r7Z-E(U0oWG{<{uHO9 zvmG?NC2)aXUXe$^NAv<#%P7jo$2`ufKh61Rk)AJu{23&+Lk)6o@8-_haA$G5b^IxC z)=9{PjgUuk>@|EWkyulEsq3{@OFXB_d%dE7w^P~1L{up%8g51l%B(Keqi!tDz z4uQuFvXPfw1k1QcS$eA*g^Iq0*%7Z^!;+*hiM^#sH zEA9?lQ(2BvYZzyYp9;se?Tav=lzhQvV@tBUUe{Qw`PHz{1^b@CQG*M8IwPXLB)fNr7mXe9coWCtd= zp-fZ;D|M7iN^<3j^V;d_Y;lr1|A4NQcDhU5Nha^e3u3h#B>tAUMFsf^IB6OG0>1&QNofJBLBnVijHKq?A@p0FSy&Q$5iun+u~kUuTSaJ3WUM|Uz=?L{U* zp18Aa2ZPV-3c1w;;^JOAbLZ70=iY>q((%~sZde9d+5~vs-Su<{ z{LLsl2Nl9?&>LX>ImlAVqKnEGWv;S7X|0q6Civo*j(Z)aB9Plx*~D2OGdbntH~CE* zmdnLtSsS=O5!vN_Zi+tObMo-D;wu|2cCn^n2(UqQh)sG}_fh*jzYlqH1oFY11Lfw8 zt8F8^+*u4YW(gl>ujF$<^VUIZ+=ib!_H`byU-2|7$}2*>aT|eFK|OPQR2-inYVy5e z8h;{ga0=R5P_`BAymLyHI4RvZSMFW4zsZL1+9$(%IN^K&Z%`U4={%*m@w7Z2fsfH|zy>}Nt7ZnaE(&~5 zm9&Ri(obyz@#zA!r8^k~{?v_CfB2ru-u2X)q=Z@q^eiv2X$tZH*l!zn8@JxnfY>CV z6Y&Gm0WX5T*A!xt3}WMYVRxog3ETmFMg`GQB$aCDni5i$Lhg5lno~eA!5gf1t~zx= z864T!*(D1BQ!7pac}t!XYvo|kSLPAr<$K7T)%>ey1-awun(KQu!5Z%m$FmZ!TPhau zcE{cZKe`WUiF;e5DUdHCAtpmW%Lajm84e%a>oe|ofKB#3e%?OM-$1TukaGo@Dq6A( zVhSrQPO(-Z0=iZJbgdt(hXXw9=~_imOU?j}ek``jobs_8E@PY<-~rM*1D$@r(*HRx zoHR-tIO~eaIZ%eg;IrN9pgWL(EL04+x1w^-OW((*Q7ZBcwI<2&DmY$GNgJFP@~1N7 z&mcIS8|fQ-i&{8J6OmNFZ|<%5YC?=!s`W`1wW+6J?!%p((+a*b5=VEoWFsm%Q*i?zt`vfQ0$PiLF4}t4I~jcyz2&|`6E#g*0aH9 zi~Ha~Hb8s^K%J=0Qi#mV;R^c<$NM3_Z2#xQXbo`oB8byG(6_npaPRl>ue}?%;TU&s z+4sSI`s3Ek<q^_$qafHfLwDq;1;zZZ{C4UUc(I`A2UHs`%3!ZJ>-AweRsSR#nx?i&mkv~BuI{e zWCTS;6hr|51Bj@o7_VXum_SrS%vlt#m=maol2il*B#0n62ojVeIp;Io_10QdJu`=> ze&2oX{c(q1G4afF*Q&Ml+PkW|+XX!m)q^GpFW7;6__N?s|C*q;Un=O}PeaV<TyRqqKRzw$>7o&>i%xGJ*9e(W-c%yF65?&W%PO@P1 zT5?r*B|JfOcuS7m$F-hw`A82+h&)LZz}*EY}>yCK5TAs`u?AkSB`~-jotq} z;>`HuB*dh-@BwRpAw6DcXxi!71>nsqhtFi6CO^RQ?^Q%>>w^4>*DhF?%n!eI61?M8 z(GYCY-f&FRGTIQm8kIGx;0YR;N3r!I%&*8pYa%~**lX|2!T%NgFX5;E@W%Va{9}T% z{Y!$ok(a;YuMK|kt0%Vm*ConeJU0&(BOWmJoSyY|a07hXvxwuLqkoCd>a1Ley;;Q* zd2?0JynlsUCnhT8s;Br;2ACDeRW;$~DxKJbJZWxLG8mb)L3!sbS>Fd|WqkzRJQb`; z+!PE=v=%l^6MnEK_|+cLgIs4?)Y9~dikW)RAG*HA8{uPG&0Y|B#jqvxcAP0qWiPlGtMa9kZsD(KW z+kHLq(68V-L0@yOSKI3kW%vX6+=>1--rfG6-uLhYd4uNu`S8@Q1+V!Fp=~^Xw^O39 zyuqYI$6y!6cSUGWYxL=@S>FZEAqIVtwJaEeI5Yz~w*-2%A}cFFyjJ3Vc~+2^pA`m^ zvvvf-;U(UL7k@bG=ir*Gk--^R@4^Q>1wVLOFc#c=79P5DqDW9Ku}SB;{y6x^zX7>d zm7t@))UW09Qdyn-xn5!aBX6SjfY%e_>m+c8*EDz=xehNGTEyIJrbK6$-q`O`qID53 z<@Qzhs_LI7g=a^*lNF*d$z<3s`CHhL2bU)YhTF0q*7@>2$?kxd(KNgRea-Vhwg8u! zWETwUBA)OPV-2#i@H}tWJi9RbcZu-Y>?&bTXyWU@WdwXV&(jrU_X}&ob94n~o`V+{ zhu>nIqCT+UNd`U(Uw~KnI%*jG9zB4V^Idc@V&%1_m3hHDYrZq{kW=%T2LFQF`OLf7 z+YFQ%`eVI&{8iovzmUHRv8PFJxqo-?u#N~>jeaVJ_;XRBV8FG8LldoZtsO7xL7i{1 z1-Nv1)=;g*=ncJl8hOjhS#yI|v*v*x^MK!M#Fn3f9$7!CwtZgKprB#a0Pv+>uoYT4 zC2>hG5dQggUM4${2nxW9aNXeB!Q1eU5BgPs&1&%GV?WEk!C&T8@ke^gy{F&`uJk&2 zjj$*Ayy@`MPb14d$2?~O8fpgIG!MZQ48|VJH~UOvnt4^dN8xxTcs)Gdf7?6LpX5D)Jc8?TcOmbo9bDpH9o+A~ z8oZ%vQS1)p`&ANK{qqueg1ZvskdK@cj83$L$GS4ulDJ*hcPR}XoRIa3R>1Q-l+Ci< z2~NX(qpUaddKu(0oJZT0xEt~Ry5PISMfjfP(6X9Ahs3c#mBb!@XRyfUksYt#cdx|n zbIrg8zmfkX#?9US8n2Q6y|>+aUGoKZc&!z8Hkm!^|Y< z?EAwN*>@p#xjkG853wANc|DKq&_pl!Sa@vmrLZPq7|&nREjc#qo17DVf}HA?WFp#| zEFV=ve$z4R5FD4~|7rNN%aM200ygw&W1zW@`CGlV{xq+M{|Vyd zW8N#^&c)b=lGvAD%{uJeM01%Lh<&}=EJvJuKdPmiv|h9lF?c+@^}Eq4@Nd_J*F-0W z=VDCPiT+HMjDAEcdLKTU*AlxvIXOHZWB;_|kgyhbK;0{qd`(Bk6>+Ut@@2%VH-X9f z;mOHQv<~f>tLlxE^;1v~2_Ox)c0SI&bd3kx$I=EBg6@vw+Xlz~@oT zC(Oin-UED&PptQwB_h8o#`=AUYQf9k(BQ;b;88oorB1=DL|5tFQnjn`_^MzIUYnZe z4ByutpKTHJPc#l5Nz@3g2QIA=SwYprHs4Py@fQUX{UPvZj|I>B7YBDj(=Gxwjr?)& zD^L47Jg&LnQIe~XqkZOe$M(1Kns}AG{l=Id%wl<-cIG8h)ZAj`N3G4ksJgi!N*HQ9 z>y6WZ4=>f-J-jYz7PgLxhxMba$ubeIJ;*s^a_B*f{cC|yM_|-CIb5;*l;mKY2f0ad z5ODi6YzaKh2hXldP73cx&Ilh*E(+g)XC9s0r!}^m8!r!!*fMMnA8=FjdiZ!W8F|+p zHn-1N>3JP>k{-S72< zs&#-TD2Z{l+-yOXJxy`-4D*!9Yi<&EK8Q|0URuDkgf}=Ynj39^R~i?-6%7pgAx7V> zb>#KHp`u}fXjigav^ZH5Iu{5d))Za@mmUXBjPca1Ubuf4`qvL$jOQfgx}KrQ?ct=P z34c!>6J^6|92Yi}ZeA94je3XoL?0oynH7E*CE*=wfj5^%+0ir6ab|3ElGz${GF8pJ z(Bn7E%kXPInI%xQq-g|Q zLjPZYKj;q4X%lvgc(iP>uu-%xSv^{rEQOpkZ!{jUXgG9gaB?efS|9#9xfX3*I1rCH zhsW1PCU=Ar;g{zn3qpU-@T`nWxq2W%#SlV2gfddt6u=S{?KRfiWy`px_~el>rP zpWlA~+tk*d?v=qd{t2Fs^zH_CI*B{Sd&RsBW+x)fd??x|bH3?s%3?gOclbO7ZM!To zQN3tYlso!4S}J^Ak6wa5xE(oA2k2XUc(_vG$vP{`M&yl)5!0t7a|0uTSh6=9mE0AM zP}{BRNR9<=Q<70Q2l486@NFCZhU=ax;5$wY+eDXym+L&=126`@5C5&4xCq8ZGi*b5 z#K8fIIj5K%(IuuDw)Il;s(Hc;H{Y1KW|P?g&sNmC5Zd-A^0^VfXN~uaSIQskweo-R zdLS?T$WQpQ{Nw$7@Jl>j-g&{z@CSYTmxBKO&|r}N3p~PF=urg!TNE6qoY?HwLo8~V z*zcbXZk!IRPJ<64W+&mbx_GY&K2tKW%FmNn?C%O@`AdTd@aiM{&w>yAXM&ggTcMvF zf?NEWz=knziC@KM{`I849WiIVSKl8E@BfZB3yS=XcdgDy)Xb}fk(Sq6Y&J;S9>54} zjhu&Tr~iyDGT%f^%(GExb5#^ZC&9brNAAOGh|$~fnmhLZpNqpwqNZUh^zA7TFB?sb zTazpvEd(ciN#=^CLhB|2r-^7&@OTDZ`!$&#JS&Pgb9`iy)#NW~g{LF0IS)BiSHzn; zqIaO56NJr|_}wXpeaoXOpleS=rQrALn-x(zQvwmEg?SQN`>}Z+`Sb#_(&X|2kJ@&% zcN#|GrQSI2UT>54BK**27^73XyLlor=-VX!I3K<47YokOwI8^?@8RGn|E=InUEgI^ zFh-Y$-wiL9E3p(ft&*qXIsp2xs>qKjA&)JcSmzf4h6(tx-N1$CeVrYA=Z}G&v1Zg4 z9<4jHvpvQ@EqDQ9v(&HYe*>@f5 z1)fL0yZO+ZiIG?gzKz#E8jD=~m8hb*Im&BVMVq5a(XWUBKdMIjEif7gKgH|YTn`_| zd4{GK`!&L5h#!qq`$>dV5KqcSdk|B0q3uQ9Z<1AoV==_53SrZzZrD=(tSjQ!U19g= z>9AMyY51Jh-L4CVAs?QqYqeb*?T&gy$Cyu|nr3d)5`OJUQ_DPPx|r9^<6!?VGYfmM z(Gd^_B-$S}28T*SGo#(%7+~~i z#4}9|LSMcdK8!JcXLJ*A>Vkf56L!-1LYpFvGz!m->L5OG4zD(_U_N^~^8c3M`M~s& z=&JDQ=x%5k*E7BW&WsBCM{~oEk>7k96^&-dGjja^kCl2Ws)B7gRdYHe%xxG;Pa*oe z4@Dk>__g_h2~GX+@~;p38@>0%p^~blaD8Z*pgnx{ zm73%4hCaPJ=<7d@vHuD@-P_>7V0hwT&^~gD=i?t83KA1O91wR4Do- z+Kzbr8?R@E+V2(Q)J5uUw;*H-)&Ub_vtcpto9 zpYT5TjEC^I{h|@!tI<#4`_XcIXA&NoXMt-Jt&TcHd!ze-&6`mrGX^o|_vn1X>xQ3b z9x@$)OfTf3AH%i%V*W6@%|6AR^Sl!gVbAe+&3CR5--x{~CVVEy!#?V70Y1LZ`t@@E z1jOp5;Ly3M^YB_C9fLdk>w=z$=a2i32G1hLe_1%a0dM?f@V4-xcF`-dCiFbw)?>kQ zevhCZ@~DU5H|_yvZp8Op?w1PM;`>kamjRm};Tb>j^Z1V=2ff~3=AGqF_Krs$x(i#% z`RYN)p&vu!S`@^9j^7x>JM&Nf4$y5=;< z+C)2}+8ED8qgmk457Dx4D0Jw3tw9(J5Bx^hH+mji;EJsf|JK*29FZy^VN+!Tk>ZG*neh+2R@b>ZPko11`7 zd+>+XxGRpay+0futwns82Q3;8of{Uuf*kTmf)>F1B>y+RhR@^e2K%}E=fIgek$YX_&(;Yqc@3)V zz~&dY%)!{sC$PO-7jdRn!z+vZ*oXaL?fpwL6N)xk$H20tQwzFL5Ke*dhu7R0fpPl= zbiX%p4%T?iM=UrwS`$@_7DMM|BA=gxz8xL?0bjQu9D+RZV{q!dXd*Z<9x;AAa@mQv z{|T@0+Mf%;!O*ZF;L6A-8#-11n3Rp?MfKsGd3-nLKJSh4n-}2g$=zR~=4LH&P_8Si z4u^Rz{3Wk-_7rk~&&_n{+GgYjth+ZvF4xIx0BvifYgT^c-KlFmZNjrW{)ZkMt=9}5 z;bMP|ceB3&I=9X1?}y%J(44XUvAQ<#Z+>-ujb9hJV-r8yKMfo>(=QmDE$ohk1|A!< z_KV=2ukl>tAwIJmSp4bN_80k8b)8nOf%*uTyx{Ng9`x5E_gv<+LGD%0AEV>&lHOb1 za_>oR0%9XM&RpjPAj3LNO?bBaUT)<)wgkB9jA z{7;eNe(VSSJHVIuKi6$P;%@>+R(sd@OT11P17{)MstZhxN8ZV69r8H5rQTDBiM_lp z;G+k4S9ral!`FlFT%+Fr+I$>z&GU>|W43ARjWDyJY7@+3$nS2%zMl_8Kh^ZpSS^Z( zl#H%IuG+~g0!}>3;WzNypGI}yrK%d%CV34n9#6|Nhtgx+jlRAEUgB2Vv)zWrcj5lt zr~p1w#PAqGo>}Ns#1tM!K#qKiJZoxnhFKD|#+c}2BK&4iaJZVe&osrBbucdirMKXw zKgU@5)_ejzX3Qb~IhTkXf)g!_(N`8(T}?2jiE7qQc^!dKH*Xl+++^=TZ?V@8Ug0G# z1WtvKZ+v4fG+qj= zWId0$KVv=D1M#@E3W)hd;mH#I+rXs1=4@vm#_+mKLl9^F4UhIXd;pILzZ}tq>+wzk zHoV4jJ};NI%j`A3Bc4tJKJ*5>jxDdX(-UlBZInDZ2R^$Aq7q~Au~0vbFg|K(Mgy}^(81wRBlA_%zzl`w8-m9B;duUabP~K*6Egw4n2Nud1>eC~ z&ug=7jk;hATxs$`zltNa@b_4oJsZD&F}C9dY)=p1@&q{ZZ;Yca%nba$$jk*c9Anh! z0@$bWh^X~}PYdYxMR;@_;_SWfaE!VAF-|{%g78|S^mB8)N4(#G-e%}tHhL?U|DNVr zO8K9whFTpu$T{%3{&zZtvk~G2TSGi%o?jd9)c~%Q{NeIn^oIGs4+GuW30ADb7+41V zngvXL^zPR>)xr4ve`7nI@h-*|oag-ude#L#rZv1~6Xa`Ey;AVg1wCG)ZU+=$h1q20 z;Q#UFSMwEeyZ6mxdAL6C2|diG<|e$-6k1^gW7Iq#TtAC_&XucGRDEKR=$7(MKDP`^-5-uJH6d1t75tS$WP_4MWduV2Bfyc5U60&Y0xaf1QKvzzh{tz`fWx3)gYY{%*6S6paMm)^8C&nlNa9WLr*#H@zqQBz;-5wzZ>E__B^ z^RTIhe&>6Q(M|!zr=iEs#NV9*#zs zi~=^}z?-RH{(SQ%M%EVm+YR<)o7`RijPmPzC5*3)f!0~b@3@BV67&PFp?nkct_P5N zR9JQNcox^U@Xkk2{~_qd;TYqipo-t&Q{yqhCj+;s@aFXA)6wrd)9_4qLHe!fKzu4< z$YivM_}m11p1CFeeyDc~xY8Zt;07Ri6|&AQK)$2SdUrS2auXPS1$^3t;!b@;o|?MG zYYnfYR|ffLA&;xW1NgTj7_?J5M;)JvNc+86fH67?PT^J@P0 zB|Se6&pQam*G*@9^JT#H3b5lE#22pP;`j3VdqH0x!|y!{Y+eHz1Hm7zVf_N*<{Nl| zAHn*W7*D^N4fubnG%kcg$c}M569y#@tE@$JhSB>^!^9H z_icQ~8~7#q`)9n)_>BuR&%xik1!Ln{?+h@vDPC=aEvb!1HFW;98i+sT!JlKH19`AF z5%y^(_H7;Zkvd1s;H>Zuz=&GH+~Qqm{s5r%65P^L$ORw5xV{JD`%W`hJmNKRi4*f$ z_IW4ZbCIy>uXzf3LEHLE$9Vih7jf=wb0xn0I$`q>xHAaO;B#Hmy)S*^`BpZ+P)=B$Nx+b)M-boN}C9xepBCD!5^J3 ztvd-LyD5~Xx$5_pNA2JtE|BKEgipK5t++D=pBxADCIPvrcxMK-X+9M9Hz?d6W-*Xig{|L&?cb#pROC-C>|s7>IJKgd z@Tr7esev9k5xrF(eRC3e@nps4TY=9#z=zt?8-B`S)Cta@v*P({>hCMj_r&Qc9gp%Z zaCr}Z{Vv)-JRXSG7{lH~qetX?#q5;LTMS8(pwf9iV7u zV+&8mmNtT~u8C1q0qB&1e=DRj7I@INq@j;nhyUq?egj6c5sf%MJPsQ74W6-I=ovo5 ztIUyJ!NV*3demajD0Hw{brq~ z8XnaFT1~*AGo*7h(QCEQ`}H-q(hYsZHH-99J@D>>j!Rsx@FXJEbKt=9;L{6=PnQ6% zOTn$nbzT8t(I43HF?H-kd?Vu+_3Q~~=41GdUihva_)g|HJZm{~&?~?g#vYCp#>F$h zoW>YK%&V(lOqJFdatg@9MbLyjX20U=3gNR3h^zn-OTnQ<>W|^jd|v;WvFIK27ti0q znEe#u!{fk*=M3ltUAhmSx*Pp{7r4N7C;I<({1t0P#O)UM_%6JDk3RRQd|^*{fiL9g zpK#c`g5RJg;IVpx!5tnKX1&`&d6*g4#)TM5e_+ekBZBTQJhE@Ua@0K7GiG?lI}X*s zqsGFgx_2)6qdms$MHsP{fkW3LPTwfM&;mR<8?N|V#EG_Aqum$yJT32ViTa%wy(p}@ z=rP;#c>FA0BPKjY&y)B(|E@Pi!GrjY`+yDCMRj-Fxe~v3DSnq;r46=>-r!Vh7dd_+ z@Tn|(7=Q910_DQq_*zf39ec-G535)UfzeDT2am-dM&AOXFM%5U?FZOu4~8~Jb_FzccAnK(i$?$z@l@@M=U^^ClEOuQKdY(@i{u^0p6 zppp~udy|3B&p>Xba%k2IrhwbC#GjQIPwT~d&S&oshYUCrc+6FcVIRxFEm#hfL$6fw zc;1QDDV=MKk$;NE<=E2&z-NZThq=Z#z=!japJNO&KYSA$qV~K9e5gg7x8&IGg?{dd{_d%K z=?h_VufvAzemw7~HdOws4>0MAzwL+bcow+Of6%M(`x$dsPp3a&?TJ@4_z}4L1YBkS zkp;+2mttF2Vq|TG|Ku7(?n@SMDTt9*3@TR!`&t?M%yCJdO&`}1de1fT#OGqgA>wl? z`p|j>&KKPe1i1#C`D|bL@AHAtg{l+LKRoLi<3C>`M%2PS(zEvZTVl-mEPXt`o4>)B zM{jZg_}d2C&;r|HxlpZ@mb=^ zyowxr226cXac3+zYPF5O$N0x%t(liifh(ASal>3~3AnQw+}Wt>>~MxYQv4~1kyir$ zmjgc4gijgee!M1m3-~40huZ_6j_51qL*0NJYYg4dm$#u$>47=^$%RMIn~$pR>BTyV zN2~!n=^Ez)9#^cn5TCn1e?xqF;5+V+CupI3=UV&*Yiykm^DY2?+F={c#5JZgZfqA5n`8S-(p z(1Uf*+YO*pmP6M-&;tRcRdacE)HMgPOwgp02vWjp)x?&~vw=f7!?P0wa2F_B&$| z*V#S-CK}?C_3;aJfZ7R~BdsrQ zP!3!_4*wU^`uD<`{h>byJh~oMfa$USP#uB%S*7~PB=o|#93EjN{I0G0ydnO4kIZv) z3LDnT`pS2YkZ$#H&EoSFc=eT@QxBg6R`h`U+n0sU_sDm~4h|EtpcS?M6<%mH=pdiJi@AaHVV7;dWdZaZ_y8!(~4$&tN zqifM?H=s{B?r#&1TA|O+RZOB6BL)@=;%2eC5AV}gkaKq^=ClAdXDYwC8rYMctb<+% zmhd8*^!UxO4X0qs8am!sZ*UCQQvh3?7YfJt<01ZpU`-rf0zN z%2)E)GvJVk&m{FFYs&1~=bhi~r+81Ee5K10Jc1r3CXcws#OQIferQkNb5F~&eWUpt z9$U@hK|TOe27xI6Z~qOWZninZ;~EzO^Ag)Qq6 zuPNuDfBOMAP0)Ol&3#z6o~>g=tcPRmZH3dg4e|(ElmXcqkJY#=)v{UVDJLIS3}}=> z&m50lDi0JYqkn41YqQRBk<&WnM66wM>@%+4j8DulBN z*I_JD&*_Wkk7l}B5A*dgK#a$sSsynYIyV&>G{wA+ciESW8@#?W*U`L;o_tw;d9?i4 zi@G1J^$oU>Z)1fga~*mN<~whKkMFvihjXJ=-)8DJ8GkrOHCY^@zOBYqt;M5F_02C<VAFu{j41360iS=;DX`G&fXQu)!`Z(r?oEtkI{l?>i zIL0r-SZAMdeUtSIXNg0%%6p%!xPONlJwz*cJ+_xc5uKkK`` zz;{wZIZtTo1&i>POAW6_GZSo?hq1!#TIO_ZJ&@Ug?PmV7-{F&2@h3mVU?KT~3P7r= z_`~>PJp$|5XDU~<`o^4uF^F@`mrLVLL)S{oRYbtGR$9n5rF8(mGa*koEG;W9L za7!}splRrvDZpj|dS)y}?`Yt|E3Gka{2cENc3Q{0^=-wZA2nxWo7FwGH{AW}dOS`z za-Q~G%^ysWZyyXk5+i!HZ}B^fIjk}LBwzize9IznXQSbH=xlCEZymb&fz>u@_;C)K zD!_*N&KgPsU~@9iIvuaD_C?jrJUwtmh0l*+K( zcLopgbVLBxmkQpTb0fzh{$L)OnRA7XuswHSJa_tD-FPUO*#s&~KXaH8LP zOa6Jh>Z~@_Ow##s8E-xne`WypS*q#q+~7ap_o!{wSFg~T1LmdFww1tVJ+^r(wtbgL z3ZWPu)_;qGMV#xd?DUOuL98RNZ&=f({xe6U=CsE<7XqJ)(WlHI)A%%#&Rs8TT4+u5 zjjGvLjL4lE*5aA9-fX-a|*_a^=@UIcPpkbRSf*0 z|I90O^Oc`c--yvBVYJox>~*Sh&B92X=5ke@Z;)PL6y6yIjE15g8HZS#WBrsI_z1oE zfv}n^kN38kjWP7))HUKrP5cCnocTNhm#^`?^aI4^NBkbO^=FKlnZjo^__IzPa}_Y+ zyrPXivA#uys=(}y$7(X4CgOWtb}i= zpn6Vir)|ui%L|{vPT%r5=jKb{xb|h2;?FLivK@$Q*71Rh(GPQ#r>;={u(mQ@xzK!h zgb|v%o8|ENSsKMyPt76*?};n+KC`{=u=_}U?Pt~4KE-zo!7o{FFk9Z>J0QXFKu>M? zvr_Sg^B){P%uiV}Myb&;x~4)2e`ei0h@SC6Gg>C>B*$|Fv?p z?ep+%2lU{D!l;qz+?~abCYm3Jo8?YpVZ(I|)JF1$IcNvrQ(G~I^R_L4#2Lb;s@A#D zr_{!F)WBG&B;R%nw5_me*M+q5fbk~~f3mSpoZaFaB>m88>@)KU=0OXchnwNz&}7xL zSu_1rb#3OX!_c41Q-(N=V}F0_Ji|v$$JjnnjG7{jQP&1Z+op+oLmf8s?VN}ER{FM3 z<6)BUS&nyC;MLXg2gGNka-Z#*8`%w2kBy zstF&)BKlt9!!h4Z`qWVCH#)kw)LD6q)v+#me2Q@CEM03XkKWPM2$)l~PsJQNmq6b} z-*|E==P4_FtEzeJ63Tm+uW{`T&wa!ScHsQ=e(V{q*F!B|FOR*|VYETxmAcP*g5{E} z`%IA5(Jw629MLGpsbSK+nTqv8T>C=&upAjGZ_YML{2K;5M#vM+6E5TpV-M?XjCoVB zCBFa-YV87ym*3mx@%ioKA?k}47dZVp|Da}LPCJK7nme_W?=%xWRpsxwX2s?`W$>$|l$Vy3 zKRCwugM6;SWAjta1MLMyjI&#W(RSq*F-EMJ&XZSIsr;RFg-P-YmQUZKPrq}zHxm6# z9*_?_536nVF=Nay-Op0~Ia2Xvj?=RR`W}l7YXyrnmp#qR$x&-rcUpq+LXSy&m=A0O zKJ+&GbcU+fX9t=eE}}fOplaD%`&-Fr9M3aG{jVn;RZvZieaG5qbM$2kS6^W4I8XCM zbrqM0&-rQ%l-FLM#{9c^B6WhtI&!X?v3G^5$1QeiuVw+Y>4(5)tm4wInuo~b(s1!G>SJ#+uDYab~VC{Z8{c3#4fi){HBL)7?+(z)U;A1adrANC*n@htROOL;EKp*GUHy27Y^3ZsT<9W>Wg-*K#t zw6V3?iTL}P!kKkG)~n;#(?~Tp>km$F`c_f%K33o8;fjbqx!o+Pr*&}qRm-+S>{Sl4^-P30A;$Nu{{bsnvre0f{pX0PIP@d>lC?`}lf`I()}MYYoaPFvQR2%ShshkxSCcp2;&b1*zvG(S@v2iS)w~mP zQfldJ`L@-n>)6<{N!zs++sJtla%Yd+fz>w7Ia+^^M>*C=1*zWdaSlp*SbZ^pZf9$<-NwLD^${2&gNRDP+hTu zI(N3_)J{~qZ=-wL;>R&(&Jk};l)q>$KV4n8aE$@K+s2*p&bO6uxlaj=n=+c4E3ED1 z+Jn4ePQv-?P{*E;JDc4+LyQmSC|Sp6PRQJlbC+?whkZCvWBymo;fXZ_h~8~RaM`fB`;S)xoazVg)|N^ z7UWq=#TnaTFF>Dhnrb+e#TgrO%DI?hJzHhvrN=7nFh?uyYHv2~*z58tm0P)~okOLT$NE-Ia}C85e;Aiz z|7JBVGX~LTv!89BpPk~7^$h2@dy7pie13K@XI83Kutv37YT63T_iU3d*d%QBNZ0nuRhv}(IZ zuCwC)bKPGB9n)ZIr6;OhT1GiY{S-bn4pEbuxm@T>mk+gcJZa@{YN_~AGsT^=giQ_o z4Qu14y7dM8&W7Sn1?gHXamTK8s~~)eswT?qEGliw>uNhz+d_xWE{6|~fo6?|_^fd2 z73rBchUstTDo?c-P0taFtWO{p#>>-L9$CB=DfY*W?@w@ze=|w*JIln$UzF>taCNpn zH8z&HS`PCuZr29oq`RfZv8T4^c&hj^tF!Z``Q%kgxf%ksq>?ZyDSfG#;!s&&R9@q} ziE2KTQaaa6o}s#0bKzA}IGm~H)m@CKE^l#KiZ`)OBX25b4Af5LI>%{@RK#|$CKzMG z?JVp(bsj|?TN{mpPg4BZsoZC;<{8#12C;@<^B=2o>y*FGa~RE3J>d`G^t1HNVl`Q9 ziQ>~F-P^~L)s{#Te^OmwnQ9T!rDrR|nK_ytT_a6hEI+-$`L)fOH(aZF+b-1%wx@hs z8liOU&2or&#IY{_p~lg}vW`&E%?nwrE2TLy%crvP3=N!bXe4e`kbhvGH+C4F?C$ye zBz>;DKF?!cd3+^n)3sEerVp?_jq!%KFb^$_?XWSYkn(4ar9$!rxs)4Zx!N0VNzDNz zwXfD+@6npS^@>Fnrxlu0-K4tLZ{pKBY2E_WP**E|jN{V`R|jJICF3!%oZ+-WRh2 za;d7rh<#X7x>s6pf@8j(w9jH?TY1+iq#EL2Qh^>Z7gckD-w@dfJJ7^79{ zceYus5wrATi^*Kqhzt4nt1wwB+?To90JU`$wuWmV)=G1CDi__Vx$J!on@}r4ObQ)e zM4xMpns1Smn=@U-|M6>DCb)I`tfQp zF65!brj)+ZYFP>WUODHZOG(qLCn)N4Esi^R9Cu=TIP$Vpd$S&4hpX>wR*t$;v6!A| zrP>y)UtA_0*}7aNmn@(D6c-j`U>Eaaf!?=`TFDl3g*6-Ull8t8s@-gn7qDJ!hcuVt zhHE5txb+5mbwmmIlSU{Z|CZ4F7RO^@)pzn~y@jnK6jCiNt#!vr>nb_#K&+~%Z%YZU z6I`pAabGjzIkoWweYTW%$oz_Hxya9$FZ5{qy;7RrDX1Kj-lYi8Ajhf27MDZ{8SYW+ z4fbmOXP@@n@@IF-$7OP8rN%Y;aHC@O67}tR#fe{qkHus`3ZMA-niN(Gq+@FxXVwAV z4Gy0T`p(~-rma%E*{a{)AbhMR;P!D0?RMIhtr@wT_^>LUTO6`6sBp?FSg&2m#iBCO zyL3Eat1Qi94TyPc32~sh^Aj}=z|87bx>b{wl~k=Wt!KxIug9k_D(L(`LGha7hvUe4 z>MS>-ZEwUUI~9AfH71GC7B`o=(P2dGUn9MVG1{!$Xu0dxrNU{QeDI2}S=`xewz^u*F6BJg+U{fqKHRS?hfiMdCzr4( zqC6|B{KLFw^FKQR&%YY-Y+3M!Y54O!~N#|Z+9_>ImQOZA?nN;%{gS^Wc7%;w9Ij8 zSq5eYH~ZdlY1u|${D-{RCh>(n#A@2M6mP6o+a+wayVyhS>~Y!_W_SaOkC&luwgz{g z##s&(md>#cnZK8FdK6<+SZmh`*1(^rabmu^~2T-4#gP#nbJCo5&M)l{UPrVw~dEs7RTRRd|9c# zx8Fr>S|7mQ*{N7VTsCLune_zO+D=y5IJVNrc+zc-zT7T9Eg)^rtJr&t#%uxgPmB#? z^l{QS%b~Ikqw=nwZC@8l>0X5#?O5TE*~(_{h2L3Pv8IsYOhNsAQOz6V)tD)uxRYDk zn%nUv$ly+9{K@3cb{B`JCz<$IowIo>$M|Zsm`hvazyAEZ_m)#DU5sCyYMHof)!)ZDw%+;YP0mB-^l53{SZqS&J5dHU zobSnU*l>UIYHmBX#%PRBQRlPSS20EDYV_0-gD>kX`b+wJh#;q;C8Y)yGNi&2_O7NfNp zoQiq1#y$Si;SfJxn`+zj_Zw1t*^zSA<^Rg70=D|tY(IHsS++_2h})~}-CYCeaFtqBx#TE=aPW6hDU;r=Ca z;6r^&3ZtD)>$j_=af-3poPn3cY?o>c8yt2U92er(Ho6vne)9qP#qZzlxUxfBNn>I; zW9tJ+X^DI!elZ)WP)fw&~Jta&1#+1p}5~;9@w_s zwe)Kn%?^jpPKQm}k8KlI=$T`_*qY65mwWDWnwHeePEOu~E!GzvYY7GF!I^6lD@(Oqw&i8TlP!LWfVb zi#vOrH;DCZr#yD-vk&CYt{mLixk^v54`A`4V#`_GPy1IRKYzhf8SU zTY7(DUCZSWm^Tt0w z(X7wO#Ad(a&tAu$Jt+>w`0P!!Z6?j7G@o{*TC7)@cw}-e{<|2P_&P)5t_ z>msgYKDN*EWHjm}u_orZQZ2vyJjVq2OCHmw*m+#8F3fT*aAV7^`iN19+`mwfHmR}6 zaY`Mbp4hfW`oh@EF}*hxi*{ykDYI=q;*i*6;uEI+W#V%vjCQ9m%50foEscw9dtL0?m%@geHfo`( z3q%=vk;W$zBg>#Hr)zPGJwhf%N5bh)&AuONQRJFV-jT&4Ej-uNIr^3~a)~@+U}Pljcw&L*;T}lqba}+iYAo z5U-rAz(KFYf0vb`*%%k&Vq0!uV{@<=AFISU@v%3Hk-bGGt#CH>u%+>_ZJ$Z|?M&a0 zv+d8oF8cud4*YB~g-eXdK8MMHxTIsvfxOAY=V1Qi#3*qHjIwfIloPAJ+R~oG<}fiH zaf>m@#3jv}gRwanqcn>m$DtUboNa$bv;CP&wY?^@zmo^NADTm9a3B_GJkpqC;u0N% zOXe*TBR|EaL`KVrm2I)FJ5U3U)-wA)CpU6paUf5Qj7j=tGHyBfljhLD80F;D!TdT9 zkDSl<=V&o5aePU~n55IOe~Qh4Iv4-TI-ups(Xw2N@k$)F<@~!eCRu8km>ixfN5Uo( zoj3}GDgGRc(~)@ePujt_iFKKMT1KOdmIsDB(=wFc0GO@{t(c!psq;@D=4%D)o z{5cdZN9GT2CdVx@nOw?jhvL;gZ8g(4;}aaz4*f6PqeuUDXk6oF{~hX= z506V4n?vnwS~U*El)uK7qa%>B9q!+Ox1(W_c{|izrxpHCJr=9Yk$e2$-aqs|`;7R|zJTA6{hi!2c?yt3@VRL8&OSgmZIr8oBnB;7U9PLn1;jgvBVSQ+Hj*d%wI~qPm z#^~_4{hf9+JmT9Ccf{R}%$LLAa`YBgCJ%n^NI3nIsFL$`WNrJOVs&`@4)^_kJ+kDy z{Z(B4Cm8*ecBtR^r`W`|zl+g7!Rct<_fK)*?f+L?4#%CpgVCY-#XnlUPcC_#RyO%;#< y`%m4D)_4D@_J8Ykw0`}k?f;kC(faxSW#9kz_TSroZ~wjh_x9i0e{cWE+y4P&M;jpk diff --git a/emacs/dot-emacs b/emacs/dot-emacs deleted file mode 100644 index aa075e7..0000000 --- a/emacs/dot-emacs +++ /dev/null @@ -1,71 +0,0 @@ -;; .emacs of Sridhar Ratnakumar -;; KISS (Keep It Simple Stupid) - -(let* ((dotfiles "~/Projects/srid.dotfiles/") - (emacsdir (concat dotfiles "emacs/")) - (extdir (concat emacsdir "external/")) - (partsdir (concat emacsdir "dot-emacs-parts/")) - (datadir (concat emacsdir "data"))) - - (defun load-part (part) - (load (concat partsdir part))) - - ;; Load paths - (add-to-list 'load-path extdir) - - (load-part "personal.el") - (load-part "basic.el") - (load-part "look-and-feel.el") - (load-part "buffer-switching.el") - ;; (load-part "terminal-enhancements.el") -- XXX: mouse scrolling doesn't work in putty - (load-part "dotnet.el") - (load-part "git-part.el") - - (load-part "lang-js.el") - (load-part "lang-fsharp.el") - (load-part "lang-vb.el") - - ; (load-part "org-initialize.el") - (load-part "goodies.el") - - (load-part "irc-setup.el") - - (server-start)) - - -(custom-set-variables - ;; custom-set-variables was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right. - '(backup-by-copying-when-linked t) - '(browse-url-browser-function (quote browse-url-generic)) - '(browse-url-generic-program "C:\\Program Files\\Internet Explorer\\ieuser.exe") - '(column-number-mode t) - '(global-font-lock-mode t nil (font-lock)) - '(gnuserv-frame (quote gnuserv-main-frame-function)) - '(hfy-optimisations (quote (skip-refontification keep-overlays))) - '(inhibit-splash-screen t) - '(javascript-indent-level 2) - '(line-number-mode t) - '(menu-bar-mode nil) - '(rcirc-auto-authenticate-flag t) - '(rcirc-default-nick "srid") - '(rcirc-default-user-name "srid") - '(rcirc-server-alist (quote (("irc.freenode.net" nick "srid" user-name "srid" full-name "Sridhar Ratnakumar" channels nil :channels ("#emacs" "#gnusim8085" "#ubuntu-in" "#haskell" "#git" "#comparewise" "#django-india" "#srid-interest" "#ilugchennai"))))) - '(rcirc-track-minor-mode t) - '(scroll-bar-mode nil) - '(show-paren-mode t) - '(tab-width 4) - '(tool-bar-mode nil nil (tool-bar)) - '(transient-mark-mode t) - '(visible-bell t)) - -(custom-set-faces - ;; custom-set-faces was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right. - ) - -(put 'downcase-region 'disabled nil) diff --git a/emacs/dot-emacs-parts/basic.el b/emacs/dot-emacs-parts/basic.el deleted file mode 100644 index 1022ed0..0000000 --- a/emacs/dot-emacs-parts/basic.el +++ /dev/null @@ -1,7 +0,0 @@ - -;; Default settings -(setq inhibit-startup-message t) -(setq backup-inhibited t) -(fset 'yes-or-no-p 'y-or-n-p) -(set-default 'fill-column 80) -(setq frame-title-format "emacs") diff --git a/emacs/dot-emacs-parts/buffer-switching.el b/emacs/dot-emacs-parts/buffer-switching.el deleted file mode 100644 index d97d166..0000000 --- a/emacs/dot-emacs-parts/buffer-switching.el +++ /dev/null @@ -1,8 +0,0 @@ -;; Buffer switching -(require 'ido) -(ido-mode t) -(setq ido-enable-flex-matching t) - -(global-set-key (kbd "") 'ido-switch-buffer) -(global-set-key (kbd "") 'ido-switch-buffer) ;; for gnome-terminal fullscreen conflict - diff --git a/emacs/dot-emacs-parts/dotnet.el b/emacs/dot-emacs-parts/dotnet.el deleted file mode 100644 index cb657bb..0000000 --- a/emacs/dot-emacs-parts/dotnet.el +++ /dev/null @@ -1,3 +0,0 @@ -;; dotnet and related loading - -(autoload 'powershell "powershell" "Run powershell as a shell within emacs." t) \ No newline at end of file diff --git a/emacs/dot-emacs-parts/git-part.el b/emacs/dot-emacs-parts/git-part.el deleted file mode 100644 index e72d49d..0000000 --- a/emacs/dot-emacs-parts/git-part.el +++ /dev/null @@ -1,2 +0,0 @@ -(add-to-list 'load-path (concat extdir "git-contrib-emacs")) -(require 'git) diff --git a/emacs/dot-emacs-parts/goodies.el b/emacs/dot-emacs-parts/goodies.el deleted file mode 100644 index a8da887..0000000 --- a/emacs/dot-emacs-parts/goodies.el +++ /dev/null @@ -1,4 +0,0 @@ -(require 'twit "twit") - -(require 'tramp) -(setq tramp-default-method "plink") diff --git a/emacs/dot-emacs-parts/irc-setup.el b/emacs/dot-emacs-parts/irc-setup.el deleted file mode 100644 index d4283f8..0000000 --- a/emacs/dot-emacs-parts/irc-setup.el +++ /dev/null @@ -1,39 +0,0 @@ -;; ----- -;; irc -;; ----- -(load "~/.freenode.el") -(setq rcirc-authinfo - (list (list "freenode" 'nickserv "srid" passwd) - (list "oftc" 'nickserv "srid" passwd) - (list "bitlbee" 'bitlbee "srid" passwd))) - -(defun im () - (interactive) - (rcirc-connect "im.bitlbee.org" 6667 - "srid" "srid" "Sridhar Ratnakumar")) - -(defun switch-to-im () - (interactive) - (let ((im-buffer (get-buffer "&bitlbee@im.bitlbee.org"))) - (when im-buffer - (switch-to-buffer im-buffer) - (rcirc-cmd-names "&bitlbee")))) -(global-set-key (kbd "C-") 'switch-to-im) - -(defun irc-count-nicks () - (interactive) - (message - (format "%d" - (length (rcirc-channel-nicks - (rcirc-buffer-process) - rcirc-target))))) - -(setq notify-wav (concat datadir "notify.wav")) - -(defun rcirc-alert (p sender resp target txt) - (when (and (string-match (rcirc-nick p) txt) - (not (string= (rcirc-nick p) sender)) - (not (string= (rcirc-server-name p) sender))) - (play-sound-file notify-wav))) - -; (add-hook 'rcirc-print-hooks 'rcirc-alert) diff --git a/emacs/dot-emacs-parts/lang-fsharp.el b/emacs/dot-emacs-parts/lang-fsharp.el deleted file mode 100644 index a97b30a..0000000 --- a/emacs/dot-emacs-parts/lang-fsharp.el +++ /dev/null @@ -1,39 +0,0 @@ -;; Tuareg mode for F# -; -(add-to-list 'load-path (concat extdir "tuareg")) - -(require 'tuareg) -(setq auto-mode-alist (cons '("\\.fs\\w?" . tuareg-mode) auto-mode-alist)) - -(add-hook 'tuareg-mode-hook - '(lambda () - (set (make-local-variable 'compile-command) - (concat "fsc \"" - (file-name-nondirectory buffer-file-name) - "\"")))) - -(defadvice tuareg-find-alternate-file (around fsharp-find-alternate-file) - "Switch Implementation/Interface." - (interactive) - (let ((name (buffer-file-name))) - (if (string-match "\\`\\(.*\\)\\.fs\\(i\\)?\\'" name) - (find-file (concat (tuareg-match-string 1 name) - (if (match-beginning 2) ".fs" ".fsi")))))) - -(defvar tuareg-interactive-program "fsi" - "*Default program name for invoking a FSharp toplevel from Emacs.") - -(defconst tuareg-error-regexp-fs - "^\\([^(\n]+\\)(\\([0-9]+\\),\\([0-9]+\\)):" - "Regular expression matching the error messages produced by fsc.") - -(add-hook 'tuareg-mode-hook - '(lambda () - (ad-activate 'tuareg-find-alternate-file) - (setq tuareg-interactive-program "fsi") - (if (boundp 'compilation-error-regexp-alist) - (or (assoc tuareg-error-regexp-fs - compilation-error-regexp-alist) - (setq compilation-error-regexp-alist - (cons (list tuareg-error-regexp-fs 1 2 3) - compilation-error-regexp-alist)))))) diff --git a/emacs/dot-emacs-parts/lang-js.el b/emacs/dot-emacs-parts/lang-js.el deleted file mode 100644 index f09b0f8..0000000 --- a/emacs/dot-emacs-parts/lang-js.el +++ /dev/null @@ -1,4 +0,0 @@ - -;; Steve Yegge's excellent Javascript mnode -(add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode)) -(autoload 'javascript-mode "javascript" nil t) diff --git a/emacs/dot-emacs-parts/lang-vb.el b/emacs/dot-emacs-parts/lang-vb.el deleted file mode 100644 index f54dbe4..0000000 --- a/emacs/dot-emacs-parts/lang-vb.el +++ /dev/null @@ -1,5 +0,0 @@ -;; vbscript mode from http://www.emacswiki.org/cgi-bin/wiki/visual-basic-mode.el - -(autoload 'visual-basic-mode "visual-basic-mode" "Visual Basic mode." t) -(setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\|vbs\\)$" . - visual-basic-mode)) auto-mode-alist)) diff --git a/emacs/dot-emacs-parts/look-and-feel.el b/emacs/dot-emacs-parts/look-and-feel.el deleted file mode 100644 index 655e3b9..0000000 --- a/emacs/dot-emacs-parts/look-and-feel.el +++ /dev/null @@ -1,12 +0,0 @@ - -;; Consolas font by Microsoft (on Windows) - -(setq font-consolas-pt9 - (concat "-outline-Consolas-normal-r-normal-normal" - "-12-90-96-96-c-*-iso8859-1")) -(if (equal system-type 'windows-nt) - (set-face-font 'default font-consolas-pt9)) - -(require 'color-theme) -(load "color-theme-library.el") -(color-theme-jsc-dark) diff --git a/emacs/dot-emacs-parts/org-initialize.el b/emacs/dot-emacs-parts/org-initialize.el deleted file mode 100644 index 3827636..0000000 --- a/emacs/dot-emacs-parts/org-initialize.el +++ /dev/null @@ -1,7 +0,0 @@ - -;; org -(require 'org-install) -(add-to-list 'auto-mode-alist '("\\.org$" . org-mode)) -(setq org-log-done t) -(global-set-key (kbd "C-c C-g") 'org-agenda-list) -(setq org-agenda-files (directory-files "~/org/" t ".*\\.org$")) diff --git a/emacs/dot-emacs-parts/personal.el b/emacs/dot-emacs-parts/personal.el deleted file mode 100644 index 21d960c..0000000 --- a/emacs/dot-emacs-parts/personal.el +++ /dev/null @@ -1,3 +0,0 @@ - -(setq user-full-name "Sridhar Ratnakumar") -(setq user-mail-address "sridhar.ratna@gmail.com") diff --git a/emacs/dot-emacs-parts/terminal-enhancements.el b/emacs/dot-emacs-parts/terminal-enhancements.el deleted file mode 100644 index f3ff4de..0000000 --- a/emacs/dot-emacs-parts/terminal-enhancements.el +++ /dev/null @@ -1,11 +0,0 @@ - -;; mouse wheell -(mwheel-install) -(xterm-mouse-mode 1) -(mouse-wheel-mode 1) -(global-set-key [mouse-4] '(lambda () - (interactive) - (scroll-down 1))) -(global-set-key [mouse-5] '(lambda () - (interactive) - (scroll-up 1))) diff --git a/emacs/external/color-theme-eon.el b/emacs/external/color-theme-eon.el deleted file mode 100644 index d09e81f..0000000 --- a/emacs/external/color-theme-eon.el +++ /dev/null @@ -1,1411 +0,0 @@ -;;; color-theme-eon.el --- dto's custom color theme - -;; Copyright (C) 2007 David O'Toole - -;; Author: David O'Toole -;; Version: $Id: color-theme-eon.el,v 1.4 2007/09/13 19:50:08 dto Exp dto $ -;; Keywords: faces - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This is what emerged from my twenty-or-so attempts at desinging the -;; ultimate DTO color theme . It's relatively low-contrast so it's -;; easy on my eyes. I tend to use bright LCD displays, so some people -;; may find it too dark. It has faces for all the programs I use or -;; write, which you can rip out and paste into your own themes: -;; org-mode, eev-mode, linkd-mode, cell-mode, gnus, rcirc, csound-x, -;; and so on. - -;; Please help me improve this theme by contributing changes to groups -;; of faces that haven't yet been made consistent with this color -;; theme. - -;;; Code: - -(defun color-theme-eon () - "Color theme by David O'Toole, created 2005-08-12." - (interactive) - (color-theme-install - '(color-theme-eon - ((background-color . "gray20") - (background-mode . dark) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "Grey") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cua-global-mark-cursor-color . "cyan") - (cua-normal-cursor-color . "black") - (cua-overwrite-cursor-color . "chartreuse") - (cua-read-only-cursor-color . "darkgreen") - (cursor-color . "magenta") - (ebnf-except-border-color . "Black") - (ebnf-line-color . "Black") - (ebnf-non-terminal-border-color . "Black") - (ebnf-repeat-border-color . "Black") - (ebnf-special-border-color . "Black") - (ebnf-terminal-border-color . "Black") - (foreground-color . "gray80") - (howm-use-color . t) - (mouse-color . "Grey") - (ps-line-number-color . "black") - (ps-zebra-color . 0.95) - (senator-eldoc-use-color . t) - (term-default-bg-color . unspecified) - (term-default-fg-color . unspecified) - (top-toolbar-shadow-color . "#fffffbeeffff") - (vc-annotate-very-old-color . "#0046FF") - (viper-saved-cursor-color-in-replace-mode . "Red3") - (whitespace-display-spaces-in-color . t)) - ((Man-overstrike-face . bold) - (Man-reverse-face . highlight) - (Man-underline-face . underline) - (align-highlight-change-face . highlight) - (align-highlight-nochange-face . secondary-selection) - (apropos-keybinding-face . underline) - (apropos-label-face . italic) - (apropos-match-face . match) - (apropos-property-face . bold-italic) - (apropos-symbol-face . bold) - (compilation-message-face . underline) - (cperl-here-face . font-lock-string-face) - (cperl-invalid-face . underline) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (delphi-comment-face . font-lock-comment-face) - (delphi-keyword-face . font-lock-keyword-face) - (delphi-string-face . font-lock-string-face) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-mouse-face . highlight) - (gnus-signature-face . gnus-signature) - (gnus-summary-selected-face . gnus-summary-selected) - (gnus-treat-display-face . head) - (gnus-treat-display-x-face . head) - (idlwave-class-arrow-face . bold) - (info-lookup-highlight-face . match) - (kk-HTML-background-color . "white") - (list-matching-lines-buffer-name-face . bold) - (list-matching-lines-face . bold) - (rmail-highlight-face . rmail-highlight) - (scomx-main-selection-color :weight bold :background "yellow") - (scomx-selection-color . "yellow") - (term-default-bg-color . unspecified) - (term-default-fg-color . unspecified) - (vc-annotate-very-old-color . "#0046FF") - (view-highlight-face . highlight) - (w3m-form-mouse-face . highlight) - (widget-mouse-face . highlight)) - ;; DEFAULT FACE - (default ((t (:stipple nil :background "gray20" :foreground "gray80" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 98 :width semi-condensed :family "misc-fixed")))) - (Buffer-menu-buffer-face ((t (nil)))) - (action-lock-face ((t (:background "gray40" :foreground "yellow")))) - (antlr-default ((t (nil)))) - (antlr-font-lock-keyword-face ((t (nil)))) - (antlr-font-lock-literal-face ((t (nil)))) - (antlr-font-lock-ruledef-face ((t (nil)))) - (antlr-font-lock-ruleref-face ((t (nil)))) - (antlr-font-lock-tokendef-face ((t (nil)))) - (antlr-font-lock-tokenref-face ((t (nil)))) - (antlr-keyword ((t (nil)))) - (antlr-literal ((t (nil)))) - (antlr-ruledef ((t (nil)))) - (antlr-ruleref ((t (nil)))) - (antlr-syntax ((t (nil)))) - (antlr-tokendef ((t (nil)))) - (antlr-tokenref ((t (nil)))) - (apt-utils-broken ((t (nil)))) - (apt-utils-broken-face ((t (nil)))) - (apt-utils-description ((t (nil)))) - (apt-utils-description-face ((t (nil)))) - (apt-utils-field-contents ((t (nil)))) - (apt-utils-field-contents-face ((t (nil)))) - (apt-utils-field-keyword ((t (nil)))) - (apt-utils-field-keyword-face ((t (nil)))) - (apt-utils-normal-package ((t (nil)))) - (apt-utils-normal-package-face ((t (nil)))) - (apt-utils-summary ((t (nil)))) - (apt-utils-summary-face ((t (nil)))) - (apt-utils-version ((t (nil)))) - (apt-utils-version-face ((t (nil)))) - (apt-utils-virtual-package ((t (nil)))) - (apt-utils-virtual-package-face ((t (nil)))) - (bbdb-company ((t (nil)))) - (bbdb-field-name ((t (nil)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (nil)))) - (bg:erc-color-face0 ((t (nil)))) - (bg:erc-color-face1 ((t (nil)))) - (bg:erc-color-face10 ((t (nil)))) - (bg:erc-color-face11 ((t (nil)))) - (bg:erc-color-face12 ((t (nil)))) - (bg:erc-color-face13 ((t (nil)))) - (bg:erc-color-face14 ((t (nil)))) - (bg:erc-color-face15 ((t (nil)))) - (bg:erc-color-face2 ((t (nil)))) - (bg:erc-color-face3 ((t (nil)))) - (bg:erc-color-face4 ((t (nil)))) - (bg:erc-color-face5 ((t (nil)))) - (bg:erc-color-face6 ((t (nil)))) - (bg:erc-color-face7 ((t (nil)))) - (bg:erc-color-face8 ((t (nil)))) - (bg:erc-color-face9 ((t (nil)))) - (blank-space-face ((t (:background "LightGray")))) - (blank-tab-face ((t (:background "Wheat")))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:bold t :foreground "beige" :weight bold)))) - (border ((t (:background "Grey")))) - (border-glyph ((t (nil)))) - (breakpoint-disabled-bitmap ((t (nil)))) - (breakpoint-disabled-bitmap-face ((t (nil)))) - (breakpoint-enabled-bitmap ((t (nil)))) - (breakpoint-enabled-bitmap-face ((t (nil)))) - (buffer-menu-buffer ((t (nil)))) - (buffers-tab ((t (:background "gray30" :foreground "LightSkyBlue")))) - (button ((t (nil)))) - (calendar-today ((t (:underline t)))) - (cell-action-face ((t (:bold t :background "red" :foreground "yellow" :weight bold)))) - (cell-axis-face ((t (:background "gray25" :foreground "gray45" :box (:line-width 1 :color "gray35"))))) - (cell-axis-odd-face ((t (:background "gray23" :foreground "gray42" :box (:line-width 1 :color "gray34"))))) - (cell-bang-face ((t (:bold t :background "red" :foreground "cyan" :weight bold)))) - (cell-blank-face ((t (:background "gray20" :foreground "white" :box (:line-width 1 :color "gray35"))))) - (cell-blank-odd-face ((t (:background "gray18" :foreground "gray99" :box (:line-width 1 :color "gray34"))))) - (cell-comment-face ((t (:italic t :foreground "white" :slant italic)))) - (cell-compute-cursor-face ((t (:box (:line-width 1 :color "purple"))))) - (cell-cursor-face ((t (:background "yellow" :foreground "black" :box nil)))) - (cell-default-face ((t (:foreground "white")))) - (cell-elisp-face ((t (:background "OliveDrab" :foreground "white")))) - (cell-file-face ((t (:foreground "yellowgreen")))) - (cell-keyword-face ((t (:background "DarkOrchid4" :foreground "white" :box (:line-width 1 :color "gray35"))))) - (cell-lisp-face ((t (:background "white" :foreground "gray50")))) - (cell-print-face ((t (:background "gray40" :foreground "gray80")))) - (cell-receive-var-face ((t (:background "mediumblue" :foreground "white")))) - (cell-selection-face ((t (:background "seagreen" :foreground "cyan")))) - (cell-send-var-face ((t (:background "mediumblue" :foreground "white")))) - (cell-subr-face ((t (:background "white" :foreground "gray40")))) - (cell-text-face ((t (:foreground "yellow")))) - (cell-wiki-face ((t (:background "darkslateblue" :foreground "white")))) - (change-log-acknowledgement ((t (nil)))) - (change-log-acknowledgement-face ((t (nil)))) - (change-log-conditionals ((t (nil)))) - (change-log-conditionals-face ((t (nil)))) - (change-log-date ((t (nil)))) - (change-log-date-face ((t (nil)))) - (change-log-email ((t (nil)))) - (change-log-email-face ((t (nil)))) - (change-log-file ((t (nil)))) - (change-log-file-face ((t (nil)))) - (change-log-function ((t (nil)))) - (change-log-function-face ((t (nil)))) - (change-log-list ((t (nil)))) - (change-log-list-face ((t (nil)))) - (change-log-name ((t (nil)))) - (change-log-name-face ((t (nil)))) - (chess-display-black-face ((t (nil)))) - (chess-display-white-face ((t (nil)))) - (circe-highlight-nick-face ((t (nil)))) - (circe-my-message-face ((t (nil)))) - (circe-originator-face ((t (nil)))) - (circe-prompt-face ((t (nil)))) - (circe-server-face ((t (nil)))) - (cmode-bracket-face ((t (nil)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:bold t :foreground "white" :weight bold)))) - (comint-input-face ((t (:foreground "deepskyblue")))) - (compilation-column-number ((t (:underline t :foreground "gold")))) - (compilation-error ((t (:underline "red")))) - (compilation-info ((t (:bold t :foreground "Green1" :weight bold)))) - (compilation-info-face ((t (:bold t :foreground "Green" :weight bold)))) - (compilation-line-number ((t (:foreground "gold")))) - (compilation-warning ((t (:bold t :foreground "Orange" :weight bold)))) - (compilation-warning-face ((t (:bold t :foreground "Orange" :weight bold)))) - (completions-common-part ((t (nil)))) - (completions-first-difference ((t (nil)))) - (cperl-array-face ((t (:bold t :foreground "light salmon" :weight bold)))) - (cperl-hash-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) - (cperl-here-face ((t (nil)))) - (cperl-invalid-face ((t (:foreground "white")))) - (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) - (cperl-pod-face ((t (nil)))) - (cperl-pod-head-face ((t (nil)))) - - (cscsd-speedbar-main-section ((t (:bold t :foreground "cyan" :weight bold)))) - (cscsd-speedbar-subsection ((t (:foreground "orange" :underline t)))) - (csound-0-opcode-face ((t (:foreground "yellow" :background "red")))) - (csound-arate-face ((t (:foreground "yellow" :background "chartreuse4")))) - (csound-comment-face ((t (:background "gray29" :foreground "gray60")))) - (csound-decls-face ((t (:foreground "yellow" :underline t)))) - (csound-define-face ((t (:bold t :foreground "red" :underline nil :weight bold)))) - (csound-equals-face ((t (:foreground "yellow" :background "red" )))) - (csound-flow-face ((t (:bold t :foreground "blue" :underline nil :weight bold)))) - (csound-frate-face ((t (:foreground "MediumBlue" :underline nil :weight normal)))) - (csound-funcs-face ((t (:foreground "magenta")))) - (csound-globs-face ((t (:foreground "pink" :background "purple" :underline "cyan" :weight normal)))) - (csound-i0-face ((t (:background "gray99" :foreground "Violet" :weight normal)))) - (csound-i1-face ((t (:foreground "Sienna" :weight normal)))) - (csound-i2-face ((t (:background "gray91" :foreground "DarkSlateBlue" :weight normal)))) - (csound-i3-face ((t (:background "gray92" :foreground "SteelBlue" :weight normal)))) - (csound-i4-face ((t (:background "gray93" :foreground "Brown" :weight normal)))) - (csound-i5-face ((t (:background "gray94" :foreground "DarkOliveGreen" :weight normal)))) - (csound-i6-face ((t (:background "gray95" :foreground "MediumSeaGreen" :weight normal)))) - (csound-i7-face ((t (:background "gray96" :foreground "Maroon" :weight normal)))) - (csound-i8-face ((t (:background "gray97" :foreground "Plum" :weight normal)))) - (csound-i9-face ((t (:background "gray98" :foreground "OrangeRed" :weight normal)))) - (csound-inout-face ((t (:foreground "yellow" :background "red")))) - (csound-irate-face ((t (:foreground "yellow" :background "darkolivegreen4")))) - (csound-krate-face ((t (:foreground "yellow" :background "olivedrab4")))) - (csound-label-face ((t (:foreground "red" :underline t :weight normal)))) - (csound-opcode-face ((t (:foreground "cyan" :background "midnightblue")))) - (csound-section-face ((t (:bold t :foreground "Sienna" :weight bold)))) - (csound-string-face ((t (:foreground "magenta" :underline nil :weight normal)))) - (csound-table-face ((t (:foreground "yellow")))) - (csound-tableno-face ((t (:bold t :foreground "red" :weight bold)))) - (csound-tempo-face ((t (:foreground "ForestGreen" :weight normal)))) - (csound-wrate-face ((t (:foreground "DodgerBlue" :underline nil :weight normal)))) - -;; (eon-annotation-delimiter-face ((t (:foreground "yellow" :background "goldenrod" :bold t :weight bold)))) -;; (eon-annotation-delimiter-alt-face ((t (:foreground "gray35" :background "gray29" :bold t :weight bold)))) -;; (eon-annotation-data-face ((t (:foreground "darkseagreen1" :background "darkseagreen4")))) - (eon-annotation-delimiter-face ((t (:foreground "turquoise1" :background "turquoise4" :bold t :weight bold)))) - (eon-annotation-delimiter-alt-face ((t (:foreground "gray35" :background "gray26" :bold t :weight bold)))) - (eon-annotation-data-face ((t ( :background "gray26")))) - (eon-id-highlight-face ((t (:foreground "red" :background "gray43")))) - - (cua-global-mark-face ((t (nil)))) - (cua-rectangle ((t (nil)))) - (cua-rectangle-face ((t (nil)))) - (cua-rectangle-noselect-face ((t (nil)))) - (cursor ((t (:background "yellow")))) - (custom-button ((t (:foreground "gainsboro")))) - (custom-button-mouse ((t (nil)))) - (custom-button-pressed ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-button-pressed-unraised ((t (nil)))) - (custom-button-unraised ((t (nil)))) - (custom-changed ((t (:background "blue" :foreground "white")))) - (custom-comment ((t (:background "dim gray")))) - (custom-comment-tag ((t (:foreground "gray80")))) - (custom-documentation ((t (:foreground "light blue")))) - (custom-face-tag ((t (:underline t)))) - (custom-group-tag ((t (:bold t :foreground "pale turquoise" :weight bold)))) - (custom-group-tag-1 ((t (:foreground "pale turquoise" :underline t)))) - (custom-invalid ((t (:background "red" :foreground "yellow")))) - (custom-link ((t (nil)))) - (custom-modified ((t (:background "blue" :foreground "white")))) - (custom-rogue ((t (:background "black" :foreground "pink")))) - (custom-saved ((t (:underline t)))) - (custom-set ((t (:background "white" :foreground "blue")))) - (custom-state ((t (:foreground "light salmon")))) - (custom-tag ((t (nil)))) - (custom-themed ((t (nil)))) - (custom-variable-button ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag ((t (:bold t :foreground "turquoise" :weight bold)))) - (cvs-filename-face ((t (:foreground "white")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:foreground "green")))) - (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) - (cvs-msg-face ((t (:foreground "gray85")))) - (cvs-need-action-face ((t (:foreground "yellow")))) - (cvs-unknown-face ((t (:foreground "grey")))) - (cyan ((t (:foreground "cyan")))) - (diary ((t (:foreground "yellow")))) - (diary-button ((t (nil)))) - (diary-button-face ((t (nil)))) - (dictionary-button ((t (nil)))) - (dictionary-button-face ((t (nil)))) - (dictionary-reference ((t (nil)))) - (dictionary-reference-face ((t (nil)))) - (dictionary-word-entry ((t (nil)))) - (dictionary-word-entry-face ((t (nil)))) - (diff-added ((t (nil)))) - (diff-added-face ((t (nil)))) - (diff-changed ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context ((t (nil)))) - (diff-context-face ((t (nil)))) - (diff-file-header ((t (nil)))) - (diff-file-header-face ((t (nil)))) - (diff-function ((t (nil)))) - (diff-function-face ((t (nil)))) - (diff-header ((t (nil)))) - (diff-header-face ((t (nil)))) - (diff-hunk-header ((t (nil)))) - (diff-hunk-header-face ((t (nil)))) - (diff-index ((t (nil)))) - (diff-index-face ((t (nil)))) - (diff-indicator-added ((t (nil)))) - (diff-indicator-changed ((t (nil)))) - (diff-indicator-removed ((t (nil)))) - (diff-nonexistent ((t (nil)))) - (diff-nonexistent-face ((t (nil)))) - (diff-removed ((t (nil)))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-directory ((t (:foreground "white" :underline "yellowgreen")))) - (dired-face-executable ((t (:foreground "green")))) - (dired-face-flagged ((t (:foreground "tomato")))) - (dired-face-header ((t (:background "grey75" :foreground "gray30")))) - (dired-face-marked ((t (:italic t :foreground "slate gray" :slant italic)))) - (dired-face-permissions ((t (:foreground "aquamarine")))) - (dired-face-setuid ((t (:foreground "gray85")))) - (dired-face-socket ((t (:foreground "gray85")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (dired-flagged ((t (:foreground "red")))) - (dired-header ((t (:italic t :slant italic :foreground "yellow")))) - (dired-ignored ((t (:foreground "gray50")))) - (dired-mark ((t (nil)))) - (dired-marked ((t (:italic t :background "blue" :foreground "yellow" :slant italic)))) - (dired-symlink ((t (:foreground "IndianRed1")))) - (dired-warning ((t (nil)))) - (display-time-mail-face ((t (:foreground "yellow" :background "red")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "gray85")))) - (doremi-last-face ((t (nil)))) - (ebrowse-default-face ((t (nil)))) - (ebrowse-file-name-face ((t (:italic t :slant italic)))) - (ebrowse-member-attribute-face ((t (:foreground "red")))) - (ebrowse-member-class-face ((t (:foreground "Gray85")))) - (ebrowse-progress-face ((t (:background "blue")))) - (ebrowse-root-class-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (ebrowse-tree-mark-face ((t (:foreground "Gray85")))) - - (elscreen-tab-background-face ((t (:background "gray25")))) - (elscreen-tab-control-face ((t (:background "white")))) - (elscreen-tab-current-screen-face ((t (:background "blueviolet" :foreground "cyan")))) - (elscreen-tab-other-screen-face ((t (:background "gray50" :foreground "gray80")))) - - (ecasound-error-face ((t (nil)))) - (ecasound-ewf-boolean-face ((t (nil)))) - (ecasound-ewf-file-face ((t (nil)))) - (ecasound-ewf-keyword-face ((t (nil)))) - (ecasound-ewf-time-face ((t (nil)))) - (ecaspace-io-face ((t (:background "navyblue" :foreground "cyan")))) - (ecaspace-monitor-p-face ((t (:background "forestgreen" :foreground "yellow")))) - (ecaspace-next-take-face ((t (:background "white" :foreground "red")))) - (ecaspace-record-p-face ((t (:background "red" :foreground "yellow")))) - (ecaspace-selected-take-face ((t (:background "gray20" :foreground "white")))) - (ecaspace-track-face ((t (:background "white" :foreground "gray50")))) - (ecb-analyse-face ((t (nil)))) - (ecb-bucket-token-face ((t (:bold t :weight bold)))) - (ecb-default-general-face ((t (:height 1.0)))) - (ecb-default-highlight-face ((t (:background "magenta" :height 1.0)))) - (ecb-directories-general-face ((t (:height 0.9)))) - (ecb-directory-face ((t (:background "Cyan4")))) - (ecb-history-face ((t (:background "Cyan4")))) - (ecb-history-general-face ((t (:height 0.9)))) - (ecb-method-face ((t (:background "Cyan4" :slant normal :weight normal)))) - (ecb-methods-general-face ((t (:slant normal)))) - (ecb-source-face ((t (:background "Cyan4")))) - (ecb-source-in-directories-buffer-face ((t (:foreground "LightBlue1")))) - (ecb-sources-face ((t (:foreground "LightBlue1")))) - (ecb-sources-general-face ((t (:height 0.9)))) - (ecb-tag-header-face ((t (nil)))) - (ecb-token-header-face ((t (:background "Steelblue4")))) - (ecb-type-token-class-face ((t (:bold t :weight bold)))) - (ecb-type-token-enum-face ((t (:bold t :weight bold)))) - (ecb-type-token-group-face ((t (:bold t :foreground "dim gray" :weight bold)))) - (ecb-type-token-interface-face ((t (:bold t :weight bold)))) - (ecb-type-token-struct-face ((t (:bold t :weight bold)))) - (ecb-type-token-typedef-face ((t (:bold t :weight bold)))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Gray30")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Gray30")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Gray30")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Gray30")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Gray30")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Gray30")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Gray30")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Gray30")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (eev-glyph-face-Greek ((t (nil)))) - (eev-glyph-face-bang ((t (:background "red" :foreground "blue")))) - (eev-glyph-face-blue ((t (:foreground "blue")))) - (eev-glyph-face-bluebg ((t (:background "blue")))) - (eev-glyph-face-font ((t (nil)))) - (eev-glyph-face-graphic ((t (nil)))) - (eev-glyph-face-greek ((t (nil)))) - (eev-glyph-face-green ((t (:bold t :foreground "yellow" :weight bold)))) - (eev-glyph-face-linear ((t (nil)))) - (eev-glyph-face-logical ((t (nil)))) - (eev-glyph-face-math ((t (nil)))) - (eev-glyph-face-red ((t (:bold t :background "red" :foreground "yellow" :weight bold)))) - (eev-glyph-face-yellow-on-red ((t (:background "red" :foreground "yellow")))) - (emacs-wiki-bad-link-face ((t (:bold t :foreground "IndianRed1" :weight bold)))) - (emacs-wiki-header-1 ((t (:bold t :weight bold :height 1.728 :family "helv")))) - (emacs-wiki-header-2 ((t (:bold t :weight bold :height 1.44 :family "helv")))) - (emacs-wiki-header-3 ((t (:bold t :weight bold :height 1.2 :family "helv")))) - (emacs-wiki-header-4 ((t (:bold t :weight bold :family "helv")))) - (emacs-wiki-header-5 ((t (:bold t :weight bold)))) - (emacs-wiki-header-6 ((t (nil)))) - (emacs-wiki-link-face ((t (:bold t :foreground "khaki" :weight bold)))) - (emacs-wiki-verbatim-face ((t (:foreground "gray")))) - (emms-pbi-current-face ((t (:bold t :foreground "gold2" :weight bold)))) - (emms-pbi-mark-marked ((t (nil)))) - (emms-pbi-mark-marked-face ((t (:italic t :background "gray30" :foreground "slate gray" :slant italic)))) - (emms-pbi-song ((t (nil)))) - (emms-pbi-song-face ((t (:foreground "gray60")))) - (emms-playlist-selected-face ((t (:foreground "yellow" :bold t :weight bold)))) - (emms-playlist-track-face ((t (nil)))) - (emms-stream-name-face ((t (nil)))) - (emms-stream-url-face ((t (nil)))) - (erc-action ((t (nil)))) - (erc-action-face ((t (:foreground "gray70")))) - (erc-bold ((t (nil)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-chanlist-even-line-face ((t (nil)))) - (erc-chanlist-header-face ((t (nil)))) - (erc-chanlist-highlight ((t (nil)))) - (erc-chanlist-odd-line-face ((t (nil)))) - (erc-command-indicator-face ((t (:bold t :weight bold)))) - (erc-current-nick ((t (nil)))) - (erc-current-nick-face ((t (:foreground "cyan")))) - (erc-dangerous-host ((t (nil)))) - (erc-dangerous-host-face ((t (:foreground "red")))) - (erc-default ((t (nil)))) - (erc-default-face ((t (:foreground "gray70")))) - (erc-direct-msg ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "pale green")))) - (erc-error ((t (nil)))) - (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (erc-fool ((t (nil)))) - (erc-fool-face ((t (:foreground "Gray85")))) - (erc-highlight ((t (nil)))) - (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-input ((t (nil)))) - (erc-input-face ((t (:foreground "gray90")))) - (erc-inverse-face ((t (:background "steel blue")))) - (erc-keyword ((t (nil)))) - (erc-keyword-face ((t (nil)))) - (erc-header-line ((t (:background "grey20" :foreground "gray90" :box nil :underline "gray60")))) - (erc-nick-default ((t (nil)))) - (erc-nick-default-face ((t (:foreground "gold")))) - (erc-nick-msg ((t (nil)))) - (erc-my-nick-face ((t (:foreground "white")))) - (erc-nick-msg-face ((t (:bold t :foreground "green" :weight bold)))) - (erc-notice ((t (nil)))) - (erc-notice-face ((t (:foreground "gray50")))) - (erc-pal ((t (nil)))) - (erc-pal-face ((t (:foreground "aquamarine")))) - (erc-prompt ((t (nil)))) - (erc-prompt-face ((t (:foreground "white")))) - (erc-timestamp ((t (nil)))) - (erc-timestamp-face ((t (:foreground "gray40")))) - (erc-underline ((t (nil)))) - (erc-underline-face ((t (:underline t)))) - (escape-glyph ((t (:foreground "cyan")))) - (eshell-ls-archive ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-backup ((t (:foreground "LightSalmon")))) - (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) - (eshell-ls-clutter ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-directory ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (eshell-ls-executable ((t (:bold t :foreground "Green" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) - (eshell-ls-missing ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-picture-face ((t (:foreground "violet")))) - (eshell-ls-product ((t (:foreground "LightSalmon")))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly ((t (:foreground "Pink")))) - (eshell-ls-readonly-face ((t (:foreground "Pink")))) - (eshell-ls-special ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-symlink ((t (:bold t :foreground "Cyan" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) - (eshell-ls-text-face ((t (nil)))) - (eshell-ls-todo-face ((t (nil)))) - (eshell-ls-unreadable ((t (:foreground "DarkGrey")))) - (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) - (eshell-prompt ((t (:bold t :foreground "Pink" :weight bold)))) - (eshell-prompt-face ((t (:bold t :foreground "Pink" :weight bold)))) - (eshell-test-failed ((t (nil)))) - (eshell-test-failed-face ((t (:bold t :weight bold)))) - (eshell-test-ok ((t (nil)))) - (eshell-test-ok-face ((t (:bold t :weight bold)))) - (excerpt ((t (:italic t :slant italic)))) - (fancy-widget-button ((t (nil)))) - (fancy-widget-button-face ((t (nil)))) - (fancy-widget-button-highlight ((t (nil)))) - (fancy-widget-button-highlight-face ((t (nil)))) - (fancy-widget-button-pressed ((t (nil)))) - (fancy-widget-button-pressed-face ((t (nil)))) - (fancy-widget-button-pressed-highlight ((t (nil)))) - (fancy-widget-button-pressed-highlight-face ((t (nil)))) - (fancy-widget-documentation ((t (nil)))) - (fancy-widget-documentation-face ((t (nil)))) - (fancy-widget-field ((t (nil)))) - (fancy-widget-field-face ((t (nil)))) - (fancy-widget-inactive ((t (nil)))) - (fancy-widget-inactive-face ((t (nil)))) - (fancy-widget-single-line-field ((t (nil)))) - (fancy-widget-single-line-field-face ((t (nil)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "gray85" :weight bold)))) - (ffap ((t (:foreground "cyan" :background "purple3")))) - (fg:black ((t (:foreground "black")))) - (fg:erc-color-face0 ((t (:foreground "white")))) - (fg:erc-color-face1 ((t (:foreground "beige")))) - (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) - (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) - (fg:erc-color-face12 ((t (:foreground "light yellow")))) - (fg:erc-color-face13 ((t (:foreground "yellow")))) - (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) - (fg:erc-color-face15 ((t (:foreground "lime green")))) - (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) - (fg:erc-color-face3 ((t (:foreground "light cyan")))) - (fg:erc-color-face4 ((t (:foreground "powder blue")))) - (fg:erc-color-face5 ((t (:foreground "sky blue")))) - (fg:erc-color-face6 ((t (:foreground "dark sea green")))) - (fg:erc-color-face7 ((t (:foreground "pale green")))) - (fg:erc-color-face8 ((t (:foreground "medium spring green")))) - (fg:erc-color-face9 ((t (:foreground "khaki")))) - (file-name-shadow ((t (nil)))) - (fixed ((t (:bold t :weight bold)))) - (fixed-pitch ((t (:family "courier")))) - (fl-comment-face ((t (:foreground "gray85")))) - (fl-doc-string-face ((t (nil)))) - (fl-function-name-face ((t (:foreground "green")))) - (fl-keyword-face ((t (:foreground "LightGreen")))) - (fl-string-face ((t (:foreground "light coral")))) - (fl-type-face ((t (:foreground "cyan")))) - (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) - (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) - (font-latex-bold ((t (nil)))) - (font-latex-bold-face ((t (nil)))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate ((t (nil)))) - (font-latex-sedate-face ((t (:foreground "Gray85")))) - (font-latex-string-face ((t (:foreground "orange")))) - (font-latex-title-4 ((t (nil)))) - (font-latex-title-4-face ((t (nil)))) - (font-latex-warning ((t (nil)))) - (font-latex-warning-face ((t (:foreground "gold")))) - (font-lock-builtin ((t (nil)))) - (font-lock-builtin-face ((t (:foreground "gray55")))) - (font-lock-comment ((t (nil)))) - (font-lock-comment-delimiter ((t (nil)))) - (font-lock-comment-delimiter-face ((t (:background "gray18" :foreground "gray25")))) - (font-lock-comment-face ((t (:background "gray18" :foreground "gray52")))) - (font-lock-constant ((t (nil)))) - (font-lock-constant-face ((t (:foreground "gold")))) - (font-lock-doc ((t (nil)))) - (font-lock-doc-face ((t (:foreground "gray60")))) - (font-lock-doc-string-face ((t (:background "gray20" :foreground "slate gray")))) - (font-lock-emphasized-face ((t (:foreground "red")))) - (font-lock-exit-face ((t (:foreground "green")))) - (font-lock-function-name ((t (nil)))) - (font-lock-function-name-face ((t (:foreground "gold")))) - (font-lock-interface-def-face ((t (nil)))) - (font-lock-keyword ((t (nil)))) - (font-lock-keyword-face ((t (:foreground "gray70")))) - (font-lock-module-def-face ((t (nil)))) - (font-lock-negation-char ((t (nil)))) - (font-lock-negation-char-face ((t (nil)))) - (font-lock-operator ((t (nil)))) - (font-lock-operator-face ((t (nil)))) - (font-lock-other-emphasized-face ((t (nil)))) - (font-lock-other-type-face ((t (nil)))) - (font-lock-preprocessor ((t (nil)))) - (font-lock-preprocessor-face ((t (nil)))) - (font-lock-pseudo-keyword ((t (nil)))) - (font-lock-pseudo-keyword-face ((t (nil)))) - (font-lock-reference-face ((t (:background "red" :foreground "yellow")))) - (font-lock-regexp-grouping-backslash ((t (:foreground "gray10")))) - (font-lock-regexp-grouping-construct ((t (:foreground "yellow")))) - (font-lock-string ((t (nil)))) - (font-lock-string-face ((t (:foreground "gray60")))) - (font-lock-type ((t (nil)))) - (font-lock-type-def-face ((t (nil)))) - (font-lock-type-face ((t (:foreground "gray60" :underline "yellow")))) - (font-lock-variable-name ((t (nil)))) - (font-lock-variable-name-face ((t (:foreground "gold")))) - (font-lock-warning ((t (nil)))) - (font-lock-warning-face ((t (:underline "red")))) - (fringe ((t (:background "Grey15")))) - (fvwm-rgb-value-face ((t (nil)))) - (fvwm-special-face ((t (nil)))) - (gnus-button ((t (nil)))) - (gnus-cite-1 ((t (:foreground "light blue")))) - (gnus-cite-10 ((t (:foreground "medium purple")))) - (gnus-cite-11 ((t (:foreground "turquoise")))) - (gnus-cite-2 ((t (:foreground "light cyan")))) - (gnus-cite-3 ((t (:foreground "light yellow")))) - (gnus-cite-4 ((t (:foreground "light pink")))) - (gnus-cite-5 ((t (:foreground "pale green")))) - (gnus-cite-6 ((t (:foreground "beige")))) - (gnus-cite-7 ((t (:foreground "orange")))) - (gnus-cite-8 ((t (:foreground "magenta")))) - (gnus-cite-9 ((t (:foreground "violet")))) - (gnus-cite-attribution ((t (:italic t :slant italic)))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "light blue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-strikethru ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1 ((t (:bold t :foreground "aquamarine1" :weight bold)))) - (gnus-group-mail-1-empty ((t (:foreground "aquamarine1")))) - (gnus-group-mail-2 ((t (:bold t :foreground "aquamarine2" :weight bold)))) - (gnus-group-mail-2-empty ((t (:foreground "aquamarine2")))) - (gnus-group-mail-3 ((t (:bold t :foreground "aquamarine3" :weight bold)))) - (gnus-group-mail-3-empty ((t (:foreground "aquamarine3")))) - (gnus-group-mail-low ((t (:bold t :foreground "aquamarine4" :weight bold)))) - (gnus-group-mail-low-empty ((t (:foreground "aquamarine4")))) - (gnus-group-news-1 ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-group-news-1-empty ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-2 ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-news-2-empty ((t (:foreground "turquoise")))) - (gnus-group-news-3 ((t (:bold t :weight bold)))) - (gnus-group-news-3-empty ((t (nil)))) - (gnus-group-news-4 ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty ((t (nil)))) - (gnus-group-news-5 ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty ((t (nil)))) - (gnus-group-news-6 ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty ((t (nil)))) - (gnus-group-news-low ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) - (gnus-group-news-low-empty ((t (:foreground "DarkTurquoise")))) - (gnus-header-content ((t (:italic t :foreground "forest green" :slant italic)))) - (gnus-header-from ((t (:foreground "spring green")))) - (gnus-header-name ((t (:foreground "SeaGreen")))) - (gnus-header-newsgroups ((t (:italic t :foreground "yellow" :slant italic)))) - (gnus-header-subject ((t (:foreground "SeaGreen3")))) - (gnus-picon-face ((t (:background "white" :foreground "black")))) - (gnus-picon-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-picons-face ((t (:background "white" :foreground "gray30")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "gray30")))) - (gnus-server-agent ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-server-closed ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) - (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) - (gnus-server-denied ((t (:bold t :foreground "Pink" :weight bold)))) - (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight bold)))) - (gnus-server-offline ((t (:bold t :foreground "Yellow" :weight bold)))) - (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) - (gnus-server-opened ((t (:bold t :foreground "Green1" :weight bold)))) - (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight bold)))) - (gnus-signature ((t (:italic t :slant italic)))) - (gnus-splash ((t (:foreground "Brown")))) - (gnus-summary-cancelled ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (gnus-summary-high-read ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (gnus-summary-high-ticked ((t (:bold t :foreground "pink" :weight bold)))) - (gnus-summary-high-undownloaded ((t (:bold t :foreground "LightGray" :weight bold)))) - (gnus-summary-high-unread ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient ((t (:italic t :foreground "SkyBlue" :slant italic)))) - (gnus-summary-low-read ((t (:italic t :foreground "PaleGreen" :slant italic)))) - (gnus-summary-low-ticked ((t (:italic t :foreground "pink" :slant italic)))) - (gnus-summary-low-undownloaded ((t (:italic t :foreground "LightGray" :slant italic :weight normal)))) - (gnus-summary-low-unread ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked ((t (:foreground "pink")))) - (gnus-summary-normal-undownloaded ((t (:foreground "LightGray" :weight normal)))) - (gnus-summary-normal-unread ((t (nil)))) - (gnus-summary-selected ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "gray30")))) - (golisp-anchor-face ((t (:bold t :foreground "yellow" :weight bold)))) - (golisp-bullet-face ((t (:foreground "yellow")))) - (golisp-defxref-name-face ((t (:bold t :foreground "gray60" :weight bold)))) - (golisp-xref-face ((t (:bold t :foreground "yellow" :weight bold)))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "gray30")))) - (gui-element ((t (:background "Gray80")))) - (header-line ((t (:background "grey20" :foreground "gray90" :box nil :underline "gray60")))) - (help-argument-name ((t (:foreground "yellow" :italic t :slant italic)))) - (help-highlight-face ((t (:bold t :underline t :weight bold)))) - (hexl-address-area ((t (nil)))) - (hexl-address-region ((t (nil)))) - (hexl-ascii-area ((t (nil)))) - (hexl-ascii-region ((t (nil)))) - (hi-black-b ((t (:bold t :weight bold)))) - (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) - (hi-blue ((t (:background "light blue")))) - (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) - (hi-green ((t (:background "green")))) - (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) - (hi-pink ((t (:background "pink")))) - (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) - (hi-yellow ((t (:background "yellow")))) - (highlight ((t (:background "purple3" :foreground "cyan")))) - (highlight-changes-delete-face ((t (:foreground "gray85" :underline t)))) - (highlight-changes-face ((t (:foreground "gray85")))) - (highlight-current-line ((t (nil)))) - (highlight-current-line-face ((t (nil)))) - (highline-face ((t (:background "DeepSkyBlue4")))) - (highline-vertical-face ((t (:background "lightcyan")))) - (holiday ((t (:background "chocolate4")))) - (hover-highlight ((t (nil)))) - (howm-menu-key-face ((t (:foreground "orange")))) - (howm-menu-list-face ((t (:foreground "white")))) - (howm-mode-keyword-face ((t (:bold t :background "dodgerblue2" :foreground "white" :weight bold)))) - (howm-mode-ref-face ((t (:bold t :background "ForestGreen" :foreground "yellow" :weight bold)))) - (howm-mode-title-face ((t (:bold t :background "DodgerBlue3" :foreground "white" :weight bold)))) - (howm-mode-wiki-face ((t (:foreground "cyan")))) - (howm-reminder-deadline-face ((t (:background "red" :foreground "yellow")))) - (howm-reminder-defer-face ((t (:background "violetred4" :foreground "magenta")))) - (howm-reminder-done-face ((t (:background "gray40" :foreground "gray90")))) - (howm-reminder-normal-face ((t (:background "forestgreen" :foreground "yellow")))) - (howm-reminder-schedule-face ((t (:background "darkorange2" :foreground "yellow")))) - (howm-reminder-separator-face ((t (:foreground "black")))) - (howm-reminder-today-face ((t (:underline "yellow")))) - (howm-reminder-todo-face ((t (:background "dodgerblue3" :foreground "cyan")))) - (howm-reminder-tomorrow-face ((t (:italic t :slant italic)))) - (howm-view-empty-face ((t (nil)))) - (howm-view-hilit-face ((t (:bold t :background "forestgreen" :foreground "yellow" :weight bold)))) - (howm-view-name-face ((t (nil)))) - (html-helper-bold-face ((t (:bold t :weight bold)))) - (html-helper-bold-italic-face ((t (nil)))) - (html-helper-builtin-face ((t (:foreground "gray85" :underline t)))) - (html-helper-italic-face ((t (:bold t :foreground "yellow" :weight bold)))) - (html-helper-underline-face ((t (:underline t)))) - (html-tag-face ((t (:bold t :weight bold)))) - (hyper-apropos-documentation ((t (nil)))) - (hyper-apropos-heading ((t (:bold t :weight bold)))) - (hyper-apropos-hyperlink ((t (nil)))) - (hyper-apropos-major-heading ((t (:bold t :weight bold)))) - (hyper-apropos-section-heading ((t (:bold t :weight bold)))) - (hyper-apropos-warning ((t (:bold t :foreground "gray85" :weight bold)))) - (ibuffer-deletion ((t (nil)))) - (ibuffer-deletion-face ((t (nil)))) - (ibuffer-help-buffer ((t (nil)))) - (ibuffer-help-buffer-face ((t (nil)))) - (ibuffer-marked ((t (nil)))) - (ibuffer-marked-face ((t (:foreground "gray85")))) - (ibuffer-special-buffer ((t (nil)))) - (ibuffer-special-buffer-face ((t (nil)))) - (idlwave-help-link ((t (:foreground "Blue")))) - (idlwave-help-link-face ((t (:foreground "Blue")))) - (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) - (ido-first-match ((t (nil)))) - (ido-first-match-face ((t (nil)))) - (ido-indicator-face ((t (nil)))) - (ido-only-match ((t (nil)))) - (ido-only-match-face ((t (nil)))) - (ido-subdir ((t (nil)))) - (ido-subdir-face ((t (nil)))) - (imaxima-latex-error ((t (nil)))) - (imaxima-latex-error-face ((t (nil)))) - (info-header-node ((t (:bold t :weight bold)))) - (info-header-xref ((t (:bold t :foreground "sky blue" :weight bold)))) - (info-menu-6 ((t (nil)))) - (info-menu-header ((t (:bold t :weight bold :family "helv")))) - (info-menu-star ((t (:underline t)))) - (info-node ((t (:bold t :weight bold)))) - (info-title-1 ((t (:bold t :weight bold :height 1.728 :family "helv")))) - (info-title-2 ((t (:bold t :weight bold :height 1.44 :family "helv")))) - (info-title-3 ((t (:bold t :weight bold :height 1.2 :family "helv")))) - (info-title-4 ((t (:bold t :weight bold :family "helv")))) - (info-xref ((t (:bold t :foreground "sky blue" :weight bold)))) - (info-xref-visited ((t (:bold t :foreground "magenta3" :weight bold)))) - (isearch ((t (:background "red" :foreground "yellow")))) - (isearch-lazy-highlight ((t (nil)))) - (isearch-secondary ((t (:background "darkred" :foreground "yellow")))) - (iswitchb-current-match ((t (nil)))) - (iswitchb-invalid-regexp ((t (nil)))) - (iswitchb-single-match ((t (nil)))) - (iswitchb-virtual-matches ((t (nil)))) - (italic ((t (:italic t :slant italic)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) - (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) - (jde-java-font-lock-doc-tag ((t (nil)))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link ((t (nil)))) - (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) - (jde-java-font-lock-modifier ((t (nil)))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) - (jde-java-font-lock-number ((t (nil)))) - (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) - (jde-java-font-lock-operator ((t (nil)))) - (jde-java-font-lock-operator-face ((t (:foreground "cyan3")))) - (jde-java-font-lock-package ((t (nil)))) - (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (keywiz-command ((t (nil)))) - (keywiz-command-face ((t (nil)))) - (keywiz-right ((t (nil)))) - (keywiz-right-face ((t (nil)))) - (keywiz-wrong ((t (nil)))) - (keywiz-wrong-face ((t (nil)))) - (lazy-highlight ((t (:background "paleturquoise4")))) - (lazy-highlight-face ((t (:bold t :foreground "yellow" :weight bold)))) - (ld-script-location-counter ((t (:bold t :foreground "gray57" :weight bold)))) - (left-margin ((t (nil)))) - - (light-symbol-face ((t (:foreground "yellow" :background "blue")))) - - (linemenu-face ((t (:background "gray30")))) - (link ((t (nil)))) - (link-visited ((t (nil)))) - (linkd-command-face ((t (:background "goldenrod4" :foreground "gold")))) - (linkd-generic-face ((t (:foreground "aquamarine1")))) - (linkd-generic-name-face ((t (:background "aquamarine4" :foreground "aquamarine1" :underline "yellow")))) - (linkd-icon-face ((t (:underline nil)))) - (linkd-node-face ((t (nil)))) - (linkd-other-face ((t (nil)))) - (linkd-star-face ((t (:background "red" :foreground "yellow" :underline nil)))) - (linkd-star-name-face ((t (:background "olivedrab4" :foreground "yellow" :underline "yellow")))) - (linkd-tag-face ((t (:background "palevioletred3" :foreground "yellow" :underline nil)))) - (linkd-tag-name-face ((t (:background "aquamarine4" :foreground "aquamarine1" :underline "yellow")))) - (linkd-to-face ((t (nil)))) - (linkd-wiki-face ((t (:foreground "cyan" :underline "yellow")))) - (list-mode-item-selected ((t (:background "gray68")))) - (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) - (log-view-message-face ((t (nil)))) - (magenta ((t (:foreground "gray85")))) - (makefile-shell ((t (nil)))) - (makefile-shell-face ((t (nil)))) - (makefile-space ((t (nil)))) - (makefile-space-face ((t (:background "hotpink")))) - (man-bold ((t (:bold t :weight bold)))) - (man-heading ((t (:bold t :weight bold)))) - (man-italic ((t (:foreground "yellow")))) - (man-xref ((t (:underline t)))) - (match ((t (:background "RoyalBlue4")))) -; (menu ((t (:background "gray17" :foreground "gray60")))) - (message-cited-text ((t (:foreground "orange")))) - (message-header-cc ((t (:foreground "khaki")))) - (message-header-contents ((t (:foreground "white")))) - (message-header-from ((t (nil)))) - (message-header-from-face ((t (nil)))) - (message-header-name ((t (:foreground "LightBlue")))) - (message-header-newsgroups ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) - (message-header-other ((t (:foreground "MediumAquamarine")))) - (message-header-subject ((t (:bold t :foreground "light cyan" :weight bold)))) - (message-header-to ((t (:bold t :foreground "light cyan" :weight bold)))) - (message-header-xheader ((t (:foreground "MediumAquamarine")))) - (message-headers ((t (:bold t :foreground "orange" :weight bold)))) - (message-highlighted-header-contents ((t (:bold t :weight bold)))) - (message-mml ((t (:foreground "ForestGreen")))) - (message-separator ((t (:foreground "chocolate")))) - (message-url ((t (:bold t :foreground "pink" :weight bold)))) - (minibuffer-prompt ((t (:bold t :background "red" :foreground "yellow" :weight bold)))) - (mm-uu-extract ((t (nil)))) - (mmm-default-submode-face ((t (:background "#c0c0c5")))) - (mmm-face ((t (:background "black" :foreground "green")))) - (mode-line ((t (:background "forestgreen" :box nil :foreground "yellow" :bold t :weight bold :box (:line-width -1 :color "forestgreen"))))) - (mode-line-buffer-id ((t (:foreground "white" :bold t :weight bold)))) - (mode-line-highlight ((t (:foreground "gray40" :background "white")))) - (mode-line-inactive ((t (:bold t :weight bold :background "gray40" :foreground "white")))) - (modeline-mousable ((t (:foreground "purple" :background "white")))) - (modeline-mousable-minor-mode ((t (nil)))) - (momentary ((t (nil)))) - (mouse ((t (:background "Grey")))) - (muse-bad-link-face ((t (nil)))) - (muse-emphasis-1 ((t (nil)))) - (muse-emphasis-2 ((t (nil)))) - (muse-emphasis-3 ((t (nil)))) - (muse-header-1 ((t (nil)))) - (muse-header-2 ((t (nil)))) - (muse-header-3 ((t (nil)))) - (muse-header-4 ((t (nil)))) - (muse-header-5 ((t (nil)))) - (muse-link-face ((t (nil)))) - (muse-verbatim-face ((t (nil)))) - (my-summary-highlight-face ((t (:background "PaleTurquoise4" :foreground "White")))) - (my-tab-face ((t (nil)))) - (my-url-face ((t (:foreground "LightBlue")))) - (mybiggernumbers ((t (nil)))) - (myblack ((t (nil)))) - (mygrey ((t (nil)))) - (mysubject ((t (nil)))) - (mythreads ((t (nil)))) - (mytime ((t (nil)))) - (next-error ((t (:background "grey30")))) - (nil ((t (nil)))) - (nobreak-space ((t (nil)))) - (org-archived ((t (nil)))) - (org-date ((t (:foreground "cyan" :underline t)))) - (org-deadline-announce ((t (:foreground "red")))) - (org-done ((t (:background "gray15" :foreground "gray45")))) - (org-formula ((t (:foreground "chocolate1")))) - (org-headline-done ((t (:foreground "palegreen")))) - (org-hide ((t (:foreground "black")))) - (org-level-1 ((t (:foreground "gold")))) - (org-level-2 ((t (:foreground "gray80")))) - (org-level-3 ((t (:foreground "gray60")))) - (org-level-4 ((t (:foreground "lightgoldenrod")))) - (org-level-5 ((t (:foreground "darkkhaki")))) - (org-level-6 ((t (:foreground "Aquamarine")))) - (org-level-7 ((t (:foreground "LightSteelBlue")))) - (org-level-8 ((t (:foreground "LightSalmon")))) - (org-link ((t (:foreground "gold" :underline t)))) - (org-scheduled-previously ((t (:foreground "red")))) - (org-scheduled-today ((t (:foreground "LightSkyBlue")))) - (org-special-keyword ((t (:foreground "cyan")))) - (org-table ((t (:foreground "LightSkyBlue")))) - (org-tag ((t (:background "navyblue" :foreground "cyan" :bold t :weight bold)))) - (org-time-grid ((t (:foreground "LightGoldenrod")))) - (org-todo ((t (:background "red" :foreground "yellow")))) - (org-upcoming-deadline ((t (nil)))) - (org-warning ((t (:bold t :foreground "Red1" :weight bold)))) - (outline-1 ((t (:italic t :bold t :foreground "LightSkyBlue" :slant italic :weight bold)))) - (outline-2 ((t (:italic t :bold t :foreground "LightGoldenrod" :slant italic :weight bold)))) - (outline-3 ((t (:bold t :foreground "Cyan" :weight bold)))) - (outline-4 ((t (:bold t :foreground "LightSteelBlue" :weight bold)))) - (outline-5 ((t (:italic t :foreground "medium aquamarine" :slant italic)))) - (outline-6 ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (outline-7 ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (outline-8 ((t (:italic t :foreground "aquamarine" :slant italic)))) - (p4-depot-added-face ((t (nil)))) - (p4-depot-deleted-face ((t (nil)))) - (p4-depot-unmapped-face ((t (nil)))) - (p4-diff-change-face ((t (nil)))) - (p4-diff-del-face ((t (nil)))) - (p4-diff-file-face ((t (nil)))) - (p4-diff-head-face ((t (nil)))) - (p4-diff-ins-face ((t (nil)))) - (paren ((t (nil)))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-dim-face ((t (nil)))) - (paren-face ((t (:background "gray20")))) - (paren-face-match ((t (:background "turquoise")))) - (paren-face-mismatch ((t (:background "purple" :foreground "white")))) - (paren-face-no-match ((t (:background "yellow" :foreground "gray30")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "RosyBrown" :foreground "gray30")))) - (paren-mismatch-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) - (paren-no-match-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) - (plain-widget-button ((t (nil)))) - (plain-widget-button-face ((t (nil)))) - (plain-widget-button-pressed ((t (nil)))) - (plain-widget-button-pressed-face ((t (nil)))) - (plain-widget-documentation ((t (nil)))) - (plain-widget-documentation-face ((t (nil)))) - (plain-widget-field ((t (nil)))) - (plain-widget-field-face ((t (nil)))) - (plain-widget-inactive ((t (nil)))) - (plain-widget-inactive-face ((t (nil)))) - (plain-widget-single-line-field ((t (nil)))) - (plain-widget-single-line-field-face ((t (nil)))) - (planner-cancelled-task-face ((t (:foreground "gray" :strike-through t)))) - (planner-completed-task-face ((t (:foreground "gray" :strike-through t)))) - (planner-delegated-task-face ((t (:italic t :slant italic)))) - (planner-high-priority-task-face ((t (:foreground "red")))) - (planner-id-face ((t (:foreground "darkgray")))) - (planner-in-progress-task-face ((t (:bold t :weight bold)))) - (planner-low-priority-task-face ((t (:foreground "blue")))) - (planner-medium-priority-task-face ((t (:foreground "green")))) - (planner-note-headline-face ((t (:bold t :foreground "dark slate blue" :weight bold)))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray40")))) - (qt-classes-face ((t (nil)))) - (query-replace ((t (:background "slate blue")))) - (rcirc-bright-nick ((t (:foreground "Aquamarine")))) - (rcirc-dim-nick ((t (:stipple nil :background "saddlebrown" :foreground "orange" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 98)))) - (rcirc-keyword ((t (nil)))) - (rcirc-mode-line-nick ((t (:background "red" :foreground "yellow")))) - (rcirc-my-nick ((t (:foreground "gold")))) - (rcirc-my-nick-face ((t (:bold t :foreground "gold" :weight bold)))) - (rcirc-nick-in-message ((t (:foreground "gold")))) - (rcirc-nick-in-message-face ((t (:foreground "greenyellow")))) - (rcirc-nick-in-message-full-line ((t (:foreground "gold")))) - (rcirc-other-nick ((t (:foreground "gray60")))) - (rcirc-other-nick-face ((t (:bold t :foreground "lightskyblue" :weight bold)))) - (rcirc-prompt ((t (:foreground "gray50")))) - (rcirc-server ((t (:foreground "gray50")))) - (rcirc-server-face ((t (nil)))) - (rcirc-server-prefix ((t (:foreground "gray60")))) - (rcirc-timestamp ((t (:stipple nil :foreground "gray")))) - (rcirc-track-keyword ((t (nil)))) - (rcirc-track-nick ((t (:background "red" :foreground "yellow")))) - (rcirc-url ((t (nil)))) - (reb-match-0 ((t (:background "lightblue")))) - (reb-match-1 ((t (:background "aquamarine")))) - (reb-match-2 ((t (:background "springgreen")))) - (reb-match-3 ((t (:background "yellow")))) - (red ((t (:foreground "red")))) - (region ((t (:foreground "cyan" :background "navyblue")))) - (right-margin ((t (nil)))) - (rmail-highlight ((t (nil)))) - (rpm-spec-dir-face ((t (nil)))) - (rpm-spec-doc-face ((t (nil)))) - (rpm-spec-ghost-face ((t (nil)))) - (rpm-spec-macro-face ((t (nil)))) - (rpm-spec-package-face ((t (nil)))) - (rpm-spec-tag-face ((t (nil)))) - (ruler-mode-column-number-face ((t (nil)))) - (ruler-mode-comment-column-face ((t (nil)))) - (ruler-mode-current-column-face ((t (nil)))) - (ruler-mode-default-face ((t (nil)))) - (ruler-mode-fill-column-face ((t (nil)))) - (ruler-mode-fringes-face ((t (nil)))) - (ruler-mode-goal-column-face ((t (nil)))) - (ruler-mode-margins-face ((t (nil)))) - (ruler-mode-pad-face ((t (nil)))) - (ruler-mode-tab-stop-face ((t (nil)))) - (scroll-bar ((t (:background "grey18" :foreground "grey40" :box (:line-width 1 :color "grey26"))))) - (secondary-selection ((t (:background "aquamarine3")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (semantic-intangible-face ((t (:foreground "gray25")))) - (semantic-read-only-face ((t (:background "gray25")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray70")))) - (senator-read-only-face ((t (:background "#664444")))) - (setnu-line-number ((t (nil)))) - (setnu-line-number-face ((t (nil)))) - (sgml-comment-face ((t (:foreground "dark turquoise")))) - (sgml-doctype-face ((t (:foreground "turquoise")))) - (sgml-end-tag-face ((t (:foreground "aquamarine")))) - (sgml-entity-face ((t (:foreground "gray85")))) - (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) - (sgml-ms-end-face ((t (:foreground "green")))) - (sgml-ms-start-face ((t (:foreground "yellow")))) - (sgml-namespace ((t (nil)))) - (sgml-pi-face ((t (:foreground "lime green")))) - (sgml-sgml-face ((t (:foreground "brown")))) - (sgml-short-ref-face ((t (:foreground "deep sky blue")))) - (sgml-start-tag-face ((t (:foreground "aquamarine")))) - (sh-escaped-newline ((t (:foreground "gold")))) - (sh-heredoc ((t (:bold t :foreground "yellow1" :weight bold)))) - (sh-heredoc-face ((t (:bold t :foreground "yellow1" :weight bold)))) - (sh-quoted-exec ((t (:foreground "cyan")))) - (shadow ((t (nil)))) - (shell-option-face ((t (:foreground "NavajoWhite")))) - (shell-output-2-face ((t (:foreground "gray85")))) - (shell-output-3-face ((t (:foreground "gray85")))) - (shell-output-face ((t (:bold t :weight bold)))) - (shell-prompt-face ((t (:foreground "VioletRed3")))) - (show-paren-match ((t (:bold t :background "red" :foreground "yellow" :weight bold)))) - (show-paren-mismatch ((t (:background "purple" :foreground "cyan")))) - (show-tabs-space-face ((t (:foreground "yellow")))) - (show-tabs-tab-face ((t (:foreground "red")))) - (show-trailing-whitespace ((t (nil)))) - (sieve-action-commands ((t (:foreground "LightSkyBlue")))) - (sieve-control-commands ((t (:foreground "LightSteelBlue")))) - (sieve-tagged-arguments ((t (:foreground "Cyan")))) - (sieve-test-commands ((t (:foreground "Aquamarine")))) - (simple-wiki-bold-face ((t (:bold t :weight bold)))) - (simple-wiki-code-face ((t (nil)))) - (simple-wiki-emph-face ((t (:italic t :slant italic)))) - (simple-wiki-heading-1-face ((t (nil)))) - (simple-wiki-heading-2-face ((t (nil)))) - (simple-wiki-heading-3-face ((t (nil)))) - (simple-wiki-heading-4-face ((t (nil)))) - (simple-wiki-heading-5-face ((t (nil)))) - (simple-wiki-heading-6-face ((t (nil)))) - (simple-wiki-italic-face ((t (:italic t :slant italic)))) - (simple-wiki-local-link-face ((t (:foreground "gray80" :underline "gray50")))) - (simple-wiki-nowiki-face ((t (nil)))) - (simple-wiki-smiley-face ((t (nil)))) - (simple-wiki-strike-face ((t (nil)))) - (simple-wiki-strong-emph-face ((t (:italic t :bold t :slant italic :weight bold)))) - (simple-wiki-strong-face ((t (:bold t :weight bold)))) - (simple-wiki-teletype-face ((t (nil)))) - (simple-wiki-underline-face ((t (nil)))) - (sldb-catch-tag-face ((t (nil)))) - (sldb-condition-face ((t (nil)))) - (sldb-detailed-frame-line-face ((t (nil)))) - (sldb-frame-label-face ((t (nil)))) - (sldb-frame-line-face ((t (nil)))) - (sldb-local-name-face ((t (nil)))) - (sldb-local-value-face ((t (nil)))) - (sldb-reference-face ((t (nil)))) - (sldb-restart-face ((t (nil)))) - (sldb-restart-number-face ((t (nil)))) - (sldb-restart-type-face ((t (nil)))) - (sldb-section-face ((t (nil)))) - (sldb-topline-face ((t (nil)))) - (slime-error-face ((t (:bold t :foreground "red" :weight bold)))) - (slime-highlight-edits-face ((t (nil)))) - (slime-highlight-face ((t (nil)))) - (slime-inspector-action-face ((t (nil)))) - (slime-inspector-label-face ((t (nil)))) - (slime-inspector-topline-face ((t (nil)))) - (slime-inspector-type-face ((t (nil)))) - (slime-inspector-value-face ((t (nil)))) - (slime-note-face ((t (:foreground "gray40")))) - (slime-reader-conditional-face ((t (nil)))) - (slime-repl-input-face ((t (:foreground "yellow")))) - (slime-repl-inputed-output-face ((t (:foreground "cyan")))) - (slime-repl-output-face ((t (:foreground "gray60")))) - (slime-repl-output-mouseover-face ((t (nil)))) - (slime-repl-prompt-face ((t (:bold t :foreground "white" :weight bold)))) - (slime-repl-result-face ((t (:foreground "blue")))) - (slime-style-warning-face ((t (nil)))) - (slime-warning-face ((t (:foreground "red")))) - (smerge-base-face ((t (:foreground "red")))) - (smerge-markers-face ((t (:background "grey85")))) - (smerge-mine-face ((t (:foreground "Gray85")))) - (smerge-other-face ((t (:foreground "darkgreen")))) - (sml-yacc-bnf-face ((t (nil)))) - (spam-face ((t (:foreground "ivory2")))) - (speedbar-button ((t (nil)))) - (speedbar-button-face ((t (:foreground "seashell2")))) - (speedbar-directory ((t (nil)))) - (speedbar-directory-face ((t (:foreground "seashell3")))) - (speedbar-file ((t (nil)))) - (speedbar-file-face ((t (:foreground "seashell4")))) - (speedbar-highlight ((t (nil)))) - (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) - (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) - (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) - (speedbar-tag ((t (nil)))) - (speedbar-tag-face ((t (:foreground "antique white")))) - (strokes-char ((t (nil)))) - (strokes-char-face ((t (:background "lightgray")))) - (swbuff-current-buffer-face ((t (:bold t :foreground "gray85" :weight bold)))) - (table-cell-face ((t (:inverse-video nil)))) - (tcl-escaped-newline ((t (:foreground "gray60")))) - (temp-face- ((t (nil)))) - (template-message-face ((t (:bold t :weight bold)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-blue-bold-face ((t (nil)))) - (term-blue-face ((t (nil)))) - (term-blue-inv-face ((t (nil)))) - (term-blue-ul-face ((t (nil)))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t :weight bold)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyan-bold-face ((t (nil)))) - (term-cyan-face ((t (nil)))) - (term-cyan-inv-face ((t (nil)))) - (term-cyan-ul-face ((t (nil)))) - (term-cyanbg ((t (:background "cyan")))) - (term-default ((t (:background "gray80" :foreground "gray30" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-bold-face ((t (nil)))) - (term-default-face ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-default-inv-face ((t (nil)))) - (term-default-ul-face ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-green-bold-face ((t (nil)))) - (term-green-face ((t (nil)))) - (term-green-inv-face ((t (nil)))) - (term-green-ul-face ((t (nil)))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magenta-bold-face ((t (nil)))) - (term-magenta-face ((t (nil)))) - (term-magenta-inv-face ((t (nil)))) - (term-magenta-ul-face ((t (nil)))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-red-bold-face ((t (nil)))) - (term-red-face ((t (nil)))) - (term-red-inv-face ((t (nil)))) - (term-red-ul-face ((t (nil)))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-white-bold-face ((t (nil)))) - (term-white-face ((t (nil)))) - (term-white-inv-face ((t (nil)))) - (term-white-ul-face ((t (nil)))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellow-bold-face ((t (nil)))) - (term-yellow-face ((t (nil)))) - (term-yellow-inv-face ((t (nil)))) - (term-yellow-ul-face ((t (nil)))) - (term-yellowbg ((t (:background "yellow")))) - (tex-math-face ((t (:foreground "RosyBrown")))) - (texinfo-heading-face ((t (:foreground "Blue")))) - (text-cursor ((t (:background "Red3" :foreground "gray80")))) - - (headline-face ((t (:foreground "yellow" :bold t :weight bold :background "gray18")))) - - (todo-comment-face ((t (:background "red" :foreground "yellow")))) - (todo-comment-text-face ((t (:italic t :slant italic)))) - - (todoo-item-assigned-header ((t (nil)))) - (todoo-item-assigned-header-face ((t (nil)))) - (todoo-item-header ((t (nil)))) - (todoo-item-header-face ((t (nil)))) - (todoo-sub-item-header ((t (nil)))) - (todoo-sub-item-header-face ((t (nil)))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (tuareg-font-lock-governing ((t (nil)))) - (tuareg-font-lock-governing-face ((t (nil)))) - (tuareg-font-lock-interactive-error ((t (nil)))) - (tuareg-font-lock-interactive-error-face ((t (nil)))) - (tuareg-font-lock-interactive-output ((t (nil)))) - (tuareg-font-lock-interactive-output-face ((t (nil)))) - (tuareg-font-lock-operator ((t (nil)))) - (tuareg-font-lock-operator-face ((t (nil)))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) - (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) - (vertical-border ((t (nil)))) - (vertical-divider ((t (:background "Gray80")))) - (vhdl-font-lock-attribute-face ((t (:foreground "gray85")))) - (vhdl-font-lock-directive-face ((t (:foreground "gray85")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "gray85")))) - (vhdl-font-lock-function-face ((t (:foreground "gray85")))) - (vhdl-font-lock-generic-/constant-face ((t (:foreground "BurlyWood1")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "gray85" :weight bold)))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "gray85" :weight bold)))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-font-lock-type-face ((t (:foreground "PaleGreen")))) - (vhdl-font-lock-variable-face ((t (:foreground "Grey80")))) - (vhdl-speedbar-architecture-face ((t (:foreground "gray85")))) - (vhdl-speedbar-architecture-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-configuration-face ((t (:foreground "gray85")))) - (vhdl-speedbar-configuration-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-entity-face ((t (:foreground "gray85")))) - (vhdl-speedbar-entity-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-instantiation-face ((t (:foreground "gray85")))) - (vhdl-speedbar-instantiation-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-library-face ((t (:foreground "Orchid1")))) - (vhdl-speedbar-package-face ((t (:foreground "gray85")))) - (vhdl-speedbar-package-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-subprogram-face ((t (:foreground "BurlyWood2")))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (vm-header-content-face ((t (:italic t :foreground "wheat" :slant italic)))) - (vm-header-from-face ((t (:italic t :foreground "wheat" :slant italic)))) - (vm-header-name-face ((t (:foreground "cyan")))) - (vm-header-subject-face ((t (:foreground "cyan")))) - (vm-header-to-face ((t (:italic t :foreground "cyan" :slant italic)))) - (vm-message-cited-face ((t (:foreground "Gray80")))) - (vm-monochrome-image ((t (:background "white" :foreground "gray30")))) - (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) - (vm-summary-highlight-face ((t (:foreground "White")))) - (vm-xface ((t (:background "white" :foreground "gray30")))) - (vmpc-pre-sig-face ((t (:foreground "gray85")))) - (vmpc-sig-face ((t (:foreground "gray85")))) - (vvb-face ((t (:background "pink" :foreground "gray30")))) - (w3m-anchor ((t (:foreground "gold" :underline "yellow")))) - (w3m-anchor-face ((t (:foreground "yellowgreen" :underline "yellow")))) - (w3m-arrived-anchor ((t (nil)))) - (w3m-arrived-anchor-face ((t (:foreground "gold")))) - (w3m-bold-face ((t (:foreground "yellow" :bold t :weight bold)))) - (w3m-current-anchor-face ((t (:foreground "yellow" :background "blue")))) - (w3m-current-anchor ((t (:foreground "gold" :background "blue")))) - (w3m-form ((t (nil)))) - (w3m-form-button ((t (nil)))) - (w3m-form-button-face ((t (nil)))) - (w3m-form-button-mouse ((t (nil)))) - (w3m-form-button-mouse-face ((t (nil)))) - (w3m-form-button-pressed ((t (nil)))) - (w3m-form-button-pressed-face ((t (nil)))) - (w3m-form-face ((t (nil)))) - (w3m-header-line-location-content-face ((t (:foreground "gray80")))) - (w3m-header-line-location-title-face ((t (:foreground "gray50" :underline "gray60")))) - (w3m-history-current-url-face ((t (nil)))) - (w3m-image ((t (nil)))) - (w3m-image-face ((t (nil)))) - (w3m-strike-through-face ((t (nil)))) - (w3m-tab-background ((t (nil)))) - (w3m-tab-background-face ((t (nil)))) - (w3m-tab-selected ((t (nil)))) - (w3m-tab-selected-face ((t (nil)))) - (w3m-tab-selected-retrieving ((t (nil)))) - (w3m-tab-selected-retrieving-face ((t (nil)))) - (w3m-tab-unselected ((t (nil)))) - (w3m-tab-unselected-face ((t (nil)))) - (w3m-tab-unselected-retrieving ((t (nil)))) - (w3m-tab-unselected-retrieving-face ((t (nil)))) - (w3m-underline-face ((t (nil)))) - (which-func ((t (:foreground "Blue1")))) - (white ((t (:foreground "white")))) - (whitespace-highlight-face ((t (nil)))) - (widget ((t (nil)))) - (widget-button ((t (:bold t :weight bold)))) - (widget-button-highlight ((t (nil)))) - (widget-button-highlight-face ((t (nil)))) - (widget-button-pressed ((t (:foreground "red")))) - (widget-button-pressed-highlight ((t (nil)))) - (widget-button-pressed-highlight-face ((t (nil)))) - (widget-documentation ((t (:foreground "light blue")))) - (widget-field ((t (:background "dim gray" :foreground "white")))) - (widget-inactive ((t (:foreground "light gray")))) - (widget-single-line-field ((t (:background "slate gray" :foreground "gray30")))) - (woman-addition-face ((t (:foreground "orange")))) - (woman-bold-face ((t (:bold t :foreground "sky blue" :weight bold)))) - (woman-italic-face ((t (:foreground "deep sky blue")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (x-face ((t (:background "white" :foreground "gray30")))) - (x-symbol-adobe-fontspecific-face ((t (nil)))) - (x-symbol-face ((t (nil)))) - (x-symbol-heading-face ((t (nil)))) - (x-symbol-info-face ((t (nil)))) - (x-symbol-invisible-face ((t (nil)))) - (x-symbol-revealed-face ((t (nil)))) - (xrdb-option-name-face ((t (:foreground "gray85")))) - (xref-keyword-face ((t (:foreground "gray85")))) - (xref-list-default-face ((t (nil)))) - (xref-list-pilot-face ((t (:foreground "gray85")))) - (xref-list-symbol-face ((t (:foreground "navy")))) - (xsl-fo-alternate-face ((t (:foreground "Yellow")))) - (xsl-fo-main-face ((t (:foreground "PaleGreen")))) - (xsl-other-element-face ((t (:foreground "Coral")))) - (xsl-xslt-alternate-face ((t (:foreground "LightGray")))) - (xsl-xslt-main-face ((t (:foreground "Wheat")))) - (xxml-emph-1-face ((t (:background "lightyellow")))) - (xxml-emph-2-face ((t (:background "lightyellow")))) - (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) - (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) - (xxml-header-3-face ((t (:background "seashell1")))) - (xxml-header-4-face ((t (:background "seashell1")))) - (xxml-interaction-face ((t (:background "lightcyan")))) - (xxml-rug-face ((t (:background "cyan")))) - (xxml-sparkle-face ((t (:background "yellow")))) - (xxml-unbreakable-space-face ((t (:foreground "grey" :underline t)))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "grey30"))))))) - -(provide 'color-theme-eon) -;;; color-theme-eon.el ends here diff --git a/emacs/external/color-theme-library.el b/emacs/external/color-theme-library.el deleted file mode 100644 index 39a18bb..0000000 --- a/emacs/external/color-theme-library.el +++ /dev/null @@ -1,13539 +0,0 @@ -;;; color-theme-library.el --- The real color theme functions - -;; Copyright (C) 2005, 2006 Xavier Maillard -;; Copyright (C) 2005, 2006 Brian Palmer - -;; Version: 0.0.9 -;; Keywords: faces -;; Author: Brian Palmer, Xavier Maillard -;; Maintainer: Xavier Maillard -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme - -;; This file is not (YET) part of GNU Emacs. - -;; This 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 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. - -;; Code: -(eval-when-compile - (require 'color-theme)) - -(defun color-theme-gnome () - "Wheat on darkslategrey scheme. -From one version of Emacs in RH6 and Gnome, modified by Jonadab." - (interactive) - (color-theme-install - '(color-theme-gnome - ((foreground-color . "wheat") - (background-color . "darkslategrey") - (background-mode . dark)) - (default ((t (nil)))) - (region ((t (:foreground "cyan" :background "dark cyan")))) - (underline ((t (:foreground "yellow" :underline t)))) - (modeline ((t (:foreground "dark cyan" :background "wheat")))) - (modeline-buffer-id ((t (:foreground "dark cyan" :background "wheat")))) - (modeline-mousable ((t (:foreground "dark cyan" :background "wheat")))) - (modeline-mousable-minor-mode ((t (:foreground "dark cyan" :background "wheat")))) - (italic ((t (:foreground "dark red" :italic t)))) - (bold-italic ((t (:foreground "dark red" :bold t :italic t)))) - (font-lock-comment-face ((t (:foreground "Firebrick")))) - (bold ((t (:bold))))))) - -(defun color-theme-blue-gnus () - "Color theme for gnus and message faces only. -This is intended for other color themes to use (eg. `color-theme-gnome2' -and `color-theme-blue-sea')." - (interactive) - (color-theme-install - '(color-theme-blue-gnus - nil - (gnus-cite-attribution-face ((t (:lforeground "lemon chiffon" :bold t)))) - (gnus-cite-face-1 ((t (:foreground "LightSalmon")))) - (gnus-cite-face-2 ((t (:foreground "Khaki")))) - (gnus-cite-face-3 ((t (:foreground "Coral")))) - (gnus-cite-face-4 ((t (:foreground "yellow green")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "bisque")))) - (gnus-cite-face-7 ((t (:foreground "peru")))) - (gnus-cite-face-8 ((t (:foreground "light coral")))) - (gnus-cite-face-9 ((t (:foreground "plum")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "White")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "White")))) - (gnus-group-mail-2-empty-face ((t (:foreground "light cyan")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "light cyan")))) - (gnus-group-mail-3-empty-face ((t (:foreground "LightBlue")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue")))) - (gnus-group-mail-low-empty-face ((t (:foreground "Aquamarine")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "Aquamarine")))) - (gnus-group-news-1-empty-face ((t (:foreground "White")))) - (gnus-group-news-1-face ((t (:bold t :foreground "White")))) - (gnus-group-news-2-empty-face ((t (:foreground "light cyan")))) - (gnus-group-news-2-face ((t (:bold t :foreground "light cyan")))) - (gnus-group-news-3-empty-face ((t (:foreground "LightBlue")))) - (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue")))) - (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) - (gnus-group-news-4-face ((t (:bold t :foreground "Aquamarine")))) - (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) - (gnus-header-from-face ((t (:bold t :foreground "light cyan")))) - (gnus-header-name-face ((t (:bold t :foreground "LightBlue")))) - (gnus-header-newsgroups-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-header-subject-face ((t (:bold t :foreground "light cyan")))) - (gnus-signature-face ((t (:foreground "Grey")))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:background "Black" :foreground "Yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "Aquamarine")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "LightSalmon")))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "beige")))) - (gnus-summary-low-ancient-face ((t (:foreground "DimGray")))) - (gnus-summary-low-read-face ((t (:foreground "slate gray")))) - (gnus-summary-low-ticked-face ((t (:foreground "Pink")))) - (gnus-summary-low-unread-face ((t (:foreground "LightGray")))) - (gnus-summary-normal-ancient-face ((t (:foreground "MediumAquamarine")))) - (gnus-summary-normal-read-face ((t (:foreground "Aquamarine")))) - (gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:background "DarkSlateBlue")))) - (message-cited-text-face ((t (:foreground "LightSalmon")))) - (message-header-cc-face ((t (:foreground "light cyan")))) - (message-header-name-face ((t (:foreground "LightBlue")))) - (message-header-newsgroups-face ((t (:bold t :foreground "MediumAquamarine")))) - (message-header-other-face ((t (:foreground "MediumAquamarine")))) - (message-header-subject-face ((t (:bold t :foreground "light cyan")))) - (message-header-to-face ((t (:bold t :foreground "light cyan")))) - (message-header-xheader-face ((t (:foreground "MediumAquamarine")))) - (message-separator-face ((t (:foreground "chocolate"))))))) - -(defun color-theme-dark-gnus () - "Color theme for gnus and message faces only. -This is intended for other color themes to use -\(eg. `color-theme-late-night')." - (interactive) - (color-theme-install - '(color-theme-blue-gnus - nil - (gnus-cite-attribution-face ((t (:foreground "#bbb")))) - (gnus-cite-face-1 ((t (:foreground "#aaa")))) - (gnus-cite-face-2 ((t (:foreground "#aaa")))) - (gnus-cite-face-3 ((t (:foreground "#aaa")))) - (gnus-cite-face-4 ((t (:foreground "#aaa")))) - (gnus-cite-face-5 ((t (:foreground "#aaa")))) - (gnus-cite-face-6 ((t (:foreground "#aaa")))) - (gnus-cite-face-7 ((t (:foreground "#aaa")))) - (gnus-cite-face-8 ((t (:foreground "#aaa")))) - (gnus-cite-face-9 ((t (:foreground "#aaa")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:foreground "#ccc")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "#999")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "#999")))) - (gnus-group-mail-2-empty-face ((t (:foreground "#999")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "#999")))) - (gnus-group-mail-3-empty-face ((t (:foreground "#888")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "#888")))) - (gnus-group-mail-low-empty-face ((t (:foreground "#777")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "#777")))) - (gnus-group-news-1-empty-face ((t (:foreground "#999")))) - (gnus-group-news-1-face ((t (:bold t :foreground "#999")))) - (gnus-group-news-2-empty-face ((t (:foreground "#888")))) - (gnus-group-news-2-face ((t (:bold t :foreground "#888")))) - (gnus-group-news-3-empty-face ((t (:foreground "#777")))) - (gnus-group-news-3-face ((t (:bold t :foreground "#777")))) - (gnus-group-news-4-empty-face ((t (:foreground "#666")))) - (gnus-group-news-4-face ((t (:bold t :foreground "#666")))) - (gnus-group-news-5-empty-face ((t (:foreground "#666")))) - (gnus-group-news-5-face ((t (:bold t :foreground "#666")))) - (gnus-group-news-6-empty-face ((t (:foreground "#666")))) - (gnus-group-news-6-face ((t (:bold t :foreground "#666")))) - (gnus-group-news-low-empty-face ((t (:foreground "#666")))) - (gnus-group-news-low-face ((t (:bold t :foreground "#666")))) - (gnus-header-content-face ((t (:foreground "#888")))) - (gnus-header-from-face ((t (:bold t :foreground "#888")))) - (gnus-header-name-face ((t (:bold t :foreground "#777")))) - (gnus-header-newsgroups-face ((t (:bold t :foreground "#777")))) - (gnus-header-subject-face ((t (:bold t :foreground "#999")))) - (gnus-signature-face ((t (:foreground "#444")))) - (gnus-splash-face ((t (:foreground "#ccc")))) - (gnus-summary-cancelled-face ((t (:background "#555" :foreground "#000")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "#555")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "#666")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "#777")))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "#888")))) - (gnus-summary-low-ancient-face ((t (:foreground "#444")))) - (gnus-summary-low-read-face ((t (:foreground "#555")))) - (gnus-summary-low-ticked-face ((t (:foreground "#666")))) - (gnus-summary-low-unread-face ((t (:foreground "#777")))) - (gnus-summary-normal-ancient-face ((t (:foreground "#555")))) - (gnus-summary-normal-read-face ((t (:foreground "#666")))) - (gnus-summary-normal-ticked-face ((t (:foreground "#777")))) - (gnus-summary-normal-unread-face ((t (:foreground "#888")))) - (gnus-summary-selected-face ((t (:background "#333")))) - (message-cited-text-face ((t (:foreground "#aaa")))) - (message-header-cc-face ((t (:foreground "#888")))) - (message-header-name-face ((t (:bold t :foreground "#777")))) - (message-header-newsgroups-face ((t (:bold t :foreground "#777")))) - (message-header-other-face ((t (:foreground "#666")))) - (message-header-subject-face ((t (:bold t :foreground "#999")))) - (message-header-to-face ((t (:bold t :foreground "#777")))) - (message-header-xheader-face ((t (:foreground "#666")))) - (message-separator-face ((t (:foreground "#999"))))))) - -(defun color-theme-blue-eshell () - "Color theme for eshell faces only. -This is intended for other color themes to use (eg. `color-theme-gnome2')." - (interactive) - (color-theme-install - '(color-theme-blue-eshell - nil - (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) - (eshell-ls-backup-face ((t (:foreground "Grey")))) - (eshell-ls-clutter-face ((t (:foreground "DimGray")))) - (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) - (eshell-ls-executable-face ((t (:foreground "Coral")))) - (eshell-ls-missing-face ((t (:foreground "black")))) - (eshell-ls-picture-face ((t (:foreground "Violet")))) ; non-standard face - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) - (eshell-ls-special-face ((t (:foreground "Gold")))) - (eshell-ls-symlink-face ((t (:foreground "White")))) - (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) ; non-standard face - (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine")))) ; non-standard face - (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) - (eshell-prompt-face ((t (:foreground "powder blue"))))))) - -(defun color-theme-salmon-font-lock () - "Color theme for font-lock faces only. -This is intended for other color themes to use (eg. `color-theme-gnome2')." - (interactive) - (color-theme-install - '(color-theme-salmon-font-lock - nil - (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen")))) - (font-lock-comment-face ((t (:foreground "LightBlue")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) - (font-lock-function-name-face ((t (:bold t :foreground "Aquamarine")))) - (font-lock-keyword-face ((t (:foreground "Salmon")))) - (font-lock-preprocessor-face ((t (:foreground "Salmon")))) - (font-lock-reference-face ((t (:foreground "pale green")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:bold t :foreground "YellowGreen")))) - (font-lock-variable-name-face ((t (:bold t :foreground "Aquamarine")))) - (font-lock-warning-face ((t (:bold t :foreground "red"))))))) - -(defun color-theme-dark-font-lock () - "Color theme for font-lock faces only. -This is intended for other color themes to use (eg. `color-theme-late-night')." - (interactive) - (color-theme-install - '(color-theme-dark-font-lock - nil - (font-lock-builtin-face ((t (:bold t :foreground "#777")))) - (font-lock-comment-face ((t (:foreground "#555")))) - (font-lock-constant-face ((t (:foreground "#777")))) - (font-lock-doc-string-face ((t (:foreground "#777")))) - (font-lock-doc-face ((t (:foreground "#777")))) - (font-lock-function-name-face ((t (:bold t :foreground "#777")))) - (font-lock-keyword-face ((t (:foreground "#777")))) - (font-lock-preprocessor-face ((t (:foreground "#777")))) - (font-lock-reference-face ((t (:foreground "#777")))) - (font-lock-string-face ((t (:foreground "#777")))) - (font-lock-type-face ((t (:bold t)))) - (font-lock-variable-name-face ((t (:bold t :foreground "#888")))) - (font-lock-warning-face ((t (:bold t :foreground "#999"))))))) - -(defun color-theme-dark-info () - "Color theme for info, help and apropos faces. -This is intended for other color themes to use (eg. `color-theme-late-night')." - (interactive) - (color-theme-install - '(color-theme-dark-info - nil - (info-header-node ((t (:foreground "#666")))) - (info-header-xref ((t (:foreground "#666")))) - (info-menu-5 ((t (:underline t)))) - (info-menu-header ((t (:bold t :foreground "#666")))) - (info-node ((t (:bold t :foreground "#888")))) - (info-xref ((t (:bold t :foreground "#777"))))))) - -(defun color-theme-gnome2 () - "Wheat on darkslategrey scheme. -`color-theme-gnome' started it all. - -This theme supports standard faces, font-lock, eshell, info, message, -gnus, custom, widget, woman, diary, cperl, bbdb, and erc. This theme -includes faces for Emacs and XEmacs. - -The theme does not support w3 faces because w3 faces can be controlled -by your default style sheet. - -This is what you should put in your .Xdefaults file, if you want to -change the colors of the menus in Emacs 20 as well: - -emacs*Background: DarkSlateGray -emacs*Foreground: Wheat" - (interactive) - (color-theme-blue-gnus) - (let ((color-theme-is-cumulative t)) - (color-theme-blue-erc) - (color-theme-blue-eshell) - (color-theme-salmon-font-lock) - (color-theme-salmon-diff) - (color-theme-install - '(color-theme-gnome2 - ((foreground-color . "wheat") - (background-color . "darkslategrey") - (mouse-color . "Grey") - (cursor-color . "LightGray") - (border-color . "black") - (background-mode . dark)) - ((apropos-keybinding-face . underline) - (apropos-label-face . italic) - (apropos-match-face . secondary-selection) - (apropos-property-face . bold-italic) - (apropos-symbol-face . info-xref) - (goto-address-mail-face . message-header-to-face) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . info-xref) - (goto-address-url-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bbdb-company ((t (:foreground "pale green")))) - (bbdb-name ((t (:bold t :foreground "pale green")))) - (bbdb-field-name ((t (:foreground "medium sea green")))) - (bbdb-field-value ((t (:foreground "dark sea green")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t :foreground "beige")))) - (calendar-today-face ((t (:underline t)))) - (comint-highlight-prompt ((t (:foreground "medium aquamarine")))) - (cperl-array-face ((t (:foreground "Yellow")))) - (cperl-hash-face ((t (:foreground "White")))) - (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) - (custom-button-face ((t (:underline t :foreground "MediumSlateBlue")))) - (custom-documentation-face ((t (:foreground "Grey")))) - (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) - (custom-state-face ((t (:foreground "LightSalmon")))) - (custom-variable-tag-face ((t (:foreground "Aquamarine")))) - (diary-face ((t (:foreground "IndianRed")))) - (dired-face-directory ((t (:bold t :foreground "sky blue")))) - (dired-face-permissions ((t (:foreground "aquamarine")))) - (dired-face-flagged ((t (:foreground "tomato")))) - (dired-face-marked ((t (:foreground "light salmon")))) - (dired-face-executable ((t (:foreground "green yellow")))) - (fringe ((t (:background "darkslategrey")))) - (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) - (highline-face ((t (:background "SeaGreen")))) - (holiday-face ((t (:background "DimGray")))) - (hyper-apropos-hyperlink ((t (:bold t :foreground "DodgerBlue1")))) - (hyper-apropos-documentation ((t (:foreground "LightSalmon")))) - (info-header-xref ((t (:foreground "DodgerBlue1" :bold t)))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) - (info-xref ((t (:bold t :foreground "DodgerBlue1")))) - (isearch ((t (:background "sea green")))) - (italic ((t (:italic t)))) - (menu ((t (:foreground "wheat" :background "darkslategrey")))) - (modeline ((t (:background "dark olive green" :foreground "wheat")))) - (modeline-buffer-id ((t (:background "dark olive green" :foreground "beige")))) - (modeline-mousable ((t (:background "dark olive green" :foreground "yellow green")))) - (modeline-mousable-minor-mode ((t (:background "dark olive green" :foreground "wheat")))) - (region ((t (:background "dark cyan" :foreground "cyan")))) - (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) - (show-paren-match-face ((t (:bold t :background "Aquamarine" :foreground "steel blue")))) - (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) - (underline ((t (:underline t)))) - (widget-field-face ((t (:foreground "LightBlue")))) - (widget-inactive-face ((t (:foreground "DimGray")))) - (widget-single-line-field-face ((t (:foreground "LightBlue")))) - (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1")))) - (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3")))) - (w3m-header-line-location-title-face ((t (:foreground "beige" :background "dark olive green")))) - (w3m-header-line-location-content-face ((t (:foreground "wheat" :background "dark olive green")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (zmacs-region ((t (:background "dark cyan" :foreground "cyan")))))))) - -(defun color-theme-simple-1 () - "Black background. -Doesn't mess with most faces, but does turn on dark background mode." - (interactive) - (color-theme-install - '(color-theme-simple-1 - ((foreground-color . "white") - (background-color . "black") - (cursor-color . "indian red") - (background-mode . dark)) - (default ((t (nil)))) - (modeline ((t (:foreground "black" :background "white")))) - (modeline-buffer-id ((t (:foreground "black" :background "white")))) - (modeline-mousable ((t (:foreground "black" :background "white")))) - (modeline-mousable-minor-mode ((t (:foreground "black" :background "white")))) - (underline ((t (:underline t)))) - (region ((t (:background "grey"))))))) - -(defun color-theme-jonadabian () - "Dark blue background. -Supports standard faces, font-lock, highlight-changes, widget and -custom." - (interactive) - (color-theme-install - '(color-theme-jonadabian - ((foreground-color . "#CCBB77") - (cursor-color . "medium turquoise") - (background-color . "#000055") - (background-mode . dark)) - (default ((t (nil)))) - (modeline ((t (:foreground "cyan" :background "#007080")))) - (modeline-buffer-id ((t (:foreground "cyan" :background "#007080")))) - (modeline-mousable ((t (:foreground "cyan" :background "#007080")))) - (modeline-mousable-minor-mode ((t (:foreground "cyan" :background "#007080")))) - (underline ((t (:underline t)))) - (region ((t (:background "#004080")))) - (font-lock-keyword-face ((t (:foreground "#00BBBB")))) - (font-lock-comment-face ((t (:foreground "grey50" :bold t :italic t)))) - (font-lock-string-face ((t (:foreground "#10D010")))) - (font-lock-constant-face ((t (:foreground "indian red")))) - (highlight-changes-face ((t (:background "navy")))) - (highlight-changes-delete-face ((t (:foreground "red" :background "navy")))) - (widget-field-face ((t (:foreground "black" :background "grey35")))) - (widget-inactive-face ((t (:foreground "gray")))) - (custom-button-face ((t (:foreground "yellow" :background "dark blue")))) - (custom-state-face ((t (:foreground "mediumaquamarine")))) - (custom-face-tag-face ((t (:foreground "goldenrod" :underline t)))) - (custom-documentation-face ((t (:foreground "#10D010")))) - (custom-set-face ((t (:foreground "#2020D0"))))))) - -(defun color-theme-ryerson () - "White on midnightblue scheme. -Used at Ryerson Polytechnic University in the Electronic Engineering department." - (interactive) - (color-theme-install - '(color-theme-ryerson - ((foreground-color . "white") - (background-color . "midnightblue") - (cursor-color . "red") - (background-mode . dark)) - (default ((t (nil)))) - (modeline ((t (:foreground "black" :background "slategray3")))) - (modeline-buffer-id ((t (:foreground "black" :background "slategray3")))) - (modeline-mousable ((t (:foreground "black" :background "slategray3")))) - (modeline-mousable-minor-mode ((t (:foreground "black" :background "slategray3")))) - (underline ((t (:underline t)))) - (region ((t (:foreground "black" :background "slategray3"))))))) - -(defun color-theme-wheat () - "Default colors on a wheat background. -Calls the standard color theme function `color-theme-standard' in order -to reset all faces." - (interactive) - (color-theme-standard) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-wheat - ((background-color . "Wheat")))))) - -(defun color-theme-standard () - "Emacs default colors. -If you are missing standard faces in this theme, please notify the maintainer." - (interactive) - ;; Note that some of the things that make up a color theme are - ;; actually variable settings! - (color-theme-install - '(color-theme-standard - ((foreground-color . "black") - (background-color . "white") - (mouse-color . "black") - (cursor-color . "black") - (border-color . "black") - (background-mode . light)) - ((Man-overstrike-face . bold) - (Man-underline-face . underline) - (apropos-keybinding-face . underline) - (apropos-label-face . italic) - (apropos-match-face . secondary-selection) - (apropos-property-face . bold-italic) - (apropos-symbol-face . bold) - (goto-address-mail-face . italic) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . bold) - (goto-address-url-mouse-face . highlight) - (help-highlight-face . underline) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:bold t :italic t)))) - (calendar-today-face ((t (:underline t)))) - (cperl-array-face ((t (:foreground "Blue" :background "lightyellow2" :bold t)))) - (cperl-hash-face ((t (:foreground "Red" :background "lightyellow2" :bold t :italic t)))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:foreground "white" :background "blue")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:foreground "blue" :underline t)))) - (custom-group-tag-face-1 ((t (:foreground "red" :underline t)))) - (custom-invalid-face ((t (:foreground "yellow" :background "red")))) - (custom-modified-face ((t (:foreground "white" :background "blue")))) - (custom-rogue-face ((t (:foreground "pink" :background "black")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:foreground "blue" :background "white")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:bold t :underline t)))) - (custom-variable-tag-face ((t (:foreground "blue" :underline t)))) - (diary-face ((t (:foreground "red")))) - (ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) - (ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) - (ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) - (ediff-current-diff-face-C ((t (:foreground "Navy" :background "Pink")))) - (ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) - (ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) - (ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) - (ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) - (ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) - (ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) - (ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) - (ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) - (ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) - (ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) - (ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) - (ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) - (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t)))) - (eshell-ls-directory-face ((t (:foreground "Blue" :bold t)))) - (eshell-ls-executable-face ((t (:foreground "ForestGreen" :bold t)))) - (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) - (eshell-ls-symlink-face ((t (:foreground "DarkCyan" :bold t)))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:foreground "Red" :bold t)))) - (eshell-test-failed-face ((t (:foreground "OrangeRed" :bold t)))) - (eshell-test-ok-face ((t (:foreground "Green" :bold t)))) - (excerpt ((t (:italic t)))) - (fixed ((t (:bold t)))) - (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t)))) - (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:foreground "Firebrick")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-keyword-face ((t (:foreground "Purple")))) - (font-lock-string-face ((t (:foreground "RosyBrown")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:foreground "Red" :bold t)))) - (fringe ((t (:background "grey95")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) - (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:foreground "DeepPink3" :bold t)))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:foreground "HotPink3" :bold t)))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:foreground "magenta4" :bold t)))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:foreground "DeepPink4" :bold t)))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:foreground "ForestGreen" :bold t)))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:foreground "CadetBlue4" :bold t)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:foreground "DarkGreen" :bold t)))) - (gnus-header-content-face ((t (:foreground "indianred4" :italic t)))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue" :italic t)))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) - (gnus-summary-high-ancient-face ((t (:foreground "RoyalBlue" :bold t)))) - (gnus-summary-high-read-face ((t (:foreground "DarkGreen" :bold t)))) - (gnus-summary-high-ticked-face ((t (:foreground "firebrick" :bold t)))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue" :italic t)))) - (gnus-summary-low-read-face ((t (:foreground "DarkGreen" :italic t)))) - (gnus-summary-low-ticked-face ((t (:foreground "firebrick" :italic t)))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (highlight ((t (:background "darkseagreen2")))) - (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "paleturquoise")))) - (holiday-face ((t (:background "pink")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:bold t :italic t)))) - (info-xref ((t (:bold t)))) - (italic ((t (:italic t)))) - (makefile-space-face ((t (:background "hotpink")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:foreground "blue4" :bold t :italic t)))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:foreground "navy blue" :bold t)))) - (message-header-to-face ((t (:foreground "MidnightBlue" :bold t)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:foreground "white" :background "black")))) - (modeline-buffer-id ((t (:foreground "white" :background "black")))) - (modeline-mousable ((t (:foreground "white" :background "black")))) - (modeline-mousable-minor-mode ((t (:foreground "white" :background "black")))) - (region ((t (:background "gray")))) - (secondary-selection ((t (:background "paleturquoise")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "brown")))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (underline ((t (:underline t)))) - (vcursor ((t (:foreground "blue" :background "cyan" :underline t)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:foreground "Red" :bold t)))) - (vhdl-font-lock-reserved-words-face ((t (:foreground "Orange" :bold t)))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) - (viper-minibuffer-emacs-face ((t (:foreground "Black" :background "darkseagreen2")))) - (viper-minibuffer-insert-face ((t (:foreground "Black" :background "pink")))) - (viper-minibuffer-vi-face ((t (:foreground "DarkGreen" :background "grey")))) - (viper-replace-overlay-face ((t (:foreground "Black" :background "darkseagreen2")))) - (viper-search-face ((t (:foreground "Black" :background "khaki")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - -(defun color-theme-fischmeister () - "The light colors on a grey blackground. -Sebastian Fischmeister " - (interactive) - (color-theme-install - '(color-theme-fischmeister - ((foreground-color . "black") - (background-color . "gray80") - (mouse-color . "red") - (cursor-color . "yellow") - (border-color . "black") - (background-mode . light)) - (default ((t (nil)))) - (modeline ((t (:foreground "gray80" :background "black")))) - (modeline-buffer-id ((t (:foreground "gray80" :background "black")))) - (modeline-mousable ((t (:foreground "gray80" :background "black")))) - (modeline-mousable-minor-mode ((t (:foreground "gray80" :background "black")))) - (highlight ((t (:background "darkseagreen2")))) - (bold ((t (:bold t)))) - (italic ((t (:italic t)))) - (bold-italic ((t (:bold t :italic t)))) - (region ((t (:background "gray")))) - (secondary-selection ((t (:background "paleturquoise")))) - (underline ((t (:underline t)))) - (show-paren-match-face ((t (:foreground "yellow" :background "darkgreen")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) - (font-lock-comment-face ((t (:foreground "FireBrick" :bold t :italic t)))) - (font-lock-string-face ((t (:foreground "DarkSlateBlue" :italic t)))) - (font-lock-keyword-face ((t (:foreground "navy")))) - (font-lock-builtin-face ((t (:foreground "white")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-variable-name-face ((t (:foreground "Darkblue")))) - (font-lock-type-face ((t (:foreground "darkgreen")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-warning-face ((t (:foreground "Orchid" :bold t)))) - (font-lock-reference-face ((t (:foreground "SteelBlue"))))))) - -(defun color-theme-sitaramv-solaris () - "White on a midnight blue background. Lots of yellow and orange. -Includes faces for font-lock, widget, custom, speedbar, message, gnus, -eshell." - (interactive) - (color-theme-install - '(color-theme-sitaramv-solaris - ((foreground-color . "white") - (background-color . "MidnightBlue") - (mouse-color . "yellow") - (cursor-color . "magenta2") - (border-color . "black") - (background-mode . dark)) - (default ((t (nil)))) - (modeline ((t (:foreground "black" :background "gold2")))) - (modeline-buffer-id ((t (:foreground "black" :background "gold2")))) - (modeline-mousable ((t (:foreground "black" :background "gold2")))) - (modeline-mousable-minor-mode ((t (:foreground "black" :background "gold2")))) - (highlight ((t (:foreground "black" :background "Aquamarine")))) - (bold ((t (:bold t)))) - (italic ((t (:italic t)))) - (bold-italic ((t (:bold t :italic t)))) - (region ((t (:foreground "black" :background "snow3")))) - (secondary-selection ((t (:foreground "black" :background "aquamarine")))) - (underline ((t (:underline t)))) - (lazy-highlight-face ((t (:foreground "yellow")))) - (font-lock-comment-face ((t (:foreground "orange" :italic t)))) - (font-lock-string-face ((t (:foreground "orange")))) - (font-lock-keyword-face ((t (:foreground "green")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-function-name-face ((t (:foreground "cyan" :bold t)))) - (font-lock-variable-name-face ((t (:foreground "white")))) - (font-lock-type-face ((t (:foreground "cyan")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-warning-face ((t (:foreground "Pink" :bold t)))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-button-face ((t (:bold t)))) - (widget-field-face ((t (:background "dim gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (custom-invalid-face ((t (:foreground "yellow" :background "red")))) - (custom-rogue-face ((t (:foreground "pink" :background "black")))) - (custom-modified-face ((t (:foreground "white" :background "blue")))) - (custom-set-face ((t (:foreground "blue" :background "white")))) - (custom-changed-face ((t (:foreground "white" :background "blue")))) - (custom-saved-face ((t (:underline t)))) - (custom-button-face ((t (nil)))) - (custom-documentation-face ((t (nil)))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-tag-face ((t (:foreground "light blue" :underline t)))) - (custom-variable-button-face ((t (:bold t :underline t)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face-1 ((t (:foreground "pink" :underline t)))) - (custom-group-tag-face ((t (:foreground "light blue" :underline t)))) - (speedbar-button-face ((t (:foreground "green3")))) - (speedbar-file-face ((t (:foreground "cyan")))) - (speedbar-directory-face ((t (:foreground "light blue")))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-highlight-face ((t (:background "sea green")))) - (font-lock-doc-string-face ((t (:foreground "Plum1" :bold t)))) - (font-lock-exit-face ((t (:foreground "green")))) - (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t)))) - (show-paren-match-face ((t (:background "red")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))) - (message-header-to-face ((t (:foreground "green2" :bold t)))) - (message-header-cc-face ((t (:foreground "LightGoldenrod" :bold t)))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-newsgroups-face ((t (:foreground "yellow" :bold t :italic t)))) - (message-header-other-face ((t (:foreground "Salmon")))) - (message-header-name-face ((t (:foreground "green3")))) - (message-header-xheader-face ((t (:foreground "GreenYellow")))) - (message-separator-face ((t (:foreground "Tan")))) - (message-cited-text-face ((t (:foreground "Gold")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:foreground "PaleTurquoise" :bold t)))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-2-face ((t (:foreground "turquoise" :bold t)))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-low-face ((t (:foreground "DarkTurquoise" :bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-mail-1-face ((t (:foreground "aquamarine1" :bold t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-2-face ((t (:foreground "aquamarine2" :bold t)))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-3-face ((t (:foreground "aquamarine3" :bold t)))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-low-face ((t (:foreground "aquamarine4" :bold t)))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) - (gnus-summary-high-ticked-face ((t (:foreground "pink" :bold t)))) - (gnus-summary-low-ticked-face ((t (:foreground "pink" :italic t)))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-high-ancient-face ((t (:foreground "SkyBlue" :bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue" :italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-high-read-face ((t (:foreground "PaleGreen" :bold t)))) - (gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t)))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-splash-face ((t (:foreground "Brown")))) - (eshell-ls-directory-face ((t (:foreground "SkyBlue" :bold t)))) - (eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t)))) - (eshell-ls-executable-face ((t (:foreground "Green" :bold t)))) - (eshell-ls-readonly-face ((t (:foreground "Pink")))) - (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) - (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) - (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) - (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) - (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t)))) - (eshell-prompt-face ((t (:foreground "Pink" :bold t)))) - (term-default-fg ((t (nil)))) - (term-default-bg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-bold ((t (:bold t)))) - (term-underline ((t (:underline t)))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-black ((t (:foreground "black")))) - (term-red ((t (:foreground "red")))) - (term-green ((t (:foreground "green")))) - (term-yellow ((t (:foreground "yellow")))) - (term-blue ((t (:foreground "blue")))) - (term-magenta ((t (:foreground "magenta")))) - (term-cyan ((t (:foreground "cyan")))) - (term-white ((t (:foreground "white")))) - (term-blackbg ((t (:background "black")))) - (term-redbg ((t (:background "red")))) - (term-greenbg ((t (:background "green")))) - (term-yellowbg ((t (:background "yellow")))) - (term-bluebg ((t (:background "blue")))) - (term-magentabg ((t (:background "magenta")))) - (term-cyanbg ((t (:background "cyan")))) - (term-whitebg ((t (:background "white")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) - (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) - (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) - (gnus-emphasis-highlight-words ((t (:foreground "yellow" :background "black")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-header-from-face ((t (:foreground "spring green")))) - (gnus-header-subject-face ((t (:foreground "yellow" :bold t)))) - (gnus-header-newsgroups-face ((t (:foreground "SeaGreen3" :bold t :italic t)))) - (gnus-header-name-face ((t (:foreground "pink")))) - (gnus-header-content-face ((t (:foreground "lime green" :italic t)))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "light blue")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise"))))))) - -(defun color-theme-sitaramv-nt () - "Black foreground on white background. -Includes faces for font-lock, widget, custom, speedbar." - (interactive) - (color-theme-install - '(color-theme-sitaramv-nt - ((foreground-color . "black") - (background-color . "white") - (mouse-color . "sienna3") - (cursor-color . "HotPink") - (border-color . "Blue") - (background-mode . light)) - (default ((t (nil)))) - (modeline ((t (:foreground "black" :background "gold2")))) - (modeline-buffer-id ((t (:foreground "black" :background "gold2")))) - (modeline-mousable ((t (:foreground "black" :background "gold2")))) - (modeline-mousable-minor-mode ((t (:foreground "black" :background "gold2")))) - (highlight ((t (:foreground "black" :background "darkseagreen2")))) - (bold ((t (:bold t)))) - (italic ((t (:italic t)))) - (bold-italic ((t (:bold t :italic t)))) - (region ((t (:foreground "black" :background "snow3")))) - (secondary-selection ((t (:background "paleturquoise")))) - (underline ((t (:underline t)))) - (lazy-highlight-face ((t (:foreground "dark magenta" :bold t)))) - (font-lock-comment-face ((t (:foreground "ForestGreen" :italic t)))) - (font-lock-string-face ((t (:foreground "red")))) - (font-lock-keyword-face ((t (:foreground "blue" :bold t)))) - (font-lock-builtin-face ((t (:foreground "black")))) - (font-lock-function-name-face ((t (:foreground "dark magenta" :bold t)))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-type-face ((t (:foreground "blue")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-warning-face ((t (:foreground "Red" :bold t)))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-button-face ((t (:bold t)))) - (widget-field-face ((t (:background "gray85")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (custom-invalid-face ((t (:foreground "yellow" :background "red")))) - (custom-rogue-face ((t (:foreground "pink" :background "black")))) - (custom-modified-face ((t (:foreground "white" :background "blue")))) - (custom-set-face ((t (:foreground "blue" :background "white")))) - (custom-changed-face ((t (:foreground "white" :background "blue")))) - (custom-saved-face ((t (:underline t)))) - (custom-button-face ((t (nil)))) - (custom-documentation-face ((t (nil)))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-tag-face ((t (:foreground "blue" :underline t)))) - (custom-variable-button-face ((t (:bold t :underline t)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face-1 ((t (:foreground "red" :underline t)))) - (custom-group-tag-face ((t (:foreground "blue" :underline t)))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-highlight-face ((t (:background "green")))) - (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t)))) - (show-paren-match-face ((t (:background "light blue")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "purple"))))))) - -(defun color-theme-billw () - "Cornsilk on black. -Includes info, diary, font-lock, eshell, sgml, message, gnus, -widget, custom, latex, ediff." - (interactive) - (color-theme-install - '(color-theme-billw - ((foreground-color . "cornsilk") - (background-color . "black") - (mouse-color . "black") - (cursor-color . "white") - (border-color . "black") - (background-mode . dark)) - (default ((t (nil)))) - (modeline ((t (:foreground "black" :background "wheat")))) - (modeline-buffer-id ((t (:foreground "black" :background "wheat")))) - (modeline-mousable ((t (:foreground "black" :background "wheat")))) - (modeline-mousable-minor-mode ((t (:foreground "black" :background "wheat")))) - (highlight ((t (:foreground "wheat" :background "darkslategray")))) - (bold ((t (:bold t)))) - (italic ((t (:italic t)))) - (bold-italic ((t (:bold t :italic t)))) - (region ((t (:background "dimgray")))) - (secondary-selection ((t (:background "deepskyblue4")))) - (underline ((t (:underline t)))) - (info-node ((t (:foreground "yellow" :bold t :italic t)))) - (info-menu-5 ((t (:underline t)))) - (info-xref ((t (:foreground "yellow" :bold t)))) - (diary-face ((t (:foreground "orange")))) - (calendar-today-face ((t (:underline t)))) - (holiday-face ((t (:background "red")))) - (show-paren-match-face ((t (:background "deepskyblue4")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) - (font-lock-comment-face ((t (:foreground "gold")))) - (font-lock-string-face ((t (:foreground "orange")))) - (font-lock-keyword-face ((t (:foreground "cyan1")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-function-name-face ((t (:foreground "mediumspringgreen")))) - (font-lock-variable-name-face ((t (:foreground "light salmon")))) - (font-lock-type-face ((t (:foreground "yellow1")))) - (font-lock-constant-face ((t (:foreground "salmon")))) - (font-lock-warning-face ((t (:foreground "gold" :bold t)))) - (blank-space-face ((t (:background "LightGray")))) - (blank-tab-face ((t (:foreground "black" :background "cornsilk")))) - (highline-face ((t (:background "gray35")))) - (eshell-ls-directory-face ((t (:foreground "green" :bold t)))) - (eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t)))) - (eshell-ls-executable-face ((t (:foreground "orange" :bold t)))) - (eshell-ls-readonly-face ((t (:foreground "gray")))) - (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) - (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) - (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) - (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) - (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-clutter-face ((t (:foreground "blue" :bold t)))) - (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) - (custom-button-face ((t (:foreground "white")))) - (sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) - (sgml-doctype-face ((t (:foreground "orange")))) - (sgml-sgml-face ((t (:foreground "yellow")))) - (vc-annotate-face-0046FF ((t (:foreground "wheat" :background "black")))) - (custom-documentation-face ((t (:foreground "white")))) - (sgml-end-tag-face ((t (:foreground "greenyellow")))) - (linemenu-face ((t (:background "gray30")))) - (sgml-entity-face ((t (:foreground "gold")))) - (message-header-to-face ((t (:foreground "floral white" :bold t)))) - (message-header-cc-face ((t (:foreground "ivory")))) - (message-header-subject-face ((t (:foreground "papaya whip" :bold t)))) - (message-header-newsgroups-face ((t (:foreground "lavender blush" :bold t :italic t)))) - (message-header-other-face ((t (:foreground "pale turquoise")))) - (message-header-name-face ((t (:foreground "light sky blue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-separator-face ((t (:foreground "sandy brown")))) - (message-cited-text-face ((t (:foreground "plum1")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:foreground "white" :bold t)))) - (gnus-group-news-1-empty-face ((t (:foreground "white")))) - (gnus-group-news-2-face ((t (:foreground "lightcyan" :bold t)))) - (gnus-group-news-2-empty-face ((t (:foreground "lightcyan")))) - (gnus-group-news-3-face ((t (:foreground "tan" :bold t)))) - (gnus-group-news-3-empty-face ((t (:foreground "tan")))) - (gnus-group-news-4-face ((t (:foreground "white" :bold t)))) - (gnus-group-news-4-empty-face ((t (:foreground "white")))) - (gnus-group-news-5-face ((t (:foreground "wheat" :bold t)))) - (gnus-group-news-5-empty-face ((t (:foreground "wheat")))) - (gnus-group-news-6-face ((t (:foreground "tan" :bold t)))) - (gnus-group-news-6-empty-face ((t (:foreground "tan")))) - (gnus-group-news-low-face ((t (:foreground "DarkTurquoise" :bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-mail-1-face ((t (:foreground "white" :bold t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) - (gnus-group-mail-2-face ((t (:foreground "lightcyan" :bold t)))) - (gnus-group-mail-2-empty-face ((t (:foreground "lightcyan")))) - (gnus-group-mail-3-face ((t (:foreground "tan" :bold t)))) - (gnus-group-mail-3-empty-face ((t (:foreground "tan")))) - (gnus-group-mail-low-face ((t (:foreground "aquamarine4" :bold t)))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-summary-selected-face ((t (:background "deepskyblue4" :underline t)))) - (gnus-summary-cancelled-face ((t (:foreground "black" :background "gray")))) - (gnus-summary-high-ticked-face ((t (:foreground "gray70" :bold t)))) - (gnus-summary-low-ticked-face ((t (:foreground "gray70" :bold t)))) - (gnus-summary-normal-ticked-face ((t (:foreground "gray70" :bold t)))) - (gnus-summary-high-ancient-face ((t (:foreground "SkyBlue" :bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue" :italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-high-read-face ((t (:foreground "PaleGreen" :bold t)))) - (gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t)))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-splash-face ((t (:foreground "gold")))) - (font-latex-bold-face ((t (nil)))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (:foreground "Gray85")))) - (font-latex-string-face ((t (:foreground "orange")))) - (font-latex-warning-face ((t (:foreground "gold")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-button-face ((t (:bold t)))) - (widget-field-face ((t (:background "gray20")))) - (widget-single-line-field-face ((t (:background "gray20")))) - (widget-inactive-face ((t (:foreground "wheat")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (custom-invalid-face ((t (:foreground "yellow" :background "red")))) - (custom-rogue-face ((t (:foreground "pink" :background "black")))) - (custom-modified-face ((t (:foreground "white" :background "blue")))) - (custom-set-face ((t (:foreground "blue")))) - (custom-changed-face ((t (:foreground "wheat" :background "skyblue")))) - (custom-saved-face ((t (:underline t)))) - (custom-state-face ((t (:foreground "light green")))) - (custom-variable-tag-face ((t (:foreground "skyblue" :underline t)))) - (custom-variable-button-face ((t (:bold t :underline t)))) - (custom-face-tag-face ((t (:foreground "white" :underline t)))) - (custom-group-tag-face-1 ((t (:foreground "pink" :underline t)))) - (custom-group-tag-face ((t (:foreground "skyblue" :underline t)))) - (swbuff-current-buffer-face ((t (:foreground "red" :bold t)))) - (ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) - (ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) - (ediff-current-diff-face-C ((t (:foreground "white" :background "indianred")))) - (ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) - (ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) - (ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) - (ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) - (ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) - (ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) - (ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) - (ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) - (ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) - (ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) - (ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) - (ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) - (ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:foreground "white" :background "goldenrod4")))) - (gnus-emphasis-underline-bold ((t (:foreground "black" :background "yellow" :bold t :underline t)))) - (gnus-emphasis-underline-italic ((t (:foreground "black" :background "yellow" :italic t :underline t)))) - (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) - (gnus-emphasis-underline-bold-italic ((t (:foreground "black" :background "yellow" :bold t :italic t :underline t)))) - (gnus-emphasis-highlight-words ((t (:foreground "yellow" :background "black")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-header-from-face ((t (:foreground "wheat")))) - (gnus-header-subject-face ((t (:foreground "wheat" :bold t)))) - (gnus-header-newsgroups-face ((t (:foreground "wheat" :italic t)))) - (gnus-header-name-face ((t (:foreground "white")))) - (gnus-header-content-face ((t (:foreground "tan" :italic t)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-splash ((t (:foreground "Brown")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "light blue")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise"))))))) - -(defun color-theme-retro-green (&optional color func) - "Plain green on black faces for those longing for the good old days." - (interactive) - ;; Build a list of faces without parameters - (let ((old-faces (face-list)) - (faces) - (face) - (foreground (or color "green"))) - (dolist (face old-faces) - (cond ((memq face '(bold bold-italic)) - (add-to-list 'faces `(,face (( t (:bold t)))))) - ((memq face '(italic underline show-paren-mismatch-face)) - (add-to-list 'faces `(,face (( t (:underline t)))))) - ((memq face '(modeline modeline-buffer-id modeline-mousable - modeline-mousable-minor-mode highlight region - secondary-selection show-paren-match-face)) - (add-to-list 'faces `(,face (( t (:foreground "black" - :background ,foreground - :inverse t)))))) - (t - (add-to-list 'faces `(,face (( t (nil)))))))) - (color-theme-install - (append - (list (or func 'color-theme-retro-green) - (list (cons 'foreground-color foreground) - (cons 'background-color "black") - (cons 'mouse-color foreground) - (cons 'cursor-color foreground) - (cons 'border-color foreground) - (cons 'background-mode 'dark))) - faces)))) - -(defun color-theme-retro-orange () - "Plain orange on black faces for those longing for the good old days." - (interactive) - (color-theme-retro-green "orange" 'color-theme-retro-orange)) - -(defun color-theme-subtle-hacker () - "Subtle Hacker Color Theme. -Based on gnome2, but uses white for important things like comments, -and less of the unreadable tomato. By Colin Walters " - (interactive) - (color-theme-gnome2) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-subtle-hacker - nil - nil - (custom-state-face ((t (:foreground "Coral")))) - (diary-face ((t (:bold t :foreground "IndianRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "DimGray")))) - (eshell-ls-executable-face ((t (:bold t :foreground "Coral")))) - (eshell-ls-missing-face ((t (:bold t :foreground "black")))) - (eshell-ls-special-face ((t (:bold t :foreground "Gold")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "White")))) - (font-lock-comment-face ((t (:foreground "White")))) - (font-lock-constant-face ((t (:bold t :foreground "Aquamarine")))) - (font-lock-function-name-face ((t (:bold t :foreground "MediumSlateBlue")))) - (font-lock-string-face ((t (:italic t :foreground "LightSalmon")))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "Aquamarine")))) - (gnus-cite-face-1 ((t (:foreground "dark khaki")))) - (gnus-cite-face-2 ((t (:foreground "chocolate")))) - (gnus-cite-face-3 ((t (:foreground "tomato")))) - (gnus-group-mail-1-empty-face ((t (:foreground "light cyan")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "light cyan")))) - (gnus-group-mail-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-mail-3-empty-face ((t (:foreground "tomato")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "tomato")))) - (gnus-group-mail-low-empty-face ((t (:foreground "dodger blue")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "dodger blue")))) - (gnus-group-news-1-empty-face ((t (:foreground "green yellow")))) - (gnus-group-news-1-face ((t (:bold t :foreground "green yellow")))) - (gnus-group-news-2-empty-face ((t (:foreground "dark orange")))) - (gnus-group-news-2-face ((t (:bold t :foreground "dark orange")))) - (gnus-group-news-3-empty-face ((t (:foreground "tomato")))) - (gnus-group-news-3-face ((t (:bold t :foreground "tomato")))) - (gnus-group-news-low-empty-face ((t (:foreground "yellow green")))) - (gnus-group-news-low-face ((t (:bold t :foreground "yellow green")))) - (gnus-header-name-face ((t (:bold t :foreground "DodgerBlue1")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) - (gnus-signature-face ((t (:foreground "salmon")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "forest green")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "burlywood")))) - (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "cyan")))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "chocolate")))) - (gnus-summary-low-read-face ((t (:foreground "light sea green")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "chocolate")))) - (gnus-summary-low-unread-face ((t (:italic t :foreground "light sea green")))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "khaki")))) - (gnus-summary-normal-ticked-face ((t (:foreground "sandy brown")))) - (gnus-summary-normal-unread-face ((t (:foreground "aquamarine")))) - (message-cited-text-face ((t (:foreground "White")))) - (message-header-name-face ((t (:foreground "DodgerBlue1")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) - (message-header-other-face ((t (:foreground "LightSkyBlue3")))) - (message-header-xheader-face ((t (:foreground "DodgerBlue3")))))))) - -(defun color-theme-pok-wog () - "Low-contrast White-on-Gray by S.Pokrovsky. - -The following might be a good addition to your .Xdefaults file: - -Emacs.pane.menubar.background: darkGrey -Emacs.pane.menubar.foreground: black" - (interactive) - (color-theme-install - '(color-theme-pok-wog - ((foreground-color . "White") - (background-color . "DarkSlateGray") - (mouse-color . "gold") - (cursor-color . "Cyan") - (border-color . "black") - (background-mode . dark)) - (default ((t (nil)))) - (bold ((t (:bold t :foreground "Wheat")))) - (bold-italic ((t (:italic t :bold t :foreground "wheat")))) - (calendar-today-face ((t (:underline t :foreground "white")))) - (diary-face ((t (:foreground "red")))) - (font-lock-builtin-face ((t (:bold t :foreground "cyan")))) - (font-lock-comment-face ((t (:foreground "Gold")))) - (font-lock-constant-face ((t (:bold t :foreground "LightSteelBlue")))) - (font-lock-function-name-face ((t (:bold t :foreground "Yellow")))) - (font-lock-keyword-face ((t (:bold t :foreground "Cyan")))) - (font-lock-string-face ((t (:foreground "Khaki")))) - (font-lock-type-face ((t (:bold t :foreground "Cyan")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (gnus-cite-attribution-face ((t (:bold t :foreground "Wheat")))) - (gnus-cite-face-1 ((t (:foreground "wheat")))) - (gnus-cite-face-10 ((t (:foreground "wheat")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :foreground "wheat")))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :foreground "white")))) - (gnus-emphasis-underline ((t (:underline t :foreground "white")))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "wheat")))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t :foreground "white")))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "Salmon")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "gold")))) - (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :foreground "Wheat")))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) - (gnus-header-content-face ((t (:italic t :foreground "Wheat")))) - (gnus-header-from-face ((t (:foreground "light yellow")))) - (gnus-header-name-face ((t (:foreground "cyan")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow")))) - (gnus-header-subject-face ((t (:bold t :foreground "Gold")))) - (gnus-signature-face ((t (:italic t :foreground "wheat")))) - (gnus-splash-face ((t (:foreground "orange")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "gold")))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (:foreground "wheat")))) - (gnus-summary-selected-face ((t (:underline t :foreground "white")))) - (highlight ((t (:background "Blue" :foreground "white")))) - (highline-face ((t (:background "black" :foreground "white")))) - (holiday-face ((t (:background "pink" :foreground "white")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t :foreground "white")))) - (info-xref ((t (:bold t :foreground "wheat")))) - (italic ((t (:italic t :foreground "white")))) - (makefile-space-face ((t (:background "hotpink")))) - (message-cited-text-face ((t (:foreground "green")))) - (message-header-cc-face ((t (:bold t :foreground "Aquamarine")))) - (message-header-name-face ((t (:foreground "Gold")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) - (message-header-other-face ((t (:foreground "lightGray")))) - (message-header-subject-face ((t (:foreground "Yellow")))) - (message-header-to-face ((t (:bold t :foreground "green2")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:bold t :foreground "khaki")))) - (message-separator-face ((t (:background "aquamarine" :foreground "black")))) - (modeline ((t (:background "DarkGray" :foreground "Black")))) - (modeline-buffer-id ((t (:background "DarkGray" :foreground "Black")))) - (modeline-mousable ((t (:background "DarkGray" :foreground "Black")))) - (modeline-mousable-minor-mode ((t (:background "DarkGray" :foreground "Black")))) - (paren-mismatch-face ((t (:background "DeepPink" :foreground "white")))) - (paren-no-match-face ((t (:background "yellow" :foreground "white")))) - (region ((t (:background "MediumSlateBlue" :foreground "white")))) - (secondary-selection ((t (:background "Sienna" :foreground "white")))) - (show-paren-match-face ((t (:background "turquoise" :foreground "white")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:bold t :foreground "magenta")))) - (speedbar-directory-face ((t (:bold t :foreground "orchid")))) - (speedbar-file-face ((t (:foreground "pink")))) - (speedbar-highlight-face ((t (:background "black")))) - (speedbar-selected-face ((t (:underline t :foreground "cyan")))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) - (underline ((t (:underline t :foreground "white")))) - (widget-button-face ((t (:bold t :foreground "wheat")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray" :foreground "white")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray" :foreground "white"))))))) - -(defun color-theme-pok-wob () - "White-on-Black by S. Pokrovsky. - -The following might be a good addition to your .Xdefaults file: - -Emacs.pane.menubar.background: darkGrey -Emacs.pane.menubar.foreground: black" - (interactive) -; (setq term-default-fg-color "white" -; term-default-bg "black") - (color-theme-install - '(color-theme-pok-wob - ((foreground-color . "white") - (background-color . "black") - (mouse-color . "gold") - (cursor-color . "yellow") - (border-color . "black") - (background-mode . dark)) - (default ((t (nil)))) - (bold ((t (:bold t :foreground "light gray")))) - (bold-italic ((t (:italic t :bold t :foreground "cyan")))) - (calendar-today-face ((t (:underline t :foreground "white")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t)))) - (custom-group-tag-face-1 ((t (:underline t)))) - (custom-invalid-face ((t (:background "red" :foreground "white")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (nil)))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t)))) - (diary-face ((t (:foreground "gold")))) - (font-lock-builtin-face ((t (:bold t :foreground "cyan")))) - (font-lock-comment-face ((t (:foreground "Gold")))) - (font-lock-constant-face ((t (:bold t :foreground "LightSteelBlue")))) - (font-lock-function-name-face ((t (:bold t :foreground "gold")))) - (font-lock-keyword-face ((t (:bold t :foreground "Cyan")))) - (font-lock-string-face ((t (:foreground "Khaki")))) - (font-lock-type-face ((t (:bold t :foreground "Cyan")))) - (font-lock-variable-name-face ((t (:italic t :foreground "gold")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (gnus-cite-attribution-face ((t (:underline t :foreground "beige")))) - (gnus-cite-face-1 ((t (:foreground "gold")))) - (gnus-cite-face-10 ((t (:foreground "coral")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "wheat")))) - (gnus-cite-face-3 ((t (:foreground "light pink")))) - (gnus-cite-face-4 ((t (:foreground "khaki")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :foreground "light gray")))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "cyan")))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "gold")))) - (gnus-emphasis-italic ((t (:italic t :foreground "cyan")))) - (gnus-emphasis-underline ((t (:underline t :foreground "white")))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "white")))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :foreground "white")))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t :foreground "white")))) - (gnus-group-mail-1-empty-face ((t (:foreground "Magenta")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "Magenta")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "Cyan")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "Cyan")))) - (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) - (gnus-group-mail-low-face ((t (:foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (:foreground "wheat")))) - (gnus-group-news-3-face ((t (:bold t :foreground "Wheat")))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-header-content-face ((t (:italic t :foreground "Wheat")))) - (gnus-header-from-face ((t (:foreground "light yellow")))) - (gnus-header-name-face ((t (:foreground "Wheat")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "gold")))) - (gnus-header-subject-face ((t (:bold t :foreground "Gold")))) - (gnus-signature-face ((t (:italic t :foreground "white")))) - (gnus-splash-face ((t (:foreground "orange")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "orange")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "red")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral")))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "gold")))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "red")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "coral")))) - (gnus-summary-low-unread-face ((t (:italic t :foreground "white")))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (:foreground "white")))) - (gnus-summary-selected-face ((t (:underline t :foreground "white")))) - (highlight ((t (:background "Blue" :foreground "white")))) - (highline-face ((t (:background "dark slate gray" :foreground "white")))) - (holiday-face ((t (:background "red" :foreground "white")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t :foreground "white")))) - (info-xref ((t (:bold t :foreground "light gray")))) - (italic ((t (:italic t :foreground "cyan")))) - (makefile-space-face ((t (:background "hotpink" :foreground "white")))) - (message-cited-text-face ((t (:foreground "green")))) - (message-header-cc-face ((t (:bold t :foreground "Aquamarine")))) - (message-header-name-face ((t (:foreground "Gold")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "gold")))) - (message-header-other-face ((t (:foreground "lightGray")))) - (message-header-subject-face ((t (:foreground "Yellow")))) - (message-header-to-face ((t (:bold t :foreground "green2")))) - (message-header-xheader-face ((t (:foreground "sky blue")))) - (message-mml-face ((t (:bold t :foreground "khaki")))) - (message-separator-face ((t (:background "aquamarine" :foreground "black")))) - (modeline ((t (:background "dark gray" :foreground "black")))) - (modeline-buffer-id ((t (:background "dark gray" :foreground "black")))) - (modeline-mousable ((t (:background "dark gray" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "dark gray" :foreground "black")))) - (paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) - (paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) - (region ((t (:background "MediumSlateBlue" :foreground "white")))) - (secondary-selection ((t (:background "Sienna" :foreground "white")))) - (show-paren-match-face ((t (:background "purple" :foreground "white")))) - (show-paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) - (speedbar-button-face ((t (nil)))) - (speedbar-directory-face ((t (nil)))) - (speedbar-file-face ((t (:bold t)))) - (speedbar-highlight-face ((t (nil)))) - (speedbar-selected-face ((t (:underline t)))) - (speedbar-tag-face ((t (nil)))) - (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) - (underline ((t (:underline t :foreground "white")))) - (widget-button-face ((t (:bold t :foreground "coral")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray" :foreground "white")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray" :foreground "white"))))))) - -(defun color-theme-blue-sea () - "The grey on midnight blue theme. - -Includes faces for apropos, font-lock (Emacs and XEmacs), speedbar, -custom, widget, info, flyspell, gnus, message, man, woman, dired. - -This is what you should put in your .Xdefaults file, if you want to -change the colors of the menus: - -emacs*Background: DarkSlateGray -emacs*Foreground: Wheat" - (interactive) - (color-theme-blue-gnus) - (let ((color-theme-is-cumulative t)) - (color-theme-blue-erc) - (color-theme-install - '(color-theme-blue-sea - ((background-color . "MidnightBlue") - (background-mode . dark) - (border-color . "Grey") - (cursor-color . "Grey") - (foreground-color . "Grey") - (mouse-color . "Grey")) - ((Man-overstrike-face . woman-bold-face) - (Man-underline-face . woman-italic-face)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:bold t :foreground "beige")))) - (calendar-today-face ((t (:underline t)))) - (cperl-array-face ((t (:foreground "light salmon" :bold t)))) - (cperl-hash-face ((t (:foreground "beige" :bold t :italic t)))) - (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) - (custom-button-face ((t (:foreground "gainsboro")))) - (custom-changed-face ((t (:foreground "white" :background "blue")))) - (custom-documentation-face ((t (:foreground "light blue")))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:foreground "pale turquoise" :bold t)))) - (custom-group-tag-face-1 ((t (:foreground "pale turquoise" :underline t)))) - (custom-invalid-face ((t (:foreground "yellow" :background "red")))) - (custom-modified-face ((t (:foreground "white" :background "blue")))) - (custom-rogue-face ((t (:foreground "pink" :background "black")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:foreground "blue" :background "white")))) - (custom-state-face ((t (:foreground "light salmon")))) - (custom-variable-button-face ((t (:bold t :underline t)))) - (custom-variable-tag-face ((t (:foreground "turquoise" :bold t)))) - (diary-face ((t (:foreground "red")))) - (dired-face-directory ((t (:bold t :foreground "sky blue")))) - (dired-face-permissions ((t (:foreground "aquamarine")))) - (dired-face-flagged ((t (:foreground "tomato")))) - (dired-face-marked ((t (:foreground "light salmon")))) - (dired-face-executable ((t (:foreground "green yellow")))) - (eshell-ls-archive-face ((t (:bold t :foreground "medium purple")))) - (eshell-ls-backup-face ((t (:foreground "dim gray")))) - (eshell-ls-clutter-face ((t (:foreground "dim gray")))) - (eshell-ls-directory-face ((t (:bold t :foreground "medium slate blue")))) - (eshell-ls-executable-face ((t (:bold t :foreground "aquamarine")))) - (eshell-ls-missing-face ((t (:foreground "black")))) - (eshell-ls-picture-face ((t (:foreground "violet")))) - (eshell-ls-product-face ((t (:foreground "light steel blue")))) - (eshell-ls-readonly-face ((t (:foreground "aquamarine")))) - (eshell-ls-special-face ((t (:foreground "gold")))) - (eshell-ls-symlink-face ((t (:foreground "white")))) - (eshell-ls-unreadable-face ((t (:foreground "dim gray")))) - (eshell-prompt-face ((t (:foreground "light sky blue" :bold t)))) - (excerpt ((t (:italic t)))) - (fixed ((t (:bold t)))) - (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t)))) - (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) - (font-lock-builtin-face ((t (:foreground "aquamarine")))) - (font-lock-comment-face ((t (:foreground "light blue")))) - (font-lock-constant-face ((t (:foreground "pale green")))) - (font-lock-doc-string-face ((t (:foreground "sky blue")))) - (font-lock-function-name-face ((t (:bold t :foreground "aquamarine")))) - (font-lock-keyword-face ((t (:foreground "pale turquoise" :bold t)))) - (font-lock-reference-face ((t (:foreground "pale green")))) - (font-lock-string-face ((t (:foreground "light sky blue")))) - (font-lock-type-face ((t (:foreground "sky blue" :bold t)))) - (font-lock-variable-name-face ((t (:foreground "turquoise" :bold t)))) - (font-lock-warning-face ((t (:foreground "Red" :bold t)))) - (fringe ((t (:background "MidnightBlue")))) - (header-line ((t (:background "#002" :foreground "cornflower blue")))) - (highlight ((t (:background "dark slate blue" :foreground "light blue")))) - (highline-face ((t (:background "DeepSkyBlue4")))) - (holiday-face ((t (:background "pink")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:bold t)))) - (info-xref ((t (:bold t :foreground "sky blue")))) - (isearch ((t (:background "slate blue")))) - (italic ((t (:foreground "sky blue")))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (:background "MidnightBlue" :foreground "Grey")))) - (modeline ((t (:foreground "wheat" :background "slate blue")))) - (mode-line-inactive ((t (:background "dark slate blue" :foreground "wheat")))) - (modeline-buffer-id ((t (:foreground "beige" :background "slate blue")))) - (modeline-mousable ((t (:foreground "light cyan" :background "slate blue")))) - (modeline-mousable-minor-mode ((t (:foreground "wheat" :background "slate blue")))) - (region ((t (:background "DarkSlateBlue")))) - (secondary-selection ((t (:background "steel blue")))) - (show-paren-match-face ((t (:foreground "white" :background "light slate blue")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) - (speedbar-button-face ((t (:foreground "seashell2")))) - (speedbar-directory-face ((t (:foreground "seashell3")))) - (speedbar-file-face ((t (:foreground "seashell4")))) - (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) - (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) - (speedbar-tag-face ((t (:foreground "antique white")))) - (tool-bar ((t (:background "MidnightBlue" :foreground "Grey" :box (:line-width 1 :style released-button))))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "light blue")))) - (widget-field-face ((t (:background "RoyalBlue4" :foreground "wheat")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "slate blue" :foreground "wheat")))) - (woman-bold-face ((t (:foreground "sky blue" :bold t)))) - (woman-italic-face ((t (:foreground "deep sky blue")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (zmacs-region ((t (:background "DarkSlateBlue")))))))) - -(defun color-theme-rotor () - "Black on Beige color theme by Jinwei Shen, created 2000-06-08. -Supports default faces, font-lock, custom, widget, message, man, -show-paren, viper." - (interactive) - (color-theme-install - '(color-theme-rotor - ((background-color . "Beige") - (background-mode . light) - (border-color . "black") - (cursor-color . "Maroon") - (foreground-color . "Black") - (mouse-color . "Black")) - ((Man-overstrike-face . font-lock-function-name-face) - (Man-underline-face . font-lock-type-face) - (list-matching-lines-face . bold) - (rmail-highlight-face . font-lock-function-name-face) - (watson-attribution-face . italic) - (watson-url-face . bold) - (watson-url-mouse-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t :background "grey40" :foreground "yellow")))) - (bold-italic ((t (:italic t :bold t :foreground "yellow green")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:foreground "MediumBlue")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-function-name-face ((t (:foreground "MediumSlateBlue")))) - (font-lock-keyword-face ((t (:foreground "#80a0ff")))) - (font-lock-string-face ((t (:foreground "red")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (highlight ((t (:background "PaleGreen" :foreground "black")))) - (italic ((t (:italic t :foreground "yellow3")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "wheat" :foreground "DarkOliveGreen")))) - (modeline-buffer-id ((t (:background "wheat" :foreground "DarkOliveGreen")))) - (modeline-mousable ((t (:background "wheat" :foreground "DarkOliveGreen")))) - (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "DarkOliveGreen")))) - (nil ((t (nil)))) - (region ((t (:background "dark cyan" :foreground "cyan")))) - (secondary-selection ((t (:background "Turquoise" :foreground "black")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (underline ((t (:underline t)))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - -(defun color-theme-pierson () - "Black on White color theme by Dan L. Pierson, created 2000-06-08. -Supports default faces, font-lock, show-paren." - (interactive) - (color-theme-install - '(color-theme-pierson - ((background-color . "AntiqueWhite") - (background-mode . light) - (border-color . "black") - (cursor-color . "Orchid") - (foreground-color . "black") - (mouse-color . "Orchid")) - ((list-matching-lines-face . bold)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:foreground "ForestGreen")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-function-name-face ((t (:foreground "blue3")))) - (font-lock-keyword-face ((t (:foreground "Blue")))) - (font-lock-string-face ((t (:foreground "Firebrick")))) - (font-lock-type-face ((t (:foreground "Purple")))) - (font-lock-variable-name-face ((t (:foreground "blue3")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (highlight ((t (:background "darkseagreen2")))) - (italic ((t (:italic t)))) - (modeline ((t (:foreground "antiquewhite" :background "black")))) - (modeline-mousable-minor-mode ((t (:foreground "antiquewhite" :background "black")))) - (modeline-mousable ((t (:foreground "antiquewhite" :background "black")))) - (modeline-buffer-id ((t (:foreground "antiquewhite" :background "black")))) - (region ((t (:background "gray")))) - (secondary-selection ((t (:background "paleturquoise")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (underline ((t (:underline t))))))) - -(defun color-theme-xemacs () - "XEmacs standard colors. -If you are missing standard faces in this theme, please notify the maintainer. -Currently, this theme includes the standard faces and font-lock faces, including -some faces used in Emacs only but which are needed to recreate the look of the -XEmacs color theme." - (interactive) - (color-theme-install - '(color-theme-xemacs - ((background-color . "gray80") - (background-mode . light) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "Red3") - (foreground-color . "black") - (top-toolbar-shadow-color . "#fffffbeeffff")) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t)))) - (dired-face-executable ((t (:foreground "SeaGreen")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "black")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (font-lock-builtin-face ((t (:foreground "red3")))) - (font-lock-comment-face ((t (:foreground "blue4")))) - (font-lock-constant-face ((t (:foreground "red3")))) - (font-lock-doc-string-face ((t (:foreground "green4")))) - (font-lock-function-name-face ((t (:foreground "brown4")))) - (font-lock-keyword-face ((t (:foreground "red4")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "green4")))) - (font-lock-type-face ((t (:foreground "steelblue")))) - (font-lock-variable-name-face ((t (:foreground "magenta4")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "Gray80")))) - (highlight ((t (:background "darkseagreen2")))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "paleturquoise")))) - (italic ((t (:italic t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68")))) - (modeline ((t (:background "Gray80")))) - (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) - (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray65")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (text-cursor ((t (:background "Red3" :foreground "gray80")))) - (toolbar ((t (:background "Gray80")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (:background "Gray80")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65"))))))) - -(defun color-theme-jsc-light () - "Color theme by John S Cooper, created 2000-06-08." - (interactive) - (color-theme-install - '(color-theme-jsc-light - ((background-color . "white") - (background-mode . light) - (border-color . "black") - (cursor-color . "Red") - (foreground-color . "black") - (mouse-color . "black")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t :foreground "red3")))) - (bold-italic ((t (:italic t :bold t :foreground "red")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:italic t :bold t :foreground "Red3")))) - (font-lock-constant-face ((t (:foreground "navy")))) - (font-lock-function-name-face ((t (:bold t :foreground "Blue")))) - (font-lock-keyword-face ((t (:bold t :foreground "Purple")))) - (font-lock-string-face ((t (:foreground "Green4")))) - (font-lock-type-face ((t (:foreground "Navy")))) - (font-lock-variable-name-face ((t (:foreground "Tan4")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "blue2")))) - (gnus-group-news-1-face ((t (:bold t :foreground "blue2")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "blue")))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "red3")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:bold t :foreground "red")))) - (gnus-signature-face ((t (:foreground "pink")))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "navy")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "blue")))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "red3")))) - (gnus-summary-normal-ticked-face ((t (:foreground "black")))) - (gnus-summary-normal-unread-face ((t (:bold t :foreground "red3")))) - (gnus-summary-selected-face ((t (:underline t)))) - (highlight ((t (:background "antiquewhite" :foreground "blue")))) - (italic ((t (:italic t)))) - (makefile-space-face ((t (:background "hotpink")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "plum" :foreground "black")))) - (modeline-buffer-id ((t (:background "plum" :foreground "black")))) - (modeline-mousable ((t (:background "plum" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "plum" :foreground "black")))) - (region ((t (:background "plum")))) - (secondary-selection ((t (:background "palegreen")))) - (show-paren-match-face ((t (:background "plum")))) - (show-paren-mismatch-face ((t (:background "navy" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - -(defun color-theme-jsc-dark () - "Color theme by John S Cooper, created 2000-06-11." - (interactive) - (color-theme-install - '(color-theme-jsc-dark - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "white") - (foreground-color . "cornsilk") - (mouse-color . "black")) - ((gnus-mouse-face . highlight) - (goto-address-mail-face . italic) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . bold) - (goto-address-url-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (blank-space-face ((t (:background "LightGray")))) - (blank-tab-face ((t (:background "cornsilk" :foreground "black")))) - (default ((t (nil)))) - (bold ((t (:bold t :foreground "white")))) - (bold-italic ((t (:italic t :bold t)))) - (calendar-today-face ((t (:underline t)))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (custom-button-face ((t (:foreground "white")))) - (custom-changed-face ((t (:background "skyblue" :foreground "wheat")))) - (custom-documentation-face ((t (:foreground "white")))) - (custom-face-tag-face ((t (:underline t :foreground "white")))) - (custom-group-tag-face ((t (:underline t :foreground "skyblue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:foreground "blue")))) - (custom-state-face ((t (:foreground "light green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "skyblue")))) - (diary-face ((t (:bold t :foreground "orange")))) - (font-lock-builtin-face ((t (:bold t :foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:italic t :foreground "red")))) - (font-lock-constant-face ((t (:bold t :foreground "salmon")))) - (font-lock-function-name-face ((t (:bold t :foreground "orange")))) - (font-lock-keyword-face ((t (:bold t :foreground "gold")))) - (font-lock-string-face ((t (:italic t :foreground "orange")))) - (font-lock-type-face ((t (:bold t :foreground "gold")))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "light salmon")))) - (font-lock-warning-face ((t (:bold t :foreground "gold")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "light cyan")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "light blue")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:background "goldenrod4" :foreground "white")))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t :background "yellow" :foreground "black")))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :background "yellow" :foreground "black")))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t :background "yellow" :foreground "black")))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "white")))) - (gnus-group-mail-2-empty-face ((t (:foreground "lightcyan")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "lightcyan")))) - (gnus-group-mail-3-empty-face ((t (:foreground "tan")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "tan")))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "white")))) - (gnus-group-news-1-face ((t (:bold t :foreground "white")))) - (gnus-group-news-2-empty-face ((t (:foreground "lightcyan")))) - (gnus-group-news-2-face ((t (:bold t :foreground "lightcyan")))) - (gnus-group-news-3-empty-face ((t (:foreground "tan")))) - (gnus-group-news-3-face ((t (:bold t :foreground "tan")))) - (gnus-group-news-4-empty-face ((t (:foreground "white")))) - (gnus-group-news-4-face ((t (:bold t :foreground "white")))) - (gnus-group-news-5-empty-face ((t (:foreground "wheat")))) - (gnus-group-news-5-face ((t (:bold t :foreground "wheat")))) - (gnus-group-news-6-empty-face ((t (:foreground "tan")))) - (gnus-group-news-6-face ((t (:bold t :foreground "tan")))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) - (gnus-header-content-face ((t (:italic t :foreground "plum1")))) - (gnus-header-from-face ((t (:bold t :foreground "wheat")))) - (gnus-header-name-face ((t (:bold t :foreground "gold")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "wheat")))) - (gnus-header-subject-face ((t (:bold t :foreground "red")))) - (gnus-signature-face ((t (:italic t :foreground "maroon")))) - (gnus-splash ((t (:foreground "Brown")))) - (gnus-splash-face ((t (:foreground "gold")))) - (gnus-summary-cancelled-face ((t (:background "gray" :foreground "black")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "gray70")))) - (gnus-summary-high-unread-face ((t (:italic t :bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "gray70")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "gray70")))) - (gnus-summary-normal-unread-face ((t (:bold t)))) - (gnus-summary-selected-face ((t (:underline t :background "deepskyblue4")))) - (highlight ((t (:background "darkslategray" :foreground "wheat")))) - (highlight-changes-delete-face ((t (:underline t :foreground "red")))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "gray35")))) - (holiday-face ((t (:background "red")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t :foreground "yellow")))) - (info-xref ((t (:bold t :foreground "plum")))) - (italic ((t (:italic t)))) - (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) - (linemenu-face ((t (:background "gray30")))) - (makefile-space-face ((t (:background "hotpink")))) - (message-cited-text-face ((t (:foreground "plum1")))) - (message-header-cc-face ((t (:bold t :foreground "ivory")))) - (message-header-name-face ((t (:foreground "light sky blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "lavender blush")))) - (message-header-other-face ((t (:foreground "pale turquoise")))) - (message-header-subject-face ((t (:bold t :foreground "papaya whip")))) - (message-header-to-face ((t (:bold t :foreground "floral white")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:bold t :foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "sandy brown")))) - (modeline ((t (:background "tan" :foreground "black")))) - (modeline-buffer-id ((t (:background "tan" :foreground "black")))) - (modeline-mousable ((t (:background "tan" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "tan" :foreground "black")))) - (paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) - (paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) - (region ((t (:background "slategrey")))) - (secondary-selection ((t (:background "deepskyblue4")))) - (sgml-doctype-face ((t (:foreground "orange")))) - (sgml-end-tag-face ((t (:foreground "greenyellow")))) - (sgml-entity-face ((t (:foreground "gold")))) - (sgml-ignored-face ((t (:background "gray60" :foreground "gray20")))) - (sgml-sgml-face ((t (:foreground "yellow")))) - (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) - (show-paren-match-face ((t (:background "deepskyblue4")))) - (show-paren-mismatch-face ((t (:bold t :background "red" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:bold t :foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "gray20")))) - (widget-inactive-face ((t (:foreground "wheat")))) - (widget-single-line-field-face ((t (:background "gray20")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon"))))))) - -(defun color-theme-greiner () - "Color theme by Kevin Greiner, created 2000-06-13. -Black on Beige, supports default, font-lock, speedbar, custom, widget -faces. Designed to be easy on the eyes, particularly on Win32 -computers which commonly have white window backgrounds." - (interactive) - (color-theme-install - '(color-theme-greiner - ((background-color . "beige") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "black") - (mouse-color . "black")) - ((list-matching-lines-face . bold)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (font-lock-builtin-face ((t (:foreground "blue4")))) - (font-lock-comment-face ((t (:foreground "Firebrick")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-keyword-face ((t (:foreground "royal blue")))) - (font-lock-string-face ((t (:foreground "RosyBrown")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (highlight ((t (:background "darkseagreen2")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (italic ((t (:italic t)))) - (modeline ((t (:background "black" :foreground "white")))) - (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) - (modeline-mousable ((t (:background "black" :foreground "white")))) - (modeline-buffer-id ((t (:background "black" :foreground "white")))) - (region ((t (:background "gray")))) - (secondary-selection ((t (:background "paleturquoise")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - -(defun color-theme-jb-simple () - "Color theme by jeff, created 2000-06-14. -Uses white background and bold for many things" - (interactive) - (color-theme-install - '(color-theme-jb-simple - ((background-color . "white") - (background-mode . light) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "black") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "black") - (foreground-color . "black") - (mouse-color . "black") - (top-toolbar-shadow-color . "#fffffbeeffff")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (rmail-highlight-face . font-lock-function-name-face) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (blank-space-face ((t (nil)))) - (blank-tab-face ((t (nil)))) - (blue ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (calendar-today-face ((t (:underline t)))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :bold t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) - (diary-face ((t (:bold t :foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (nil)))) - (erc-error-face ((t (:bold t)))) - (erc-input-face ((t (nil)))) - (erc-inverse-face ((t (nil)))) - (erc-notice-face ((t (nil)))) - (erc-pal-face ((t (nil)))) - (erc-prompt-face ((t (nil)))) - (erc-underline-face ((t (nil)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) - (eshell-ls-picture-face ((t (nil)))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-test-ok-face ((t (:bold t :foreground "Green")))) - (excerpt ((t (:italic t)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (fixed ((t (:bold t)))) - (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) - (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) - (font-latex-bold-face ((t (nil)))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (nil)))) - (font-latex-string-face ((t (nil)))) - (font-latex-warning-face ((t (nil)))) - (font-lock-builtin-face ((t (:bold t :foreground "Orchid")))) - (font-lock-comment-face ((t (:italic t :bold t :foreground "blue4")))) - (font-lock-constant-face ((t (:bold t :foreground "CadetBlue")))) - (font-lock-doc-string-face ((t (:italic t :bold t :foreground "blue4")))) - (font-lock-exit-face ((t (nil)))) - (font-lock-function-name-face ((t (:bold t :foreground "brown4")))) - (font-lock-keyword-face ((t (:bold t :foreground "black")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:italic t :bold t :foreground "green4")))) - (font-lock-type-face ((t (:bold t :foreground "steelblue")))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "magenta4")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (gnus-cite-attribution-face ((t (:italic t :bold t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (nil)))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) - (gnus-header-from-face ((t (:bold t :foreground "red3")))) - (gnus-header-name-face ((t (:bold t :foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:bold t :foreground "red4")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-splash ((t (nil)))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:italic t :bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (:bold t)))) - (gnus-summary-selected-face ((t (:underline t)))) - (green ((t (nil)))) - (gui-button-face ((t (:background "grey75")))) - (gui-element ((t (:background "Gray80")))) - (highlight ((t (:background "darkseagreen2")))) - (highlight-changes-delete-face ((t (:underline t :foreground "red")))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "paleturquoise")))) - (holiday-face ((t (:background "pink")))) - (html-helper-italic-face ((t (:italic t)))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (nil)))) - (italic ((t (:italic t)))) - (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) - (left-margin ((t (nil)))) - (linemenu-face ((t (nil)))) - (list-mode-item-selected ((t (nil)))) - (makefile-space-face ((t (:background "hotpink")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:bold t)))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "darkblue" :foreground "yellow")))) - (modeline-buffer-id ((t (:background "black" :foreground "white")))) - (modeline-mousable ((t (:background "black" :foreground "white")))) - (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) - (nil ((t (nil)))) - (paren-mismatch-face ((t (:bold t)))) - (paren-no-match-face ((t (:bold t)))) - (pointer ((t (nil)))) - (primary-selection ((t (nil)))) - (red ((t (nil)))) - (region ((t (:background "gray")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (sgml-doctype-face ((t (nil)))) - (sgml-end-tag-face ((t (nil)))) - (sgml-entity-face ((t (nil)))) - (sgml-ignored-face ((t (nil)))) - (sgml-sgml-face ((t (nil)))) - (sgml-start-tag-face ((t (nil)))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) - (speedbar-button-face ((t (:bold t :foreground "green4")))) - (speedbar-directory-face ((t (:bold t :foreground "blue4")))) - (speedbar-file-face ((t (:bold t :foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (swbuff-current-buffer-face ((t (:bold t)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (text-cursor ((t (nil)))) - (toolbar ((t (nil)))) - (underline ((t (:underline t)))) - (vc-annotate-face-0046FF ((t (nil)))) - (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) - (vertical-divider ((t (nil)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (nil)))) - (woman-unknown-face ((t (nil)))) - (yellow ((t (nil)))) - (zmacs-region ((t (nil))))))) - -(defun color-theme-beige-diff () - "Brownish faces for diff and change-log modes. -This is intended for other color themes to use (eg. `color-theme-gnome2' -and `color-theme-blue-sea')." - (color-theme-install - '(color-theme-beige-diff - nil - (change-log-acknowledgement-face ((t (:foreground "firebrick")))) - (change-log-conditionals-face ((t (:foreground "khaki" :background "sienna")))) - (change-log-date-face ((t (:foreground "gold")))) - (change-log-email-face ((t (:foreground "khaki" :underline t)))) - (change-log-file-face ((t (:bold t :foreground "lemon chiffon")))) - (change-log-function-face ((t (:foreground "khaki" :background "sienna")))) - (change-log-list-face ((t (:foreground "wheat")))) - (change-log-name-face ((t (:bold t :foreground "light goldenrod")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey50")))) - (diff-file-header-face ((t (:bold t :foreground "lemon chiffon")))) - (diff-function-face ((t (:foreground "grey50")))) - (diff-header-face ((t (:foreground "lemon chiffon")))) - (diff-hunk-header-face ((t (:foreground "light goldenrod")))) - (diff-index-face ((t (:bold t :underline t)))) - (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-removed-face ((t (nil)))) - (log-view-message-face ((t (:foreground "lemon chiffon"))))))) - -(defun color-theme-standard-ediff () - "Standard colors for ediff faces. -This is intended for other color themes to use -\(eg. `color-theme-goldenrod')." - (color-theme-install - '(color-theme-beige-diff - nil - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White"))))))) - -(defun color-theme-beige-eshell () - "Brownish colors for eshell faces only. -This is intended for other color themes to use (eg. `color-theme-goldenrod')." - (color-theme-install - '(color-theme-beige-eshell - nil - (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) - (eshell-ls-backup-face ((t (:foreground "Grey")))) - (eshell-ls-clutter-face ((t (:foreground "DimGray")))) - (eshell-ls-directory-face ((t (:bold t :foreground "dark khaki")))) - (eshell-ls-executable-face ((t (:foreground "Coral")))) - (eshell-ls-missing-face ((t (:foreground "black")))) - (eshell-ls-picture-face ((t (:foreground "gold")))) ; non-standard face - (eshell-ls-product-face ((t (:foreground "dark sea green")))) - (eshell-ls-readonly-face ((t (:foreground "light steel blue")))) - (eshell-ls-special-face ((t (:foreground "gold")))) - (eshell-ls-symlink-face ((t (:foreground "peach puff")))) - (eshell-ls-text-face ((t (:foreground "moccasin")))) ; non-standard face - (eshell-ls-todo-face ((t (:bold t :foreground "yellow green")))) ; non-standard face - (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) - (eshell-prompt-face ((t (:foreground "lemon chiffon"))))))) - -(defun color-theme-goldenrod () - "Brown color theme. Very different from the others. -Supports standard, font-lock and info faces, and it uses -`color-theme-blue-gnus', `color-theme-blue-erc' , and -`color-theme-beige-diff'." - (interactive) - (color-theme-blue-gnus) - (let ((color-theme-is-cumulative t)) - (color-theme-blue-erc) - (color-theme-beige-diff) - (color-theme-beige-eshell) - (color-theme-install - '(color-theme-goldenrod - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "light goldenrod") - (foreground-color . "goldenrod") - (mouse-color . "goldenrod")) - ((goto-address-mail-face . info-xref) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t :foreground "lavender")))) - (font-lock-builtin-face ((t (:foreground "pale goldenrod")))) - (font-lock-comment-face ((t (:foreground "indian red")))) - (font-lock-constant-face ((t (:foreground "pale green")))) - (font-lock-function-name-face ((t (:bold t :foreground "lemon chiffon")))) - (font-lock-keyword-face ((t (:foreground "wheat")))) - (font-lock-string-face ((t (:foreground "gold")))) - (font-lock-type-face ((t (:foreground "dark khaki" :bold t)))) - (font-lock-variable-name-face ((t (:bold t :foreground "khaki")))) - (font-lock-warning-face ((t (:bold t :foreground "orange red")))) - (fringe ((t (:background "gray25")))) - (header-line ((t (:background "gray20" :foreground "gray70")))) - (highlight ((t (:background "dark slate blue")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:bold t)))) - (info-xref ((t (:bold t :foreground "pale goldenrod")))) - (isearch ((t (:background "SeaGreen4")))) - (isearch-lazy-highlight-face ((t (:background "DarkOliveGreen4")))) - (italic ((t (:italic t :foreground "lavender")))) - (menu ((t (:background "gray25" :foreground "lemon chiffon")))) - (modeline ((t (:background "gray40" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) - (modeline-buffer-id ((t (:background "AntiqueWhite4" :foreground "lemon chiffon")))) - (modeline-mousable ((t (:background "AntiqueWhite4" :foreground "lemon chiffon")))) - (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "lemon chiffon")))) - (mode-line-inactive ((t (:background "gray20" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) - (region ((t (:background "dark olive green")))) - (secondary-selection ((t (:background "dark green")))) - (tool-bar ((t (:background "gray25" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) - (underline ((t (:underline t)))))))) - -(defun color-theme-ramangalahy () - "Color theme by Solofo Ramangalahy, created 2000-10-18. -Black on light grey, includes faces for vm, ispell, gnus, -dired, display-time, cperl, font-lock, widget, x-symbol." - (interactive) - (color-theme-install - '(color-theme-ramangalahy - ((background-color . "lightgrey") - (background-mode . light) - (background-toolbar-color . "#bfbfbfbfbfbf") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#737373737373") - (cursor-color . "blue") - (foreground-color . "black") - (top-toolbar-shadow-color . "#e6e6e6e6e6e6")) - ((gnus-mouse-face . highlight) - (goto-address-mail-face . info-xref) - (ispell-highlight-face . highlight) - (notes-bold-face . notes-bold-face) - (setnu-line-number-face . bold) - (tinyreplace-:face . highlight) - (vm-highlight-url-face . bold-italic) - (vm-highlighted-header-face . bold) - (vm-mime-button-face . gui-button-face) - (vm-summary-highlight-face . bold)) - (default ((t (nil)))) - (bbdb-company ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (cperl-here-face ((t (:foreground "green4")))) - (cperl-pod-face ((t (:foreground "brown4")))) - (cperl-pod-head-face ((t (:foreground "steelblue")))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t)))) - (dired-face-executable ((t (:foreground "SeaGreen")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "black")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "blue")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (font-lock-comment-face ((t (:bold t :foreground "purple")))) - (font-lock-doc-string-face ((t (:bold t :foreground "slateblue")))) - (font-lock-emphasized-face ((t (:bold t :background "lightyellow2")))) - (font-lock-function-name-face ((t (:bold t :foreground "blue")))) - (font-lock-keyword-face ((t (:bold t :foreground "violetred")))) - (font-lock-other-emphasized-face ((t (:italic t :bold t :background "lightyellow2")))) - (font-lock-other-type-face ((t (:bold t :foreground "orange3")))) - (font-lock-preprocessor-face ((t (:bold t :foreground "mediumblue")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "green4")))) - (font-lock-type-face ((t (:bold t :foreground "steelblue")))) - (font-lock-variable-name-face ((t (:foreground "magenta4")))) - (font-lock-warning-face ((t (:bold t :background "yellow" :foreground "Red")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (nil)))) - (gnus-emphasis-italic ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t)))) - (gnus-emphasis-underline-italic ((t (:underline t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-news-3-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:foreground "indianred4")))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-signature-face ((t (:bold t)))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (nil)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "lightgrey" :foreground "black")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "lightgrey")))) - (highlight ((t (:background "darkseagreen2")))) - (info-node ((t (:underline t :bold t :foreground "mediumpurple")))) - (info-xref ((t (:underline t :bold t :foreground "#0000ee")))) - (isearch ((t (:background "paleturquoise")))) - (italic ((t (:italic t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) - (message-cited-text ((t (:foreground "slategrey")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-contents ((t (:italic t)))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-headers ((t (:bold t)))) - (message-highlighted-header-contents ((t (:bold t)))) - (message-separator-face ((t (:foreground "brown")))) - (message-url ((t (:bold t)))) - (modeline ((t (:bold t :background "Gray75" :foreground "Black")))) - (modeline-buffer-id ((t (:bold t :background "Gray75" :foreground "blue4")))) - (modeline-mousable ((t (:bold t :background "Gray75" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:bold t :background "Gray75" :foreground "green4")))) - (paren-blink-off ((t (:foreground "lightgrey")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (pointer ((t (:foreground "blue")))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "black" :foreground "white")))) - (right-margin ((t (nil)))) - (searchm-buffer ((t (:bold t :background "white" :foreground "red")))) - (searchm-button ((t (:bold t :background "CadetBlue" :foreground "white")))) - (searchm-field ((t (:background "grey89")))) - (searchm-field-label ((t (:bold t)))) - (searchm-highlight ((t (:bold t :background "darkseagreen2" :foreground "black")))) - (secondary-selection ((t (:background "paleturquoise")))) - (template-message-face ((t (:bold t)))) - (text-cursor ((t (:background "blue" :foreground "lightgrey")))) - (toolbar ((t (nil)))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (x-face ((t (:background "white" :foreground "black")))) - (x-symbol-adobe-fontspecific-face ((t (nil)))) - (x-symbol-face ((t (nil)))) - (x-symbol-heading-face ((t (:underline t :bold t :foreground "green4")))) - (x-symbol-info-face ((t (:foreground "green4")))) - (x-symbol-invisible-face ((t (nil)))) - (x-symbol-revealed-face ((t (:background "pink")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "yellow"))))))) - -(defun color-theme-raspopovic () - "Color theme by Pedja Raspopovic, created 2000-10-19. -Includes faces for dired, font-lock, info, paren." - (interactive) - (color-theme-install - '(color-theme-raspopovic - ((background-color . "darkblue") - (background-mode . light) - (background-toolbar-color . "#bfbfbfbfbfbf") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#737373737373") - (cursor-color . "Red3") - (foreground-color . "yellow") - (top-toolbar-shadow-color . "#e6e6e6e6e6e6")) - ((setnu-line-number-face . bold) - (goto-address-mail-face . info-xref)) - (default ((t (nil)))) - (blue ((t (:background "darkblue" :foreground "blue")))) - (bold ((t (:bold t :background "darkblue" :foreground "yellow")))) - (bold-italic ((t (:bold t :background "darkblue" :foreground "red3")))) - (comint-input-face ((t (:foreground "deepskyblue")))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:foreground "lightgreen")))) - (dired-face-executable ((t (:foreground "indianred")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-marked ((t (:background "darkblue" :foreground "deepskyblue")))) - (dired-face-permissions ((t (:background "darkblue" :foreground "white")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "grey95")))) - (font-lock-comment-face ((t (:background "darkblue" :foreground "lightgreen")))) - (font-lock-doc-string-face ((t (:background "darkblue" :foreground "darkseagreen")))) - (font-lock-function-name-face ((t (:bold t :background "darkblue" :foreground "indianred")))) - (font-lock-keyword-face ((t (:background "darkblue" :foreground "skyblue")))) - (font-lock-preprocessor-face ((t (:background "darkblue" :foreground "orange")))) - (font-lock-reference-face ((t (:background "darkblue" :foreground "deepskyblue")))) - (font-lock-string-face ((t (:background "darkblue" :foreground "lightgrey")))) - (font-lock-type-face ((t (:background "darkblue" :foreground "orange")))) - (font-lock-variable-name-face ((t (:background "darkblue" :foreground "white")))) - (green ((t (:background "darkblue" :foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (highlight ((t (:background "yellow" :foreground "darkblue")))) - (info-node ((t (:bold t :background "darkblue" :foreground "red3")))) - (info-xref ((t (:bold t :background "darkblue" :foreground "yellow")))) - (isearch ((t (:background "yellow" :foreground "darkblue")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:background "darkblue" :foreground "red3")))) - (left-margin ((t (:background "darkblue" :foreground "yellow")))) - (list-mode-item-selected ((t (:background "gray68" :foreground "yellow")))) - (makefile-space-face ((t (:background "hotpink")))) - (modeline ((t (:background "Gray75" :foreground "Black")))) - (modeline-buffer-id ((t (:background "Gray75" :foreground "blue")))) - (modeline-mousable ((t (:background "Gray75" :foreground "red")))) - (modeline-mousable-minor-mode ((t (:background "Gray75" :foreground "green4")))) - (paren-blink-off ((t (:foreground "darkblue")))) - (paren-match ((t (:background "yellow" :foreground "darkblue")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "yellow")))) - (pointer ((t (:background "darkblue" :foreground "red3")))) - (primary-selection ((t (:background "yellow" :foreground "darkblue")))) - (red ((t (:background "darkblue" :foreground "red")))) - (right-margin ((t (:background "darkblue" :foreground "yellow")))) - (secondary-selection ((t (:background "darkblue" :foreground "yellow")))) - (shell-option-face ((t (:background "darkblue" :foreground "cyan2")))) - (shell-output-2-face ((t (:background "darkblue" :foreground "darkseagreen")))) - (shell-output-3-face ((t (:background "darkblue" :foreground "lightgrey")))) - (shell-output-face ((t (:background "darkblue" :foreground "white")))) - (shell-prompt-face ((t (:background "darkblue" :foreground "red")))) - (text-cursor ((t (:background "Red3" :foreground "white")))) - (underline ((t (:underline t :background "darkblue" :foreground "yellow")))) - (vvb-face ((t (:background "pink" :foreground "black")))) - (yellow ((t (:background "darkblue" :foreground "yellow")))) - (zmacs-region ((t (:background "gray" :foreground "black"))))))) - -(defun color-theme-taylor () - "Color theme by Art Taylor, created 2000-10-20. -Wheat on black. Includes faces for font-lock, gnus, paren." - (interactive) - (color-theme-install - '(color-theme-taylor - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "red") - (foreground-color . "wheat") - (mouse-color . "black")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t :background "grey40" :foreground "yellow")))) - (bold-italic ((t (:italic t :bold t :foreground "yellow green")))) - (fl-comment-face ((t (:foreground "medium purple")))) - (fl-function-name-face ((t (:foreground "green")))) - (fl-keyword-face ((t (:foreground "LightGreen")))) - (fl-string-face ((t (:foreground "light coral")))) - (fl-type-face ((t (:foreground "cyan")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "OrangeRed")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (highlight ((t (:background "black" :foreground "black")))) - (italic ((t (:italic t :foreground "yellow3")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4")))) - (message-header-name-face ((t (:foreground "DarkGreen")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-to-face ((t (:bold t :foreground "green2")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "blue3")))) - (modeline ((t (:background "wheat" :foreground "black")))) - (modeline-buffer-id ((t (:background "wheat" :foreground "black")))) - (modeline-mousable ((t (:background "wheat" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "black")))) - (region ((t (:background "blue")))) - (secondary-selection ((t (:background "darkslateblue" :foreground "black")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (underline ((t (:underline t)))) - (xref-keyword-face ((t (:foreground "blue")))) - (xref-list-default-face ((t (nil)))) - (xref-list-pilot-face ((t (:foreground "navy")))) - (xref-list-symbol-face ((t (:foreground "navy"))))))) - -(defun color-theme-marquardt () - "Color theme by Colin Marquardt, created 2000-10-25. -Black on bisque, a light color. Based on some settings from Robin S. Socha. -Features some color changes to programming languages, especially vhdl-mode. -You might also want to put something like - Emacs*Foreground: Black - Emacs*Background: bisque2 -in your ~/.Xdefaults." - (interactive) - (color-theme-install - '(color-theme-marquardt - ((background-color . "bisque") - (background-mode . light) - (background-toolbar-color . "bisque") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#909099999999") - (cursor-color . "Red3") - (foreground-color . "black") - (top-toolbar-shadow-color . "#ffffffffffff")) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:bold t)))) - (border-glyph ((t (nil)))) - (calendar-today-face ((t (:underline t)))) - (diary-face ((t (:foreground "red")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (font-lock-comment-face ((t (:foreground "gray50")))) - (font-lock-doc-string-face ((t (:foreground "green4")))) - (font-lock-function-name-face ((t (:foreground "darkorange")))) - (font-lock-keyword-face ((t (:foreground "blue3")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-special-comment-face ((t (:foreground "blue4")))) - (font-lock-special-keyword-face ((t (:foreground "red4")))) - (font-lock-string-face ((t (:foreground "green4")))) - (font-lock-type-face ((t (:foreground "steelblue")))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "azure1" :foreground "Black")))) - (highlight ((t (:background "darkseagreen2" :foreground "blue")))) - (holiday-face ((t (:background "pink" :foreground "black")))) - (info-node ((t (:bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "yellow" :foreground "red")))) - (italic ((t (:bold t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "bisque2" :foreground "steelblue4")))) - (modeline-buffer-id ((t (:background "bisque2" :foreground "blue4")))) - (modeline-mousable ((t (:background "bisque2" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "bisque2" :foreground "green4")))) - (paren-blink-off ((t (:foreground "azure1")))) - (paren-face ((t (:background "lightgoldenrod")))) - (paren-match ((t (:background "bisque2")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (paren-mismatch-face ((t (:background "DeepPink")))) - (paren-no-match-face ((t (:background "yellow")))) - (pointer ((t (:background "white" :foreground "blue")))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (shell-option-face ((t (:foreground "gray50")))) - (shell-output-2-face ((t (:foreground "green4")))) - (shell-output-3-face ((t (:foreground "green4")))) - (shell-output-face ((t (:bold t)))) - (shell-prompt-face ((t (:foreground "blue3")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (text-cursor ((t (:background "Red3" :foreground "bisque")))) - (toolbar ((t (:background "Gray80")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "SaddleBrown")))) - (vhdl-font-lock-function-face ((t (:foreground "DarkCyan")))) - (vhdl-font-lock-generic-/constant-face ((t (:foreground "Gold3")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-font-lock-type-face ((t (:foreground "ForestGreen")))) - (vhdl-font-lock-variable-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) - (vhdl-speedbar-subprogram-face ((t (:foreground "Orchid4")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "steelblue" :foreground "yellow"))))))) - -(defun color-theme-parus () - "Color theme by Jon K Hellan, created 2000-11-01. -White on dark blue color theme. - -There is some redundancy in the X resources, but I do not have time to -find out which should go or which should stay: - -Emacs*dialog*Background: midnightblue -Emacs*dialog*Foreground: white -Emacs*popup*Background: midnightblue -Emacs*popup*Foreground: white -emacs*background: #00005a -emacs*cursorColor: gray90 -emacs*foreground: White -emacs.dialog*.background: midnightblue -emacs.menu*.background: midnightblue -emacs.pane.menubar.background: midnightblue" - (interactive) - (color-theme-install - '(color-theme-parus - ((background-color . "#00005a") - (background-mode . dark) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "White") - (mouse-color . "yellow")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (paren-face . bold) - (paren-mismatch-face . paren-mismatch-face) - (paren-no-match-face . paren-no-match-face) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (font-latex-bold-face ((t (:bold t :foreground "OliveDrab")))) - (font-latex-italic-face ((t (:italic t :foreground "OliveDrab")))) - (font-latex-math-face ((t (:foreground "burlywood")))) - (font-latex-sedate-face ((t (:foreground "LightGray")))) - (font-latex-string-face ((t (:foreground "LightSalmon")))) - (font-latex-warning-face ((t (:foreground "Pink")))) - (font-lock-builtin-face ((t (:foreground "#e0e0ff")))) - (font-lock-reference-face ((t (:foreground "#e0e0ff")))) - (font-lock-comment-face ((t (:foreground "#FFd1d1")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) - (font-lock-function-name-face ((t (:foreground "#b2e4ff")))) - (font-lock-keyword-face ((t (:foreground "#a0ffff")))) - (font-lock-string-face ((t (:foreground "#efca10")))) - (font-lock-doc-string-face ((t (:foreground "#efca10")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "#dfdfff")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) - (gnus-header-content-face ((t (:italic t :foreground "#90f490")))) - (gnus-header-from-face ((t (:foreground "#aaffaa")))) - (gnus-header-name-face ((t (:foreground "#c7e3c7")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow")))) - (gnus-header-subject-face ((t (:foreground "#a0f0a0")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (highlight ((t (:background "darkolivegreen")))) - (italic ((t (:italic t)))) - (message-cited-text-face ((t (:foreground "#dfdfff")))) - (message-header-cc-face ((t (:bold t :foreground "#a0f0a0")))) - (message-header-name-face ((t (:foreground "#c7e3c7")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) - (message-header-other-face ((t (:foreground "#db9b9b")))) - (message-header-subject-face ((t (:foreground "#a0f0a0")))) - (message-header-to-face ((t (:bold t :foreground "#aaffaa")))) - (message-header-xheader-face ((t (:foreground "#e2e2ff")))) - (message-mml-face ((t (:foreground "#abdbab")))) - (message-separator-face ((t (:foreground "#dfdfff")))) - (modeline ((t (:background "White" :foreground "#00005a")))) - (modeline-buffer-id ((t (:background "White" :foreground "#00005a")))) - (modeline-mousable ((t (:background "White" :foreground "#00005a")))) - (modeline-mousable-minor-mode ((t (:background "White" :foreground "#00005a")))) - (paren-mismatch-face ((t (:background "DeepPink")))) - (paren-no-match-face ((t (:background "yellow")))) - (region ((t (:background "blue")))) - (primary-selection ((t (:background "blue")))) - (isearch ((t (:background "blue")))) - (secondary-selection ((t (:background "darkslateblue")))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray"))))))) - -(defun color-theme-high-contrast () - "High contrast color theme, maybe for the visually impaired. -Watch out! This will set a very large font-size! - -If you want to modify the font as well, you should customize variable -`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". -The default setting will prevent color themes from installing specific -fonts." - (interactive) - (color-theme-standard) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-high-contrast - ((cursor-color . "red") - (width . 60) - (height . 25) - (background . dark)) - (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :height 240 :width normal :family "adobe-courier")))) - - (bold ((t (:bold t :underline t)))) - (bold-italic ((t (:bold t :underline t)))) - (font-lock-builtin-face ((t (:bold t :foreground "Red")))) - (font-lock-comment-face ((t (:bold t :foreground "Firebrick")))) - (font-lock-constant-face ((t (:bold t :underline t :foreground "Blue")))) - (font-lock-function-name-face ((t (:bold t :foreground "Blue")))) - (font-lock-keyword-face ((t (:bold t :foreground "Purple")))) - (font-lock-string-face ((t (:bold t :foreground "DarkGreen")))) - (font-lock-type-face ((t (:bold t :foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:bold t :foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (highlight ((t (:background "black" :foreground "white" :bold 1)))) - (info-menu-5 ((t (:underline t :bold t)))) - (info-node ((t (:bold t)))) - (info-xref ((t (:bold t )))) - (italic ((t (:bold t :underline t)))) - (modeline ((t (:background "black" :foreground "white" :bold 1)))) - (modeline-buffer-id ((t (:background "black" :foreground "white" :bold 1)))) - (modeline-mousable ((t (:background "black" :foreground "white" :bold 1)))) - (modeline-mousable-minor-mode ((t (:background "black" :foreground "white" :bold 1)))) - (region ((t (:background "black" :foreground "white" :bold 1)))) - (secondary-selection ((t (:background "black" :foreground "white" :bold 1)))) - (underline ((t (:bold t :underline t)))))))) - -(defun color-theme-infodoc () - "Color theme by Frederic Giroud, created 2001-01-18. -Black on wheat scheme. Based on infodoc (xemacs variant distribution), -with my favorit fontlock color." - (interactive) - (color-theme-install - '(color-theme-infodoc - ((background-color . "wheat") - (background-mode . light) - (background-toolbar-color . "#000000000000") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#000000000000") - (cursor-color . "red") - (foreground-color . "black") - (top-toolbar-shadow-color . "#ffffffffffff")) - nil - (default ((t (:bold t)))) - (blue ((t (:bold t :foreground "blue")))) - (bold ((t (:background "wheat" :foreground "black")))) - (bold-italic ((t (:bold t :background "wheat" :foreground "black")))) - (border-glyph ((t (:bold t)))) - (calendar-today-face ((t (:underline t :bold t)))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:bold t :background "blue" :foreground "white")))) - (custom-documentation-face ((t (:bold t :background "wheat" :foreground "purple4")))) - (custom-face-tag-face ((t (:underline t :bold t)))) - (custom-group-tag-face ((t (:underline t :bold t :background "wheat" :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :bold t :background "wheat" :foreground "red")))) - (custom-invalid-face ((t (:bold t :background "red" :foreground "yellow")))) - (custom-modified-face ((t (:bold t :background "blue" :foreground "white")))) - (custom-rogue-face ((t (:bold t :background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t :bold t)))) - (custom-set-face ((t (:bold t :background "white" :foreground "blue")))) - (custom-state-face ((t (:bold t :background "wheat" :foreground "dark green")))) - (custom-variable-button-face ((t (:underline t)))) - (custom-variable-tag-face ((t (:underline t :bold t :background "wheat" :foreground "blue")))) - (diary-face ((t (:bold t :foreground "red")))) - (display-time-mail-balloon-enhance-face ((t (:bold t :background "wheat" :foreground "black")))) - (display-time-mail-balloon-gnus-group-face ((t (:bold t :background "wheat" :foreground "blue")))) - (display-time-time-balloon-face ((t (:bold t :background "light salmon" :foreground "dark green")))) - (font-lock-comment-face ((t (:bold t :background "wheat" :foreground "turquoise4")))) - (font-lock-doc-string-face ((t (:bold t :background "wheat" :foreground "purple4")))) - (font-lock-function-name-face ((t (:bold t :background "wheat" :foreground "blue4")))) - (font-lock-keyword-face ((t (:bold t :background "wheat" :foreground "dark orchid")))) - (font-lock-preprocessor-face ((t (:bold t :background "wheat" :foreground "orchid4")))) - (font-lock-reference-face ((t (:bold t :background "wheat" :foreground "red3")))) - (font-lock-string-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) - (font-lock-type-face ((t (:bold t :background "wheat" :foreground "brown")))) - (font-lock-variable-name-face ((t (:bold t :background "wheat" :foreground "chocolate")))) - (font-lock-warning-face ((t (:bold t :background "wheat" :foreground "black")))) - (gdb-arrow-face ((t (:bold t :background "LightGreen" :foreground "black")))) - (green ((t (:bold t :foreground "green")))) - (gui-button-face ((t (:bold t :background "wheat" :foreground "red")))) - (gui-element ((t (:bold t :background "wheat" :foreground "black")))) - (highlight ((t (:bold t :background "darkseagreen2" :foreground "dark green")))) - (holiday-face ((t (:bold t :background "pink" :foreground "black")))) - (hproperty:but-face ((t (:bold t :background "wheat" :foreground "medium violet red")))) - (hproperty:flash-face ((t (:bold t :background "wheat" :foreground "gray80")))) - (hproperty:highlight-face ((t (:bold t :background "wheat" :foreground "red")))) - (hproperty:item-face ((t (:bold t)))) - (isearch ((t (:bold t :background "pale turquoise" :foreground "blue")))) - (italic ((t (:bold t :background "wheat" :foreground "black")))) - (left-margin ((t (:bold t :background "wheat" :foreground "black")))) - (list-mode-item-selected ((t (:bold t :background "gray68" :foreground "black")))) - (message-cited-text ((t (:bold t :background "wheat" :foreground "brown")))) - (message-header-contents ((t (:bold t :background "wheat" :foreground "black")))) - (message-headers ((t (:bold t :background "wheat" :foreground "black")))) - (message-highlighted-header-contents ((t (:bold t :background "wheat" :foreground "blue")))) - (message-url ((t (nil)))) - (modeline ((t (:bold t :background "light salmon" :foreground "dark green")))) - (modeline-buffer-id ((t (:bold t :background "light salmon" :foreground "blue4")))) - (modeline-mousable ((t (:bold t :background "light salmon" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:bold t :background "light salmon" :foreground "green4")))) - (pointer ((t (:bold t :background "wheat" :foreground "red")))) - (primary-selection ((t (:bold t :background "medium sea green")))) - (red ((t (:bold t :foreground "red")))) - (right-margin ((t (:bold t :background "wheat" :foreground "black")))) - (secondary-selection ((t (:bold t :background "paleturquoise" :foreground "black")))) - (shell-input-face ((t (:bold t :background "wheat" :foreground "blue")))) - (shell-option-face ((t (:bold t :background "wheat" :foreground "turquoise4")))) - (shell-output-2-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) - (shell-output-3-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) - (shell-output-face ((t (:bold t :background "wheat" :foreground "black")))) - (shell-prompt-face ((t (:bold t :background "wheat" :foreground "dark orchid")))) - (text-cursor ((t (:bold t :background "red" :foreground "wheat")))) - (toolbar ((t (:bold t :background "wheat" :foreground "black")))) - (underline ((t (:underline t :bold t :background "wheat" :foreground "black")))) - (vertical-divider ((t (:bold t)))) - (widget-button-face ((t (nil)))) - (widget-button-pressed-face ((t (:bold t :background "wheat" :foreground "red")))) - (widget-documentation-face ((t (:bold t :background "wheat" :foreground "dark green")))) - (widget-field-face ((t (:bold t :background "gray85")))) - (widget-inactive-face ((t (:bold t :background "wheat" :foreground "dim gray")))) - (x-face ((t (:bold t :background "wheat" :foreground "black")))) - (yellow ((t (:bold t :foreground "yellow")))) - (zmacs-region ((t (:bold t :background "lightyellow" :foreground "darkgreen"))))))) - -(defun color-theme-classic () - "Color theme by Frederic Giroud, created 2001-01-18. -AntiqueWhite on darkslategrey scheme. Based on Gnome 2, with my favorit -color foreground-color and fontlock color." - (interactive) - (color-theme-blue-gnus) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-classic - ((foreground-color . "AntiqueWhite") - (background-color . "darkslategrey") - (mouse-color . "Grey") - (cursor-color . "Red") - (border-color . "black") - (background-mode . dark)) - ((apropos-keybinding-face . underline) - (apropos-label-face . italic) - (apropos-match-face . secondary-selection) - (apropos-property-face . bold-italic) - (apropos-symbol-face . info-xref) - (goto-address-mail-face . message-header-to-face) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . info-xref) - (goto-address-url-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t :foreground "beige")))) - (calendar-today-face ((t (:underline t)))) - (cperl-array-face ((t (:foreground "Yellow")))) - (cperl-hash-face ((t (:foreground "White")))) - (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) - (custom-button-face ((t (:underline t :foreground "MediumSlateBlue")))) - (custom-documentation-face ((t (:foreground "Grey")))) - (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) - (custom-state-face ((t (:foreground "LightSalmon")))) - (custom-variable-tag-face ((t (:foreground "Aquamarine")))) - (diary-face ((t (:foreground "IndianRed")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "LightSalmon")))) - (erc-error-face ((t (:bold t :foreground "IndianRed")))) - (erc-input-face ((t (:foreground "Beige")))) - (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) - (erc-notice-face ((t (:foreground "MediumAquamarine")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:foreground "MediumAquamarine")))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) - (eshell-ls-backup-face ((t (:foreground "Grey")))) - (eshell-ls-clutter-face ((t (:foreground "DimGray")))) - (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) - (eshell-ls-executable-face ((t (:foreground "Coral")))) - (eshell-ls-missing-face ((t (:foreground "black")))) - (eshell-ls-picture-face ((t (:foreground "Violet")))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) - (eshell-ls-special-face ((t (:foreground "Gold")))) - (eshell-ls-symlink-face ((t (:foreground "White")))) - (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) - (eshell-prompt-face ((t (:foreground "MediumAquamarine")))) - (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen")))) - (font-lock-comment-face ((t (:foreground "tomato3")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-string-face ((t (:foreground "LightSalmon3")))) - (font-lock-function-name-face ((t (:foreground "SteelBlue1")))) - (font-lock-keyword-face ((t (:foreground "cyan1")))) - (font-lock-reference-face ((t (:foreground "LightSalmon2")))) - (font-lock-string-face ((t (:foreground "LightSalmon3")))) - (font-lock-type-face ((t (:foreground "PaleGreen3")))) - (font-lock-variable-name-face ((t (:foreground "khaki1")))) - (font-lock-warning-face ((t (:bold t :foreground "IndianRed")))) - (font-lock-preprocessor-face ((t (:foreground "SkyBlue3")))) - (widget-field-face ((t (:background "DarkCyan")))) - (custom-group-tag-face ((t(:foreground "brown" :underline t)))) - (custom-state-face ((t (:foreground "khaki")))) - (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) - (highline-face ((t (:background "SeaGreen")))) - (holiday-face ((t (:background "DimGray")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) - (info-xref ((t (:underline t :foreground "DodgerBlue1")))) - (isearch ((t (:foreground "red" :background "CornflowerBlue")))) - (italic ((t (:italic t)))) - (modeline ((t (:background "LightSlateGray" :foreground "AntiqueWhite")))) - (modeline-buffer-id ((t (:background "LightSlateGray" :foreground "DarkBlue")))) - (modeline-mousable ((t (:background "LightSlateGray" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "LightSlateGray" :foreground "wheat")))) - (region ((t (:background "dark cyan" :foreground "cyan")))) - (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) - (show-paren-match-face ((t (:background "Aquamarine" :foreground "SlateBlue")))) - (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) - (underline ((t (:underline t)))) - (widget-field-face ((t (:foreground "LightBlue")))) - (widget-inactive-face ((t (:foreground "DimGray")))) - (widget-single-line-field-face ((t (:foreground "LightBlue")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))))))) - -(defun color-theme-scintilla () - "Color theme by Gordon Messmer, created 2001-02-07. -Based on the Scintilla editor. - -If you want to modify the font as well, you should customize variable -`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". -The default setting will prevent color themes from installing specific -fonts." - (interactive) - (color-theme-install - ;; The light editor style doesn't seem to look right with - ;; the same font that works in the dark editor style. - ;; Dark letters on light background just isn't as visible. - '(color-theme-scintilla - ((font . "-monotype-courier new-bold-r-normal-*-*-140-*-*-m-*-iso8859-1") - (width . 95) - (height . 40) - (background-color . "white") - (foreground-color . "black") - (background-mode . light) - (mouse-color . "grey15") - (cursor-color . "grey15")) - (default ((t nil))) - (font-lock-comment-face ((t (:italic t :foreground "ForestGreen")))) - (font-lock-string-face ((t (:foreground "DarkMagenta")))) - (font-lock-keyword-face ((t (:foreground "NavyBlue")))) - (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) - (font-lock-constant-face ((t (:foreground "Blue")))) - (font-lock-type-face ((t (:foreground "NavyBlue")))) - (font-lock-variable-name-face ((t (:foreground "DarkCyan")))) - (font-lock-function-name-face ((t (:foreground "DarkCyan")))) - (font-lock-builtin-face ((t (:foreground "NavyBlue")))) - (highline-face ((t (:background "Grey95")))) - (show-paren-match-face ((t (:background "Grey80")))) - (region ((t (:background "Grey80")))) - (highlight ((t (:foreground "ForestGreen")))) - (secondary-selection ((t (:background "NavyBlue" :foreground "white")))) - (widget-field-face ((t (:background "NavyBlue")))) - (widget-single-line-field-face ((t (:background "RoyalBlue")))))) ) - -(defun color-theme-gtk-ide () - "Color theme by Gordon Messmer, created 2001-02-07. -Inspired by a GTK IDE whose name I've forgotten. - -If you want to modify the font as well, you should customize variable -`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". -The default setting will prevent color themes from installing specific -fonts." - ;; The light editor style doesn't seem to look right with - ;; the same font that works in the dark editor style. - ;; Dark letters on light background just isn't as visible. - (interactive) - (color-theme-install - '(color-theme-gtk-ide - ((font . "-monotype-courier new-medium-r-normal-*-*-120-*-*-m-*-iso8859-15") - (width . 95) - (height . 45) - (background-color . "white") - (foreground-color . "black") - (background-mode . light) - (mouse-color . "grey15") - (cursor-color . "grey15")) - (default ((t nil))) - (font-lock-comment-face ((t (:italic t :foreground "grey55")))) - (font-lock-string-face ((t (:foreground "DarkRed")))) - (font-lock-keyword-face ((t (:foreground "DarkBlue")))) - (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) - (font-lock-constant-face ((t (:foreground "OliveDrab")))) - (font-lock-type-face ((t (:foreground "SteelBlue4")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-function-name-face ((t (:foreground "SlateBlue")))) - (font-lock-builtin-face ((t (:foreground "ForestGreen")))) - (highline-face ((t (:background "grey95")))) - (show-paren-match-face ((t (:background "grey80")))) - (region ((t (:background "grey80")))) - (highlight ((t (:background "LightSkyBlue")))) - (secondary-selection ((t (:background "grey55")))) - (widget-field-face ((t (:background "navy")))) - (widget-single-line-field-face ((t (:background "royalblue")))))) ) - -(defun color-theme-midnight () - "Color theme by Gordon Messmer, created 2001-02-07. -A color theme inspired by a certain IDE for Windows. It's all from memory, -since I only used that software in college. - -If you want to modify the font as well, you should customize variable -`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". -The default setting will prevent color themes from installing specific -fonts." - (interactive) - (color-theme-install - '(color-theme-midnight - ((font . "fixed") - (width . 130) - (height . 50) - (background-color . "black") - (foreground-color . "grey85") - (background-mode . dark) - (mouse-color . "grey85") - (cursor-color . "grey85")) - (default ((t (nil)))) - (font-lock-comment-face ((t (:italic t :foreground "grey60")))) - (font-lock-string-face ((t (:foreground "Magenta")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (font-lock-constant-face ((t (:foreground "OliveDrab")))) - (font-lock-type-face ((t (:foreground "DarkCyan")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-function-name-face ((t (:foreground "SlateBlue")))) - (font-lock-builtin-face ((t (:foreground "SkyBlue")))) - (highline-face ((t (:background "grey12")))) - (setnu-line-number-face ((t (:background "Grey15" :foreground "White" :bold t)))) - (show-paren-match-face ((t (:background "grey30")))) - (region ((t (:background "grey15")))) - (highlight ((t (:background "blue")))) - (secondary-selection ((t (:background "navy")))) - (widget-field-face ((t (:background "navy")))) - (widget-single-line-field-face ((t (:background "royalblue")))))) ) - -(defun color-theme-jedit-grey () - "Color theme by Gordon Messmer, created 2001-02-07. -Based on a screenshot of jedit. - -If you want to modify the font as well, you should customize variable -`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". -The default setting will prevent color themes from installing specific -fonts." - (interactive) - (color-theme-install - '(color-theme-jedit-grey - ((font . "fixed") - (width . 130) - (height . 50) - (background-color . "grey77") - (foreground-color . "black") - (background-mode . light) - (mouse-color . "black") - (cursor-color . "black")) - (default ((t (nil)))) - (font-lock-comment-face ((t (:italic t :foreground "RoyalBlue4")))) - (font-lock-string-face ((t (:foreground "Gold4")))) - (font-lock-keyword-face ((t (:bold t :foreground "DarkRed")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (font-lock-constant-face ((t (:foreground "DarkCyan")))) - (font-lock-type-face ((t (:foreground "DarkRed")))) - (font-lock-function-name-face ((t (:foreground "Green4")))) - (font-lock-builtin-face ((t (:bold t :foreground "DarkRed")))) - (highline-face ((t (:background "grey84")))) - (setnu-line-number-face ((t (:background "White" :foreground "MediumPurple3" :italic t)))) - (show-paren-match-face ((t (:background "grey60")))) - (region ((t (:background "grey70")))) - (highlight ((t (:background "grey90")))) - (secondary-selection ((t (:background "white")))) - (widget-field-face ((t (:background "royalblue")))) - (widget-single-line-field-face ((t (:background "royalblue")))))) ) - -(defun color-theme-snow () - "Color theme by Nicolas Rist, created 2001-03-08. -Black on gainsboro. In Emacs, the text background is a shade darker -than the frame background: Gainsboro instead of snow. This makes the -structure of the text clearer without being too agressive on the eyes. -On XEmacs, this doesn't really work as the frame and the default face -allways use the same foreground and background colors. -The color theme includes gnus, message, font-lock, sgml, and speedbar." - (interactive) - (color-theme-install - '(color-theme-snow - ((background-color . "snow2") - (background-mode . light) - (border-color . "black") - (cursor-color . "RoyalBlue2") - (foreground-color . "black") - (mouse-color . "black")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (:background "gainsboro" :foreground "dark slate gray")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (calendar-today-face ((t (:underline t)))) - (custom-button-face ((t (:background "gainsboro" :foreground "dark cyan")))) - (custom-documentation-face ((t (:background "gainsboro")))) - (diary-face ((t (:foreground "red")))) - (fg:black ((t (:foreground "black")))) - (font-lock-builtin-face ((t (:background "gainsboro" :foreground "medium orchid")))) - (font-lock-comment-face ((t (:background "gainsboro" :foreground "SteelBlue3")))) - (font-lock-constant-face ((t (:background "gainsboro" :foreground "orange3")))) - (font-lock-function-name-face ((t (:background "gainsboro" :foreground "blue3")))) - (font-lock-keyword-face ((t (:background "gainsboro" :foreground "red3")))) - (font-lock-string-face ((t (:background "gainsboro" :foreground "SpringGreen3")))) - (font-lock-type-face ((t (:background "gainsboro" :foreground "dark cyan")))) - (font-lock-variable-name-face ((t (:background "gainsboro" :foreground "purple2")))) - (font-lock-warning-face ((t (:bold t :background "gainsboro" :foreground "red")))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gui-button-face ((t (:foreground "light grey")))) - (highlight ((t (:background "LightSteelBlue1")))) - (holiday-face ((t (:background "pink")))) - (ibuffer-marked-face ((t (:foreground "red")))) - (italic ((t (:italic t)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "dark slate gray" :foreground "gainsboro")))) - (modeline-buffer-id ((t (:background "dark slate gray" :foreground "gainsboro")))) - (modeline-mousable ((t (:background "dark slate gray" :foreground "gainsboro")))) - (modeline-mousable-minor-mode ((t (:background "dark slate gray" :foreground "gainsboro")))) - (region ((t (:background "lavender")))) - (secondary-selection ((t (:background "paleturquoise")))) - (sgml-comment-face ((t (:foreground "dark green")))) - (sgml-doctype-face ((t (:foreground "maroon")))) - (sgml-end-tag-face ((t (:foreground "blue2")))) - (sgml-entity-face ((t (:foreground "red2")))) - (sgml-ignored-face ((t (:background "gray90" :foreground "maroon")))) - (sgml-ms-end-face ((t (:foreground "maroon")))) - (sgml-ms-start-face ((t (:foreground "maroon")))) - (sgml-pi-face ((t (:foreground "maroon")))) - (sgml-sgml-face ((t (:foreground "maroon")))) - (sgml-short-ref-face ((t (:foreground "goldenrod")))) - (sgml-start-tag-face ((t (:foreground "blue2")))) - (show-paren-match-face ((t (:background "SlateGray1")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "dark turquoise" :foreground "white")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (underline ((t (:underline t))))))) - -(defun color-theme-montz () - "Color theme by Brady Montz, created 2001-03-08. -Black on Gray. -Includes dired, bbdb, font-lock, gnus, message, viper, and widget." - (interactive) - (color-theme-install - '(color-theme-montz - ((background-color . "gray80") - (background-mode . light) - (background-toolbar-color . "#cccccccccccc") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#7a7a7a7a7a7a") - (cursor-color . "Red3") - (foreground-color . "black") - (top-toolbar-shadow-color . "#f5f5f5f5f5f5") - (viper-saved-cursor-color-in-replace-mode . "Red3")) - ((gnus-mouse-face . highlight) - (paren-match-face . paren-face-match) - (paren-mismatch-face . paren-face-mismatch) - (paren-no-match-face . paren-face-no-match) - (smiley-mouse-face . highlight)) - (default ((t (nil)))) - (bbdb-company ((t (:italic t)))) - (bbdb-field-name ((t (:bold t)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t)))) - (dired-face-executable ((t (:foreground "SeaGreen")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "black")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (font-lock-builtin-face ((t (:foreground "red3")))) - (font-lock-comment-face ((t (:foreground "blue")))) - (font-lock-constant-face ((t (:foreground "red3")))) - (font-lock-doc-string-face ((t (:foreground "mediumvioletred")))) - (font-lock-function-name-face ((t (:foreground "firebrick")))) - (font-lock-keyword-face ((t (:bold t :foreground "black")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "mediumvioletred")))) - (font-lock-type-face ((t (:foreground "darkgreen")))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-picons-face ((t (:background "white" :foreground "black")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (nil)))) - (highlight ((t (:background "darkseagreen2")))) - (info-node ((t (:bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "paleturquoise")))) - (italic ((t (:italic t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (nil)))) - (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) - (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) - (paren-face-match ((t (:background "turquoise")))) - (paren-face-mismatch ((t (:background "purple" :foreground "white")))) - (paren-face-no-match ((t (:background "yellow" :foreground "black")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (text-cursor ((t (:background "Red3" :foreground "gray80")))) - (toolbar ((t (nil)))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (viper-minibuffer-emacs-face ((t (:background "gray80" :foreground "black")))) - (viper-minibuffer-insert-face ((t (:background "gray80" :foreground "black")))) - (viper-minibuffer-vi-face ((t (:background "gray80" :foreground "black")))) - (viper-replace-overlay-face ((t (:background "black" :foreground "white")))) - (viper-search-face ((t (:background "black" :foreground "white")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "black" :foreground "white"))))))) - -(defun color-theme-aalto-light () - "Color theme by Jari Aalto, created 2001-03-08. -Black on light yellow. -Used for Win32 on a Nokia446Xpro monitor. -Includes cvs, font-lock, gnus, message, sgml, widget" - (interactive) - (color-theme-install - '(color-theme-aalto-light - ((background-color . "#FFFFE0") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "black") - (mouse-color . "LawnGreen")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (tinyreplace-:face . highlight) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (calendar-today-face ((t (:underline t)))) - (cvs-filename-face ((t (:foreground "blue4")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "blue4")))) - (cvs-marked-face ((t (:bold t :foreground "green3")))) - (cvs-msg-face ((t (:italic t)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:foreground "red")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-test-ok-face ((t (:bold t :foreground "Green")))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:foreground "Firebrick")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-keyword-face ((t (:foreground "Purple")))) - (font-lock-string-face ((t (:foreground "RosyBrown")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (highlight ((t (:background "darkseagreen2")))) - (holiday-face ((t (:background "pink")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (italic ((t (:italic t)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "black" :foreground "white")))) - (modeline-buffer-id ((t (:background "black" :foreground "white")))) - (modeline-mousable ((t (:background "black" :foreground "white")))) - (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) - (region ((t (:background "gray")))) - (secondary-selection ((t (:background "paleturquoise")))) - (sgml-comment-face ((t (:foreground "dark turquoise")))) - (sgml-doctype-face ((t (:foreground "red")))) - (sgml-end-tag-face ((t (:foreground "blue")))) - (sgml-entity-face ((t (:foreground "magenta")))) - (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) - (sgml-ms-end-face ((t (:foreground "green")))) - (sgml-ms-start-face ((t (:foreground "green")))) - (sgml-pi-face ((t (:foreground "lime green")))) - (sgml-sgml-face ((t (:foreground "brown")))) - (sgml-short-ref-face ((t (:foreground "deep sky blue")))) - (sgml-start-tag-face ((t (:foreground "blue")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - -(defun color-theme-aalto-dark () - "Color theme by Jari Aalto, created 2001-03-08. -White on Deep Sky Blue 3. -Used for Unix Exceed on a Nokia446Xpro monitor. -Includes font-lock, info, and message." - (interactive) - (color-theme-install - '(color-theme-aalto-dark - ((background-color . "DeepSkyBlue3") - (background-mode . dark) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "white") - (mouse-color . "black")) - ((ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (tinyreplace-:face . highlight) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t :background "blue3" :foreground "white")))) - (bold-italic ((t (:italic t :bold t :foreground "blue3")))) - (calendar-today-face ((t (:underline t)))) - (diary-face ((t (:foreground "red")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "OrangeRed")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (highlight ((t (:background "blue3" :foreground "white")))) - (holiday-face ((t (:background "pink")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (italic ((t (:italic t :background "gray")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4")))) - (message-header-name-face ((t (:foreground "DarkGreen")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-to-face ((t (:bold t :foreground "green2")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "blue3")))) - (modeline ((t (:background "white" :foreground "DeepSkyBlue3")))) - (modeline-buffer-id ((t (:background "white" :foreground "DeepSkyBlue3")))) - (modeline-mousable ((t (:background "white" :foreground "DeepSkyBlue3")))) - (modeline-mousable-minor-mode ((t (:background "white" :foreground "DeepSkyBlue3")))) - (region ((t (:background "gray")))) - (secondary-selection ((t (:background "darkslateblue")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (underline ((t (:underline t))))))) - -(defun color-theme-blippblopp () - "Color theme by Thomas Sicheritz-Ponten, created 2001-03-12. -Used by researchers at Uppsala University and the Center for Biological -Sequence Analysis at the Technical University of Denmark. (As some of my -swedish friends couldn't pronounce Sicheritz - they choose to transform -it to something more \"swedish\": Blippblopp :-) -Includes font-lock and message." - (interactive) - (color-theme-install - '(color-theme-blippblopp - ((background-color . "white") - (background-mode . light) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "Red3") - (foreground-color . "black") - (mouse-color . "black") - (top-toolbar-shadow-color . "#fffffbeeffff") - (viper-saved-cursor-color-in-replace-mode . "Red3")) - ((ispell-highlight-face . highlight)) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (excerpt ((t (:italic t)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (fg:black ((t (:foreground "black")))) - (fixed ((t (:bold t)))) - (font-lock-builtin-face ((t (:foreground "red3")))) - (font-lock-comment-face ((t (:foreground "orange")))) - (font-lock-constant-face ((t (:foreground "red3")))) - (font-lock-doc-string-face ((t (:foreground "darkgreen")))) - (font-lock-exit-face ((t (:foreground "green")))) - (font-lock-function-name-face ((t (:bold t :foreground "red")))) - (font-lock-keyword-face ((t (:bold t :foreground "steelblue")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "green4")))) - (font-lock-type-face ((t (:bold t :foreground "blue")))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (green ((t (:foreground "green")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "dimgray" :foreground "lemonchiffon")))) - (modeline-buffer-id ((t (:background "dimgray" :foreground "green3")))) - (modeline-mousable ((t (:background "dimgray" :foreground "orange")))) - (modeline-mousable-minor-mode ((t (:background "dimgray" :foreground "blue4")))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray65")))) - (secondary-selection ((t (:background "paleturquoise")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (text-cursor ((t (:background "Red3" :foreground "white")))) - (toolbar ((t (:background "Gray80")))) - (underline ((t (:underline t)))) - (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) - (vertical-divider ((t (:background "Gray80")))) - (xref-keyword-face ((t (:foreground "blue")))) - (xref-list-pilot-face ((t (:foreground "navy")))) - (xref-list-symbol-face ((t (:foreground "navy")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65"))))))) - -(defun color-theme-hober (&optional preview) - "Does all sorts of crazy stuff. -Originally based on color-theme-standard, so I probably still have some -setting that I haven't changed. I also liberally copied settings from -the other themes in this package. The end result isn't much like the -other ones; I hope you like it." - (interactive) - (color-theme-install - '(color-theme-hober - ((foreground-color . "#c0c0c0") - (background-color . "black") - (mouse-color . "black") - (cursor-color . "medium turquoise") - (border-color . "black") - (background-mode . dark)) - (default ((t (nil)))) - (modeline ((t (:foreground "white" :background "darkslateblue")))) - (modeline-buffer-id ((t (:foreground "white" :background "darkslateblue")))) - (modeline-mousable ((t (:foreground "white" :background "darkslateblue")))) - (modeline-mousable-minor-mode ((t (:foreground "white" :background "darkslateblue")))) - (highlight ((t (:foreground "black" :background "#c0c0c0")))) - (bold ((t (:bold t)))) - (italic ((t (:italic t)))) - (bold-italic ((t (:bold t :italic t)))) - (region ((t (:foreground "white" :background "darkslateblue")))) - (zmacs-region ((t (:foreground "white" :background "darkslateblue")))) - (secondary-selection ((t (:background "paleturquoise")))) - (underline ((t (:underline t)))) - (diary-face ((t (:foreground "red")))) - (calendar-today-face ((t (:underline t)))) - (holiday-face ((t (:background "pink")))) - (widget-documentation-face ((t (:foreground "dark green" :background "white")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red" :background "black")))) - (widget-field-face ((t (:background "gray85" :foreground "black")))) - (widget-single-line-field-face ((t (:background "gray85" :foreground "black")))) - (widget-inactive-face ((t (:foreground "dim gray" :background "red")))) - (fixed ((t (:bold t)))) - (excerpt ((t (:italic t)))) - (term-default-fg ((t (nil)))) - (term-default-bg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-bold ((t (:bold t)))) - (term-underline ((t (:underline t)))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-white ((t (:foreground "#c0c0c0")))) - (term-whitebg ((t (:background "#c0c0c0")))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-red ((t (:foreground "#ef8171")))) - (term-redbg ((t (:background "#ef8171")))) - (term-green ((t (:foreground "#e5f779")))) - (term-greenbg ((t (:background "#e5f779")))) - (term-yellow ((t (:foreground "#fff796")))) - (term-yellowbg ((t (:background "#fff796")))) - (term-blue ((t (:foreground "#4186be")))) - (term-bluebg ((t (:background "#4186be")))) - (term-magenta ((t (:foreground "#ef9ebe")))) - (term-magentabg ((t (:background "#ef9ebe")))) - (term-cyan ((t (:foreground "#71bebe")))) - (term-cyanbg ((t (:background "#71bebe")))) - (font-lock-keyword-face ((t (:foreground "#00ffff")))) - (font-lock-comment-face ((t (:foreground "Red")))) - (font-lock-string-face ((t (:foreground "#ffff00")))) - (font-lock-constant-face ((t (:foreground "#00ff00")))) - (font-lock-builtin-face ((t (:foreground "#ffaa00")))) - (font-lock-type-face ((t (:foreground "Coral")))) - (font-lock-warning-face ((t (:foreground "Red" :bold t)))) - (font-lock-function-name-face ((t (:foreground "#4186be")))) - (font-lock-variable-name-face ((t (:foreground "white" :bold t)))) - (message-header-to-face ((t (:foreground "#4186be" :bold t)))) - (message-header-cc-face ((t (:foreground "#4186be")))) - (message-header-subject-face ((t (:foreground "#4186be" :bold t)))) - (message-header-newsgroups-face ((t (:foreground "Coral" :bold t)))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-name-face ((t (:foreground "white")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-separator-face ((t (:foreground "brown")))) - (message-cited-text-face ((t (:foreground "white")))) - (gnus-header-from-face ((t (:foreground "Coral")))) - (gnus-header-subject-face ((t (:foreground "#4186be")))) - (gnus-header-newsgroups-face ((t (:foreground "#4186be" :italic t)))) - (gnus-header-name-face ((t (:foreground "white")))) - (gnus-header-content-face ((t (:foreground "#4186be" :italic t)))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-list ((t (:bold nil :foreground "red")))) - (gnus-group-news-1-face ((t (:foreground "ForestGreen" :bold t)))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-2-face ((t (:foreground "CadetBlue4" :bold t)))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-low-face ((t (:foreground "DarkGreen" :bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-mail-1-face ((t (:foreground "DeepPink3" :bold t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-2-face ((t (:foreground "HotPink3" :bold t)))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-3-face ((t (:foreground "magenta4" :bold t)))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-low-face ((t (:foreground "DeepPink4" :bold t)))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) - (gnus-summary-high-ticked-face ((t (:foreground "firebrick" :bold t)))) - (gnus-summary-low-ticked-face ((t (:foreground "firebrick" :italic t)))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-high-ancient-face ((t (:foreground "RoyalBlue" :bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue" :italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-high-read-face ((t (:foreground "DarkGreen" :bold t)))) - (gnus-summary-low-read-face ((t (:foreground "DarkGreen" :italic t)))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) - (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) - (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) - (gnus-signature-face ((t (:foreground "white")))) - (gnus-cite-face-1 ((t (:foreground "Khaki")))) - (gnus-cite-face-2 ((t (:foreground "Coral")))) - (gnus-cite-face-3 ((t (:foreground "#4186be")))) - (gnus-cite-face-4 ((t (:foreground "yellow green")))) - (gnus-cite-face-5 ((t (:foreground "IndianRed")))) - (highlight-changes-face ((t (:foreground "red")))) - (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) - (show-paren-match-face ((t (:foreground "white" :background "purple")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cperl-array-face ((t (:foreground "Blue" :bold t :background "lightyellow2")))) - (cperl-hash-face ((t (:foreground "Red" :bold t :italic t :background "lightyellow2")))) - (makefile-space-face ((t (:background "hotpink")))) - (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) - (sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) - (sgml-doctype-face ((t (:foreground "orange")))) - (sgml-sgml-face ((t (:foreground "yellow")))) - (sgml-end-tag-face ((t (:foreground "greenyellow")))) - (sgml-entity-face ((t (:foreground "gold")))) - (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) - (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t))))))) - -(defun color-theme-bharadwaj () - "Color theme by Girish Bharadwaj, created 2001-03-28. -Black on gainsboro. Includes BBDB, custom, cperl, cvs, dired, ediff, -erc, eshell, font-latex, font-lock, gnus, info, message, paren, sgml, -shell, speedbar, term, vhdl, viper, widget, woman, xref. Wow!" - (interactive) - (color-theme-install - '(color-theme-bharadwaj - ((background-color . "gainsboro") - (background-mode . light) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "black") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "grey15") - (foreground-color . "black") - (mouse-color . "grey15") - (top-toolbar-shadow-color . "#fffffbeeffff") - (viper-saved-cursor-color-in-replace-mode . "Red3")) - ((gnus-mouse-face . highlight) - (smiley-mouse-face . highlight)) - (default ((t (nil)))) - (bbdb-company ((t (nil)))) - (bbdb-field-name ((t (:bold t)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (blank-space-face ((t (nil)))) - (blank-tab-face ((t (nil)))) - (blue ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:bold t)))) - (border-glyph ((t (nil)))) - (calendar-today-face ((t (:underline t)))) - (comint-input-face ((t (:foreground "deepskyblue")))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) - (cperl-hash-face ((t (:bold t :background "lightyellow2" :foreground "Red")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :bold t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) - (cvs-filename-face ((t (:foreground "blue4")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "blue4")))) - (cvs-marked-face ((t (:bold t :foreground "green3")))) - (cvs-msg-face ((t (nil)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:bold t :foreground "red")))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t :foreground "forestgreen")))) - (dired-face-executable ((t (:foreground "indianred")))) - (dired-face-flagged ((t (:background "SlateGray")))) - (dired-face-marked ((t (:background "darkblue" :foreground "deepskyblue")))) - (dired-face-permissions ((t (nil)))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "grey95")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (nil)))) - (erc-error-face ((t (:bold t)))) - (erc-input-face ((t (nil)))) - (erc-inverse-face ((t (nil)))) - (erc-notice-face ((t (nil)))) - (erc-pal-face ((t (nil)))) - (erc-prompt-face ((t (nil)))) - (erc-underline-face ((t (nil)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) - (eshell-ls-picture-face ((t (nil)))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-test-ok-face ((t (:bold t :foreground "Green")))) - (excerpt ((t (nil)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (fg:black ((t (:foreground "black")))) - (fixed ((t (:bold t)))) - (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) - (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) - (font-latex-bold-face ((t (nil)))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (nil)))) - (font-latex-string-face ((t (nil)))) - (font-latex-warning-face ((t (nil)))) - (font-lock-builtin-face ((t (:foreground "ForestGreen")))) - (font-lock-comment-face ((t (:foreground "grey55")))) - (font-lock-constant-face ((t (:foreground "OliveDrab")))) - (font-lock-doc-string-face ((t (:bold t :foreground "blue4")))) - (font-lock-exit-face ((t (nil)))) - (font-lock-function-name-face ((t (:italic t :bold t :foreground "SlateBlue")))) - (font-lock-keyword-face ((t (:foreground "DarkBlue")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "DarkRed")))) - (font-lock-type-face ((t (:foreground "SteelBlue4")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) - (fringe ((t (:background "grey95")))) - (gnus-cite-attribution-face ((t (:bold t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:bold t)))) - (gnus-emphasis-highlight-words ((t (nil)))) - (gnus-emphasis-italic ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:foreground "indianred4")))) - (gnus-header-from-face ((t (:bold t :foreground "red3")))) - (gnus-header-name-face ((t (:bold t :foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:bold t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:bold t :foreground "red4")))) - (gnus-picons-face ((t (:background "white" :foreground "black")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (nil)))) - (gnus-splash ((t (nil)))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (nil)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (:bold t)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (nil)))) - (gui-button-face ((t (:background "grey75")))) - (gui-element ((t (:background "Gray80")))) - (highlight ((t (:background "LightSkyBlue")))) - (highlight-changes-delete-face ((t (:underline t :foreground "red")))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "grey95")))) - (holiday-face ((t (:background "pink")))) - (html-helper-italic-face ((t (nil)))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "yellow")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (nil)))) - (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) - (left-margin ((t (nil)))) - (linemenu-face ((t (nil)))) - (list-mode-item-selected ((t (nil)))) - (makefile-space-face ((t (:background "hotpink")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:bold t)))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "white" :foreground "black")))) - (modeline-buffer-id ((t (:background "white" :foreground "black")))) - (modeline-mousable ((t (:background "white" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "white" :foreground "black")))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-face-match ((t (:background "turquoise")))) - (paren-face-mismatch ((t (:background "purple" :foreground "white")))) - (paren-face-no-match ((t (:background "yellow" :foreground "black")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (paren-mismatch-face ((t (:bold t)))) - (paren-no-match-face ((t (:bold t)))) - (pointer ((t (nil)))) - (primary-selection ((t (nil)))) - (red ((t (nil)))) - (region ((t (:background "grey80")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "grey55")))) - (sgml-comment-face ((t (:foreground "dark turquoise")))) - (sgml-doctype-face ((t (nil)))) - (sgml-end-tag-face ((t (nil)))) - (sgml-entity-face ((t (nil)))) - (sgml-ignored-face ((t (nil)))) - (sgml-ms-end-face ((t (:foreground "green")))) - (sgml-ms-start-face ((t (:foreground "green")))) - (sgml-pi-face ((t (:foreground "lime green")))) - (sgml-sgml-face ((t (nil)))) - (sgml-short-ref-face ((t (:foreground "deep sky blue")))) - (sgml-start-tag-face ((t (nil)))) - (shell-option-face ((t (:foreground "blue")))) - (shell-output-2-face ((t (:foreground "darkseagreen")))) - (shell-output-3-face ((t (:foreground "slategrey")))) - (shell-output-face ((t (:foreground "palegreen")))) - (shell-prompt-face ((t (:foreground "red")))) - (show-paren-match-face ((t (:background "grey80")))) - (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) - (speedbar-button-face ((t (:bold t :foreground "green4")))) - (speedbar-directory-face ((t (:bold t :foreground "blue4")))) - (speedbar-file-face ((t (:bold t :foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (swbuff-current-buffer-face ((t (:bold t)))) - (template-message-face ((t (:bold t)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (text-cursor ((t (:background "grey15" :foreground "gainsboro")))) - (toolbar ((t (nil)))) - (underline ((t (:underline t)))) - (vc-annotate-face-0046FF ((t (nil)))) - (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) - (vertical-divider ((t (nil)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (vvb-face ((t (:background "pink" :foreground "black")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "navy" :foreground "white")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "royalblue" :foreground "white")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (nil)))) - (woman-unknown-face ((t (nil)))) - (xref-keyword-face ((t (:foreground "blue")))) - (xref-list-pilot-face ((t (:foreground "navy")))) - (xref-list-symbol-face ((t (:foreground "navy")))) - (yellow ((t (nil)))) - (zmacs-region ((t (:background "royalblue"))))))) - -(defun color-theme-oswald () - "Color theme by Tom Oswald, created 2001-04-18. -Green on black, includes font-lock, show-paren, and ediff." - (interactive) - (color-theme-install - '(color-theme-oswald - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "green") - (mouse-color . "black")) - ((blank-space-face . blank-space-face) - (blank-tab-face . blank-tab-face) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (blank-space-face ((t (:background "LightGray")))) - (blank-tab-face ((t (:background "green" :foreground "black")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (font-lock-builtin-face ((t (:italic t :bold t :foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:italic t :foreground "LightGoldenrod4")))) - (font-lock-constant-face ((t (:italic t :foreground "HotPink")))) - (font-lock-doc-string-face ((t (:italic t :foreground "orange")))) - (font-lock-function-name-face ((t (:italic t :bold t :foreground "red")))) - (font-lock-keyword-face ((t (:foreground "red")))) - (font-lock-preprocessor-face ((t (:italic t :foreground "HotPink")))) - (font-lock-string-face ((t (:italic t :foreground "orange")))) - (font-lock-reference-face ((t (:italic t :bold t :foreground "LightSteelBlue")))) - (font-lock-type-face ((t (:italic t :foreground "LightSlateBlue")))) - (font-lock-variable-name-face ((t (:underline t :foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (highlight ((t (:background "yellow" :foreground "red")))) - (isearch ((t (:background "dim gray" :foreground "aquamarine")))) - (ispell-face ((t (:bold t :background "#3454b4" :foreground "yellow")))) - (italic ((t (:italic t)))) - (modeline ((t (:background "green" :foreground "black")))) - (modeline-buffer-id ((t (:background "green" :foreground "black")))) - (modeline-mousable ((t (:background "green" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "green" :foreground "black")))) - (region ((t (:background "dim gray" :foreground "aquamarine")))) - (secondary-selection ((t (:background "darkslateblue" :foreground "light goldenrod")))) - (show-paren-match-face ((t (:background "turquoise" :foreground "black")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (underline ((t (:underline t)))) - (zmacs-region ((t (:background "dim gray" :foreground "aquamarine"))))))) - -(defun color-theme-salmon-diff () - "Salmon and aquamarine faces for diff and change-log modes. -This is intended for other color themes to use (eg. `color-theme-gnome2')." - (color-theme-install - '(color-theme-salmon-diff - nil - (change-log-acknowledgement-face ((t (:foreground "LightBlue")))) - (change-log-conditionals-face ((t (:bold t :weight bold :foreground "Aquamarine")))) - (change-log-date-face ((t (:foreground "LightSalmon")))) - (change-log-email-face ((t (:bold t :weight bold :foreground "Aquamarine")))) - (change-log-file-face ((t (:bold t :weight bold :foreground "Aquamarine")))) - (change-log-function-face ((t (:bold t :weight bold :foreground "Aquamarine")))) - (change-log-list-face ((t (:foreground "Salmon")))) - (change-log-name-face ((t (:foreground "Aquamarine")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey70")))) - (diff-file-header-face ((t (:bold t)))) - (diff-function-face ((t (:foreground "grey70")))) - (diff-header-face ((t (:foreground "light salmon")))) - (diff-hunk-header-face ((t (:foreground "light salmon")))) - (diff-index-face ((t (:bold t)))) - (diff-nonexistent-face ((t (:bold t)))) - (diff-removed-face ((t (nil)))) - (log-view-message-face ((t (:foreground "light salmon"))))))) - -(defun color-theme-robin-hood () - "`color-theme-gnome2' with navajo white on green. -This theme tries to avoid underlined and italic faces, because -the fonts either look ugly, or do not exist. The author himself -uses neep, for example." - (interactive) - (color-theme-gnome2) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-robin-hood - ((foreground-color . "navajo white") - (background-color . "#304020")) - ((CUA-mode-read-only-cursor-color . "white") - (help-highlight-face . info-xref) - (list-matching-lines-buffer-name-face . bold)) - (default ((t (nil)))) - (button ((t (:bold t)))) - (calendar-today-face ((t (:foreground "lemon chiffon")))) - (custom-button-face ((t (:bold t :foreground "DodgerBlue1")))) - (diary-face ((t (:bold t :foreground "yellow")))) - (fringe ((t (:background "#003700")))) - (header-line ((t (:background "#030" :foreground "#AA7")))) - (holiday-face ((t (:bold t :foreground "peru")))) - (ido-subdir-face ((t (:foreground "MediumSlateBlue")))) - (isearch ((t (:foreground "pink" :background "red")))) - (isearch-lazy-highlight-face ((t (:foreground "red")))) - (menu ((t (:background "#304020" :foreground "navajo white")))) - (minibuffer-prompt ((t (:foreground "pale green")))) - (modeline ((t (:background "dark olive green" :foreground "wheat" :box (:line-width 1 :style released-button))))) - (mode-line-inactive ((t (:background "dark olive green" :foreground "khaki" :box (:line-width 1 :style released-button))))) - (semantic-dirty-token-face ((t (:background "grey22")))) - (tool-bar ((t (:background "#304020" :foreground "wheat" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lemon chiffon" :foreground "black")))))))) - -(defun color-theme-snowish () - "Color theme by Girish Bharadwaj, created 2001-05-17. -Dark slate gray on snow2, lots of blue colors. -Includes custom, eshell, font-lock, gnus, html-helper, -hyper-apropos, jde, message, paren, semantic, speedbar, -term, widget." - (interactive) - (color-theme-install - '(color-theme-snowish - ((background-color . "snow2") - (background-mode . light) - (cursor-color . "Red3") - (foreground-color . "darkslategray")) - ((buffers-tab-face . buffers-tab) - (gnus-mouse-face . highlight) - (sgml-set-face . t) - (smiley-mouse-face . highlight)) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t :foreground "peru")))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:background "snow2" :foreground "darkslategray")))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (cyan ((t (:foreground "cyan")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan")))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red")))) - (font-lock-builtin-face ((t (:underline t :foreground "blue")))) - (font-lock-comment-face ((t (:foreground "snow4")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-doc-string-face ((t (:foreground "mediumblue")))) - (font-lock-function-name-face ((t (:bold t :foreground "darkblue")))) - (font-lock-keyword-face ((t (:bold t :foreground "dodgerblue")))) - (font-lock-preprocessor-face ((t (:underline t :foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "darkviolet")))) - (font-lock-type-face ((t (:foreground "goldenrod")))) - (font-lock-variable-name-face ((t (:foreground "tomato")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (gnus-cite-attribution-face ((t (nil)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (nil)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t)))) - (gnus-emphasis-underline-italic ((t (:underline t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:foreground "indianred4")))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-picons-face ((t (:background "white" :foreground "black")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (nil)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (nil)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "#D4D0C8" :foreground "black")))) - (highlight ((t (:background "darkseagreen2")))) - (html-helper-bold-face ((t (:bold t)))) - (html-helper-bold-italic-face ((t (nil)))) - (html-helper-builtin-face ((t (:underline t :foreground "blue3")))) - (html-helper-italic-face ((t (:foreground "medium sea green")))) - (html-helper-underline-face ((t (:underline t)))) - (html-tag-face ((t (:bold t)))) - (hyper-apropos-documentation ((t (:foreground "darkred")))) - (hyper-apropos-heading ((t (:bold t)))) - (hyper-apropos-hyperlink ((t (:foreground "blue4")))) - (hyper-apropos-major-heading ((t (:bold t)))) - (hyper-apropos-section-heading ((t (nil)))) - (hyper-apropos-warning ((t (:bold t :foreground "red")))) - (info-menu-6 ((t (nil)))) - (isearch ((t (:background "paleturquoise")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (nil)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) - (jde-java-font-lock-link-face ((t (:underline t :foreground "blue")))) - (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "darkslategray")))) - (magenta ((t (:foreground "magenta")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (nil)))) - (modeline-buffer-id ((t (:background "#D4D0C8" :foreground "blue4")))) - (modeline-mousable ((t (:background "#D4D0C8" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "#D4D0C8" :foreground "green4")))) - (paren-blink-off ((t (:foreground "snow2")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "snow2" :foreground "darkslategray")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (semantic-intangible-face ((t (:foreground "gray25")))) - (semantic-read-only-face ((t (:background "gray25")))) - (senator-momentary-highlight-face ((t (:background "gray70")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (template-message-face ((t (:bold t)))) - (term-blue-bold-face ((t (:bold t :background "snow2" :foreground "blue")))) - (term-blue-face ((t (:foreground "blue")))) - (term-blue-inv-face ((t (:background "blue")))) - (term-blue-ul-face ((t (:underline t :background "snow2" :foreground "blue")))) - (term-cyan-bold-face ((t (:bold t :background "snow2" :foreground "cyan")))) - (term-cyan-face ((t (:foreground "cyan")))) - (term-cyan-inv-face ((t (:background "cyan")))) - (term-cyan-ul-face ((t (:underline t :background "snow2" :foreground "cyan")))) - (term-default-bold-face ((t (:bold t :background "snow2" :foreground "darkslategray")))) - (term-default-face ((t (:background "snow2" :foreground "darkslategray")))) - (term-default-inv-face ((t (:background "darkslategray" :foreground "snow2")))) - (term-default-ul-face ((t (:underline t :background "snow2" :foreground "darkslategray")))) - (term-green-bold-face ((t (:bold t :background "snow2" :foreground "green")))) - (term-green-face ((t (:foreground "green")))) - (term-green-inv-face ((t (:background "green")))) - (term-green-ul-face ((t (:underline t :background "snow2" :foreground "green")))) - (term-magenta-bold-face ((t (:bold t :background "snow2" :foreground "magenta")))) - (term-magenta-face ((t (:foreground "magenta")))) - (term-magenta-inv-face ((t (:background "magenta")))) - (term-magenta-ul-face ((t (:underline t :background "snow2" :foreground "magenta")))) - (term-red-bold-face ((t (:bold t :background "snow2" :foreground "red")))) - (term-red-face ((t (:foreground "red")))) - (term-red-inv-face ((t (:background "red")))) - (term-red-ul-face ((t (:underline t :background "snow2" :foreground "red")))) - (term-white-bold-face ((t (:bold t :background "snow2" :foreground "white")))) - (term-white-face ((t (:foreground "white")))) - (term-white-inv-face ((t (:background "snow2")))) - (term-white-ul-face ((t (:underline t :background "snow2" :foreground "white")))) - (term-yellow-bold-face ((t (:bold t :background "snow2" :foreground "yellow")))) - (term-yellow-face ((t (:foreground "yellow")))) - (term-yellow-inv-face ((t (:background "yellow")))) - (term-yellow-ul-face ((t (:underline t :background "snow2" :foreground "yellow")))) - (text-cursor ((t (:background "Red3" :foreground "snow2")))) - (toolbar ((t (nil)))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (white ((t (:foreground "white")))) - (widget ((t (nil)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65"))))))) - -(defun color-theme-dark-laptop () - "Color theme by Laurent Michel, created 2001-05-24. -Includes custom, fl, font-lock, gnus, message, widget." - (interactive) - (color-theme-install - '(color-theme-dark-laptop - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "white") - (mouse-color . "sienna1")) - ((gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "light blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) - (fl-comment-face ((t (:foreground "pink")))) - (fl-doc-string-face ((t (:foreground "purple")))) - (fl-function-name-face ((t (:foreground "red")))) - (fl-keyword-face ((t (:foreground "cyan")))) - (fl-string-face ((t (:foreground "green")))) - (fl-type-face ((t (:foreground "yellow")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "OrangeRed")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) - (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) - (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:bold t :foreground "deep sky blue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:bold t :foreground "cyan")))) - (gnus-cite-face-3 ((t (:bold t :foreground "gold")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:bold t :foreground "chocolate")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) - (gnus-header-content-face ((t (:italic t :foreground "forest green")))) - (gnus-header-from-face ((t (:bold t :foreground "spring green")))) - (gnus-header-name-face ((t (:foreground "deep sky blue")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "purple")))) - (gnus-header-subject-face ((t (:bold t :foreground "orange")))) - (gnus-signature-face ((t (:bold t :foreground "khaki")))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (highlight ((t (:background "darkolivegreen")))) - (italic ((t (:italic t)))) - (message-cited-text-face ((t (:bold t :foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4")))) - (message-header-name-face ((t (:bold t :foreground "orange")))) - (message-header-newsgroups-face ((t (:bold t :foreground "violet")))) - (message-header-other-face ((t (:bold t :foreground "chocolate")))) - (message-header-subject-face ((t (:bold t :foreground "yellow")))) - (message-header-to-face ((t (:bold t :foreground "cyan")))) - (message-header-xheader-face ((t (:bold t :foreground "light blue")))) - (message-mml-face ((t (:bold t :background "Green3")))) - (message-separator-face ((t (:foreground "blue3")))) - (modeline ((t (:background "white" :foreground "black")))) - (modeline-buffer-id ((t (:background "white" :foreground "black")))) - (modeline-mousable ((t (:background "white" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "white" :foreground "black")))) - (region ((t (:background "blue")))) - (primary-selection ((t (:background "blue")))) - (isearch ((t (:background "blue")))) - (zmacs-region ((t (:background "blue")))) - (secondary-selection ((t (:background "darkslateblue")))) - (underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray"))))))) - -(defun color-theme-taming-mr-arneson () - "Color theme by Erik Arneson, created 2001-06-12. -Light sky blue on black. Includes bbdb, cperl, custom, cvs, diff, -dired, font-lock, html-helper, hyper-apropos, info, isearch, man, -message, paren, shell, and widget." - (interactive) - (color-theme-install - '(color-theme-taming-mr-arneson - ((background-color . "black") - (background-mode . light) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "Red3") - (foreground-color . "LightSkyBlue") - (top-toolbar-shadow-color . "#fffffbeeffff")) - ((buffers-tab-face . buffers-tab) - (cperl-here-face . font-lock-string-face) - (cperl-invalid-face quote default) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (ispell-highlight-face . highlight) - (vc-mode-face . highlight) - (vm-highlight-url-face . bold-italic) - (vm-highlighted-header-face . bold) - (vm-mime-button-face . gui-button-face) - (vm-summary-highlight-face . bold)) - (default ((t (nil)))) - (bbdb-company ((t (nil)))) - (bbdb-field-name ((t (:bold t)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:bold t :foreground "yellow")))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:background "black" :foreground "LightSkyBlue")))) - (cperl-array-face ((t (:bold t :foreground "SkyBlue2")))) - (cperl-hash-face ((t (:foreground "LightBlue2")))) - (cperl-invalid-face ((t (:foreground "white")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:foreground "white")))) - (custom-comment-tag-face ((t (:foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "white")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (cvs-filename-face ((t (:foreground "white")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:foreground "green")))) - (cvs-marked-face ((t (:bold t :foreground "green3")))) - (cvs-msg-face ((t (:foreground "red")))) - (cvs-need-action-face ((t (:foreground "yellow")))) - (cvs-unknown-face ((t (:foreground "grey")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-file-header-face ((t (:bold t :background "grey70")))) - (diff-hunk-header-face ((t (:background "grey85")))) - (diff-index-face ((t (:bold t :background "grey70")))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t :foreground "SkyBlue2")))) - (dired-face-executable ((t (:foreground "Green")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-header ((t (:background "grey75" :foreground "black")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "black")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (excerpt ((t (nil)))) - (fixed ((t (:bold t)))) - (font-lock-builtin-face ((t (:foreground "red3")))) - (font-lock-comment-face ((t (:foreground "red")))) - (font-lock-constant-face ((t (nil)))) - (font-lock-doc-string-face ((t (:foreground "turquoise")))) - (font-lock-function-name-face ((t (:foreground "white")))) - (font-lock-keyword-face ((t (:foreground "green")))) - (font-lock-preprocessor-face ((t (:foreground "green3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "turquoise")))) - (font-lock-type-face ((t (:foreground "steelblue")))) - (font-lock-variable-name-face ((t (:foreground "magenta2")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (nil)))) - (highlight ((t (:background "darkseagreen2" :foreground "blue")))) - (html-helper-bold-face ((t (:bold t)))) - (html-helper-italic-face ((t (:bold t :foreground "yellow")))) - (html-helper-underline-face ((t (:underline t)))) - (hyper-apropos-documentation ((t (:foreground "white")))) - (hyper-apropos-heading ((t (:bold t)))) - (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) - (hyper-apropos-major-heading ((t (:bold t)))) - (hyper-apropos-section-heading ((t (:bold t)))) - (hyper-apropos-warning ((t (:bold t :foreground "red")))) - (info-node ((t (:bold t :foreground "yellow")))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "paleturquoise" :foreground "dark red")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:bold t :foreground "yellow")))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "dark green")))) - (man-bold ((t (:bold t)))) - (man-heading ((t (:bold t)))) - (man-italic ((t (:foreground "yellow")))) - (man-xref ((t (:underline t)))) - (message-cited-text ((t (:foreground "orange")))) - (message-header-contents ((t (:foreground "white")))) - (message-headers ((t (:bold t :foreground "orange")))) - (message-highlighted-header-contents ((t (:bold t)))) - (message-url ((t (:bold t :foreground "pink")))) - (mmm-face ((t (:background "black" :foreground "green")))) - (modeline ((t (nil)))) - (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) - (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-match ((t (:background "dark blue")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "LightSkyBlue")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65" :foreground "DarkBlue")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray65" :foreground "DarkBlue")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise" :foreground "black")))) - (shell-option-face ((t (:foreground "blue4")))) - (shell-output-2-face ((t (:foreground "green4")))) - (shell-output-3-face ((t (:foreground "green4")))) - (shell-output-face ((t (:bold t)))) - (shell-prompt-face ((t (:foreground "red4")))) - (text-cursor ((t (:background "Red3" :foreground "black")))) - (toolbar ((t (:background "Gray80" :foreground "black")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (vm-xface ((t (:background "white" :foreground "black")))) - (vmpc-pre-sig-face ((t (:foreground "forestgreen")))) - (vmpc-sig-face ((t (:foreground "steelblue")))) - (widget ((t (nil)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85" :foreground "black")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (x-face ((t (:background "white" :foreground "black")))) - (xrdb-option-name-face ((t (:foreground "red")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65"))))))) - -(defun color-theme-digital-ofs1 () - "Color theme by Gareth Owen, created 2001-06-13. -This works well on an old, beat-up Digital Unix box with its 256 colour -display, on which other color themes hog too much of the palette. -Black on some shade of dark peach. Includes bbdb, cperl, custom, -cvs, diff, dired, ediff, erc, eshell, font-latex, font-lock, gnus, -highlight, hproperty, html-helper, hyper-apropos, info, jde, man, -message, paren, searchm, semantic, sgml, shell, speedbar, term, -vhdl, viper, w3m, widget, woman, x-symbol, xref." - (interactive) - (color-theme-install - '(color-theme-digital-ofs1 - ((background-color . "#CA94AA469193") - (background-mode . light) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "black") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "Black") - (foreground-color . "Black") - (mouse-color . "Black") - (top-toolbar-shadow-color . "#fffffbeeffff") - (viper-saved-cursor-color-in-replace-mode . "Red3")) - ((Man-overstrike-face . bold) - (Man-underline-face . underline) - (gnus-mouse-face . highlight) - (goto-address-mail-face . italic) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . bold) - (goto-address-url-mouse-face . highlight) - (ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (rmail-highlight-face . font-lock-function-name-face) - (view-highlight-face . highlight)) - (default ((t (:bold t)))) - (bbdb-company ((t (:italic t)))) - (bbdb-field-name ((t (:bold t)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (blank-space-face ((t (nil)))) - (blank-tab-face ((t (nil)))) - (blue ((t (:bold t :foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (:bold t)))) - (buffers-tab ((t (:background "black" :foreground "LightSkyBlue")))) - (calendar-today-face ((t (:underline t :bold t :foreground "white")))) - (comint-input-face ((t (nil)))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) - (cperl-here-face ((t (nil)))) - (cperl-invalid-face ((t (:foreground "white")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cperl-pod-face ((t (nil)))) - (cperl-pod-head-face ((t (nil)))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:bold t :background "blue" :foreground "white")))) - (custom-comment-face ((t (:foreground "white")))) - (custom-comment-tag-face ((t (:foreground "white")))) - (custom-documentation-face ((t (:bold t)))) - (custom-face-tag-face ((t (:underline t :bold t)))) - (custom-group-tag-face ((t (:underline t :bold t :foreground "DarkBlue")))) - (custom-group-tag-face-1 ((t (:underline t :bold t :foreground "red")))) - (custom-invalid-face ((t (:bold t :background "red" :foreground "yellow")))) - (custom-modified-face ((t (:bold t :background "blue" :foreground "white")))) - (custom-rogue-face ((t (:bold t :background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t :bold t)))) - (custom-set-face ((t (:bold t :background "white" :foreground "blue")))) - (custom-state-face ((t (:bold t :foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) - (cvs-filename-face ((t (:foreground "white")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "green")))) - (cvs-marked-face ((t (:bold t :foreground "green3")))) - (cvs-msg-face ((t (:italic t :foreground "red")))) - (cvs-need-action-face ((t (:foreground "yellow")))) - (cvs-unknown-face ((t (:foreground "grey")))) - (cyan ((t (:foreground "cyan")))) - (diary-face ((t (:bold t :foreground "red")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-file-header-face ((t (:bold t :background "grey70")))) - (diff-hunk-header-face ((t (:background "grey85")))) - (diff-index-face ((t (:bold t :background "grey70")))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t)))) - (dired-face-executable ((t (:foreground "SeaGreen")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-header ((t (:background "grey75" :foreground "black")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "black")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (display-time-mail-balloon-enhance-face ((t (:bold t :background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:bold t :foreground "blue")))) - (display-time-time-balloon-face ((t (:bold t :foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (nil)))) - (erc-error-face ((t (:bold t)))) - (erc-input-face ((t (nil)))) - (erc-inverse-face ((t (nil)))) - (erc-notice-face ((t (nil)))) - (erc-pal-face ((t (nil)))) - (erc-prompt-face ((t (nil)))) - (erc-underline-face ((t (nil)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) - (eshell-ls-picture-face ((t (:foreground "Violet")))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) - (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) - (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine")))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-test-ok-face ((t (:bold t :foreground "Green")))) - (excerpt ((t (:italic t)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (fg:black ((t (:foreground "black")))) - (fixed ((t (:bold t)))) - (fl-comment-face ((t (:foreground "medium purple")))) - (fl-doc-string-face ((t (nil)))) - (fl-function-name-face ((t (:foreground "green")))) - (fl-keyword-face ((t (:foreground "LightGreen")))) - (fl-string-face ((t (:foreground "light coral")))) - (fl-type-face ((t (:foreground "cyan")))) - (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) - (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) - (font-latex-bold-face ((t (:bold t)))) - (font-latex-italic-face ((t (:italic t)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (nil)))) - (font-latex-string-face ((t (nil)))) - (font-latex-warning-face ((t (nil)))) - (font-lock-builtin-face ((t (:italic t :bold t :foreground "Orchid")))) - (font-lock-comment-face ((t (:bold t :foreground "Firebrick")))) - (font-lock-constant-face ((t (:italic t :bold t :foreground "CadetBlue")))) - (font-lock-doc-string-face ((t (:italic t :bold t :foreground "green4")))) - (font-lock-emphasized-face ((t (:bold t)))) - (font-lock-exit-face ((t (:foreground "green")))) - (font-lock-function-name-face ((t (:italic t :bold t :foreground "Blue")))) - (font-lock-keyword-face ((t (:bold t :foreground "dark olive green")))) - (font-lock-other-emphasized-face ((t (:italic t :bold t)))) - (font-lock-other-type-face ((t (:bold t :foreground "DarkBlue")))) - (font-lock-preprocessor-face ((t (:italic t :bold t :foreground "blue3")))) - (font-lock-reference-face ((t (:italic t :bold t :foreground "red3")))) - (font-lock-special-comment-face ((t (nil)))) - (font-lock-special-keyword-face ((t (nil)))) - (font-lock-string-face ((t (:italic t :bold t :foreground "DarkBlue")))) - (font-lock-type-face ((t (:italic t :bold t :foreground "DarkGreen")))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "darkgreen")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (fringe ((t (:background "grey95")))) - (gdb-arrow-face ((t (:bold t)))) - (gnus-cite-attribution-face ((t (:italic t :bold t)))) - (gnus-cite-face-1 ((t (:bold t :foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:bold t :foreground "firebrick")))) - (gnus-cite-face-3 ((t (:bold t :foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:bold t :foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-cite-face-list ((t (nil)))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) - (gnus-header-from-face ((t (:bold t :foreground "red3")))) - (gnus-header-name-face ((t (:bold t :foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:bold t :foreground "red4")))) - (gnus-picons-face ((t (:background "white" :foreground "black")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (:italic t :bold t)))) - (gnus-splash ((t (nil)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:italic t :bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (:bold t)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (:bold t :foreground "green")))) - (gui-button-face ((t (:bold t :background "grey75" :foreground "black")))) - (gui-element ((t (:bold t :background "Gray80")))) - (highlight ((t (:bold t :background "darkseagreen2")))) - (highlight-changes-delete-face ((t (:underline t :foreground "red")))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "black" :foreground "white")))) - (holiday-face ((t (:bold t :background "pink" :foreground "white")))) - (hproperty:but-face ((t (:bold t)))) - (hproperty:flash-face ((t (:bold t)))) - (hproperty:highlight-face ((t (:bold t)))) - (hproperty:item-face ((t (:bold t)))) - (html-helper-bold-face ((t (:bold t)))) - (html-helper-bold-italic-face ((t (nil)))) - (html-helper-builtin-face ((t (:underline t :foreground "blue3")))) - (html-helper-italic-face ((t (:italic t :bold t :foreground "yellow")))) - (html-helper-underline-face ((t (:underline t)))) - (html-tag-face ((t (:bold t)))) - (hyper-apropos-documentation ((t (:foreground "white")))) - (hyper-apropos-heading ((t (:bold t)))) - (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) - (hyper-apropos-major-heading ((t (:bold t)))) - (hyper-apropos-section-heading ((t (:bold t)))) - (hyper-apropos-warning ((t (:bold t :foreground "red")))) - (ibuffer-marked-face ((t (:foreground "red")))) - (info-menu-5 ((t (:underline t :bold t)))) - (info-menu-6 ((t (nil)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:bold t :background "paleturquoise")))) - (isearch-secondary ((t (:foreground "red3")))) - (ispell-face ((t (:bold t)))) - (italic ((t (:italic t :bold t)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) - (jde-java-font-lock-link-face ((t (:underline t :foreground "blue")))) - (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) - (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) - (left-margin ((t (:bold t)))) - (linemenu-face ((t (nil)))) - (list-mode-item-selected ((t (:bold t :background "gray68")))) - (magenta ((t (:foreground "magenta")))) - (makefile-space-face ((t (:background "hotpink")))) - (man-bold ((t (:bold t)))) - (man-heading ((t (:bold t)))) - (man-italic ((t (:foreground "yellow")))) - (man-xref ((t (:underline t)))) - (message-cited-text ((t (:bold t :foreground "orange")))) - (message-cited-text-face ((t (:bold t :foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-contents ((t (:italic t :bold t :foreground "white")))) - (message-header-name-face ((t (:bold t :foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:bold t :foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:bold t :foreground "blue")))) - (message-headers ((t (:bold t :foreground "orange")))) - (message-highlighted-header-contents ((t (:bold t)))) - (message-mml-face ((t (:bold t :foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (message-url ((t (:bold t :foreground "pink")))) - (mmm-face ((t (:background "black" :foreground "green")))) - (modeline ((t (:bold t :background "Black" :foreground "#CA94AA469193")))) - (modeline-buffer-id ((t (:bold t :background "Gray80" :foreground "blue4")))) - (modeline-mousable ((t (:bold t :background "Gray80" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:bold t :background "Gray80" :foreground "green4")))) - (my-tab-face ((t (nil)))) - (nil ((t (nil)))) - (p4-diff-del-face ((t (:bold t)))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-face ((t (nil)))) - (paren-face-match ((t (nil)))) - (paren-face-mismatch ((t (nil)))) - (paren-face-no-match ((t (nil)))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (paren-mismatch-face ((t (:bold t :background "DeepPink" :foreground "white")))) - (paren-no-match-face ((t (:bold t :background "yellow" :foreground "white")))) - (pointer ((t (:bold t)))) - (primary-selection ((t (:bold t :background "gray65")))) - (red ((t (:bold t :foreground "red")))) - (region ((t (:bold t :background "gray")))) - (right-margin ((t (:bold t)))) - (searchm-buffer ((t (:bold t)))) - (searchm-button ((t (:bold t)))) - (searchm-field ((t (nil)))) - (searchm-field-label ((t (:bold t)))) - (searchm-highlight ((t (:bold t)))) - (secondary-selection ((t (:bold t :background "paleturquoise")))) - (semantic-intangible-face ((t (:foreground "gray25")))) - (semantic-read-only-face ((t (:background "gray25")))) - (senator-momentary-highlight-face ((t (:background "gray70")))) - (setnu-line-number-face ((t (:italic t :bold t)))) - (sgml-comment-face ((t (:foreground "dark green")))) - (sgml-doctype-face ((t (:foreground "maroon")))) - (sgml-end-tag-face ((t (:foreground "blue2")))) - (sgml-entity-face ((t (:foreground "red2")))) - (sgml-ignored-face ((t (:background "gray90" :foreground "maroon")))) - (sgml-ms-end-face ((t (:foreground "maroon")))) - (sgml-ms-start-face ((t (:foreground "maroon")))) - (sgml-pi-face ((t (:foreground "maroon")))) - (sgml-sgml-face ((t (:foreground "maroon")))) - (sgml-short-ref-face ((t (:foreground "goldenrod")))) - (sgml-start-tag-face ((t (:foreground "blue2")))) - (shell-input-face ((t (:bold t)))) - (shell-option-face ((t (:bold t :foreground "blue4")))) - (shell-output-2-face ((t (:bold t :foreground "green4")))) - (shell-output-3-face ((t (:bold t :foreground "green4")))) - (shell-output-face ((t (:bold t)))) - (shell-prompt-face ((t (:bold t :foreground "red4")))) - (show-paren-match-face ((t (:bold t :background "turquoise")))) - (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) - (speedbar-button-face ((t (:bold t :foreground "magenta")))) - (speedbar-directory-face ((t (:bold t :foreground "orchid")))) - (speedbar-file-face ((t (:bold t :foreground "pink")))) - (speedbar-highlight-face ((t (:background "black")))) - (speedbar-selected-face ((t (:underline t :foreground "cyan")))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) - (template-message-face ((t (:bold t)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-blue-bold-face ((t (:bold t :background "snow2" :foreground "blue")))) - (term-blue-face ((t (:foreground "blue")))) - (term-blue-inv-face ((t (:background "blue")))) - (term-blue-ul-face ((t (:underline t :background "snow2" :foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyan-bold-face ((t (:bold t :background "snow2" :foreground "cyan")))) - (term-cyan-face ((t (:foreground "cyan")))) - (term-cyan-inv-face ((t (:background "cyan")))) - (term-cyan-ul-face ((t (:underline t :background "snow2" :foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-bold-face ((t (:bold t :background "snow2" :foreground "darkslategray")))) - (term-default-face ((t (:background "snow2" :foreground "darkslategray")))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-default-inv-face ((t (:background "darkslategray" :foreground "snow2")))) - (term-default-ul-face ((t (:underline t :background "snow2" :foreground "darkslategray")))) - (term-green ((t (:foreground "green")))) - (term-green-bold-face ((t (:bold t :background "snow2" :foreground "green")))) - (term-green-face ((t (:foreground "green")))) - (term-green-inv-face ((t (:background "green")))) - (term-green-ul-face ((t (:underline t :background "snow2" :foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magenta-bold-face ((t (:bold t :background "snow2" :foreground "magenta")))) - (term-magenta-face ((t (:foreground "magenta")))) - (term-magenta-inv-face ((t (:background "magenta")))) - (term-magenta-ul-face ((t (:underline t :background "snow2" :foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-red-bold-face ((t (:bold t :background "snow2" :foreground "red")))) - (term-red-face ((t (:foreground "red")))) - (term-red-inv-face ((t (:background "red")))) - (term-red-ul-face ((t (:underline t :background "snow2" :foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-white-bold-face ((t (:bold t :background "snow2" :foreground "white")))) - (term-white-face ((t (:foreground "white")))) - (term-white-inv-face ((t (:background "snow2")))) - (term-white-ul-face ((t (:underline t :background "snow2" :foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellow-bold-face ((t (:bold t :background "snow2" :foreground "yellow")))) - (term-yellow-face ((t (:foreground "yellow")))) - (term-yellow-inv-face ((t (:background "yellow")))) - (term-yellow-ul-face ((t (:underline t :background "snow2" :foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (text-cursor ((t (:bold t :background "Red3" :foreground "gray80")))) - (toolbar ((t (:bold t :background "Gray80")))) - (underline ((t (:underline t :bold t)))) - (vc-annotate-face-0046FF ((t (nil)))) - (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) - (vertical-divider ((t (:bold t :background "Gray80")))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-generic-/constant-face ((t (nil)))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-font-lock-type-face ((t (nil)))) - (vhdl-font-lock-variable-face ((t (nil)))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) - (vhdl-speedbar-subprogram-face ((t (nil)))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (vm-xface ((t (:background "white" :foreground "black")))) - (vmpc-pre-sig-face ((t (:foreground "forestgreen")))) - (vmpc-sig-face ((t (:foreground "steelblue")))) - (vvb-face ((t (nil)))) - (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1")))) - (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3")))) - (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) - (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) - (white ((t (:foreground "white")))) - (widget ((t (nil)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:bold t :foreground "red")))) - (widget-documentation-face ((t (:bold t :foreground "dark green")))) - (widget-field-face ((t (:bold t :background "gray85")))) - (widget-inactive-face ((t (:bold t :foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (x-face ((t (:bold t :background "white" :foreground "black")))) - (x-symbol-adobe-fontspecific-face ((t (nil)))) - (x-symbol-face ((t (nil)))) - (x-symbol-heading-face ((t (:bold t)))) - (x-symbol-info-face ((t (nil)))) - (x-symbol-invisible-face ((t (nil)))) - (x-symbol-revealed-face ((t (nil)))) - (xrdb-option-name-face ((t (:foreground "red")))) - (xref-keyword-face ((t (:foreground "blue")))) - (xref-list-default-face ((t (nil)))) - (xref-list-pilot-face ((t (:foreground "navy")))) - (xref-list-symbol-face ((t (:foreground "navy")))) - (yellow ((t (:bold t :foreground "yellow")))) - (zmacs-region ((t (:bold t :background "gray65"))))))) - -(defun color-theme-mistyday () - "Color theme by K.C. Hari Kumar, created 2001-06-13. -Black on mistyrose. Includes CUA, calendar, diary, font-latex and -font-lock. Uses backgrounds on some font-lock faces." - (interactive) - (color-theme-install - '(color-theme-mistyday - ((background-color . "mistyrose") - (background-mode . light) - (border-color . "black") - (cursor-color . "deep pink") - (foreground-color . "Black") - (mouse-color . "black")) - ((goto-address-mail-face . italic) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . bold) - (goto-address-url-mouse-face . highlight) - (list-matching-lines-face . bold) - (paren-match-face . paren-face-match) - (paren-mismatch-face . paren-face-mismatch) - (paren-no-match-face . paren-face-no-match)) - (default ((t (nil)))) - (CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) - (CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) - (CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (calendar-today-face ((t (:underline t :background "Spring Green" :foreground "Brown")))) - (custom-button-face ((t (:background "dark slate grey" :foreground "azure")))) - (custom-documentation-face ((t (:background "white" :foreground "blue")))) - (diary-face ((t (:background "navy" :foreground "yellow")))) - (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen")))) - (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen")))) - (font-latex-math-face ((t (:foreground "navy")))) - (font-latex-sedate-face ((t (:foreground "DimGray")))) - (font-latex-string-face ((t (nil)))) - (font-latex-warning-face ((t (nil)))) - (font-lock-builtin-face ((t (:background "DarkTurquoise" :foreground "Navy")))) - (font-lock-comment-face ((t (:italic t :foreground "royal blue")))) - (font-lock-constant-face ((t (:background "pale green" :foreground "dark slate blue")))) - (font-lock-doc-string-face ((t (:background "medium aquamarine" :foreground "deep pink")))) - (font-lock-function-name-face ((t (:background "SpringGreen" :foreground "MidnightBlue")))) - (font-lock-keyword-face ((t (:foreground "dark magenta")))) - (font-lock-preprocessor-face ((t (:background "pale green" :foreground "dark slate blue")))) - (font-lock-reference-face ((t (:background "DarkTurquoise" :foreground "Navy")))) - (font-lock-string-face ((t (:background "medium aquamarine" :foreground "deep pink")))) - (font-lock-type-face ((t (:background "steel blue" :foreground "khaki")))) - (font-lock-variable-name-face ((t (:background "thistle" :foreground "orange red")))) - (font-lock-warning-face ((t (:background "LemonChiffon" :foreground "Red")))) - (highlight ((t (:background "dark slate grey" :foreground "light cyan")))) - (holiday-face ((t (:background "orangered" :foreground "lightyellow")))) - (ido-first-match-face ((t (:bold t)))) - (ido-only-match-face ((t (:foreground "ForestGreen")))) - (ido-subdir-face ((t (:foreground "red")))) - (italic ((t (:italic t)))) - (isearch ((t (:background "sienna" :foreground "light cyan")))) - (modeline ((t (:background "Royalblue4" :foreground "lawn green")))) - (modeline-buffer-id ((t (:background "Royalblue4" :foreground "lawn green")))) - (modeline-mousable ((t (:background "Royalblue4" :foreground "lawn green")))) - (modeline-mousable-minor-mode ((t (:background "Royalblue4" :foreground "lawn green")))) - (paren-face-match ((t (:background "turquoise")))) - (paren-face-mismatch ((t (:background "purple" :foreground "white")))) - (paren-face-no-match ((t (:background "yellow" :foreground "black")))) - (primary-selection ((t (:background "sienna" :foreground "light cyan")))) - (region ((t (:background "sienna" :foreground "light cyan")))) - (secondary-selection ((t (:background "forest green" :foreground "white smoke")))) - (underline ((t (:underline t)))) - (zmacs-region ((t (:background "sienna" :foreground "light cyan"))))))) - -(defun color-theme-marine () - "Color theme by Girish Bharadwaj, created 2001-06-22. -Matches the MS Windows Marine color theme. -Includes custom, font-lock, paren, widget." - (interactive) - (color-theme-install - '(color-theme-marine - ((background-color . "#9dcec9") - (background-mode . light) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "darkslategray") - (mouse-color . "sienna1")) - ((buffers-tab-face . buffers-tab) - (gnus-mouse-face . highlight) - (smiley-mouse-face . highlight)) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (nil)))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:background "#9dcec9" :foreground "darkslategray")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "deeppink")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "darkgreen")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (font-lock-builtin-face ((t (:foreground "SteelBlue")))) - (font-lock-comment-face ((t (:foreground "cadetblue")))) - (font-lock-constant-face ((t (:foreground "OrangeRed")))) - (font-lock-doc-string-face ((t (:foreground "Salmon")))) - (font-lock-function-name-face ((t (:bold t :foreground "NavyBlue")))) - (font-lock-keyword-face ((t (:bold t :foreground "purple")))) - (font-lock-preprocessor-face ((t (:foreground "SteelBlue")))) - (font-lock-reference-face ((t (:foreground "SteelBlue")))) - (font-lock-string-face ((t (:foreground "royalblue")))) - (font-lock-type-face ((t (:foreground "darkmagenta")))) - (font-lock-variable-name-face ((t (:foreground "violetred")))) - (font-lock-warning-face ((t (:bold t :foreground "red")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "#489088" :foreground "black")))) - (highlight ((t (:background "darkolivegreen" :foreground "white")))) - (isearch ((t (:background "blue")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (nil)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "darkslategray")))) - (modeline ((t (:background "black" :foreground "white")))) - (modeline-buffer-id ((t (:background "black" :foreground "white")))) - (modeline-mousable ((t (:background "black" :foreground "white")))) - (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) - (paren-blink-off ((t (:foreground "black")))) - (paren-match ((t (:background "darkolivegreen" :foreground "white")))) - (paren-mismatch ((t (:background "#9dcec9" :foreground "darkslategray")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "blue")))) - (red ((t (:foreground "red")))) - (region ((t (:background "blue")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "darkslateblue" :foreground "white")))) - (template-message-face ((t (:bold t)))) - (text-cursor ((t (:background "yellow" :foreground "#9dcec9")))) - (toolbar ((t (nil)))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (widget ((t (nil)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "forestgreen")))) - (widget-field-face ((t (:background "gray")))) - (widget-inactive-face ((t (:foreground "dimgray")))) - (widget-single-line-field-face ((t (:background "dim gray" :foreground "white")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "blue"))))))) - -(defun color-theme-blue-erc () - "Color theme for erc faces only. -This is intended for other color themes to use (eg. `color-theme-gnome2')." - (color-theme-install - '(color-theme-blue-erc - nil - (erc-action-face ((t (nil)))) - (erc-bold-face ((t (:bold t)))) - (erc-current-nick-face ((t (:bold t :foreground "yellow")))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "pale green")))) - (erc-error-face ((t (:bold t :foreground "IndianRed")))) - (erc-highlight-face ((t (:bold t :foreground "pale green")))) - (erc-input-face ((t (:foreground "light blue")))) - (erc-inverse-face ((t (:background "steel blue")))) - (erc-keyword-face ((t (:foreground "orange" :bold t)))) - (erc-notice-face ((t (:foreground "light salmon")))) - (erc-notice-face ((t (:foreground "MediumAquamarine")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:foreground "light blue" :bold t)))) - (fg:erc-color-face0 ((t (:foreground "white")))) - (fg:erc-color-face1 ((t (:foreground "beige")))) - (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) - (fg:erc-color-face3 ((t (:foreground "light cyan")))) - (fg:erc-color-face4 ((t (:foreground "powder blue")))) - (fg:erc-color-face5 ((t (:foreground "sky blue")))) - (fg:erc-color-face6 ((t (:foreground "dark sea green")))) - (fg:erc-color-face7 ((t (:foreground "pale green")))) - (fg:erc-color-face8 ((t (:foreground "medium spring green")))) - (fg:erc-color-face9 ((t (:foreground "khaki")))) - (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) - (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) - (fg:erc-color-face12 ((t (:foreground "light yellow")))) - (fg:erc-color-face13 ((t (:foreground "yellow")))) - (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) - (fg:erc-color-face15 ((t (:foreground "lime green")))) - (bg:erc-color-face0 ((t (nil)))) - (bg:erc-color-face1 ((t (nil)))) - (bg:erc-color-face2 ((t (nil)))) - (bg:erc-color-face3 ((t (nil)))) - (bg:erc-color-face4 ((t (nil)))) - (bg:erc-color-face5 ((t (nil)))) - (bg:erc-color-face6 ((t (nil)))) - (bg:erc-color-face7 ((t (nil)))) - (bg:erc-color-face8 ((t (nil)))) - (bg:erc-color-face9 ((t (nil)))) - (bg:erc-color-face10 ((t (nil)))) - (bg:erc-color-face11 ((t (nil)))) - (bg:erc-color-face12 ((t (nil)))) - (bg:erc-color-face13 ((t (nil)))) - (bg:erc-color-face14 ((t (nil)))) - (bg:erc-color-face15 ((t (nil))))))) - -(defun color-theme-dark-erc () - "Color theme for erc faces only. -This is intended for other color themes to use (eg. `color-theme-late-night')." - (interactive) - (color-theme-install - '(color-theme-dark-erc - nil - (erc-action-face ((t (nil)))) - (erc-bold-face ((t (:bold t)))) - (erc-current-nick-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (nil)))) - (erc-error-face ((t (:bold t :foreground "IndianRed")))) - (erc-highlight-face ((t (:bold t :foreground "pale green")))) - (erc-input-face ((t (:foreground "#555")))) - (erc-inverse-face ((t (:background "steel blue")))) - (erc-keyword-face ((t (:foreground "#999" :bold t)))) - (erc-nick-msg-face ((t (:foreground "#888")))) - (erc-notice-face ((t (:foreground "#444")))) - (erc-pal-face ((t (:foreground "#888")))) - (erc-prompt-face ((t (:foreground "#777" :bold t)))) - (erc-timestamp-face ((t (:foreground "#777" :bold t)))) - (fg:erc-color-face0 ((t (:foreground "white")))) - (fg:erc-color-face1 ((t (:foreground "beige")))) - (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) - (fg:erc-color-face3 ((t (:foreground "light cyan")))) - (fg:erc-color-face4 ((t (:foreground "powder blue")))) - (fg:erc-color-face5 ((t (:foreground "sky blue")))) - (fg:erc-color-face6 ((t (:foreground "dark sea green")))) - (fg:erc-color-face7 ((t (:foreground "pale green")))) - (fg:erc-color-face8 ((t (:foreground "medium spring green")))) - (fg:erc-color-face9 ((t (:foreground "khaki")))) - (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) - (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) - (fg:erc-color-face12 ((t (:foreground "light yellow")))) - (fg:erc-color-face13 ((t (:foreground "yellow")))) - (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) - (fg:erc-color-face15 ((t (:foreground "lime green")))) - (bg:erc-color-face0 ((t (nil)))) - (bg:erc-color-face1 ((t (nil)))) - (bg:erc-color-face2 ((t (nil)))) - (bg:erc-color-face3 ((t (nil)))) - (bg:erc-color-face4 ((t (nil)))) - (bg:erc-color-face5 ((t (nil)))) - (bg:erc-color-face6 ((t (nil)))) - (bg:erc-color-face7 ((t (nil)))) - (bg:erc-color-face8 ((t (nil)))) - (bg:erc-color-face9 ((t (nil)))) - (bg:erc-color-face10 ((t (nil)))) - (bg:erc-color-face11 ((t (nil)))) - (bg:erc-color-face12 ((t (nil)))) - (bg:erc-color-face13 ((t (nil)))) - (bg:erc-color-face14 ((t (nil)))) - (bg:erc-color-face15 ((t (nil))))))) - -(defun color-theme-subtle-blue () - "Color theme by Chris McMahan, created 2001-09-06. -Light blue background. Includes bbdb, comint, cperl, custom, cvs, -diary, dired, display-time, ecb, ediff, erc, eshell, font-lock, -gnus, html-helper, info, isearch, jde, message, paren, semantic, -sgml, speedbar, term, vhdl, viper, vm, widget, woman, xref, xxml." - (interactive) - (color-theme-install - '(color-theme-subtle-blue - ((background-color . "#65889C") - (background-mode . dark) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "black") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "white") - (foreground-color . "#eedfcc") - (mouse-color . "Grey") - (top-toolbar-shadow-color . "#fffffbeeffff") - (viper-saved-cursor-color-in-replace-mode . "Red3")) - ((blank-space-face . blank-space-face) - (blank-tab-face . blank-tab-face) - (ecb-source-in-directories-buffer-face . ecb-sources-face) - (gnus-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (vm-highlight-url-face . my-url-face) - (vm-highlighted-header-face . my-url-face) - (vm-mime-button-face . gui-button-face) - (vm-summary-highlight-face . my-summary-highlight-face)) - (default ((t (nil)))) - (bbdb-company ((t (:italic t)))) - (bbdb-field-name ((t (:bold t :foreground "MediumAquamarine")))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (blank-space-face ((t (:background "gray80")))) - (blank-tab-face ((t (:background "LightBlue" :foreground "DarkSlateGray")))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t :foreground "MediumAquamarine")))) - (bold-italic ((t (:italic t :bold t :foreground "SkyBlue")))) - (border ((t (:background "black")))) - (border-glyph ((t (nil)))) - (calendar-today-face ((t (:underline t)))) - (comint-highlight-input ((t (:bold t)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (comint-input-face ((t (:foreground "deepskyblue")))) - (cperl-array-face ((t (:bold t :foreground "Yellow")))) - (cperl-hash-face ((t (:italic t :bold t :foreground "White")))) - (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) - (cursor ((t (:background "white")))) - (custom-button-face ((t (:underline t :bold t :foreground "MediumAquaMarine")))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black")))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (:foreground "Grey")))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:bold t :foreground "MediumAquamarine")))) - (custom-group-tag-face-1 ((t (:foreground "MediumAquaMarine")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "yellow")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:bold t :foreground "Aquamarine")))) - (cvs-filename-face ((t (:foreground "blue4")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "blue4")))) - (cvs-marked-face ((t (:bold t :foreground "green3")))) - (cvs-msg-face ((t (:italic t)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:bold t :foreground "cyan")))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t :foreground "sky blue")))) - (dired-face-executable ((t (:foreground "MediumAquaMarine")))) - (dired-face-flagged ((t (:foreground "Cyan")))) - (dired-face-marked ((t (:foreground "cyan")))) - (dired-face-permissions ((t (:foreground "aquamarine")))) - (dired-face-setuid ((t (:foreground "LightSalmon")))) - (dired-face-socket ((t (:foreground "LightBlue")))) - (dired-face-symlink ((t (:foreground "gray95")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (ecb-sources-face ((t (:foreground "LightBlue1")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "indianred" :foreground "white")))) - (ediff-even-diff-face-A ((t (:background "light gray" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Gray" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Gray" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light gray" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Gray" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light gray" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light gray" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Gray" :foreground "White")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "LightSalmon")))) - (erc-error-face ((t (:bold t :foreground "yellow")))) - (erc-input-face ((t (:foreground "Beige")))) - (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) - (erc-notice-face ((t (:foreground "MediumAquamarine")))) - (erc-pal-face ((t (:foreground "PaleGreen")))) - (erc-prompt-face ((t (:foreground "MediumAquamarine")))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "wheat")))) - (eshell-ls-backup-face ((t (:foreground "Grey")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "wheat")))) - (eshell-ls-directory-face ((t (:bold t :foreground "Yellow")))) - (eshell-ls-executable-face ((t (:bold t :foreground "wheat")))) - (eshell-ls-missing-face ((t (:bold t :foreground "wheat")))) - (eshell-ls-picture-face ((t (:foreground "wheat")))) - (eshell-ls-product-face ((t (:foreground "wheat")))) - (eshell-ls-readonly-face ((t (:foreground "wheat")))) - (eshell-ls-special-face ((t (:bold t :foreground "wheat")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "White")))) - (eshell-ls-text-face ((t (:foreground "wheat")))) - (eshell-ls-todo-face ((t (:foreground "wheat")))) - (eshell-ls-unreadable-face ((t (:foreground "wheat3")))) - (eshell-prompt-face ((t (:bold t :foreground "PaleGreen")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-test-ok-face ((t (:bold t :foreground "Green")))) - (excerpt ((t (:italic t)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) - (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (:foreground "Gray85")))) - (font-latex-string-face ((t (:foreground "orange")))) - (font-latex-warning-face ((t (:foreground "gold")))) - (font-lock-builtin-face ((t (:foreground "PaleGreen")))) - (font-lock-comment-face ((t (:italic t :foreground "Wheat3")))) - (font-lock-constant-face ((t (:foreground "LightBlue")))) - (font-lock-doc-face ((t (:bold t :foreground "DarkSeaGreen")))) - (font-lock-doc-string-face ((t (:bold t :foreground "DarkSeaGreen")))) - (font-lock-exit-face ((t (:foreground "green")))) - (font-lock-function-name-face ((t (:italic t :bold t :foreground "cyan")))) - (font-lock-keyword-face ((t (:bold t :foreground "LightBlue")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "PaleGreen")))) - (font-lock-string-face ((t (:italic t :foreground "MediumAquamarine")))) - (font-lock-type-face ((t (:bold t :foreground "LightBlue")))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "LightBlue")))) - (font-lock-warning-face ((t (:bold t :foreground "LightSalmon")))) - (fringe ((t (:background "darkslategrey")))) - (gnus-cite-attribution-face ((t (:italic t :bold t)))) - (gnus-cite-face-1 ((t (:foreground "LightBlue")))) - (gnus-cite-face-10 ((t (:foreground "LightBlue")))) - (gnus-cite-face-11 ((t (:foreground "LightBlue")))) - (gnus-cite-face-2 ((t (:foreground "LightBlue")))) - (gnus-cite-face-3 ((t (:foreground "LightBlue")))) - (gnus-cite-face-4 ((t (:foreground "LightBlue")))) - (gnus-cite-face-5 ((t (:foreground "LightBlue")))) - (gnus-cite-face-6 ((t (:foreground "LightBlue")))) - (gnus-cite-face-7 ((t (:foreground "LightBlue")))) - (gnus-cite-face-8 ((t (:foreground "LightBlue")))) - (gnus-cite-face-9 ((t (:foreground "LightBlue")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "light cyan")))) - (gnus-group-mail-2-empty-face ((t (:foreground "gray80")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-mail-3-empty-face ((t (:foreground "gray80")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue")))) - (gnus-group-mail-low-empty-face ((t (:foreground "gray80")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "LightBlue")))) - (gnus-group-news-1-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-1-face ((t (:bold t :foreground "green yellow")))) - (gnus-group-news-2-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-2-face ((t (:bold t :foreground "Aquamarine")))) - (gnus-group-news-3-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue")))) - (gnus-group-news-4-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-4-face ((t (:bold t :foreground "Wheat")))) - (gnus-group-news-5-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-group-news-6-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine")))) - (gnus-group-news-low-empty-face ((t (:foreground "gray80")))) - (gnus-group-news-low-face ((t (:bold t :foreground "yellow green")))) - (gnus-header-content-face ((t (:italic t :foreground "LightSkyBlue3")))) - (gnus-header-from-face ((t (:bold t :foreground "light cyan")))) - (gnus-header-name-face ((t (:bold t :foreground "LightBlue")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) - (gnus-header-subject-face ((t (:bold t :foreground "light cyan")))) - (gnus-picons-face ((t (:background "white" :foreground "black")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (:italic t :foreground "LightBlue")))) - (gnus-splash ((t (:foreground "Brown")))) - (gnus-splash-face ((t (:foreground "LightBlue")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "gray80")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "LightBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "gray80")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "burlywood")))) - (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "wheat")))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "LightBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "light sea green")))) - (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "LightBlue")))) - (gnus-summary-low-unread-face ((t (:italic t :foreground "light sea green")))) - (gnus-summary-normal-ancient-face ((t (:foreground "gray80")))) - (gnus-summary-normal-read-face ((t (:foreground "gray80")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "sandy brown")))) - (gnus-summary-normal-unread-face ((t (:bold t :foreground "wheat")))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "cyan" :foreground "#65889C")))) - (gui-element ((t (:background "Gray")))) - (header-line ((t (:background "grey20" :foreground "grey90")))) - (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) - (highlight-changes-delete-face ((t (:underline t :foreground "red")))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "SeaGreen")))) - (holiday-face ((t (:background "DimGray")))) - (html-helper-bold-face ((t (:foreground "DarkRed")))) - (html-helper-italic-face ((t (:foreground "DarkBlue")))) - (html-helper-underline-face ((t (:underline t :foreground "Black")))) - (html-tag-face ((t (:foreground "Blue")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:underline t :italic t :bold t :foreground "light blue")))) - (info-xref ((t (:bold t :foreground "light blue")))) - (isearch ((t (:background "Aquamarine" :foreground "SteelBlue")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:italic t)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) - (jde-java-font-lock-api-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-bold-face ((t (:bold t)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-italic-face ((t (:italic t)))) - (jde-java-font-lock-link-face ((t (:underline t :foreground "LightBlue")))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-package-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) - (left-margin ((t (nil)))) - (linemenu-face ((t (:background "gray30")))) - (list-mode-item-selected ((t (nil)))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (:background "wheat" :foreground "gray30")))) - (message-cited-text-face ((t (:foreground "White")))) - (message-header-cc-face ((t (:bold t :foreground "light cyan")))) - (message-header-name-face ((t (:foreground "LightBlue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) - (message-header-other-face ((t (:foreground "LightSkyBlue3")))) - (message-header-subject-face ((t (:bold t :foreground "light cyan")))) - (message-header-to-face ((t (:bold t :foreground "light cyan")))) - (message-header-xheader-face ((t (:foreground "LightBlue")))) - (message-mml-face ((t (:bold t :foreground "LightBlue")))) - (message-separator-face ((t (:foreground "LightBlue")))) - (mmm-default-submode-face ((t (:background "#c0c0c5")))) - (modeline ((t (:background "#4f657d" :foreground "gray80")))) - (modeline-buffer-id ((t (:background "#4f657d" :foreground "gray80")))) - (modeline-mousable ((t (:background "#4f657d" :foreground "gray80")))) - (modeline-mousable-minor-mode ((t (:background "#4f657d" :foreground "gray80")))) - (mouse ((t (:background "Grey")))) - (my-summary-highlight-face ((t (:foreground "White")))) - (my-url-face ((t (:foreground "PaleTurquoise")))) - (nil ((t (nil)))) - (paren-blink-off ((t (:foreground "gray")))) - (paren-face-match ((t (:background "turquoise")))) - (paren-face-mismatch ((t (:background "purple" :foreground "white")))) - (paren-face-no-match ((t (:background "yellow" :foreground "black")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (paren-mismatch-face ((t (:bold t)))) - (paren-no-match-face ((t (:bold t)))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "CadetBlue" :foreground "gray80")))) - (right-margin ((t (nil)))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "LightBlue" :foreground "#4f657d")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (semantic-intangible-face ((t (:foreground "gray25")))) - (semantic-read-only-face ((t (:background "gray25")))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray80")))) - (senator-read-only-face ((t (:background "#664444")))) - (sgml-comment-face ((t (:foreground "dark turquoise")))) - (sgml-doctype-face ((t (:foreground "red")))) - (sgml-end-tag-face ((t (:foreground "blue")))) - (sgml-entity-face ((t (:foreground "magenta")))) - (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) - (sgml-ms-end-face ((t (:foreground "green")))) - (sgml-ms-start-face ((t (:foreground "yellow")))) - (sgml-pi-face ((t (:foreground "lime green")))) - (sgml-sgml-face ((t (:foreground "brown")))) - (sgml-short-ref-face ((t (:foreground "deep sky blue")))) - (sgml-start-tag-face ((t (:foreground "dark green")))) - (shell-option-face ((t (:foreground "blue")))) - (shell-output-2-face ((t (:foreground "darkseagreen")))) - (shell-output-3-face ((t (:foreground "slategray")))) - (shell-output-face ((t (:foreground "palegreen")))) - (shell-prompt-face ((t (:foreground "red")))) - (show-paren-match-face ((t (:background "Aquamarine" :foreground "steel blue")))) - (show-paren-mismatch-face ((t (:bold t :background "IndianRed" :foreground "White")))) - (speedbar-button-face ((t (:bold t :foreground "LightBlue")))) - (speedbar-directory-face ((t (:bold t :foreground "yellow")))) - (speedbar-file-face ((t (:bold t :foreground "wheat")))) - (speedbar-highlight-face ((t (:background "sea green")))) - (speedbar-selected-face ((t (:underline t)))) - (speedbar-tag-face ((t (:foreground "LightBlue")))) - (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) - (template-message-face ((t (:bold t)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (text-cursor ((t (:background "Red3" :foreground "white")))) - (tool-bar ((t (:background "grey75" :foreground "black")))) - (toolbar ((t (:background "Gray")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (nil)))) - (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) - (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) - (vertical-divider ((t (:background "Gray")))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) - (vhdl-speedbar-package-face ((t (:foreground "Gray50")))) - (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Gray50")))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "gray" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (vm-header-content-face ((t (:italic t :foreground "gray80")))) - (vm-header-from-face ((t (:italic t :background "#65889C" :foreground "cyan")))) - (vm-header-name-face ((t (:foreground "cyan")))) - (vm-header-subject-face ((t (:foreground "cyan")))) - (vm-header-to-face ((t (:italic t :foreground "cyan")))) - (vm-message-cited-face ((t (:foreground "Gray80")))) - (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) - (vm-summary-highlight-face ((t (:foreground "White")))) - (vmpc-pre-sig-face ((t (:foreground "Aquamarine")))) - (vmpc-sig-face ((t (:foreground "LightBlue")))) - (vvb-face ((t (:background "pink" :foreground "black")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "cyan")))) - (widget-documentation-face ((t (:foreground "LightBlue")))) - (widget-field-face ((t (:foreground "LightBlue")))) - (widget-inactive-face ((t (:foreground "Wheat3")))) - (widget-single-line-field-face ((t (:foreground "LightBlue")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (xref-keyword-face ((t (:foreground "Cyan")))) - (xref-list-pilot-face ((t (:foreground "navy")))) - (xref-list-symbol-face ((t (:foreground "navy")))) - (xxml-emph-1-face ((t (:background "lightyellow")))) - (xxml-emph-2-face ((t (:background "lightyellow")))) - (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) - (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) - (xxml-header-3-face ((t (:background "seashell1")))) - (xxml-header-4-face ((t (:background "seashell1")))) - (xxml-interaction-face ((t (:background "lightcyan")))) - (xxml-rug-face ((t (:background "cyan")))) - (xxml-sparkle-face ((t (:background "yellow")))) - (xxml-unbreakable-space-face ((t (:underline t :foreground "grey")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "#4f657d"))))))) - -(defun color-theme-dark-blue () - "Color theme by Chris McMahan, created 2001-09-09. -Based on `color-theme-subtle-blue' with a slightly darker background." - (interactive) - (color-theme-subtle-blue) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-dark-blue - ((background-color . "#537182") - (foreground-color . "AntiqueWhite2")) - nil - (default ((t (nil)))) - (blank-space-face ((t (:background "LightGray")))) - (blank-tab-face ((t (:background "Wheat" :foreground "DarkSlateGray")))) - (cursor ((t (:background "LightGray")))) - (dired-face-executable ((t (:foreground "green yellow")))) - (dired-face-flagged ((t (:foreground "tomato")))) - (dired-face-marked ((t (:foreground "light salmon")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (fixed ((t (:bold t)))) - (font-lock-comment-face ((t (:italic t :foreground "Gray80")))) - (font-lock-doc-face ((t (:bold t)))) - (font-lock-function-name-face ((t (:italic t :bold t :foreground "Yellow")))) - (font-lock-string-face ((t (:italic t :foreground "DarkSeaGreen")))) - (font-lock-type-face ((t (:bold t :foreground "YellowGreen")))) - (gui-button-face ((t (:background "DarkSalmon" :foreground "white")))) - (modeline ((t (:background "#c1ccd9" :foreground "#4f657d")))) - (modeline-buffer-id ((t (:background "#c1ccd9" :foreground "#4f657d")))) - (modeline-mousable ((t (:background "#c1ccd9" :foreground "#4f657d")))) - (modeline-mousable-minor-mode ((t (:background "#c1ccd9" :foreground "#4f657d")))) - (my-url-face ((t (:foreground "LightBlue")))) - (region ((t (:background "PaleTurquoise4" :foreground "gray80")))) - (secondary-selection ((t (:background "sea green" :foreground "yellow")))) - (vm-header-content-face ((t (:italic t :foreground "wheat")))) - (vm-header-from-face ((t (:italic t :foreground "wheat")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (xref-keyword-face ((t (:foreground "blue")))) - (zmacs-region ((t (:background "SlateGray")))))))) - -(defun color-theme-jonadabian-slate () - "Another slate-and-wheat color theme by Jonadab the Unsightly One. -Updated 2001-10-12." - (interactive) - (color-theme-install - '(color-theme-jonadabian-slate - ((background-color . "#305050") - (background-mode . dark) - (border-color . "black") - (cursor-color . "medium turquoise") - (foreground-color . "#CCBB77") - (mouse-color . "black")) - ((list-matching-lines-face . bold) - (ued-mode-keyname-face . modeline) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (fringe ((t (:background "#007080")))) - (bold ((t (:bold t :foreground "#EEDDAA")))) - (gnus-emphasis-bold ((t (:bold t :foreground "#EEDDAA")))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "#EEDDAA")))) - (bold-italic ((t (:italic t :bold t :foreground "#AA0000")))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "#AA0000")))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :foreground "#AA0000")))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t :bold t :foreground "#AA0000")))) - (calendar-today-face ((t (:underline t :background "darkslategrey")))) - (cperl-array-face ((t (:background "#004060")))) - (cperl-hash-face ((t (:background "#004400")))) - (custom-button-face ((t (:background "dark blue" :foreground "rgbi:1.00/1.00/0.00")))) - (custom-documentation-face ((t (:foreground "#10D010")))) - (custom-face-tag-face ((t (:underline t :foreground "goldenrod")))) - (custom-group-tag-face ((t (:underline t :foreground "light blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:foreground "#6666dd")))) - (custom-state-face ((t (:foreground "mediumaquamarine")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) - (diary-face ((t (:foreground "red")))) - (eshell-ls-archive-face ((t (:foreground "green")))) - (eshell-ls-backup-face ((t (:foreground "grey60")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue")))) - (eshell-ls-executable-face ((t (:foreground "white")))) - (eshell-ls-missing-face ((t (:foreground "red")))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly-face ((t (:foreground "indian red")))) - (eshell-ls-special-face ((t (:foreground "yellow")))) - (eshell-ls-symlink-face ((t (:foreground "#6666dd")))) - (eshell-ls-unreadable-face ((t (:foreground "red")))) - (eshell-prompt-face ((t (:bold t :background "#305050" :foreground "#EEDD99")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:italic t :bold t :foreground "grey66")))) - (font-lock-constant-face ((t (:foreground "indian red")))) - (font-lock-function-name-face ((t (:foreground "#D0D000")))) - (font-lock-keyword-face ((t (:foreground "#00BBBB")))) - (font-lock-string-face ((t (:foreground "#10D010")))) - (font-lock-type-face ((t (:bold t :foreground "#ff7788")))) - (font-lock-variable-name-face ((t (:foreground "#eeddaa")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (header-line ((t (:box (:line-width 1 :style released-button))))) - (highlight ((t (:background "#226644")))) - (highlight-changes-delete-face ((t (:background "navy" :foreground "red")))) - (highlight-changes-face ((t (:background "navy")))) - (holiday-face ((t (:foreground "#ff7744")))) - (italic ((t (:italic t :foreground "#AA0000")))) - (gnus-emphasis-italic ((t (:italic t :foreground "#AA0000")))) - (modeline ((t (:background "#007080" :foreground "cyan")))) - (modeline-buffer-id ((t (:background "#007080" :foreground "cyan")))) - (modeline-mousable ((t (:background "#007080" :foreground "cyan")))) - (modeline-mousable-minor-mode ((t (:background "#007080" :foreground "cyan")))) - (region ((t (:background "#226644")))) - (secondary-selection ((t (:background "darkslategrey")))) - (sgml-comment-face ((t (:foreground "grey60")))) - (sgml-doctype-face ((t (:foreground "red")))) - (sgml-end-tag-face ((t (:foreground "#00D0D0")))) - (sgml-entity-face ((t (:foreground "indian red")))) - (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) - (sgml-ms-end-face ((t (:foreground "green")))) - (sgml-ms-start-face ((t (:foreground "green")))) - (sgml-pi-face ((t (:foreground "lime green")))) - (sgml-sgml-face ((t (:foreground "brown")))) - (sgml-short-ref-face ((t (:foreground "deep sky blue")))) - (sgml-start-tag-face ((t (:foreground "#D0D000")))) - (show-paren-match-face ((t (:background "#400055" :foreground "cyan")))) - (show-paren-mismatch-face ((t (:background "red")))) - (special-string-face ((t (:foreground "light green")))) - (term-black ((t (:background "#000055" :foreground "black")))) - (term-blackbg ((t (:background "black" :foreground "#CCBB77")))) - (term-blue ((t (:background "#000055" :foreground "blue")))) - (term-bluebg ((t (:background "blue" :foreground "#CCBB77")))) - (term-bold ((t (:bold t :background "#000055" :foreground "#CCBB77")))) - (term-cyan ((t (:background "#000055" :foreground "cyan")))) - (term-cyanbg ((t (:background "darkcyan")))) - (term-default-bg ((t (:foreground "#CCBB77")))) - (term-default-bg-inv ((t (:foreground "#CCBB77")))) - (term-default-fg ((t (:background "#000055")))) - (term-default-fg-inv ((t (:background "#000055")))) - (term-green ((t (:background "#000055" :foreground "green")))) - (term-greenbg ((t (:background "darkgreen")))) - (term-invisible ((t (:foreground "#CCBB77")))) - (term-invisible-inv ((t (:foreground "#CCBB77")))) - (term-magenta ((t (:background "#000055" :foreground "magenta")))) - (term-magentabg ((t (:background "darkmagenta")))) - (term-red ((t (:background "#000055" :foreground "red")))) - (term-redbg ((t (:background "darkred")))) - (term-underline ((t (:underline t :background "#000055" :foreground "#CCBB77")))) - (term-white ((t (:background "#000055" :foreground "white")))) - (term-whitebg ((t (:background "grey50")))) - (term-yellow ((t (:background "#000055" :foreground "yellow")))) - (term-yellowbg ((t (:background "#997700")))) - (trailing-whitespace ((t (:background "#23415A")))) - (underline ((t (:underline t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "green")))) - (widget-field-face ((t (:background "grey35" :foreground "black")))) - (widget-inactive-face ((t (:foreground "gray")))) - (widget-single-line-field-face ((t (:background "dim gray"))))))) - -(defun color-theme-gray1 () - "Color theme by Paul Pulli, created 2001-10-19." - (interactive) - (color-theme-install - '(color-theme-gray1 - ((background-color . "darkgray") - (background-mode . light) - (background-toolbar-color . "#949494949494") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#595959595959") - (cursor-color . "Yellow") - (foreground-color . "black") - (top-toolbar-shadow-color . "#b2b2b2b2b2b2")) - nil - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (cperl-here-face ((t (:background "gray68" :foreground "DeepPink")))) - (font-lock-builtin-face ((t (:bold t :foreground "red3")))) - (font-lock-comment-face ((t (:foreground "gray50")))) - (font-lock-constant-face ((t (:bold t :foreground "blue3")))) - (font-lock-doc-string-face ((t (:foreground "black")))) - (font-lock-function-name-face ((t (:bold t :foreground "DeepPink3")))) - (font-lock-keyword-face ((t (:bold t :foreground "red")))) - (font-lock-other-type-face ((t (:bold t :foreground "green4")))) - (font-lock-preprocessor-face ((t (:bold t :foreground "blue3")))) - (font-lock-reference-face ((t (:bold t :foreground "red3")))) - (font-lock-string-face ((t (:foreground "red")))) - (font-lock-type-face ((t (:bold t :foreground "white")))) - (font-lock-variable-name-face ((t (:bold t :foreground "blue3")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (green ((t (:foreground "green4")))) - (gui-button-face ((t (:background "black" :foreground "red")))) - (gui-element ((t (:background "gray58")))) - (highlight ((t (:background "magenta" :foreground "yellow")))) - (isearch ((t (:background "red" :foreground "yellow")))) - (italic ((t (:italic t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray90" :foreground "purple")))) - (m4-face ((t (:background "gray90" :foreground "orange3")))) - (message-cited-text ((t (nil)))) - (message-header-contents ((t (nil)))) - (message-headers ((t (nil)))) - (message-highlighted-header-contents ((t (nil)))) - (modeline ((t (:background "#aa80aa" :foreground "White")))) - (modeline-buffer-id ((t (:background "#aa80aa" :foreground "linen")))) - (modeline-mousable ((t (:background "#aa80aa" :foreground "cyan")))) - (modeline-mousable-minor-mode ((t (:background "#aa80aa" :foreground "yellow")))) - (paren-blink-off ((t (:foreground "gray58")))) - (paren-blink-on ((t (:foreground "purple")))) - (paren-match ((t (:background "gray68" :foreground "white")))) - (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray")))) - (red ((t (:foreground "red")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (text-cursor ((t (:background "Yellow" :foreground "darkgray")))) - (toolbar ((t (:background "#aa80aa" :foreground "linen")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (nil)))) - (x-face ((t (:background "black" :foreground "lavenderblush")))) - (yellow ((t (:foreground "yellow3")))) - (zmacs-region ((t (:background "paleturquoise" :foreground "black"))))))) - -(defun color-theme-word-perfect () - "White on blue background, based on WordPerfect 5.1. -Color theme by Thomas Gehrlein, created 2001-10-21." - (interactive) - (color-theme-install - '(color-theme-word-perfect - ((background-color . "blue4") - (background-mode . dark) - (border-color . "black") - (cursor-color . "gold") - (foreground-color . "white") - (mouse-color . "black")) - ((ecb-source-in-directories-buffer-face . ecb-sources-face) - (gnus-mouse-face . highlight) - (goto-address-mail-face . italic) - (goto-address-mail-mouse-face . secondary-selection) - (goto-address-url-face . bold) - (goto-address-url-mouse-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bbdb-field-name ((t (:foreground "lime green")))) - (bbdb-field-value ((t (:foreground "white")))) - (bbdb-name ((t (:underline t :foreground "lime green")))) - (bold ((t (:bold t :foreground "white")))) - (bold-italic ((t (:italic t :bold t :foreground "yellow")))) - (calendar-today-face ((t (:underline t :foreground "deep sky blue")))) - (diary-face ((t (:foreground "gold")))) - (ecb-sources-face ((t (:foreground "LightBlue1")))) - (edb-inter-field-face ((t (:foreground "deep sky blue")))) - (edb-normal-summary-face ((t (:foreground "gold")))) - (emacs-wiki-bad-link-face ((t (:underline "coral" :bold t :foreground "coral")))) - (emacs-wiki-link-face ((t (:underline "cyan" :bold t :foreground "cyan")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "deep sky blue")))) - (font-lock-constant-face ((t (:foreground "lime green")))) - (font-lock-doc-face ((t (:foreground "gold")))) - (font-lock-doc-string-face ((t (:foreground "gold")))) - (font-lock-function-name-face ((t (:background "blue4" :foreground "IndianRed")))) - (font-lock-keyword-face ((t (:foreground "lime green")))) - (font-lock-preprocessor-face ((t (:foreground "lime green")))) - (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) - (font-lock-string-face ((t (:foreground "gold")))) - (font-lock-type-face ((t (:foreground "lime green")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "firebrick")))) - (gnus-emphasis-bold ((t (:foreground "yellow2")))) - (gnus-emphasis-bold-italic ((t (:foreground "yellow2")))) - (gnus-emphasis-italic ((t (:foreground "yellow2")))) - (gnus-emphasis-underline ((t (:foreground "yellow2")))) - (gnus-emphasis-underline-bold ((t (:foreground "yellow2")))) - (gnus-emphasis-underline-bold-italic ((t (:foreground "yellow2")))) - (gnus-emphasis-underline-italic ((t (:foreground "yellow2")))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (:foreground "deep sky blue")))) - (gnus-group-news-3-face ((t (:bold t :foreground "deep sky blue")))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) - (gnus-header-content-face ((t (:foreground "gold")))) - (gnus-header-from-face ((t (:foreground "gold")))) - (gnus-header-name-face ((t (:foreground "deep sky blue")))) - (gnus-header-newsgroups-face ((t (:foreground "gold")))) - (gnus-header-subject-face ((t (:foreground "gold")))) - (gnus-signature-face ((t (:foreground "gold")))) - (gnus-splash-face ((t (:foreground "firebrick")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "deep sky blue")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "deep sky blue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "deep sky blue")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "deep sky blue")))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "lime green")))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "deep sky blue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "deep sky blue")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "deep sky blue")))) - (gnus-summary-low-unread-face ((t (:italic t :foreground "lime green")))) - (gnus-summary-normal-ancient-face ((t (:foreground "deep sky blue")))) - (gnus-summary-normal-read-face ((t (:foreground "deep sky blue")))) - (gnus-summary-normal-ticked-face ((t (:foreground "deep sky blue")))) - (gnus-summary-normal-unread-face ((t (:foreground "lime green")))) - (gnus-summary-selected-face ((t (:underline t :foreground "gold")))) - (highlight ((t (:background "steel blue" :foreground "black")))) - (holiday-face ((t (:background "blue4" :foreground "IndianRed1")))) - (info-menu-5 ((t (:underline t :foreground "gold")))) - (info-node ((t (:italic t :bold t :foreground "gold")))) - (info-xref ((t (:bold t :foreground "gold")))) - (isearch ((t (:background "firebrick" :foreground "white")))) - (italic ((t (:italic t :foreground "yellow2")))) - (message-cited-text-face ((t (:foreground "gold")))) - (message-header-cc-face ((t (:bold t :foreground "green4")))) - (message-header-name-face ((t (:foreground "deep sky blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "gold")))) - (message-header-other-face ((t (:foreground "gold")))) - (message-header-subject-face ((t (:foreground "gold")))) - (message-header-to-face ((t (:bold t :foreground "gold")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-separator-face ((t (:foreground "lime green")))) - (modeline ((t (:foreground "white" :background "black")))) - (modeline-buffer-id ((t (:foreground "white" :background "black")))) - (modeline-mousable ((t (:foreground "white" :background "black")))) - (modeline-mousable-minor-mode ((t (:foreground "white" :background "black")))) - (overlay-empty-face ((t (nil)))) - (primary-selection ((t (:background "firebrick" :foreground "white")))) - (region ((t (:background "firebrick" :foreground "white")))) - (secondary-selection ((t (:background "yellow2" :foreground "black")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (show-paren-match-face ((t (:background "deep sky blue" :foreground "black")))) - (show-paren-mismatch-face ((t (:background "firebrick" :foreground "white")))) - (underline ((t (:underline t :background "blue4" :foreground "white"))))))) - -;; In order to produce this, follow these steps: -;; -;; 0. Make sure .Xresources and .Xdefaults don't have any Emacs related -;; entries. -;; -;; 1. cd into the Emacs lisp directory and run the following command: -;; ( for d in `find -type d`; \ -;; do grep --files-with-matches 'defface[ ]' $d/*.el; \ -;; done ) | sort | uniq -;; Put the result in a lisp block, using load-library calls. -;; -;; Repeat this for any directories on your load path which you want to -;; include in the standard. This might include W3, eshell, etc. -;; -;; Add some of the libraries that don't use defface: -;; -;; 2. Start emacs using the --no-init-file and --no-site-file command line -;; arguments. Evaluate the lisp block you prepared. -;; 3. Load color-theme and run color-theme-print. Save the output and use it -;; to define color-theme-standard. -;; -;; (progn -;; (load-library "add-log") -;; (load-library "calendar") -;; (load-library "comint") -;; (load-library "cus-edit") -;; (load-library "cus-face") -;; (load-library "custom") -;; (load-library "diff-mode") -;; (load-library "ediff-init") -;; (load-library "re-builder") -;; (load-library "viper-init") -;; (load-library "enriched") -;; (load-library "em-ls") -;; (load-library "em-prompt") -;; (load-library "esh-test") -;; (load-library "faces") -;; (load-library "font-lock") -;; (load-library "generic-x") -;; (load-library "gnus-art") -;; (load-library "gnus-cite") -;; (load-library "gnus") -;; (load-library "message") -;; (load-library "hilit-chg") -;; (load-library "hi-lock") -;; (load-library "info") -;; (load-library "isearch") -;; (load-library "log-view") -;; (load-library "paren") -;; (load-library "pcvs-info") -;; (load-library "antlr-mode") -;; (load-library "cperl-mode") -;; (load-library "ebrowse") -;; (load-library "idlwave") -;; (load-library "idlw-shell") -;; (load-library "make-mode") -;; (load-library "sh-script") -;; (load-library "vhdl-mode") -;; (load-library "smerge-mode") -;; (load-library "speedbar") -;; (load-library "strokes") -;; (load-library "artist") -;; (load-library "flyspell") -;; (load-library "texinfo") -;; (load-library "tex-mode") -;; (load-library "tooltip") -;; (load-library "vcursor") -;; (load-library "wid-edit") -;; (load-library "woman") -;; (load-library "term") -;; (load-library "man") -;; (load-file "/home/alex/elisp/color-theme.el") -;; (color-theme-print)) -;; -;; 4. Make the color theme usable on Xemacs (add more faces, resolve -;; :inherit attributes) -;; -(defun color-theme-emacs-21 () - "Color theme used by Emacs 21.1. -Added and adapted for XEmacs by Alex Schroeder. Adaptation mostly -consisted of resolving :inherit attributes and adding missing faces. -This theme includes faces from the following Emacs libraries: add-log -calendar comint cus-edit cus-face custom diff-mode ediff-init re-builder -viper-init enriched em-ls em-prompt esh-test faces font-lock generic-x -gnus-art gnus-cite gnus message hilit-chg hi-lock info isearch log-view -paren pcvs-info antlr-mode cperl-mode ebrowse idlwave idlw-shell -make-mode sh-script vhdl-mode smerge-mode speedbar strokes artist -flyspell texinfo tex-mode tooltip vcursor wid-edit woman term man" - (interactive) - (color-theme-install - '(color-theme-emacs-21 - ((background-color . "white") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "black") - (mouse-color . "black")) - ((Man-overstrike-face . bold) - (Man-underline-face . underline) - (cperl-here-face . font-lock-string-face) - (cperl-invalid-face . underline) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-mouse-face . highlight) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (help-highlight-face . underline) - (idlwave-class-arrow-face . bold) - (idlwave-shell-breakpoint-face . idlwave-shell-bp-face) - (idlwave-shell-expression-face . secondary-selection) - (idlwave-shell-stop-line-face . highlight) - (ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (viper-insert-state-cursor-color . "Green") - (viper-replace-overlay-cursor-color . "Red") - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) - (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) - (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) - (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) - (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) - (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) - (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) - (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) - (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) - (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (calendar-today-face ((t (:underline t)))) - (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) - (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) - (change-log-date-face ((t (:foreground "RosyBrown")))) - (change-log-email-face ((t (:foreground "DarkGoldenrod")))) - (change-log-file-face ((t (:foreground "Blue")))) - (change-log-function-face ((t (:foreground "DarkGoldenrod")))) - (change-log-list-face ((t (:foreground "Purple")))) - (change-log-name-face ((t (:foreground "CadetBlue")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cursor ((t (:background "black")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) - (cvs-filename-face ((t (:foreground "blue4")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) - (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) - (cvs-msg-face ((t (:italic t :slant italic)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:foreground "red")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey50")))) - (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-function-face ((t (:foreground "grey50")))) - (diff-header-face ((t (:background "grey85")))) - (diff-hunk-header-face ((t (:background "grey85")))) - (diff-index-face ((t (:bold t :weight bold :background "grey70")))) - (diff-nonexistent-face ((t (:bold t :weight bold :background "grey70")))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "RosyBrown")))) - (dired-face-directory ((t (:foreground "Blue")))) - (dired-face-executable ((t (nil)))) - (dired-face-flagged ((t (:foreground "Red" :weight bold)))) - (dired-face-marked ((t (:foreground "Red" :weight bold)))) - (dired-face-permissions ((t (nil)))) - (dired-face-setuid ((t (nil)))) - (dired-face-socket ((t (nil)))) - (dired-face-symlink ((t (:foreground "Purple")))) - (ebrowse-default-face ((t (nil)))) - (ebrowse-file-name-face ((t (:italic t :slant italic)))) - (ebrowse-member-attribute-face ((t (:foreground "red")))) - (ebrowse-member-class-face ((t (:foreground "purple")))) - (ebrowse-progress-face ((t (:background "blue")))) - (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) - (ebrowse-tree-mark-face ((t (:foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) - (excerpt ((t (:italic t :slant italic)))) - (fixed ((t (:bold t :weight bold)))) - (fixed-pitch ((t (:family "courier")))) - (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) - (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:foreground "Firebrick")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-doc-face ((t (:foreground "RosyBrown")))) - (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-keyword-face ((t (:foreground "Purple")))) - (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) - (font-lock-reference-face ((t (:foreground "Orchid")))) - (font-lock-string-face ((t (:foreground "RosyBrown")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (fringe ((t (:background "grey95")))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) - (hi-black-b ((t (:bold t :weight bold)))) - (hi-black-hb ((t (:bold t :family "helv" :weight bold :height 1.67)))) - (hi-blue ((t (:background "light blue")))) - (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) - (hi-green ((t (:background "green")))) - (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) - (hi-pink ((t (:background "pink")))) - (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) - (hi-yellow ((t (:background "yellow")))) - (highlight ((t (:background "darkseagreen2")))) - (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) - (highlight-changes-face ((t (:foreground "red")))) - (holiday-face ((t (:background "pink")))) - (idlwave-help-link-face ((t (:foreground "Blue")))) - (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) - (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "brown")))) - (info-header-xref ((t (:bold t :weight bold :foreground "magenta4")))) - (info-menu-5 ((t (:foreground "red1")))) - (info-menu-header ((t (:bold t :family "helv" :weight bold)))) - (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) - (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) - (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic t :slant italic)))) - (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) - (log-view-message-face ((t (:background "grey85")))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (mouse ((t (:background "black")))) - (primary-selection ((t (:background "lightgoldenrod2")))) - (reb-match-0 ((t (:background "lightblue")))) - (reb-match-1 ((t (:background "aquamarine")))) - (reb-match-2 ((t (:background "springgreen")))) - (reb-match-3 ((t (:background "yellow")))) - (region ((t (:background "lightgoldenrod2")))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "yellow")))) - (sh-heredoc-face ((t (:foreground "tan")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (show-tabs-space-face ((t (:foreground "yellow")))) - (show-tabs-tab-face ((t (:foreground "red")))) - (smerge-base-face ((t (:foreground "red")))) - (smerge-markers-face ((t (:background "grey85")))) - (smerge-mine-face ((t (:foreground "blue")))) - (smerge-other-face ((t (:foreground "darkgreen")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "brown")))) - (strokes-char-face ((t (:background "lightgray")))) - (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) - (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (tex-math-face ((t (:foreground "RosyBrown")))) - (texinfo-heading-face ((t (:foreground "Blue")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (woman-addition-face ((t (:foreground "orange")))) - (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) - (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) - (woman-unknown-face ((t (:foreground "brown")))) - (zmacs-region ((t (:background "lightgoldenrod2"))))))) - -(defun color-theme-jsc-light2 () - "Color theme by John S Cooper, created 2001-10-29. -This builds on `color-theme-jsc-light'." - (interactive) - (color-theme-jsc-light) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-jsc-light2 - ((vc-annotate-very-old-color . "#0046FF") - (senator-eldoc-use-color . t)) - nil - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (change-log-file-face ((t (:foreground "Blue")))) - (change-log-name-face ((t (:foreground "Maroon")))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) - (font-lock-constant-face ((t (:foreground "Maroon")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-type-face ((t (:italic t :foreground "Navy" :slant italic)))) - (fringe ((t (:background "grey88")))) - (gnus-group-mail-1-empty-face ((t (:foreground "Blue2")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) - (gnus-header-name-face ((t (:bold t :foreground "maroon" :weight bold)))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "Navy")))) - (gnus-summary-normal-unread-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (header-line ((t (:background "grey90" :foreground "grey20" :box nil)))) - (highlight ((t (:background "darkseagreen2")))) - (ido-subdir-face ((t (:foreground "red")))) - (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) - (mode-line ((t (:background "grey88" :foreground "black" :box (:line-width -1 :style released-button))))) - (region ((t (:background "lightgoldenrod2")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "yellow")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (tooltip ((t (:background "lightyellow" :foreground "black")))))))) - -(defun color-theme-ld-dark () - "Dark Color theme by Linh Dang, created 2001-11-06." - (interactive) - (color-theme-install - '(color-theme-ld-dark - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "white") - (mouse-color . "white")) - ((align-highlight-change-face . highlight) - (align-highlight-nochange-face . secondary-selection) - (apropos-keybinding-face . underline) - (apropos-label-face . italic) - (apropos-match-face . secondary-selection) - (apropos-property-face . bold-italic) - (apropos-symbol-face . bold) - (ebnf-except-border-color . "Black") - (ebnf-line-color . "Black") - (ebnf-non-terminal-border-color . "Black") - (ebnf-repeat-border-color . "Black") - (ebnf-special-border-color . "Black") - (ebnf-terminal-border-color . "Black") - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-carpal-button-face . bold) - (gnus-carpal-header-face . bold-italic) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-mouse-face . highlight) - (gnus-selected-tree-face . modeline) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (help-highlight-face . underline) - (list-matching-lines-face . bold) - (ps-line-number-color . "black") - (ps-zebra-color . 0.95) - (tags-tag-face . default) - (vc-annotate-very-old-color . "#0046FF") - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "black" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) - (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) - (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) - (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) - (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) - (bbdb-company ((t (:italic t :slant italic)))) - (bbdb-field-name ((t (:bold t :weight bold)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (change-log-acknowledgement-face ((t (:italic t :slant oblique :foreground "AntiqueWhite3")))) - (change-log-conditionals-face ((t (:foreground "Aquamarine")))) - (change-log-date-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) - (change-log-email-face ((t (:foreground "Aquamarine")))) - (change-log-file-face ((t (:bold t :family "Verdana" :weight bold :foreground "LightSkyBlue" :height 0.9)))) - (change-log-function-face ((t (:foreground "Aquamarine")))) - (change-log-list-face ((t (:foreground "LightSkyBlue")))) - (change-log-name-face ((t (:bold t :weight bold :foreground "Gold")))) - (clear-case-mode-string-face ((t (:bold t :family "Arial" :box (:line-width 2 :color "grey" :style released-button) :foreground "black" :background "grey" :weight bold :height 0.9)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "yellow")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.1)))) - (custom-group-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.1)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.1)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey70")))) - (diff-file-header-face ((t (:bold t :background "grey60" :weight bold)))) - (diff-function-face ((t (:foreground "grey70")))) - (diff-header-face ((t (:background "grey45")))) - (diff-hunk-header-face ((t (:background "grey45")))) - (diff-index-face ((t (:bold t :weight bold :background "grey60")))) - (diff-nonexistent-face ((t (:bold t :weight bold :background "grey60")))) - (diff-removed-face ((t (nil)))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "SteelBlue")))) - (font-lock-comment-face ((t (:italic t :foreground "AntiqueWhite3" :slant oblique)))) - (font-lock-constant-face ((t (:bold t :foreground "Gold" :weight bold)))) - (font-lock-doc-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) - (font-lock-doc-string-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) - (font-lock-function-name-face ((t (:bold t :foreground "LightSkyBlue" :weight bold :height 0.9 :family "Verdana")))) - (font-lock-keyword-face ((t (:foreground "LightSkyBlue")))) - (font-lock-preprocessor-face ((t (:bold t :foreground "Gold" :weight bold)))) - (font-lock-reference-face ((t (:foreground "SteelBlue")))) - (font-lock-string-face ((t (:italic t :foreground "BurlyWood" :slant oblique)))) - (font-lock-type-face ((t (:bold t :foreground "PaleGreen" :weight bold :height 0.9 :family "Verdana")))) - (font-lock-variable-name-face ((t (:foreground "Aquamarine")))) - (font-lock-warning-face ((t (:bold t :foreground "chocolate" :weight bold)))) - (fringe ((t (:family "outline-courier new" :width normal :weight normal :slant normal :underline nil :overline nil :strike-through nil :box nil :inverse-video nil :stipple nil :background "grey4" :foreground "Wheat")))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "light blue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "forest green" :slant italic)))) - (gnus-header-from-face ((t (:foreground "spring green")))) - (gnus-header-name-face ((t (:foreground "SeaGreen")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) - (gnus-header-subject-face ((t (:foreground "SeaGreen3")))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:family "Arial" :background "grey20" :foreground "grey75" :box (:line-width 3 :color "grey20" :style released-button) :height 0.9)))) - (highlight ((t (:background "darkolivegreen")))) - (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "white")))) - (info-header-xref ((t (:bold t :weight bold :foreground "cyan")))) - (info-menu-5 ((t (:foreground "red1")))) - (info-menu-header ((t (:bold t :family "helv" :weight bold)))) - (info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) - (info-xref ((t (:bold t :foreground "cyan" :weight bold)))) - (isearch ((t (:background "palevioletred2")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) - (message-header-name-face ((t (:foreground "DarkGreen")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "blue3")))) - (modeline ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) - (modeline-mousable-minor-mode ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) - (modeline-mousable ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) - (modeline-buffer-id ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) - (mouse ((t (:background "white")))) - (primary-selection ((t (:background "DarkSlateGray")))) - (region ((t (:background "DarkSlateGray")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "SkyBlue4")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (trailing-whitespace ((t (:background "white")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (zmacs-region ((t (:background "DarkSlateGray"))))))) - -(defun color-theme-deep-blue () - "Color theme by Tomas Cerha, created 2001-11-13." - (interactive) - (color-theme-install - '(color-theme-deep-blue - ((background-color . "#102e4e") - (background-mode . dark) - (border-color . "black") - (cursor-color . "green") - (foreground-color . "#eeeeee") - (mouse-color . "white")) - ((browse-kill-ring-separator-face . bold) - (display-time-mail-face . mode-line) - (help-highlight-face . underline) - (list-matching-lines-face . secondary-selection) - (vc-annotate-very-old-color . "#0046FF") - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "#102e4e" :foreground "#eeeeee" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "misc-fixed")))) - (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) - (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) - (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) - (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (calendar-today-face ((t (:background "blue")))) - (change-log-acknowledgement-face ((t (:italic t :slant italic :foreground "CadetBlue")))) - (change-log-conditionals-face ((t (:foreground "SeaGreen2")))) - (change-log-date-face ((t (:foreground "burlywood")))) - (change-log-email-face ((t (:foreground "SeaGreen2")))) - (change-log-file-face ((t (:bold t :weight bold :foreground "goldenrod")))) - (change-log-function-face ((t (:foreground "SeaGreen2")))) - (change-log-list-face ((t (:bold t :weight bold :foreground "DeepSkyBlue1")))) - (change-log-name-face ((t (:foreground "gold")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "green" :foreground "black")))) - (cvs-filename-face ((t (:foreground "lightblue")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "lightyellow" :weight bold)))) - (cvs-marked-face ((t (:bold t :foreground "green" :weight bold)))) - (cvs-msg-face ((t (:italic t :slant italic)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:foreground "orange red")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey70")))) - (diff-file-header-face ((t (:bold t :background "grey60" :weight bold)))) - (diff-function-face ((t (:foreground "grey70")))) - (diff-header-face ((t (:background "grey45")))) - (diff-hunk-header-face ((t (:background "grey45")))) - (diff-index-face ((t (:bold t :weight bold :background "grey60")))) - (diff-nonexistent-face ((t (:bold t :weight bold :background "grey60")))) - (diff-removed-face ((t (nil)))) - (fixed-pitch ((t (:family "fixed")))) - (font-latex-bold-face ((t (:bold t :foreground "OliveDrab" :weight bold)))) - (font-latex-italic-face ((t (:italic t :foreground "OliveDrab" :slant italic)))) - (font-latex-math-face ((t (:foreground "burlywood")))) - (font-latex-sedate-face ((t (:foreground "LightGray")))) - (font-latex-string-face ((t (:foreground "LightSalmon")))) - (font-latex-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - (font-lock-builtin-face ((t (:foreground "LightCoral")))) - (font-lock-comment-face ((t (:italic t :foreground "CadetBlue" :slant italic)))) - (font-lock-constant-face ((t (:foreground "gold")))) - (font-lock-doc-face ((t (:foreground "BlanchedAlmond")))) - (font-lock-doc-string-face ((t (:foreground "BlanchedAlmond")))) - (font-lock-function-name-face ((t (:bold t :foreground "goldenrod" :weight bold)))) - (font-lock-keyword-face ((t (:bold t :foreground "DeepSkyBlue1" :weight bold)))) - (font-lock-preprocessor-face ((t (:foreground "gold")))) - (font-lock-reference-face ((t (:foreground "LightCoral")))) - (font-lock-string-face ((t (:foreground "burlywood")))) - (font-lock-type-face ((t (:foreground "CadetBlue1")))) - (font-lock-variable-name-face ((t (:foreground "SeaGreen2")))) - (font-lock-warning-face ((t (:foreground "yellow")))) - (fringe ((t (:background "#405060")))) - (header-line ((t (:box (:line-width 2 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "darkgreen")))) - (holiday-face ((t (:foreground "green")))) - (info-header-node ((t (:foreground "DeepSkyBlue1")))) - (info-header-xref ((t (:bold t :weight bold :foreground "SeaGreen2")))) - (info-menu-5 ((t (:foreground "wheat")))) - (info-menu-header ((t (:bold t :family "helv" :weight bold)))) - (info-node ((t (:foreground "DeepSkyBlue1")))) - (info-xref ((t (:bold t :foreground "SeaGreen2" :weight bold)))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (menu ((t (:background "gray" :foreground "black" :family "helvetica")))) - (modeline ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) - (modeline-buffer-id ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) - (modeline-mousable ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) - (modeline-mousable-minor-mode ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) - (mouse ((t (:background "white")))) - (region ((t (:background "DarkCyan")))) - (scroll-bar ((t (:background "gray" :foreground "#506070")))) - (secondary-selection ((t (:background "yellow" :foreground "gray10")))) - (show-paren-match-face ((t (:bold t :foreground "yellow" :weight bold)))) - (show-paren-mismatch-face ((t (:bold t :foreground "red" :weight bold)))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "#102e4e")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray"))))))) - -(defun color-theme-kingsajz () - "Color theme by Olgierd \"Kingsajz\" Ziolko, created 2001-12-04. -Another theme with wheat on DarkSlatGrey. Based on Subtle Hacker. -Used on Emacs 21.1 @ WinMe. Not tested on any other systems. - -Some faces uses Andale mono font (nice fixed-width font). -It is available at: http://www.microsoft.com/typography/downloads/andale32.exe - -Hail Eris! All hail Discordia!" - (interactive) - (color-theme-install - '(color-theme-kingsajz - ((background-color . "darkslategrey") - (background-mode . dark) - (border-color . "black") - (cursor-color . "LightGray") - (foreground-color . "wheat") - (mouse-color . "Grey")) - ((apropos-keybinding-face . underline) - (apropos-label-face face italic mouse-face highlight) - (apropos-match-face . secondary-selection) - (apropos-property-face . bold-italic) - (apropos-symbol-face . info-xref) - (display-time-mail-face . mode-line) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-carpal-button-face . bold) - (gnus-carpal-header-face . bold-italic) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-mouse-face . highlight) - (gnus-selected-tree-face . modeline) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (gnus-treat-display-xface . head) - (help-highlight-face . underline) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "darkslategrey" :foreground "wheat" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono")))) - (bbdb-field-name ((t (:foreground "green")))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (blue ((t (:foreground "cyan")))) - (bold ((t (:bold t :foreground "OrangeRed" :weight bold :family "Arial")))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold :family "Arial")))) - (border ((t (:background "black")))) - (calendar-today-face ((t (:underline t)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cperl-array-face ((t (:foreground "Yellow")))) - (cperl-hash-face ((t (:foreground "White")))) - (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) - (cursor ((t (:background "LightGray")))) - (custom-button-face ((t (:foreground "MediumSlateBlue" :underline t)))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (:foreground "Grey")))) - (custom-face-tag-face ((t (:bold t :family "Arial" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) - (custom-group-tag-face-1 ((t (:bold t :family "Arial" :foreground "pink" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "Coral")))) - (custom-variable-button-face ((t (:underline t)))) - (custom-variable-tag-face ((t (:foreground "Aquamarine")))) - (date ((t (:foreground "green")))) - (diary-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (dired-face-directory ((t (:bold t :foreground "sky blue" :weight bold)))) - (dired-face-executable ((t (:foreground "green yellow")))) - (dired-face-flagged ((t (:foreground "tomato")))) - (dired-face-marked ((t (:foreground "light salmon")))) - (dired-face-permissions ((t (:foreground "aquamarine")))) - (erc-action-face ((t (:bold t :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "pale green")))) - (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-host-danger-face ((t (:foreground "red")))) - (erc-input-face ((t (:foreground "light blue")))) - (erc-inverse-face ((t (:background "steel blue")))) - (erc-notice-face ((t (:foreground "light salmon")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "Grey")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "DimGray" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "Coral" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "black" :weight bold)))) - (eshell-ls-picture-face ((t (:foreground "Violet")))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) - (eshell-ls-special-face ((t (:bold t :foreground "Gold" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "White" :weight bold)))) - (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) - (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine" :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) - (eshell-prompt-face ((t (:foreground "powder blue")))) - (face-1 ((t (:stipple nil :foreground "royal blue" :family "andale mono")))) - (face-2 ((t (:stipple nil :foreground "DeepSkyBlue1" :overline nil :underline nil :slant normal :family "outline-andale mono")))) - (face-3 ((t (:stipple nil :foreground "NavajoWhite3")))) - (fg:erc-color-face0 ((t (:foreground "white")))) - (fg:erc-color-face1 ((t (:foreground "beige")))) - (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) - (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) - (fg:erc-color-face12 ((t (:foreground "light yellow")))) - (fg:erc-color-face13 ((t (:foreground "yellow")))) - (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) - (fg:erc-color-face15 ((t (:foreground "lime green")))) - (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) - (fg:erc-color-face3 ((t (:foreground "light cyan")))) - (fg:erc-color-face4 ((t (:foreground "powder blue")))) - (fg:erc-color-face5 ((t (:foreground "sky blue")))) - (fg:erc-color-face6 ((t (:foreground "dark sea green")))) - (fg:erc-color-face7 ((t (:foreground "pale green")))) - (fg:erc-color-face8 ((t (:foreground "medium spring green")))) - (fg:erc-color-face9 ((t (:foreground "khaki")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (font-lock-comment-face ((t (:foreground "White")))) - (font-lock-constant-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (font-lock-doc-face ((t (:italic t :slant italic :foreground "LightSalmon")))) - (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) - (font-lock-function-name-face ((t (:bold t :foreground "MediumSlateBlue" :weight bold)))) - (font-lock-keyword-face ((t (:foreground "Salmon")))) - (font-lock-preprocessor-face ((t (:foreground "Salmon")))) - (font-lock-reference-face ((t (:foreground "pale green")))) - (font-lock-string-face ((t (:italic t :foreground "LightSalmon" :slant italic)))) - (font-lock-type-face ((t (:bold t :foreground "YellowGreen" :weight bold)))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "Aquamarine" :slant italic :weight bold)))) - (font-lock-warning-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (fringe ((t (:background "darkslategrey")))) - (gnus-cite-attribution-face ((t (:family "arial")))) - (gnus-cite-face-1 ((t (:foreground "DarkGoldenrod3")))) - (gnus-cite-face-10 ((t (nil)))) - (gnus-cite-face-11 ((t (nil)))) - (gnus-cite-face-2 ((t (:foreground "IndianRed3")))) - (gnus-cite-face-3 ((t (:foreground "tomato")))) - (gnus-cite-face-4 ((t (:foreground "yellow green")))) - (gnus-cite-face-5 ((t (:foreground "SteelBlue3")))) - (gnus-cite-face-6 ((t (:foreground "Azure3")))) - (gnus-cite-face-7 ((t (:foreground "Azure4")))) - (gnus-cite-face-8 ((t (:foreground "SpringGreen4")))) - (gnus-cite-face-9 ((t (:foreground "SlateGray4")))) - (gnus-emphasis-bold ((t (:bold t :foreground "greenyellow" :weight bold :family "Arial")))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "OrangeRed1" :slant italic :weight bold :family "arial")))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "khaki")))) - (gnus-emphasis-italic ((t (:italic t :bold t :foreground "orange" :slant italic :weight bold :family "Arial")))) - (gnus-emphasis-underline ((t (:foreground "greenyellow" :underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :foreground "khaki" :underline t :weight bold :family "Arial")))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold :family "Arial")))) - (gnus-emphasis-underline-italic ((t (:italic t :foreground "orange" :underline t :slant italic :family "Arial")))) - (gnus-group-mail-1-empty-face ((t (:foreground "Salmon4")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "firebrick1" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "turquoise4")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "LightCyan4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "LightCyan1" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "SteelBlue4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "SteelBlue2" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "Salmon4")))) - (gnus-group-news-1-face ((t (:bold t :foreground "FireBrick1" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "darkorange3")))) - (gnus-group-news-2-face ((t (:bold t :foreground "dark orange" :weight bold)))) - (gnus-group-news-3-empty-face ((t (:foreground "turquoise4")))) - (gnus-group-news-3-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (gnus-group-news-4-empty-face ((t (:foreground "SpringGreen4")))) - (gnus-group-news-4-face ((t (:bold t :foreground "SpringGreen2" :weight bold)))) - (gnus-group-news-5-empty-face ((t (:foreground "OliveDrab4")))) - (gnus-group-news-5-face ((t (:bold t :foreground "OliveDrab2" :weight bold)))) - (gnus-group-news-6-empty-face ((t (:foreground "DarkGoldenrod4")))) - (gnus-group-news-6-face ((t (:bold t :foreground "DarkGoldenrod3" :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "wheat4")))) - (gnus-group-news-low-face ((t (:bold t :foreground "tan4" :weight bold)))) - (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) - (gnus-header-from-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (gnus-header-name-face ((t (:bold t :foreground "DodgerBlue1" :weight bold)))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3" :slant italic :weight bold)))) - (gnus-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (gnus-signature-face ((t (:italic t :foreground "salmon" :slant italic)))) - (gnus-splash-face ((t (:foreground "Firebrick1")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "MistyRose4" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "tomato3" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral" :weight bold)))) - (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "red1" :slant italic :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "DarkSeaGreen4" :slant italic)))) - (gnus-summary-low-read-face ((t (:foreground "SeaGreen4")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "Green4" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :foreground "green3" :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "khaki4")))) - (gnus-summary-normal-ticked-face ((t (:foreground "khaki3")))) - (gnus-summary-normal-unread-face ((t (:foreground "khaki")))) - (gnus-summary-selected-face ((t (:foreground "gold" :underline t)))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:foreground "red" :background "black")))) - (gui-element ((t (:bold t :background "#ffffff" :foreground "#000000" :weight bold)))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) - (highline-face ((t (:background "SeaGreen")))) - (holiday-face ((t (:background "DimGray")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:bold t :foreground "DodgerBlue1" :underline t :weight bold)))) - (info-xref ((t (:bold t :foreground "DodgerBlue3" :weight bold)))) - (isearch ((t (:background "sea green" :foreground "black")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :foreground "chocolate3" :slant italic)))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "White")))) - (message-header-cc-face ((t (:foreground "light cyan")))) - (message-header-name-face ((t (:foreground "DodgerBlue1")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "LightSkyBlue3")))) - (message-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (message-header-xheader-face ((t (:foreground "DodgerBlue3")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:background "cornflower blue" :foreground "chocolate")))) - (modeline ((t (:background "dark olive green" :foreground "wheat" :box (:line-width -1 :style released-button))))) - (modeline-buffer-id ((t (:bold t :background "dark olive green" :foreground "beige" :weight bold :family "arial")))) - (modeline-mousable ((t (:bold t :background "dark olive green" :foreground "yellow green" :weight bold :family "arial")))) - (modeline-mousable-minor-mode ((t (:bold t :background "dark olive green" :foreground "wheat" :weight bold :family "arial")))) - (mouse ((t (:background "Grey")))) - (paren-blink-off ((t (:foreground "brown")))) - (region ((t (:background "dark cyan" :foreground "cyan")))) - (ruler-mode-column-number-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "black")))) - (ruler-mode-current-column-face ((t (:bold t :box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :width normal :family "outline-andale mono" :foreground "yellow" :weight bold)))) - (ruler-mode-default-face ((t (:family "outline-andale mono" :width normal :weight normal :slant normal :underline nil :overline nil :strike-through nil :inverse-video nil :stipple nil :background "grey76" :foreground "grey64" :box (:color "grey76" :line-width 1 :style released-button))))) - (ruler-mode-fill-column-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "red")))) - (ruler-mode-margins-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :foreground "grey64" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :background "grey64")))) - (ruler-mode-tab-stop-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "steelblue")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) - (show-paren-match-face ((t (:bold t :background "Aquamarine" :foreground "steel blue" :weight bold)))) - (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) - (swbuff-current-buffer-face ((t (:bold t :foreground "red" :weight bold)))) - (text-cursor ((t (:background "Red" :foreground "white")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "Arial")))) - (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1" :weight bold)))) - (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3" :weight bold)))) - (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) - (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) - (widget-button-face ((t (:bold t :foreground "green" :weight bold :family "courier")))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:foreground "LightBlue")))) - (widget-inactive-face ((t (:foreground "DimGray")))) - (widget-single-line-field-face ((t (:foreground "LightBlue")))) - (woman-bold-face ((t (:bold t :weight bold :family "Arial")))) - (woman-italic-face ((t (:italic t :foreground "beige" :slant italic :family "Arial")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (zmacs-region ((t (:background "dark cyan" :foreground "cyan"))))))) - -(defun color-theme-comidia () - "Color theme by Marcelo Dias de Toledo, created 2001-12-17. -Steel blue on black." - (interactive) - (color-theme-install - '(color-theme-comidia - ((background-color . "Black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "SteelBlue") - (foreground-color . "SteelBlue") - (mouse-color . "SteelBlue")) - ((display-time-mail-face . mode-line) - (gnus-mouse-face . highlight) - (gnus-summary-selected-face . gnus-summary-selected-face) - (help-highlight-face . underline) - (ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed")))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "SteelBlue")))) - (erc-action-face ((t (:bold t :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-dangerous-host-face ((t (:foreground "red")))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "IndianRed")))) - (erc-error-face ((t (:background "Red" :foreground "White")))) - (erc-fool-face ((t (:foreground "dim gray")))) - (erc-input-face ((t (:foreground "brown")))) - (erc-inverse-face ((t (:background "Black" :foreground "White")))) - (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) - (erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) - (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) - (erc-underline-face ((t (:underline t)))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "chocolate1")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-face ((t (:foreground "LightSalmon")))) - (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) - (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) - (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - (fringe ((t (:background "grey10")))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:family "neep" :width condensed :box (:line-width 1 :style none) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "darkolivegreen")))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) - (message-header-name-face ((t (:foreground "DarkGreen")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "blue3")))) - (modeline ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) - (modeline-buffer-id ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) - (modeline-mousable-minor-mode ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) - (modeline-mousable ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) - (mouse ((t (:background "SteelBlue")))) - (primary-selection ((t (:background "blue3")))) - (region ((t (:background "blue3")))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "SkyBlue4")))) - (speedbar-button-face ((t (:foreground "green3")))) - (speedbar-directory-face ((t (:foreground "light blue")))) - (speedbar-file-face ((t (:foreground "cyan")))) - (speedbar-highlight-face ((t (:background "sea green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (zmacs-region ((t (:background "blue3"))))))) - -(defun color-theme-katester () - "Color theme by walterh@rocketmail.com, created 2001-12-12. -A pastelly-mac like color-theme." - (interactive) - (color-theme-standard) - (let ((color-theme-is-cumulative t)) - (color-theme-install - '(color-theme-katester - ((background-color . "ivory") - (cursor-color . "slateblue") - (foreground-color . "black") - (mouse-color . "slateblue")) - (default ((t ((:background "ivory" :foreground "black"))))) - (bold ((t (:bold t)))) - (font-lock-string-face ((t (:foreground "maroon")))) - (font-lock-keyword-face ((t (:foreground "blue")))) - (font-lock-constant-face ((t (:foreground "darkblue")))) - (font-lock-type-face ((t (:foreground "black")))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-function-name-face ((t (:bold t :underline t)))) - (font-lock-comment-face ((t (:background "seashell")))) - (highlight ((t (:background "lavender")))) - (italic ((t (:italic t)))) - (modeline ((t (:background "moccasin" :foreground "black")))) - (region ((t (:background "lavender" )))) - (underline ((t (:underline t)))))))) - -(defun color-theme-arjen () - "Color theme by awiersma, created 2001-08-27." - (interactive) - (color-theme-install - '(color-theme-arjen - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "White") - (mouse-color . "sienna1")) - ((buffers-tab-face . buffers-tab) - (cperl-here-face . font-lock-string-face) - (cperl-invalid-face quote underline) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (vc-mode-face . highlight)) - (default ((t (:background "black" :foreground "white")))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:bold t)))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:background "black" :foreground "white")))) - (calendar-today-face ((t (:underline t)))) - (cperl-array-face ((t (:foreground "darkseagreen")))) - (cperl-hash-face ((t (:foreground "darkseagreen")))) - (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "light blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) - (diary-face ((t (:foreground "IndianRed")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "sandybrown")))) - (erc-error-face ((t (:bold t :foreground "IndianRed")))) - (erc-input-face ((t (:foreground "Beige")))) - (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) - (erc-notice-face ((t (:foreground "MediumAquamarine")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:foreground "MediumAquamarine")))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) - (eshell-ls-backup-face ((t (:foreground "Grey")))) - (eshell-ls-clutter-face ((t (:foreground "DimGray")))) - (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) - (eshell-ls-executable-face ((t (:foreground "Coral")))) - (eshell-ls-missing-face ((t (:foreground "black")))) - (eshell-ls-picture-face ((t (:foreground "Violet")))) - (eshell-ls-product-face ((t (:foreground "sandybrown")))) - (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) - (eshell-ls-special-face ((t (:foreground "Gold")))) - (eshell-ls-symlink-face ((t (:foreground "White")))) - (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) - (eshell-prompt-face ((t (:foreground "MediumAquamarine")))) - (fl-comment-face ((t (:foreground "pink")))) - (fl-doc-string-face ((t (:foreground "purple")))) - (fl-function-name-face ((t (:foreground "red")))) - (fl-keyword-face ((t (:foreground "cadetblue")))) - (fl-string-face ((t (:foreground "green")))) - (fl-type-face ((t (:foreground "yellow")))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "IndianRed")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-string-face ((t (:foreground "DarkOrange")))) - (font-lock-function-name-face ((t (:foreground "YellowGreen")))) - (font-lock-keyword-face ((t (:foreground "PaleYellow")))) - (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) - (font-lock-reference-face ((t (:foreground "SlateBlue")))) - (font-lock-string-face ((t (:foreground "Orange")))) - (font-lock-type-face ((t (:foreground "Green")))) - (font-lock-variable-name-face ((t (:foreground "darkseagreen")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink")))) - (qt-classes-face ((t (:foreground "Red")))) - (gnus-cite-attribution-face ((t (nil)))) - (gnus-cite-face-1 ((t (:bold nil :foreground "deep sky blue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:bold nil :foreground "cadetblue")))) - (gnus-cite-face-3 ((t (:bold nil :foreground "gold")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:bold nil :foreground "chocolate")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold nil)))) - (gnus-emphasis-bold-italic ((t (:bold nil)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold nil)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :bold nil)))) - (gnus-emphasis-underline-italic ((t (:underline t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold nil :foreground "aquamarine1")))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold nil :foreground "aquamarine2")))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold nil :foreground "aquamarine3")))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold nil :foreground "aquamarine4")))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold nil :foreground "PaleTurquoise")))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold nil :foreground "turquoise")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold nil)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold nil)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold nil)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold nil)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold nil :foreground "DarkTurquoise")))) - (gnus-header-content-face ((t (:foreground "forest green")))) - (gnus-header-from-face ((t (:bold nil :foreground "spring green")))) - (gnus-header-name-face ((t (:foreground "deep sky blue")))) - (gnus-header-newsgroups-face ((t (:bold nil :foreground "purple")))) - (gnus-header-subject-face ((t (:bold nil :foreground "orange")))) - (gnus-signature-face ((t (:bold nil :foreground "khaki")))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold nil :foreground "SkyBlue")))) - (gnus-summary-high-read-face ((t (:bold nil :foreground "PaleGreen")))) - (gnus-summary-high-ticked-face ((t (:bold nil :foreground "pink")))) - (gnus-summary-high-unread-face ((t (:bold nil)))) - (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-low-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-low-ticked-face ((t (:foreground "pink")))) - (gnus-summary-low-unread-face ((t (nil)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "#D4D0C8" :foreground "black")))) - (highlight ((t (:background "darkolivegreen")))) - (highline-face ((t (:background "SeaGreen")))) - (holiday-face ((t (:background "DimGray")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) - (info-xref ((t (:underline t :foreground "DodgerBlue1")))) - (isearch ((t (:background "blue")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (nil)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68" :foreground "white")))) - (message-cited-text-face ((t (:bold t :foreground "green")))) - (message-header-cc-face ((t (:bold t :foreground "green4")))) - (message-header-name-face ((t (:bold t :foreground "orange")))) - (message-header-newsgroups-face ((t (:bold t :foreground "violet")))) - (message-header-other-face ((t (:bold t :foreground "chocolate")))) - (message-header-subject-face ((t (:bold t :foreground "yellow")))) - (message-header-to-face ((t (:bold t :foreground "cadetblue")))) - (message-header-xheader-face ((t (:bold t :foreground "light blue")))) - (message-mml-face ((t (:bold t :foreground "Green3")))) - (message-separator-face ((t (:foreground "blue3")))) - (modeline ((t (:background "DarkRed" :foreground "white" :box (:line-width 1 :style released-button))))) - (modeline-buffer-id ((t (:background "DarkRed" :foreground "white")))) - (modeline-mousable ((t (:background "DarkRed" :foreground "white")))) - (modeline-mousable-minor-mode ((t (:background "DarkRed" :foreground "white")))) - (p4-depot-added-face ((t (:foreground "blue")))) - (p4-depot-deleted-face ((t (:foreground "red")))) - (p4-depot-unmapped-face ((t (:foreground "grey30")))) - (p4-diff-change-face ((t (:foreground "dark green")))) - (p4-diff-del-face ((t (:foreground "red")))) - (p4-diff-file-face ((t (:background "gray90")))) - (p4-diff-head-face ((t (:background "gray95")))) - (p4-diff-ins-face ((t (:foreground "blue")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "blue")))) - (red ((t (:foreground "red")))) - (region ((t (:background "blue")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "darkslateblue")))) - (show-paren-match-face ((t (:background "Aquamarine" :foreground "SlateBlue")))) - (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) - (text-cursor ((t (:background "yellow" :foreground "black")))) - (toolbar ((t (nil)))) - (underline ((nil (:underline nil)))) - (vertical-divider ((t (nil)))) - (widget ((t (nil)))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (woman-bold-face ((t (:bold t)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "snow" :foreground "blue"))))))) - -(defun color-theme-tty-dark () - "Color theme by Oivvio Polite, created 2002-02-01. Good for tty display." - (interactive) - (color-theme-install - '(color-theme-tty-dark - ((background-color . "black") - (background-mode . dark) - (border-color . "blue") - (cursor-color . "red") - (foreground-color . "white") - (mouse-color . "black")) - ((ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (tinyreplace-:face . highlight) - (view-highlight-face . highlight)) - (default ((t (nil)))) - (bold ((t (:underline t :background "black" :foreground "white")))) - (bold-italic ((t (:underline t :foreground "white")))) - (calendar-today-face ((t (:underline t)))) - (diary-face ((t (:foreground "red")))) - (font-lock-builtin-face ((t (:foreground "blue")))) - (font-lock-comment-face ((t (:foreground "cyan")))) - (font-lock-constant-face ((t (:foreground "magenta")))) - (font-lock-function-name-face ((t (:foreground "cyan")))) - (font-lock-keyword-face ((t (:foreground "red")))) - (font-lock-string-face ((t (:foreground "green")))) - (font-lock-type-face ((t (:foreground "yellow")))) - (font-lock-variable-name-face ((t (:foreground "blue")))) - (font-lock-warning-face ((t (:bold t :foreground "magenta")))) - (highlight ((t (:background "blue" :foreground "yellow")))) - (holiday-face ((t (:background "cyan")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (italic ((t (:underline t :background "red")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green")))) - (message-header-name-face ((t (:foreground "green")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green")))) - (message-header-to-face ((t (:bold t :foreground "green")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "green")))) - (message-separator-face ((t (:foreground "blue")))) - - (modeline ((t (:background "white" :foreground "blue")))) - (modeline-buffer-id ((t (:background "white" :foreground "red")))) - (modeline-mousable ((t (:background "white" :foreground "magenta")))) - (modeline-mousable-minor-mode ((t (:background "white" :foreground "yellow")))) - (region ((t (:background "white" :foreground "black")))) - (zmacs-region ((t (:background "cyan" :foreground "black")))) - (secondary-selection ((t (:background "blue")))) - (show-paren-match-face ((t (:background "red")))) - (show-paren-mismatch-face ((t (:background "magenta" :foreground "white")))) - (underline ((t (:underline t))))))) - -(defun color-theme-aliceblue () - "Color theme by Girish Bharadwaj, created 2002-03-27. -Includes comint prompt, custom, font-lock, isearch, -jde, senator, speedbar, and widget." - (interactive) - (color-theme-install - '(color-theme-aliceblue - ((background-color . "AliceBlue") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "DarkSlateGray4") - (mouse-color . "black")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (semantic-which-function-use-color . t) - (senator-eldoc-use-color . t) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "AliceBlue" :foreground "DarkSlateGray4" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (cursor ((t (:background "black")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:italic t :foreground "Firebrick" :slant oblique)))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-function-name-face ((t (:bold t :foreground "Blue" :weight extra-bold :family "outline-verdana")))) - (font-lock-keyword-face ((t (:bold t :foreground "Purple" :weight semi-bold :family "outline-verdana")))) - (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) - (font-lock-reference-face ((t (:foreground "Orchid")))) - (font-lock-string-face ((t (:foreground "RosyBrown")))) - (font-lock-type-face ((t (:italic t :foreground "ForestGreen" :slant italic)))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod" :width condensed)))) - (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (fringe ((t (:background "DarkSlateBlue")))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) - (highlight ((t (:background "darkseagreen2")))) - (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic t :slant italic)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) - (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) - (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) - (jde-java-font-lock-api-face ((t (:foreground "dark goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "CadetBlue")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "green4")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) - (jde-java-font-lock-modifier-face ((t (:foreground "Orchid")))) - (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) - (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) - (jde-java-font-lock-package-face ((t (:foreground "blue3")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (menu ((t (nil)))) - (modeline ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-buffer-id ((t (:background "grey75" :foreground "black")))) - (modeline-mousable ((t (:background "grey75" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black")))) - (mouse ((t (:background "black")))) - (primary-selection ((t (:background "lightgoldenrod2")))) - (region ((t (:background "lightgoldenrod2")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "yellow")))) - (semantic-dirty-token-face ((t (:background "lightyellow")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray25")))) - (senator-momentary-highlight-face ((t (:background "gray70")))) - (senator-read-only-face ((t (:background "#CCBBBB")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "brown")))) - (template-message-face ((t (:bold t :weight bold)))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (zmacs-region ((t (:background "lightgoldenrod2"))))))) - -(defun color-theme-black-on-gray () - "Color theme by sbhojwani, created 2002-04-03. -Includes ecb, font-lock, paren, semantic, and widget faces. -Some of the font-lock faces are disabled, ie. they look just -like the default face. This is for people that don't like -the look of \"angry fruit salad\" when editing." - (interactive) - (color-theme-install - '(color-theme-black-on-gray - ((background-color . "white") - (background-mode . light) - (border-color . "blue") - (foreground-color . "black")) - ((buffers-tab-face . buffers-tab) - (ecb-directories-general-face . ecb-default-general-face) - (ecb-directory-face . ecb-default-highlight-face) - (ecb-history-face . ecb-default-highlight-face) - (ecb-history-general-face . ecb-default-general-face) - (ecb-method-face . ecb-default-highlight-face) - (ecb-methods-general-face . ecb-default-general-face) - (ecb-source-face . ecb-default-highlight-face) - (ecb-source-in-directories-buffer-face . ecb-source-in-directories-buffer-face) - (ecb-sources-general-face . ecb-default-general-face) - (ecb-token-header-face . ecb-token-header-face)) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t :size "10pt")))) - (bold-italic ((t (:italic t :bold t :size "10pt")))) - (border-glyph ((t (:size "11pt")))) - (buffers-tab ((t (:background "gray75")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (ecb-bucket-token-face ((t (:bold t :size "10pt")))) - (ecb-default-general-face ((t (nil)))) - (ecb-default-highlight-face ((t (:background "cornflower blue" :foreground "yellow")))) - (ecb-directories-general-face ((t (nil)))) - (ecb-directory-face ((t (:background "cornflower blue" :foreground "yellow")))) - (ecb-history-face ((t (:background "cornflower blue" :foreground "yellow")))) - (ecb-history-general-face ((t (nil)))) - (ecb-method-face ((t (:background "cornflower blue" :foreground "yellow")))) - (ecb-methods-general-face ((t (nil)))) - (ecb-source-face ((t (:background "cornflower blue" :foreground "yellow")))) - (ecb-source-in-directories-buffer-face ((t (:foreground "medium blue")))) - (ecb-sources-general-face ((t (nil)))) - (ecb-token-header-face ((t (:background "SeaGreen1")))) - (ecb-type-token-class-face ((t (:bold t :size "10pt")))) - (ecb-type-token-enum-face ((t (:bold t :size "10pt")))) - (ecb-type-token-group-face ((t (:bold t :size "10pt" :foreground "dimgray")))) - (ecb-type-token-interface-face ((t (:bold t :size "10pt")))) - (ecb-type-token-struct-face ((t (:bold t :size "10pt")))) - (ecb-type-token-typedef-face ((t (:bold t :size "10pt")))) - (font-lock-builtin-face ((t (:foreground "red3")))) - (font-lock-constant-face ((t (:foreground "blue3")))) - (font-lock-comment-face ((t (:foreground "blue")))) - (font-lock-doc-face ((t (:foreground "green4")))) - (font-lock-doc-string-face ((t (:foreground "green4")))) - (font-lock-function-name-face ((t (nil)))) - (font-lock-keyword-face ((t (nil)))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (nil)))) - (font-lock-type-face ((t (nil)))) - (font-lock-variable-name-face ((t (nil)))) - (font-lock-warning-face ((t (nil)))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75")))) - (gui-element ((t (:size "8pt" :background "gray75")))) - (highlight ((t (:background "darkseagreen2")))) - (isearch ((t (:background "paleturquoise")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:size "10pt")))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68")))) - (modeline ((t (:background "gray75")))) - (modeline-buffer-id ((t (:background "gray75" :foreground "blue4")))) - (modeline-mousable ((t (:background "gray75" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "gray75" :foreground "green4")))) - (paren-blink-off ((t (:foreground "gray")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (nil)))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray65")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (semantic-dirty-token-face ((t (nil)))) - (semantic-unmatched-syntax-face ((t (nil)))) - (text-cursor ((t (:background "red" :foreground "gray")))) - (toolbar ((t (:background "gray75")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (:background "gray75")))) - (widget ((t (:size "8pt" :background "gray75")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (nil)))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65"))))))) - -(defun color-theme-dark-blue2 () - "Color theme by Chris McMahan, created 2002-04-12. -Includes antlr, bbdb, change-log, comint, cperl, custom cvs, diff, -dired, display-time, ebrowse, ecb, ediff, erc, eshell, fl, font-lock, -gnus, hi, highlight, html-helper, hyper-apropos, info, isearch, jde, -message, mmm, paren, semantic, senator, sgml, smerge, speedbar, -strokes, term, vhdl, viper, vm, widget, xref, xsl, xxml. Yes, it is -a large theme." - (interactive) - (color-theme-install - '(color-theme-dark-blue2 - ((background-color . "#233b5a") - (background-mode . dark) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "black") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (cursor-color . "Yellow") - (foreground-color . "#fff8dc") - (mouse-color . "Grey") - (top-toolbar-shadow-color . "#fffffbeeffff") - (viper-saved-cursor-color-in-replace-mode . "Red3")) - ((blank-space-face . blank-space-face) - (blank-tab-face . blank-tab-face) - (cperl-invalid-face . underline) - (ecb-directories-general-face . ecb-directories-general-face) - (ecb-directory-face . ecb-directory-face) - (ecb-history-face . ecb-history-face) - (ecb-history-general-face . ecb-history-general-face) - (ecb-method-face . ecb-method-face) - (ecb-methods-general-face . ecb-methods-general-face) - (ecb-source-face . ecb-source-face) - (ecb-source-in-directories-buffer-face . ecb-sources-face) - (ecb-sources-general-face . ecb-sources-general-face) - (ecb-token-header-face . ecb-token-header-face) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (help-highlight-face . underline) - (highline-face . highline-face) - (highline-vertical-face . highline-vertical-face) - (list-matching-lines-face . bold) - (ps-zebra-color . 0.95) - (senator-eldoc-use-color . t) - (sgml-set-face . t) - (tags-tag-face . default) - (view-highlight-face . highlight) - (vm-highlight-url-face . bold-italic) - (vm-highlighted-header-face . bold) - (vm-mime-button-face . gui-button-face) - (vm-summary-highlight-face . bold) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "#233b5a" :foreground "#fff8dc" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) - (Info-title-1-face ((t (:bold t :weight bold :height 1.728 :family "helv")))) - (Info-title-2-face ((t (:bold t :weight bold :height 1.44 :family "helv")))) - (Info-title-3-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) - (Info-title-4-face ((t (:bold t :weight bold :family "helv")))) - (antlr-font-lock-keyword-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (antlr-font-lock-literal-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (antlr-font-lock-ruledef-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (antlr-font-lock-ruleref-face ((t (:foreground "Gray85")))) - (antlr-font-lock-tokendef-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (antlr-font-lock-tokenref-face ((t (:foreground "Gray85")))) - (bbdb-company ((t (:italic t :slant italic)))) - (bbdb-field-name ((t (:bold t :weight bold)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (blank-space-face ((t (:background "LightGray")))) - (blank-tab-face ((t (:background "Wheat")))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t :foreground "cyan" :weight bold)))) - (bold-italic ((t (:italic t :bold t :foreground "cyan2" :slant italic :weight bold)))) - (border ((t (:background "black")))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:background "gray30" :foreground "LightSkyBlue")))) - (calendar-today-face ((t (:underline t)))) - (change-log-acknowledgement-face ((t (:foreground "firebrick")))) - (change-log-conditionals-face ((t (:background "sienna" :foreground "khaki")))) - (change-log-date-face ((t (:foreground "gold")))) - (change-log-email-face ((t (:foreground "khaki" :underline t)))) - (change-log-file-face ((t (:bold t :foreground "lemon chiffon" :weight bold)))) - (change-log-function-face ((t (:background "sienna" :foreground "khaki")))) - (change-log-list-face ((t (:foreground "wheat")))) - (change-log-name-face ((t (:bold t :foreground "light goldenrod" :weight bold)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (comint-input-face ((t (:foreground "deepskyblue")))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) - (cperl-invalid-face ((t (:foreground "white")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cursor ((t (:background "Yellow")))) - (custom-button-face ((t (:bold t :weight bold)))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "gray30")))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:foreground "white")))) - (custom-comment-tag-face ((t (:foreground "white")))) - (custom-documentation-face ((t (:foreground "light blue")))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:bold t :foreground "gray85" :underline t :weight bold)))) - (custom-group-tag-face-1 ((t (:foreground "gray85" :underline t)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "gray30" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "gray85")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :foreground "gray85" :underline t :weight bold)))) - (cvs-filename-face ((t (:foreground "white")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:foreground "green")))) - (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) - (cvs-msg-face ((t (:foreground "gray85")))) - (cvs-need-action-face ((t (:foreground "yellow")))) - (cvs-unknown-face ((t (:foreground "grey")))) - (cyan ((t (:foreground "cyan")))) - (diary-face ((t (:bold t :foreground "gray85" :weight bold)))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey50")))) - (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-function-face ((t (:foreground "grey50")))) - (diff-header-face ((t (:foreground "lemon chiffon")))) - (diff-hunk-header-face ((t (:background "grey85")))) - (diff-index-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t :weight bold)))) - (dired-face-executable ((t (:foreground "gray85")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-header ((t (:background "grey75" :foreground "gray30")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "gray30")))) - (dired-face-setuid ((t (:foreground "gray85")))) - (dired-face-socket ((t (:foreground "gray85")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "gray85")))) - (ebrowse-default-face ((t (nil)))) - (ebrowse-file-name-face ((t (:italic t :slant italic)))) - (ebrowse-member-attribute-face ((t (:foreground "red")))) - (ebrowse-member-class-face ((t (:foreground "Gray85")))) - (ebrowse-progress-face ((t (:background "blue")))) - (ebrowse-root-class-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (ebrowse-tree-mark-face ((t (:foreground "Gray85")))) - (ecb-bucket-token-face ((t (:bold t :weight bold)))) - (ecb-default-general-face ((t (:height 1.0)))) - (ecb-default-highlight-face ((t (:background "magenta" :height 1.0)))) - (ecb-directories-general-face ((t (:height 0.9)))) - (ecb-directory-face ((t (:background "Cyan4")))) - (ecb-history-face ((t (:background "Cyan4")))) - (ecb-history-general-face ((t (:height 0.9)))) - (ecb-method-face ((t (:background "Cyan4" :slant normal :weight normal)))) - (ecb-methods-general-face ((t (:slant normal)))) - (ecb-source-face ((t (:background "Cyan4")))) - (ecb-source-in-directories-buffer-face ((t (:foreground "LightBlue1")))) - (ecb-sources-face ((t (:foreground "LightBlue1")))) - (ecb-sources-general-face ((t (:height 0.9)))) - (ecb-token-header-face ((t (:background "Steelblue4")))) - (ecb-type-token-class-face ((t (:bold t :weight bold)))) - (ecb-type-token-enum-face ((t (:bold t :weight bold)))) - (ecb-type-token-group-face ((t (:bold t :foreground "dim gray" :weight bold)))) - (ecb-type-token-interface-face ((t (:bold t :weight bold)))) - (ecb-type-token-struct-face ((t (:bold t :weight bold)))) - (ecb-type-token-typedef-face ((t (:bold t :weight bold)))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Gray30")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Gray30")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Gray30")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Gray30")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Gray30")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Gray30")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Gray30")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Gray30")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (erc-action-face ((t (:bold t :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-dangerous-host-face ((t (:foreground "red")))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "pale green")))) - (erc-error-face ((t (:bold t :foreground "gray85" :weight bold)))) - (erc-fool-face ((t (:foreground "Gray85")))) - (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-input-face ((t (:foreground "light blue")))) - (erc-inverse-face ((t (:background "Black" :foreground "White")))) - (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-notice-face ((t (:foreground "light salmon")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) - (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "gray85")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "gray85" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "Cyan" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :weight bold)))) - (eshell-ls-picture-face ((t (:foreground "gray85")))) - (eshell-ls-product-face ((t (:foreground "gray85")))) - (eshell-ls-readonly-face ((t (:foreground "gray70")))) - (eshell-ls-special-face ((t (:bold t :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :weight bold)))) - (eshell-ls-text-face ((t (:foreground "gray85")))) - (eshell-ls-todo-face ((t (:bold t :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "gray85")))) - (eshell-prompt-face ((t (:bold t :foreground "Yellow" :weight bold)))) - (eshell-test-failed-face ((t (:bold t :weight bold)))) - (eshell-test-ok-face ((t (:bold t :weight bold)))) - (excerpt ((t (:italic t :slant italic)))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "gray85" :weight bold)))) - (fg:black ((t (:foreground "black")))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed ((t (:bold t :weight bold)))) - (fixed-pitch ((t (:family "outline-lucida console")))) - (fl-comment-face ((t (:foreground "gray85")))) - (fl-function-name-face ((t (:foreground "green")))) - (fl-keyword-face ((t (:foreground "LightGreen")))) - (fl-string-face ((t (:foreground "light coral")))) - (fl-type-face ((t (:foreground "cyan")))) - (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) - (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) - (font-latex-bold-face ((t (nil)))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (:foreground "Gray85")))) - (font-latex-string-face ((t (:foreground "orange")))) - (font-latex-warning-face ((t (:foreground "gold")))) - (font-lock-builtin-face ((t (:bold t :foreground "LightSteelBlue" :weight bold)))) - (font-lock-comment-face ((t (:italic t :foreground "medium aquamarine" :slant italic)))) - (font-lock-constant-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (font-lock-doc-face ((t (:bold t :weight bold)))) - (font-lock-doc-string-face ((t (:bold t :foreground "aquamarine" :weight bold)))) - (font-lock-exit-face ((t (:foreground "green")))) - (font-lock-function-name-face ((t (:italic t :bold t :foreground "LightSkyBlue" :slant italic :weight bold)))) - (font-lock-keyword-face ((t (:bold t :foreground "Cyan" :weight bold)))) - (font-lock-preprocessor-face ((t (:foreground "Gray85")))) - (font-lock-reference-face ((t (:foreground "cyan")))) - (font-lock-string-face ((t (:italic t :foreground "aquamarine" :slant italic)))) - (font-lock-type-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (font-lock-variable-name-face ((t (:italic t :bold t :foreground "LightGoldenrod" :slant italic :weight bold)))) - (font-lock-warning-face ((t (:bold t :foreground "Salmon" :weight bold)))) - (fringe ((t (:background "#3c5473")))) - (gnus-cite-attribution-face ((t (:italic t :bold t :foreground "beige" :underline t :slant italic :weight bold)))) - (gnus-cite-face-1 ((t (:foreground "gold")))) - (gnus-cite-face-10 ((t (:foreground "coral")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "wheat")))) - (gnus-cite-face-3 ((t (:foreground "light pink")))) - (gnus-cite-face-4 ((t (:foreground "khaki")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :foreground "light gray" :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "cyan" :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "gray30" :foreground "gold")))) - (gnus-emphasis-italic ((t (:italic t :foreground "cyan" :slant italic)))) - (gnus-emphasis-underline ((t (:foreground "white" :underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :foreground "white" :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :foreground "white" :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :foreground "white" :underline t :slant italic)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (:foreground "Magenta")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "Cyan")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "Cyan" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "Gray85" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-news-3-empty-face ((t (:foreground "wheat")))) - (gnus-group-news-3-face ((t (:bold t :foreground "Wheat" :weight bold)))) - (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "Wheat" :slant italic)))) - (gnus-header-from-face ((t (:bold t :foreground "light yellow" :weight bold)))) - (gnus-header-name-face ((t (:bold t :foreground "Wheat" :weight bold)))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "gold" :slant italic :weight bold)))) - (gnus-header-subject-face ((t (:bold t :foreground "Gold" :weight bold)))) - (gnus-picons-face ((t (:background "white" :foreground "gray30")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "gray30")))) - (gnus-signature-face ((t (:italic t :foreground "white" :slant italic)))) - (gnus-splash ((t (:foreground "Brown")))) - (gnus-splash-face ((t (:foreground "orange")))) - (gnus-summary-cancelled-face ((t (:background "gray30" :foreground "orange")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "gray85" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral" :weight bold)))) - (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "gold" :slant italic :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "gray85" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "coral" :slant italic :weight bold)))) - (gnus-summary-low-unread-face ((t (:italic t :foreground "white" :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "gray70")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) - (gnus-summary-normal-unread-face ((t (:bold t :foreground "gray85" :weight bold)))) - (gnus-summary-selected-face ((t (:foreground "white" :underline t)))) - (gnus-x-face ((t (:background "white" :foreground "gray30")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "gray30")))) - (gui-element ((t (:background "Gray80")))) - (header-line ((t (:background "grey20" :foreground "grey90")))) - (hi-black-b ((t (:bold t :weight bold)))) - (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) - (hi-blue ((t (:background "light blue")))) - (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) - (hi-green ((t (:background "green")))) - (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) - (hi-pink ((t (:background "pink")))) - (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) - (hi-yellow ((t (:background "yellow")))) - (highlight ((t (:background "SkyBlue3")))) - (highlight-changes-delete-face ((t (:foreground "gray85" :underline t)))) - (highlight-changes-face ((t (:foreground "gray85")))) - (highline-face ((t (:background "#3c5473")))) - (highline-vertical-face ((t (:background "lightcyan")))) - (holiday-face ((t (:background "pink" :foreground "gray30")))) - (html-helper-bold-face ((t (:bold t :weight bold)))) - (html-helper-bold-italic-face ((t (nil)))) - (html-helper-builtin-face ((t (:foreground "gray85" :underline t)))) - (html-helper-italic-face ((t (:bold t :foreground "yellow" :weight bold)))) - (html-helper-underline-face ((t (:underline t)))) - (html-tag-face ((t (:bold t :weight bold)))) - (hyper-apropos-documentation ((t (:foreground "white")))) - (hyper-apropos-heading ((t (:bold t :weight bold)))) - (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) - (hyper-apropos-major-heading ((t (:bold t :weight bold)))) - (hyper-apropos-section-heading ((t (:bold t :weight bold)))) - (hyper-apropos-warning ((t (:bold t :foreground "gray85" :weight bold)))) - (ibuffer-marked-face ((t (:foreground "gray85")))) - (idlwave-help-link-face ((t (:foreground "Blue")))) - (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) - (info-header-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) - (info-header-xref ((t (:bold t :foreground "magenta4" :weight bold)))) - (info-menu-5 ((t (:underline t)))) - (info-menu-6 ((t (nil)))) - (info-menu-header ((t (:bold t :weight bold :family "helv")))) - (info-node ((t (:italic t :bold t :slant italic :weight bold)))) - (info-xref ((t (:bold t :weight bold)))) - (isearch ((t (:background "LightSeaGreen")))) - (isearch-lazy-highlight-face ((t (:background "cyan4")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:italic t :bold t :slant italic :weight bold)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) - (jde-java-font-lock-api-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "cyan3" :underline t)))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) - (jde-java-font-lock-operator-face ((t (:foreground "cyan3")))) - (jde-java-font-lock-package-face ((t (:foreground "LightBlue")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (lazy-highlight-face ((t (:bold t :foreground "yellow" :weight bold)))) - (left-margin ((t (nil)))) - (linemenu-face ((t (:background "gray30")))) - (list-mode-item-selected ((t (:background "gray68")))) - (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) - (log-view-message-face ((t (:background "grey85")))) - (magenta ((t (:foreground "gray85")))) - (makefile-space-face ((t (:background "hotpink" :foreground "white")))) - (man-bold ((t (:bold t :weight bold)))) - (man-heading ((t (:bold t :weight bold)))) - (man-italic ((t (:foreground "yellow")))) - (man-xref ((t (:underline t)))) - (menu ((t (:background "wheat" :foreground "gray30")))) - (message-cited-text ((t (:foreground "orange")))) - (message-cited-text-face ((t (:foreground "medium aquamarine")))) - (message-header-cc-face ((t (:bold t :foreground "gray85" :weight bold)))) - (message-header-contents ((t (:foreground "white")))) - (message-header-name-face ((t (:foreground "gray85")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "gray85")))) - (message-header-subject-face ((t (:bold t :foreground "green3" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-headers ((t (:bold t :foreground "orange" :weight bold)))) - (message-highlighted-header-contents ((t (:bold t :weight bold)))) - (message-mml-face ((t (:bold t :foreground "gray85" :weight bold)))) - (message-separator-face ((t (:foreground "gray85")))) - (message-url ((t (:bold t :foreground "pink" :weight bold)))) - (mmm-default-submode-face ((t (:background "#c0c0c5")))) - (mmm-face ((t (:background "black" :foreground "green")))) - (modeline ((t (:background "#3c5473" :foreground "lightgray" :box (:line-width -1 :style released-button :family "helv"))))) - (modeline-buffer-id ((t (:background "white" :foreground "DeepSkyBlue3" :slant normal :weight normal :width normal :family "outline-verdana")))) - (modeline-mousable ((t (:background "white" :foreground "DeepSkyBlue3")))) - (modeline-mousable-minor-mode ((t (:background "white" :foreground "DeepSkyBlue3")))) - (mouse ((t (:background "Grey")))) - (my-summary-highlight-face ((t (:background "PaleTurquoise4" :foreground "White")))) - (my-url-face ((t (:foreground "LightBlue")))) - (nil ((t (nil)))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-face-match ((t (:background "turquoise")))) - (paren-face-mismatch ((t (:background "purple" :foreground "white")))) - (paren-face-no-match ((t (:background "yellow" :foreground "gray30")))) - (paren-match ((t (:background "darkseagreen2")))) - (paren-mismatch ((t (:background "RosyBrown" :foreground "gray30")))) - (paren-mismatch-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) - (paren-no-match-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray40")))) - (reb-match-0 ((t (:background "lightblue")))) - (reb-match-1 ((t (:background "aquamarine")))) - (reb-match-2 ((t (:background "springgreen")))) - (reb-match-3 ((t (:background "yellow")))) - (red ((t (:foreground "red")))) - (region ((t (:background "Cyan4")))) - (right-margin ((t (nil)))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "gray60")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (semantic-intangible-face ((t (:foreground "gray25")))) - (semantic-read-only-face ((t (:background "gray25")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray70")))) - (senator-read-only-face ((t (:background "#664444")))) - (sgml-comment-face ((t (:foreground "dark turquoise")))) - (sgml-doctype-face ((t (:foreground "turquoise")))) - (sgml-end-tag-face ((t (:foreground "aquamarine")))) - (sgml-entity-face ((t (:foreground "gray85")))) - (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) - (sgml-ms-end-face ((t (:foreground "green")))) - (sgml-ms-start-face ((t (:foreground "yellow")))) - (sgml-pi-face ((t (:foreground "lime green")))) - (sgml-sgml-face ((t (:foreground "brown")))) - (sgml-short-ref-face ((t (:foreground "deep sky blue")))) - (sgml-start-tag-face ((t (:foreground "aquamarine")))) - (sh-heredoc-face ((t (:foreground "tan")))) - (shell-option-face ((t (:foreground "gray85")))) - (shell-output-2-face ((t (:foreground "gray85")))) - (shell-output-3-face ((t (:foreground "gray85")))) - (shell-output-face ((t (:bold t :weight bold)))) - (shell-prompt-face ((t (:foreground "yellow")))) - (show-paren-match-face ((t (:bold t :background "turquoise" :weight bold)))) - (show-paren-mismatch-face ((t (:bold t :background "RosyBrown" :foreground "white" :weight bold)))) - (show-tabs-space-face ((t (:foreground "yellow")))) - (show-tabs-tab-face ((t (:foreground "red")))) - (smerge-base-face ((t (:foreground "red")))) - (smerge-markers-face ((t (:background "grey85")))) - (smerge-mine-face ((t (:foreground "Gray85")))) - (smerge-other-face ((t (:foreground "darkgreen")))) - (speedbar-button-face ((t (:bold t :weight bold)))) - (speedbar-directory-face ((t (:bold t :weight bold)))) - (speedbar-file-face ((t (:bold t :weight bold)))) - (speedbar-highlight-face ((t (:background "sea green")))) - (speedbar-selected-face ((t (:underline t)))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (strokes-char-face ((t (:background "lightgray")))) - (swbuff-current-buffer-face ((t (:bold t :foreground "gray85" :weight bold)))) - (template-message-face ((t (:bold t :weight bold)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t :weight bold)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default ((t (:background "gray80" :foreground "gray30" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (tex-math-face ((t (:foreground "RosyBrown")))) - (texinfo-heading-face ((t (:foreground "Blue")))) - (text-cursor ((t (:background "Red3" :foreground "gray80")))) - (tool-bar ((t (:background "grey75" :foreground "black")))) - (toolbar ((t (:background "Gray80")))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) - (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) - (vertical-divider ((t (:background "Gray80")))) - (vhdl-font-lock-attribute-face ((t (:foreground "gray85")))) - (vhdl-font-lock-directive-face ((t (:foreground "gray85")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "gray85")))) - (vhdl-font-lock-function-face ((t (:foreground "gray85")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "gray85" :weight bold)))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "gray85" :weight bold)))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "gray85")))) - (vhdl-speedbar-architecture-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-configuration-face ((t (:foreground "gray85")))) - (vhdl-speedbar-configuration-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-entity-face ((t (:foreground "gray85")))) - (vhdl-speedbar-entity-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-instantiation-face ((t (:foreground "gray85")))) - (vhdl-speedbar-instantiation-selected-face ((t (:foreground "gray85" :underline t)))) - (vhdl-speedbar-package-face ((t (:foreground "gray85")))) - (vhdl-speedbar-package-selected-face ((t (:foreground "gray85" :underline t)))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (vm-header-content-face ((t (:italic t :foreground "wheat" :slant italic)))) - (vm-header-from-face ((t (:italic t :foreground "wheat" :slant italic)))) - (vm-header-name-face ((t (:foreground "cyan")))) - (vm-header-subject-face ((t (:foreground "cyan")))) - (vm-header-to-face ((t (:italic t :foreground "cyan" :slant italic)))) - (vm-message-cited-face ((t (:foreground "Gray80")))) - (vm-monochrome-image ((t (:background "white" :foreground "gray30")))) - (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) - (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) - (vm-summary-highlight-face ((t (:foreground "White")))) - (vm-xface ((t (:background "white" :foreground "gray30")))) - (vmpc-pre-sig-face ((t (:foreground "gray85")))) - (vmpc-sig-face ((t (:foreground "gray85")))) - (vvb-face ((t (:background "pink" :foreground "gray30")))) - (w3m-anchor-face ((t (:bold t :foreground "gray85" :weight bold)))) - (w3m-arrived-anchor-face ((t (:bold t :foreground "gray85" :weight bold)))) - (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) - (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) - (white ((t (:foreground "white")))) - (widget ((t (nil)))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "gray85")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85" :foreground "gray30")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "dim gray" :foreground "white")))) - (woman-addition-face ((t (:foreground "orange")))) - (woman-bold-face ((t (:bold t :weight bold)))) - (woman-italic-face ((t (:foreground "beige")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (x-face ((t (:background "white" :foreground "gray30")))) - (xrdb-option-name-face ((t (:foreground "gray85")))) - (xref-keyword-face ((t (:foreground "gray85")))) - (xref-list-default-face ((t (nil)))) - (xref-list-pilot-face ((t (:foreground "gray85")))) - (xref-list-symbol-face ((t (:foreground "navy")))) - (xsl-fo-alternate-face ((t (:foreground "Yellow")))) - (xsl-fo-main-face ((t (:foreground "PaleGreen")))) - (xsl-other-element-face ((t (:foreground "Coral")))) - (xsl-xslt-alternate-face ((t (:foreground "LightGray")))) - (xsl-xslt-main-face ((t (:foreground "Wheat")))) - (xxml-emph-1-face ((t (:background "lightyellow")))) - (xxml-emph-2-face ((t (:background "lightyellow")))) - (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) - (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) - (xxml-header-3-face ((t (:background "seashell1")))) - (xxml-header-4-face ((t (:background "seashell1")))) - (xxml-interaction-face ((t (:background "lightcyan")))) - (xxml-rug-face ((t (:background "cyan")))) - (xxml-sparkle-face ((t (:background "yellow")))) - (xxml-unbreakable-space-face ((t (:foreground "grey" :underline t)))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "Cyan4"))))))) - -(defun color-theme-blue-mood () - "Color theme by Nelson Loyola, created 2002-04-15. -Includes cperl, custom, font-lock, p4, speedbar, widget." - (interactive) - (color-theme-install - '(color-theme-blue-mood - ((background-color . "DodgerBlue4") - (background-mode . dark) - (background-toolbar-color . "#bfbfbfbfbfbf") - (border-color . "Blue") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#6c6c68686868") - (cursor-color . "DarkGoldenrod1") - (foreground-color . "white smoke") - (mouse-color . "black") - (top-toolbar-shadow-color . "#e5e5e0e0e1e1")) - ((vc-annotate-very-old-color . "#0046FF")) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (nil)))) - (border-glyph ((t (nil)))) - (cmode-bracket-face ((t (:bold t)))) - (cperl-array-face ((t (:bold t :foreground "wheat")))) - (cperl-hash-face ((t (:bold t :foreground "chartreuse")))) - (custom-button-face ((t (nil)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:bold t :foreground "cyan")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) - (font-lock-builtin-face ((t (:bold t :foreground "wheat")))) - (font-lock-comment-face ((t (:bold t :foreground "gray72")))) - (font-lock-constant-face ((t (:bold t :foreground "cyan3")))) - (font-lock-doc-string-face ((t (:foreground "#00C000")))) - (font-lock-function-name-face ((t (:bold t :foreground "chartreuse")))) - (font-lock-keyword-face ((t (:bold t :foreground "gold1")))) - (font-lock-other-emphasized-face ((t (:bold t :foreground "gold1")))) - (font-lock-other-type-face ((t (:bold t :foreground "gold1")))) - (font-lock-preprocessor-face ((t (:foreground "plum")))) - (font-lock-reference-face ((t (:bold t :foreground "orangered")))) - (font-lock-string-face ((t (:foreground "tomato")))) - (font-lock-type-face ((t (:bold t :foreground "gold1")))) - (font-lock-variable-name-face ((t (:foreground "light yellow")))) - (font-lock-warning-face ((t (:foreground "tomato")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:size "nil" :background "#e7e3d6" :foreground" #000000")))) - (highlight ((t (:background "red" :foreground "yellow")))) - (isearch ((t (:bold t :background "pale turquoise" :foreground "blue")))) - (italic ((t (nil)))) - (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:bold t :background "gray68" :foreground "yellow")))) - (modeline ((t (:background "goldenrod" :foreground "darkblue")))) - (modeline-buffer-id ((t (:background "goldenrod" :foreground "darkblue")))) - (modeline-mousable ((t (:background "goldenrod" :foreground "darkblue")))) - (modeline-mousable-minor-mode ((t (:background "goldenrod" :foreground "darkblue")))) - (my-tab-face ((t (:background "SlateBlue1")))) - (p4-depot-added-face ((t (:foreground "steelblue1")))) - (p4-depot-deleted-face ((t (:foreground "red")))) - (p4-depot-unmapped-face ((t (:foreground "grey90")))) - (p4-diff-change-face ((t (:foreground "dark green")))) - (p4-diff-del-face ((t (:bold t :foreground "salmon")))) - (p4-diff-file-face ((t (:background "blue")))) - (p4-diff-head-face ((t (:background "blue")))) - (p4-diff-ins-face ((t (:foreground "steelblue1")))) - (paren-blink-off ((t (:foreground "DodgerBlue4")))) - (paren-match ((t (:background "red" :foreground "yellow")))) - (paren-mismatch ((t (:background "DeepPink")))) - (pointer ((t (:background "white")))) - (primary-selection ((t (:bold t :background "medium sea green")))) - (red ((t (:foreground "red")))) - (region ((t (:background "red" :foreground "yellow")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "gray91" :foreground "sienna3")))) - (show-paren-match-face ((t (:background "cyan3" :foreground "blue")))) - (show-paren-mismatch-face ((t (:background "red" :foreground "blue")))) - (show-trailing-whitespace ((t (:background "red" :foreground "blue")))) - (speedbar-button-face ((t (:foreground "white")))) - (speedbar-directory-face ((t (:foreground "gray")))) - (speedbar-file-face ((t (:foreground "gold1")))) - (speedbar-highlight-face ((t (:background "lightslateblue" :foreground "gold1")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "chartreuse")))) - (text-cursor ((t (:background "DarkGoldenrod1" :foreground "DodgerBlue4")))) - (toolbar ((t (:background "#e7e3d6" :foreground "#000000")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (:background "#e7e3d6" :foreground "#000000")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "white" :foreground "midnightblue"))))))) - -(defun color-theme-euphoria () - "Color theme by oGLOWo, created 2000-04-19. -Green on black theme including font-lock, speedbar, and widget." - (interactive) - (color-theme-install - '(color-theme-euphoria - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "yellow") - (foreground-color . "#00ff00") - (mouse-color . "yellow")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "black" :foreground "#00ff00" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "misc-fixed")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "yellow")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "magenta")))) - (font-lock-comment-face ((t (:foreground "deeppink")))) - (font-lock-constant-face ((t (:foreground "blue")))) - (font-lock-doc-face ((t (:foreground "cyan")))) - (font-lock-doc-string-face ((t (:foreground "cyan")))) - (font-lock-function-name-face ((t (:foreground "purple")))) - (font-lock-keyword-face ((t (:foreground "red")))) - (font-lock-preprocessor-face ((t (:foreground "blue1")))) - (font-lock-reference-face ((t (nil)))) - (font-lock-string-face ((t (:foreground "cyan")))) - (font-lock-type-face ((t (:foreground "yellow")))) - (font-lock-variable-name-face ((t (:foreground "violet")))) - (font-lock-warning-face ((t (:bold t :foreground "red" :weight bold)))) - (fringe ((t (:background "gray16" :foreground "#00ff00")))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "darkolivegreen")))) - (horizontal-divider ((t (:background "gray16" :foreground "#00ff00")))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (menu ((t (:background "gray16" :foreground "green")))) - (modeline ((t (:background "gray16" :foreground "#00ff00" :box (:line-width -1 :style released-button))))) - (modeline-buffer-id ((t (:background "gray16" :foreground "#00ff00")))) - (modeline-mousable ((t (:background "gray16" :foreground "#00ff00")))) - (modeline-mousable-minor-mode ((t (:background "gray16" :foreground "#00ff00")))) - (mouse ((t (:background "yellow")))) - (primary-selection ((t (:background "#00ff00" :foreground "black")))) - (region ((t (:background "steelblue" :foreground "white")))) - (scroll-bar ((t (:background "gray16" :foreground "#00ff00")))) - (secondary-selection ((t (:background "#00ff00" :foreground "black")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "#00ff00")))) - (speedbar-directory-face ((t (:foreground "#00ff00")))) - (speedbar-file-face ((t (:foreground "cyan")))) - (speedbar-highlight-face ((t (:background "#00ff00" :foreground "purple")))) - (speedbar-selected-face ((t (:foreground "deeppink" :underline t)))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (tool-bar ((t (:background "gray16" :foreground "green" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "gray16" :foreground "#00ff00")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (vertical-divider ((t (:background "gray16" :foreground "#00ff00")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (zmacs-region ((t (:background "steelblue" :foreground "white"))))))) - -(defun color-theme-resolve () - "Color theme by Damien Elmes, created 2002-04-24. -A white smoke on blue color theme." - (interactive) - (color-theme-install - '(color-theme-resolve - ((background-color . "#00457f") - (background-mode . dark) - (border-color . "black") - (cursor-color . "DarkGoldenrod1") - (foreground-color . "white smoke") - (mouse-color . "white")) - ((display-time-mail-face . mode-line) - (help-highlight-face . underline) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "#00457f" :foreground "white smoke" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "b&h-lucidatypewriter")))) - (bold ((t (:bold t :foreground "snow2" :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (calendar-today-face ((t (:underline t)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cperl-array-face ((t (:bold t :foreground "wheat" :weight bold)))) - (cperl-hash-face ((t (:bold t :foreground "chartreuse" :weight bold)))) - (cursor ((t (:background "DarkGoldenrod1")))) - (diary-face ((t (:foreground "yellow")))) - (erc-input-face ((t (:foreground "lightblue2")))) - (erc-notice-face ((t (:foreground "lightyellow3")))) - (fixed-pitch ((t (:family "courier")))) - (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen" :weight bold)))) - (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen" :slant italic)))) - (font-latex-math-face ((t (:foreground "burlywood")))) - (font-latex-sedate-face ((t (:foreground "LightGray")))) - (font-latex-string-face ((t (:foreground "RosyBrown")))) - (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (font-lock-builtin-face ((t (:foreground "wheat")))) - (font-lock-comment-face ((t (:foreground "light steel blue")))) - (font-lock-constant-face ((t (:foreground "seashell3")))) - (font-lock-doc-face ((t (:foreground "plum")))) - (font-lock-doc-string-face ((t (:foreground "#008000")))) - (font-lock-function-name-face ((t (:foreground "thistle1")))) - (font-lock-keyword-face ((t (:foreground "wheat")))) - (font-lock-other-emphasized-face ((t (:bold t :foreground "gold1" :weight bold)))) - (font-lock-other-type-face ((t (:bold t :foreground "gold1" :weight bold)))) - (font-lock-preprocessor-face ((t (:foreground "#800080")))) - (font-lock-reference-face ((t (:foreground "wheat")))) - (font-lock-string-face ((t (:foreground "plum")))) - (font-lock-type-face ((t (:foreground "lawn green")))) - (font-lock-variable-name-face ((t (:foreground "light yellow")))) - (font-lock-warning-face ((t (:foreground "plum")))) - (fringe ((t (:background "#000000")))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "light blue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "snow2" :slant italic)))) - (gnus-header-from-face ((t (:foreground "spring green")))) - (gnus-header-name-face ((t (:bold t :foreground "snow2" :weight bold)))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) - (gnus-header-subject-face ((t (:bold t :foreground "peach puff" :weight bold)))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:background "grey20" :foreground "grey90")))) - (highlight ((t (:background "gray91" :foreground "firebrick")))) - (highline-face ((t (:background "paleturquoise" :foreground "black")))) - (holiday-face ((t (:background "chocolate4")))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "seashell3")))) - (message-header-cc-face ((t (:bold t :foreground "snow2" :weight bold)))) - (message-header-name-face ((t (:bold t :foreground "snow1" :weight bold)))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "snow2")))) - (message-header-subject-face ((t (:bold t :foreground "snow2" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "snow2" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "misty rose")))) - (modeline ((t (:foreground "white" :background "#001040" :box (:line-width -1 :style released-button))))) - (modeline-buffer-id ((t (:foreground "white" :background "#001040")))) - (modeline-mousable ((t (:foreground "white" :background "#001040")))) - (modeline-mousable-minor-mode ((t (:foreground "white" :background "#001040")))) - (mouse ((t (:background "white")))) - (my-tab-face ((t (:background "SlateBlue1")))) - (p4-diff-del-face ((t (:bold t :foreground "salmon" :weight bold)))) - (primary-selection ((t (:background "gray91" :foreground "DodgerBlue4")))) - (region ((t (:background "gray91" :foreground "DodgerBlue4")))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "gray91" :foreground "sienna3")))) - (show-paren-match-face ((t (:background "cyan3" :foreground "blue")))) - (show-paren-mismatch-face ((t (:background "red" :foreground "blue")))) - (tool-bar ((t (:background "grey75" :foreground "black")))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "steel blue")))) - (widget-inactive-face ((t (:foreground "grey")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (zmacs-region ((t (:background "gray91" :foreground "DodgerBlue4"))))))) - -(defun color-theme-xp () - "Color theme by Girish Bharadwaj, created 2002-04-25. -Includes custom, erc, font-lock, jde, semantic, speedbar, widget." - (interactive) - (color-theme-install - '(color-theme-xp - ((background-color . "lightyellow2") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "gray20") - (mouse-color . "black")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (semantic-which-function-use-color . t) - (senator-eldoc-use-color . t) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "lightyellow2" :foreground "gray20" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (button ((t (:underline t)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (cursor ((t (:background "black")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) - (erc-action-face ((t (:bold t :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "IndianRed")))) - (erc-error-face ((t (:background "Red" :foreground "White")))) - (erc-input-face ((t (:foreground "brown")))) - (erc-inverse-face ((t (:background "Black" :foreground "White")))) - (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) - (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) - (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) - (erc-underline-face ((t (:underline t)))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "magenta3" :underline t :height 0.9)))) - (font-lock-comment-face ((t (:italic t :foreground "gray60" :slant oblique :height 0.9)))) - (font-lock-constant-face ((t (:bold t :foreground "medium purple" :weight bold :height 0.9)))) - (font-lock-function-name-face ((t (:bold t :foreground "black" :weight bold)))) - (font-lock-keyword-face ((t (:bold t :foreground "blue" :weight bold)))) - (font-lock-string-face ((t (:foreground "red" :height 0.9)))) - (font-lock-type-face ((t (:foreground "Royalblue")))) - (font-lock-variable-name-face ((t (:bold t :foreground "maroon" :weight bold :height 0.9)))) - (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (fringe ((t (:background "dodgerblue")))) - (header-line ((t (:underline "red" :overline "red" :background "grey90" :foreground "grey20" :box nil)))) - (highlight ((t (:background "darkseagreen2")))) - (isearch ((t (:background "magenta2" :foreground "lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic t :slant italic)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) - (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) - (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) - (jde-java-font-lock-api-face ((t (:foreground "dark goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "CadetBlue")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "green4")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "cadetblue" :underline t :slant normal)))) - (jde-java-font-lock-modifier-face ((t (:foreground "Orchid")))) - (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) - (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) - (jde-java-font-lock-package-face ((t (:foreground "blue3")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (menu ((t (nil)))) - (minibuffer-prompt ((t (:foreground "dark blue")))) - (modeline ((t (:background "dodgerblue" :foreground "black" :overline "red" :underline "red")))) - (modeline-buffer-id ((t (:background "dodgerblue" :foreground "black")))) - (modeline-mousable ((t (:background "dodgerblue" :foreground "black")))) - (modeline-mousable-minor-mode ((t (:background "dodgerblue" :foreground "black")))) - (mode-line-inactive ((t (:italic t :underline "red" :overline "red" :background "white" :foreground "cadetblue" :box (:line-width -1 :color "grey75") :slant oblique :weight light)))) - (mouse ((t (:background "black")))) - (primary-selection ((t (:background "lightgoldenrod2")))) - (region ((t (:background "lightgoldenrod2")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "yellow")))) - (semantic-dirty-token-face ((t (:background "lightyellow")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray25")))) - (senator-momentary-highlight-face ((t (:background "gray70")))) - (senator-read-only-face ((t (:background "#CCBBBB")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "brown")))) - (template-message-face ((t (:bold t :weight bold)))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (zmacs-region ((t (:background "lightgoldenrod2"))))))) - -(defun color-theme-gray30 () - "Color theme by Girish Bharadwaj, created 2002-04-22." - (interactive) - (color-theme-install - '(color-theme-gray30 - ((background-color . "grey30") - (background-mode . dark) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "gainsboro") - (mouse-color . "black")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (semantic-which-function-use-color . t) - (senator-eldoc-use-color . t) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "grey30" :foreground "gainsboro" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (button ((t (:underline t)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "black")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) - (erc-action-face ((t (:bold t :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "IndianRed")))) - (erc-error-face ((t (:background "Red" :foreground "White")))) - (erc-input-face ((t (:foreground "brown")))) - (erc-inverse-face ((t (:background "Black" :foreground "White")))) - (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) - (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) - (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly-face ((t (:foreground "Pink")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "LightSkyBlue" :underline t)))) - (font-lock-comment-face ((t (:italic t :foreground "lightgreen" :slant oblique)))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-function-name-face ((t (:bold t :foreground "DodgerBlue" :weight bold :height 1.05)))) - (font-lock-keyword-face ((t (:foreground "LightPink" :height 1.05)))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "yellow" :height 1.05)))) - (font-lock-variable-name-face ((t (:foreground "gold")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - (fringe ((t (:background "grey10")))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "darkolivegreen")))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) - (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) - (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) - (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "cadetblue" :underline t :slant normal)))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) - (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) - (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (menu ((t (nil)))) - (minibuffer-prompt ((t (:foreground "cyan")))) - (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (mode-line-inactive ((t (:background "grey30" :foreground "grey80" :box (:line-width -1 :color "grey40" :style nil) :weight light)))) - (mouse ((t (:background "black")))) - (primary-selection ((t (:background "blue3")))) - (region ((t (:background "blue3")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "SkyBlue4")))) - (semantic-dirty-token-face ((t (:background "lightyellow")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray30")))) - (senator-read-only-face ((t (:background "#664444")))) - (show-paren-match-face ((t (:background "steelblue3")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green3")))) - (speedbar-directory-face ((t (:foreground "light blue")))) - (speedbar-file-face ((t (:foreground "cyan")))) - (speedbar-highlight-face ((t (:background "sea green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (template-message-face ((t (:bold t :weight bold)))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (zmacs-region ((t (:background "blue3"))))))) - -(defun color-theme-dark-green () - "Color theme by ces93, created 2002-03-30." - (interactive) - (color-theme-install - '(color-theme-dark-green - ((background-mode . light) - (background-toolbar-color . "#e79ddf7ddf7d") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#8e3886178617") - (top-toolbar-shadow-color . "#ffffffffffff")) - nil - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (fringe ((t (nil)))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:background "#ffffff" :foreground "#000000")))) - (highlight ((t (:background "gray" :foreground "darkred")))) - (isearch ((t (:background "LightSlateGray" :foreground "red")))) - (italic ((t (:italic t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68")))) - (mode-line ((t (:background "LightSlateGray" :foreground "black")))) - (modeline ((t (:background "LightSlateGray" :foreground "black")))) - (modeline-buffer-id ((t (:background "LightSlateGray" :foreground "blue4")))) - (modeline-mousable ((t (:background "LightSlateGray" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "LightSlateGray" :foreground "green4")))) - (pointer ((t (:background "#ffffff" :foreground "#000000")))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray65")))) - (right-margin ((t (nil)))) - (rpm-spec-dir-face ((t (:foreground "green")))) - (rpm-spec-doc-face ((t (:foreground "magenta")))) - (rpm-spec-ghost-face ((t (:foreground "red")))) - (rpm-spec-macro-face ((t (:foreground "purple")))) - (rpm-spec-package-face ((t (:foreground "red")))) - (rpm-spec-tag-face ((t (:foreground "blue")))) - (secondary-selection ((t (:background "paleturquoise")))) - (text-cursor ((t (:background "Red3" :foreground "DarkSlateGray")))) - (tool-bar ((t (nil)))) - (toolbar ((t (:background "#ffffff" :foreground "#000000")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (:background "#ffffff" :foreground "#000000")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "darkorange" :foreground "black"))))))) - -(defun color-theme-whateveryouwant () - "Color theme by Fabien Penso, created 2002-05-02." - (interactive) - (color-theme-install - '(color-theme-whateveryouwant - ((background-color . "white") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "black") - (mouse-color . "black")) - ((cperl-here-face . font-lock-string-face) - (cperl-invalid-face . underline) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (display-time-mail-face . mode-line) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-carpal-button-face . bold) - (gnus-carpal-header-face . bold-italic) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-mouse-face . highlight) - (gnus-selected-tree-face . modeline) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (gnus-treat-display-xface . head) - (help-highlight-face . underline) - (ispell-highlight-face . flyspell-incorrect-face) - (list-matching-lines-face . bold) - (sgml-set-face . t) - (view-highlight-face . highlight) - (widget-mouse-face . highlight) - (x-face-mouse-face . highlight)) - (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) - (Info-title-1-face ((t (:bold t :weight bold :height 1.728 :family "helv")))) - (Info-title-2-face ((t (:bold t :weight bold :height 1.44 :family "helv")))) - (Info-title-3-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) - (Info-title-4-face ((t (:bold t :weight bold :family "helv")))) - (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) - (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) - (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) - (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) - (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) - (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) - (bbdb-company ((t (:italic t :slant italic)))) - (bbdb-field-name ((t (:bold t :foreground "gray40" :weight bold)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (:underline t)))) - (bold ((t (:bold t :foreground "gray40" :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (calendar-today-face ((t (:underline t)))) - (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) - (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) - (change-log-date-face ((t (:foreground "RosyBrown")))) - (change-log-email-face ((t (:foreground "DarkGoldenrod")))) - (change-log-file-face ((t (:foreground "Blue")))) - (change-log-function-face ((t (:foreground "DarkGoldenrod")))) - (change-log-list-face ((t (:foreground "Purple")))) - (change-log-name-face ((t (:foreground "CadetBlue")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cursor ((t (:background "black")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) - (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :foreground "red" :weight bold :height 1.2 :family "helv")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2 :family "helv")))) - (cvs-filename-face ((t (:foreground "blue4")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) - (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) - (cvs-msg-face ((t (:italic t :slant italic)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:foreground "red")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey50")))) - (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-function-face ((t (:foreground "grey50")))) - (diff-header-face ((t (:background "grey85")))) - (diff-hunk-header-face ((t (:background "grey85")))) - (diff-index-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "RosyBrown")))) - (dired-face-directory ((t (:foreground "Blue")))) - (dired-face-executable ((t (nil)))) - (dired-face-flagged ((t (:bold t :foreground "Red" :weight bold)))) - (dired-face-marked ((t (:bold t :foreground "Red" :weight bold)))) - (dired-face-permissions ((t (nil)))) - (dired-face-setuid ((t (nil)))) - (dired-face-socket ((t (nil)))) - (dired-face-symlink ((t (:foreground "Purple")))) - (ebrowse-default-face ((t (nil)))) - (ebrowse-file-name-face ((t (:italic t :slant italic)))) - (ebrowse-member-attribute-face ((t (:foreground "red")))) - (ebrowse-member-class-face ((t (:foreground "purple")))) - (ebrowse-progress-face ((t (:background "blue")))) - (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) - (ebrowse-tree-mark-face ((t (:foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (erc-action-face ((t (:bold t :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "LightSalmon")))) - (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (erc-input-face ((t (:foreground "Beige")))) - (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) - (erc-notice-face ((t (:foreground "MediumAquamarine")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:foreground "MediumAquamarine")))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-picture-face ((t (:foreground "Violet")))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "#aa0000" :weight bold :width condensed :family "neep-alt")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) - (excerpt ((t (:italic t :slant italic)))) - (fixed ((t (:bold t :weight bold)))) - (fixed-pitch ((t (:family "courier")))) - (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) - (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) - (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen" :weight bold)))) - (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen" :slant italic)))) - (font-latex-math-face ((t (:foreground "SaddleBrown")))) - (font-latex-sedate-face ((t (:foreground "DimGray")))) - (font-latex-string-face ((t (:foreground "RosyBrown")))) - (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (font-lock-builtin-face ((t (:foreground "dodgerblue3")))) - (font-lock-comment-face ((t (:foreground "#cc0000" :width semi-condensed :family "helvetica")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-doc-face ((t (:foreground "RosyBrown")))) - (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) - (font-lock-function-name-face ((t (:bold t :foreground "navy" :weight bold :height 100)))) - (font-lock-keyword-face ((t (:bold t :foreground "red4" :weight bold)))) - (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) - (font-lock-reference-face ((t (:foreground "Orchid")))) - (font-lock-string-face ((t (:foreground "navy")))) - (font-lock-type-face ((t (:bold t :foreground "black" :weight bold)))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-warning-face ((t (:foreground "orange2")))) - (fringe ((t (:background "white")))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "red" :weight normal :height 120 :family "courier")))) - (gnus-group-news-1-face ((t (:foreground "red" :weight normal :height 120 :family "courier")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-header-content-face ((t (:foreground "goldenrod" :slant normal :family "helvetica")))) - (gnus-header-from-face ((t (:bold t :foreground "grey75" :weight bold :height 140 :family "helvetica")))) - (gnus-header-name-face ((t (:foreground "grey75" :height 120 :family "helvetica")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) - (gnus-header-subject-face ((t (:bold t :foreground "firebrick" :weight bold :height 160 :family "helvetica")))) - (gnus-picon-face ((t (:background "white" :foreground "black")))) - (gnus-picon-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "grey65" :height 110 :width condensed :family "neep")))) - (gnus-summary-normal-read-face ((t (:foreground "grey75" :height 110 :width condensed :family "neep")))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick" :weight bold :height 110 :width condensed :family "neep")))) - (gnus-summary-normal-unread-face ((t (:foreground "firebrick" :height 110 :width condensed :family "neep")))) - (gnus-summary-selected-face ((t (:background "gold" :foreground "black" :box (:line-width 1 :color "yellow" :style released-button) :height 140 :width condensed :family "neep")))) - (header-line ((t (:background "grey90" :foreground "grey20" :box nil)))) - (hi-black-b ((t (:bold t :weight bold)))) - (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) - (hi-blue ((t (:background "light blue")))) - (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) - (hi-green ((t (:background "green")))) - (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) - (hi-pink ((t (:background "pink")))) - (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) - (hi-yellow ((t (:background "yellow")))) - (highlight ((t (:background "black" :foreground "white")))) - (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "gray80")))) - (holiday-face ((t (:background "pink")))) - (idlwave-help-link-face ((t (:foreground "Blue")))) - (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) - (info-header-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) - (info-header-xref ((t (:bold t :foreground "magenta4" :weight bold)))) - (info-menu-5 ((t (:foreground "red1")))) - (info-menu-header ((t (:bold t :weight bold :family "helv")))) - (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) - (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) - (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic t :slant italic)))) - (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) - (log-view-message-face ((t (:background "grey85")))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "grey45" :weight normal :family "helvetica")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "grey60" :weight bold :height 120 :family "helvetica")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (mode-line ((t (:background "grey90" :foreground "black" :box (:line-width 1 :style none) :width condensed :family "neep")))) - (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button) :weight bold)))) - (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (mouse ((t (:background "black")))) - (mpg123-face-cur ((t (:background "#004080" :foreground "yellow")))) - (mpg123-face-slider ((t (:background "yellow" :foreground "black")))) - (primary-selection ((t (:background "lightgoldenrod2")))) - (reb-match-0 ((t (:background "lightblue")))) - (reb-match-1 ((t (:background "aquamarine")))) - (reb-match-2 ((t (:background "springgreen")))) - (reb-match-3 ((t (:background "yellow")))) - (region ((t (:background "#aa0000" :foreground "white")))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "yellow")))) - (sgml-comment-face ((t (:italic t :foreground "SeaGreen" :slant italic)))) - (sgml-doctype-face ((t (:bold t :foreground "FireBrick" :weight bold)))) - (sgml-end-tag-face ((t (:stipple nil :background "white" :foreground "SlateBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) - (sgml-entity-face ((t (:stipple nil :background "SlateBlue" :foreground "Red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) - (sgml-ignored-face ((t (nil)))) - (sgml-ms-end-face ((t (nil)))) - (sgml-ms-start-face ((t (nil)))) - (sgml-pi-face ((t (:bold t :foreground "gray40" :weight bold)))) - (sgml-sgml-face ((t (:bold t :foreground "gray40" :weight bold)))) - (sgml-short-ref-face ((t (nil)))) - (sgml-shortref-face ((t (:bold t :foreground "gray40" :weight bold)))) - (sgml-start-tag-face ((t (:stipple nil :background "white" :foreground "SlateBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) - (sh-heredoc-face ((t (:foreground "tan")))) - (show-paren-match-face ((t (:background "gray80" :foreground "black")))) - (show-paren-mismatch-face ((t (:background "red" :foreground "yellow")))) - (show-tabs-space-face ((t (:foreground "yellow")))) - (show-tabs-tab-face ((t (:foreground "red")))) - (smerge-base-face ((t (:foreground "red")))) - (smerge-markers-face ((t (:background "grey85")))) - (smerge-mine-face ((t (:foreground "blue")))) - (smerge-other-face ((t (:foreground "darkgreen")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "brown")))) - (strokes-char-face ((t (:background "lightgray")))) - (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) - (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (tex-math-face ((t (:foreground "RosyBrown")))) - (texinfo-heading-face ((t (:foreground "Blue")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:foreground "navy" :underline t)))) - (variable-pitch ((t (:family "helv")))) - (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (woman-addition-face ((t (:foreground "orange")))) - (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) - (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) - (woman-unknown-face ((t (:foreground "brown")))) - (zmacs-region ((t (:background "lightgoldenrod2"))))))) - -(defun color-theme-bharadwaj-slate () - "Color theme by Girish Bharadwaj, created 2002-05-06." - (interactive) - (color-theme-install - '(color-theme-bharadwaj-slate - ((background-color . "DarkSlateGray") - (background-mode . dark) - (border-color . "black") - (cursor-color . "khaki") - (foreground-color . "palegreen") - (mouse-color . "black")) - ((display-time-mail-face . mode-line) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-mouse-face . highlight) - (help-highlight-face . underline) - (ibuffer-deletion-face . font-lock-type-face) - (ibuffer-filter-group-name-face . bold) - (ibuffer-marked-face . font-lock-warning-face) - (ibuffer-title-face . font-lock-type-face) - (list-matching-lines-buffer-name-face . underline) - (list-matching-lines-face . bold) - (semantic-which-function-use-color . t) - (senator-eldoc-use-color . t) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "DarkSlateGray" :foreground "palegreen" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida sans typewriter")))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (button ((t (:underline t)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "khaki")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) - (erc-action-face ((t (:bold t :box (:line-width 2 :color "grey75") :weight bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "IndianRed")))) - (erc-error-face ((t (:background "Red" :foreground "White")))) - (erc-input-face ((t (:foreground "lightblue")))) - (erc-inverse-face ((t (:background "Black" :foreground "White")))) - (erc-notice-face ((t (:bold t :foreground "dodgerblue" :weight bold)))) - (erc-prompt-face ((t (:bold t :background "black" :foreground "white" :weight bold)))) - (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-product-face ((t (:foreground "LightSalmon")))) - (eshell-ls-readonly-face ((t (:foreground "Pink")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) - (eshell-prompt-face ((t (:bold t :foreground "Pink" :weight bold)))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:bold t :foreground "pink" :weight bold :height 1.1)))) - (font-lock-comment-face ((t (:foreground "violet" :height 1.0)))) - (font-lock-constant-face ((t (:bold t :foreground "tomato" :weight bold :height 1.0)))) - (font-lock-function-name-face ((t (:bold t :foreground "DodgerBlue" :weight bold)))) - (font-lock-keyword-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (font-lock-preprocessor-face ((t (:bold t :foreground "tomato" :weight bold :height 1.0)))) - (font-lock-reference-face ((t (:bold t :foreground "pink" :weight bold :height 1.1)))) - (font-lock-string-face ((t (:foreground "red" :height 1.0)))) - (font-lock-type-face ((t (:foreground "lightblue3")))) - (font-lock-variable-name-face ((t (:bold t :foreground "gray" :weight bold :height 1.0)))) - (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - (fringe ((t (:background "DarkSlateGray")))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "light blue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "light cyan")))) - (gnus-cite-face-3 ((t (:foreground "light yellow")))) - (gnus-cite-face-4 ((t (:foreground "light pink")))) - (gnus-cite-face-5 ((t (:foreground "pale green")))) - (gnus-cite-face-6 ((t (:foreground "beige")))) - (gnus-cite-face-7 ((t (:foreground "orange")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) - (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) - (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "forest green" :slant italic)))) - (gnus-header-from-face ((t (:foreground "spring green")))) - (gnus-header-name-face ((t (:foreground "SeaGreen")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) - (gnus-header-subject-face ((t (:foreground "SeaGreen3")))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:underline "blueviolet" :overline "blueviolet" :box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "darkolivegreen")))) - (html-helper-bold-face ((t (:bold t :foreground "wheat" :weight bold)))) - (html-helper-italic-face ((t (:italic t :foreground "spring green" :slant italic)))) - (html-helper-underline-face ((t (:foreground "cornsilk" :underline t)))) - (html-tag-face ((t (:bold t :foreground "deep sky blue" :weight bold)))) - (info-menu-6 ((t (nil)))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) - (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) - (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) - (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) - (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) - (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) - (message-header-name-face ((t (:foreground "DarkGreen")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "blue3")))) - (minibuffer-prompt ((t (:foreground "cyan")))) - (mode-line ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) - (mode-line-inactive ((t (:italic t :underline "blueviolet" :overline "blueviolet" :background "white" :foreground "cadetblue" :box (:line-width -1 :color "grey75") :slant oblique :weight light)))) - (modeline ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) - (modeline-buffer-id ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) - (modeline-mousable ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) - (modeline-mousable-minor-mode ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) - (mouse ((t (:background "black")))) - (primary-selection ((t (:background "dimgray")))) - (region ((t (:background "dimgray")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "SkyBlue4")))) - (semantic-dirty-token-face ((t (:background "lightyellow")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray30")))) - (senator-read-only-face ((t (:background "#664444")))) - (show-paren-match-face ((t (:bold t :foreground "lightblue" :weight bold :height 1.1)))) - (show-paren-mismatch-face ((t (:bold t :foreground "red" :weight bold :height 1.1)))) - (show-tabs-space-face ((t (:foreground "yellow")))) - (show-tabs-tab-face ((t (:foreground "red")))) - (speedbar-button-face ((t (:foreground "green3")))) - (speedbar-directory-face ((t (:foreground "light blue")))) - (speedbar-file-face ((t (:foreground "cyan")))) - (speedbar-highlight-face ((t (:background "sea green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (template-message-face ((t (:bold t :weight bold)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (:background "black")))) - (term-blue ((t (:foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t :weight bold)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default ((t (:stipple nil :background "DarkSlateGray" :foreground "palegreen" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida sans typewriter")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-green ((t (:foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (tool-bar ((t (:background "DarkSlateGray" :foreground "White" :box (:line-width 1 :color "blue"))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray")))) - (zmacs-region ((t (:background "dimgray"))))))) - -(defun color-theme-lethe () - "Color theme by Ivica Loncar, created 2002-08-02. -Some additional X resources as suggested by the author: - -Emacs*menubar.Foreground: Yellow -Emacs*menubar.Background: #1a2b3c -Emacs*menubar.topShadowColor: gray -Emacs*menubar.bottomShadowColor: dimgray - -Some fonts I really like (note: this fonts are not highly -available): - -Emacs.default.attributeFont: -letl-*-medium-r-*-*-*-*-*-*-*-*-iso8859-2 -Emacs*menubar*Font: -etl-fixed-medium-r-normal--14-*-*-*-*-*-iso8859-1 - -Mouse fix: - -Emacs*dialog*XmPushButton.translations:#override\n\ - : Arm()\n\ - ,: Activate()\ - Disarm()\n\ - (2+): MultiArm()\n\ - (2+): MultiActivate()\n\ - : Activate()\ - Disarm()\n\ - osfSelect: ArmAndActivate()\n\ - osfActivate: ArmAndActivate()\n\ - osfHelp: Help()\n\ - ~Shift ~Meta ~Alt Return: ArmAndActivate()\n\ - : Enter()\n\ - : Leave()\n - -Bonus: do not use 3D modeline." - (interactive) - (color-theme-install - '(color-theme-lethe - ((background-color . "black") - (background-mode . dark) - (background-toolbar-color . "#000000000000") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "red") - (cursor-color . "red") - (foreground-color . "peachpuff") - (mouse-color . "red") - (top-toolbar-shadow-color . "#f5f5f5f5f5f5")) - ((buffers-tab-face . buffers-tab) - (cscope-use-face . t) - (gnus-mouse-face . highlight)) - (default ((t (nil)))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (nil)))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border ((t (nil)))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:bold t :foreground "red")))) - (button ((t (:underline t)))) - (calendar-today-face ((t (:underline t)))) - (comint-highlight-input ((t (:bold t)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cscope-file-face ((t (:foreground "blue")))) - (cscope-function-face ((t (:foreground "magenta")))) - (cscope-line-face ((t (:foreground "green")))) - (cscope-line-number-face ((t (:foreground "red")))) - (cscope-mouse-face ((t (:background "blue" :foreground "white")))) - (cursor ((t (nil)))) - (custom-button-face ((t (nil)))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black")))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t)))) - (custom-variable-tag-face ((t (:underline t :foreground "blue")))) - (cyan ((t (:foreground "cyan")))) - (diary-face ((t (:foreground "red")))) - (dired-face-boring ((t (:foreground "Gray65")))) - (dired-face-directory ((t (:bold t)))) - (dired-face-executable ((t (:foreground "SeaGreen")))) - (dired-face-flagged ((t (:background "LightSlateGray")))) - (dired-face-marked ((t (:background "PaleVioletRed")))) - (dired-face-permissions ((t (:background "grey75" :foreground "black")))) - (dired-face-setuid ((t (:foreground "Red")))) - (dired-face-socket ((t (:foreground "magenta")))) - (dired-face-symlink ((t (:foreground "cyan")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (erc-action-face ((t (:bold t)))) - (erc-bold-face ((t (:bold t)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "IndianRed")))) - (erc-error-face ((t (:background "Red" :foreground "White")))) - (erc-input-face ((t (:foreground "brown")))) - (erc-inverse-face ((t (:background "Black" :foreground "White")))) - (erc-notice-face ((t (:bold t :foreground "SlateBlue")))) - (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black")))) - (erc-timestamp-face ((t (:bold t :foreground "green")))) - (erc-underline-face ((t (:underline t)))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) - (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red")))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) - (eshell-test-ok-face ((t (:bold t :foreground "Green")))) - (excerpt ((t (:italic t)))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed ((t (:bold t)))) - (fixed-pitch ((t (:size "16")))) - (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) - (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:bold t :foreground "cyan")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-doc-face ((t (:bold t :foreground "red")))) - (font-lock-doc-string-face ((t (:bold t :foreground "red")))) - (font-lock-function-name-face ((t (:bold t :foreground "white")))) - (font-lock-keyword-face ((t (:bold t :foreground "yellow")))) - (font-lock-preprocessor-face ((t (:bold t :foreground "blue")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:bold t :foreground "magenta")))) - (font-lock-type-face ((t (:bold t :foreground "lightgreen")))) - (font-lock-variable-name-face ((t (:bold t :foreground "white")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (fringe ((t (:background "grey95")))) - (gdb-arrow-face ((t (:bold t :background "yellow" :foreground "red")))) - (gnus-cite-attribution-face ((t (:italic t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-highlight-words ((t (:foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-picons-face ((t (:background "white" :foreground "black")))) - (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) - (gnus-signature-face ((t (:italic t)))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:size "12" :background "Gray80" :foreground "black")))) - (header-line ((t (:background "grey20" :foreground "grey90")))) - (highlight ((t (:bold t :background "yellow" :foreground "red")))) - (highlight-changes-delete-face ((t (:underline t :foreground "red")))) - (highlight-changes-face ((t (:foreground "red")))) - (highline-face ((t (:background "paleturquoise")))) - (holiday-face ((t (:background "pink")))) - (hyper-apropos-documentation ((t (:foreground "#aaaaaa")))) - (hyper-apropos-heading ((t (:bold t :foreground "#999999")))) - (hyper-apropos-hyperlink ((t (:foreground "Violet")))) - (hyper-apropos-major-heading ((t (:bold t :foreground "#ff0000")))) - (hyper-apropos-section-heading ((t (:italic t :bold t :foreground "#33aa55")))) - (hyper-apropos-warning ((t (:bold t :foreground "red")))) - (info-menu-5 ((t (:underline t)))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "paleturquoise")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:italic t)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) - (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) - (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) - (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) - (jde-java-font-lock-italic-face ((t (:italic t)))) - (jde-java-font-lock-link-face ((t (:underline t :foreground "cadetblue")))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) - (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) - (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68")))) - (magenta ((t (:foreground "magenta")))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (nil)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:bold t :foreground "cyan")))) - (message-separator-face ((t (:foreground "brown")))) - (minibuffer-prompt ((t (:foreground "cyan")))) - (mode-line ((t (:background "grey75" :foreground "black")))) - (mode-line-inactive ((t (:background "grey30" :foreground "grey80")))) - (modeline ((t (:bold t :background "red" :foreground "yellow")))) - (modeline-buffer-id ((t (:bold t :background "red" :foreground "yellow")))) - (modeline-mousable ((t (:background "red" :foreground "yellow")))) - (modeline-mousable-minor-mode ((t (:background "red" :foreground "green4")))) - (mouse ((t (nil)))) - (paren-blink-off ((t (:foreground "black")))) - (paren-match ((t (:bold t :background "yellow" :foreground "red")))) - (paren-mismatch ((t (:background "DeepPink")))) - (pointer ((t (nil)))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray75")))) - (right-margin ((t (nil)))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (semantic-dirty-token-face ((t (:background "lightyellow")))) - (semantic-unmatched-syntax-face ((t (nil)))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray30")))) - (senator-read-only-face ((t (:background "#664444")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:underline t :foreground "red")))) - (speedbar-tag-face ((t (:foreground "brown")))) - (template-message-face ((t (:bold t)))) - (term-black ((t (:foreground "black")))) - (term-blackbg ((t (nil)))) - (term-blue ((t (:foreground "blue")))) - (term-blue-bold-face ((t (:bold t :foreground "blue")))) - (term-blue-face ((t (:foreground "blue")))) - (term-blue-inv-face ((t (:background "blue")))) - (term-blue-ul-face ((t (:underline t :foreground "blue")))) - (term-bluebg ((t (:background "blue")))) - (term-bold ((t (:bold t)))) - (term-cyan ((t (:foreground "cyan")))) - (term-cyan-bold-face ((t (:bold t :foreground "cyan")))) - (term-cyan-face ((t (:foreground "cyan")))) - (term-cyan-inv-face ((t (:background "cyan")))) - (term-cyan-ul-face ((t (:underline t :foreground "cyan")))) - (term-cyanbg ((t (:background "cyan")))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-bold-face ((t (:bold t)))) - (term-default-face ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-default-inv-face ((t (:background "peachpuff" :foreground "black")))) - (term-default-ul-face ((t (:underline t)))) - (term-green ((t (:foreground "green")))) - (term-green-bold-face ((t (:bold t :foreground "green")))) - (term-green-face ((t (:foreground "green")))) - (term-green-inv-face ((t (:background "green")))) - (term-green-ul-face ((t (:underline t :foreground "green")))) - (term-greenbg ((t (:background "green")))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (:foreground "magenta")))) - (term-magenta-bold-face ((t (:bold t :foreground "magenta")))) - (term-magenta-face ((t (:foreground "magenta")))) - (term-magenta-inv-face ((t (:background "magenta")))) - (term-magenta-ul-face ((t (:underline t :foreground "magenta")))) - (term-magentabg ((t (:background "magenta")))) - (term-red ((t (:foreground "red")))) - (term-red-bold-face ((t (:bold t :foreground "red")))) - (term-red-face ((t (:foreground "red")))) - (term-red-inv-face ((t (:background "red")))) - (term-red-ul-face ((t (:underline t :foreground "red")))) - (term-redbg ((t (:background "red")))) - (term-underline ((t (:underline t)))) - (term-white ((t (:foreground "white")))) - (term-white-bold-face ((t (:bold t :foreground "white")))) - (term-white-face ((t (:foreground "white")))) - (term-white-inv-face ((t (nil)))) - (term-white-ul-face ((t (:underline t :foreground "white")))) - (term-whitebg ((t (:background "white")))) - (term-yellow ((t (:foreground "yellow")))) - (term-yellow-bold-face ((t (:bold t :foreground "yellow")))) - (term-yellow-face ((t (:foreground "yellow")))) - (term-yellow-inv-face ((t (:background "yellow")))) - (term-yellow-ul-face ((t (:underline t :foreground "yellow")))) - (term-yellowbg ((t (:background "yellow")))) - (text-cursor ((t (:background "red" :foreground "black")))) - (tool-bar ((t (:background "grey75" :foreground "black")))) - (toolbar ((t (:background "Gray80" :foreground "black")))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (nil)))) - (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) - (vertical-divider ((t (:background "Gray80" :foreground "black")))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (white ((t (:foreground "white")))) - (widget ((t (:size "12" :background "Gray80" :foreground "black")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (nil)))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (x-face ((t (:bold t :background "wheat" :foreground "black")))) - (xrdb-option-name-face ((t (:bold t :foreground "yellow")))) - (xrdb-option-value-face ((t (:bold t :foreground "magenta")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "white" :foreground "black"))))))) - -(defun color-theme-shaman () - "Color theme by shaman, created 2002-11-11." - (interactive) - (color-theme-install - '(color-theme-shaman - ((background-color . "#456345") - (background-mode . dark) - (background-toolbar-color . "#cf3ccf3ccf3c") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#79e77df779e7") - (foreground-color . "White") - (top-toolbar-shadow-color . "#f7defbeef7de")) - ((buffers-tab-face . buffers-tab)) - (default ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t :size "12")))) - (bold-italic ((t (:italic t :bold t :size "12")))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (:background "Gray80" :foreground "black")))) - (font-lock-builtin-face ((t (:foreground "cadetblue2")))) - (font-lock-comment-face ((t (:foreground "gray80")))) - (font-lock-constant-face ((t (:foreground "steelblue1")))) - (font-lock-doc-face ((t (:foreground "light coral")))) - (font-lock-doc-string-face ((t (:foreground "light coral")))) - (font-lock-function-name-face ((t (:foreground "aquamarine")))) - (font-lock-keyword-face ((t (:foreground "cyan")))) - (font-lock-preprocessor-face ((t (:foreground "steelblue1")))) - (font-lock-reference-face ((t (:foreground "cadetblue2")))) - (font-lock-string-face ((t (:foreground "tan")))) - (font-lock-type-face ((t (:foreground "wheat")))) - (font-lock-variable-name-face ((t (:foreground "cyan3")))) - (font-lock-warning-face ((t (:bold t :size "12" :foreground "Pink")))) - (fringe ((t (nil)))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75" :foreground "black")))) - (gui-element ((t (:size "12" :background "Gray80" :foreground "black")))) - (highlight ((t (:background "darkseagreen2")))) - (isearch ((t (:background "paleturquoise")))) - (isearch-secondary ((t (:foreground "red3")))) - (italic ((t (:italic t :size "12")))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68")))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:bold t :foreground "green4")))) - (message-header-name-face ((t (:foreground "DarkGreen")))) - (message-header-newsgroups-face ((t (:bold t :foreground "yellow")))) - (message-header-other-face ((t (:foreground "#b00000")))) - (message-header-subject-face ((t (:foreground "green3")))) - (message-header-to-face ((t (:bold t :foreground "green2")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "blue3")))) - (mode-line ((t (:background "Gray80" :foreground "black")))) - (modeline ((t (:background "Gray80" :foreground "black")))) - (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) - (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) - (pointer ((t (:foreground "White")))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray65")))) - (right-margin ((t (nil)))) - (rpm-spec-dir-face ((t (:foreground "green")))) - (rpm-spec-doc-face ((t (:foreground "magenta")))) - (rpm-spec-ghost-face ((t (:foreground "red")))) - (rpm-spec-macro-face ((t (:foreground "yellow")))) - (rpm-spec-package-face ((t (:foreground "red")))) - (rpm-spec-tag-face ((t (:foreground "blue")))) - (rpm-spec-var-face ((t (:foreground "maroon")))) - (secondary-selection ((t (:background "paleturquoise")))) - (text-cursor ((t (:background "Pink" :foreground "Black")))) - (tool-bar ((t (nil)))) - (toolbar ((t (:background "Gray80" :foreground "black")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (:background "Gray80" :foreground "black")))) - (widget ((t (:size "12" :background "Gray80" :foreground "black")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65"))))))) - -(defun color-theme-emacs-nw () - "Follow emacs21's color-theme, with -nw getting 100% compatibility. - -Alex's `color-theme-emacs-21' follows emacs21's theme, but in the -current scheme of things, that means that when it works on X, it won't -work in -nw perfectly. The modeline and menuline will have same -colors as the rest of emacs, which can be particularly disturbing when -there are multiple windows. - -OTOH, `color-theme-emacs-nw' follows emacs21's theme but the goal is -100% -nw compatibility, and in X; we shall try for decent color -scheme, and as much compability default emacs21's X as possble. -Bugs to deego@gnufans.org. - -TODO: Try to make this theme relative to color-theme-emacs-21 rather -than absolute, viz: call that first and then tweak minor stuff." - (interactive) - (color-theme-install - '(color-theme-emacs-nw - ((background-color . "white") - (background-mode . light) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "black") - (mouse-color . "black")) - ((Man-overstrike-face . bold) - (Man-underline-face . underline) - (cperl-here-face . font-lock-string-face) - (cperl-invalid-face . underline) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-mouse-face . highlight) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (help-highlight-face . underline) - (idlwave-class-arrow-face . bold) - (idlwave-shell-breakpoint-face . idlwave-shell-bp-face) - (idlwave-shell-expression-face . secondary-selection) - (idlwave-shell-stop-line-face . highlight) - (ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (viper-insert-state-cursor-color . "Green") - (viper-replace-overlay-cursor-color . "Red") - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) - (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) - (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) - (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) - (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) - (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) - (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) - (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) - (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) - (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (calendar-today-face ((t (:underline t)))) - (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) - (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) - (change-log-date-face ((t (:foreground "RosyBrown")))) - (change-log-email-face ((t (:foreground "DarkGoldenrod")))) - (change-log-file-face ((t (:foreground "Blue")))) - (change-log-function-face ((t (:foreground "DarkGoldenrod")))) - (change-log-list-face ((t (:foreground "Purple")))) - (change-log-name-face ((t (:foreground "CadetBlue")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) - (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) - (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) - (cursor ((t (:background "black")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "gray85")))) - (custom-comment-tag-face ((t (:foreground "blue4")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) - (cvs-filename-face ((t (:foreground "blue4")))) - (cvs-handled-face ((t (:foreground "pink")))) - (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) - (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) - (cvs-msg-face ((t (:italic t :slant italic)))) - (cvs-need-action-face ((t (:foreground "orange")))) - (cvs-unknown-face ((t (:foreground "red")))) - (diary-face ((t (:foreground "red")))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (:foreground "grey50")))) - (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) - (diff-function-face ((t (:foreground "grey50")))) - (diff-header-face ((t (:background "grey85")))) - (diff-hunk-header-face ((t (:background "grey85")))) - (diff-index-face ((t (:bold t :weight bold :background "grey70")))) - (diff-nonexistent-face ((t (:bold t :weight bold :background "grey70")))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (:foreground "RosyBrown")))) - (dired-face-directory ((t (:foreground "Blue")))) - (dired-face-executable ((t (nil)))) - (dired-face-flagged ((t (:foreground "Red" :weight bold)))) - (dired-face-marked ((t (:foreground "Red" :weight bold)))) - (dired-face-permissions ((t (nil)))) - (dired-face-setuid ((t (nil)))) - (dired-face-socket ((t (nil)))) - (dired-face-symlink ((t (:foreground "Purple")))) - (ebrowse-default-face ((t (nil)))) - (ebrowse-file-name-face ((t (:italic t :slant italic)))) - (ebrowse-member-attribute-face ((t (:foreground "red")))) - (ebrowse-member-class-face ((t (:foreground "purple")))) - (ebrowse-progress-face ((t (:background "blue")))) - (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) - (ebrowse-tree-mark-face ((t (:foreground "red")))) - (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) - (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) - (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) - (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) - (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) - (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) - (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) - (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) - (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) - (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) - (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) - (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) - (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) - (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) - (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) - (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-ls-product-face ((t (:foreground "OrangeRed")))) - (eshell-ls-readonly-face ((t (:foreground "Brown")))) - (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) - (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) - (eshell-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) - (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) - (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) - (excerpt ((t (:italic t :slant italic)))) - (fixed ((t (:bold t :weight bold)))) - (fixed-pitch ((t (:family "courier")))) - (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) - (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) - (font-lock-builtin-face ((t (:foreground "Orchid")))) - (font-lock-comment-face ((t (:foreground "Firebrick")))) - (font-lock-constant-face ((t (:foreground "CadetBlue")))) - (font-lock-doc-face ((t (:foreground "RosyBrown")))) - (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) - (font-lock-function-name-face ((t (:foreground "Blue")))) - (font-lock-keyword-face ((t (:foreground "Purple")))) - (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) - (font-lock-reference-face ((t (:foreground "Orchid")))) - (font-lock-string-face ((t (:foreground "RosyBrown")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (fringe ((t (:background "grey95")))) - (gnus-cite-attribution-face ((t (:italic t :slant italic)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) - (gnus-header-from-face ((t (:foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) - (gnus-header-subject-face ((t (:foreground "red4")))) - (gnus-signature-face ((t (:italic t :slant italic)))) - (gnus-splash-face ((t (:foreground "Brown")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) - (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) - (hi-black-b ((t (:bold t :weight bold)))) - (hi-black-hb ((t (:bold t :family "helv" :weight bold :height 1.67)))) - (hi-blue ((t (:background "light blue")))) - (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) - (hi-green ((t (:background "green")))) - (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) - (hi-pink ((t (:background "pink")))) - (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) - (hi-yellow ((t (:background "yellow")))) - (highlight ((t (:background "darkseagreen2")))) - (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) - (highlight-changes-face ((t (:foreground "red")))) - (holiday-face ((t (:background "pink")))) - (idlwave-help-link-face ((t (:foreground "Blue")))) - (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) - (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "brown")))) - (info-header-xref ((t (:bold t :weight bold :foreground "magenta4")))) - (info-menu-5 ((t (:foreground "red1")))) - (info-menu-header ((t (:bold t :family "helv" :weight bold)))) - (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) - (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) - (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic t :slant italic)))) - (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) - (log-view-message-face ((t (:background "grey85")))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue" :weight bold)))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (mode-line ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) - (modeline ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) - (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (mouse ((t (:background "black")))) - (primary-selection ((t (:background "lightgoldenrod2")))) - (reb-match-0 ((t (:background "lightblue")))) - (reb-match-1 ((t (:background "aquamarine")))) - (reb-match-2 ((t (:background "springgreen")))) - (reb-match-3 ((t (:background "yellow")))) - (region ((t (:background "lightgoldenrod2")))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "yellow")))) - (sh-heredoc-face ((t (:foreground "tan")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (show-tabs-space-face ((t (:foreground "yellow")))) - (show-tabs-tab-face ((t (:foreground "red")))) - (smerge-base-face ((t (:foreground "red")))) - (smerge-markers-face ((t (:background "grey85")))) - (smerge-mine-face ((t (:foreground "blue")))) - (smerge-other-face ((t (:foreground "darkgreen")))) - (speedbar-button-face ((t (:foreground "green4")))) - (speedbar-directory-face ((t (:foreground "blue4")))) - (speedbar-file-face ((t (:foreground "cyan4")))) - (speedbar-highlight-face ((t (:background "green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-tag-face ((t (:foreground "brown")))) - (strokes-char-face ((t (:background "lightgray")))) - (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) - (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) - (tex-math-face ((t (:foreground "RosyBrown")))) - (texinfo-heading-face ((t (:foreground "Blue")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) - (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) - (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) - (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) - (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) - (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) - (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) - (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) - (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) - (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) - (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) - (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) - (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) - (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) - (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) - (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) - (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) - (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) - (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) - (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) - (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) - (viper-search-face ((t (:background "khaki" :foreground "Black")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85")))) - (woman-addition-face ((t (:foreground "orange")))) - (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) - (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) - (woman-unknown-face ((t (:foreground "brown")))) - (zmacs-region ((t (:background "lightgoldenrod2"))))))) - -(defun color-theme-late-night () - "Color theme by Alex Schroeder, created 2003-08-07. -This theme is for use late at night, with only little light in the room. -The goal was to make something as dark and subtle as the text console in -its default 80x25 state -- dark grey on black." - (interactive) - (let ((color-theme-is-cumulative t)) - (color-theme-dark-erc) - (color-theme-dark-gnus) - ;; (color-theme-dark-diff) - ;; (color-theme-dark-eshell) - (color-theme-dark-info) - (color-theme-dark-font-lock) - (color-theme-install - '(color-theme-late-night - ((background-color . "#000") - (background-mode . dark) - (background-toolbar-color . "#000") - (border-color . "#000") - (bottom-toolbar-shadow-color . "#000") - (cursor-color . "#888") - (foreground-color . "#666") - (top-toolbar-shadow-color . "#111")) - (default ((t (nil)))) - (bold ((t (:bold t)))) - (button ((t (:bold t)))) - (custom-button-face ((t (:bold t :foreground "#999")))) - (fringe ((t (:background "#111" :foreground "#444")))) - (header-line ((t (:background "#333" :foreground "#000")))) - (highlight ((t (:background "dark slate blue" :foreground "light blue")))) - (holiday-face ((t (:background "#000" :foreground "#777")))) - (isearch ((t (:foreground "pink" :background "red")))) - (isearch-lazy-highlight-face ((t (:foreground "red")))) - (italic ((t (:bold t)))) - (menu ((t (:background "#111" :foreground "#444")))) - (minibuffer-prompt ((t (:foreground "555")))) - (modeline ((t (:background "#111" :foreground "#444")))) - (mode-line-inactive ((t (:background "#000" :foreground "#444")))) - (modeline-buffer-id ((t (:background "#000" :foreground "#555")))) - (modeline-mousable ((t (:background "#000" :foreground "#555")))) - (modeline-mousable-minor-mode ((t (:background "#000" :foreground "#555")))) - (region ((t (:background "dark cyan" :foreground "cyan")))) - (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) - (show-paren-match-face ((t (:foreground "white" :background "light slate blue")))) - (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) - (tool-bar ((t (:background "#111" :foreground "#777")))) - (tooltip ((t (:background "#333" :foreground "#777")))) - (underline ((t (:bold t)))) - (variable-pitch ((t (nil)))) - (widget-button-face ((t (:bold t :foreground "#888")))) - (widget-field-face ((t (:bold t :foreground "#999")))))))) - -(defun color-theme-clarity () - "White on black color theme by Richard Wellum, created 2003-01-16." - (interactive) - (color-theme-install - '(color-theme-clarity - ((background-color . "black") - (background-mode . dark) - (border-color . "white") - (cursor-color . "yellow") - (foreground-color . "white") - (mouse-color . "white")) - ((CUA-mode-global-mark-cursor-color . "cyan") - (CUA-mode-normal-cursor-color . "yellow") - (CUA-mode-overwrite-cursor-color . "red") - (CUA-mode-read-only-cursor-color . "green") - (help-highlight-face . underline) - (ibuffer-dired-buffer-face . font-lock-function-name-face) - (ibuffer-help-buffer-face . font-lock-comment-face) - (ibuffer-hidden-buffer-face . font-lock-warning-face) - (ibuffer-occur-match-face . font-lock-warning-face) - (ibuffer-read-only-buffer-face . font-lock-type-face) - (ibuffer-special-buffer-face . font-lock-keyword-face) - (ibuffer-title-face . font-lock-type-face) - (list-matching-lines-face . bold) - (ps-line-number-color . "black") - (ps-zebra-color . 0.95) - (tags-tag-face . default) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (nil)))) - (CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) - (CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) - (CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "white")))) - (clearcase-dired-checkedout-face ((t (:foreground "red")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cursor ((t (:background "yellow")))) - (fixed-pitch ((t (:family "courier")))) - (flash-paren-face-off ((t (nil)))) - (flash-paren-face-on ((t (nil)))) - (flash-paren-face-region ((t (nil)))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "OrangeRed")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-face ((t (:foreground "LightSalmon")))) - (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - (fringe ((t (:background "grey10")))) - (header-line ((t (:box (:line-width -1 :style released-button) :foreground "grey20" :background "grey90" :box nil)))) - (highlight ((t (:background "darkolivegreen")))) - (ibuffer-deletion-face ((t (:foreground "red")))) - (ibuffer-marked-face ((t (:foreground "green")))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (menu ((t (nil)))) - (mode-line ((t (:foreground "yellow" :background "darkslateblue" :box (:line-width -1 :style released-button))))) - (mouse ((t (:background "white")))) - (region ((t (:background "blue")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "darkslateblue")))) - (show-block-face1 ((t (:background "gray10")))) - (show-block-face2 ((t (:background "gray15")))) - (show-block-face3 ((t (:background "gray20")))) - (show-block-face4 ((t (:background "gray25")))) - (show-block-face5 ((t (:background "gray30")))) - (show-block-face6 ((t (:background "gray35")))) - (show-block-face7 ((t (:background "gray40")))) - (show-block-face8 ((t (:background "gray45")))) - (show-block-face9 ((t (:background "gray50")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray"))))))) - -(defun color-theme-andreas () - "Color theme by Andreas Busch, created 2003-02-06." - (interactive) - (color-theme-install - '(color-theme-andreas - ((background-mode . light) - (background-color . "white") - (background-toolbar-color . "#cccccccccccc") - (border-color . "#000000000000") - (bottom-toolbar-shadow-color . "#7a7a7a7a7a7a") - (foreground-color . "black") - (top-toolbar-shadow-color . "#f5f5f5f5f5f5")) - ((gnus-mouse-face . highlight) - (ispell-highlight-face . highlight)) - (default ((t (nil)))) - (OrangeRed ((t (nil)))) - (blue ((t (:foreground "blue")))) - (bold ((t (:bold t)))) - (bold-italic ((t (:italic t :bold t)))) - (border-glyph ((t (nil)))) - (calendar-today-face ((t (:underline t)))) - (color-mode-face-@ ((t (:foreground "orange")))) - (color-mode-face-a ((t (:foreground "blue")))) - (color-mode-face-b ((t (:foreground "red")))) - (color-mode-face-c ((t (:foreground "green3")))) - (color-mode-face-d ((t (:background "red" :foreground "white")))) - (color-mode-face-e ((t (:background "orange" :foreground "blue")))) - (color-mode-face-f ((t (:background "blue" :foreground "yellow")))) - (color-mode-face-g ((t (:background "lightblue" :foreground "brown")))) - (color-mode-face-h ((t (:background "brown" :foreground "white")))) - (custom-button-face ((t (:bold t)))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:underline t :foreground "blue")))) - (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "dark green")))) - (custom-variable-button-face ((t (:underline t :bold t :background "gray90")))) - (custom-variable-tag-face ((t (:underline t :background "gray95" :foreground "blue")))) - (diary-face ((t (:foreground "red")))) - (display-time-mail-balloon-enhance-face ((t (:background "orange")))) - (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) - (display-time-time-balloon-face ((t (:foreground "red")))) - (emacs-wiki-bad-link-face ((t (:bold t :foreground "red")))) - (emacs-wiki-link-face ((t (:bold t :foreground "green")))) - (font-lock-comment-face ((t (:foreground "orange1")))) - (font-lock-doc-string-face ((t (:foreground "green4")))) - (font-lock-function-name-face ((t (:foreground "blue3")))) - (font-lock-keyword-face ((t (:foreground "red1")))) - (font-lock-preprocessor-face ((t (:foreground "blue3")))) - (font-lock-reference-face ((t (:foreground "red3")))) - (font-lock-string-face ((t (:foreground "green4")))) - (font-lock-type-face ((t (:foreground "#6920ac")))) - (font-lock-variable-name-face ((t (:foreground "blue3")))) - (font-lock-warning-face ((t (:bold t :foreground "Red")))) - (gnu-cite-face-3 ((t (nil)))) - (gnu-cite-face-4 ((t (nil)))) - (gnus-cite-attribution-face ((t (:underline t)))) - (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) - (gnus-cite-face-10 ((t (:foreground "medium purple")))) - (gnus-cite-face-11 ((t (:foreground "turquoise")))) - (gnus-cite-face-2 ((t (:foreground "firebrick")))) - (gnus-cite-face-3 ((t (:foreground "dark green")))) - (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "dark violet")))) - (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) - (gnus-cite-face-8 ((t (:foreground "magenta")))) - (gnus-cite-face-9 ((t (:foreground "violet")))) - (gnus-emphasis-bold ((t (:bold t)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) - (gnus-emphasis-italic ((t (:italic t)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) - (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) - (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) - (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) - (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) - (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) - (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) - (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) - (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) - (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) - (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t)))) - (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) - (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) - (gnus-header-from-face ((t (:bold t :foreground "red3")))) - (gnus-header-name-face ((t (:foreground "maroon")))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) - (gnus-header-subject-face ((t (:bold t :foreground "red4")))) - (gnus-splash-face ((t (:foreground "red")))) - (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) - (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "DarkRed")))) - (gnus-summary-high-unread-face ((t (:bold t)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) - (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) - (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) - (gnus-summary-low-unread-face ((t (:italic t)))) - (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) - (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) - (gnus-summary-normal-ticked-face ((t (:foreground "Red")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (gnus-x-face ((t (nil)))) - (green ((t (:foreground "green")))) - (gui-button-face ((t (:background "grey75")))) - (gui-element ((t (:background "Gray80")))) - (highlight ((t (nil)))) - (holiday-face ((t (:background "pink")))) - (hyper-apropos-documentation ((t (:foreground "darkred")))) - (hyper-apropos-heading ((t (:bold t)))) - (hyper-apropos-hyperlink ((t (:foreground "blue4")))) - (hyper-apropos-major-heading ((t (:bold t)))) - (hyper-apropos-section-heading ((t (:italic t :bold t)))) - (hyper-apropos-warning ((t (:bold t :foreground "red")))) - (info-node ((t (:italic t :bold t)))) - (info-xref ((t (:bold t)))) - (isearch ((t (:background "yellow" :foreground "red")))) - (italic ((t (:italic t)))) - (kai-gnus-cite-face-1 ((t (:foreground "LightCyan4")))) - (kai-gnus-cite-face-2 ((t (:foreground "LightSkyBlue2")))) - (kai-gnus-cite-face-3 ((t (:foreground "DodgerBlue3")))) - (kai-gnus-group-mail-face ((t (:foreground "darkslategrey")))) - (kai-gnus-group-nonempty-mail-face ((t (:foreground "DarkRed")))) - (kai-gnus-group-starred-face ((t (:foreground "grey50")))) - (left-margin ((t (nil)))) - (list-mode-item-selected ((t (:background "gray68")))) - (message-cited-text ((t (:italic t)))) - (message-cited-text-face ((t (:foreground "red")))) - (message-header-cc-face ((t (:foreground "MidnightBlue")))) - (message-header-contents ((t (:italic t)))) - (message-header-name-face ((t (:foreground "cornflower blue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) - (message-header-other-face ((t (:foreground "steel blue")))) - (message-header-subject-face ((t (:bold t :foreground "navy blue")))) - (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) - (message-header-xheader-face ((t (:foreground "blue")))) - (message-headers ((t (:bold t)))) - (message-highlighted-header-contents ((t (:italic t :bold t)))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "brown")))) - (modeline ((t (:background "Gray75" :foreground "Black")))) - (modeline-buffer-id ((t (:background "Gray75" :foreground "blue4")))) - (modeline-mousable ((t (:background "Gray75" :foreground "firebrick")))) - (modeline-mousable-minor-mode ((t (:background "Gray75" :foreground "green4")))) - (paren-blink-off ((t (:foreground "gray80")))) - (paren-match ((t (:background "red" :foreground "white")))) - (paren-mismatch ((t (:background "DeepPink")))) - (pointer ((t (:foreground "blue")))) - (primary-selection ((t (:background "gray65")))) - (red ((t (:foreground "red")))) - (region ((t (:background "gray75")))) - (right-margin ((t (nil)))) - (secondary-selection ((t (:background "paleturquoise")))) - (text-cursor ((t (:background "red" :foreground "LightYellow1")))) - (toolbar ((t (:background "Gray80")))) - (underline ((t (:underline t)))) - (vertical-divider ((t (:background "Gray80")))) - (widget-button-face ((t (:bold t)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (x-face ((t (:background "white")))) - (yellow ((t (:foreground "yellow")))) - (zmacs-region ((t (:background "gray65" :foreground "yellow"))))))) - -(defun color-theme-charcoal-black () - "Color theme by Lars Chr. Hausmann, created 2003-03-24." - (interactive) - (color-theme-install - '(color-theme-charcoal-black - ((background-color . "Grey15") - (background-mode . dark) - (border-color . "Grey") - (cursor-color . "Grey") - (foreground-color . "Grey") - (mouse-color . "Grey")) - ((display-time-mail-face . mode-line) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-mouse-face . highlight) - (gnus-server-agent-face . gnus-server-agent-face) - (gnus-server-closed-face . gnus-server-closed-face) - (gnus-server-denied-face . gnus-server-denied-face) - (gnus-server-offline-face . gnus-server-offline-face) - (gnus-server-opened-face . gnus-server-opened-face) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (help-highlight-face . underline) - (list-matching-lines-face . bold) - (mime-button-face . bold) - (mime-button-mouse-face . highlight) - (sgml-set-face . t) - (tags-tag-face . default) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "Grey15" :foreground "Grey" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 87 :width semi-condensed :family "misc-fixed")))) - (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) - (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) - (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) - (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) - (bg:erc-color-face0 ((t (nil)))) - (bg:erc-color-face1 ((t (nil)))) - (bg:erc-color-face10 ((t (nil)))) - (bg:erc-color-face11 ((t (nil)))) - (bg:erc-color-face12 ((t (nil)))) - (bg:erc-color-face13 ((t (nil)))) - (bg:erc-color-face14 ((t (nil)))) - (bg:erc-color-face15 ((t (nil)))) - (bg:erc-color-face2 ((t (nil)))) - (bg:erc-color-face3 ((t (nil)))) - (bg:erc-color-face4 ((t (nil)))) - (bg:erc-color-face5 ((t (nil)))) - (bg:erc-color-face6 ((t (nil)))) - (bg:erc-color-face7 ((t (nil)))) - (bg:erc-color-face8 ((t (nil)))) - (bg:erc-color-face9 ((t (nil)))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:bold t :foreground "beige" :weight bold)))) - (border ((t (:background "Grey")))) - (calendar-today-face ((t (:underline t)))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cperl-array-face ((t (:bold t :foreground "light salmon" :weight bold)))) - (cperl-hash-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) - (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) - (cursor ((t (:background "Grey")))) - (custom-button-face ((t (:foreground "gainsboro")))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (:foreground "light blue")))) - (custom-face-tag-face ((t (:underline t)))) - (custom-group-tag-face ((t (:bold t :foreground "pale turquoise" :weight bold)))) - (custom-group-tag-face-1 ((t (:foreground "pale turquoise" :underline t)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "light salmon")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (diary-face ((t (:foreground "red")))) - (dired-face-directory ((t (:bold t :foreground "sky blue" :weight bold)))) - (dired-face-executable ((t (:foreground "green yellow")))) - (dired-face-flagged ((t (:foreground "tomato")))) - (dired-face-marked ((t (:foreground "light salmon")))) - (dired-face-permissions ((t (:foreground "aquamarine")))) - (erc-action-face ((t (nil)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "pale green")))) - (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) - (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-input-face ((t (:foreground "light blue")))) - (erc-inverse-face ((t (:background "steel blue")))) - (erc-notice-face ((t (:foreground "light salmon")))) - (erc-pal-face ((t (:foreground "pale green")))) - (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) - (eshell-ls-archive-face ((t (:bold t :foreground "medium purple" :weight bold)))) - (eshell-ls-backup-face ((t (:foreground "dim gray")))) - (eshell-ls-clutter-face ((t (:foreground "dim gray")))) - (eshell-ls-directory-face ((t (:bold t :foreground "medium slate blue" :weight bold)))) - (eshell-ls-executable-face ((t (:bold t :foreground "aquamarine" :weight bold)))) - (eshell-ls-missing-face ((t (:foreground "black")))) - (eshell-ls-picture-face ((t (:foreground "violet")))) - (eshell-ls-product-face ((t (:foreground "light steel blue")))) - (eshell-ls-readonly-face ((t (:foreground "aquamarine")))) - (eshell-ls-special-face ((t (:foreground "gold")))) - (eshell-ls-symlink-face ((t (:foreground "white")))) - (eshell-ls-unreadable-face ((t (:foreground "dim gray")))) - (eshell-prompt-face ((t (:bold t :foreground "light sky blue" :weight bold)))) - (excerpt ((t (:italic t :slant italic)))) - (fg:erc-color-face0 ((t (:foreground "white")))) - (fg:erc-color-face1 ((t (:foreground "beige")))) - (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) - (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) - (fg:erc-color-face12 ((t (:foreground "light yellow")))) - (fg:erc-color-face13 ((t (:foreground "yellow")))) - (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) - (fg:erc-color-face15 ((t (:foreground "lime green")))) - (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) - (fg:erc-color-face3 ((t (:foreground "light cyan")))) - (fg:erc-color-face4 ((t (:foreground "powder blue")))) - (fg:erc-color-face5 ((t (:foreground "sky blue")))) - (fg:erc-color-face6 ((t (:foreground "dark sea green")))) - (fg:erc-color-face7 ((t (:foreground "pale green")))) - (fg:erc-color-face8 ((t (:foreground "medium spring green")))) - (fg:erc-color-face9 ((t (:foreground "khaki")))) - (fixed ((t (:bold t :weight bold)))) - (fixed-pitch ((t (:family "courier")))) - (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) - (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) - (font-lock-builtin-face ((t (:foreground "aquamarine")))) - (font-lock-comment-face ((t (:foreground "light blue")))) - (font-lock-constant-face ((t (:foreground "pale green")))) - (font-lock-doc-face ((t (:foreground "light sky blue")))) - (font-lock-doc-string-face ((t (:foreground "sky blue")))) - (font-lock-function-name-face ((t (:bold t :foreground "aquamarine" :weight bold)))) - (font-lock-keyword-face ((t (:bold t :foreground "pale turquoise" :weight bold)))) - (font-lock-reference-face ((t (:foreground "pale green")))) - (font-lock-string-face ((t (:foreground "light sky blue")))) - (font-lock-type-face ((t (:bold t :foreground "sky blue" :weight bold)))) - (font-lock-variable-name-face ((t (:bold t :foreground "turquoise" :weight bold)))) - (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (fringe ((t (:background "Grey15")))) - (gnus-cite-face-1 ((t (:foreground "LightSalmon")))) - (gnus-cite-face-2 ((t (:foreground "Khaki")))) - (gnus-cite-face-3 ((t (:foreground "Coral")))) - (gnus-cite-face-4 ((t (:foreground "yellow green")))) - (gnus-cite-face-5 ((t (:foreground "dark khaki")))) - (gnus-cite-face-6 ((t (:foreground "bisque")))) - (gnus-cite-face-7 ((t (:foreground "peru")))) - (gnus-cite-face-8 ((t (:foreground "light coral")))) - (gnus-cite-face-9 ((t (:foreground "plum")))) - (gnus-emphasis-bold ((t (:bold t :weight bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-strikethru ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (:foreground "White")))) - (gnus-group-mail-1-face ((t (:bold t :foreground "White" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (:foreground "light cyan")))) - (gnus-group-mail-2-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (:foreground "LightBlue")))) - (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (:foreground "Aquamarine")))) - (gnus-group-mail-low-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (gnus-group-news-1-empty-face ((t (:foreground "White")))) - (gnus-group-news-1-face ((t (:bold t :foreground "White" :weight bold)))) - (gnus-group-news-2-empty-face ((t (:foreground "light cyan")))) - (gnus-group-news-2-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (gnus-group-news-3-empty-face ((t (:foreground "LightBlue")))) - (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue" :weight bold)))) - (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) - (gnus-group-news-4-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) - (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) - (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) - (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) - (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) - (gnus-header-from-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (gnus-header-name-face ((t (:bold t :foreground "LightBlue" :weight bold)))) - (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) - (gnus-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) - (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight bold)))) - (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) - (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight bold)))) - (gnus-signature-face ((t (:foreground "Grey")))) - (gnus-splash-face ((t (:foreground "ForestGreen")))) - (gnus-summary-cancelled-face ((t (:background "Black" :foreground "Yellow")))) - (gnus-summary-high-ancient-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) - (gnus-summary-high-read-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) - (gnus-summary-high-ticked-face ((t (:bold t :foreground "LightSalmon" :weight bold)))) - (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) - (gnus-summary-low-ancient-face ((t (:italic t :foreground "DimGray" :slant italic)))) - (gnus-summary-low-read-face ((t (:foreground "slate gray")))) - (gnus-summary-low-ticked-face ((t (:foreground "Pink")))) - (gnus-summary-low-unread-face ((t (:foreground "LightGray")))) - (gnus-summary-normal-ancient-face ((t (:foreground "MediumAquamarine")))) - (gnus-summary-normal-read-face ((t (:foreground "Aquamarine")))) - (gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:underline t)))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) - (highlight ((t (:background "dark slate blue" :foreground "light blue")))) - (highline-face ((t (:background "DeepSkyBlue4")))) - (holiday-face ((t (:background "pink")))) - (info-header-node ((t (:bold t :weight bold)))) - (info-header-xref ((t (:bold t :weight bold :foreground "sky blue")))) - (info-menu-5 ((t (:underline t)))) - (info-menu-header ((t (:bold t :family "helv" :weight bold)))) - (info-node ((t (:bold t :weight bold)))) - (info-xref ((t (:bold t :foreground "sky blue" :weight bold)))) - (isearch ((t (:background "slate blue")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:foreground "sky blue")))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) - (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) - (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (makefile-space-face ((t (:background "hotpink")))) - (menu ((t (:background "MidnightBlue" :foreground "Grey")))) - (message-cited-text-face ((t (:foreground "LightSalmon")))) - (message-header-cc-face ((t (:foreground "light cyan")))) - (message-header-name-face ((t (:foreground "LightBlue")))) - (message-header-newsgroups-face ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) - (message-header-other-face ((t (:foreground "MediumAquamarine")))) - (message-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (message-header-to-face ((t (:bold t :foreground "light cyan" :weight bold)))) - (message-header-xheader-face ((t (:foreground "MediumAquamarine")))) - (message-mml-face ((t (:foreground "ForestGreen")))) - (message-separator-face ((t (:foreground "chocolate")))) - (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) - (mouse ((t (:background "Grey")))) - (region ((t (:background "DarkSlateBlue")))) - (scroll-bar ((t (:background "grey75")))) - (secondary-selection ((t (:background "steel blue")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (show-paren-match-face ((t (:background "light slate blue" :foreground "white")))) - (show-paren-mismatch-face ((t (:background "red" :foreground "white")))) - (speedbar-button-face ((t (:foreground "seashell2")))) - (speedbar-directory-face ((t (:foreground "seashell3")))) - (speedbar-file-face ((t (:foreground "seashell4")))) - (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) - (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) - (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) - (speedbar-tag-face ((t (:foreground "antique white")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "light blue")))) - (widget-field-face ((t (:background "RoyalBlue4" :foreground "wheat")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "slate blue" :foreground "wheat")))) - (woman-bold-face ((t (:bold t :foreground "sky blue" :weight bold)))) - (woman-italic-face ((t (:foreground "deep sky blue")))) - (woman-unknown-face ((t (:foreground "LightSalmon")))) - (zmacs-region ((t (:background "DarkSlateBlue"))))))) - -(defun color-theme-vim-colors () - "Color theme by Michael Soulier, created 2003-03-26." - (interactive) - (color-theme-install - '(color-theme-vim-colors - ((background-color . "#ffffff") - (background-mode . light) - (border-color . "black") - (cursor-color . "#000000") - (foreground-color . "#000000") - (mouse-color . "#000000")) - ((Man-overstrike-face . bold) - (Man-underline-face . underline) - (apropos-keybinding-face . underline) - (apropos-label-face . italic) - (apropos-match-face . secondary-selection) - (apropos-property-face . bold-italic) - (apropos-symbol-face . bold) - (cperl-here-face . font-lock-string-face) - (cperl-invalid-face quote underline) - (cperl-pod-face . font-lock-comment-face) - (cperl-pod-head-face . font-lock-variable-name-face) - (help-highlight-face . underline) - (ispell-highlight-face . highlight) - (list-matching-lines-face . bold) - (rpm-spec-dir-face . rpm-spec-dir-face) - (rpm-spec-doc-face . rpm-spec-doc-face) - (rpm-spec-ghost-face . rpm-spec-ghost-face) - (rpm-spec-macro-face . rpm-spec-macro-face) - (rpm-spec-package-face . rpm-spec-package-face) - (rpm-spec-tag-face . rpm-spec-tag-face) - (tags-tag-face . default) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:background "#ffffff" :foreground "#000000")))) - (Info-title-1-face ((t (nil)))) - (Info-title-2-face ((t (nil)))) - (Info-title-3-face ((t (nil)))) - (Info-title-4-face ((t (:bold (bold extra-bold ultra-bold))))) - (bold ((t (:bold (bold extra-bold ultra-bold))))) - (bold-italic ((t (:italic (italic oblique) :bold (bold extra-bold ultra-bold))))) - (border ((t (:background "black")))) - (comint-highlight-input ((t (:bold (bold extra-bold ultra-bold))))) - (comint-highlight-prompt ((t (:foreground "dark blue")))) - (cperl-array-face ((t (:foreground "brown")))) - (cperl-hash-face ((t (:foreground "red")))) - (cperl-nonoverridable-face ((t (:foreground "#008b8b")))) - (cursor ((t (:background "#000000")))) - (fixed-pitch ((t (nil)))) - (font-lock-builtin-face ((t (:foreground "purple")))) - (font-lock-comment-face ((t (:foreground "blue")))) - (font-lock-constant-face ((t (:foreground "green4")))) - (font-lock-doc-face ((t (:background "#f2f2f2")))) - (font-lock-function-name-face ((t (:foreground "#008b8b")))) - (font-lock-keyword-face ((t (:bold (bold extra-bold ultra-bold) :foreground "#a52a2a")))) - (font-lock-string-face ((t (:background "#f2f2f2" :foreground "#ff00ff")))) - (font-lock-type-face ((t (:foreground "ForestGreen")))) - (font-lock-variable-name-face ((t (:foreground "#008b8b")))) - (font-lock-warning-face ((t (:bold (bold extra-bold ultra-bold) :foreground "Red")))) - (fringe ((t (:background "#e5e5e5")))) - (header-line ((t (:background "grey90" :foreground "grey20")))) - (highlight ((t (:background "darkseagreen2")))) - (info-header-node ((t (nil)))) - (info-header-xref ((t (nil)))) - (info-menu-5 ((t (:foreground "red1")))) - (info-menu-header ((t (:bold (bold extra-bold ultra-bold))))) - (info-node ((t (:italic (italic oblique) :bold (bold extra-bold ultra-bold) :foreground "brown")))) - (info-xref ((t (:bold (bold extra-bold ultra-bold) :foreground "magenta4")))) - (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic (italic oblique))))) - (menu ((t (nil)))) - (mode-line ((t (:background "grey75" :foreground "black")))) - (mouse ((t (:background "#000000")))) - (region ((t (:background "lightgoldenrod2")))) - (rpm-spec-dir-face ((t (:foreground "green")))) - (rpm-spec-doc-face ((t (:foreground "magenta")))) - (rpm-spec-ghost-face ((t (:foreground "red")))) - (rpm-spec-macro-face ((t (:foreground "purple")))) - (rpm-spec-package-face ((t (:foreground "red")))) - (rpm-spec-tag-face ((t (:foreground "blue")))) - (scroll-bar ((t (:background "grey75" :foreground "#000000")))) - (secondary-selection ((t (:background "yellow")))) - (sh-heredoc-face ((t (:foreground "tan")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (tool-bar ((t (:background "grey75" :foreground "black")))) - (tooltip ((t (:background "lightyellow" :foreground "black")))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (nil)))) - (widget-button-face ((t (:bold (bold extra-bold ultra-bold))))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - -(defun color-theme-calm-forest () - "Color theme by Artur Hefczyc, created 2003-04-18." - (interactive) - (color-theme-install - '(color-theme-calm-forest - ((background-color . "gray12") - (background-mode . dark) - (border-color . "black") - (cursor-color . "orange") - (foreground-color . "green") - (mouse-color . "yellow")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (senator-eldoc-use-color . t) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "gray12" :foreground "green" :inverse-video nil :box nil -:strike-through nil :overline nil :underline nil :slant normal :weight normal :height 98 :width -normal :family "outline-courier new")))) - (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) - (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) - (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) - (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (comint-highlight-input ((t (:bold t :weight bold)))) - (comint-highlight-prompt ((t (:foreground "cyan")))) - (cparen-around-andor-face ((t (:bold t :foreground "maroon" :weight bold)))) - (cparen-around-begin-face ((t (:foreground "maroon")))) - (cparen-around-conditional-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) - (cparen-around-define-face ((t (:bold t :foreground "Blue" :weight bold)))) - (cparen-around-lambda-face ((t (:foreground "LightSeaGreen")))) - (cparen-around-letdo-face ((t (:bold t :foreground "LightSeaGreen" :weight bold)))) - (cparen-around-quote-face ((t (:foreground "SaddleBrown")))) - (cparen-around-set!-face ((t (:foreground "OrangeRed")))) - (cparen-around-syntax-rules-face ((t (:foreground "Magenta")))) - (cparen-around-vector-face ((t (:foreground "chocolate")))) - (cparen-binding-face ((t (:foreground "ForestGreen")))) - (cparen-binding-list-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) - (cparen-conditional-clause-face ((t (:foreground "RoyalBlue")))) - (cparen-normal-paren-face ((t (:foreground "grey50")))) - (cursor ((t (:background "orange")))) - (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style -released-button))))) - (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width -2 :style pressed-button))))) - (custom-changed-face ((t (:background "blue" :foreground "white")))) - (custom-comment-face ((t (:background "dim gray")))) - (custom-comment-tag-face ((t (:foreground "gray80")))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) - (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) - (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height -1.2)))) - (custom-invalid-face ((t (:background "red" :foreground "yellow")))) - (custom-modified-face ((t (:background "blue" :foreground "white")))) - (custom-rogue-face ((t (:background "black" :foreground "pink")))) - (custom-saved-face ((t (:underline t)))) - (custom-set-face ((t (:background "white" :foreground "blue")))) - (custom-state-face ((t (:foreground "lime green")))) - (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) - (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold -:height 1.2)))) - (eieio-custom-slot-tag-face ((t (:foreground "light blue")))) - (extra-whitespace-face ((t (:background "pale green")))) - (fixed-pitch ((t (:family "courier")))) - (font-latex-bold-face ((t (:bold t :foreground "OliveDrab" :weight bold)))) - (font-latex-italic-face ((t (:italic t :foreground "OliveDrab" :slant italic)))) - (font-latex-math-face ((t (:foreground "burlywood")))) - (font-latex-sedate-face ((t (:foreground "LightGray")))) - (font-latex-string-face ((t (:foreground "RosyBrown")))) - (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) - (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) - (font-lock-comment-face ((t (:foreground "chocolate1")))) - (font-lock-constant-face ((t (:foreground "Aquamarine")))) - (font-lock-doc-face ((t (:foreground "LightSalmon")))) - (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) - (font-lock-keyword-face ((t (:foreground "Cyan")))) - (font-lock-string-face ((t (:foreground "LightSalmon")))) - (font-lock-type-face ((t (:foreground "PaleGreen")))) - (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) - (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) - (fringe ((t (:background "grey10")))) - (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground -"grey90" :box nil)))) - (highlight ((t (:background "darkolivegreen")))) - (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "white")))) - (info-header-xref ((t (:bold t :weight bold :foreground "cyan")))) - (info-menu-5 ((t (:foreground "red1")))) - (info-menu-header ((t (:bold t :family "helv" :weight bold)))) - (info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) - (info-xref ((t (:bold t :foreground "cyan" :weight bold)))) - (isearch ((t (:background "palevioletred2" :foreground "brown4")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) - (italic ((t (:italic t :slant italic)))) - (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) - (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) - (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) - (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) - (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) - (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) - (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) - (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) - (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) - (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) - (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) - (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) - (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (:underline t)))) - (menu ((t (nil)))) - (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style -released-button))))) - (mouse ((t (:background "yellow")))) - (region ((t (:background "blue3")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "SkyBlue4")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (senator-intangible-face ((t (:foreground "gray75")))) - (senator-momentary-highlight-face ((t (:background "gray30")))) - (senator-read-only-face ((t (:background "#664444")))) - (show-paren-match-face ((t (:background "turquoise")))) - (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) - (speedbar-button-face ((t (:foreground "green3")))) - (speedbar-directory-face ((t (:foreground "light blue")))) - (speedbar-file-face ((t (:foreground "cyan")))) - (speedbar-highlight-face ((t (:background "sea green")))) - (speedbar-selected-face ((t (:foreground "red" :underline t)))) - (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) - (speedbar-tag-face ((t (:foreground "yellow")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style -released-button))))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "lime green")))) - (widget-field-face ((t (:background "dim gray")))) - (widget-inactive-face ((t (:foreground "light gray")))) - (widget-single-line-field-face ((t (:background "dim gray"))))))) - -(defun color-theme-lawrence () - "Color theme by lawrence mitchell . -Mainly shades of green. -Contains faces for erc, gnus, most of jde." - (interactive) - (color-theme-install - '(color-theme-lawrence - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "green") - (foreground-color . "#00CC00") - (mouse-color . "black")) - ((erc-button-face . bold) - (erc-button-mouse-face . highlight) - (gnus-article-button-face . bold) - (gnus-article-mouse-face . highlight) - (gnus-cite-attribution-face . gnus-cite-attribution-face) - (gnus-mouse-face . highlight) - (gnus-server-agent-face . gnus-server-agent-face) - (gnus-server-closed-face . gnus-server-closed-face) - (gnus-server-denied-face . gnus-server-denied-face) - (gnus-server-offline-face . gnus-server-offline-face) - (gnus-server-opened-face . gnus-server-opened-face) - (gnus-signature-face . gnus-signature-face) - (gnus-summary-selected-face . gnus-summary-selected-face) - (gnus-treat-display-face . head) - (gnus-treat-display-xface . head) - (list-matching-lines-buffer-name-face . underline) - (list-matching-lines-face . bold) - (paren-match-face . paren-face-match) - (paren-mismatch-face . paren-face-mismatch) - (paren-no-match-face . paren-face-no-match) - (sgml-set-face . t) - (tags-tag-face . default) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (nil)))) - (Buffer-menu-buffer-face ((t (:bold t :weight bold)))) - (bg:erc-color-face0 ((t (:background "White")))) - (bg:erc-color-face1 ((t (:background "black")))) - (bg:erc-color-face10 ((t (:background "lightblue1")))) - (bg:erc-color-face11 ((t (:background "cyan")))) - (bg:erc-color-face12 ((t (:background "blue")))) - (bg:erc-color-face13 ((t (:background "deeppink")))) - (bg:erc-color-face14 ((t (:background "gray50")))) - (bg:erc-color-face15 ((t (:background "gray90")))) - (bg:erc-color-face2 ((t (:background "blue4")))) - (bg:erc-color-face3 ((t (:background "green4")))) - (bg:erc-color-face4 ((t (:background "red")))) - (bg:erc-color-face5 ((t (:background "brown")))) - (bg:erc-color-face6 ((t (:background "purple")))) - (bg:erc-color-face7 ((t (:background "orange")))) - (bg:erc-color-face8 ((t (:background "yellow")))) - (bg:erc-color-face9 ((t (:background "green")))) - (bold ((t (:bold t :foreground "#00CC00" :background "black")))) - (bold-italic ((t (:italic t :bold t :slant oblique :weight semi-bold)))) - (border ((t (:background "black")))) - (button ((t (:underline t)))) - (comint-highlight-input ((t (nil)))) - (comint-highlight-prompt ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (cursor ((t (:background "green")))) - (custom-button-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (custom-button-pressed-face ((t (nil)))) - (custom-changed-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) - (custom-comment-face ((t (nil)))) - (custom-comment-tag-face ((t (nil)))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (nil)))) - (custom-group-tag-face ((t (nil)))) - (custom-group-tag-face-1 ((t (nil)))) - (custom-invalid-face ((t (:foreground "#00CC00" :background "black" :strike-through t)))) - (custom-modified-face ((t (nil)))) - (custom-rogue-face ((t (nil)))) - (custom-saved-face ((t (nil)))) - (custom-set-face ((t (nil)))) - (custom-state-face ((t (nil)))) - (custom-variable-button-face ((t (nil)))) - (custom-variable-tag-face ((t (nil)))) - (erc-action-face ((t (:bold t :weight semi-bold)))) - (erc-bold-face ((t (:bold t :weight bold)))) - (erc-current-nick-face ((t (:bold t :foreground "LightSeaGreen" :weight semi-bold)))) - (erc-dangerous-host-face ((t (:foreground "red")))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (:foreground "IndianRed")))) - (erc-error-face ((t (:bold t :weight semi-bold :background "darkblue" :foreground "#00CC00")))) - (erc-fool-face ((t (:foreground "dim gray")))) - (erc-input-face ((t (:foreground "springgreen")))) - (erc-inverse-face ((t (:bold t :background "Darkgreen" :foreground "Black" :weight semi-bold)))) - (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) - (erc-nick-default-face ((t (:bold t :weight semi-bold)))) - (erc-nick-msg-face ((t (:bold t :foreground "springgreen" :weight semi-bold)))) - (erc-notice-face ((t (:foreground "seagreen" :weight normal)))) - (erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) - (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight semi-bold)))) - (erc-timestamp-face ((t (:foreground "seagreen" :weight normal)))) - (erc-underline-face ((t (:underline t)))) - (fg:erc-color-face0 ((t (:foreground "White")))) - (fg:erc-color-face1 ((t (:foreground "black")))) - (fg:erc-color-face10 ((t (:foreground "lightblue1")))) - (fg:erc-color-face11 ((t (:foreground "cyan")))) - (fg:erc-color-face12 ((t (:foreground "blue")))) - (fg:erc-color-face13 ((t (:foreground "deeppink")))) - (fg:erc-color-face14 ((t (:foreground "gray50")))) - (fg:erc-color-face15 ((t (:foreground "gray90")))) - (fg:erc-color-face2 ((t (:foreground "blue4")))) - (fg:erc-color-face3 ((t (:foreground "green4")))) - (fg:erc-color-face4 ((t (:foreground "red")))) - (fg:erc-color-face5 ((t (:foreground "brown")))) - (fg:erc-color-face6 ((t (:foreground "purple")))) - (fg:erc-color-face7 ((t (:foreground "orange")))) - (fg:erc-color-face8 ((t (:foreground "yellow")))) - (fg:erc-color-face9 ((t (:foreground "green")))) - (fixed-pitch ((t (nil)))) - (font-latex-string-face ((t (:bold t :weight semi-bold :foreground "seagreen" :background "black")))) - (font-latex-warning-face ((t (:bold t :weight semi-bold :background "darkblue" :foreground "#00CC00")))) - (font-lock-builtin-face ((t (:foreground "seagreen1")))) - (font-lock-comment-face ((t (:background "black" :foreground "medium spring green")))) - (font-lock-constant-face ((t (nil)))) - (font-lock-doc-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))) - (font-lock-function-name-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (font-lock-keyword-face ((t (:bold t :background "black" :foreground "green" :underline t :weight semi-bold)))) - (font-lock-preprocessor-face ((t (:foreground "#00ccdd")))) - (font-lock-string-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))) - (font-lock-type-face ((t (nil)))) - (font-lock-variable-name-face ((t (nil)))) - (font-lock-warning-face ((t (:bold t :foreground "#00CC00" :background "darkblue" :weight semi-bold)))) - (fringe ((t (:foreground "#00CC00" :background "#151515")))) - (gnus-cite-attribution-face ((t (:italic t :foreground "#00CC00" :background "black" :slant italic)))) - (gnus-cite-face-1 ((t (:background "black" :foreground "springgreen")))) - (gnus-cite-face-10 ((t (nil)))) - (gnus-cite-face-11 ((t (nil)))) - (gnus-cite-face-2 ((t (:background "black" :foreground "lightseagreen")))) - (gnus-cite-face-3 ((t (:background "black" :foreground "darkseagreen")))) - (gnus-cite-face-4 ((t (:background "black" :foreground "forestgreen")))) - (gnus-cite-face-5 ((t (:background "black" :foreground "springgreen")))) - (gnus-cite-face-6 ((t (:background "black" :foreground "springgreen")))) - (gnus-cite-face-7 ((t (:background "black" :foreground "springgreen")))) - (gnus-cite-face-8 ((t (:background "black" :foreground "springgreen")))) - (gnus-cite-face-9 ((t (:background "black" :foreground "springgreen")))) - (gnus-emphasis-bold ((t (:bold t :weight semi-bold)))) - (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight semi-bold)))) - (gnus-emphasis-highlight-words ((t (:bold t :foreground "#00CC00" :background "black" :underline t :weight bold)))) - (gnus-emphasis-italic ((t (:italic t :slant italic)))) - (gnus-emphasis-strikethru ((t (nil)))) - (gnus-emphasis-underline ((t (:underline t)))) - (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight semi-bold)))) - (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight semi-bold)))) - (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) - (gnus-group-mail-1-empty-face ((t (nil)))) - (gnus-group-mail-1-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-mail-2-empty-face ((t (nil)))) - (gnus-group-mail-2-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-mail-3-empty-face ((t (nil)))) - (gnus-group-mail-3-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-mail-low-empty-face ((t (nil)))) - (gnus-group-mail-low-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-1-empty-face ((t (nil)))) - (gnus-group-news-1-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-2-empty-face ((t (nil)))) - (gnus-group-news-2-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-group-news-low-empty-face ((t (nil)))) - (gnus-group-news-low-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-header-content-face ((t (:background "black" :foreground "springgreen")))) - (gnus-header-from-face ((t (nil)))) - (gnus-header-name-face ((t (nil)))) - (gnus-header-newsgroups-face ((t (nil)))) - (gnus-header-subject-face ((t (nil)))) - (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) - (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) - (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight semi-bold)))) - (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) - (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight semi-bold)))) - (gnus-signature-face ((t (:background "black" :foreground "springgreen" :slant normal)))) - (gnus-splash-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-summary-cancelled-face ((t (:foreground "#00CC00" :background "black" :strike-through t)))) - (gnus-summary-high-ancient-face ((t (nil)))) - (gnus-summary-high-read-face ((t (nil)))) - (gnus-summary-high-ticked-face ((t (:background "black" :foreground "seagreen")))) - (gnus-summary-high-undownloaded-face ((t (:bold t :foreground "LightGray" :weight bold)))) - (gnus-summary-high-unread-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-summary-low-ancient-face ((t (nil)))) - (gnus-summary-low-read-face ((t (nil)))) - (gnus-summary-low-ticked-face ((t (nil)))) - (gnus-summary-low-undownloaded-face ((t (:italic t :foreground "LightGray" :slant italic :weight normal)))) - (gnus-summary-low-unread-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) - (gnus-summary-normal-ancient-face ((t (nil)))) - (gnus-summary-normal-read-face ((t (nil)))) - (gnus-summary-normal-ticked-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (gnus-summary-normal-undownloaded-face ((t (:foreground "LightGray" :weight normal)))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (:background "#101010")))) - (gnus-x-face ((t (:background "white" :foreground "black")))) - (header-line ((t (nil)))) - (highlight ((t (:foreground "#00CC00" :background "darkgreen")))) - (ido-first-match-face ((t (:bold t :weight bold)))) - (ido-indicator-face ((t (:background "red" :foreground "yellow" :width condensed)))) - (ido-only-match-face ((t (:foreground "ForestGreen")))) - (ido-subdir-face ((t (:foreground "red")))) - (isearch ((t (:background "seagreen" :foreground "black")))) - (isearch-lazy-highlight-face ((t (:background "darkseagreen" :foreground "black")))) - (italic ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) - (menu ((t (:bold t :background "black" :foreground "green" :box (:line-width -1 :color "#606060") :weight semi-bold)))) - (message-cited-text-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) - (message-header-cc-face ((t (nil)))) - (message-header-name-face ((t (nil)))) - (message-header-newsgroups-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (message-header-other-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (message-header-subject-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (message-header-to-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (message-header-xheader-face ((t (nil)))) - (message-mml-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) - (message-separator-face ((t (nil)))) - (minibuffer-prompt ((t (:background "black" :foreground "seagreen")))) - (mode-line ((t (:bold t :background "#404040" :foreground "green" :box (:line-width -1 :color "#606060") :weight semi-bold)))) - (mode-line-inactive ((t (:bold t :weight semi-bold :box (:line-width -1 :color "#606060") :foreground "green" :background "#101010")))) - (mouse ((t (:background "black")))) - (paren-face ((t (:background "black" :foreground "darkgreen")))) - (paren-face-match ((t (:background "black" :foreground "springgreen")))) - (paren-face-mismatch ((t (:foreground "#00CC00" :background "black" :strike-through t)))) - (paren-face-no-match ((t (:background "black" :foreground "red")))) - (region ((t (:background "seagreen" :foreground "black")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "darkseagreen" :foreground "black")))) - (semantic-dirty-token-face ((t (:background "gray10")))) - (semantic-unmatched-syntax-face ((t (:underline "red")))) - (sgml-end-tag-face ((t (:foreground "seagreen")))) - (sgml-start-tag-face ((t (:foreground "seagreen")))) - (tabbar-button-face ((t (:background "black" :foreground "#00cc00" :box (:line-width 2 :color "black" :style released-button))))) - (tabbar-default-face ((t (:background "black" :foreground "#00cc00")))) - (tabbar-selected-face ((t (:background "black" :foreground "springgreen" :box (:line-width 2 :color "black" :style released-button))))) - (tabbar-separator-face ((t (:foreground "#00cc00" :background "black")))) - (tabbar-unselected-face ((t (:background "black" :foreground "seagreen" :box (:line-width 2 :color "black" :style pressed-button))))) - (tool-bar ((t (:box (:line-width 1 :style released-button))))) - (tooltip ((t (nil)))) - (trailing-whitespace ((t (:background "lightseagreen" :foreground "black")))) - (underline ((t (:foreground "#00CC00" :background "black" :underline t)))) - (variable-pitch ((t (:underline nil :foreground "#00CC00" :background "black")))) - (widget-button-face ((t (:bold t :foreground "#00CC00" :background "black")))) - (widget-button-pressed-face ((t (nil)))) - (widget-documentation-face ((t (nil)))) - (widget-field-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) - (widget-inactive-face ((t (nil)))) - (widget-single-line-field-face ((t (nil))))))) - -(defun color-theme-matrix () - "Color theme by walterh@rocketmail.com, created 2003-10-16." - (interactive) - (color-theme-install - '(color-theme-matrix - ((background-color . "black") - (background-mode . dark) - (background-toolbar-color . "bisque") - (border-color . "orange") - (bottom-toolbar-shadow-color . "#909099999999") - (cursor-color . "#7eff00") - (foreground-color . "#7eff00") - (mouse-color . "#7eff00") - (top-toolbar-shadow-color . "#ffffffffffff")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (rmail-highlight-face . font-lock-function-name-face) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "black" :foreground -"#7eff00" :inverse-video nil :box nil :strike-through nil :overline nil -:underline nil :slant normal :weight normal :height 90 :width normal -:family "outline-courier new")))) - (Buffer-menu-buffer-face ((t (nil)))) - (CUA-global-mark-face ((t (nil)))) - (CUA-rectangle-face ((t (nil)))) - (CUA-rectangle-noselect-face ((t (nil)))) - (Info-title-1-face ((t (nil)))) - (Info-title-2-face ((t (nil)))) - (Info-title-3-face ((t (nil)))) - (Info-title-4-face ((t (nil)))) - (antlr-font-lock-keyword-face ((t (nil)))) - (antlr-font-lock-literal-face ((t (nil)))) - (antlr-font-lock-ruledef-face ((t (nil)))) - (antlr-font-lock-ruleref-face ((t (nil)))) - (antlr-font-lock-tokendef-face ((t (nil)))) - (antlr-font-lock-tokenref-face ((t (nil)))) - (bbdb-company ((t (nil)))) - (bbdb-field-name ((t (nil)))) - (bbdb-field-value ((t (nil)))) - (bbdb-name ((t (nil)))) - (bg:erc-color-face0 ((t (nil)))) - (bg:erc-color-face1 ((t (nil)))) - (bg:erc-color-face10 ((t (nil)))) - (bg:erc-color-face11 ((t (nil)))) - (bg:erc-color-face12 ((t (nil)))) - (bg:erc-color-face13 ((t (nil)))) - (bg:erc-color-face14 ((t (nil)))) - (bg:erc-color-face15 ((t (nil)))) - (bg:erc-color-face2 ((t (nil)))) - (bg:erc-color-face3 ((t (nil)))) - (bg:erc-color-face4 ((t (nil)))) - (bg:erc-color-face5 ((t (nil)))) - (bg:erc-color-face6 ((t (nil)))) - (bg:erc-color-face7 ((t (nil)))) - (bg:erc-color-face8 ((t (nil)))) - (bg:erc-color-face9 ((t (nil)))) - (blank-space-face ((t (nil)))) - (blank-tab-face ((t (nil)))) - (blue ((t (nil)))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:bold t :weight bold)))) - (border ((t (:background "orange")))) - (border-glyph ((t (nil)))) - (buffers-tab ((t (nil)))) - (button ((t (nil)))) - (calendar-today-face ((t (nil)))) - (change-log-acknowledgement-face ((t (nil)))) - (change-log-conditionals-face ((t (nil)))) - (change-log-date-face ((t (nil)))) - (change-log-email-face ((t (nil)))) - (change-log-file-face ((t (nil)))) - (change-log-function-face ((t (nil)))) - (change-log-list-face ((t (nil)))) - (change-log-name-face ((t (nil)))) - (clearcase-dired-checkedout-face ((t (nil)))) - (comint-highlight-input ((t (nil)))) - (comint-highlight-prompt ((t (nil)))) - (cparen-around-andor-face ((t (nil)))) - (cparen-around-begin-face ((t (nil)))) - (cparen-around-conditional-face ((t (nil)))) - (cparen-around-define-face ((t (nil)))) - (cparen-around-lambda-face ((t (nil)))) - (cparen-around-letdo-face ((t (nil)))) - (cparen-around-quote-face ((t (nil)))) - (cparen-around-set!-face ((t (nil)))) - (cparen-around-syntax-rules-face ((t (nil)))) - (cparen-around-vector-face ((t (nil)))) - (cparen-binding-face ((t (nil)))) - (cparen-binding-list-face ((t (nil)))) - (cparen-conditional-clause-face ((t (nil)))) - (cparen-normal-paren-face ((t (nil)))) - (cperl-array-face ((t (nil)))) - (cperl-hash-face ((t (nil)))) - (cperl-invalid-face ((t (nil)))) - (cperl-nonoverridable-face ((t (nil)))) - (cursor ((t (:background "#7eff00" :foreground "black")))) - (custom-button-face ((t (nil)))) - (custom-button-pressed-face ((t (nil)))) - (custom-changed-face ((t (nil)))) - (custom-comment-face ((t (nil)))) - (custom-comment-tag-face ((t (nil)))) - (custom-documentation-face ((t (nil)))) - (custom-face-tag-face ((t (nil)))) - (custom-group-tag-face ((t (nil)))) - (custom-group-tag-face-1 ((t (nil)))) - (custom-invalid-face ((t (nil)))) - (custom-modified-face ((t (nil)))) - (custom-rogue-face ((t (nil)))) - (custom-saved-face ((t (nil)))) - (custom-set-face ((t (nil)))) - (custom-state-face ((t (nil)))) - (custom-variable-button-face ((t (nil)))) - (custom-variable-tag-face ((t (nil)))) - (cvs-filename-face ((t (nil)))) - (cvs-handled-face ((t (nil)))) - (cvs-header-face ((t (nil)))) - (cvs-marked-face ((t (nil)))) - (cvs-msg-face ((t (nil)))) - (cvs-need-action-face ((t (nil)))) - (cvs-unknown-face ((t (nil)))) - (cyan ((t (nil)))) - (diary-face ((t (nil)))) - (diff-added-face ((t (nil)))) - (diff-changed-face ((t (nil)))) - (diff-context-face ((t (nil)))) - (diff-file-header-face ((t (nil)))) - (diff-function-face ((t (nil)))) - (diff-header-face ((t (nil)))) - (diff-hunk-header-face ((t (nil)))) - (diff-index-face ((t (nil)))) - (diff-nonexistent-face ((t (nil)))) - (diff-removed-face ((t (nil)))) - (dired-face-boring ((t (nil)))) - (dired-face-directory ((t (nil)))) - (dired-face-executable ((t (nil)))) - (dired-face-flagged ((t (nil)))) - (dired-face-header ((t (nil)))) - (dired-face-marked ((t (nil)))) - (dired-face-permissions ((t (nil)))) - (dired-face-setuid ((t (nil)))) - (dired-face-socket ((t (nil)))) - (dired-face-symlink ((t (nil)))) - (display-time-mail-balloon-enhance-face ((t (nil)))) - (display-time-mail-balloon-gnus-group-face ((t (nil)))) - (display-time-time-balloon-face ((t (nil)))) - (ebrowse-default-face ((t (nil)))) - (ebrowse-file-name-face ((t (nil)))) - (ebrowse-member-attribute-face ((t (nil)))) - (ebrowse-member-class-face ((t (nil)))) - (ebrowse-progress-face ((t (nil)))) - (ebrowse-root-class-face ((t (nil)))) - (ebrowse-tree-mark-face ((t (nil)))) - (ecb-sources-face ((t (nil)))) - (edb-inter-field-face ((t (nil)))) - (edb-normal-summary-face ((t (nil)))) - (ediff-current-diff-face-A ((t (nil)))) - (ediff-current-diff-face-Ancestor ((t (nil)))) - (ediff-current-diff-face-B ((t (nil)))) - (ediff-current-diff-face-C ((t (nil)))) - (ediff-even-diff-face-A ((t (nil)))) - (ediff-even-diff-face-Ancestor ((t (nil)))) - (ediff-even-diff-face-B ((t (nil)))) - (ediff-even-diff-face-C ((t (nil)))) - (ediff-fine-diff-face-A ((t (nil)))) - (ediff-fine-diff-face-Ancestor ((t (nil)))) - (ediff-fine-diff-face-B ((t (nil)))) - (ediff-fine-diff-face-C ((t (nil)))) - (ediff-odd-diff-face-A ((t (nil)))) - (ediff-odd-diff-face-Ancestor ((t (nil)))) - (ediff-odd-diff-face-B ((t (nil)))) - (ediff-odd-diff-face-C ((t (nil)))) - (eieio-custom-slot-tag-face ((t (nil)))) - (emacs-wiki-bad-link-face ((t (nil)))) - (emacs-wiki-link-face ((t (nil)))) - (erc-action-face ((t (nil)))) - (erc-bold-face ((t (nil)))) - (erc-current-nick-face ((t (nil)))) - (erc-dangerous-host-face ((t (nil)))) - (erc-default-face ((t (nil)))) - (erc-direct-msg-face ((t (nil)))) - (erc-error-face ((t (nil)))) - (erc-fool-face ((t (nil)))) - (erc-highlight-face ((t (nil)))) - (erc-input-face ((t (nil)))) - (erc-inverse-face ((t (nil)))) - (erc-keyword-face ((t (nil)))) - (erc-nick-default-face ((t (nil)))) - (erc-nick-msg-face ((t (nil)))) - (erc-notice-face ((t (nil)))) - (erc-pal-face ((t (nil)))) - (erc-prompt-face ((t (nil)))) - (erc-timestamp-face ((t (nil)))) - (erc-underline-face ((t (nil)))) - (eshell-ls-archive-face ((t (nil)))) - (eshell-ls-backup-face ((t (nil)))) - (eshell-ls-clutter-face ((t (nil)))) - (eshell-ls-directory-face ((t (nil)))) - (eshell-ls-executable-face ((t (nil)))) - (eshell-ls-missing-face ((t (nil)))) - (eshell-ls-picture-face ((t (nil)))) - (eshell-ls-product-face ((t (nil)))) - (eshell-ls-readonly-face ((t (nil)))) - (eshell-ls-special-face ((t (nil)))) - (eshell-ls-symlink-face ((t (nil)))) - (eshell-ls-text-face ((t (nil)))) - (eshell-ls-todo-face ((t (nil)))) - (eshell-ls-unreadable-face ((t (nil)))) - (eshell-prompt-face ((t (nil)))) - (eshell-test-failed-face ((t (nil)))) - (eshell-test-ok-face ((t (nil)))) - (excerpt ((t (nil)))) - (extra-whitespace-face ((t (nil)))) - (ff-paths-non-existant-file-face ((t (nil)))) - (fg:black ((t (nil)))) - (fg:erc-color-face0 ((t (nil)))) - (fg:erc-color-face1 ((t (nil)))) - (fg:erc-color-face10 ((t (nil)))) - (fg:erc-color-face11 ((t (nil)))) - (fg:erc-color-face12 ((t (nil)))) - (fg:erc-color-face13 ((t (nil)))) - (fg:erc-color-face14 ((t (nil)))) - (fg:erc-color-face15 ((t (nil)))) - (fg:erc-color-face2 ((t (nil)))) - (fg:erc-color-face3 ((t (nil)))) - (fg:erc-color-face4 ((t (nil)))) - (fg:erc-color-face5 ((t (nil)))) - (fg:erc-color-face6 ((t (nil)))) - (fg:erc-color-face7 ((t (nil)))) - (fg:erc-color-face8 ((t (nil)))) - (fg:erc-color-face9 ((t (nil)))) - (fixed ((t (nil)))) - (fixed-pitch ((t (nil)))) - (fl-comment-face ((t (nil)))) - (fl-function-name-face ((t (nil)))) - (fl-keyword-face ((t (nil)))) - (fl-string-face ((t (nil)))) - (fl-type-face ((t (nil)))) - (flash-paren-face-off ((t (nil)))) - (flash-paren-face-on ((t (nil)))) - (flash-paren-face-region ((t (nil)))) - (flyspell-duplicate-face ((t (nil)))) - (flyspell-incorrect-face ((t (nil)))) - (font-latex-bold-face ((t (nil)))) - (font-latex-italic-face ((t (nil)))) - (font-latex-math-face ((t (nil)))) - (font-latex-sedate-face ((t (nil)))) - (font-latex-string-face ((t (nil)))) - (font-latex-warning-face ((t (nil)))) - (font-lock-builtin-face ((t (:foreground "pink2")))) - (font-lock-comment-face ((t (:italic t :background "black" :slant -italic)))) - (font-lock-constant-face ((t (:foreground "magenta")))) - (font-lock-doc-face ((t (nil)))) - (font-lock-doc-string-face ((t (nil)))) - (font-lock-exit-face ((t (nil)))) - (font-lock-function-name-face ((t (:bold t :underline t :weight -bold)))) - (font-lock-keyword-face ((t (:foreground "yellow1")))) - (font-lock-other-emphasized-face ((t (nil)))) - (font-lock-other-type-face ((t (nil)))) - (font-lock-preprocessor-face ((t (nil)))) - (font-lock-reference-face ((t (nil)))) - (font-lock-special-comment-face ((t (nil)))) - (font-lock-special-keyword-face ((t (nil)))) - (font-lock-string-face ((t (:foreground "yellow2")))) - (font-lock-type-face ((t (:foreground "LightYellow1")))) - (font-lock-variable-name-face ((t (:foreground "light green")))) - (font-lock-warning-face ((t (nil)))) - (fringe ((t (nil)))) - (gnus-cite-attribution-face ((t (nil)))) - (gnus-cite-face-1 ((t (nil)))) - (gnus-cite-face-10 ((t (nil)))) - (gnus-cite-face-11 ((t (nil)))) - (gnus-cite-face-2 ((t (nil)))) - (gnus-cite-face-3 ((t (nil)))) - (gnus-cite-face-4 ((t (nil)))) - (gnus-cite-face-5 ((t (nil)))) - (gnus-cite-face-6 ((t (nil)))) - (gnus-cite-face-7 ((t (nil)))) - (gnus-cite-face-8 ((t (nil)))) - (gnus-cite-face-9 ((t (nil)))) - (gnus-emphasis-bold ((t (nil)))) - (gnus-emphasis-bold-italic ((t (nil)))) - (gnus-emphasis-highlight-words ((t (nil)))) - (gnus-emphasis-italic ((t (nil)))) - (gnus-emphasis-strikethru ((t (nil)))) - (gnus-emphasis-underline ((t (nil)))) - (gnus-emphasis-underline-bold ((t (nil)))) - (gnus-emphasis-underline-bold-italic ((t (nil)))) - (gnus-emphasis-underline-italic ((t (nil)))) - (gnus-filterhist-face-1 ((t (nil)))) - (gnus-group-mail-1-empty-face ((t (nil)))) - (gnus-group-mail-1-face ((t (nil)))) - (gnus-group-mail-2-empty-face ((t (nil)))) - (gnus-group-mail-2-face ((t (nil)))) - (gnus-group-mail-3-empty-face ((t (nil)))) - (gnus-group-mail-3-face ((t (nil)))) - (gnus-group-mail-low-empty-face ((t (nil)))) - (gnus-group-mail-low-face ((t (nil)))) - (gnus-group-news-1-empty-face ((t (nil)))) - (gnus-group-news-1-face ((t (nil)))) - (gnus-group-news-2-empty-face ((t (nil)))) - (gnus-group-news-2-face ((t (nil)))) - (gnus-group-news-3-empty-face ((t (nil)))) - (gnus-group-news-3-face ((t (nil)))) - (gnus-group-news-4-empty-face ((t (nil)))) - (gnus-group-news-4-face ((t (nil)))) - (gnus-group-news-5-empty-face ((t (nil)))) - (gnus-group-news-5-face ((t (nil)))) - (gnus-group-news-6-empty-face ((t (nil)))) - (gnus-group-news-6-face ((t (nil)))) - (gnus-group-news-low-empty-face ((t (nil)))) - (gnus-group-news-low-face ((t (nil)))) - (gnus-header-content-face ((t (nil)))) - (gnus-header-from-face ((t (nil)))) - (gnus-header-name-face ((t (nil)))) - (gnus-header-newsgroups-face ((t (nil)))) - (gnus-header-subject-face ((t (nil)))) - (gnus-picon-face ((t (nil)))) - (gnus-picon-xbm-face ((t (nil)))) - (gnus-picons-face ((t (nil)))) - (gnus-picons-xbm-face ((t (nil)))) - (gnus-server-agent-face ((t (nil)))) - (gnus-server-closed-face ((t (nil)))) - (gnus-server-denied-face ((t (nil)))) - (gnus-server-offline-face ((t (nil)))) - (gnus-server-opened-face ((t (nil)))) - (gnus-signature-face ((t (nil)))) - (gnus-splash ((t (nil)))) - (gnus-splash-face ((t (nil)))) - (gnus-summary-cancelled-face ((t (nil)))) - (gnus-summary-high-ancient-face ((t (nil)))) - (gnus-summary-high-read-face ((t (nil)))) - (gnus-summary-high-ticked-face ((t (nil)))) - (gnus-summary-high-undownloaded-face ((t (nil)))) - (gnus-summary-high-unread-face ((t (nil)))) - (gnus-summary-low-ancient-face ((t (nil)))) - (gnus-summary-low-read-face ((t (nil)))) - (gnus-summary-low-ticked-face ((t (nil)))) - (gnus-summary-low-undownloaded-face ((t (nil)))) - (gnus-summary-low-unread-face ((t (nil)))) - (gnus-summary-normal-ancient-face ((t (nil)))) - (gnus-summary-normal-read-face ((t (nil)))) - (gnus-summary-normal-ticked-face ((t (nil)))) - (gnus-summary-normal-undownloaded-face ((t (nil)))) - (gnus-summary-normal-unread-face ((t (nil)))) - (gnus-summary-selected-face ((t (nil)))) - (gnus-x-face ((t (nil)))) - (green ((t (nil)))) - (gui-button-face ((t (nil)))) - (gui-element ((t (nil)))) - (header-line ((t (nil)))) - (hi-black-b ((t (nil)))) - (hi-black-hb ((t (nil)))) - (hi-blue ((t (nil)))) - (hi-blue-b ((t (nil)))) - (hi-green ((t (nil)))) - (hi-green-b ((t (nil)))) - (hi-pink ((t (nil)))) - (hi-red-b ((t (nil)))) - (hi-yellow ((t (nil)))) - (highlight ((t (:background "#7eff00" :foreground "black")))) - (highlight-changes-delete-face ((t (nil)))) - (highlight-changes-face ((t (nil)))) - (highline-face ((t (nil)))) - (holiday-face ((t (nil)))) - (html-helper-bold-face ((t (nil)))) - (html-helper-bold-italic-face ((t (nil)))) - (html-helper-builtin-face ((t (nil)))) - (html-helper-italic-face ((t (nil)))) - (html-helper-underline-face ((t (nil)))) - (html-tag-face ((t (nil)))) - (hyper-apropos-documentation ((t (nil)))) - (hyper-apropos-heading ((t (nil)))) - (hyper-apropos-hyperlink ((t (nil)))) - (hyper-apropos-major-heading ((t (nil)))) - (hyper-apropos-section-heading ((t (nil)))) - (hyper-apropos-warning ((t (nil)))) - (ibuffer-deletion-face ((t (nil)))) - (ibuffer-marked-face ((t (nil)))) - (idlwave-help-link-face ((t (nil)))) - (idlwave-shell-bp-face ((t (nil)))) - (ido-first-match-face ((t (nil)))) - (ido-indicator-face ((t (nil)))) - (ido-only-match-face ((t (nil)))) - (ido-subdir-face ((t (nil)))) - (info-header-node ((t (nil)))) - (info-header-xref ((t (nil)))) - (info-menu-5 ((t (nil)))) - (info-menu-6 ((t (nil)))) - (info-menu-header ((t (nil)))) - (info-node ((t (nil)))) - (info-xref ((t (nil)))) - (isearch ((t (nil)))) - (isearch-lazy-highlight-face ((t (nil)))) - (isearch-secondary ((t (nil)))) - (italic ((t (:underline t)))) - (jde-bug-breakpoint-cursor ((t (nil)))) - (jde-bug-breakpoint-marker ((t (nil)))) - (jde-db-active-breakpoint-face ((t (nil)))) - (jde-db-requested-breakpoint-face ((t (nil)))) - (jde-db-spec-breakpoint-face ((t (nil)))) - (jde-java-font-lock-api-face ((t (nil)))) - (jde-java-font-lock-bold-face ((t (nil)))) - (jde-java-font-lock-code-face ((t (nil)))) - (jde-java-font-lock-constant-face ((t (nil)))) - (jde-java-font-lock-doc-tag-face ((t (nil)))) - (jde-java-font-lock-italic-face ((t (nil)))) - (jde-java-font-lock-link-face ((t (nil)))) - (jde-java-font-lock-modifier-face ((t (nil)))) - (jde-java-font-lock-number-face ((t (nil)))) - (jde-java-font-lock-operator-face ((t (nil)))) - (jde-java-font-lock-package-face ((t (nil)))) - (jde-java-font-lock-pre-face ((t (nil)))) - (jde-java-font-lock-underline-face ((t (nil)))) - (lazy-highlight-face ((t (nil)))) - (left-margin ((t (nil)))) - (linemenu-face ((t (nil)))) - (list-mode-item-selected ((t (nil)))) - (log-view-file-face ((t (nil)))) - (log-view-message-face ((t (nil)))) - (magenta ((t (nil)))) - (makefile-space-face ((t (nil)))) - (man-bold ((t (nil)))) - (man-heading ((t (nil)))) - (man-italic ((t (nil)))) - (man-xref ((t (nil)))) - (menu ((t (nil)))) - (message-cited-text ((t (nil)))) - (message-cited-text-face ((t (nil)))) - (message-header-cc-face ((t (nil)))) - (message-header-contents ((t (nil)))) - (message-header-name-face ((t (nil)))) - (message-header-newsgroups-face ((t (nil)))) - (message-header-other-face ((t (nil)))) - (message-header-subject-face ((t (nil)))) - (message-header-to-face ((t (nil)))) - (message-header-xheader-face ((t (nil)))) - (message-headers ((t (nil)))) - (message-highlighted-header-contents ((t (nil)))) - (message-mml-face ((t (nil)))) - (message-separator-face ((t (nil)))) - (message-url ((t (nil)))) - (minibuffer-prompt ((t (nil)))) - (mmm-face ((t (nil)))) - (mode-line ((t (:bold t :background "gray" :foreground "black" -:weight bold)))) - (mode-line-inactive ((t (nil)))) - (modeline-buffer-id ((t (:background "orange" :foreground -"black")))) - (modeline-mousable ((t (:background "orange" :foreground -"black")))) - (modeline-mousable-minor-mode ((t (:background "orange" -:foreground "black")))) - (mouse ((t (nil)))) - (mpg123-face-cur ((t (nil)))) - (mpg123-face-slider ((t (nil)))) - (my-tab-face ((t (nil)))) - (nil ((t (nil)))) - (overlay-empty-face ((t (nil)))) - (p4-diff-del-face ((t (nil)))) - (paren-blink-off ((t (nil)))) - (paren-face ((t (nil)))) - (paren-face-match ((t (nil)))) - (paren-face-mismatch ((t (nil)))) - (paren-face-no-match ((t (nil)))) - (paren-match ((t (nil)))) - (paren-mismatch ((t (nil)))) - (paren-mismatch-face ((t (nil)))) - (paren-no-match-face ((t (nil)))) - (pointer ((t (nil)))) - (primary-selection ((t (nil)))) - (reb-match-0 ((t (nil)))) - (reb-match-1 ((t (nil)))) - (reb-match-2 ((t (nil)))) - (reb-match-3 ((t (nil)))) - (red ((t (nil)))) - (region ((t (:background "#7eff00" :foreground "black")))) - (right-margin ((t (nil)))) - (rpm-spec-dir-face ((t (nil)))) - (rpm-spec-doc-face ((t (nil)))) - (rpm-spec-ghost-face ((t (nil)))) - (rpm-spec-macro-face ((t (nil)))) - (rpm-spec-package-face ((t (nil)))) - (rpm-spec-tag-face ((t (nil)))) - (rpm-spec-var-face ((t (nil)))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "orange" :foreground -"black")))) - (semantic-dirty-token-face ((t (nil)))) - (semantic-intangible-face ((t (nil)))) - (semantic-read-only-face ((t (nil)))) - (semantic-unmatched-syntax-face ((t (nil)))) - (senator-intangible-face ((t (nil)))) - (senator-momentary-highlight-face ((t (nil)))) - (senator-read-only-face ((t (nil)))) - (sgml-comment-face ((t (nil)))) - (sgml-doctype-face ((t (nil)))) - (sgml-end-tag-face ((t (nil)))) - (sgml-entity-face ((t (nil)))) - (sgml-ignored-face ((t (nil)))) - (sgml-ms-end-face ((t (nil)))) - (sgml-ms-start-face ((t (nil)))) - (sgml-pi-face ((t (nil)))) - (sgml-sgml-face ((t (nil)))) - (sgml-short-ref-face ((t (nil)))) - (sgml-shortref-face ((t (nil)))) - (sgml-start-tag-face ((t (nil)))) - (sh-heredoc-face ((t (nil)))) - (shell-option-face ((t (nil)))) - (shell-output-2-face ((t (nil)))) - (shell-output-3-face ((t (nil)))) - (shell-output-face ((t (nil)))) - (shell-prompt-face ((t (nil)))) - (show-block-face1 ((t (nil)))) - (show-block-face2 ((t (nil)))) - (show-block-face3 ((t (nil)))) - (show-block-face4 ((t (nil)))) - (show-block-face5 ((t (nil)))) - (show-block-face6 ((t (nil)))) - (show-block-face7 ((t (nil)))) - (show-block-face8 ((t (nil)))) - (show-block-face9 ((t (nil)))) - (show-paren-match-face ((t (:background "orange" :foreground -"black")))) - (show-paren-mismatch-face ((t (:underline t)))) - (show-tabs-space-face ((t (nil)))) - (show-tabs-tab-face ((t (nil)))) - (smerge-base-face ((t (nil)))) - (smerge-markers-face ((t (nil)))) - (smerge-mine-face ((t (nil)))) - (smerge-other-face ((t (nil)))) - (speedbar-button-face ((t (nil)))) - (speedbar-directory-face ((t (nil)))) - (speedbar-file-face ((t (nil)))) - (speedbar-highlight-face ((t (nil)))) - (speedbar-selected-face ((t (nil)))) - (speedbar-separator-face ((t (nil)))) - (speedbar-tag-face ((t (nil)))) - (strokes-char-face ((t (nil)))) - (swbuff-current-buffer-face ((t (nil)))) - (tabbar-button-face ((t (nil)))) - (tabbar-default-face ((t (nil)))) - (tabbar-selected-face ((t (nil)))) - (tabbar-separator-face ((t (nil)))) - (tabbar-unselected-face ((t (nil)))) - (template-message-face ((t (nil)))) - (term-black ((t (nil)))) - (term-blackbg ((t (nil)))) - (term-blue ((t (nil)))) - (term-blue-bold-face ((t (nil)))) - (term-blue-face ((t (nil)))) - (term-blue-inv-face ((t (nil)))) - (term-blue-ul-face ((t (nil)))) - (term-bluebg ((t (nil)))) - (term-bold ((t (nil)))) - (term-cyan ((t (nil)))) - (term-cyan-bold-face ((t (nil)))) - (term-cyan-face ((t (nil)))) - (term-cyan-inv-face ((t (nil)))) - (term-cyan-ul-face ((t (nil)))) - (term-cyanbg ((t (nil)))) - (term-default ((t (nil)))) - (term-default-bg ((t (nil)))) - (term-default-bg-inv ((t (nil)))) - (term-default-bold-face ((t (nil)))) - (term-default-face ((t (nil)))) - (term-default-fg ((t (nil)))) - (term-default-fg-inv ((t (nil)))) - (term-default-inv-face ((t (nil)))) - (term-default-ul-face ((t (nil)))) - (term-green ((t (nil)))) - (term-green-bold-face ((t (nil)))) - (term-green-face ((t (nil)))) - (term-green-inv-face ((t (nil)))) - (term-green-ul-face ((t (nil)))) - (term-greenbg ((t (nil)))) - (term-invisible ((t (nil)))) - (term-invisible-inv ((t (nil)))) - (term-magenta ((t (nil)))) - (term-magenta-bold-face ((t (nil)))) - (term-magenta-face ((t (nil)))) - (term-magenta-inv-face ((t (nil)))) - (term-magenta-ul-face ((t (nil)))) - (term-magentabg ((t (nil)))) - (term-red ((t (nil)))) - (term-red-bold-face ((t (nil)))) - (term-red-face ((t (nil)))) - (term-red-inv-face ((t (nil)))) - (term-red-ul-face ((t (nil)))) - (term-redbg ((t (nil)))) - (term-underline ((t (nil)))) - (term-white ((t (nil)))) - (term-white-bold-face ((t (nil)))) - (term-white-face ((t (nil)))) - (term-white-inv-face ((t (nil)))) - (term-white-ul-face ((t (nil)))) - (term-whitebg ((t (nil)))) - (term-yellow ((t (nil)))) - (term-yellow-bold-face ((t (nil)))) - (term-yellow-face ((t (nil)))) - (term-yellow-inv-face ((t (nil)))) - (term-yellow-ul-face ((t (nil)))) - (term-yellowbg ((t (nil)))) - (tex-math-face ((t (nil)))) - (texinfo-heading-face ((t (nil)))) - (text-cursor ((t (nil)))) - (tool-bar ((t (nil)))) - (tooltip ((t (nil)))) - (trailing-whitespace ((t (nil)))) - (underline ((t (:underline t)))) - (variable-pitch ((t (nil)))) - (vc-annotate-face-0046FF ((t (nil)))) - (vcursor ((t (nil)))) - (vertical-divider ((t (nil)))) - (vhdl-font-lock-attribute-face ((t (nil)))) - (vhdl-font-lock-directive-face ((t (nil)))) - (vhdl-font-lock-enumvalue-face ((t (nil)))) - (vhdl-font-lock-function-face ((t (nil)))) - (vhdl-font-lock-generic-/constant-face ((t (nil)))) - (vhdl-font-lock-prompt-face ((t (nil)))) - (vhdl-font-lock-reserved-words-face ((t (nil)))) - (vhdl-font-lock-translate-off-face ((t (nil)))) - (vhdl-font-lock-type-face ((t (nil)))) - (vhdl-font-lock-variable-face ((t (nil)))) - (vhdl-speedbar-architecture-face ((t (nil)))) - (vhdl-speedbar-architecture-selected-face ((t (nil)))) - (vhdl-speedbar-configuration-face ((t (nil)))) - (vhdl-speedbar-configuration-selected-face ((t (nil)))) - (vhdl-speedbar-entity-face ((t (nil)))) - (vhdl-speedbar-entity-selected-face ((t (nil)))) - (vhdl-speedbar-instantiation-face ((t (nil)))) - (vhdl-speedbar-instantiation-selected-face ((t (nil)))) - (vhdl-speedbar-package-face ((t (nil)))) - (vhdl-speedbar-package-selected-face ((t (nil)))) - (vhdl-speedbar-subprogram-face ((t (nil)))) - (viper-minibuffer-emacs-face ((t (nil)))) - (viper-minibuffer-insert-face ((t (nil)))) - (viper-minibuffer-vi-face ((t (nil)))) - (viper-replace-overlay-face ((t (nil)))) - (viper-search-face ((t (nil)))) - (vm-xface ((t (nil)))) - (vmpc-pre-sig-face ((t (nil)))) - (vmpc-sig-face ((t (nil)))) - (w3m-anchor-face ((t (nil)))) - (w3m-arrived-anchor-face ((t (nil)))) - (w3m-header-line-location-content-face ((t (nil)))) - (w3m-header-line-location-title-face ((t (nil)))) - (white ((t (nil)))) - (widget ((t (nil)))) - (widget-button-face ((t (nil)))) - (widget-button-pressed-face ((t (nil)))) - (widget-documentation-face ((t (nil)))) - (widget-field-face ((t (nil)))) - (widget-inactive-face ((t (nil)))) - (widget-single-line-field-face ((t (nil)))) - (woman-addition-face ((t (nil)))) - (woman-bold-face ((t (nil)))) - (woman-italic-face ((t (nil)))) - (woman-unknown-face ((t (nil)))) - (x-face ((t (nil)))) - (xrdb-option-name-face ((t (nil)))) - (xref-keyword-face ((t (nil)))) - (xref-list-default-face ((t (nil)))) - (xref-list-pilot-face ((t (nil)))) - (xref-list-symbol-face ((t (nil)))) - (yellow ((t (nil)))) - (zmacs-region ((t (nil))))))) - -(defun color-theme-feng-shui () - "Color theme by walterh@rocketmail.com (www.xanadb.com), created - 2003-10-16. Evolved from color-theme-katester" - (interactive) - (color-theme-install - '(color-theme-feng-shui - ((background-color . "ivory") - (background-mode . light) - (border-color . "black") - (cursor-color . "slateblue") - (foreground-color . "black") - (mouse-color . "slateblue")) - ((help-highlight-face . underline) - (list-matching-lines-face . bold) - (view-highlight-face . highlight) - (widget-mouse-face . highlight)) - (default ((t (:stipple nil :background "ivory" :foreground "black" -:inverse-video nil :box nil :strike-through nil :overline nil -:underline nil :slant normal :weight normal :height 90 :width normal -:family "outline-courier new")))) - (bold ((t (:bold t :weight bold)))) - (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) - (border ((t (:background "black")))) - (cursor ((t (:background "slateblue" :foreground "black")))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:foreground "black")))) - (font-lock-comment-face ((t (:italic t :background "seashell" -:slant italic)))) - (font-lock-constant-face ((t (:foreground "darkblue")))) - (font-lock-doc-face ((t (:background "lemonChiffon")))) - (font-lock-function-name-face ((t (:bold t :underline t :weight -bold)))) - (font-lock-keyword-face ((t (:foreground "blue")))) - (font-lock-string-face ((t (:background "lemonChiffon")))) - (font-lock-type-face ((t (:foreground "black")))) - (font-lock-variable-name-face ((t (:foreground "black")))) - (font-lock-warning-face ((t (:bold t :foreground "Red" :weight -bold)))) - (fringe ((t (:background "grey95")))) - (header-line ((t (:bold t :weight bold :underline t :background -"grey90" :foreground "grey20" :box nil)))) - (highlight ((t (:background "mistyRose" :foreground "black")))) - (isearch ((t (:background "magenta4" :foreground -"lightskyblue1")))) - (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) - (italic ((t (:italic t :slant italic)))) - (menu ((t (nil)))) - (mode-line ((t (:bold t :background "mistyRose" :foreground "navy" -:underline t :weight bold)))) - (mouse ((t (:background "slateblue")))) - (region ((t (:background "lavender" :foreground "black")))) - (scroll-bar ((t (nil)))) - (secondary-selection ((t (:background "yellow")))) - (tool-bar ((t (:background "grey75" :foreground "black" :box -(:line-width 1 :style released-button))))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv")))) - (widget-button-face ((t (:bold t :weight bold)))) - (widget-button-pressed-face ((t (:foreground "red")))) - (widget-documentation-face ((t (:foreground "dark green")))) - (widget-field-face ((t (:background "gray85")))) - (widget-inactive-face ((t (:foreground "dim gray")))) - (widget-single-line-field-face ((t (:background "gray85"))))))) - - -(defun color-theme-renegade () - "Renegade BBS styled color theme. Works well in X and terminals. -Created by Dave Benjamin Dec 23 2005." - (interactive) - (color-theme-install - '(color-theme-renegade - ((background-color . "black") - (background-mode . dark) - (border-color . "black") - (cursor-color . "black") - (foreground-color . "cyan3") - (mouse-color . "white")) - (default ((t (nil)))) - (bold ((t (:bold t :foreground "cyan" :weight bold)))) - (bold-italic ((t (:italic t :bold t :foreground "cyan" :slant italic :weight bold)))) - (fixed-pitch ((t (:family "courier")))) - (font-lock-builtin-face ((t (:bold t :foreground "cornflower blue" :weight bold)))) - (font-lock-comment-face ((t (:bold t :foreground "yellow" :weight bold)))) - (font-lock-constant-face ((t (:foreground "magenta3")))) - (font-lock-doc-face ((t (:bold t :weight bold :foreground "red")))) - (font-lock-function-name-face ((t (:foreground "gray")))) - (font-lock-keyword-face ((t (:bold t :foreground "cyan" :weight bold)))) - (font-lock-string-face ((t (:bold t :foreground "red" :weight bold)))) - (font-lock-type-face ((t (:bold t :foreground "cyan" :weight bold)))) - (font-lock-variable-name-face ((t (:foreground "cyan3")))) - (font-lock-warning-face ((t (:bold t :foreground "red" :weight bold)))) - (fringe ((t (:background "gray32")))) - (highlight ((t (:background "blue")))) - (isearch ((t (:background "blue" :foreground "cyan3")))) - (isearch-lazy-highlight-face ((t (:background "turquoise3" :foreground "black")))) - (menu ((t (nil)))) - (mode-line ((t (:bold t :background "blue3" :foreground "white" :box (:line-width -1 :style released-button) :weight bold)))) - (mouse ((t (:background "white")))) - (region ((t (:bold t :background "white" :foreground "blue" :weight bold)))) - (scroll-bar ((t (nil)))) - (trailing-whitespace ((t (:background "red")))) - (underline ((t (:underline t)))) - (variable-pitch ((t (:family "helv"))))))) - -;;; color-theme-library.el ends here diff --git a/emacs/external/color-theme.el b/emacs/external/color-theme.el deleted file mode 100644 index 5c7d3a8..0000000 --- a/emacs/external/color-theme.el +++ /dev/null @@ -1,1668 +0,0 @@ -;;; color-theme.el --- install color themes - -;; Copyright (C) 1999, 2000 Jonadab the Unsightly One -;; Copyright (C) 2000, 2001, 2002, 2003 Alex Schroeder -;; Copyright (C) 2003, 2004, 2005, 2006 Xavier Maillard - -;; Version: 6.6.0 -;; Keywords: faces -;; Author: Jonadab the Unsightly One -;; Maintainer: Xavier Maillard -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme - -;; This file is not (YET) part of GNU Emacs. - -;; This 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 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: - -;; Please read README and BUGS files for any relevant help. -;; Contributors (not themers) should also read HACKING file. - -;;; Thanks - -;; Deepak Goel -;; S. Pokrovsky for ideas and discussion. -;; Gordon Messmer for ideas and discussion. -;; Sriram Karra for the color-theme-submit stuff. -;; Olgierd `Kingsajz' Ziolko for the spec-filter idea. -;; Brian Palmer for color-theme-library ideas and code -;; All the users that contributed their color themes. - - - -;;; Code: -(eval-when-compile - (require 'easymenu) - (require 'reporter) - (require 'sendmail)) - -(require 'cl); set-difference is a function... - -;; for custom-face-attributes-get or face-custom-attributes-get -(require 'cus-face) -(require 'wid-edit); for widget-apply stuff in cus-face.el - -(defconst color-theme-maintainer-address "zedek@gnu.org" - "Address used by `submit-color-theme'.") - -;; Emacs / XEmacs compatibility and workaround layer - -(cond ((and (facep 'tool-bar) - (not (facep 'toolbar))) - (put 'toolbar 'face-alias 'tool-bar)) - ((and (facep 'toolbar) - (not (facep 'tool-bar))) - (put 'tool-bar 'face-alias 'toolbar))) - -(defvar color-theme-xemacs-p (and (featurep 'xemacs) - (string-match "XEmacs" emacs-version)) - "Non-nil if running XEmacs.") - -;; Add this since it appears to miss in emacs-2x -(or (fboundp 'replace-in-string) - (defun replace-in-string (target old new) - (replace-regexp-in-string old new target))) - -;; face-attr-construct has a problem in Emacs 20.7 and older when -;; dealing with inverse-video faces. Here is a short test to check -;; wether you are affected. - -;; (set-background-color "wheat") -;; (set-foreground-color "black") -;; (setq a (make-face 'a-face)) -;; (face-spec-set a '((t (:background "white" :foreground "black" :inverse-video t)))) -;; (face-attr-construct a) -;; => (:background "black" :inverse-video t) - -;; The expected response is the original specification: -;; => (:background "white" :foreground "black" :inverse-video t) - -;; That's why we depend on cus-face.el functionality. - -(cond ((fboundp 'custom-face-attributes-get) - (defun color-theme-face-attr-construct (face frame) - (if (atom face) - (custom-face-attributes-get face frame) - (if (and (consp face) (eq (car face) 'quote)) - (custom-face-attributes-get (cadr face) frame) - (custom-face-attributes-get (car face) frame))))) - ((fboundp 'face-custom-attributes-get) - (defalias 'color-theme-face-attr-construct - 'face-custom-attributes-get)) - (t - (defun color-theme-face-attr-construct (&rest ignore) - (error "Unable to construct face attributes")))) - -(defun color-theme-alist (plist) - "Transform PLIST into an alist if it is a plist and return it. -If the first element of PLIST is a cons cell, we just return PLIST, -assuming PLIST to be an alist. If the first element of plist is not a -symbol, this is an error: We cannot distinguish a plist from an ordinary -list, but a list that doesn't start with a symbol is certainly no plist -and no alist. - -This is used to make sure `default-frame-alist' really is an alist and not -a plist. In XEmacs, the alist is deprecated; a plist is used instead." - (cond ((consp (car plist)) - plist) - ((not (symbolp (car plist))) - (error "Wrong type argument: plist, %S" plist)) - ((featurep 'xemacs) - (plist-to-alist plist)))); XEmacs only - -;; Customization - -(defgroup color-theme nil - "Color Themes for Emacs. -A color theme consists of frame parameter settings, variable settings, -and face definitions." - :version "20.6" - :group 'faces) - -(defcustom color-theme-legal-frame-parameters "\\(color\\|mode\\)$" - "Regexp that matches frame parameter names. -Only frame parameter names that match this regexp can be changed as part -of a color theme." - :type '(choice (const :tag "Colors only" "\\(color\\|mode\\)$") - (const :tag "Colors, fonts, and size" - "\\(color\\|mode\\|font\\|height\\|width\\)$") - (regexp :tag "Custom regexp")) - :group 'color-theme - :link '(info-link "(elisp)Window Frame Parameters")) - -(defcustom color-theme-legal-variables "\\(color\\|face\\)$" - "Regexp that matches variable names. -Only variables that match this regexp can be changed as part of a color -theme. In addition to matching this name, the variables have to be user -variables (see function `user-variable-p')." - :type 'regexp - :group 'color-theme) - -(defcustom color-theme-illegal-faces "^w3-" - "Regexp that matches face names forbidden in themes. -The default setting \"^w3-\" excludes w3 faces since these -are created dynamically." - :type 'regexp - :group 'color-theme - :link '(info-link "(elisp)Faces for Font Lock") - :link '(info-link "(elisp)Standard Faces")) - -(defcustom color-theme-illegal-default-attributes '(:family :height :width) - "A list of face properties to be ignored when installing faces. -This prevents Emacs from doing terrible things to your display just because -a theme author likes weird fonts." - :type '(repeat symbol) - :group 'color-theme) - -(defcustom color-theme-is-global t - "*Determines wether a color theme is installed on all frames or not. -If non-nil, color themes will be installed for all frames. -If nil, color themes will be installed for the selected frame only. - -A possible use for this variable is dynamic binding. Here is a larger -example to put in your ~/.emacs; it will make the Blue Sea color theme -the default used for the first frame, and it will create two additional -frames with different color themes. - -setup: - \(require 'color-theme) - ;; set default color theme - \(color-theme-blue-sea) - ;; create some frames with different color themes - \(let ((color-theme-is-global nil)) - \(select-frame (make-frame)) - \(color-theme-gnome2) - \(select-frame (make-frame)) - \(color-theme-standard)) - -Please note that using XEmacs and and a nil value for -color-theme-is-global will ignore any variable settings for the color -theme, since XEmacs doesn't have frame-local variable bindings. - -Also note that using Emacs and a non-nil value for color-theme-is-global -will install a new color theme for all frames. Using XEmacs and a -non-nil value for color-theme-is-global will install a new color theme -only on those frames that are not using a local color theme." - :type 'boolean - :group 'color-theme) - -(defcustom color-theme-is-cumulative t - "*Determines wether new color themes are installed on top of each other. -If non-nil, installing a color theme will undo all settings made by -previous color themes." - :type 'boolean - :group 'color-theme) - -(defcustom color-theme-directory nil - "Directory where we can find additionnal themes (personnal). -Note that there is at least one directory shipped with the official -color-theme distribution where all contributed themes are located. -This official selection can't be changed with that variable. -However, you still can decide to turn it on or off and thus, -not be shown with all themes but yours." - :type '(repeat string) - :group 'color-theme) - -(defcustom color-theme-libraries (directory-files - (concat - (file-name-directory (locate-library "color-theme")) - "/themes") t "^color-theme") - "A list of files, which will be loaded in color-theme-initialize depending -on `color-theme-load-all-themes' value. -This allows a user to prune the default color-themes (which can take a while -to load)." - :type '(repeat string) - :group 'color-theme) - -(defcustom color-theme-load-all-themes t - "When t, load all color-theme theme files -as presented by `color-theme-libraries'. Else -do not load any of this themes." - :type 'boolean - :group 'color-theme) - -(defcustom color-theme-mode-hook nil - "Hook for color-theme-mode." - :type 'hook - :group 'color-theme) - -(defvar color-theme-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'color-theme-install-at-point) - (define-key map (kbd "c") 'list-colors-display) - (define-key map (kbd "d") 'color-theme-describe) - (define-key map (kbd "f") 'list-faces-display) - (define-key map (kbd "i") 'color-theme-install-at-point) - (define-key map (kbd "l") 'color-theme-install-at-point-for-current-frame) - (define-key map (kbd "p") 'color-theme-print) - (define-key map (kbd "q") 'bury-buffer) - (define-key map (kbd "?") 'color-theme-describe) - (if color-theme-xemacs-p - (define-key map (kbd "") 'color-theme-install-at-mouse) - (define-key map (kbd "") 'color-theme-install-at-mouse)) - map) - "Mode map used for the buffer created by `color-theme-select'.") - -(defvar color-theme-initialized nil - "Internal variable determining whether color-theme-initialize has been invoked yet") - -(defvar color-theme-buffer-name "*Color Theme Selection*" - "Name of the color theme selection buffer.") - -(defvar color-theme-original-frame-alist nil - "nil until one of the color themes has been installed.") - -(defvar color-theme-history nil - "List of color-themes called, in reverse order") - -(defcustom color-theme-history-max-length nil - "Max length of history to maintain. -Two other values are acceptable: t means no limit, and -nil means that no history is maintained." - :type '(choice (const :tag "No history" nil) - (const :tag "Unlimited length" t) - integer) - :group 'color-theme) - -(defvar color-theme-counter 0 - "Counter for every addition to `color-theme-history'. -This counts how many themes were installed, regardless -of `color-theme-history-max-length'.") - -(defvar color-theme-entry-path (cond - ;; Emacs 22.x and later - ((lookup-key global-map [menu-bar tools]) - '("tools")) - ;; XEmacs - ((featurep 'xemacs) - (setq tool-entry '("Tools"))) - ;; Emacs < 22 - (t - '("Tools"))) - "Menu tool entry path.") - -(defun color-theme-add-to-history (name) - "Add color-theme NAME to `color-theme-history'." - (setq color-theme-history - (cons (list name color-theme-is-cumulative) - color-theme-history) - color-theme-counter (+ 1 color-theme-counter)) - ;; Truncate the list if necessary. - (when (and (integerp color-theme-history-max-length) - (>= (length color-theme-history) - color-theme-history-max-length)) - (setcdr (nthcdr (1- color-theme-history-max-length) - color-theme-history) - nil))) - -;; (let ((l '(1 2 3 4 5))) -;; (setcdr (nthcdr 2 l) nil) -;; l) - - - -;; List of color themes used to create the *Color Theme Selection* -;; buffer. - -(defvar color-themes - '((color-theme-aalto-dark "Aalto Dark" "Jari Aalto ") - (color-theme-aalto-light "Aalto Light" "Jari Aalto ") - (color-theme-aliceblue "Alice Blue" "Girish Bharadwaj ") - (color-theme-andreas "Andreas" "Andreas Busch ") - (color-theme-arjen "Arjen" "Arjen Wiersma ") - (color-theme-beige-diff "Beige Diff" "Alex Schroeder " t) - (color-theme-bharadwaj "Bharadwaj" "Girish Bharadwaj ") - (color-theme-bharadwaj-slate "Bharadwaj Slate" "Girish Bharadwaj ") - (color-theme-billw "Billw" "Bill White ") - (color-theme-black-on-gray "BlackOnGray" "Sudhir Bhojwani ") - (color-theme-blippblopp "Blipp Blopp" "Thomas Sicheritz-Ponten") - (color-theme-simple-1 "Black" "Jonadab ") - (color-theme-blue-erc "Blue ERC" "Alex Schroeder " t) - (color-theme-blue-gnus "Blue Gnus" "Alex Schroeder " t) - (color-theme-blue-mood "Blue Mood" "Nelson Loyola ") - (color-theme-blue-sea "Blue Sea" "Alex Schroeder ") - (color-theme-calm-forest "Calm Forest" "Artur Hefczyc ") - (color-theme-charcoal-black "Charcoal Black" "Lars Chr. Hausmann ") - (color-theme-goldenrod "Cheap Goldenrod" "Alex Schroeder ") - (color-theme-clarity "Clarity and Beauty" "Richard Wellum ") - (color-theme-classic "Classic" "Frederic Giroud ") - (color-theme-comidia "Comidia" "Marcelo Dias de Toledo ") - (color-theme-jsc-dark "Cooper Dark" "John S Cooper ") - (color-theme-jsc-light "Cooper Light" "John S Cooper ") - (color-theme-jsc-light2 "Cooper Light 2" "John S Cooper ") - (color-theme-dark-blue "Dark Blue" "Chris McMahan ") - (color-theme-dark-blue2 "Dark Blue 2" "Chris McMahan ") - (color-theme-dark-green "Dark Green" "eddy_woody@hotmail.com") - (color-theme-dark-laptop "Dark Laptop" "Laurent Michel ") - (color-theme-deep-blue "Deep Blue" "Tomas Cerha ") - (color-theme-digital-ofs1 "Digital OFS1" "Gareth Owen ") - (color-theme-euphoria "Euphoria" "oGLOWo@oGLOWo.cjb.net") - (color-theme-feng-shui "Feng Shui" "Walter Higgins ") - (color-theme-fischmeister "Fischmeister" - "Sebastian Fischmeister ") - (color-theme-gnome "Gnome" "Jonadab ") - (color-theme-gnome2 "Gnome 2" "Alex Schroeder ") - (color-theme-gray1 "Gray1" "Paul Pulli ") - (color-theme-gray30 "Gray30" "Girish Bharadwaj ") - (color-theme-kingsajz "Green Kingsajz" "Olgierd `Kingsajz' Ziolko ") - (color-theme-greiner "Greiner" "Kevin Greiner ") - (color-theme-gtk-ide "GTK IDE" "Gordon Messmer ") - (color-theme-high-contrast "High Contrast" "Alex Schroeder ") - (color-theme-hober "Hober" "Edward O'Connor ") - (color-theme-infodoc "Infodoc" "Frederic Giroud ") - (color-theme-jb-simple "JB Simple" "jeff@dvns.com") - (color-theme-jedit-grey "Jedit Grey" "Gordon Messmer ") - (color-theme-jonadabian "Jonadab" "Jonadab ") - (color-theme-jonadabian-slate "Jonadabian Slate" "Jonadab ") - (color-theme-katester "Katester" "Higgins_Walter@emc.com") - (color-theme-late-night "Late Night" "Alex Schroeder ") - (color-theme-lawrence "Lawrence" "lawrence mitchell ") - (color-theme-lethe "Lethe" "Ivica Loncar ") - (color-theme-ld-dark "Linh Dang Dark" "Linh Dang ") - (color-theme-marine "Marine" "Girish Bharadwaj ") - (color-theme-matrix "Matrix" "Walter Higgins ") - (color-theme-marquardt "Marquardt" "Colin Marquardt ") - (color-theme-midnight "Midnight" "Gordon Messmer ") - (color-theme-mistyday "Misty Day" "Hari Kumar ") - (color-theme-montz "Montz" "Brady Montz ") - (color-theme-oswald "Oswald" "Tom Oswald ") - (color-theme-parus "Parus" "Jon K Hellan ") - (color-theme-pierson "Pierson" "Dan L. Pierson ") - (color-theme-ramangalahy "Ramangalahy" "Solofo Ramangalahy ") - (color-theme-raspopovic "Raspopovic" "Pedja Raspopovic ") - (color-theme-renegade "Renegade" "Dave Benjamin ") - (color-theme-resolve "Resolve" "Damien Elmes ") - (color-theme-retro-green "Retro Green" "Alex Schroeder ") - (color-theme-retro-orange "Retro Orange" "Alex Schroeder ") - (color-theme-robin-hood "Robin Hood" "Alex Schroeder ") - (color-theme-rotor "Rotor" "Jinwei Shen ") - (color-theme-ryerson "Ryerson" "Luis Fernandes ") - (color-theme-salmon-diff "Salmon Diff" "Alex Schroeder " t) - (color-theme-salmon-font-lock "Salmon Font-Lock" "Alex Schroeder " t) - (color-theme-scintilla "Scintilla" "Gordon Messmer ") - (color-theme-shaman "Shaman" "shaman@interdon.net") - (color-theme-sitaramv-nt "Sitaram NT" - "Sitaram Venkatraman ") - (color-theme-sitaramv-solaris "Sitaram Solaris" - "Sitaram Venkatraman ") - (color-theme-snow "Snow" "Nicolas Rist ") - (color-theme-snowish "Snowish" "Girish Bharadwaj ") - (color-theme-standard-ediff "Standard Ediff" "Emacs Team, added by Alex Schroeder " t) - (color-theme-standard "Standard Emacs 20" "Emacs Team, added by Alex Schroeder ") - (color-theme-emacs-21 "Standard Emacs 21" "Emacs Team, added by Alex Schroeder ") - (color-theme-emacs-nw "Standard Emacs 21 No Window" "Emacs Team, added by D. Goel ") - (color-theme-xemacs "Standard XEmacs" "XEmacs Team, added by Alex Schroeder ") - (color-theme-subtle-blue "Subtle Blue" "Chris McMahan ") - (color-theme-subtle-hacker "Subtle Hacker" "Colin Walters ") - (color-theme-taming-mr-arneson "Taming Mr Arneson" "Erik Arneson ") - (color-theme-taylor "Taylor" "Art Taylor ") - (color-theme-tty-dark "TTY Dark" "O Polite ") - (color-theme-vim-colors "Vim Colors" "Michael Soulier ") - (color-theme-whateveryouwant "Whateveryouwant" "Fabien Penso , color by Scott Jaderholm ") - (color-theme-wheat "Wheat" "Alex Schroeder ") - (color-theme-pok-wob "White On Black" "S. Pokrovsky ") - (color-theme-pok-wog "White On Grey" "S. Pokrovsky ") - (color-theme-word-perfect "WordPerfect" "Thomas Gehrlein ") - (color-theme-xp "XP" "Girish Bharadwaj ")) - "List of color themes. - -Each THEME is itself a three element list (FUNC NAME MAINTAINER &optional LIBRARY). - -FUNC is a color theme function which does the setup. The function -FUNC may call `color-theme-install'. The color theme function may be -interactive. - -NAME is the name of the theme and MAINTAINER is the name and/or email of -the maintainer of the theme. - -If LIBRARY is non-nil, the color theme will be considered a library and -may not be shown in the default menu. - -If you defined your own color theme and want to add it to this list, -use something like this: - - (add-to-list 'color-themes '(color-theme-gnome2 \"Gnome2\" \"Alex\"))") - -;;; Functions - -(defun color-theme-backup-original-values () - "Back up the original `default-frame-alist'. -The values are stored in `color-theme-original-frame-alist' on -startup." - (if (null color-theme-original-frame-alist) - (setq color-theme-original-frame-alist - (color-theme-filter (frame-parameters (selected-frame)) - color-theme-legal-frame-parameters)))) -(add-hook 'after-init-hook 'color-theme-backup-original-values) - -;;;###autoload -(defun color-theme-select (&optional arg) - "Displays a special buffer for selecting and installing a color theme. -With optional prefix ARG, this buffer will include color theme libraries -as well. A color theme library is in itself not complete, it must be -used as part of another color theme to be useful. Thus, color theme -libraries are mainly useful for color theme authors." - (interactive "P") - (unless color-theme-initialized (color-theme-initialize)) - (switch-to-buffer (get-buffer-create color-theme-buffer-name)) - (setq buffer-read-only nil) - (erase-buffer) - ;; recreate the snapshot if necessary - (when (or (not (assq 'color-theme-snapshot color-themes)) - (not (commandp 'color-theme-snapshot))) - (fset 'color-theme-snapshot (color-theme-make-snapshot)) - (setq color-themes (delq (assq 'color-theme-snapshot color-themes) - color-themes) - color-themes (delq (assq 'bury-buffer color-themes) - color-themes) - color-themes (append '((color-theme-snapshot - "[Reset]" "Undo changes, if possible.") - (bury-buffer - "[Quit]" "Bury this buffer.")) - color-themes))) - (dolist (theme color-themes) - (let ((func (nth 0 theme)) - (name (nth 1 theme)) - (author (nth 2 theme)) - (library (nth 3 theme)) - (desc)) - (when (or (not library) arg) - (setq desc (format "%-23s %s" - (if library (concat name " [lib]") name) - author)) - (put-text-property 0 (length desc) 'color-theme func desc) - (put-text-property 0 (length name) 'face 'bold desc) - (put-text-property 0 (length name) 'mouse-face 'highlight desc) - (insert desc) - (newline)))) - (goto-char (point-min)) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (color-theme-mode)) - -(when (require 'easymenu) - (easy-menu-add-item nil color-theme-entry-path "--") - (easy-menu-add-item nil color-theme-entry-path - ["Color Themes" color-theme-select t])) - -(defun color-theme-mode () - "Major mode to select and install color themes. - -Use \\[color-theme-install-at-point] to install a color theme on all frames. -Use \\[color-theme-install-at-point-for-current-frame] to install a color theme for the current frame only. - -The changes are applied on top of your current setup. This is a -feature. - -Some of the themes should be considered extensions to the standard color -theme: they modify only a limited number of faces and variables. To -verify the final look of a color theme, install the standard color -theme, then install the other color theme. This is a feature. It allows -you to mix several color themes. - -Use \\[color-theme-describe] to read more about the color theme function at point. -If you want to install the color theme permanently, put the call to the -color theme function into your ~/.emacs: - - \(require 'color-theme) - \(color-theme-gnome2) - -If you worry about the size of color-theme.el: You are right. Use -\\[color-theme-print] to print the current color theme and save the resulting buffer -as ~/.emacs-color-theme. Now you can install only this specific color -theme in your .emacs: - - \(load-file \"~/.emacs-color-theme\") - \(my-color-theme) - -The Emacs menu is not affected by color themes within Emacs. Depending -on the toolkit you used to compile Emacs, you might have to set specific -X ressources. See the info manual for more information. Here is an -example ~/.Xdefaults fragment: - - emacs*Background: DarkSlateGray - emacs*Foreground: wheat - -\\{color-theme-mode-map} - -The color themes are listed in `color-themes', which see." - (kill-all-local-variables) - (setq major-mode 'color-theme-mode) - (setq mode-name "Color Themes") - (use-local-map color-theme-mode-map) - (when (functionp 'goto-address); Emacs - (goto-address)) - (run-hooks 'color-theme-mode-hook)) - -;;; Commands in Color Theme Selection mode - -;;;###autoload -(defun color-theme-describe () - "Describe color theme listed at point. -This shows the documentation of the value of text-property color-theme -at point. The text-property color-theme should be a color theme -function. See `color-themes'." - (interactive) - (describe-function (get-text-property (point) 'color-theme))) - -;;;###autoload -(defun color-theme-install-at-mouse (event) - "Install color theme clicked upon using the mouse. -First argument EVENT is used to set point. Then -`color-theme-install-at-point' is called." - (interactive "e") - (save-excursion - (mouse-set-point event) - (color-theme-install-at-point))) - -;;;autoload -(defun color-theme-install-at-point () - "Install color theme at point. -This calls the value of the text-property `color-theme' at point. -The text-property `color-theme' should be a color theme function. -See `color-themes'." - (interactive) - (let ((func (get-text-property (point) 'color-theme))) - ;; install theme - (if func - (funcall func)) - ;; If goto-address is being used, remove all overlays in the current - ;; buffer and run it again. The face used for the mail addresses in - ;; the the color theme selection buffer is based on the variable - ;; goto-address-mail-face. Changes in that variable will not affect - ;; existing overlays, however, thereby confusing users. - (when (functionp 'goto-address); Emacs - (dolist (o (overlays-in (point-min) (point-max))) - (delete-overlay o)) - (goto-address)))) - -;;;###autoload -(defun color-theme-install-at-point-for-current-frame () - "Install color theme at point for current frame only. -Binds `color-theme-is-global' to nil and calls -`color-theme-install-at-point'." - (interactive) - (let ((color-theme-is-global nil)) - (color-theme-install-at-point))) - - - -;; Taking a snapshot of the current color theme and pretty printing it. - -(defun color-theme-filter (old-list regexp &optional exclude) - "Filter OLD-LIST. -The resulting list will be newly allocated and contains only elements -with names matching REGEXP. OLD-LIST may be a list or an alist. If you -want to filter a plist, use `color-theme-alist' to convert your plist to -an alist, first. - -If the optional argument EXCLUDE is non-nil, then the sense is -reversed: only non-matching elements will be retained." - (let (elem new-list) - (dolist (elem old-list) - (setq name (symbol-name (if (listp elem) (car elem) elem))) - (when (or (and (not exclude) - (string-match regexp name)) - (and exclude - (not (string-match regexp name)))) - ;; Now make sure that if elem is a cons cell, and the cdr of - ;; that cons cell is a string, then we need a *new* string in - ;; the new list. Having a new cons cell is of no use because - ;; modify-frame-parameters will modify this string, thus - ;; modifying our color theme functions! - (when (and (consp elem) - (stringp (cdr elem))) - (setq elem (cons (car elem) - (copy-sequence (cdr elem))))) - ;; Now store elem - (setq new-list (cons elem new-list)))) - new-list)) - -(defun color-theme-spec-filter (spec) - "Filter the attributes in SPEC. -This makes sure that SPEC has the form ((t (PLIST ...))). -Only properties not in `color-theme-illegal-default-attributes' -are included in the SPEC returned." - (let ((props (cadar spec)) - result prop val) - (while props - (setq prop (nth 0 props) - val (nth 1 props) - props (nthcdr 2 props)) - (unless (memq prop color-theme-illegal-default-attributes) - (setq result (cons val (cons prop result))))) - `((t ,(nreverse result))))) - -;; (color-theme-spec-filter '((t (:background "blue3")))) -;; (color-theme-spec-filter '((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed")))) - -(defun color-theme-plist-delete (plist prop) - "Delete property PROP from property list PLIST by side effect. -This modifies PLIST." - ;; deal with prop at the start - (while (eq (car plist) prop) - (setq plist (cddr plist))) - ;; deal with empty plist - (when plist - (let ((lastcell (cdr plist)) - (l (cddr plist))) - (while l - (if (eq (car l) prop) - (progn - (setq l (cddr l)) - (setcdr lastcell l)) - (setq lastcell (cdr l) - l (cddr l)))))) - plist) - -;; (color-theme-plist-delete '(a b c d e f g h) 'a) -;; (color-theme-plist-delete '(a b c d e f g h) 'b) -;; (color-theme-plist-delete '(a b c d e f g h) 'c) -;; (color-theme-plist-delete '(a b c d e f g h) 'g) -;; (color-theme-plist-delete '(a b c d c d e f g h) 'c) -;; (color-theme-plist-delete '(a b c d e f c d g h) 'c) - -(if (or (featurep 'xemacs) - (< emacs-major-version 21)) - (defalias 'color-theme-spec-compat 'identity) - (defun color-theme-spec-compat (spec) - "Filter the attributes in SPEC such that is is never invalid. -Example: Eventhough :bold works in Emacs, it is not recognized by -`customize-face' -- and then the face is uncustomizable. This -function replaces a :bold attribute with the corresponding :weight -attribute, if there is no :weight, or deletes it. This undoes the -doings of `color-theme-spec-canonical-font', more or less." - (let ((props (cadar spec))) - (when (plist-member props :bold) - (setq props (color-theme-plist-delete props :bold)) - (unless (plist-member props :weight) - (setq props (plist-put props :weight 'bold)))) - (when (plist-member props :italic) - (setq props (color-theme-plist-delete props :italic)) - (unless (plist-member props :slant) - (setq props (plist-put props :slant 'italic)))) - `((t ,props))))) - -;; (color-theme-spec-compat '((t (:foreground "blue" :bold t)))) -;; (color-theme-spec-compat '((t (:bold t :foreground "blue" :weight extra-bold)))) -;; (color-theme-spec-compat '((t (:italic t :foreground "blue")))) -;; (color-theme-spec-compat '((t (:slant oblique :italic t :foreground "blue")))) - -(defun color-theme-spec-canonical-font (atts) - "Add :bold and :italic attributes if necessary." - ;; add these to the front of atts -- this will keept the old value for - ;; customize-face in Emacs 21. - (when (and (memq (plist-get atts :weight) - '(ultra-bold extra-bold bold semi-bold)) - (not (plist-get atts :bold))) - (setq atts (cons :bold (cons t atts)))) - (when (and (not (memq (plist-get atts :slant) - '(normal nil))) - (not (plist-get atts :italic))) - (setq atts (cons :italic (cons t atts)))) - atts) -;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'bold (selected-frame))) -;; (defface foo '((t (:weight extra-bold))) "foo") -;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'foo (selected-frame))) -;; (face-spec-set 'foo '((t (:weight extra-bold))) nil) -;; (face-spec-set 'foo '((t (:bold t))) nil) -;; (face-spec-set 'foo '((t (:bold t :weight extra-bold))) nil) - -;; Handle :height according to NEWS file for Emacs 21 -(defun color-theme-spec-resolve-height (old new) - "Return the new height given OLD and NEW height. -OLD is the current setting, NEW is the setting inherited from." - (cond ((not old) - new) - ((integerp old) - old) - ((and (floatp old) - (integerp new)) - (round (* old new))) - ((and (floatp old) - (floatp new)) - (* old new)) - ((and (functionp old) - (integerp new)) - (round (funcall old new))) - ((and (functionp old) - (float new)) - `(lambda (f) (* (funcall ,old f) ,new))) - ((and (functionp old) - (functionp new)) - `(lambda (f) (* (funcall ,old (funcall ,new f))))) - (t - (error "Illegal :height attributes: %S or %S" old new)))) -;; (color-theme-spec-resolve-height 12 1.2) -;; (color-theme-spec-resolve-height 1.2 1.2) -;; (color-theme-spec-resolve-height 1.2 12) -;; (color-theme-spec-resolve-height 1.2 'foo) -;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 5) -;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 2.0) -;; the following lambda is the result from the above calculation -;; (color-theme-spec-resolve-height (lambda (f) (* (funcall (lambda (f) (* 2 f)) f) 2.0)) 5) - -(defun color-theme-spec-resolve-inheritance (atts) - "Resolve all occurences of the :inherit attribute." - (let ((face (plist-get atts :inherit))) - ;; From the Emacs 21 NEWS file: "Attributes from inherited faces are - ;; merged into the face like an underlying face would be." -- - ;; therefore properties of the inherited face only add missing - ;; attributes. - (when face - ;; remove :inherit face from atts -- this assumes only one - ;; :inherit attribute. - (setq atts (delq ':inherit (delq face atts))) - (let ((more-atts (color-theme-spec-resolve-inheritance - (color-theme-face-attr-construct - face (selected-frame)))) - att val) - (while more-atts - (setq att (car more-atts) - val (cadr more-atts) - more-atts (cddr more-atts)) - ;; Color-theme assumes that no value is ever 'unspecified. - (cond ((eq att ':height); cumulative effect! - (setq atts (plist-put atts - ':height - (color-theme-spec-resolve-height - (plist-get atts att) - val)))) - ;; Default: Only put if it has not been specified before. - ((not (plist-get atts att)) - (setq atts (cons att (cons val atts)))) - -)))) - atts)) -;; (color-theme-spec-resolve-inheritance '(:bold t)) -;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "blue")) -;; (color-theme-face-attr-construct 'font-lock-comment-face (selected-frame)) -;; (color-theme-spec-resolve-inheritance '(:bold t :inherit font-lock-comment-face)) -;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "red" :inherit font-lock-comment-face)) -;; (color-theme-face-attr-construct 'Info-title-2-face (selected-frame)) -;; (color-theme-face-attr-construct 'Info-title-3-face (selected-frame)) -;; (color-theme-face-attr-construct 'Info-title-4-face (selected-frame)) -;; (color-theme-spec-resolve-inheritance '(:inherit Info-title-2-face)) - -;; The :inverse-video attribute causes Emacs to swap foreground and -;; background colors, XEmacs does not. Therefore, if anybody chooses -;; the inverse-video attribute, we 1. swap the colors ourselves in Emacs -;; and 2. we remove the inverse-video attribute in Emacs and XEmacs. -;; Inverse-video is only useful on a monochrome tty. -(defun color-theme-spec-maybe-invert (atts) - "Remove the :inverse-video attribute from ATTS. -If ATTS contains :inverse-video t, remove it and swap foreground and -background color. Return ATTS." - (let ((inv (plist-get atts ':inverse-video))) - (if inv - (let (result att) - (while atts - (setq att (car atts) - atts (cdr atts)) - (cond ((and (eq att :foreground) (not color-theme-xemacs-p)) - (setq result (cons :background result))) - ((and (eq att :background) (not color-theme-xemacs-p)) - (setq result (cons :foreground result))) - ((eq att :inverse-video) - (setq atts (cdr atts))); this prevents using dolist - (t - (setq result (cons att result))))) - (nreverse result)) - ;; else - atts))) -;; (color-theme-spec-maybe-invert '(:bold t)) -;; (color-theme-spec-maybe-invert '(:foreground "blue")) -;; (color-theme-spec-maybe-invert '(:background "red")) -;; (color-theme-spec-maybe-invert '(:inverse-video t)) -;; (color-theme-spec-maybe-invert '(:inverse-video t :foreground "red")) -;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red")) -;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red" :foreground "blue" :bold t)) -;; (color-theme-spec-maybe-invert '(:inverse-video nil :background "red" :foreground "blue" :bold t)) - -(defun color-theme-spec (face) - "Return a list for FACE which has the form (FACE SPEC). -See `defface' for the format of SPEC. In this case we use only one -DISPLAY, t, and determine ATTS using `color-theme-face-attr-construct'. -If ATTS is nil, (nil) is used instead. - -If ATTS contains :inverse-video t, we remove it and swap foreground and -background color using `color-theme-spec-maybe-invert'. We do this -because :inverse-video is handled differently in Emacs and XEmacs. We -will loose on a tty without colors, because in that situation, -:inverse-video means something." - (let ((atts - (color-theme-spec-canonical-font - (color-theme-spec-maybe-invert - (color-theme-spec-resolve-inheritance - (color-theme-face-attr-construct face (selected-frame))))))) - (if atts - `(,face ((t ,atts))) - `(,face ((t (nil))))))) - -(defun color-theme-get-params () - "Return a list of frame parameter settings usable in a color theme. -Such an alist may be installed by `color-theme-install-frame-params'. The -frame parameters returned must match `color-theme-legal-frame-parameters'." - (let ((params (color-theme-filter (frame-parameters (selected-frame)) - color-theme-legal-frame-parameters))) - (sort params (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b))))))) - -(defun color-theme-get-vars () - "Return a list of variable settings usable in a color theme. -Such an alist may be installed by `color-theme-install-variables'. -The variable names must match `color-theme-legal-variables', and the -variable must be a user variable according to `user-variable-p'." - (let ((vars) - (val)) - (mapatoms (lambda (v) - (and (boundp v) - (user-variable-p v) - (string-match color-theme-legal-variables - (symbol-name v)) - (setq val (eval v)) - (add-to-list 'vars (cons v val))))) - (sort vars (lambda (a b) (string< (car a) (car b)))))) - -(defun color-theme-print-alist (alist) - "Print ALIST." - (insert "\n " (if alist "(" "nil")) - (dolist (elem alist) - (when (= (preceding-char) ?\)) - (insert "\n ")) - (prin1 elem (current-buffer))) - (when (= (preceding-char) ?\)) (insert ")"))) - -(defun color-theme-get-faces () - "Return a list of faces usable in a color theme. -Such an alist may be installed by `color-theme-install-faces'. The -faces returned must not match `color-theme-illegal-faces'." - (let ((faces (color-theme-filter (face-list) color-theme-illegal-faces t))) - ;; default face must come first according to comments in - ;; custom-save-faces, the rest is to be sorted by name - (cons 'default (sort (delq 'default faces) 'string-lessp)))) - -(defun color-theme-get-face-definitions () - "Return face settings usable in a color-theme." - (let ((faces (color-theme-get-faces))) - (mapcar 'color-theme-spec faces))) - -(defun color-theme-print-faces (faces) - "Print face settings for all faces returned by `color-theme-get-faces'." - (when faces - (insert "\n ")) - (dolist (face faces) - (when (= (preceding-char) ?\)) - (insert "\n ")) - (prin1 face (current-buffer)))) - -(defun color-theme-reset-faces () - "Reset face settings for all faces returned by `color-theme-get-faces'." - (let ((faces (color-theme-get-faces)) - (face) (spec) (entry) - (frame (if color-theme-is-global nil (selected-frame)))) - (while faces - (setq entry (color-theme-spec (car faces))) - (setq face (nth 0 entry)) - (setq spec '((t (nil)))) - (setq faces (cdr faces)) - (if (functionp 'face-spec-reset-face) - (face-spec-reset-face face frame) - (face-spec-set face spec frame) - (if color-theme-is-global - (put face 'face-defface-spec spec)))))) - -(defun color-theme-print-theme (func doc params vars faces) - "Print a theme into the current buffer. -FUNC is the function name, DOC the doc string, PARAMS the -frame parameters, VARS the variable bindings, and FACES -the list of faces and their specs." - (insert "(defun " (symbol-name func) " ()\n" - " \"" doc "\"\n" - " (interactive)\n" - " (color-theme-install\n" - " '(" (symbol-name func)) - ;; alist of frame parameters - (color-theme-print-alist params) - ;; alist of variables - (color-theme-print-alist vars) - ;; remaining elements of snapshot: face specs - (color-theme-print-faces faces) - (insert ")))\n") - (insert "(add-to-list 'color-themes '(" (symbol-name func) " " - " \"THEME NAME\" \"YOUR NAME\"))") - (goto-char (point-min))) - -;;;###autoload -(defun color-theme-print (&optional buf) - "Print the current color theme function. - -You can contribute this function to or -paste it into your .emacs file and call it. That should recreate all -the settings necessary for your color theme. - -Example: - - \(require 'color-theme) - \(defun my-color-theme () - \"Color theme by Alex Schroeder, created 2000-05-17.\" - \(interactive) - \(color-theme-install - '(... - ... - ...))) - \(my-color-theme) - -If you want to use a specific color theme function, you can call the -color theme function in your .emacs directly. - -Example: - - \(require 'color-theme) - \(color-theme-gnome2)" - (interactive) - (message "Pretty printing current color theme function...") - (switch-to-buffer (if buf - buf - (get-buffer-create "*Color Theme*"))) - (unless buf - (setq buffer-read-only nil) - (erase-buffer)) - ;; insert defun - (insert "(eval-when-compile" - " (require 'color-theme))\n") - (color-theme-print-theme 'my-color-theme - (concat "Color theme by " - (if (string= "" user-full-name) - (user-login-name) - user-full-name) - ", created " (format-time-string "%Y-%m-%d") ".") - (color-theme-get-params) - (color-theme-get-vars) - (mapcar 'color-theme-spec (color-theme-get-faces))) - (unless buf - (emacs-lisp-mode)) - (goto-char (point-min)) - (message "Pretty printing current color theme function... done")) - -(defun color-theme-analyze-find-theme (code) - "Find the sexpr that calls `color-theme-install'." - (let (theme) - (while (and (not theme) code) - (when (eq (car code) 'color-theme-install) - (setq theme code)) - (when (listp (car code)) - (setq theme (color-theme-analyze-find-theme (car code)))) - (setq code (cdr code))) - theme)) - -;; (equal (color-theme-analyze-find-theme -;; '(defun color-theme-blue-eshell () -;; "Color theme for eshell faces only." -;; (color-theme-install -;; '(color-theme-blue-eshell -;; nil -;; (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) -;; (eshell-ls-backup-face ((t (:foreground "Grey")))))))) -;; '(color-theme-install -;; (quote -;; (color-theme-blue-eshell -;; nil -;; (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) -;; (eshell-ls-backup-face ((t (:foreground "Grey"))))))))) - -(defun color-theme-analyze-add-face (a b regexp faces) - "If only one of A or B are in FACES, the other is added, and FACES is returned. -If REGEXP is given, this is only done if faces contains a match for regexps." - (when (or (not regexp) - (catch 'found - (dolist (face faces) - (when (string-match regexp (symbol-name (car face))) - (throw 'found t))))) - (let ((face-a (assoc a faces)) - (face-b (assoc b faces))) - (if (and face-a (not face-b)) - (setq faces (cons (list b (nth 1 face-a)) - faces)) - (if (and (not face-a) face-b) - (setq faces (cons (list a (nth 1 face-b)) - faces)))))) - faces) - -;; (equal (color-theme-analyze-add-face -;; 'blue 'violet nil -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((violet ((t (:foreground "blue")))) -;; (blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; (equal (color-theme-analyze-add-face -;; 'violet 'blue nil -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((violet ((t (:foreground "blue")))) -;; (blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; (equal (color-theme-analyze-add-face -;; 'violet 'blue "foo" -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; (equal (color-theme-analyze-add-face -;; 'violet 'blue "blue" -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((violet ((t (:foreground "blue")))) -;; (blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) - -(defun color-theme-analyze-add-faces (faces) - "Add missing faces to FACES and return it." - ;; The most important thing is to add missing faces for the other - ;; editor. These are the most important faces to check. The - ;; following rules list two faces, A and B. If either of the two is - ;; part of the theme, the other must be, too. The optional third - ;; argument specifies a regexp. Only if an existing face name - ;; matches this regexp, is the rule applied. - (let ((rules '((font-lock-builtin-face font-lock-reference-face) - (font-lock-doc-face font-lock-doc-string-face) - (font-lock-constant-face font-lock-preprocessor-face) - ;; In Emacs 21 `modeline' is just an alias for - ;; `mode-line'. I recommend the use of - ;; `modeline' until further notice. - (modeline mode-line) - (modeline modeline-buffer-id) - (modeline modeline-mousable) - (modeline modeline-mousable-minor-mode) - (region primary-selection) - (region zmacs-region) - (font-lock-string-face dired-face-boring "^dired") - (font-lock-function-name-face dired-face-directory "^dired") - (default dired-face-executable "^dired") - (font-lock-warning-face dired-face-flagged "^dired") - (font-lock-warning-face dired-face-marked "^dired") - (default dired-face-permissions "^dired") - (default dired-face-setuid "^dired") - (default dired-face-socket "^dired") - (font-lock-keyword-face dired-face-symlink "^dired") - (tool-bar menu)))) - (dolist (rule rules) - (setq faces (color-theme-analyze-add-face - (nth 0 rule) (nth 1 rule) (nth 2 rule) faces)))) - ;; The `fringe' face defines what the left and right borders of the - ;; frame look like in Emacs 21. To give them default fore- and - ;; background colors, use (fringe ((t (nil)))) in your color theme. - ;; Usually it makes more sense to choose a color slightly lighter or - ;; darker from the default background. - (unless (assoc 'fringe faces) - (setq faces (cons '(fringe ((t (nil)))) faces))) - ;; The tool-bar should not be part of the frame-parameters, since it - ;; should not appear or disappear depending on the color theme. The - ;; apppearance of the toolbar, however, can be changed by the color - ;; theme. For Emacs 21, use the `tool-bar' face. The easiest way - ;; to do this is to give it the default fore- and background colors. - ;; This can be achieved using (tool-bar ((t (nil)))) in the theme. - ;; Usually it makes more sense, however, to provide the same colors - ;; as used in the `menu' face, and to specify a :box attribute. In - ;; order to alleviate potential Emacs/XEmacs incompatibilities, - ;; `toolbar' will be defined as an alias for `tool-bar' if it does - ;; not exist, and vice-versa. This is done eventhough the face - ;; `toolbar' seems to have no effect on XEmacs. If you look at - ;; XEmacs lisp/faces.el, however, you will find that it is in fact - ;; referenced for XPM stuff. - (unless (assoc 'tool-bar faces) - (setq faces (cons '(tool-bar ((t (nil)))) faces))) - ;; Move the default face back to the front, and sort the rest. - (unless (eq (caar faces) 'default) - (let ((face (assoc 'default faces))) - (setq faces (cons face - (sort (delete face faces) - (lambda (a b) - (string-lessp (car a) (car b)))))))) - faces) - -(defun color-theme-analyze-remove-heights (faces) - "Remove :height property where it is an integer and return FACES." - ;; I don't recommend making font sizes part of a color theme. Most - ;; users would be surprised to see their font sizes change when they - ;; install a color-theme. Therefore, remove all :height attributes - ;; if the value is an integer. If the value is a float, this is ok - ;; -- the value is relative to the default height. One notable - ;; exceptions is for a color-theme created for visually impaired - ;; people. These *must* use a larger font in order to be usable. - (let (result) - (dolist (face faces) - (let ((props (cadar (nth 1 face)))) - (if (and (plist-member props :height) - (integerp (plist-get props :height))) - (setq props (color-theme-plist-delete props :height) - result (cons (list (car face) `((t ,props))) - result)) - (setq result (cons face result))))) - (nreverse result))) - -;; (equal (color-theme-analyze-remove-heights -;; '((blue ((t (:foreground "blue" :height 2)))) -;; (bold ((t (:bold t :height 1.0)))))) -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t :height 1.0)))))) - -;;;###autoload -(defun color-theme-analyze-defun () - "Once you have a color-theme printed, check for missing faces. -This is used by maintainers who receive a color-theme submission -and want to make sure it follows the guidelines by the color-theme -author." - ;; The support for :foreground and :background attributes works for - ;; Emacs 20 and 21 as well as for XEmacs. :inverse-video is taken - ;; care of while printing color themes. - (interactive) - ;; Parse the stuff and find the call to color-theme-install - (save-excursion - (save-restriction - (narrow-to-defun) - ;; define the function - (eval-defun nil) - (goto-char (point-min)) - (let* ((code (read (current-buffer))) - (theme (color-theme-canonic - (eval - (cadr - (color-theme-analyze-find-theme - code))))) - (func (color-theme-function theme)) - (doc (documentation func t)) - (variables (color-theme-variables theme)) - (faces (color-theme-faces theme)) - (params (color-theme-frame-params theme))) - (setq faces (color-theme-analyze-remove-heights - (color-theme-analyze-add-faces faces))) - ;; Remove any variable bindings of faces that point to their - ;; symbol? Perhaps not, because another theme might want to - ;; change this, so it is important to be able to reset them. - ;; (let (result) - ;; (dolist (var variables) - ;; (unless (eq (car var) (cdr var)) - ;; (setq result (cons var result)))) - ;; (setq variables (nreverse result))) - ;; Now modify the theme directly. - (setq theme (color-theme-analyze-find-theme code)) - (setcdr (cadadr theme) (list params variables faces)) - (message "Pretty printing analysed color theme function...") - (with-current-buffer (get-buffer-create "*Color Theme*") - (setq buffer-read-only nil) - (erase-buffer) - ;; insert defun - (color-theme-print-theme func doc params variables faces) - (emacs-lisp-mode)) - (message "Pretty printing analysed color theme function... done") - (ediff-buffers (current-buffer) - (get-buffer "*Color Theme*")))))) - -;;; Creating a snapshot of the current color theme - -(defun color-theme-snapshot nil) - -;;;###autoload -(defun color-theme-make-snapshot () - "Return the definition of the current color-theme. -The function returned will recreate the color-theme in use at the moment." - (eval `(lambda () - "The color theme in use when the selection buffer was created. -\\[color-theme-select] creates the color theme selection buffer. At the -same time, this snapshot is created as a very simple undo mechanism. -The snapshot is created via `color-theme-snapshot'." - (interactive) - (color-theme-install - '(color-theme-snapshot - ;; alist of frame parameters - ,(color-theme-get-params) - ;; alist of variables - ,(color-theme-get-vars) - ;; remaining elements of snapshot: face specs - ,@(color-theme-get-face-definitions)))))) - - - -;;; Handling the various parts of a color theme install - -(defvar color-theme-frame-param-frobbing-rules - '((foreground-color default foreground) - (background-color default background)) - "List of rules to use when frobbing faces based on frame parameters. -This is only necessary for XEmacs, because in Emacs 21 changing the -frame paramters automatically affects the relevant faces.") - -;; fixme: silent the bytecompiler with set-face-property -(defun color-theme-frob-faces (params) - "Change certain faces according to PARAMS. -This uses `color-theme-frame-param-frobbing-rules'." - (dolist (rule color-theme-frame-param-frobbing-rules) - (let* ((param (nth 0 rule)) - (face (nth 1 rule)) - (prop (nth 2 rule)) - (val (cdr (assq param params))) - (frame (if color-theme-is-global nil (selected-frame)))) - (when val - (set-face-property face prop val frame))))) - -(defun color-theme-alist-reduce (old-list) - "Reduce OLD-LIST. -The resulting list will be newly allocated and will not contain any elements -with duplicate cars. This will speed the installation of new themes by -only installing unique attributes." - (let (new-list) - (dolist (elem old-list) - (when (not (assq (car elem) new-list)) - (setq new-list (cons elem new-list)))) - new-list)) - -(defun color-theme-install-frame-params (params) - "Change frame parameters using alist PARAMETERS. - -If `color-theme-is-global' is non-nil, all frames are modified using -`modify-frame-parameters' and the PARAMETERS are prepended to -`default-frame-alist'. The value of `initial-frame-alist' is not -modified. If `color-theme-is-global' is nil, only the selected frame is -modified. If `color-theme-is-cumulative' is nil, the frame parameters -are restored from `color-theme-original-frame-alist'. - -If the current frame parameters have a parameter `minibuffer' with -value `only', then the frame parameters are not installed, since this -indicates a dedicated minibuffer frame. - -Called from `color-theme-install'." - (setq params (color-theme-filter - params color-theme-legal-frame-parameters)) - ;; We have a new list in params now, therefore we may use - ;; destructive nconc. - (if color-theme-is-global - (let ((frames (frame-list))) - (if (or color-theme-is-cumulative - (null color-theme-original-frame-alist)) - (setq default-frame-alist - (append params (color-theme-alist default-frame-alist)) - minibuffer-frame-alist - (append params (color-theme-alist minibuffer-frame-alist))) - (setq default-frame-alist - (append params color-theme-original-frame-alist) - minibuffer-frame-alist - (append params (color-theme-alist minibuffer-frame-alist)))) - (setq default-frame-alist - (color-theme-alist-reduce default-frame-alist) - minibuffer-frame-alist - (color-theme-alist-reduce minibuffer-frame-alist)) - (dolist (frame frames) - (let ((params (if (eq 'only (cdr (assq 'minibuffer (frame-parameters frame)))) - minibuffer-frame-alist - default-frame-alist))) - (condition-case var - (modify-frame-parameters frame params) - (error (message "Error using params %S: %S" params var)))))) - (condition-case var - (modify-frame-parameters (selected-frame) params) - (error (message "Error using params %S: %S" params var)))) - (when color-theme-xemacs-p - (color-theme-frob-faces params))) - -;; (setq default-frame-alist (cons '(height . 30) default-frame-alist)) - -(defun color-theme-install-variables (vars) - "Change variables using alist VARS. -All variables matching `color-theme-legal-variables' are set. - -If `color-theme-is-global' and `color-theme-xemacs-p' are nil, variables -are made frame-local before setting them. Variables are set using `set' -in either case. This may lead to problems if changing the variable -requires the usage of the function specified with the :set tag in -defcustom declarations. - -Called from `color-theme-install'." - (let ((vars (color-theme-filter vars color-theme-legal-variables))) - (dolist (var vars) - (if (or color-theme-is-global color-theme-xemacs-p) - (set (car var) (cdr var)) - (make-variable-frame-local (car var)) - (modify-frame-parameters (selected-frame) (list var)))))) - -(defun color-theme-install-faces (faces) - "Change faces using FACES. - -Change faces for all frames and create any faces listed in FACES which -don't exist. The modified faces will be marked as \"unchanged from -its standard setting\". This is OK, since the changes made by -installing a color theme should never by saved in .emacs by -customization code. - -FACES should be a list where each entry has the form: - - (FACE SPEC) - -See `defface' for the format of SPEC. - -If `color-theme-is-global' is non-nil, faces are modified on all frames -using `face-spec-set'. If `color-theme-is-global' is nil, faces are -only modified on the selected frame. Non-existing faces are created -using `make-empty-face' in either case. If `color-theme-is-cumulative' -is nil, all faces are reset before installing the new faces. - -Called from `color-theme-install'." - ;; clear all previous faces - (when (not color-theme-is-cumulative) - (color-theme-reset-faces)) - ;; install new faces - (let ((faces (color-theme-filter faces color-theme-illegal-faces t)) - (frame (if color-theme-is-global nil (selected-frame)))) - (dolist (entry faces) - (let ((face (nth 0 entry)) - (spec (nth 1 entry))) - (or (facep face) - (make-empty-face face)) - ;; remove weird properties from the default face only - (when (eq face 'default) - (setq spec (color-theme-spec-filter spec))) - ;; Emacs/XEmacs customization issues: filter out :bold when - ;; the spec contains :weight, etc, such that the spec remains - ;; "valid" for custom. - (setq spec (color-theme-spec-compat spec)) - ;; using a spec of ((t (nil))) to reset a face doesn't work - ;; in Emacs 21, we use the new function face-spec-reset-face - ;; instead - (if (and (functionp 'face-spec-reset-face) - (equal spec '((t (nil))))) - (face-spec-reset-face face frame) - (condition-case var - (progn - (face-spec-set face spec frame) - (if color-theme-is-global - (put face 'face-defface-spec spec))) - (error (message "Error using spec %S: %S" spec var)))))))) - -;; `custom-set-faces' is unusable here because it doesn't allow to set -;; the faces for one frame only. - -;; Emacs `face-spec-set': If FRAME is nil, the face is created and -;; marked as a customized face. This is achieved by setting the -;; `face-defface-spec' property. If we don't, new frames will not be -;; created using the face we installed because `face-spec-set' is -;; broken: If given a FRAME of nil, it will not set the default faces; -;; instead it will walk through all the frames and set modify the faces. -;; If we do set a property (`saved-face' or `face-defface-spec'), -;; `make-frame' will correctly use the faces we defined with our color -;; theme. If we used the property `saved-face', -;; `customize-save-customized' will save all the faces installed as part -;; of a color-theme in .emacs. That's why we use the -;; `face-defface-spec' property. - - - -;;; Theme accessor functions, canonicalization, merging, comparing - -(defun color-theme-canonic (theme) - "Return the canonic form of THEME. -This deals with all the backwards compatibility stuff." - (let (function frame-params variables faces) - (when (functionp (car theme)) - (setq function (car theme) - theme (cdr theme))) - (setq frame-params (car theme) - theme (cdr theme)) - ;; optional variable defintions (for backwards compatibility) - (when (listp (caar theme)) - (setq variables (car theme) - theme (cdr theme))) - ;; face definitions - (setq faces theme) - (list function frame-params variables faces))) - -(defun color-theme-function (theme) - "Return function used to create THEME." - (nth 0 theme)) - -(defun color-theme-frame-params (theme) - "Return frame-parameters defined by THEME." - (nth 1 theme)) - -(defun color-theme-variables (theme) - "Return variables set by THEME." - (nth 2 theme)) - -(defun color-theme-faces (theme) - "Return faces defined by THEME." - (nth 3 theme)) - -(defun color-theme-merge-alists (&rest alists) - "Merges all the alist arguments into one alist. -Only the first instance of every key will be part of the resulting -alist. Membership will be tested using `assq'." - (let (result) - (dolist (l alists) - (dolist (entry l) - (unless (assq (car entry) result) - (setq result (cons entry result))))) - (nreverse result))) -;; (color-theme-merge-alists '((a . 1) (b . 2))) -;; (color-theme-merge-alists '((a . 1) (b . 2) (a . 3))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((a . 3))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4) (b . 5))) - -;;;###autoload -(defun color-theme-compare (theme-a theme-b) - "Compare two color themes. -This will print the differences between installing THEME-A and -installing THEME-B. Note that the order is important: If a face is -defined in THEME-A and not in THEME-B, then this will not show up as a -difference, because there is no reset before installing THEME-B. If a -face is defined in THEME-B and not in THEME-A, then this will show up as -a difference." - (interactive - (list - (intern - (completing-read "Theme A: " - (mapcar (lambda (i) (list (symbol-name (car i)))) - color-themes) - (lambda (i) (string-match "color-theme" (car i))))) - (intern - (completing-read "Theme B: " - (mapcar (lambda (i) (list (symbol-name (car i)))) - color-themes) - (lambda (i) (string-match "color-theme" (car i))))))) - ;; install the themes in a new frame and get the definitions - (let ((color-theme-is-global nil)) - (select-frame (make-frame)) - (funcall theme-a) - (setq theme-a (list theme-a - (color-theme-get-params) - (color-theme-get-vars) - (color-theme-get-face-definitions))) - (funcall theme-b) - (setq theme-b (list theme-b - (color-theme-get-params) - (color-theme-get-vars) - (color-theme-get-face-definitions))) - (delete-frame)) - (let ((params (set-difference - (color-theme-frame-params theme-b) - (color-theme-frame-params theme-a) - :test 'equal)) - (vars (set-difference - (color-theme-variables theme-b) - (color-theme-variables theme-a) - :test 'equal)) - (faces (set-difference - (color-theme-faces theme-b) - (color-theme-faces theme-a) - :test 'equal))) - (list 'diff - params - vars - faces))) - - - -;;; Installing a color theme -;;;###autoload -(defun color-theme-install (theme) - "Install a color theme defined by frame parameters, variables and faces. - -The theme is installed for all present and future frames; any missing -faces are created. See `color-theme-install-faces'. - -THEME is a color theme definition. See below for more information. - -If you want to install a color theme from your .emacs, use the output -generated by `color-theme-print'. This produces color theme function -which you can copy to your .emacs. - -A color theme definition is a list: -\([FUNCTION] FRAME-PARAMETERS VARIABLE-SETTINGS FACE-DEFINITIONS) - -FUNCTION is the color theme function which called `color-theme-install'. -This is no longer used. There was a time when this package supported -automatic factoring of color themes. This has been abandoned. - -FRAME-PARAMETERS is an alist of frame parameters. These are installed -with `color-theme-install-frame-params'. These are installed last such -that any changes to the default face can be changed by the frame -parameters. - -VARIABLE-DEFINITIONS is an alist of variable settings. These are -installed with `color-theme-install-variables'. - -FACE-DEFINITIONS is an alist of face definitions. These are installed -with `color-theme-install-faces'. - -If `color-theme-is-cumulative' is nil, a color theme will undo face and -frame-parameter settings of previous color themes." - (setq theme (color-theme-canonic theme)) - (color-theme-install-variables (color-theme-variables theme)) - (color-theme-install-faces (color-theme-faces theme)) - ;; frame parameters override faces - (color-theme-install-frame-params (color-theme-frame-params theme)) - (when color-theme-history-max-length - (color-theme-add-to-history - (car theme)))) - - - -;; Sharing your stuff -;;;###autoload -(defun color-theme-submit () - "Submit your color-theme to the maintainer." - (interactive) - (require 'reporter) - (let ((reporter-eval-buffer (current-buffer)) - final-resting-place - after-sep-pos - (reporter-status-message "Formatting buffer...") - (reporter-status-count 0) - (problem "Yet another color-theme") - (agent (reporter-compose-outgoing)) - (mailbuf (current-buffer)) - hookvar) - ;; do the work - (require 'sendmail) - ;; If mailbuf did not get made visible before, make it visible now. - (let (same-window-buffer-names same-window-regexps) - (pop-to-buffer mailbuf) - ;; Just in case the original buffer is not visible now, bring it - ;; back somewhere - (and pop-up-windows (display-buffer reporter-eval-buffer))) - (goto-char (point-min)) - (mail-position-on-field "to") - (insert color-theme-maintainer-address) - (mail-position-on-field "subject") - (insert problem) - ;; move point to the body of the message - (mail-text) - (setq after-sep-pos (point)) - (unwind-protect - (progn - (setq final-resting-place (point-marker)) - (goto-char final-resting-place)) - (color-theme-print (current-buffer)) - (goto-char final-resting-place) - (insert "\n\n") - (goto-char final-resting-place) - (insert "Hello there!\n\nHere's my color theme named: ") - (set-marker final-resting-place nil)) - ;; compose the minibuf message and display this. - (let* ((sendkey-whereis (where-is-internal - (get agent 'sendfunc) nil t)) - (abortkey-whereis (where-is-internal - (get agent 'abortfunc) nil t)) - (sendkey (if sendkey-whereis - (key-description sendkey-whereis) - "C-c C-c")); TBD: BOGUS hardcode - (abortkey (if abortkey-whereis - (key-description abortkey-whereis) - "M-x kill-buffer"))); TBD: BOGUS hardcode - (message "Enter a message and type %s to send or %s to abort." - sendkey abortkey)))) - - - -;; Use this to define themes -(defmacro define-color-theme (name author description &rest forms) - (let ((n name)) - `(progn - (add-to-list 'color-themes - (list ',n - (upcase-initials - (replace-in-string - (replace-in-string - (symbol-name ',n) "^color-theme-" "") "-" " ")) - ,author)) - (defun ,n () - ,description - (interactive) - ,@forms)))) - - -;;; FIXME: is this useful ?? -;;;###autoload -(defun color-theme-initialize () - "Initialize the color theme package by loading color-theme-libraries." - (interactive) - - (cond ((and (not color-theme-load-all-themes) - color-theme-directory) - (setq color-theme-libraries - (directory-files color-theme-directory t "^color-theme"))) - (color-theme-directory - (push (cdr (directory-files color-theme-directory t "^color-theme")) - color-theme-libraries))) - (dolist (library color-theme-libraries) - (load library))) - -(when nil - (setq color-theme-directory "themes/" - color-theme-load-all-themes nil) - (color-theme-initialize) -) -;; TODO: I don't like all those function names cluttering up my namespace. -;; Instead, a hashtable for the color-themes should be created. Now that -;; define-color-theme is around, it should be easy to change in just the -;; one place. - - -(provide 'color-theme) - -;;; color-theme.el ends here diff --git a/emacs/external/css-mode.el b/emacs/external/css-mode.el deleted file mode 100644 index bae3408..0000000 --- a/emacs/external/css-mode.el +++ /dev/null @@ -1,470 +0,0 @@ - -;;;; A major mode for editing CSS. - -;;; Adds font locking, some rather primitive indentation handling and -;;; some typing help. -;;; -(defvar cssm-version "0.11" - "The current version number of css-mode.") -;;; copyright (c) 1998 Lars Marius Garshol, larsga@ifi.uio.no -;;; $Id: css-mode.el,v 1.9 2000/01/05 21:21:56 larsga Exp $ - -;;; css-mode 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. -;;; -;;; css-mode 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -; Send me an email if you want new features (or if you add them yourself). -; I will do my best to preserve the API to functions not explicitly marked -; as internal and variables shown as customizable. I make no promises about -; the rest. - -; Bug reports are very welcome. New versions of the package will appear at -; http://www.stud.ifi.uio.no/~larsga/download/css-mode.html -; You can register at the same address if you want to be notified when a -; new version appears. - -; Thanks to Philippe Le Hegaret, Kjetil Kjernsmo, Alf-Ivar Holm and -; Alfred Correira for much useful feedback. Alf-Ivar Holm also contributed -; patches. - -; To install, put this in your .emacs: -; -; (autoload 'css-mode "css-mode") -; (setq auto-mode-alist -; (cons '("\\.css\\'" . css-mode) auto-mode-alist)) - -;; Todo: - -; - must not color URL file name extensions as class selectors (*.css) -; - color [] and url() constructs correctly, even if quoted strings present -; - disregard anything inside strings - -;; Possible later additions: -; -; - forward/backward style/@media rule commands -; - more complete syntax table - -;; Required modules - -(require 'apropos) -(require 'font-lock) -(require 'cl) - -;;; The code itself - -; Customizable variables: - -(defvar cssm-indent-level 2 "The indentation level inside @media rules.") -(defvar cssm-mirror-mode t - "Whether brackets, quotes etc should be mirrored automatically on - insertion.") -(defvar cssm-newline-before-closing-bracket nil - "In mirror-mode, controls whether a newline should be inserted before the -closing bracket or not.") -(defvar cssm-indent-function #'cssm-c-style-indenter - "Which function to use when deciding which column to indent to. To get -C-style indentation, use cssm-c-style-indenter.") - -; The rest of the code: - -(defvar cssm-properties - '("font-family" "font-style" "font-variant" "font-weight" - "font-size" "font" "background-color" "background-image" - "background-repeat" "background-attachment" "background-position" - "color" "background" "word-spacing" "letter-spacing" - "border-top-width" "border-right-width" "border-left-width" - "border-bottom-width" "border-width" "list-style-type" - "list-style-image" "list-style-position" "text-decoration" - "vertical-align" "text-transform" "text-align" "text-indent" - "line-height" "margin-top" "margin-right" "margin-bottom" - "margin-left" "margin" "padding-top" "padding-right" "padding-bottom" - "padding-left" "padding" "border-top" "border-right" "border-bottom" - "border-left" "border" "width" "height" "float" "clear" "display" - "list-style" "white-space" "border-style" "border-color" - - ; CSS level 2: - - "azimuth" "border-bottom-color" "border-bottom-style" - "border-collapse" "border-left-color" "border-left-style" - "border-right-color" "border-right-style" "border-top-color" - "border-top-style" "caption-side" "cell-spacing" "clip" "column-span" - "content" "cue" "cue-after" "cue-before" "cursor" "direction" - "elevation" "font-size-adjust" "left" "marks" "max-height" "max-width" - "min-height" "min-width" "orphans" "overflow" "page-break-after" - "page-break-before" "pause" "pause-after" "pause-before" "pitch" - "pitch-range" "play-during" "position" "richness" "right" "row-span" - "size" "speak" "speak-date" "speak-header" "speak-punctuation" - "speak-time" "speech-rate" "stress" "table-layout" "text-shadow" "top" - "visibility" "voice-family" "volume" "widows" "z-index") - "A list of all CSS properties.") - -(defvar cssm-properties-alist - (mapcar (lambda(prop) - (cons (concat prop ":") nil)) cssm-properties) - "An association list of the CSS properties for completion use.") - -(defvar cssm-keywords - (append '("!\\s-*important" - - ; CSS level 2: - - "@media" "@import" "@page" "@font-face") - (mapcar (lambda(property) - (concat property "\\s-*:")) - cssm-properties)) - "A list of all CSS keywords.") - -(defvar cssm-pseudos - '("link" "visited" "active" "first-line" "first-letter" - - ; CSS level 2 - "first-child" "before" "after" "hover") - "A list of all CSS pseudo-classes.") - -; internal -(defun cssm-list-2-regexp(altlist) - "Takes a list and returns the regexp \\(elem1\\|elem2\\|...\\)" - (let ((regexp "\\(")) - (mapcar (lambda(elem) - (setq regexp (concat regexp elem "\\|"))) - altlist) - (concat (substring regexp 0 -2) ; cutting the last "\\|" - "\\)") - )) - -(defvar cssm-font-lock-keywords - (list - (cons (cssm-list-2-regexp cssm-keywords) font-lock-keyword-face) - (cons "\\.[a-zA-Z][-a-zA-Z0-9.]+" font-lock-variable-name-face) - (cons (concat ":" (cssm-list-2-regexp cssm-pseudos)) - font-lock-variable-name-face) - (cons "#[a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)?" - font-lock-reference-face) - (cons "\\[.*\\]" font-lock-variable-name-face) - (cons "#[-a-zA-Z0-9]*" font-lock-function-name-face) - (cons "rgb(\\s-*[0-9]+\\(\\.[0-9]+\\s-*%\\s-*\\)?\\s-*,\\s-*[0-9]+\\(\\.[0-9]+\\s-*%\\s-*\\)?\\s-*,\\s-*[0-9]+\\(\\.[0-9]+\\s-*%\\s-*\\)?\\s-*)" - font-lock-reference-face) - ) - "Rules for highlighting CSS style sheets.") - -(defvar cssm-mode-map () - "Keymap used in CSS mode.") -(when (not cssm-mode-map) - (setq cssm-mode-map (make-sparse-keymap)) - (define-key cssm-mode-map (read-kbd-macro "C-c C-c") 'cssm-insert-comment) - (define-key cssm-mode-map (read-kbd-macro "C-c C-u") 'cssm-insert-url) - (define-key cssm-mode-map (read-kbd-macro "}") 'cssm-insert-right-brace-and-indent) - (define-key cssm-mode-map (read-kbd-macro "M-TAB") 'cssm-complete-property)) - -;;; Cross-version compatibility layer - -(when (not (or (apropos-macrop 'kbd) - (fboundp 'kbd))) - (defmacro kbd (keys) - "Convert KEYS to the internal Emacs key representation. -KEYS should be a string constant in the format used for -saving keyboard macros (see `insert-kbd-macro')." - (read-kbd-macro keys))) - -;;; Auto-indentation support - -; internal -(defun cssm-insert-right-brace-and-indent() - (interactive) - (insert "}") - (cssm-indent-line)) - -; internal -(defun cssm-inside-atmedia-rule() - "Decides if point is currently inside an @media rule." - (let ((orig-pos (point)) - (atmedia (re-search-backward "@media" 0 t)) - (balance 1) ; used to keep the {} balance, 1 because we start on a { - ) - ; Going to the accompanying { - (re-search-forward "{" (point-max) t) - (if (null atmedia) - nil ; no @media before this point => not inside - (while (and (< (point) orig-pos) - (< 0 balance)) - (if (null (re-search-forward "[{}]" (point-max) 0)) - (goto-char (point-max)) ; break - (setq balance - (if (string= (match-string 0) "{") - (+ balance 1) - (- balance 1))))) - (= balance 1)) - )) - -; internal -(defun cssm-rule-is-atmedia() - "Decides if point is currently on the { of an @media or ordinary style rule." - (let ((result (re-search-backward "[@}{]" 0 t))) - (if (null result) - nil - (string= (match-string 0) "@")))) - -; internal -(defun cssm-find-column(first-char) - "Find which column to indent to." - - ; Find out where to indent to by looking at previous lines - ; spinning backwards over comments - (let (pos) - (while (and (setq pos (re-search-backward (cssm-list-2-regexp - '("/\\*" "\\*/" "{" "}")) - (point-min) t)) - (string= (match-string 0) "*/")) - (search-backward "/*" (point-min) t)) - - ; did the last search find anything? - (if pos - (save-excursion - (let ((construct (match-string 0)) - (column (current-column))) - (apply cssm-indent-function - (list (cond - ((string= construct "{") - (cond - ((cssm-rule-is-atmedia) - 'inside-atmedia) - ((cssm-inside-atmedia-rule) - 'inside-rule-and-atmedia) - (t - 'inside-rule))) - ((string= construct "/*") - 'inside-comment) - ((string= construct "}") - (if (cssm-inside-atmedia-rule) - 'inside-atmedia - 'outside)) - (t 'outside)) - column - first-char)))) - - (apply cssm-indent-function - (list 'outside - (current-column) - first-char))))) - -(defun cssm-indent-line() - "Indents the current line." - (interactive) - (beginning-of-line) - (let* ((beg-of-line (point)) - (pos (re-search-forward "[]@#a-zA-Z0-9;,.\"{}/*\n:[]" (point-max) t)) - (first (match-string 0)) - (start (match-beginning 0))) - - (goto-char beg-of-line) - - (let ((indent-column (cssm-find-column first))) - (goto-char beg-of-line) - - ; Remove all leading whitespace on this line ( - (if (not (or (null pos) - (= beg-of-line start))) - (kill-region beg-of-line start)) - - (goto-char beg-of-line) - - ; Indent - (while (< 0 indent-column) - (insert " ") - (setq indent-column (- indent-column 1)))))) - -;;; Indent-style functions - -(defun cssm-old-style-indenter(position column first-char-on-line) - (cond - ((eq position 'inside-atmedia) - (if (string= "}" first-char-on-line) - 0 - cssm-indent-level)) - - ((eq position 'inside-rule) - (+ column 2)) - - ((eq position 'inside-rule-and-atmedia) - (+ column 2)) - - ((eq position 'inside-comment) - (+ column 3)) - - ((eq position 'outside) - 0))) - -(defun cssm-c-style-indenter(position column first-char-on-line) - (cond - ((or (eq position 'inside-atmedia) - (eq position 'inside-rule)) - (if (string= "}" first-char-on-line) - 0 - cssm-indent-level)) - - ((eq position 'inside-rule-and-atmedia) - (if (string= "}" first-char-on-line) - cssm-indent-level - (* 2 cssm-indent-level))) - - ((eq position 'inside-comment) - (+ column 3)) - - ((eq position 'outside) - 0))) - -;;; Typing shortcuts - -(define-skeleton cssm-insert-curlies - "Inserts a pair of matching curly parenthesises." nil - "{ " _ (if cssm-newline-before-closing-bracket "\n" " ") - "}") - -(define-skeleton cssm-insert-quotes - "Inserts a pair of matching quotes." nil - "\"" _ "\"") - -(define-skeleton cssm-insert-parenthesises - "Inserts a pair of matching parenthesises." nil - "(" _ ")") - -(define-skeleton cssm-insert-comment - "Inserts a full comment." nil - "/* " _ " */") - -(define-skeleton cssm-insert-url - "Inserts a URL." nil - "url(" _ ")") - -(define-skeleton cssm-insert-brackets - "Inserts a pair of matching brackets." nil - "[" _ "]") - -(defun cssm-enter-mirror-mode() - "Turns on mirror mode, where quotes, brackets etc are mirrored automatically - on insertion." - (interactive) - (define-key cssm-mode-map (read-kbd-macro "{") 'cssm-insert-curlies) - (define-key cssm-mode-map (read-kbd-macro "\"") 'cssm-insert-quotes) - (define-key cssm-mode-map (read-kbd-macro "(") 'cssm-insert-parenthesises) - (define-key cssm-mode-map (read-kbd-macro "[") 'cssm-insert-brackets)) - -(defun cssm-leave-mirror-mode() - "Turns off mirror mode." - (interactive) - (define-key cssm-mode-map (read-kbd-macro "{") 'self-insert-command) - (define-key cssm-mode-map (read-kbd-macro "\"") 'self-insert-command) - (define-key cssm-mode-map (read-kbd-macro "(") 'self-insert-command) - (define-key cssm-mode-map (read-kbd-macro "[") 'self-insert-command)) - -;;; Property completion - -(defun cssm-property-at-point() - "If point is at the end of a property name: returns it." - (let ((end (point)) - (start (+ (re-search-backward "[^-A-Za-z]") 1))) - (goto-char end) - (buffer-substring start end))) - -; internal -(defun cssm-maximum-common(alt1 alt2) - "Returns the maximum common starting substring of alt1 and alt2." - (let* ((maxlen (min (length alt1) (length alt2))) - (alt1 (substring alt1 0 maxlen)) - (alt2 (substring alt2 0 maxlen))) - (while (not (string= (substring alt1 0 maxlen) - (substring alt2 0 maxlen))) - (setq maxlen (- maxlen 1))) - (substring alt1 0 maxlen))) - -; internal -(defun cssm-common-beginning(alts) - "Returns the maximum common starting substring of all alts elements." - (let ((common (car alts))) - (dolist (alt (cdr alts) common) - (setq common (cssm-maximum-common alt common))))) - -(defun cssm-complete-property-frame(completions) - ; This code stolen from message.el. Kudos to larsi. - (let ((cur (current-buffer))) - (pop-to-buffer "*Completions*") - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (display-completion-list (sort completions 'string<))) - (goto-char (point-min)) - (pop-to-buffer cur)))) - -(defun cssm-complete-property() - "Completes the CSS property being typed at point." - (interactive) - (let* ((prop (cssm-property-at-point)) - (alts (all-completions prop cssm-properties-alist)) - (proplen (length prop))) - (if (= (length alts) 1) - (insert (substring (car alts) proplen)) - (let ((beg (cssm-common-beginning alts))) - (if (not (string= beg prop)) - (insert (substring beg proplen)) - (insert (substring - (completing-read "Property: " cssm-properties-alist nil - nil prop) - proplen))))))) - -(defun css-mode() - "Major mode for editing CSS style sheets. -\\{cssm-mode-map}" - (interactive) - - ; Initializing - (kill-all-local-variables) - - ; Setting up indentation handling - (make-local-variable 'indent-line-function) - (setq indent-line-function 'cssm-indent-line) - - ; Setting up font-locking - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(cssm-font-lock-keywords nil t nil nil)) - - ; Setting up typing shortcuts - (make-local-variable 'skeleton-end-hook) - (setq skeleton-end-hook nil) - - (when cssm-mirror-mode - (cssm-enter-mirror-mode)) - - (use-local-map cssm-mode-map) - - ; Setting up syntax recognition - (make-local-variable 'comment-start) - (make-local-variable 'comment-end) - (make-local-variable 'comment-start-skip) - - (setq comment-start "/* " - comment-end " */" - comment-start-skip "/\\*[ \n\t]+") - - ; Setting up syntax table - (modify-syntax-entry ?* ". 23") - (modify-syntax-entry ?/ ". 14") - - ; Final stuff, then we're done - (setq mode-name "CSS" - major-mode 'css-mode) - (run-hooks 'css-mode-hook)) - -(provide 'css-mode) - -;; CSS-mode ends here \ No newline at end of file diff --git a/emacs/external/django-html-mode.el b/emacs/external/django-html-mode.el deleted file mode 100644 index 77728f1..0000000 --- a/emacs/external/django-html-mode.el +++ /dev/null @@ -1,185 +0,0 @@ -;; django-html-mode.el --- django html mode - -;; Author: TSKim (http://tsgates.cafe24.com, tsgatesv@gmail.com) -;; Keywords: django html languages -;; Created : 2007.01 - -;; 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 -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; - -;;; Code: - -(require 'sgml-mode) - -(defvar django-html-mode-hook nil) - -(defvar django-html-mode-map - (let ((django-html-mode-map (make-keymap))) - (define-key django-html-mode-map "\C-j" 'newline-and-indent) - django-html-mode-map) - "Keymap for Django major mode") - -;; if : if, if not, if A or B, if not A or B, if not A and B -;; TODO in for loop -;; for : for a in alist reversed - ;; forloop.counter The current iteration of the loop (1-indexed) - ;; forloop.counter0 The current iteration of the loop (0-indexed) - ;; forloop.revcounter The number of iterations from the end of the loop (1-indexed) - ;; forloop.revcounter0 The number of iterations from the end of the loop (0-indexed) - ;; forloop.first True if this is the first time through the loop - ;; forloop.last True if this is the last time through the loop - ;; forloop.parentloop For nested loops, this is the loop "above" the current one - -;; ifequal : ifequal A B -;; comment : {% This is comment %} -;; filter : {{ name | lower }} - -;; keyword-end : if, for, ifequal, block, ifnotequal, spaceless -;; keyword-3 : regroup -;; keyword-2 : for, ifequal -;; keyword-1 : if, block, extends, include, ifchanged, load, now, ssi, withratio -;; keyword-0 : else, spaceless - -;; start and end keyword for block/comment/variable -(defconst django-html-open-block "{%") -(defconst django-html-close-block "%}") -(defconst django-html-open-comment "{#") -(defconst django-html-close-comment "#}") -(defconst django-html-open-variable "{{") -(defconst django-html-close-variable "}}") - -(defconst django-html-font-lock-keywords-1 - (append - ;; html-mode keyword - sgml-font-lock-keywords-1) - - "First level keyword highlighting") - -(defconst django-html-font-lock-keywords-2 - (append - django-html-font-lock-keywords-1 - sgml-font-lock-keywords-2)) - -(defconst django-html-font-lock-keywords-3 - (append - django-html-font-lock-keywords-1 - django-html-font-lock-keywords-2 - - `(;; comment - (,(rx (eval django-html-open-comment) - (1+ space) - (0+ (not (any "#"))) - (1+ space) - (eval django-html-close-comment)) - . font-lock-comment-face) - - ;; variable font lock - (,(rx (eval django-html-open-variable) - (1+ space) - (group (0+ (not (any "}")))) - (1+ space) - (eval django-html-close-variable)) - (1 font-lock-variable-name-face)) - - ;; start, end keyword font lock - (,(rx (group (or (eval django-html-open-block) - (eval django-html-close-block) - (eval django-html-open-comment) - (eval django-html-close-comment) - (eval django-html-open-variable) - (eval django-html-close-variable)))) - (1 font-lock-builtin-face)) - - ;; end prefix keyword font lock - (,(rx (eval django-html-open-block) - (1+ space) - (group (and "end" - ;; end prefix keywords - (or "if" "for" "ifequal" "block" "ifnotequal" "spaceless" "filter"))) - (1+ space) - (eval django-html-close-block)) - (1 font-lock-keyword-face)) - - ;; more words after keyword - (,(rx (eval django-html-open-block) - (1+ space) - (group (or "extends" "for" "cycle" "filter" "if not" "else" - "firstof" "debug" "if" "ifchanged" "ifequal" "ifnotequal" - "include" "load" "now" "regroup" "spaceless" "ssi" - "templatetag" "widthratio" "block")) - - ;; TODO: is there a more beautiful way? - (0+ (not (any "}"))) - - (1+ space) - (eval django-html-close-block)) - (1 font-lock-keyword-face)) - - ;; TODO: if specific cases for supporting "or", "not", and "and" - - ;; for sepcific cases for supporting in - (,(rx (eval django-html-open-block) - (1+ space) - "for" - (1+ space) - - (group (1+ (or word ?_ ?.))) - - (1+ space) - (group "in") - (1+ space) - - (group (1+ (or word ?_ ?.))) - - (group (? (1+ space) "reverse")) - - (1+ space) - (eval django-html-close-block)) - (1 font-lock-variable-name-face) (2 font-lock-keyword-face) - (3 font-lock-variable-name-face) (4 font-lock-keyword-face))))) - -(defvar django-html-font-lock-keywords - django-html-font-lock-keywords-1) - -(defvar django-html-mode-syntax-table - (let ((django-html-mode-syntax-table (make-syntax-table))) - django-html-mode-syntax-table) - "Syntax table for django-html-mode") - -;;;###autoload -(define-derived-mode django-html-mode html-mode "django-html" - "Major mode for editing django html files(.djhtml)" - :group 'django-html - - ;; it mainly from sgml-mode font lock setting - (set (make-local-variable 'font-lock-defaults) - '((django-html-font-lock-keywords - django-html-font-lock-keywords-1 - django-html-font-lock-keywords-2 - django-html-font-lock-keywords-3) - nil t nil nil - (font-lock-syntactic-keywords - . sgml-font-lock-syntactic-keywords)))) - -;; ".html" is common in django -;; (add-to-list 'auto-mode-alist '("\\.djhtml$'" . django-html-mode)) - -(provide 'django-html-mode) diff --git a/emacs/external/git-contrib-emacs/.gitignore b/emacs/external/git-contrib-emacs/.gitignore deleted file mode 100644 index c531d98..0000000 --- a/emacs/external/git-contrib-emacs/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.elc diff --git a/emacs/external/git-contrib-emacs/Makefile b/emacs/external/git-contrib-emacs/Makefile deleted file mode 100644 index a48540a..0000000 --- a/emacs/external/git-contrib-emacs/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -## Build and install stuff - -EMACS = emacs - -ELC = git.elc vc-git.elc git-blame.elc -INSTALL ?= install -INSTALL_ELC = $(INSTALL) -m 644 -prefix ?= $(HOME) -emacsdir = $(prefix)/share/emacs/site-lisp -RM ?= rm -f - -all: $(ELC) - -install: all - $(INSTALL) -d $(DESTDIR)$(emacsdir) - $(INSTALL_ELC) $(ELC:.elc=.el) $(ELC) $(DESTDIR)$(emacsdir) - -%.elc: %.el - $(EMACS) -batch -f batch-byte-compile $< - -clean:; $(RM) $(ELC) diff --git a/emacs/external/git-contrib-emacs/git-blame.el b/emacs/external/git-contrib-emacs/git-blame.el deleted file mode 100644 index 9f92cd2..0000000 --- a/emacs/external/git-contrib-emacs/git-blame.el +++ /dev/null @@ -1,434 +0,0 @@ -;;; git-blame.el --- Minor mode for incremental blame for Git -*- coding: utf-8 -*- -;; -;; Copyright (C) 2007 David Kågedal -;; -;; Authors: David Kågedal -;; Created: 31 Jan 2007 -;; Message-ID: <87iren2vqx.fsf@morpheus.local> -;; License: GPL -;; Keywords: git, version control, release management -;; -;; Compatibility: Emacs21, Emacs22 and EmacsCVS -;; Git 1.5 and up - -;; This file is *NOT* part of GNU Emacs. -;; This file is distributed under the same terms as GNU Emacs. - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be -;; useful, but WITHOUT ANY WARRANTY; without even the implied -;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -;; PURPOSE. See the GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public -;; License along with this program; if not, write to the Free -;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, -;; MA 02111-1307 USA - -;; http://www.fsf.org/copyleft/gpl.html - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Here is an Emacs implementation of incremental git-blame. When you -;; turn it on while viewing a file, the editor buffer will be updated by -;; setting the background of individual lines to a color that reflects -;; which commit it comes from. And when you move around the buffer, a -;; one-line summary will be shown in the echo area. - -;;; Installation: -;; -;; To use this package, put it somewhere in `load-path' (or add -;; directory with git-blame.el to `load-path'), and add the following -;; line to your .emacs: -;; -;; (require 'git-blame) -;; -;; If you do not want to load this package before it is necessary, you -;; can make use of the `autoload' feature, e.g. by adding to your .emacs -;; the following lines -;; -;; (autoload 'git-blame-mode "git-blame" -;; "Minor mode for incremental blame for Git." t) -;; -;; Then first use of `M-x git-blame-mode' would load the package. - -;;; Compatibility: -;; -;; It requires GNU Emacs 21 or later and Git 1.5.0 and up -;; -;; If you'are using Emacs 20, try changing this: -;; -;; (overlay-put ovl 'face (list :background -;; (cdr (assq 'color (cddddr info))))) -;; -;; to -;; -;; (overlay-put ovl 'face (cons 'background-color -;; (cdr (assq 'color (cddddr info))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(eval-when-compile (require 'cl)) ; to use `push', `pop' - - -(defun git-blame-color-scale (&rest elements) - "Given a list, returns a list of triples formed with each -elements of the list. - -a b => bbb bba bab baa abb aba aaa aab" - (let (result) - (dolist (a elements) - (dolist (b elements) - (dolist (c elements) - (setq result (cons (format "#%s%s%s" a b c) result))))) - result)) - -;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") => -;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24" -;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...) - -(defmacro git-blame-random-pop (l) - "Select a random element from L and returns it. Also remove -selected element from l." - ;; only works on lists with unique elements - `(let ((e (elt ,l (random (length ,l))))) - (setq ,l (remove e ,l)) - e)) - -(defvar git-blame-log-oneline-format - "format:[%cr] %cn: %s" - "*Formatting option used for describing current line in the minibuffer. - -This option is used to pass to git log --pretty= command-line option, -and describe which commit the current line was made.") - -(defvar git-blame-dark-colors - (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") - "*List of colors (format #RGB) to use in a dark environment. - -To check out the list, evaluate (list-colors-display git-blame-dark-colors).") - -(defvar git-blame-light-colors - (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec") - "*List of colors (format #RGB) to use in a light environment. - -To check out the list, evaluate (list-colors-display git-blame-light-colors).") - -(defvar git-blame-colors '() - "Colors used by git-blame. The list is built once when activating git-blame -minor mode.") - -(defvar git-blame-ancient-color "dark green" - "*Color to be used for ancient commit.") - -(defvar git-blame-autoupdate t - "*Automatically update the blame display while editing") - -(defvar git-blame-proc nil - "The running git-blame process") -(make-variable-buffer-local 'git-blame-proc) - -(defvar git-blame-overlays nil - "The git-blame overlays used in the current buffer.") -(make-variable-buffer-local 'git-blame-overlays) - -(defvar git-blame-cache nil - "A cache of git-blame information for the current buffer") -(make-variable-buffer-local 'git-blame-cache) - -(defvar git-blame-idle-timer nil - "An idle timer that updates the blame") -(make-variable-buffer-local 'git-blame-cache) - -(defvar git-blame-update-queue nil - "A queue of update requests") -(make-variable-buffer-local 'git-blame-update-queue) - -;; FIXME: docstrings -(defvar git-blame-file nil) -(defvar git-blame-current nil) - -(defvar git-blame-mode nil) -(make-variable-buffer-local 'git-blame-mode) - -(defvar git-blame-mode-line-string " blame" - "String to display on the mode line when git-blame is active.") - -(or (assq 'git-blame-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist))) - -;;;###autoload -(defun git-blame-mode (&optional arg) - "Toggle minor mode for displaying Git blame - -With prefix ARG, turn the mode on if ARG is positive." - (interactive "P") - (cond - ((null arg) - (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on))) - ((> (prefix-numeric-value arg) 0) (git-blame-mode-on)) - (t (git-blame-mode-off)))) - -(defun git-blame-mode-on () - "Turn on git-blame mode. - -See also function `git-blame-mode'." - (make-local-variable 'git-blame-colors) - (if git-blame-autoupdate - (add-hook 'after-change-functions 'git-blame-after-change nil t) - (remove-hook 'after-change-functions 'git-blame-after-change t)) - (git-blame-cleanup) - (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) - (if (eq bgmode 'dark) - (setq git-blame-colors git-blame-dark-colors) - (setq git-blame-colors git-blame-light-colors))) - (setq git-blame-cache (make-hash-table :test 'equal)) - (setq git-blame-mode t) - (git-blame-run)) - -(defun git-blame-mode-off () - "Turn off git-blame mode. - -See also function `git-blame-mode'." - (git-blame-cleanup) - (if git-blame-idle-timer (cancel-timer git-blame-idle-timer)) - (setq git-blame-mode nil)) - -;;;###autoload -(defun git-reblame () - "Recalculate all blame information in the current buffer" - (interactive) - (unless git-blame-mode - (error "Git-blame is not active")) - - (git-blame-cleanup) - (git-blame-run)) - -(defun git-blame-run (&optional startline endline) - (if git-blame-proc - ;; Should maybe queue up a new run here - (message "Already running git blame") - (let ((display-buf (current-buffer)) - (blame-buf (get-buffer-create - (concat " git blame for " (buffer-name)))) - (args '("--incremental" "--contents" "-"))) - (if startline - (setq args (append args - (list "-L" (format "%d,%d" startline endline))))) - (setq args (append args - (list (file-name-nondirectory buffer-file-name)))) - (setq git-blame-proc - (apply 'start-process - "git-blame" blame-buf - "git" "blame" - args)) - (with-current-buffer blame-buf - (erase-buffer) - (make-local-variable 'git-blame-file) - (make-local-variable 'git-blame-current) - (setq git-blame-file display-buf) - (setq git-blame-current nil)) - (set-process-filter git-blame-proc 'git-blame-filter) - (set-process-sentinel git-blame-proc 'git-blame-sentinel) - (process-send-region git-blame-proc (point-min) (point-max)) - (process-send-eof git-blame-proc)))) - -(defun remove-git-blame-text-properties (start end) - (let ((modified (buffer-modified-p)) - (inhibit-read-only t)) - (remove-text-properties start end '(point-entered nil)) - (set-buffer-modified-p modified))) - -(defun git-blame-cleanup () - "Remove all blame properties" - (mapcar 'delete-overlay git-blame-overlays) - (setq git-blame-overlays nil) - (remove-git-blame-text-properties (point-min) (point-max))) - -(defun git-blame-update-region (start end) - "Rerun blame to get updates between START and END" - (let ((overlays (overlays-in start end))) - (while overlays - (let ((overlay (pop overlays))) - (if (< (overlay-start overlay) start) - (setq start (overlay-start overlay))) - (if (> (overlay-end overlay) end) - (setq end (overlay-end overlay))) - (setq git-blame-overlays (delete overlay git-blame-overlays)) - (delete-overlay overlay)))) - (remove-git-blame-text-properties start end) - ;; We can be sure that start and end are at line breaks - (git-blame-run (1+ (count-lines (point-min) start)) - (count-lines (point-min) end))) - -(defun git-blame-sentinel (proc status) - (with-current-buffer (process-buffer proc) - (with-current-buffer git-blame-file - (setq git-blame-proc nil) - (if git-blame-update-queue - (git-blame-delayed-update)))) - ;;(kill-buffer (process-buffer proc)) - ;;(message "git blame finished") - ) - -(defvar in-blame-filter nil) - -(defun git-blame-filter (proc str) - (save-excursion - (set-buffer (process-buffer proc)) - (goto-char (process-mark proc)) - (insert-before-markers str) - (goto-char 0) - (unless in-blame-filter - (let ((more t) - (in-blame-filter t)) - (while more - (setq more (git-blame-parse))))))) - -(defun git-blame-parse () - (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") - (let ((hash (match-string 1)) - (src-line (string-to-number (match-string 2))) - (res-line (string-to-number (match-string 3))) - (num-lines (string-to-number (match-string 4)))) - (setq git-blame-current - (if (string= hash "0000000000000000000000000000000000000000") - nil - (git-blame-new-commit - hash src-line res-line num-lines)))) - (delete-region (point) (match-end 0)) - t) - ((looking-at "filename \\(.+\\)\n") - (let ((filename (match-string 1))) - (git-blame-add-info "filename" filename)) - (delete-region (point) (match-end 0)) - t) - ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") - (let ((key (match-string 1)) - (value (match-string 2))) - (git-blame-add-info key value)) - (delete-region (point) (match-end 0)) - t) - ((looking-at "boundary\n") - (setq git-blame-current nil) - (delete-region (point) (match-end 0)) - t) - (t - nil))) - -(defun git-blame-new-commit (hash src-line res-line num-lines) - (save-excursion - (set-buffer git-blame-file) - (let ((info (gethash hash git-blame-cache)) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) - (when (not info) - ;; Assign a random color to each new commit info - ;; Take care not to select the same color multiple times - (let ((color (if git-blame-colors - (git-blame-random-pop git-blame-colors) - git-blame-ancient-color))) - (setq info (list hash src-line res-line num-lines - (git-describe-commit hash) - (cons 'color color)))) - (puthash hash info git-blame-cache)) - (goto-line res-line) - (while (> num-lines 0) - (if (get-text-property (point) 'git-blame) - (forward-line) - (let* ((start (point)) - (end (progn (forward-line 1) (point))) - (ovl (make-overlay start end))) - (push ovl git-blame-overlays) - (overlay-put ovl 'git-blame info) - (overlay-put ovl 'help-echo hash) - (overlay-put ovl 'face (list :background - (cdr (assq 'color (nthcdr 5 info))))) - ;; the point-entered property doesn't seem to work in overlays - ;;(overlay-put ovl 'point-entered - ;; `(lambda (x y) (git-blame-identify ,hash))) - (let ((modified (buffer-modified-p))) - (put-text-property (if (= start 1) start (1- start)) (1- end) - 'point-entered - `(lambda (x y) (git-blame-identify ,hash))) - (set-buffer-modified-p modified)))) - (setq num-lines (1- num-lines)))))) - -(defun git-blame-add-info (key value) - (if git-blame-current - (nconc git-blame-current (list (cons (intern key) value))))) - -(defun git-blame-current-commit () - (let ((info (get-char-property (point) 'git-blame))) - (if info - (car info) - (error "No commit info")))) - -(defun git-describe-commit (hash) - (with-temp-buffer - (call-process "git" nil t nil - "log" "-1" - (concat "--pretty=" git-blame-log-oneline-format) - hash) - (buffer-substring (point-min) (1- (point-max))))) - -(defvar git-blame-last-identification nil) -(make-variable-buffer-local 'git-blame-last-identification) -(defun git-blame-identify (&optional hash) - (interactive) - (let ((info (gethash (or hash (git-blame-current-commit)) git-blame-cache))) - (when (and info (not (eq info git-blame-last-identification))) - (message "%s" (nth 4 info)) - (setq git-blame-last-identification info)))) - -;; (defun git-blame-after-save () -;; (when git-blame-mode -;; (git-blame-cleanup) -;; (git-blame-run))) -;; (add-hook 'after-save-hook 'git-blame-after-save) - -(defun git-blame-after-change (start end length) - (when git-blame-mode - (git-blame-enq-update start end))) - -(defvar git-blame-last-update nil) -(make-variable-buffer-local 'git-blame-last-update) -(defun git-blame-enq-update (start end) - "Mark the region between START and END as needing blame update" - ;; Try to be smart and avoid multiple callouts for sequential - ;; editing - (cond ((and git-blame-last-update - (= start (cdr git-blame-last-update))) - (setcdr git-blame-last-update end)) - ((and git-blame-last-update - (= end (car git-blame-last-update))) - (setcar git-blame-last-update start)) - (t - (setq git-blame-last-update (cons start end)) - (setq git-blame-update-queue (nconc git-blame-update-queue - (list git-blame-last-update))))) - (unless (or git-blame-proc git-blame-idle-timer) - (setq git-blame-idle-timer - (run-with-idle-timer 0.5 nil 'git-blame-delayed-update)))) - -(defun git-blame-delayed-update () - (setq git-blame-idle-timer nil) - (if git-blame-update-queue - (let ((first (pop git-blame-update-queue)) - (inhibit-point-motion-hooks t)) - (git-blame-update-region (car first) (cdr first))))) - -(provide 'git-blame) - -;;; git-blame.el ends here diff --git a/emacs/external/git-contrib-emacs/git.el b/emacs/external/git-contrib-emacs/git.el deleted file mode 100644 index 4fa853f..0000000 --- a/emacs/external/git-contrib-emacs/git.el +++ /dev/null @@ -1,1588 +0,0 @@ -;;; git.el --- A user interface for git - -;; Copyright (C) 2005, 2006, 2007 Alexandre Julliard - -;; Version: 1.0 - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be -;; useful, but WITHOUT ANY WARRANTY; without even the implied -;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -;; PURPOSE. See the GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public -;; License along with this program; if not, write to the Free -;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, -;; MA 02111-1307 USA - -;;; Commentary: - -;; This file contains an interface for the git version control -;; system. It provides easy access to the most frequently used git -;; commands. The user interface is as far as possible identical to -;; that of the PCL-CVS mode. -;; -;; To install: put this file on the load-path and place the following -;; in your .emacs file: -;; -;; (require 'git) -;; -;; To start: `M-x git-status' -;; -;; TODO -;; - portability to XEmacs -;; - diff against other branch -;; - renaming files from the status buffer -;; - creating tags -;; - fetch/pull -;; - switching branches -;; - revlist browser -;; - git-show-branch browser -;; - menus -;; - -(eval-when-compile (require 'cl)) -(require 'ewoc) -(require 'log-edit) -(require 'easymenu) - - -;;;; Customizations -;;;; ------------------------------------------------------------ - -(defgroup git nil - "A user interface for the git versioning system." - :group 'tools) - -(defcustom git-committer-name nil - "User name to use for commits. -The default is to fall back to the repository config, -then to `add-log-full-name' and then to `user-full-name'." - :group 'git - :type '(choice (const :tag "Default" nil) - (string :tag "Name"))) - -(defcustom git-committer-email nil - "Email address to use for commits. -The default is to fall back to the git repository config, -then to `add-log-mailing-address' and then to `user-mail-address'." - :group 'git - :type '(choice (const :tag "Default" nil) - (string :tag "Email"))) - -(defcustom git-commits-coding-system nil - "Default coding system for the log message of git commits." - :group 'git - :type '(choice (const :tag "From repository config" nil) - (coding-system))) - -(defcustom git-append-signed-off-by nil - "Whether to append a Signed-off-by line to the commit message before editing." - :group 'git - :type 'boolean) - -(defcustom git-reuse-status-buffer t - "Whether `git-status' should try to reuse an existing buffer -if there is already one that displays the same directory." - :group 'git - :type 'boolean) - -(defcustom git-per-dir-ignore-file ".gitignore" - "Name of the per-directory ignore file." - :group 'git - :type 'string) - -(defcustom git-show-uptodate nil - "Whether to display up-to-date files." - :group 'git - :type 'boolean) - -(defcustom git-show-ignored nil - "Whether to display ignored files." - :group 'git - :type 'boolean) - -(defcustom git-show-unknown t - "Whether to display unknown files." - :group 'git - :type 'boolean) - - -(defface git-status-face - '((((class color) (background light)) (:foreground "purple")) - (((class color) (background dark)) (:foreground "salmon"))) - "Git mode face used to highlight added and modified files." - :group 'git) - -(defface git-unmerged-face - '((((class color) (background light)) (:foreground "red" :bold t)) - (((class color) (background dark)) (:foreground "red" :bold t))) - "Git mode face used to highlight unmerged files." - :group 'git) - -(defface git-unknown-face - '((((class color) (background light)) (:foreground "goldenrod" :bold t)) - (((class color) (background dark)) (:foreground "goldenrod" :bold t))) - "Git mode face used to highlight unknown files." - :group 'git) - -(defface git-uptodate-face - '((((class color) (background light)) (:foreground "grey60")) - (((class color) (background dark)) (:foreground "grey40"))) - "Git mode face used to highlight up-to-date files." - :group 'git) - -(defface git-ignored-face - '((((class color) (background light)) (:foreground "grey60")) - (((class color) (background dark)) (:foreground "grey40"))) - "Git mode face used to highlight ignored files." - :group 'git) - -(defface git-mark-face - '((((class color) (background light)) (:foreground "red" :bold t)) - (((class color) (background dark)) (:foreground "tomato" :bold t))) - "Git mode face used for the file marks." - :group 'git) - -(defface git-header-face - '((((class color) (background light)) (:foreground "blue")) - (((class color) (background dark)) (:foreground "blue"))) - "Git mode face used for commit headers." - :group 'git) - -(defface git-separator-face - '((((class color) (background light)) (:foreground "brown")) - (((class color) (background dark)) (:foreground "brown"))) - "Git mode face used for commit separator." - :group 'git) - -(defface git-permission-face - '((((class color) (background light)) (:foreground "green" :bold t)) - (((class color) (background dark)) (:foreground "green" :bold t))) - "Git mode face used for permission changes." - :group 'git) - - -;;;; Utilities -;;;; ------------------------------------------------------------ - -(defconst git-log-msg-separator "--- log message follows this line ---") - -(defvar git-log-edit-font-lock-keywords - `(("^\\(Author:\\|Date:\\|Parent:\\|Signed-off-by:\\)\\(.*\\)$" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face)) - (,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$") - (1 font-lock-comment-face)))) - -(defun git-get-env-strings (env) - "Build a list of NAME=VALUE strings from a list of environment strings." - (mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env)) - -(defun git-call-process-env (buffer env &rest args) - "Wrapper for call-process that sets environment strings." - (let ((process-environment (append (git-get-env-strings env) - process-environment))) - (apply #'call-process "git" nil buffer nil args))) - -(defun git-call-process-display-error (&rest args) - "Wrapper for call-process that displays error messages." - (let* ((dir default-directory) - (buffer (get-buffer-create "*Git Command Output*")) - (ok (with-current-buffer buffer - (let ((default-directory dir) - (buffer-read-only nil)) - (erase-buffer) - (eq 0 (apply 'call-process "git" nil (list buffer t) nil args)))))) - (unless ok (display-message-or-buffer buffer)) - ok)) - -(defun git-call-process-env-string (env &rest args) - "Wrapper for call-process that sets environment strings, -and returns the process output as a string, or nil if the git failed." - (with-temp-buffer - (and (eq 0 (apply #' git-call-process-env t env args)) - (buffer-string)))) - -(defun git-run-process-region (buffer start end program args) - "Run a git process with a buffer region as input." - (let ((output-buffer (current-buffer)) - (dir default-directory)) - (with-current-buffer buffer - (cd dir) - (apply #'call-process-region start end program - nil (list output-buffer nil) nil args)))) - -(defun git-run-command-buffer (buffer-name &rest args) - "Run a git command, sending the output to a buffer named BUFFER-NAME." - (let ((dir default-directory) - (buffer (get-buffer-create buffer-name))) - (message "Running git %s..." (car args)) - (with-current-buffer buffer - (let ((default-directory dir) - (buffer-read-only nil)) - (erase-buffer) - (apply #'git-call-process-env buffer nil args))) - (message "Running git %s...done" (car args)) - buffer)) - -(defun git-run-command-region (buffer start end env &rest args) - "Run a git command with specified buffer region as input." - (unless (eq 0 (if env - (git-run-process-region - buffer start end "env" - (append (git-get-env-strings env) (list "git") args)) - (git-run-process-region - buffer start end "git" args))) - (error "Failed to run \"git %s\":\n%s" (mapconcat (lambda (x) x) args " ") (buffer-string)))) - -(defun git-run-hook (hook env &rest args) - "Run a git hook and display its output if any." - (let ((dir default-directory) - (hook-name (expand-file-name (concat ".git/hooks/" hook)))) - (or (not (file-executable-p hook-name)) - (let (status (buffer (get-buffer-create "*Git Hook Output*"))) - (with-current-buffer buffer - (erase-buffer) - (cd dir) - (setq status - (if env - (apply #'call-process "env" nil (list buffer t) nil - (append (git-get-env-strings env) (list hook-name) args)) - (apply #'call-process hook-name nil (list buffer t) nil args)))) - (display-message-or-buffer buffer) - (eq 0 status))))) - -(defun git-get-string-sha1 (string) - "Read a SHA1 from the specified string." - (and string - (string-match "[0-9a-f]\\{40\\}" string) - (match-string 0 string))) - -(defun git-get-committer-name () - "Return the name to use as GIT_COMMITTER_NAME." - ; copied from log-edit - (or git-committer-name - (git-config "user.name") - (and (boundp 'add-log-full-name) add-log-full-name) - (and (fboundp 'user-full-name) (user-full-name)) - (and (boundp 'user-full-name) user-full-name))) - -(defun git-get-committer-email () - "Return the email address to use as GIT_COMMITTER_EMAIL." - ; copied from log-edit - (or git-committer-email - (git-config "user.email") - (and (boundp 'add-log-mailing-address) add-log-mailing-address) - (and (fboundp 'user-mail-address) (user-mail-address)) - (and (boundp 'user-mail-address) user-mail-address))) - -(defun git-get-commits-coding-system () - "Return the coding system to use for commits." - (let ((repo-config (git-config "i18n.commitencoding"))) - (or git-commits-coding-system - (and repo-config - (fboundp 'locale-charset-to-coding-system) - (locale-charset-to-coding-system repo-config)) - 'utf-8))) - -(defun git-get-logoutput-coding-system () - "Return the coding system used for git-log output." - (let ((repo-config (or (git-config "i18n.logoutputencoding") - (git-config "i18n.commitencoding")))) - (or git-commits-coding-system - (and repo-config - (fboundp 'locale-charset-to-coding-system) - (locale-charset-to-coding-system repo-config)) - 'utf-8))) - -(defun git-escape-file-name (name) - "Escape a file name if necessary." - (if (string-match "[\n\t\"\\]" name) - (concat "\"" - (mapconcat (lambda (c) - (case c - (?\n "\\n") - (?\t "\\t") - (?\\ "\\\\") - (?\" "\\\"") - (t (char-to-string c)))) - name "") - "\"") - name)) - -(defun git-success-message (text files) - "Print a success message after having handled FILES." - (let ((n (length files))) - (if (equal n 1) - (message "%s %s" text (car files)) - (message "%s %d files" text n)))) - -(defun git-get-top-dir (dir) - "Retrieve the top-level directory of a git tree." - (let ((cdup (with-output-to-string - (with-current-buffer standard-output - (cd dir) - (unless (eq 0 (call-process "git" nil t nil "rev-parse" "--show-cdup")) - (error "cannot find top-level git tree for %s." dir)))))) - (expand-file-name (concat (file-name-as-directory dir) - (car (split-string cdup "\n")))))) - -;stolen from pcl-cvs -(defun git-append-to-ignore (file) - "Add a file name to the ignore file in its directory." - (let* ((fullname (expand-file-name file)) - (dir (file-name-directory fullname)) - (name (file-name-nondirectory fullname)) - (ignore-name (expand-file-name git-per-dir-ignore-file dir)) - (created (not (file-exists-p ignore-name)))) - (save-window-excursion - (set-buffer (find-file-noselect ignore-name)) - (goto-char (point-max)) - (unless (zerop (current-column)) (insert "\n")) - (insert "/" name "\n") - (sort-lines nil (point-min) (point-max)) - (save-buffer)) - (when created - (git-call-process-env nil nil "update-index" "--add" "--" (file-relative-name ignore-name))) - (git-update-status-files (list (file-relative-name ignore-name)) 'unknown))) - -; propertize definition for XEmacs, stolen from erc-compat -(eval-when-compile - (unless (fboundp 'propertize) - (defun propertize (string &rest props) - (let ((string (copy-sequence string))) - (while props - (put-text-property 0 (length string) (nth 0 props) (nth 1 props) string) - (setq props (cddr props))) - string)))) - -;;;; Wrappers for basic git commands -;;;; ------------------------------------------------------------ - -(defun git-rev-parse (rev) - "Parse a revision name and return its SHA1." - (git-get-string-sha1 - (git-call-process-env-string nil "rev-parse" rev))) - -(defun git-config (key) - "Retrieve the value associated to KEY in the git repository config file." - (let ((str (git-call-process-env-string nil "config" key))) - (and str (car (split-string str "\n"))))) - -(defun git-symbolic-ref (ref) - "Wrapper for the git-symbolic-ref command." - (let ((str (git-call-process-env-string nil "symbolic-ref" ref))) - (and str (car (split-string str "\n"))))) - -(defun git-update-ref (ref newval &optional oldval reason) - "Update a reference by calling git-update-ref." - (let ((args (and oldval (list oldval)))) - (push newval args) - (push ref args) - (when reason - (push reason args) - (push "-m" args)) - (apply 'git-call-process-display-error "update-ref" args))) - -(defun git-read-tree (tree &optional index-file) - "Read a tree into the index file." - (apply #'git-call-process-env nil - (if index-file `(("GIT_INDEX_FILE" . ,index-file)) nil) - "read-tree" (if tree (list tree)))) - -(defun git-write-tree (&optional index-file) - "Call git-write-tree and return the resulting tree SHA1 as a string." - (git-get-string-sha1 - (git-call-process-env-string (and index-file `(("GIT_INDEX_FILE" . ,index-file))) "write-tree"))) - -(defun git-commit-tree (buffer tree head) - "Call git-commit-tree with buffer as input and return the resulting commit SHA1." - (let ((author-name (git-get-committer-name)) - (author-email (git-get-committer-email)) - (subject "commit (initial): ") - author-date log-start log-end args coding-system-for-write) - (when head - (setq subject "commit: ") - (push "-p" args) - (push head args)) - (with-current-buffer buffer - (goto-char (point-min)) - (if - (setq log-start (re-search-forward (concat "^" (regexp-quote git-log-msg-separator) "\n") nil t)) - (save-restriction - (narrow-to-region (point-min) log-start) - (goto-char (point-min)) - (when (re-search-forward "^Author: +\\(.*?\\) *<\\(.*\\)> *$" nil t) - (setq author-name (match-string 1) - author-email (match-string 2))) - (goto-char (point-min)) - (when (re-search-forward "^Date: +\\(.*\\)$" nil t) - (setq author-date (match-string 1))) - (goto-char (point-min)) - (while (re-search-forward "^Parent: +\\([0-9a-f]+\\)" nil t) - (unless (string-equal head (match-string 1)) - (setq subject "commit (merge): ") - (push "-p" args) - (push (match-string 1) args)))) - (setq log-start (point-min))) - (setq log-end (point-max)) - (goto-char log-start) - (when (re-search-forward ".*$" nil t) - (setq subject (concat subject (match-string 0)))) - (setq coding-system-for-write buffer-file-coding-system)) - (let ((commit - (git-get-string-sha1 - (with-output-to-string - (with-current-buffer standard-output - (let ((env `(("GIT_AUTHOR_NAME" . ,author-name) - ("GIT_AUTHOR_EMAIL" . ,author-email) - ("GIT_COMMITTER_NAME" . ,(git-get-committer-name)) - ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email))))) - (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env)) - (apply #'git-run-command-region - buffer log-start log-end env - "commit-tree" tree (nreverse args)))))))) - (and (git-update-ref "HEAD" commit head subject) - commit)))) - -(defun git-empty-db-p () - "Check if the git db is empty (no commit done yet)." - (not (eq 0 (call-process "git" nil nil nil "rev-parse" "--verify" "HEAD")))) - -(defun git-get-merge-heads () - "Retrieve the merge heads from the MERGE_HEAD file if present." - (let (heads) - (when (file-readable-p ".git/MERGE_HEAD") - (with-temp-buffer - (insert-file-contents ".git/MERGE_HEAD" nil nil nil t) - (goto-char (point-min)) - (while (re-search-forward "[0-9a-f]\\{40\\}" nil t) - (push (match-string 0) heads)))) - (nreverse heads))) - -(defun git-get-commit-description (commit) - "Get a one-line description of COMMIT." - (let ((coding-system-for-read (git-get-logoutput-coding-system))) - (let ((descr (git-call-process-env-string nil "log" "--max-count=1" "--pretty=oneline" commit))) - (if (and descr (string-match "\\`\\([0-9a-f]\\{40\\}\\) *\\(.*\\)$" descr)) - (concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr)) - descr)))) - -;;;; File info structure -;;;; ------------------------------------------------------------ - -; fileinfo structure stolen from pcl-cvs -(defstruct (git-fileinfo - (:copier nil) - (:constructor git-create-fileinfo (state name &optional old-perm new-perm rename-state orig-name marked)) - (:conc-name git-fileinfo->)) - marked ;; t/nil - state ;; current state - name ;; file name - old-perm new-perm ;; permission flags - rename-state ;; rename or copy state - orig-name ;; original name for renames or copies - needs-refresh) ;; whether file needs to be refreshed - -(defvar git-status nil) - -(defun git-clear-status (status) - "Remove everything from the status list." - (ewoc-filter status (lambda (info) nil))) - -(defun git-set-fileinfo-state (info state) - "Set the state of a file info." - (unless (eq (git-fileinfo->state info) state) - (setf (git-fileinfo->state info) state - (git-fileinfo->new-perm info) (git-fileinfo->old-perm info) - (git-fileinfo->rename-state info) nil - (git-fileinfo->orig-name info) nil - (git-fileinfo->needs-refresh info) t))) - -(defun git-status-filenames-map (status func files &rest args) - "Apply FUNC to the status files names in the FILES list." - (when files - (setq files (sort files #'string-lessp)) - (let ((file (pop files)) - (node (ewoc-nth status 0))) - (while (and file node) - (let ((info (ewoc-data node))) - (if (string-lessp (git-fileinfo->name info) file) - (setq node (ewoc-next status node)) - (if (string-equal (git-fileinfo->name info) file) - (apply func info args)) - (setq file (pop files)))))))) - -(defun git-set-filenames-state (status files state) - "Set the state of a list of named files." - (when files - (git-status-filenames-map status #'git-set-fileinfo-state files state) - (unless state ;; delete files whose state has been set to nil - (ewoc-filter status (lambda (info) (git-fileinfo->state info)))))) - -(defun git-state-code (code) - "Convert from a string to a added/deleted/modified state." - (case (string-to-char code) - (?M 'modified) - (?? 'unknown) - (?A 'added) - (?D 'deleted) - (?U 'unmerged) - (?T 'modified) - (t nil))) - -(defun git-status-code-as-string (code) - "Format a git status code as string." - (case code - ('modified (propertize "Modified" 'face 'git-status-face)) - ('unknown (propertize "Unknown " 'face 'git-unknown-face)) - ('added (propertize "Added " 'face 'git-status-face)) - ('deleted (propertize "Deleted " 'face 'git-status-face)) - ('unmerged (propertize "Unmerged" 'face 'git-unmerged-face)) - ('uptodate (propertize "Uptodate" 'face 'git-uptodate-face)) - ('ignored (propertize "Ignored " 'face 'git-ignored-face)) - (t "? "))) - -(defun git-file-type-as-string (old-perm new-perm) - "Return a string describing the file type based on its permissions." - (let* ((old-type (lsh (or old-perm 0) -9)) - (new-type (lsh (or new-perm 0) -9)) - (str (case new-type - (?\100 ;; file - (case old-type - (?\100 nil) - (?\120 " (type change symlink -> file)") - (?\160 " (type change subproject -> file)"))) - (?\120 ;; symlink - (case old-type - (?\100 " (type change file -> symlink)") - (?\160 " (type change subproject -> symlink)") - (t " (symlink)"))) - (?\160 ;; subproject - (case old-type - (?\100 " (type change file -> subproject)") - (?\120 " (type change symlink -> subproject)") - (t " (subproject)"))) - (?\110 nil) ;; directory (internal, not a real git state) - (?\000 ;; deleted or unknown - (case old-type - (?\120 " (symlink)") - (?\160 " (subproject)"))) - (t (format " (unknown type %o)" new-type))))) - (cond (str (propertize str 'face 'git-status-face)) - ((eq new-type ?\110) "/") - (t "")))) - -(defun git-rename-as-string (info) - "Return a string describing the copy or rename associated with INFO, or an empty string if none." - (let ((state (git-fileinfo->rename-state info))) - (if state - (propertize - (concat " (" - (if (eq state 'copy) "copied from " - (if (eq (git-fileinfo->state info) 'added) "renamed from " - "renamed to ")) - (git-escape-file-name (git-fileinfo->orig-name info)) - ")") 'face 'git-status-face) - ""))) - -(defun git-permissions-as-string (old-perm new-perm) - "Format a permission change as string." - (propertize - (if (or (not old-perm) - (not new-perm) - (eq 0 (logand ?\111 (logxor old-perm new-perm)))) - " " - (if (eq 0 (logand ?\111 old-perm)) "+x" "-x")) - 'face 'git-permission-face)) - -(defun git-fileinfo-prettyprint (info) - "Pretty-printer for the git-fileinfo structure." - (let ((old-perm (git-fileinfo->old-perm info)) - (new-perm (git-fileinfo->new-perm info))) - (insert (concat " " (if (git-fileinfo->marked info) (propertize "*" 'face 'git-mark-face) " ") - " " (git-status-code-as-string (git-fileinfo->state info)) - " " (git-permissions-as-string old-perm new-perm) - " " (git-escape-file-name (git-fileinfo->name info)) - (git-file-type-as-string old-perm new-perm) - (git-rename-as-string info))))) - -(defun git-insert-info-list (status infolist) - "Insert a list of file infos in the status buffer, replacing existing ones if any." - (setq infolist (sort infolist - (lambda (info1 info2) - (string-lessp (git-fileinfo->name info1) - (git-fileinfo->name info2))))) - (let ((info (pop infolist)) - (node (ewoc-nth status 0))) - (while info - (cond ((not node) - (setq node (ewoc-enter-last status info)) - (setq info (pop infolist))) - ((string-lessp (git-fileinfo->name (ewoc-data node)) - (git-fileinfo->name info)) - (setq node (ewoc-next status node))) - ((string-equal (git-fileinfo->name (ewoc-data node)) - (git-fileinfo->name info)) - ;; preserve the marked flag - (setf (git-fileinfo->marked info) (git-fileinfo->marked (ewoc-data node))) - (setf (git-fileinfo->needs-refresh info) t) - (setf (ewoc-data node) info) - (setq info (pop infolist))) - (t - (setq node (ewoc-enter-before status node info)) - (setq info (pop infolist))))))) - -(defun git-run-diff-index (status files) - "Run git-diff-index on FILES and parse the results into STATUS. -Return the list of files that haven't been handled." - (let ((remaining (copy-sequence files)) - infolist) - (with-temp-buffer - (apply #'git-call-process-env t nil "diff-index" "-z" "-M" "HEAD" "--" files) - (goto-char (point-min)) - (while (re-search-forward - ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0" - nil t 1) - (let ((old-perm (string-to-number (match-string 1) 8)) - (new-perm (string-to-number (match-string 2) 8)) - (state (or (match-string 4) (match-string 6))) - (name (or (match-string 5) (match-string 7))) - (new-name (match-string 8))) - (if new-name ; copy or rename - (if (eq ?C (string-to-char state)) - (push (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) infolist) - (push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist) - (push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist)) - (push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist)) - (setq remaining (delete name remaining)) - (when new-name (setq remaining (delete new-name remaining)))))) - (git-insert-info-list status infolist) - remaining)) - -(defun git-find-status-file (status file) - "Find a given file in the status ewoc and return its node." - (let ((node (ewoc-nth status 0))) - (while (and node (not (string= file (git-fileinfo->name (ewoc-data node))))) - (setq node (ewoc-next status node))) - node)) - -(defun git-run-ls-files (status files default-state &rest options) - "Run git-ls-files on FILES and parse the results into STATUS. -Return the list of files that haven't been handled." - (let (infolist) - (with-temp-buffer - (apply #'git-call-process-env t nil "ls-files" "-z" (append options (list "--") files)) - (goto-char (point-min)) - (while (re-search-forward "\\([^\0]*?\\)\\(/?\\)\0" nil t 1) - (let ((name (match-string 1))) - (push (git-create-fileinfo default-state name 0 - (if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0)) - infolist) - (setq files (delete name files))))) - (git-insert-info-list status infolist) - files)) - -(defun git-run-ls-files-cached (status files default-state) - "Run git-ls-files -c on FILES and parse the results into STATUS. -Return the list of files that haven't been handled." - (let ((remaining (copy-sequence files)) - infolist) - (with-temp-buffer - (apply #'git-call-process-env t nil "ls-files" "-z" "-s" "-c" "--" files) - (goto-char (point-min)) - (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) - (let* ((new-perm (string-to-number (match-string 1) 8)) - (old-perm (if (eq default-state 'added) 0 new-perm)) - (name (match-string 2))) - (push (git-create-fileinfo default-state name old-perm new-perm) infolist) - (setq remaining (delete name remaining))))) - (git-insert-info-list status infolist) - remaining)) - -(defun git-run-ls-unmerged (status files) - "Run git-ls-files -u on FILES and parse the results into STATUS." - (with-temp-buffer - (apply #'git-call-process-env t nil "ls-files" "-z" "-u" "--" files) - (goto-char (point-min)) - (let (unmerged-files) - (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t) - (push (match-string 1) unmerged-files)) - (git-set-filenames-state status unmerged-files 'unmerged)))) - -(defun git-get-exclude-files () - "Get the list of exclude files to pass to git-ls-files." - (let (files - (config (git-config "core.excludesfile"))) - (when (file-readable-p ".git/info/exclude") - (push ".git/info/exclude" files)) - (when (and config (file-readable-p config)) - (push config files)) - files)) - -(defun git-run-ls-files-with-excludes (status files default-state &rest options) - "Run git-ls-files on FILES with appropriate --exclude-from options." - (let ((exclude-files (git-get-exclude-files))) - (apply #'git-run-ls-files status files default-state "--directory" "--no-empty-directory" - (concat "--exclude-per-directory=" git-per-dir-ignore-file) - (append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files))))) - -(defun git-update-status-files (files &optional default-state) - "Update the status of FILES from the index." - (unless git-status (error "Not in git-status buffer.")) - (when (or git-show-uptodate files) - (git-run-ls-files-cached git-status files 'uptodate)) - (let* ((remaining-files - (if (git-empty-db-p) ; we need some special handling for an empty db - (git-run-ls-files-cached git-status files 'added) - (git-run-diff-index git-status files)))) - (git-run-ls-unmerged git-status files) - (when (or remaining-files (and git-show-unknown (not files))) - (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'unknown "-o"))) - (when (or remaining-files (and git-show-ignored (not files))) - (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'ignored "-o" "-i"))) - (git-set-filenames-state git-status remaining-files default-state) - (git-refresh-files) - (git-refresh-ewoc-hf git-status))) - -(defun git-mark-files (status files) - "Mark all the specified FILES, and unmark the others." - (setq files (sort files #'string-lessp)) - (let ((file (and files (pop files))) - (node (ewoc-nth status 0))) - (while node - (let ((info (ewoc-data node))) - (if (and file (string-equal (git-fileinfo->name info) file)) - (progn - (unless (git-fileinfo->marked info) - (setf (git-fileinfo->marked info) t) - (setf (git-fileinfo->needs-refresh info) t)) - (setq file (pop files)) - (setq node (ewoc-next status node))) - (when (git-fileinfo->marked info) - (setf (git-fileinfo->marked info) nil) - (setf (git-fileinfo->needs-refresh info) t)) - (if (and file (string-lessp file (git-fileinfo->name info))) - (setq file (pop files)) - (setq node (ewoc-next status node)))))))) - -(defun git-marked-files () - "Return a list of all marked files, or if none a list containing just the file at cursor position." - (unless git-status (error "Not in git-status buffer.")) - (or (ewoc-collect git-status (lambda (info) (git-fileinfo->marked info))) - (list (ewoc-data (ewoc-locate git-status))))) - -(defun git-marked-files-state (&rest states) - "Return marked files that are in the specified states." - (let ((files (git-marked-files)) - result) - (dolist (info files) - (when (memq (git-fileinfo->state info) states) - (push info result))) - result)) - -(defun git-refresh-files () - "Refresh all files that need it and clear the needs-refresh flag." - (unless git-status (error "Not in git-status buffer.")) - (ewoc-map - (lambda (info) - (let ((refresh (git-fileinfo->needs-refresh info))) - (setf (git-fileinfo->needs-refresh info) nil) - refresh)) - git-status) - ; move back to goal column - (when goal-column (move-to-column goal-column))) - -(defun git-refresh-ewoc-hf (status) - "Refresh the ewoc header and footer." - (let ((branch (git-symbolic-ref "HEAD")) - (head (if (git-empty-db-p) "Nothing committed yet" - (git-get-commit-description "HEAD"))) - (merge-heads (git-get-merge-heads))) - (ewoc-set-hf status - (format "Directory: %s\nBranch: %s\nHead: %s%s\n" - default-directory - (if branch - (if (string-match "^refs/heads/" branch) - (substring branch (match-end 0)) - branch) - "none (detached HEAD)") - head - (if merge-heads - (concat "\nMerging: " - (mapconcat (lambda (str) (git-get-commit-description str)) merge-heads "\n ")) - "")) - (if (ewoc-nth status 0) "" " No changes.")))) - -(defun git-get-filenames (files) - (mapcar (lambda (info) (git-fileinfo->name info)) files)) - -(defun git-update-index (index-file files) - "Run git-update-index on a list of files." - (let ((env (and index-file `(("GIT_INDEX_FILE" . ,index-file)))) - added deleted modified) - (dolist (info files) - (case (git-fileinfo->state info) - ('added (push info added)) - ('deleted (push info deleted)) - ('modified (push info modified)))) - (when added - (apply #'git-call-process-env nil env "update-index" "--add" "--" (git-get-filenames added))) - (when deleted - (apply #'git-call-process-env nil env "update-index" "--remove" "--" (git-get-filenames deleted))) - (when modified - (apply #'git-call-process-env nil env "update-index" "--" (git-get-filenames modified))))) - -(defun git-run-pre-commit-hook () - "Run the pre-commit hook if any." - (unless git-status (error "Not in git-status buffer.")) - (let ((files (git-marked-files-state 'added 'deleted 'modified))) - (or (not files) - (not (file-executable-p ".git/hooks/pre-commit")) - (let ((index-file (make-temp-file "gitidx"))) - (unwind-protect - (let ((head-tree (unless (git-empty-db-p) (git-rev-parse "HEAD^{tree}")))) - (git-read-tree head-tree index-file) - (git-update-index index-file files) - (git-run-hook "pre-commit" `(("GIT_INDEX_FILE" . ,index-file)))) - (delete-file index-file)))))) - -(defun git-do-commit () - "Perform the actual commit using the current buffer as log message." - (interactive) - (let ((buffer (current-buffer)) - (index-file (make-temp-file "gitidx"))) - (with-current-buffer log-edit-parent-buffer - (if (git-marked-files-state 'unmerged) - (message "You cannot commit unmerged files, resolve them first.") - (unwind-protect - (let ((files (git-marked-files-state 'added 'deleted 'modified)) - head head-tree) - (unless (git-empty-db-p) - (setq head (git-rev-parse "HEAD") - head-tree (git-rev-parse "HEAD^{tree}"))) - (if files - (progn - (message "Running git commit...") - (git-read-tree head-tree index-file) - (git-update-index nil files) ;update both the default index - (git-update-index index-file files) ;and the temporary one - (let ((tree (git-write-tree index-file))) - (if (or (not (string-equal tree head-tree)) - (yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? ")) - (let ((commit (git-commit-tree buffer tree head))) - (when commit - (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil)) - (condition-case nil (delete-file ".git/MERGE_MSG") (error nil)) - (with-current-buffer buffer (erase-buffer)) - (git-update-status-files (git-get-filenames files) 'uptodate) - (git-call-process-env nil nil "rerere") - (git-call-process-env nil nil "gc" "--auto") - (git-refresh-files) - (git-refresh-ewoc-hf git-status) - (message "Committed %s." commit) - (git-run-hook "post-commit" nil))) - (message "Commit aborted.")))) - (message "No files to commit."))) - (delete-file index-file)))))) - - -;;;; Interactive functions -;;;; ------------------------------------------------------------ - -(defun git-mark-file () - "Mark the file that the cursor is on and move to the next one." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let* ((pos (ewoc-locate git-status)) - (info (ewoc-data pos))) - (setf (git-fileinfo->marked info) t) - (ewoc-invalidate git-status pos) - (ewoc-goto-next git-status 1))) - -(defun git-unmark-file () - "Unmark the file that the cursor is on and move to the next one." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let* ((pos (ewoc-locate git-status)) - (info (ewoc-data pos))) - (setf (git-fileinfo->marked info) nil) - (ewoc-invalidate git-status pos) - (ewoc-goto-next git-status 1))) - -(defun git-unmark-file-up () - "Unmark the file that the cursor is on and move to the previous one." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let* ((pos (ewoc-locate git-status)) - (info (ewoc-data pos))) - (setf (git-fileinfo->marked info) nil) - (ewoc-invalidate git-status pos) - (ewoc-goto-prev git-status 1))) - -(defun git-mark-all () - "Mark all files." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (ewoc-map (lambda (info) (unless (git-fileinfo->marked info) - (setf (git-fileinfo->marked info) t))) git-status) - ; move back to goal column after invalidate - (when goal-column (move-to-column goal-column))) - -(defun git-unmark-all () - "Unmark all files." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (ewoc-map (lambda (info) (when (git-fileinfo->marked info) - (setf (git-fileinfo->marked info) nil) - t)) git-status) - ; move back to goal column after invalidate - (when goal-column (move-to-column goal-column))) - -(defun git-toggle-all-marks () - "Toggle all file marks." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (ewoc-map (lambda (info) (setf (git-fileinfo->marked info) (not (git-fileinfo->marked info))) t) git-status) - ; move back to goal column after invalidate - (when goal-column (move-to-column goal-column))) - -(defun git-next-file (&optional n) - "Move the selection down N files." - (interactive "p") - (unless git-status (error "Not in git-status buffer.")) - (ewoc-goto-next git-status n)) - -(defun git-prev-file (&optional n) - "Move the selection up N files." - (interactive "p") - (unless git-status (error "Not in git-status buffer.")) - (ewoc-goto-prev git-status n)) - -(defun git-next-unmerged-file (&optional n) - "Move the selection down N unmerged files." - (interactive "p") - (unless git-status (error "Not in git-status buffer.")) - (let* ((last (ewoc-locate git-status)) - (node (ewoc-next git-status last))) - (while (and node (> n 0)) - (when (eq 'unmerged (git-fileinfo->state (ewoc-data node))) - (setq n (1- n)) - (setq last node)) - (setq node (ewoc-next git-status node))) - (ewoc-goto-node git-status last))) - -(defun git-prev-unmerged-file (&optional n) - "Move the selection up N unmerged files." - (interactive "p") - (unless git-status (error "Not in git-status buffer.")) - (let* ((last (ewoc-locate git-status)) - (node (ewoc-prev git-status last))) - (while (and node (> n 0)) - (when (eq 'unmerged (git-fileinfo->state (ewoc-data node))) - (setq n (1- n)) - (setq last node)) - (setq node (ewoc-prev git-status node))) - (ewoc-goto-node git-status last))) - -(defun git-add-file () - "Add marked file(s) to the index cache." - (interactive) - (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored)))) - ;; FIXME: add support for directories - (unless files - (push (file-relative-name (read-file-name "File to add: " nil nil t)) files)) - (when (apply 'git-call-process-display-error "update-index" "--add" "--" files) - (git-update-status-files files 'uptodate) - (git-success-message "Added" files)))) - -(defun git-ignore-file () - "Add marked file(s) to the ignore list." - (interactive) - (let ((files (git-get-filenames (git-marked-files-state 'unknown)))) - (unless files - (push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files)) - (dolist (f files) (git-append-to-ignore f)) - (git-update-status-files files 'ignored) - (git-success-message "Ignored" files))) - -(defun git-remove-file () - "Remove the marked file(s)." - (interactive) - (let ((files (git-get-filenames (git-marked-files-state 'added 'modified 'unknown 'uptodate 'ignored)))) - (unless files - (push (file-relative-name (read-file-name "File to remove: " nil nil t)) files)) - (if (yes-or-no-p - (format "Remove %d file%s? " (length files) (if (> (length files) 1) "s" ""))) - (progn - (dolist (name files) - (ignore-errors - (if (file-directory-p name) - (delete-directory name) - (delete-file name)))) - (when (apply 'git-call-process-display-error "update-index" "--remove" "--" files) - (git-update-status-files files nil) - (git-success-message "Removed" files))) - (message "Aborting")))) - -(defun git-revert-file () - "Revert changes to the marked file(s)." - (interactive) - (let ((files (git-marked-files-state 'added 'deleted 'modified 'unmerged)) - added modified) - (when (and files - (yes-or-no-p - (format "Revert %d file%s? " (length files) (if (> (length files) 1) "s" "")))) - (dolist (info files) - (case (git-fileinfo->state info) - ('added (push (git-fileinfo->name info) added)) - ('deleted (push (git-fileinfo->name info) modified)) - ('unmerged (push (git-fileinfo->name info) modified)) - ('modified (push (git-fileinfo->name info) modified)))) - ;; check if a buffer contains one of the files and isn't saved - (dolist (file modified) - (let ((buffer (get-file-buffer file))) - (when (and buffer (buffer-modified-p buffer)) - (error "Buffer %s is modified. Please kill or save modified buffers before reverting." (buffer-name buffer))))) - (let ((ok (and - (or (not added) - (apply 'git-call-process-display-error "update-index" "--force-remove" "--" added)) - (or (not modified) - (apply 'git-call-process-display-error "checkout" "HEAD" modified))))) - (git-update-status-files (append added modified) 'uptodate) - (when ok - (dolist (file modified) - (let ((buffer (get-file-buffer file))) - (when buffer (with-current-buffer buffer (revert-buffer t t t))))) - (git-success-message "Reverted" (git-get-filenames files))))))) - -(defun git-resolve-file () - "Resolve conflicts in marked file(s)." - (interactive) - (let ((files (git-get-filenames (git-marked-files-state 'unmerged)))) - (when files - (when (apply 'git-call-process-display-error "update-index" "--" files) - (git-update-status-files files 'uptodate) - (git-success-message "Resolved" files))))) - -(defun git-remove-handled () - "Remove handled files from the status list." - (interactive) - (ewoc-filter git-status - (lambda (info) - (case (git-fileinfo->state info) - ('ignored git-show-ignored) - ('uptodate git-show-uptodate) - ('unknown git-show-unknown) - (t t)))) - (unless (ewoc-nth git-status 0) ; refresh header if list is empty - (git-refresh-ewoc-hf git-status))) - -(defun git-toggle-show-uptodate () - "Toogle the option for showing up-to-date files." - (interactive) - (if (setq git-show-uptodate (not git-show-uptodate)) - (git-refresh-status) - (git-remove-handled))) - -(defun git-toggle-show-ignored () - "Toogle the option for showing ignored files." - (interactive) - (if (setq git-show-ignored (not git-show-ignored)) - (progn - (message "Inserting ignored files...") - (git-run-ls-files-with-excludes git-status nil 'ignored "-o" "-i") - (git-refresh-files) - (git-refresh-ewoc-hf git-status) - (message "Inserting ignored files...done")) - (git-remove-handled))) - -(defun git-toggle-show-unknown () - "Toogle the option for showing unknown files." - (interactive) - (if (setq git-show-unknown (not git-show-unknown)) - (progn - (message "Inserting unknown files...") - (git-run-ls-files-with-excludes git-status nil 'unknown "-o") - (git-refresh-files) - (git-refresh-ewoc-hf git-status) - (message "Inserting unknown files...done")) - (git-remove-handled))) - -(defun git-expand-directory (info) - "Expand the directory represented by INFO to list its files." - (when (eq (lsh (git-fileinfo->new-perm info) -9) ?\110) - (let ((dir (git-fileinfo->name info))) - (git-set-filenames-state git-status (list dir) nil) - (git-run-ls-files-with-excludes git-status (list (concat dir "/")) 'unknown "-o") - (git-refresh-files) - (git-refresh-ewoc-hf git-status) - t))) - -(defun git-setup-diff-buffer (buffer) - "Setup a buffer for displaying a diff." - (let ((dir default-directory)) - (with-current-buffer buffer - (diff-mode) - (goto-char (point-min)) - (setq default-directory dir) - (setq buffer-read-only t))) - (display-buffer buffer) - ; shrink window only if it displays the status buffer - (when (eq (window-buffer) (current-buffer)) - (shrink-window-if-larger-than-buffer))) - -(defun git-diff-file () - "Diff the marked file(s) against HEAD." - (interactive) - (let ((files (git-marked-files))) - (git-setup-diff-buffer - (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" "HEAD" "--" (git-get-filenames files))))) - -(defun git-diff-file-merge-head (arg) - "Diff the marked file(s) against the first merge head (or the nth one with a numeric prefix)." - (interactive "p") - (let ((files (git-marked-files)) - (merge-heads (git-get-merge-heads))) - (unless merge-heads (error "No merge in progress")) - (git-setup-diff-buffer - (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" - (or (nth (1- arg) merge-heads) "HEAD") "--" (git-get-filenames files))))) - -(defun git-diff-unmerged-file (stage) - "Diff the marked unmerged file(s) against the specified stage." - (let ((files (git-marked-files))) - (git-setup-diff-buffer - (apply #'git-run-command-buffer "*git-diff*" "diff-files" "-p" stage "--" (git-get-filenames files))))) - -(defun git-diff-file-base () - "Diff the marked unmerged file(s) against the common base file." - (interactive) - (git-diff-unmerged-file "-1")) - -(defun git-diff-file-mine () - "Diff the marked unmerged file(s) against my pre-merge version." - (interactive) - (git-diff-unmerged-file "-2")) - -(defun git-diff-file-other () - "Diff the marked unmerged file(s) against the other's pre-merge version." - (interactive) - (git-diff-unmerged-file "-3")) - -(defun git-diff-file-combined () - "Do a combined diff of the marked unmerged file(s)." - (interactive) - (git-diff-unmerged-file "-c")) - -(defun git-diff-file-idiff () - "Perform an interactive diff on the current file." - (interactive) - (let ((files (git-marked-files-state 'added 'deleted 'modified))) - (unless (eq 1 (length files)) - (error "Cannot perform an interactive diff on multiple files.")) - (let* ((filename (car (git-get-filenames files))) - (buff1 (find-file-noselect filename)) - (buff2 (git-run-command-buffer (concat filename ".~HEAD~") "cat-file" "blob" (concat "HEAD:" filename)))) - (ediff-buffers buff1 buff2)))) - -(defun git-log-file () - "Display a log of changes to the marked file(s)." - (interactive) - (let* ((files (git-marked-files)) - (coding-system-for-read git-commits-coding-system) - (buffer (apply #'git-run-command-buffer "*git-log*" "rev-list" "--pretty" "HEAD" "--" (git-get-filenames files)))) - (with-current-buffer buffer - ; (git-log-mode) FIXME: implement log mode - (goto-char (point-min)) - (setq buffer-read-only t)) - (display-buffer buffer))) - -(defun git-log-edit-files () - "Return a list of marked files for use in the log-edit buffer." - (with-current-buffer log-edit-parent-buffer - (git-get-filenames (git-marked-files-state 'added 'deleted 'modified)))) - -(defun git-log-edit-diff () - "Run a diff of the current files being committed from a log-edit buffer." - (with-current-buffer log-edit-parent-buffer - (git-diff-file))) - -(defun git-append-sign-off (name email) - "Append a Signed-off-by entry to the current buffer, avoiding duplicates." - (let ((sign-off (format "Signed-off-by: %s <%s>" name email)) - (case-fold-search t)) - (goto-char (point-min)) - (unless (re-search-forward (concat "^" (regexp-quote sign-off)) nil t) - (goto-char (point-min)) - (unless (re-search-forward "^Signed-off-by: " nil t) - (setq sign-off (concat "\n" sign-off))) - (goto-char (point-max)) - (insert sign-off "\n")))) - -(defun git-setup-log-buffer (buffer &optional author-name author-email subject date msg) - "Setup the log buffer for a commit." - (unless git-status (error "Not in git-status buffer.")) - (let ((merge-heads (git-get-merge-heads)) - (dir default-directory) - (committer-name (git-get-committer-name)) - (committer-email (git-get-committer-email)) - (sign-off git-append-signed-off-by)) - (with-current-buffer buffer - (cd dir) - (erase-buffer) - (insert - (propertize - (format "Author: %s <%s>\n%s%s" - (or author-name committer-name) - (or author-email committer-email) - (if date (format "Date: %s\n" date) "") - (if merge-heads - (format "Parent: %s\n%s\n" - (git-rev-parse "HEAD") - (mapconcat (lambda (str) (concat "Parent: " str)) merge-heads "\n")) - "")) - 'face 'git-header-face) - (propertize git-log-msg-separator 'face 'git-separator-face) - "\n") - (when subject (insert subject "\n\n")) - (cond (msg (insert msg "\n")) - ((file-readable-p ".dotest/msg") - (insert-file-contents ".dotest/msg")) - ((file-readable-p ".git/MERGE_MSG") - (insert-file-contents ".git/MERGE_MSG"))) - ; delete empty lines at end - (goto-char (point-min)) - (when (re-search-forward "\n+\\'" nil t) - (replace-match "\n" t t)) - (when sign-off (git-append-sign-off committer-name committer-email))) - buffer)) - -(defun git-commit-file () - "Commit the marked file(s), asking for a commit message." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (when (git-run-pre-commit-hook) - (let ((buffer (get-buffer-create "*git-commit*")) - (coding-system (git-get-commits-coding-system)) - author-name author-email subject date) - (when (eq 0 (buffer-size buffer)) - (when (file-readable-p ".dotest/info") - (with-temp-buffer - (insert-file-contents ".dotest/info") - (goto-char (point-min)) - (when (re-search-forward "^Author: \\(.*\\)\nEmail: \\(.*\\)$" nil t) - (setq author-name (match-string 1)) - (setq author-email (match-string 2))) - (goto-char (point-min)) - (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subject (match-string 1))) - (goto-char (point-min)) - (when (re-search-forward "^Date: \\(.*\\)$" nil t) - (setq date (match-string 1))))) - (git-setup-log-buffer buffer author-name author-email subject date)) - (if (boundp 'log-edit-diff-function) - (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files) - (log-edit-diff-function . git-log-edit-diff)) buffer) - (log-edit 'git-do-commit nil 'git-log-edit-files buffer)) - (setq font-lock-keywords (font-lock-compile-keywords git-log-edit-font-lock-keywords)) - (setq buffer-file-coding-system coding-system) - (re-search-forward (regexp-quote (concat git-log-msg-separator "\n")) nil t)))) - -(defun git-setup-commit-buffer (commit) - "Setup the commit buffer with the contents of COMMIT." - (let (author-name author-email subject date msg) - (with-temp-buffer - (let ((coding-system (git-get-logoutput-coding-system))) - (git-call-process-env t nil "log" "-1" "--pretty=medium" commit) - (goto-char (point-min)) - (when (re-search-forward "^Author: *\\(.*\\) <\\(.*\\)>$" nil t) - (setq author-name (match-string 1)) - (setq author-email (match-string 2))) - (when (re-search-forward "^Date: *\\(.*\\)$" nil t) - (setq date (match-string 1))) - (while (re-search-forward "^ \\(.*\\)$" nil t) - (push (match-string 1) msg)) - (setq msg (nreverse msg)) - (setq subject (pop msg)) - (while (and msg (zerop (length (car msg))) (pop msg))))) - (git-setup-log-buffer (get-buffer-create "*git-commit*") - author-name author-email subject date - (mapconcat #'identity msg "\n")))) - -(defun git-get-commit-files (commit) - "Retrieve the list of files modified by COMMIT." - (let (files) - (with-temp-buffer - (git-call-process-env t nil "diff-tree" "-r" "-z" "--name-only" "--no-commit-id" commit) - (goto-char (point-min)) - (while (re-search-forward "\\([^\0]*\\)\0" nil t 1) - (push (match-string 1) files))) - files)) - -(defun git-amend-commit () - "Undo the last commit on HEAD, and set things up to commit an -amended version of it." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (when (git-empty-db-p) (error "No commit to amend.")) - (let* ((commit (git-rev-parse "HEAD")) - (files (git-get-commit-files commit))) - (when (git-call-process-display-error "reset" "--soft" "HEAD^") - (git-update-status-files (copy-sequence files) 'uptodate) - (git-mark-files git-status files) - (git-refresh-files) - (git-setup-commit-buffer commit) - (git-commit-file)))) - -(defun git-find-file () - "Visit the current file in its own buffer." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let ((info (ewoc-data (ewoc-locate git-status)))) - (unless (git-expand-directory info) - (find-file (git-fileinfo->name info)) - (when (eq 'unmerged (git-fileinfo->state info)) - (smerge-mode 1))))) - -(defun git-find-file-other-window () - "Visit the current file in its own buffer in another window." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let ((info (ewoc-data (ewoc-locate git-status)))) - (find-file-other-window (git-fileinfo->name info)) - (when (eq 'unmerged (git-fileinfo->state info)) - (smerge-mode)))) - -(defun git-find-file-imerge () - "Visit the current file in interactive merge mode." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let ((info (ewoc-data (ewoc-locate git-status)))) - (find-file (git-fileinfo->name info)) - (smerge-ediff))) - -(defun git-view-file () - "View the current file in its own buffer." - (interactive) - (unless git-status (error "Not in git-status buffer.")) - (let ((info (ewoc-data (ewoc-locate git-status)))) - (view-file (git-fileinfo->name info)))) - -(defun git-refresh-status () - "Refresh the git status buffer." - (interactive) - (let* ((status git-status) - (pos (ewoc-locate status)) - (marked-files (git-get-filenames (ewoc-collect status (lambda (info) (git-fileinfo->marked info))))) - (cur-name (and pos (git-fileinfo->name (ewoc-data pos))))) - (unless status (error "Not in git-status buffer.")) - (message "Refreshing git status...") - (git-call-process-env nil nil "update-index" "--refresh") - (git-clear-status status) - (git-update-status-files nil) - ; restore file marks - (when marked-files - (git-status-filenames-map status - (lambda (info) - (setf (git-fileinfo->marked info) t) - (setf (git-fileinfo->needs-refresh info) t)) - marked-files) - (git-refresh-files)) - ; move point to the current file name if any - (message "Refreshing git status...done") - (let ((node (and cur-name (git-find-status-file status cur-name)))) - (when node (ewoc-goto-node status node))))) - -(defun git-status-quit () - "Quit git-status mode." - (interactive) - (bury-buffer)) - -;;;; Major Mode -;;;; ------------------------------------------------------------ - -(defvar git-status-mode-hook nil - "Run after `git-status-mode' is setup.") - -(defvar git-status-mode-map nil - "Keymap for git major mode.") - -(defvar git-status nil - "List of all files managed by the git-status mode.") - -(unless git-status-mode-map - (let ((map (make-keymap)) - (commit-map (make-sparse-keymap)) - (diff-map (make-sparse-keymap)) - (toggle-map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "?" 'git-help) - (define-key map "h" 'git-help) - (define-key map " " 'git-next-file) - (define-key map "a" 'git-add-file) - (define-key map "c" 'git-commit-file) - (define-key map "\C-c" commit-map) - (define-key map "d" diff-map) - (define-key map "=" 'git-diff-file) - (define-key map "f" 'git-find-file) - (define-key map "\r" 'git-find-file) - (define-key map "g" 'git-refresh-status) - (define-key map "i" 'git-ignore-file) - (define-key map "l" 'git-log-file) - (define-key map "m" 'git-mark-file) - (define-key map "M" 'git-mark-all) - (define-key map "n" 'git-next-file) - (define-key map "N" 'git-next-unmerged-file) - (define-key map "o" 'git-find-file-other-window) - (define-key map "p" 'git-prev-file) - (define-key map "P" 'git-prev-unmerged-file) - (define-key map "q" 'git-status-quit) - (define-key map "r" 'git-remove-file) - (define-key map "R" 'git-resolve-file) - (define-key map "t" toggle-map) - (define-key map "T" 'git-toggle-all-marks) - (define-key map "u" 'git-unmark-file) - (define-key map "U" 'git-revert-file) - (define-key map "v" 'git-view-file) - (define-key map "x" 'git-remove-handled) - (define-key map "\C-?" 'git-unmark-file-up) - (define-key map "\M-\C-?" 'git-unmark-all) - ; the commit submap - (define-key commit-map "\C-a" 'git-amend-commit) - ; the diff submap - (define-key diff-map "b" 'git-diff-file-base) - (define-key diff-map "c" 'git-diff-file-combined) - (define-key diff-map "=" 'git-diff-file) - (define-key diff-map "e" 'git-diff-file-idiff) - (define-key diff-map "E" 'git-find-file-imerge) - (define-key diff-map "h" 'git-diff-file-merge-head) - (define-key diff-map "m" 'git-diff-file-mine) - (define-key diff-map "o" 'git-diff-file-other) - ; the toggle submap - (define-key toggle-map "u" 'git-toggle-show-uptodate) - (define-key toggle-map "i" 'git-toggle-show-ignored) - (define-key toggle-map "k" 'git-toggle-show-unknown) - (define-key toggle-map "m" 'git-toggle-all-marks) - (setq git-status-mode-map map)) - (easy-menu-define git-menu git-status-mode-map - "Git Menu" - `("Git" - ["Refresh" git-refresh-status t] - ["Commit" git-commit-file t] - ("Merge" - ["Next Unmerged File" git-next-unmerged-file t] - ["Prev Unmerged File" git-prev-unmerged-file t] - ["Mark as Resolved" git-resolve-file t] - ["Interactive Merge File" git-find-file-imerge t] - ["Diff Against Common Base File" git-diff-file-base t] - ["Diff Combined" git-diff-file-combined t] - ["Diff Against Merge Head" git-diff-file-merge-head t] - ["Diff Against Mine" git-diff-file-mine t] - ["Diff Against Other" git-diff-file-other t]) - "--------" - ["Add File" git-add-file t] - ["Revert File" git-revert-file t] - ["Ignore File" git-ignore-file t] - ["Remove File" git-remove-file t] - "--------" - ["Find File" git-find-file t] - ["View File" git-view-file t] - ["Diff File" git-diff-file t] - ["Interactive Diff File" git-diff-file-idiff t] - ["Log" git-log-file t] - "--------" - ["Mark" git-mark-file t] - ["Mark All" git-mark-all t] - ["Unmark" git-unmark-file t] - ["Unmark All" git-unmark-all t] - ["Toggle All Marks" git-toggle-all-marks t] - ["Hide Handled Files" git-remove-handled t] - "--------" - ["Show Uptodate Files" git-toggle-show-uptodate :style toggle :selected git-show-uptodate] - ["Show Ignored Files" git-toggle-show-ignored :style toggle :selected git-show-ignored] - ["Show Unknown Files" git-toggle-show-unknown :style toggle :selected git-show-unknown] - "--------" - ["Quit" git-status-quit t]))) - - -;; git mode should only run in the *git status* buffer -(put 'git-status-mode 'mode-class 'special) - -(defun git-status-mode () - "Major mode for interacting with Git. -Commands: -\\{git-status-mode-map}" - (kill-all-local-variables) - (buffer-disable-undo) - (setq mode-name "git status" - major-mode 'git-status-mode - goal-column 17 - buffer-read-only t) - (use-local-map git-status-mode-map) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((status (ewoc-create 'git-fileinfo-prettyprint "" ""))) - (set (make-local-variable 'git-status) status)) - (set (make-local-variable 'list-buffers-directory) default-directory) - (make-local-variable 'git-show-uptodate) - (make-local-variable 'git-show-ignored) - (make-local-variable 'git-show-unknown) - (run-hooks 'git-status-mode-hook))) - -(defun git-find-status-buffer (dir) - "Find the git status buffer handling a specified directory." - (let ((list (buffer-list)) - (fulldir (expand-file-name dir)) - found) - (while (and list (not found)) - (let ((buffer (car list))) - (with-current-buffer buffer - (when (and list-buffers-directory - (string-equal fulldir (expand-file-name list-buffers-directory)) - (eq major-mode 'git-status-mode)) - (setq found buffer)))) - (setq list (cdr list))) - found)) - -(defun git-status (dir) - "Entry point into git-status mode." - (interactive "DSelect directory: ") - (setq dir (git-get-top-dir dir)) - (if (file-directory-p (concat (file-name-as-directory dir) ".git")) - (let ((buffer (or (and git-reuse-status-buffer (git-find-status-buffer dir)) - (create-file-buffer (expand-file-name "*git-status*" dir))))) - (switch-to-buffer buffer) - (cd dir) - (git-status-mode) - (git-refresh-status) - (goto-char (point-min)) - (add-hook 'after-save-hook 'git-update-saved-file)) - (message "%s is not a git working tree." dir))) - -(defun git-update-saved-file () - "Update the corresponding git-status buffer when a file is saved. -Meant to be used in `after-save-hook'." - (let* ((file (expand-file-name buffer-file-name)) - (dir (condition-case nil (git-get-top-dir (file-name-directory file)) (error nil))) - (buffer (and dir (git-find-status-buffer dir)))) - (when buffer - (with-current-buffer buffer - (let ((filename (file-relative-name file dir))) - ; skip files located inside the .git directory - (unless (string-match "^\\.git/" filename) - (git-call-process-env nil nil "add" "--refresh" "--" filename) - (git-update-status-files (list filename) 'uptodate))))))) - -(defun git-help () - "Display help for Git mode." - (interactive) - (describe-function 'git-status-mode)) - -(provide 'git) -;;; git.el ends here diff --git a/emacs/external/git-contrib-emacs/vc-git.el b/emacs/external/git-contrib-emacs/vc-git.el deleted file mode 100644 index b8f6be5..0000000 --- a/emacs/external/git-contrib-emacs/vc-git.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; vc-git.el --- VC backend for the git version control system - -;; Copyright (C) 2006 Alexandre Julliard - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be -;; useful, but WITHOUT ANY WARRANTY; without even the implied -;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -;; PURPOSE. See the GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public -;; License along with this program; if not, write to the Free -;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, -;; MA 02111-1307 USA - -;;; Commentary: - -;; This file contains a VC backend for the git version control -;; system. -;; -;; To install: put this file on the load-path and add GIT to the list -;; of supported backends in `vc-handled-backends'; the following line, -;; placed in your ~/.emacs, will accomplish this: -;; -;; (add-to-list 'vc-handled-backends 'GIT) -;; -;; TODO -;; - changelog generation -;; - working with revisions other than HEAD -;; - -(eval-when-compile (require 'cl)) - -(defvar git-commits-coding-system 'utf-8 - "Default coding system for git commits.") - -(defun vc-git--run-command-string (file &rest args) - "Run a git command on FILE and return its output as string." - (let* ((ok t) - (str (with-output-to-string - (with-current-buffer standard-output - (unless (eq 0 (apply #'call-process "git" nil '(t nil) nil - (append args (list (file-relative-name file))))) - (setq ok nil)))))) - (and ok str))) - -(defun vc-git--run-command (file &rest args) - "Run a git command on FILE, discarding any output." - (let ((name (file-relative-name file))) - (eq 0 (apply #'call-process "git" nil (get-buffer "*Messages") nil (append args (list name)))))) - -(defun vc-git-registered (file) - "Check whether FILE is registered with git." - (with-temp-buffer - (let* ((dir (file-name-directory file)) - (name (file-relative-name file dir))) - (and (ignore-errors - (when dir (cd dir)) - (eq 0 (call-process "git" nil '(t nil) nil "ls-files" "-c" "-z" "--" name))) - (let ((str (buffer-string))) - (and (> (length str) (length name)) - (string= (substring str 0 (1+ (length name))) (concat name "\0")))))))) - -(defun vc-git-state (file) - "git-specific version of `vc-state'." - (let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--"))) - (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} [ADMU]\0[^\0]+\0" diff)) - 'edited - 'up-to-date))) - -(defun vc-git-workfile-version (file) - "git-specific version of `vc-workfile-version'." - (let ((str (with-output-to-string - (with-current-buffer standard-output - (call-process "git" nil '(t nil) nil "symbolic-ref" "HEAD"))))) - (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) - (match-string 2 str) - str))) - -(defun vc-git-symbolic-commit (commit) - "Translate COMMIT string into symbolic form. -Returns nil if not possible." - (and commit - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "name-rev" - "--name-only" "--tags" - commit)) - (goto-char (point-min)) - (= (forward-line 2) 1) - (bolp) - (buffer-substring-no-properties (point-min) (1- (point-max))))))) - -(defun vc-git-previous-version (file rev) - "git-specific version of `vc-previous-version'." - (let ((default-directory (file-name-directory (expand-file-name file))) - (file (file-name-nondirectory file))) - (vc-git-symbolic-commit - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "rev-list" - "-2" rev "--" file)) - (goto-char (point-max)) - (bolp) - (zerop (forward-line -1)) - (not (bobp)) - (buffer-substring-no-properties - (point) - (1- (point-max)))))))) - -(defun vc-git-next-version (file rev) - "git-specific version of `vc-next-version'." - (let* ((default-directory (file-name-directory - (expand-file-name file))) - (file (file-name-nondirectory file)) - (current-rev - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "rev-list" - "-1" rev "--" file)) - (goto-char (point-max)) - (bolp) - (zerop (forward-line -1)) - (bobp) - (buffer-substring-no-properties - (point) - (1- (point-max))))))) - (and current-rev - (vc-git-symbolic-commit - (with-temp-buffer - (and - (zerop - (call-process "git" nil '(t nil) nil "rev-list" - "HEAD" "--" file)) - (goto-char (point-min)) - (search-forward current-rev nil t) - (zerop (forward-line -1)) - (buffer-substring-no-properties - (point) - (progn (forward-line 1) (1- (point)))))))))) - -(defun vc-git-revert (file &optional contents-done) - "Revert FILE to the version stored in the git repository." - (if contents-done - (vc-git--run-command file "update-index" "--") - (vc-git--run-command file "checkout" "HEAD"))) - -(defun vc-git-checkout-model (file) - 'implicit) - -(defun vc-git-workfile-unchanged-p (file) - (let ((sha1 (vc-git--run-command-string file "hash-object" "--")) - (head (vc-git--run-command-string file "ls-tree" "-z" "HEAD" "--"))) - (and head - (string-match "[0-7]\\{6\\} blob \\([0-9a-f]\\{40\\}\\)\t[^\0]+\0" head) - (string= (car (split-string sha1 "\n")) (match-string 1 head))))) - -(defun vc-git-register (file &optional rev comment) - "Register FILE into the git version-control system." - (vc-git--run-command file "update-index" "--add" "--")) - -(defun vc-git-print-log (file &optional buffer) - (let ((name (file-relative-name file)) - (coding-system-for-read git-commits-coding-system)) - (vc-do-command buffer 'async "git" name "rev-list" "--pretty" "HEAD" "--"))) - -(defun vc-git-diff (file &optional rev1 rev2 buffer) - (let ((name (file-relative-name file)) - (buf (or buffer "*vc-diff*"))) - (if (and rev1 rev2) - (vc-do-command buf 0 "git" name "diff-tree" "-p" rev1 rev2 "--") - (vc-do-command buf 0 "git" name "diff-index" "-p" (or rev1 "HEAD") "--")) - ; git-diff-index doesn't set exit status like diff does - (if (vc-git-workfile-unchanged-p file) 0 1))) - -(defun vc-git-checkin (file rev comment) - (let ((coding-system-for-write git-commits-coding-system)) - (vc-git--run-command file "commit" "-m" comment "--only" "--"))) - -(defun vc-git-checkout (file &optional editable rev destfile) - (if destfile - (let ((fullname (substring - (vc-git--run-command-string file "ls-files" "-z" "--full-name" "--") - 0 -1)) - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion)) - (with-temp-file destfile - (eq 0 (call-process "git" nil t nil "cat-file" "blob" - (concat (or rev "HEAD") ":" fullname))))) - (vc-git--run-command file "checkout" (or rev "HEAD")))) - -(defun vc-git-annotate-command (file buf &optional rev) - ; FIXME: rev is ignored - (let ((name (file-relative-name file))) - (call-process "git" nil buf nil "blame" name))) - -(defun vc-git-annotate-time () - (and (re-search-forward "[0-9a-f]+ (.* \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\) +[0-9]+)" nil t) - (vc-annotate-convert-time - (apply #'encode-time (mapcar (lambda (match) (string-to-number (match-string match))) '(6 5 4 3 2 1 7)))))) - -;; Not really useful since we can't do anything with the revision yet -;;(defun vc-annotate-extract-revision-at-line () -;; (save-excursion -;; (move-beginning-of-line 1) -;; (and (looking-at "[0-9a-f]+") -;; (buffer-substring (match-beginning 0) (match-end 0))))) - -(provide 'vc-git) diff --git a/emacs/external/javascript.el b/emacs/external/javascript.el deleted file mode 100644 index a99b3e9..0000000 --- a/emacs/external/javascript.el +++ /dev/null @@ -1,700 +0,0 @@ -;;; javascript.el --- Major mode for editing JavaScript source text - -;; Copyright (C) 2006 Karl Landström - -;; Author: Karl Landström -;; Maintainer: Karl Landström -;; Version: 2.0 Beta 8 -;; Date: 2006-12-26 -;; Keywords: languages, oop - -;; 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 main features of this JavaScript mode are syntactic -;; highlighting (enabled with `font-lock-mode' or -;; `global-font-lock-mode'), automatic indentation and filling of -;; comments. -;; -;; This package has (only) been tested with GNU Emacs 21.4 (the latest -;; stable release). -;; -;; Installation: -;; -;; Put this file in a directory where Emacs can find it (`C-h v -;; load-path' for more info). Then add the following lines to your -;; Emacs initialization file: -;; -;; (add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode)) -;; (autoload 'javascript-mode "javascript" nil t) -;; -;; General Remarks: -;; -;; This mode assumes that block comments are not nested inside block -;; comments and that strings do not contain line breaks. -;; -;; Exported names start with "javascript-" whereas private names start -;; with "js-". -;; -;; Changes: -;; -;; See javascript.el.changelog. - -;;; Code: - -(require 'cc-mode) -(require 'font-lock) -(require 'newcomment) - -(defgroup javascript nil - "Customization variables for `javascript-mode'." - :tag "JavaScript" - :group 'languages) - -(defcustom javascript-indent-level 4 - "Number of spaces for each indentation step." - :type 'integer - :group 'javascript) - -(defcustom javascript-auto-indent-flag t - "Automatic indentation with punctuation characters. If non-nil, the -current line is indented when certain punctuations are inserted." - :type 'boolean - :group 'javascript) - - -;; --- Keymap --- - -(defvar javascript-mode-map nil - "Keymap used in JavaScript mode.") - -(unless javascript-mode-map - (setq javascript-mode-map (make-sparse-keymap))) - -(when javascript-auto-indent-flag - (mapc (lambda (key) - (define-key javascript-mode-map key 'javascript-insert-and-indent)) - '("{" "}" "(" ")" ":" ";" ","))) - -(defun javascript-insert-and-indent (key) - "Run command bound to key and indent current line. Runs the command -bound to KEY in the global keymap and indents the current line." - (interactive (list (this-command-keys))) - (call-interactively (lookup-key (current-global-map) key)) - (indent-according-to-mode)) - - -;; --- Syntax Table And Parsing --- - -(defvar javascript-mode-syntax-table - (let ((table (make-syntax-table))) - (c-populate-syntax-table table) - - ;; The syntax class of underscore should really be `symbol' ("_") - ;; but that makes matching of tokens much more complex as e.g. - ;; "\\" matches part of e.g. "_xyz" and "xyz_abc". Defines - ;; it as word constituent for now. - (modify-syntax-entry ?_ "w" table) - - table) - "Syntax table used in JavaScript mode.") - - -(defun js-re-search-forward-inner (regexp &optional bound count) - "Auxiliary function for `js-re-search-forward'." - (let ((parse) - (saved-point (point-min))) - (while (> count 0) - (re-search-forward regexp bound) - (setq parse (parse-partial-sexp saved-point (point))) - (cond ((nth 3 parse) - (re-search-forward - (concat "\\([^\\]\\|^\\)" (string (nth 3 parse))) - (save-excursion (end-of-line) (point)) t)) - ((nth 7 parse) - (forward-line)) - ((or (nth 4 parse) - (and (eq (char-before) ?\/) (eq (char-after) ?\*))) - (re-search-forward "\\*/")) - (t - (setq count (1- count)))) - (setq saved-point (point)))) - (point)) - - -(defun js-re-search-forward (regexp &optional bound noerror count) - "Search forward but ignore strings and comments. Invokes -`re-search-forward' but treats the buffer as if strings and -comments have been removed." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js-re-search-forward-inner regexp bound 1)) - ((< count 0) - '(js-re-search-backward-inner regexp bound (- count))) - ((> count 0) - '(js-re-search-forward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) - - -(defun js-re-search-backward-inner (regexp &optional bound count) - "Auxiliary function for `js-re-search-backward'." - (let ((parse) - (saved-point (point-min))) - (while (> count 0) - (re-search-backward regexp bound) - (when (and (> (point) (point-min)) - (save-excursion (backward-char) (looking-at "/[/*]"))) - (forward-char)) - (setq parse (parse-partial-sexp saved-point (point))) - (cond ((nth 3 parse) - (re-search-backward - (concat "\\([^\\]\\|^\\)" (string (nth 3 parse))) - (save-excursion (beginning-of-line) (point)) t)) - ((nth 7 parse) - (goto-char (nth 8 parse))) - ((or (nth 4 parse) - (and (eq (char-before) ?/) (eq (char-after) ?*))) - (re-search-backward "/\\*")) - (t - (setq count (1- count)))))) - (point)) - - -(defun js-re-search-backward (regexp &optional bound noerror count) - "Search backward but ignore strings and comments. Invokes -`re-search-backward' but treats the buffer as if strings and -comments have been removed." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js-re-search-backward-inner regexp bound 1)) - ((< count 0) - '(js-re-search-forward-inner regexp bound (- count))) - ((> count 0) - '(js-re-search-backward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) - - -(defun js-continued-var-decl-list-p () - "Return non-nil if point is inside a continued variable declaration -list." - (interactive) - (let ((start (save-excursion (js-re-search-backward "\\" nil t)))) - (and start - (save-excursion (re-search-backward "\n" start t)) - (not (save-excursion - (js-re-search-backward - ";\\|[^, \t][ \t]*\\(/[/*]\\|$\\)" start t)))))) - - -;; --- Font Lock --- - -(defun js-inside-param-list-p () - "Return non-nil if point is inside a function parameter list." - (condition-case err - (save-excursion - (up-list -1) - (and (looking-at "(") - (progn (backward-word 1) - (or (looking-at "function") - (progn (backward-word 1) (looking-at "function")))))) - (error nil))) - - -(defconst js-function-heading-1-re - "^[ \t]*function[ \t]+\\(\\w+\\)" - "Regular expression matching the start of a function header.") - -(defconst js-function-heading-2-re - "^[ \t]*\\(\\w+\\)[ \t]*:[ \t]*function\\>" - "Regular expression matching the start of a function entry in - an associative array.") - -(defconst js-keyword-re - (regexp-opt '("abstract" "break" "case" "catch" "class" "const" - "continue" "debugger" "default" "delete" "do" "else" - "enum" "export" "extends" "final" "finally" "for" - "function" "goto" "if" "implements" "import" "in" - "instanceof" "interface" "native" "new" "package" - "private" "protected" "public" "return" "static" - "super" "switch" "synchronized" "this" "throw" - "throws" "transient" "try" "typeof" "var" "void" - "volatile" "while" "with") 'words) - "Regular expression matching any JavaScript keyword.") - -(defconst js-basic-type-re - (regexp-opt '("boolean" "byte" "char" "double" "float" "int" "long" - "short" "void") 'words) - "Regular expression matching any predefined type in JavaScript.") - -(defconst js-constant-re - (regexp-opt '("false" "null" "true") 'words) - "Regular expression matching any future reserved words in JavaScript.") - - -(defconst js-font-lock-keywords-1 - (list - "\\" - (list js-function-heading-1-re 1 font-lock-function-name-face) - (list js-function-heading-2-re 1 font-lock-function-name-face) - (list "[=(][ \t]*\\(/.*?[^\\]/\\w*\\)" 1 font-lock-string-face)) - "Level one font lock.") - -(defconst js-font-lock-keywords-2 - (append js-font-lock-keywords-1 - (list (list js-keyword-re 1 font-lock-keyword-face) - (cons js-basic-type-re font-lock-type-face) - (cons js-constant-re font-lock-constant-face))) - "Level two font lock.") - - -;; Limitations with variable declarations: There seems to be no -;; sensible way to highlight variables occuring after an initialized -;; variable in a variable list. For instance, in -;; -;; var x, y = f(a, b), z -;; -;; z will not be highlighted. - -(defconst js-font-lock-keywords-3 - (append - js-font-lock-keywords-2 - (list - - ;; variable declarations - (list - (concat "\\<\\(const\\|var\\)\\>\\|" js-basic-type-re) - (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)" - nil - nil - '(1 font-lock-variable-name-face))) - - ;; continued variable declaration list - (list - (concat "^[ \t]*\\w+[ \t]*\\([,;=]\\|/[/*]\\|$\\)") - (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)" - '(if (save-excursion (backward-char) (js-continued-var-decl-list-p)) - (backward-word 1) - (end-of-line)) - '(end-of-line) - '(1 font-lock-variable-name-face))) - - ;; formal parameters - (list - (concat "\\\\([ \t]+\\w+\\)?[ \t]*([ \t]*\\w") - (list "\\(\\w+\\)\\([ \t]*).*\\)?" - '(backward-char) - '(end-of-line) - '(1 font-lock-variable-name-face))) - - ;; continued formal parameter list - (list - (concat "^[ \t]*\\w+[ \t]*[,)]") - (list "\\w+" - '(if (save-excursion (backward-char) (js-inside-param-list-p)) - (backward-word 1) - (end-of-line)) - '(end-of-line) - '(0 font-lock-variable-name-face))))) - "Level three font lock.") - -(defconst js-font-lock-keywords - '(js-font-lock-keywords-3 js-font-lock-keywords-1 js-font-lock-keywords-2 - js-font-lock-keywords-3) - "See `font-lock-keywords'.") - - -;; --- Indentation --- - -(defconst js-possibly-braceless-keyword-re - (regexp-opt - '("catch" "do" "else" "finally" "for" "if" "try" "while" "with") - 'words) - "Regular expression matching keywords that are optionally - followed by an opening brace.") - -(defconst js-indent-operator-re - (concat "[-+*/%<>=&^|?:]\\([^-+*/]\\|$\\)\\|" - (regexp-opt '("in" "instanceof") 'words)) - "Regular expression matching operators that affect indentation - of continued expressions.") - - -(defun js-looking-at-operator-p () - "Return non-nil if text after point is an operator (that is not -a comma)." - (save-match-data - (and (looking-at js-indent-operator-re) - (or (not (looking-at ":")) - (save-excursion - (and (js-re-search-backward "[?:{]\\|\\" nil t) - (looking-at "?"))))))) - - -(defun js-continued-expression-p () - "Returns non-nil if the current line continues an expression." - (save-excursion - (back-to-indentation) - (or (js-looking-at-operator-p) - (and (js-re-search-backward "\n" nil t) - (progn - (skip-chars-backward " \t") - (backward-char) - (and (> (point) (point-min)) - (save-excursion (backward-char) (not (looking-at "[/*]/"))) - (js-looking-at-operator-p) - (and (progn (backward-char) - (not (looking-at "++\\|--\\|/[/*]")))))))))) - - -(defun js-end-of-do-while-loop-p () - "Returns non-nil if word after point is `while' of a do-while -statement, else returns nil. A braceless do-while statement -spanning several lines requires that the start of the loop is -indented to the same column as the current line." - (interactive) - (save-excursion - (save-match-data - (when (looking-at "\\s-*\\") - (if (save-excursion - (skip-chars-backward "[ \t\n]*}") - (looking-at "[ \t\n]*}")) - (save-excursion - (backward-list) (backward-word 1) (looking-at "\\")) - (js-re-search-backward "\\" (point-at-bol) t) - (or (looking-at "\\") - (let ((saved-indent (current-indentation))) - (while (and (js-re-search-backward "^[ \t]*\\<" nil t) - (/= (current-indentation) saved-indent))) - (and (looking-at "[ \t]*\\") - (not (js-re-search-forward - "\\" (point-at-eol) t)) - (= (current-indentation) saved-indent))))))))) - - -(defun js-ctrl-statement-indentation () - "Returns the proper indentation of the current line if it -starts the body of a control statement without braces, else -returns nil." - (save-excursion - (back-to-indentation) - (when (save-excursion - (and (not (looking-at "[{]")) - (progn - (js-re-search-backward "[[:graph:]]" nil t) - (forward-char) - (when (= (char-before) ?\)) (backward-list)) - (skip-syntax-backward " ") - (skip-syntax-backward "w") - (looking-at js-possibly-braceless-keyword-re)) - (not (js-end-of-do-while-loop-p)))) - (save-excursion - (goto-char (match-beginning 0)) - (+ (current-indentation) javascript-indent-level))))) - - -(defun js-proper-indentation (parse-status) - "Return the proper indentation for the current line." - (save-excursion - (back-to-indentation) - (let ((ctrl-stmt-indent (js-ctrl-statement-indentation)) - (same-indent-p (looking-at "[]})]\\|\\\\|\\")) - (continued-expr-p (js-continued-expression-p))) - (cond (ctrl-stmt-indent) - ((js-continued-var-decl-list-p) - (js-re-search-backward "\\" nil t) - (+ (current-indentation) javascript-indent-level)) - ((nth 1 parse-status) - (goto-char (nth 1 parse-status)) - (if (looking-at "[({[][ \t]*\\(/[/*]\\|$\\)") - (progn - (skip-syntax-backward " ") - (when (= (char-before) ?\)) (backward-list)) - (back-to-indentation) - (cond (same-indent-p - (current-column)) - (continued-expr-p - (+ (current-column) (* 2 javascript-indent-level))) - (t - (+ (current-column) javascript-indent-level)))) - (unless same-indent-p - (forward-char) - (skip-chars-forward " \t")) - (current-column))) - (continued-expr-p javascript-indent-level) - (t 0))))) - - -(defun javascript-indent-line () - "Indent the current line as JavaScript source text." - (interactive) - (let ((parse-status - (save-excursion (parse-partial-sexp (point-min) (point-at-bol)))) - (offset (- (current-column) (current-indentation)))) - (when (not (nth 8 parse-status)) - (indent-line-to (js-proper-indentation parse-status)) - (when (> offset 0) (forward-char offset))))) - - -;; --- Filling --- - -;; FIXME: It should be possible to use the more sofisticated function -;; `c-fill-paragraph' in `cc-cmds.el' instead. However, just setting -;; `fill-paragraph-function' to `c-fill-paragraph' does not work; -;; inside `c-fill-paragraph', `fill-paragraph-function' evaluates to -;; nil!? - -(defun js-backward-paragraph () - "Move backward to start of paragraph. Postcondition: Point is at -beginning of buffer or the previous line contains only whitespace." - (forward-line -1) - (while (not (or (bobp) (looking-at "^[ \t]*$"))) - (forward-line -1)) - (when (not (bobp)) (forward-line 1))) - - -(defun js-forward-paragraph () - "Move forward to end of paragraph. Postcondition: Point is at -end of buffer or the next line contains only whitespace." - (forward-line 1) - (while (not (or (eobp) (looking-at "^[ \t]*$"))) - (forward-line 1)) - (when (not (eobp)) (backward-char 1))) - - -(defun js-fill-block-comment-paragraph (parse-status justify) - "Fill current paragraph as a block comment. PARSE-STATUS is the -result of `parse-partial-regexp' from beginning of buffer to -point. JUSTIFY has the same meaning as in `fill-paragraph'." - (let ((offset (save-excursion - (goto-char (nth 8 parse-status)) (current-indentation)))) - (save-excursion - (save-restriction - (narrow-to-region (save-excursion - (goto-char (nth 8 parse-status)) (point-at-bol)) - (save-excursion - (goto-char (nth 8 parse-status)) - (re-search-forward "*/"))) - (narrow-to-region (save-excursion - (js-backward-paragraph) - (when (looking-at "^[ \t]*$") (forward-line 1)) - (point)) - (save-excursion - (js-forward-paragraph) - (when (looking-at "^[ \t]*$") (backward-char)) - (point))) - (goto-char (point-min)) - (while (not (eobp)) - (delete-horizontal-space) - (forward-line 1)) - (let ((fill-column (- fill-column offset)) - (fill-paragraph-function nil)) - (fill-paragraph justify)) - - ;; In Emacs 21.4 as opposed to CVS Emacs 22, - ;; `fill-paragraph' seems toadd a newline at the end of the - ;; paragraph. Remove it! - (goto-char (point-max)) - (when (looking-at "^$") (backward-delete-char 1)) - - (goto-char (point-min)) - (while (not (eobp)) - (indent-to offset) - (forward-line 1)))))) - - -(defun js-sline-comment-par-start () - "Return point at the beginning of the line where the current -single-line comment paragraph starts." - (save-excursion - (beginning-of-line) - (while (and (not (bobp)) - (looking-at "^[ \t]*//[ \t]*[[:graph:]]")) - (forward-line -1)) - (unless (bobp) (forward-line 1)) - (point))) - - -(defun js-sline-comment-par-end () - "Return point at end of current single-line comment paragraph." - (save-excursion - (beginning-of-line) - (while (and (not (eobp)) - (looking-at "^[ \t]*//[ \t]*[[:graph:]]")) - (forward-line 1)) - (unless (bobp) (backward-char)) - (point))) - - -(defun js-sline-comment-offset (line) - "Return the column at the start of the current single-line -comment paragraph." - (save-excursion - (goto-line line) - (re-search-forward "//" (point-at-eol)) - (goto-char (match-beginning 0)) - (current-column))) - - -(defun js-sline-comment-text-offset (line) - "Return the column at the start of the text of the current -single-line comment paragraph." - (save-excursion - (goto-line line) - (re-search-forward "//[ \t]*" (point-at-eol)) - (current-column))) - - -(defun js-at-empty-sline-comment-p () - "Return non-nil if inside an empty single-line comment." - (and (save-excursion - (beginning-of-line) - (not (looking-at "^.*//.*[[:graph:]]"))) - (save-excursion - (re-search-backward "//" (point-at-bol) t)))) - - -(defun js-fill-sline-comments (parse-status justify) - "Fill current paragraph as a sequence of single-line comments. -PARSE-STATUS is the result of `parse-partial-regexp' from -beginning of buffer to point. JUSTIFY has the same meaning as in -`fill-paragraph'." - (when (not (js-at-empty-sline-comment-p)) - (let* ((start (js-sline-comment-par-start)) - (start-line (1+ (count-lines (point-min) start))) - (end (js-sline-comment-par-end)) - (offset (js-sline-comment-offset start-line)) - (text-offset (js-sline-comment-text-offset start-line))) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*//[ \t]*" nil t) - (replace-match "") - (forward-line 1)) - (let ((fill-paragraph-function nil) - (fill-column (- fill-column text-offset))) - (fill-paragraph justify)) - - ;; In Emacs 21.4 as opposed to CVS Emacs 22, - ;; `fill-paragraph' seems toadd a newline at the end of the - ;; paragraph. Remove it! - (goto-char (point-max)) - (when (looking-at "^$") (backward-delete-char 1)) - - (goto-char (point-min)) - (while (not (eobp)) - (indent-to offset) - (insert "//") - (indent-to text-offset) - (forward-line 1))))))) - - -(defun js-trailing-comment-p (parse-status) - "Return non-nil if inside a trailing comment. PARSE-STATUS is -the result of `parse-partial-regexp' from beginning of buffer to -point." - (save-excursion - (when (nth 4 parse-status) - (goto-char (nth 8 parse-status)) - (skip-chars-backward " \t") - (not (bolp))))) - - -(defun js-block-comment-p (parse-status) - "Return non-nil if inside a block comment. PARSE-STATUS is the -result of `parse-partial-regexp' from beginning of buffer to -point." - (save-excursion - (save-match-data - (when (nth 4 parse-status) - (goto-char (nth 8 parse-status)) - (looking-at "/\\*"))))) - - -(defun javascript-fill-paragraph (&optional justify) - "If inside a comment, fill the current comment paragraph. -Trailing comments are ignored." - (interactive) - (let ((parse-status (parse-partial-sexp (point-min) (point)))) - (when (and (nth 4 parse-status) - (not (js-trailing-comment-p parse-status))) - (if (js-block-comment-p parse-status) - (js-fill-block-comment-paragraph parse-status justify) - (js-fill-sline-comments parse-status justify)))) - t) - - -;; --- Imenu --- - -(defconst js-imenu-generic-expression - (list - (list - nil - "function\\s-+\\(\\w+\\)\\s-*(" - 1)) - "Regular expression matching top level procedures. Used by imenu.") - - -;; --- Main Function --- - -;;;###autoload -(defun javascript-mode () - "Major mode for editing JavaScript source text. - -Key bindings: - -\\{javascript-mode-map}" - (interactive) - (kill-all-local-variables) - - (use-local-map javascript-mode-map) - (set-syntax-table javascript-mode-syntax-table) - (set (make-local-variable 'indent-line-function) 'javascript-indent-line) - (set (make-local-variable 'font-lock-defaults) (list js-font-lock-keywords)) - - (set (make-local-variable 'parse-sexp-ignore-comments) t) - - ;; Comments - (setq comment-start "// ") - (setq comment-end "") - (set (make-local-variable 'fill-paragraph-function) - 'javascript-fill-paragraph) - - ;; Imenu - (setq imenu-case-fold-search nil) - (set (make-local-variable 'imenu-generic-expression) - js-imenu-generic-expression) - - (setq major-mode 'javascript-mode) - (setq mode-name "JavaScript") - (run-hooks 'javascript-mode-hook)) - - -(provide 'javascript-mode) -;;; javascript.el ends here diff --git a/emacs/external/ljupdate/COPYING b/emacs/external/ljupdate/COPYING deleted file mode 100644 index 6ddaa3f..0000000 --- a/emacs/external/ljupdate/COPYING +++ /dev/null @@ -1,341 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA - 02110-1301, USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - Appendix: How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) 19yy - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA, - 02110-1301, USA - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19yy name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/emacs/external/ljupdate/Makefile b/emacs/external/ljupdate/Makefile deleted file mode 100644 index 19cd297..0000000 --- a/emacs/external/ljupdate/Makefile +++ /dev/null @@ -1,70 +0,0 @@ -### Makefile --- byte-compile ljupdate and its dependencies - -## Configuration - -# choose one: -EMACS=emacs -q --no-site-file -# or -#EMACS=xemacs -vanilla - -## Building - -SOURCE=lj-acct.el lj-compat.el lj-compose.el lj-custom.el lj-edit.el \ - lj-fill.el lj-login.el lj-pcomplete.el lj-protocol.el lj-util.el -TARGET=$(patsubst %.el,%.elc, $(SOURCE) ljupdate.el) -TARBALL=ljupdate.tar.gz - -compile: $(TARGET) - -ljupdate.el: ljupdate.in $(SOURCE) - rm -f ljupdate.elc - cat ljupdate.in | sed -e "s/##revision##/`svnversion .`/" > ljupdate.el - @$(EMACS) -batch -l lj-maint.el -f lj-generate-autoloads ljupdate.el . - -## Distribution - -DISTFILES=$(patsubst %,ljupdate/%,$(SOURCE) lj-maint.el ljupdate.in \ - ljupdate.el README COPYING Makefile) - -dist: $(TARBALL) - -$(TARBALL): $(SOURCE) lj-maint.el ljupdate.in ljupdate.el README \ - COPYING Makefile - tar czvf $(TARBALL) -C .. $(DISTFILES) - -pub: $(TARBALL) - darcs push -va - scp $(TARBALL) rakim:/web/edward.oconnor.cx/html/code/ljupdate - -## Support for downloading required libraries - -THIRD_PARTY=http-cookies.el http-get.el http-post.el -fetch: $(THIRD_PARTY) - -SAVANNAH_VIEWCVS=http://cvs.savannah.gnu.org/viewvc -HTTP_EMACS_SITE=$(SAVANNAH_VIEWCVS)/*checkout*/http-emacs/http-emacs - -$(THIRD_PARTY): - wget $(HTTP_EMACS_SITE)/$*.el - -## Cleaning - -pretty: - @rm -f *~ - -clean: - @rm -f $(TARGET) - -distclean: clean - @rm -f $(THIRD_PARTY) ljupdate.el $(TARBALL) - -## Workhorse - -.el.elc: - @$(EMACS) -batch -l lj-maint.el -f batch-byte-compile $*.el \ - || (echo "Perhaps you should specifcy LOAD_PATH to make?" \ - "(e.g. \"gmake LOAD_PATH=~/elisp\".)" \ - && echo "Please see README for compilation instructions." \ - && exit 1) - -### Makefile ends here diff --git a/emacs/external/ljupdate/README b/emacs/external/ljupdate/README deleted file mode 100644 index 0567818..0000000 --- a/emacs/external/ljupdate/README +++ /dev/null @@ -1,74 +0,0 @@ -Using ljupdate -*- outline -*- - -* Dependencies - -** GNU Emacs - -I haven't yet done the work necessary to make ljupdate work on XEmacs. - -** http-cookies.el, http-get.el, http-post.el - -If you don't already have these libraries, you'll need to download them -from Savannah CVS. If you have wget(1) and make(1) on your machine, a -simple 'make fetch' in this directory will grab the latest versions for -you. If not, you can find them at this URL: - - http://savannah.nongnu.org/cgi-bin/viewcvs/http-emacs/http-emacs/ - -Drop these files into a directory in your `load-path'. For instance, you -could drop these files into an `elisp' directory in your home directory. -You would add this directory to your `load-path' by adding something -like the following to your ~/.emacs file: - - (add-to-list 'load-path "~/elisp") - -* Compilation - -You don't have to compile ljupdate, but if you'd like to, running `make' -in this directory should be sufficient. If the http-FOO.el libraries are -in some other directory, invoking make with LOAD_PATH=/path/to/that/dir -will point Emacs at them when compiling. - -** Subversion users - -N.B., if you've checked ljupdate out from Subversion, running `make' -isn't optional. - -* Usage - -Add this `ljupdate' directory to your `load-path'. If you put the -`ljupdate' directory under ~/elisp, you would do so like this: - - (add-to-list 'load-path "~/elisp/ljupdate") - -Tell Emacs that you want to use ljupdate, by adding something like -this to your ~/.emacs: - - (require 'ljupdate) - -That's it! - -Customize the group `ljupdate' to configure ljupdate to your liking. - - M-x customize-group RET ljupdate RET - -There are three commands that may interest you: - -** lj-login, lj-logout - -These do what you expect them to do. They will prompt you for a server -(typically www.livejournal.com) your username, and your password. - -** lj-compose - -Invoking this command is how you begin to compose a new LiveJournal -post with ljupdate. - -* Troubleshooting - -Please post any questions you may have to the ljupdate community on -LiveJournal, which you can find here: - - http://community.livejournal.com/ljupdate/ - -Share and Enjoy! diff --git a/emacs/external/ljupdate/http-cookies.el b/emacs/external/ljupdate/http-cookies.el deleted file mode 100644 index a369c17..0000000 --- a/emacs/external/ljupdate/http-cookies.el +++ /dev/null @@ -1,416 +0,0 @@ -;;; http-cookies.el --- simple HTTP cookies implementation - -;; Copyright (C) 2004, David Hansen - -;; Author: David Hansen -;; Maintainer: David Hansen -;; Version: 1.0.0 -;; Keywords: hypermedia - -;; This file is not part of GNU Emacs. - -;; This 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 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: - -;; Implementation of old netscape cookies (used by maybe all servers) and -;; version 1 cookies. -;; -;; See http://www.faqs.org/rfcs/rfc2109.html and -;; http://wp.netscape.com/newsref/std/cookie_spec.html - -;;; Change log: - -;;; TODO: - -;; - whitelist -;; - blacklist -;; - reading from file, saving to file -;; - expire - -;;; Code: - -(require 'time-date) - -(defconst http-cookies-version "1.0.0") - -(defgroup http-emacs () - "Simple HTTP client implementation in elisp.") - -(defcustom http-emacs-use-cookies nil - "Use cookies in the http-emacs package. *EXPERIMENTAL*" - :type 'boolean - :group 'http-emacs) - -(defcustom http-emacs-cookie-file "~/.emacs-cookies" - "*File where to store the cookies." - :type 'file - :group 'http-emacs) - -(defconst http-token-value-regexp - "^[ \t]*\\(.*?\\)[ \t]*=[ \t]*\"?\\(.*?\\)\"?[ \t]*;?[ \t]*$" - "Regexp to match a token=\"value\"; in a cookie.") - -(defvar http-cookies-accept-functions - '(http-cookie-check-path - http-cookie-check-domain - http-cookie-check-hostname) - "*List of functions used to determine if we accept a cookie or not. -If one of these function returns nil the cookie will be rejected. Each -function can access the free variables `cookie', `host' (from the url) -`path' (from the URL) and `url' to make its decision.") - -(defvar http-cookies-host-hash - (make-hash-table :test 'equal) - "Hash to look up cookies by host name.") - -(defvar http-cookies-domain-hash - (make-hash-table :test 'equal) - "Hash to look up cookies by domain.") - - - -;; functions for parsing the header - -(defun http-cookies-ns-to-rfc (line) - "Make the header value LINE a bit more RFC compatible. -Make old netscape cookies a bit more RFC 2109 compatible by quoting -the \"expires\" value. We need this to be able to properly split -the header value if there is more than one cookie." - (let ((start 0)) - (while (string-match "expires[ \t]*=[ \t]*\\([^\";]+?\\)\\(;\\|$\\)" - line start) - (setq start (match-end 0)) - (setq line (replace-match "\"\\1\"" t nil line 1))) - line)) - -(defun http-cookies-find-char-in-string (char string &optional start) - "Return the first position of CHAR in STRING. -If START is non-nil start at position START." - (unless start - (setq start 0)) - (let ((i start) (len (length string)) pos) - (while (and (not pos) (< i len)) - (when (= (aref string i) char) - (setq pos i)) - (setq i (1+ i))) - pos)) - -(defun http-cookies-find-quoted-strings (header-value) - "Return list of positions of quoted strings in HEADER_VALUE. -Return a list of pairs with the beginning and end of quoted strings -in a \"Set-cookie: \" header value." - (let ((start 0) qstring-pos) - (while (string-match "=[ \t]*\\(\".*?[^\\]\"\\)" header-value start) - (add-to-list 'qstring-pos (cons (match-beginning 1) (1- (match-end 1)))) - (setq start (match-end 1))) - qstring-pos)) - -(defun http-cookies-split-string (header-value sep-char) - "Split the HEADER-VALUE at the character SEP-CHAR. -Ignores SEP-CHAR if it is in a quoted string. Return a list of the -substrings." - (let ((qstrings (http-cookies-find-quoted-strings header-value)) - (start 0) (beg 0) pos in-qstring strings) - (while (setq pos (http-cookies-find-char-in-string - sep-char header-value start)) - (unless (= pos start) ; ignore empty strings - ;; check if pos is in a quoted string - (dolist (qstring-pos qstrings) - (unless in-qstring - (when (and (> pos (car qstring-pos)) (< pos (cdr qstring-pos))) - (setq in-qstring t)))) - (if in-qstring - (setq in-qstring nil) - (add-to-list 'strings (substring header-value beg pos)) - (setq beg (1+ pos)))) - (setq start (1+ pos))) - ;; add the last token - (add-to-list 'strings (substring header-value beg)) - strings)) - -(defun http-cookies-parse-cookie (string) - "Parse one cookie. -Return an alist ((NAME . VALUE) (attr1 . value1) (attr2 . value2) ...) -or nil on error." - (let (attrs error) - (dolist (attr (http-cookies-split-string string ?\;)) - (if (string-match http-token-value-regexp attr) - (add-to-list 'attrs (cons (match-string 1 attr) - (match-string 2 attr))) - ;; match the secure attribute - (if (string-match "[ \t]*\\([a-zA-Z]+\\)[ \t]*" attr) - (add-to-list 'attrs (cons (match-string 1 attr) t)) - (setq error t) - (message "Cannot parse cookie %s" string)))) - (unless error - attrs))) - -(defun http-cookies-set (url headers) - "Set the cookies from the response to a request of URL. -Set HEADERS to the headers of the response." - (let ((host (http-cookies-url-host url)) (path (http-cookies-url-path url)) - header-value cookie) - ;; The server may send several "Set-Cookie:" headers. - (dolist (line headers) - (when (equal (car line) "set-cookie") - (setq header-value (http-cookies-ns-to-rfc (cdr line))) - ;; there may be several cookies separated by "," - (dolist (raw-cookie (http-cookies-split-string header-value ?\,)) - (setq cookie (http-cookies-parse-cookie raw-cookie)) - ;; (message "%s" raw-cookie) - (when (http-cookies-accept) - ;; (message "accepted") - (http-cookies-store host cookie))))))) - - - -;; storing cookies - -(defun http-cookies-name (cookie) - "Return the name of the COOKIE." - (car (car cookie))) - -(defun http-cookies-path (cookie) - "Return the value of the path attribute of the COOKIE." - (let ((attr (or (assoc "path" cookie) (assoc "Path" cookie)))) - (when attr - (cdr attr)))) - -(defun http-cookies-domain (cookie) - "Return the value of the domain attribute of the COOKIE." - (let ((attr (or (assoc "domain" cookie) (assoc "Domain" cookie)))) - (when attr - (cdr attr)))) - -(defun http-cookies-expires (cookie) - "Return the value of the expires attribute of the COOKIE." - (let ((attr (assoc "expires" cookie))) - (when attr - (cdr attr)))) - -(defun http-cookies-max-age (cookie) - "Return the value of the Max-Age attribute of the COOKIE." - (let ((attr (assoc "Max-Age" cookie))) - (when attr - (cdr attr)))) - -(defun http-cookies-version (cookie) - "Return the value of the version attribute of the COOKIE." - (let ((version (assoc "Version" cookie))) - (when version - (if (equal version "1") - t - (message "Cookie version %s not supported." version) - nil)))) - -(defun http-cookies-equal (c1 c2) - "Return non nil if the given cookies are equal. -Old netscape cookies are equal if the name and path attributes are equal. -Version 1 cookies are equal if name path and domain are equal." - (if (and (http-cookies-version c1) (http-cookies-version c2)) - ;; version 1 cookies - (and (equal (http-cookies-name c1) (http-cookies-name c2)) - (equal (http-cookies-path c1) (http-cookies-path c2)) - (equal (http-cookies-domain c1) (http-cookies-domain c2))) - ;; netscape cookies - (and (equal (http-cookies-name c1) (http-cookies-name c2)) - (equal (http-cookies-path c1) (http-cookies-path c2))))) - -(defun http-cookies-expired (expire-string) - "Return non nil if EXPIRE-STRING is in the past." - (> (time-to-seconds (time-since expire-string)) 0.0)) - -(defun http-cookies-remove (cookie key table) - "Remove cookies \"equal\" to COOKIE from the list stored with KEY in TABLE." - (let ((cookie-list (gethash key table)) new-list) - (dolist (entry cookie-list) - (unless (http-cookies-equal entry cookie) - (add-to-list 'new-list entry))) - (when cookie-list - (remhash key table) - (puthash key new-list table)))) - -(defun http-cookies-store (host cookie) - "Store the given COOKIE from HOST in the hash tables. -Remove cookie from the tables if the given COOKIE expires in the past or -has an \"Max-Age\" of 0." - (let ((domain (http-cookies-domain cookie)) - (max-age (http-cookies-max-age cookie)) - (expires (http-cookies-expires cookie)) - (cookie-list)) - ;; remove an possible "equal" old cookie - (http-cookies-remove cookie host http-cookies-host-hash) - (when domain - (http-cookies-remove cookie domain http-cookies-domain-hash)) - ;; check if expires is in the past or Max-Age is zero - (unless (or (and max-age (= (string-to-number max-age) 0)) - (and expires (http-cookies-expired expires))) - ;; convert "Max-Age" to "expire" - (when max-age - ;; this value does not have to be in the "right" format - ;; it's enough if `parse-time-string' can parse it - (setq expires (format-time-string - "%Y-%m-%d %T %z" - (time-add (current-time) (seconds-to-time max-age)) - t)) - (setcdr (assoc "Max-Age" cookie) expires) - (setcar (assoc "Max-Age" cookie) "expires")) - (setq cookie-list (gethash host http-cookies-host-hash)) - (add-to-list 'cookie-list cookie) - (puthash host cookie-list http-cookies-host-hash) - (when domain - (setq cookie-list (gethash domain http-cookies-domain-hash)) - (add-to-list 'cookie-list cookie) - (puthash domain cookie-list http-cookies-domain-hash))))) - - - -;; building the header to send back the cookie - -(defun http-cookies-cookie-to-string (cookie) - "Return the cookie as a string to be used as a header value." - (let* ((name (http-cookies-name cookie)) - (value (cdr (assoc name cookie))) - (path (http-cookies-path cookie)) - (domain (http-cookies-domain cookie)) - (string)) - (if (http-cookies-version cookie) - ;; version 1 cookie - (progn - (setq string (concat "$Version = \"1\"; " name " = \"" value "\"")) - (when path - (setq string (concat string "; $Path = \"" path "\""))) - (when domain - (setq string (concat string "; $Domain = \"" domain "\"")))) - ;; netscape cookies - (setq string (concat name "=" value))))) - -(defun http-cookies-cookie-in-list (cookie list) - "Return non-nil if a cookie \"equal\" to the given COOKIE is in LIST." - (let ((in-list)) - (dolist (element list) - (unless in-list - (setq in-list (http-cookies-equal cookie element)))) - in-list)) - -(defun http-cookies-path-depth (cookie) - "Return the number of dashes in the path attribute of the cookie." - (let ((patch http-cookies-path cookie) (n 0) (start 0)) - (while (setq start (http-cookies-find-char-in-string ?\/ path start)) - (setq n (1+ n))) - n)) - -(defun http-cookie-path-depth-less (c1 c2) - "Return non nil if the path depth of cookie C1 is less than C2." - (< (http-cookies-path-depth c1) (http-cookies-path-depth c2))) - -(defun http-cookies-build-header (url) - "Return a pair (\"Cookie\" .

). -Use this to send back cookies to the given URL." - (let ((host (http-cookies-url-host url)) (domain) (cookie-list) (string)) - (when (string-match "^[^.]+\\(\\..+\\)" host) - (setq domain (match-string 1 host)) - (dolist (cookie (gethash host http-cookies-host-hash)) - (unless (http-cookies-expired (http-cookies-expires cookie)) - (add-to-list 'cookie-list cookie))) - (dolist (cookie (gethash domain http-cookies-domain-hash)) - (unless (or (http-cookies-cookie-in-list cookie cookie-list) - (http-cookies-expired (http-cookies-expires cookie))) - (add-to-list 'cookie-list cookie))) - (setq cookie-list (sort cookie-list 'http-cookies-path-depth-less)) - (dolist (cookie cookie-list) - (if string - (setq string (concat string "; " - (http-cookies-cookie-to-string cookie))) - (setq string (http-cookies-cookie-to-string cookie))))) - (cons "Cookie" string))) - - - -;; extract parts of the url - -(defun http-cookies-url-host (url) - "Return the hostname of URL" - (unless (string-match - "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)" - url) - (error "Cannot parse URL %s." url)) - (match-string 1 url)) - -(defun http-cookies-url-path (url) - "Return the path of the URL." - (unless (string-match - "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)" - url) - (error "Cannot parse URL %s." url)) - (concat "/" (or (match-string 4 url) ""))) - - - -;; functions to check the cookie (implementation of 4.3.2 of RFC 2109) - -(defun http-cookies-accept () - "Return non nil if the cookie should be accepted. -The tests are based on the functions in `http-cookies-accept-functions'." - (let ((accept t)) - (dolist (fun http-cookies-accept-functions) - (when accept - (setq accept (funcall fun)))) - accept)) - -(defun http-cookie-check-path () - "Return nil if the \"path\" attribute is not a prefix of th URL." - (let ((cookie-path (cdr (assoc "path" cookie)))) - (if cookie-path - (if (string-match (concat "^" cookie-path) path) - t - (message "Rejecting cookie: path attribute \"%s\" is not a prefix\ - of the URL %s." cookie-path url) - nil) - t))) - -(defun http-cookie-check-domain () - "Return nil if the domain is bogus. -Return nil if the domain does not start with a \".\" or does not contain -an embedded dot." - (let ((domain (cdr (assoc "domain" cookie)))) - (if domain - (if (string-match "^\\.[^.]+\\.[^.]+" domain) - t - (message "Rejection cookie: domain \"%s\" does not start with a dot\ - or does not contain an embedded dot." domain) - nil) - t))) - -(defun http-cookie-check-hostname () - "Return nil if the domain doesn't match the host. -Return nil if the domain attribute does not match the host name or the -host name without the domain attribute still contains one or more dots." - ;; FIXME: hostname might be an IP address - (let ((domain (cdr (assoc "domain" cookie)))) - (if (not domain) - t - (when (string-match (concat domain "$") host) - (not (http-cookies-find-char-in-string - ?\. (substring host 0 (match-beginning 0)))))))) - - - -(provide 'http-cookies) - -;;; http-cookies.el ends here diff --git a/emacs/external/ljupdate/http-get.el b/emacs/external/ljupdate/http-get.el deleted file mode 100644 index 4a58814..0000000 --- a/emacs/external/ljupdate/http-get.el +++ /dev/null @@ -1,448 +0,0 @@ -;;; http-get.el --- simple HTTP GET - -;; Copyright (C) 2002, 2003 Alex Schroeder - -;; Author: Alex Schroeder -;; Pierre Gaston -;; David Hansen -;; Maintainer: David Hansen -;; Version: 1.0.15 -;; Keywords: hypermedia -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?HttpGet - -;; This file is not part of GNU Emacs. - -;; This 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 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: - -;; Use `http-get' to download an URL. - -;;; Change log: - -;; 1.0.15 -;; - made `http-parse-headers' RFC 2616 compatible (removing whitespaces, -;; headers may spawn several line) -;; - log message headers -;; - made most variables buffer local with `make-variable-buffer-local' -;; 1.0.14 -;; - Removed attempt to fix bug in 1.0.12, not needed anymore since 1.0.13. -;; 1.0.13 -;; - The string is now not anymore decoded in the http-filter. -;; You have to run `http-decode' yourself. -;; 1.0.12 -;; - Hopefully fixed the bug with inserting "half" multi byte chars. -;; 1.0.11 -;; - Added (setq string (string-make-unibyte string)) to http-filter -;; this seems to solve problems with multi byte chars. -;; - Fixed bug when building the headers. -;; - Fixed indentation (please guys, read the coding conventions in the -;; elisp manual) -;; - Replaced string-bytes with length (string-bytes shouldn't be needed -;; anymore as we force the string to be unibyte) -;; 1.0.10 -;; - Fix some codings problems again. -;; 1.0.9 -;; - Added better coding support. -;; 1.0.8 -;; - Rewrote the parser. -;; - Correction to the http 1.0 usage. -;; 1.0.3 -;; - Move http-url-encode from http-post.el to http-get.el. -;; - Add a param to http-get to specify the encoding of the params in the url. - -;;; Code: - -(require 'hexl) -(require 'http-cookies) - -(defvar http-get-version "1.0.15") - -;; Proxy -(defvar http-proxy-host nil - "*If nil dont use proxy, else name of proxy server.") - -(defvar http-proxy-port nil - "*Port number of proxy server. Default is 80.") - -(defvar http-coding 'iso-8859-1 - "Default coding to be use when the string is inserted in the buffer. -This coding will be modified on Finding the content-type header") -(make-variable-buffer-local 'http-coding) - -(defvar http-filter-pre-insert-hook '(http-parser) - "Hook run by the `http-filter'. -This is called whenever a chunk of input arrives, before it is -inserted into the buffer. If you want to modify the string that gets -inserted, modify the variable `string' which is dynamically bound to -what will get inserted in the end. The string will be inserted at -the `process-mark', which you can get by calling \(process-mark proc). -`proc' is dynamically bound to the process, and the current buffer -is the very buffer where the string will be inserted.") - -(defvar http-filter-post-insert-hook nil - "Hook run by the `http-filter'. -This is called whenever a chunk of input arrives, after it has been -inserted, but before the `process-mark' has moved. Therefore, the new -text lies between the `process-mark' and point. You can get the values -of the `process-mark' by calling (process-mark proc). Please take care -to leave point at the right place, eg. by wrapping your code in a -`save-excursion'.") - -(defun http-filter (proc string) - "Filter function for HTTP buffers. -See `http-filter-pre-insert-hook' and `http-filter-post-insert-hook' -for places where you can do your own stuff such as HTML rendering. -Argument PROC is the process that is filtered. -Argument STRING is the string outputted by the process." - ;; emacs seems to screw this sometimes - (when (fboundp 'string-make-unibyte) - (setq string (string-make-unibyte string))) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - " Insert the text, advancing the process marker." - (goto-char (process-mark proc)) - (run-hooks 'http-filter-pre-insert-hook) - ;; Note: the string is inserted binary in a unibyte buffer - (insert string) - (run-hooks 'http-filter-post-insert-hook) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc)))))) - -(defvar http-status-code nil - "The status code returned for the current buffer. -This is set by the function `http-headers'.") -(make-variable-buffer-local 'http-status-code) - -(defvar http-reason-phrase nil - "The reason phrase returned for the `http-status-code'. -This is set by the function `http-headers'.") -(make-variable-buffer-local 'http-reason-phrase) - -(defvar http-headers nil - "An alist of the headers that have been parsed and removed from the buffer. -The headers are stored as an alist. -This is set by the function `http-headers'.") -(make-variable-buffer-local 'http-headers) - -(defvar http-parser-state 'status-line - "Parser status.") -(make-variable-buffer-local 'http-parser-state) - -(defvar http-unchunk-chunk-size 0 - "Size of the current unfinished chunk.") -(make-variable-buffer-local 'http-unchunk-chunk-size) - -(defvar http-not-yet-parsed "" - "Received bytes that have not yet been parsed.") -(make-variable-buffer-local 'http-not-yet-parsed) - -(defvar http-host "" - "The host to which we have sent the request.") -(make-variable-buffer-local 'http-host) - -(defvar http-url "" - "The requested URL.") -(make-variable-buffer-local 'http-url) - -(defun http-parser () - "Simple parser for http message. -Parse the status line, headers and chunk." - (let ((parsed-string (concat http-not-yet-parsed string)) content-type) - (setq string "") - (setq http-not-yet-parsed "") - (while (> (length parsed-string) 0) - (cond - - ((eq http-parser-state 'status-line) - ;; parsing status line - (if (string-match "HTTP/[0-9.]+ \\([0-9]+\\) \\(.*\\)\r\n" - parsed-string) - (progn - (setq http-status-code - (string-to-number (match-string 1 parsed-string))) - (setq http-reason-phrase (match-string 2 parsed-string)) - (setq http-parser-state 'header) - (setq parsed-string (substring parsed-string (match-end 0)))) - ;; status line not found - (setq http-not-yet-parsed parsed-string) - (setq parsed-string ""))) - - ((eq http-parser-state 'header) - ;; parsing headers - (if (string-match "\r\n\r\n" parsed-string) - (let ((end-headers (match-end 0))) - (setq http-headers - (http-parse-headers - (substring parsed-string 0 (match-beginning 0)))) - (if (string= "chunked" - (cdr (assoc "transfer-encoding" http-headers))) - (setq http-parser-state 'chunked) - (setq http-parser-state 'dump)) - (when (and - (setq content-type - (cdr (assoc "content-type" http-headers))) - (string-match "charset=\\(.*\\)" content-type)) - (setq http-coding - (intern-soft (downcase (match-string 1 content-type))))) - (setq parsed-string (substring parsed-string end-headers)) - ;; set cookies - (when http-emacs-use-cookies - (http-cookies-set http-url http-headers))) - ;; we don't have all the headers yet - (setq http-not-yet-parsed parsed-string) - (setq parsed-string ""))) - - ((eq http-parser-state 'chunked) - ;; parsing chunked content - (if (> (length parsed-string) http-unchunk-chunk-size) - (progn - (setq string (concat string - (substring parsed-string 0 - http-unchunk-chunk-size))) - (setq parsed-string - (substring parsed-string http-unchunk-chunk-size)) - (setq http-unchunk-chunk-size 0) - - (if (string-match "\\([0-9a-f]+\\)[^\r^\b]*\\(\r\n\\)" - parsed-string) - (if (> (setq http-unchunk-chunk-size - (hexl-hex-string-to-integer - (match-string 1 parsed-string))) - 0) - (setq parsed-string - (substring parsed-string (match-end 2))) - ;; chunk 0 found we just burry it - (setq parsed-string "") - (setq http-parser-state 'trailer)) - ;; we don't have the next chunk-size yet - (setq http-not-yet-parsed parsed-string) - (setq parsed-string ""))) - ;; the current chunk is not finished yet - (setq string (concat string parsed-string)) - (setq http-unchunk-chunk-size - (- http-unchunk-chunk-size (length parsed-string))) - (setq parsed-string ""))) - - ((eq http-parser-state 'trailer) - ;; parsing trailer - (setq parsed-string "")) - - ((eq http-parser-state 'dump) - (setq string parsed-string) - (setq parsed-string "")))))) - - -(defun http-parse-headers (header-string) - "Parse the header string. -Argument HEADER-STRING A string containing a header list." - ;; headers may spawn several line if the nth, n>1, line starts with - ;; at least one whitespace - (setq header-string (replace-regexp-in-string "\r\n[ \t]+" " " - header-string)) - (let ((lines-list (split-string header-string "\r\n"))) - (mapcar (lambda (line) - (if (string-match ":[ \t]+\\(.*?\\)[ \t]*$" line) - (cons (downcase (substring line 0 (match-beginning 0))) - (match-string 1 line)) - line)) - lines-list))) - - -;; URL encoding for parameters -(defun http-url-encode (str content-type) - "URL encode STR using CONTENT-TYPE as the coding system." - (apply 'concat - (mapcar (lambda (c) - (if (or (and (>= c ?a) (<= c ?z)) - (and (>= c ?A) (<= c ?Z)) - (and (>= c ?0) (<= c ?9))) - (string c) - (format "%%%02x" c))) - (encode-coding-string str content-type)))) - - -(defun http-decode-buffer () - "Decode buffer according to the buffer local variable `http-coding'." - (when (and - (fboundp 'set-buffer-multibyte) - (fboundp 'multibyte-string-p)) - (when (multibyte-string-p (decode-coding-string "test" http-coding)) - (set-buffer-multibyte t))) - (decode-coding-region (point-min) (point-max) http-coding)) - -;; Debugging -(defvar http-log-function 'ignore - "Function to call for log messages.") - -(defun http-log (str) - "Log STR using `http-log-function'. -The default value just ignores STR." - (funcall http-log-function str)) - - -(defun http-get-debug (url &optional headers version) - "Debug the call to `http-get'." - (interactive "sURL: ") - (let* ((http-log-function (lambda (str) - (save-excursion - ;; dynamic binding -- buf from http-get is used - (set-buffer buf) - (insert str)))) - proc) - (when (get-buffer "*Debug HTTP-GET*") - (kill-buffer "*Debug HTTP-GET*")) - (setq proc (http-get url headers nil version)) - (set (make-local-variable 'http-filter-pre-insert-hook) nil) - (set (make-local-variable 'http-filter-post-insert-hook) nil) - (rename-buffer "*Debug HTTP-GET*"))) - - -;; The main function - -;;;###autoload -(defun http-get (url &optional headers sentinel version bufname content-type) - "Get URL in a buffer, and return the process. -You can get the buffer associated with this process using -`process-buffer'. - -The optional HEADERS are an alist where each element has the form -\(NAME . VALUE). Both must be strings and will be passed along with -the request. - -With optional argument SENTINEL, the buffer is not shown. It is the -responsibility of the sentinel to show it, if appropriate. A sentinel -function takes two arguments, process and message. It is called when -the process is killed, for example. This is useful when specifying a -non-persistent connection. By default, connections are persistent. -Add \(\"Connection\" . \"close\") to HEADERS in order to specify a -non-persistent connection. Usually you do not need to specify a -sentinel, and `ignore' is used instead, to prevent a message being -printed when the connection is closed. - -If you want to filter the content as it arrives, bind -`http-filter-pre-insert-hook' and `http-filter-post-insert-hook'. - -The optional argument VERSION specifies the HTTP version to use. It -defaults to version 1.0, such that the connection is automatically -closed when the entire document has been downloaded. This will then -call SENTINEL, if provided. If no sentinel is provided, `ignore' will -be used in order to prevent a message in the buffer when the process -is killed. - -CONTENT-TYPE is a coding system to use for the encoding of the url -param value. Its upper case print name will be used for the server. -Possible values are `iso-8859-1' or `euc-jp' and others. - -The coding system of the process is set to `binary', because we need to -distinguish between \\r and \\n. To correctly decode the text later, -use `decode-coding-region' and get the coding system to use from -`http-headers'." - (interactive "sURL: ") - (setq version (or version 1.0)) - (let* (host dir file port proc buf command start-line (message-headers "") ) - (unless (string-match - "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)" - url) - (error "Cannot parse URL %s." url)) - (unless bufname - (setq bufname (format "*HTTP GET %s *" url))) - - (setq host (match-string 1 url) - port (or (and (setq port (match-string 3 url)) - (string-to-int port)) 80) - dir (or (match-string 4 url) "") - file (or (match-string 5 url) "") - buf (get-buffer-create bufname) - proc (open-network-stream - (concat "HTTP GET " url) buf - (if http-proxy-host http-proxy-host host) - (if http-proxy-port http-proxy-port port) )) - (if sentinel - (set-buffer buf) - (switch-to-buffer buf)) - (erase-buffer) - (kill-all-local-variables) - (with-current-buffer buf - (setq http-host host) - (setq http-url url)) - (if content-type - (setq file - (replace-regexp-in-string - "=[^&]+" - (lambda (param) - (concat "=" - (http-url-encode (substring param 1) content-type))) - file))) - (setq start-line - (concat (format "GET %s%s%s HTTP/%.1f\r\n" - (if http-proxy-host - (concat "http://" host "/") "/") dir file version) - (format "Host: %s\r\n" host))) - (when http-emacs-use-cookies - (let ((cookie (http-cookies-build-header url))) - (when cookie (add-to-list 'headers cookie)))) - (when headers - (setq message-headers (mapconcat (lambda (pair) - (concat (car pair) ": " (cdr pair))) - headers - "\r\n"))) - ;; mapconcat doesn't append the \r\n for the final line - (setq command (format "%s%s\r\n\r\n" start-line message-headers)) - (http-log (format "Connecting to %s %d\nCommand:\n%s\n" host port command)) - (http-log message-headers) - (set-process-sentinel proc (or sentinel 'ignore)) - (set-process-coding-system proc 'binary 'binary) ; we need \r\n - ;; we need this to be able to correctly decode the buffer with - ;; decode-coding-region later - (when (fboundp 'set-buffer-multibyte) - (with-current-buffer buf (set-buffer-multibyte nil))) - (set-process-filter proc 'http-filter) - (set-marker (process-mark proc) (point-max)) - (process-send-string proc command) - - proc)) - - -;; needed for xemacs. c&p from gnu emacs cvs sources -(unless (fboundp 'replace-regexp-in-string) - (defun replace-regexp-in-string (regexp rep string &optional - fixedcase literal subexp start) - (let ((l (length string)) - (start (or start 0)) - matches str mb me) - (save-match-data - (while (and (< start l) (string-match regexp string start)) - (setq mb (match-beginning 0) - me (match-end 0)) - (when (= me mb) (setq me (min l (1+ mb)))) - (string-match regexp (setq str (substring string mb me))) - (setq matches - (cons (replace-match (if (stringp rep) - rep - (funcall rep (match-string 0 str))) - fixedcase literal str subexp) - (cons (substring string start mb) - matches))) - (setq start me)) - (setq matches (cons (substring string start l) matches)) - (apply #'concat (nreverse matches)))))) - -(provide 'http-get) - -;;; http-get.el ends here diff --git a/emacs/external/ljupdate/http-post.el b/emacs/external/ljupdate/http-post.el deleted file mode 100644 index fbca42b..0000000 --- a/emacs/external/ljupdate/http-post.el +++ /dev/null @@ -1,172 +0,0 @@ -;;; http-post.el --- simple HTTP POST - -;; Copyright (C) 2002, 2003 Alex Schroeder - -;; Author: Alex Schroeder -;; Maintainer: David Hansen -;; Version: 1.0.5 -;; Keywords: hypermedia -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?HttpPost - -;; This file is not part of GNU Emacs. - -;; This 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 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: - -;; Use `http-post' to post to a URL. - -;;; Change Log: - -;; 1.0.5 -;; - Added experimental cookies support. -;; 1.0.4 -;; - Fixed bug in `http-post' that ignored the headers argument. -;; 1.0.3 -;; - Minor fix. -;; 1.0.1 -;; - Moved http-url-encode to http-get. - -;;; Code: - -(require 'http-get) -(require 'http-cookies) - -(defvar http-post-version "1.0.5") - - -;; The main function - -(defun http-post (url parameters content-type &optional headers sentinel - version verbose bufname) - "Post to a URL in a buffer using HTTP 1.1, and return the process. -You can get the buffer associated with this process using -`process-buffer'. - - - -PARAMETERS is an alist of parameters to use. Each element has the -form \(NAME . VALUE). These usually correspond to successful controls -on HTML forms. - -CONTENT-TYPE is a coding system to use. Its upper case print name -will be used for the server. Possible values are `iso-8859-1' or -`euc-jp' and others. - -The optional HEADERS are an alist where each element has the form -\(NAME . VALUE). Both must be strings and will be passed along with -the request. The reason CONTENT-TYPE is not just passed along as one -of the headers is that part of the Content-Type value is fixed and -cannot be changed: The basic encoding is implemented using -`html-url-encode' and is called application/x-www-form-urlencoded. - -With optional argument SENTINEL, the buffer is not shown. It is the -responsibility of the sentinel to show it, if appropriate. A sentinel -function takes two arguments, process and message. It is called when -the process is killed, for example. This is useful when specifying a -non-persistent connection. By default, connections are persistent. -Add \(\"Connection\" . \"close\") to HEADERS in order to specify a -non-persistent connection. Usually you do not need to specify a -sentinel, and `ignore' is used instead, to prevent a message being -printed when the connection is closed. - -If you want to filter the content as it arrives, bind -`http-filter-pre-insert-hook' and `http-filter-post-insert-hook'. - -The optional argument VERSION specifies the HTTP version to use. It -defaults to version 1.0, such that the connection is automatically -closed when the entire document has been downloaded. - -If the optional argument VERBOSE is non-nil, a message will show the -command sent to the server. - -The coding system of the process is set to `binary', because we need to -distinguish between \\r and \\n. To correctly decode the text later, -use `decode-coding-region' and get the coding system to use from -`http-headers'." - (interactive) - (setq version (or version 1.0)) - (let* (host dir file port proc buf header body content-length) - (unless (string-match - "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)" - url) - (error "Cannot parse URL %s" url)) - (unless bufname (setq bufname - (format "*HTTP POST %s *" url))) - (setq host (match-string 1 url) - port (or (and (setq port (match-string 3 url)) - (string-to-int port)) 80) - dir (or (match-string 4 url) "") - file (or (match-string 5 url) "") - buf (get-buffer-create bufname) - proc (open-network-stream - (concat "HTTP POST " url) - buf (if http-proxy-host http-proxy-host host) - (if http-proxy-port http-proxy-port port))) - (set-process-sentinel proc (or sentinel 'ignore)) - (set-process-coding-system proc 'binary 'binary) ; we need \r\n - (set-process-filter proc 'http-filter) - (set-marker (process-mark proc) (point-min) buf) - (if sentinel - (set-buffer buf) - (switch-to-buffer buf)) - (erase-buffer) - (kill-all-local-variables) - - (with-current-buffer buf - (setq http-host host) - (setq http-url url)) - - (let (result) - (dolist (param parameters) - (setq result (cons (concat (car param) "=" - (http-url-encode (cdr param) - content-type)) - result))) - (setq body (mapconcat 'identity result "&"))) - - (setq header - (concat (format "POST %s%s%s HTTP/%.1f\r\n" - (if http-proxy-host - (concat "http://" host "/") - "/") dir file version) - (format "Host: %s\r\n" host) - "Content-Type: application/x-www-form-urlencoded" - (format "; charset=%s\r\n" - (upcase (symbol-name content-type))) - (format "Content-Length: %d\r\n" (length body)))) - - (when http-emacs-use-cookies - (let ((cookie (http-cookies-build-header url))) - (when cookie (add-to-list 'headers cookie)))) - (if headers - (setq header (concat header - (mapconcat (lambda (pair) - (concat (car pair) ": " (cdr pair))) - headers - "\r\n") - "\r\n\r\n")) - (setq header (concat header "\r\n"))) - (when verbose - ;;(when t - (message "%s" (concat header body "\n\n"))) - (process-send-string proc (concat header body "\r\n")) - proc)) - - -(provide 'http-post) - -;;; http-post.el ends here diff --git a/emacs/external/ljupdate/index.html b/emacs/external/ljupdate/index.html deleted file mode 100644 index 6730e4f..0000000 --- a/emacs/external/ljupdate/index.html +++ /dev/null @@ -1,56 +0,0 @@ - - - - ljupdate — a LiveJournal client for Emacs - - - - -

- ljupdate — a - LiveJournal client for - Emacs -

- -

- Download the latest development - snapshot or use subversion to check out - the source like so: -

- - 
svn checkout http://ljupdate.googlecode.com/svn/trunk/ ljupdate
- -

- If you have any questions, please post them to the - [info]ljupdate - community. -

- -
- -

- ljupdate is hosted on - Google Code's Project Hosting; - here's the project page. -

- - diff --git a/emacs/external/ljupdate/lj-acct.el b/emacs/external/ljupdate/lj-acct.el deleted file mode 100644 index f33a39e..0000000 --- a/emacs/external/ljupdate/lj-acct.el +++ /dev/null @@ -1,230 +0,0 @@ -;;; lj-acct.el --- LiveJournal account handling code for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'lj-custom) - -;; backing store - -(defvar lj-acct-hash nil - "Hash in which internal account information is stored.") - -(defun lj-make-acct-hash () - "Create a new value for variable `lj-acct-hash'." - (make-hash-table :test 'equal)) - -(defun lj-acct-hash () - "Return the hash table in which internal account information is stored. -Will attempt to load our cached configuration if it is available." - (when (null lj-acct-hash) - (lj-cache-load)) - (or lj-acct-hash - (setq lj-acct-hash (lj-make-acct-hash)))) - -;; sever/user property getters/setters - -(defun lj-servers () - "Return a list of LiveJournal servers that we know about." - (let ((servers '())) - (maphash (lambda (server server-hash) - (push server servers)) - (lj-acct-hash)) - (nreverse servers))) - -(defun lj-server-get (server property) - "Fetch the value of SERVER's PROPERTY." - (let ((server-hash (gethash server (lj-acct-hash)))) - (when server-hash - (gethash property server-hash)))) - -(defun lj-users (server) - "Return a list of users on SERVER whose accounts we can use." - (let ((server-hash (gethash server (lj-acct-hash))) - (users '())) - (when server-hash - (maphash (lambda (user user-hash) - (when (and (stringp user) - (hash-table-p user-hash)) - (push user users))) - server-hash) - users))) - -(defun lj-server-put (server property value) - "Set SERVER' value of PROPERTY to VALUE." - (let ((server-hash (gethash server (lj-acct-hash)))) - (unless server-hash - (setq server-hash (make-hash-table :test 'equal)) - (puthash server server-hash (lj-acct-hash))) - (puthash property value server-hash))) - -(defun lj-server-rem (server property) - "Remove SERVER's PROPERTY." - (let ((server-hash (gethash server (lj-acct-hash)))) - (when server-hash - (remhash property server-hash)))) - -(defun lj-user-get (server username property) - "Fetch SERVER's value of USERNAME's PROPERTY." - (let ((user-hash (lj-server-get server username))) - (when user-hash - (gethash property user-hash)))) - -(defun lj-user-put (server username property value) - "Set SERVER's value of USERNAME's PROPERTY to VALUE." - (let ((user-hash (lj-server-get server username))) - (unless user-hash - (setq user-hash (make-hash-table :test 'equal)) - (lj-server-put server username user-hash)) - (puthash property value user-hash))) - -(defun lj-user-rem (server username property) - "Remove SERVER's USERNAME's PROPERTY." - (let ((user-hash (lj-server-get server username))) - (when user-hash - (remhash property user-hash)))) - -;; serialization / deserialization routines - -(defun lj-hash-from-alist (alist) - "Return a new hash table with the same mappings as in ALIST." - (let ((hash (make-hash-table :test 'equal))) - (mapcar (lambda (element) - (puthash (car element) (cdr element) hash)) - alist) - hash)) - -(defun lj-alist-from-hash (hash) - "Return a new alist with the same mapping as in HASH." - (let ((alist '())) - (maphash (lambda (k v) - (push (cons k v) alist)) - hash) - alist)) - -;; loading and saving cache - -(defun lj-cache-file (&optional filename) - "Return the absolute path to FILENAME. -If FILENAME is nil, returns the absolute path to the file named -\"cache\" in `lj-cache-dir'." - (if filename - (expand-file-name filename) - (expand-file-name "cache" lj-cache-dir))) - -(defun lj-cache-load (&optional filename) - "Load server and user information out of cache FILENAME. -We use our default cache location if FILENAME is nil." - (setq filename (lj-cache-file filename)) - (when (file-readable-p filename) - (with-temp-buffer - (insert-file-contents filename) - (eval-buffer)))) - -(defvar lj-cache-format 1 - "Version of the cache file format.") - -(defun lj-cache-save-forms () - "Return Lisp forms which would restore this ljupdate config if evalled." - (let ((forms '())) - (push '(setq lj-cache-format 1) forms) - (push '(setq lj-acct-hash (lj-make-acct-hash)) forms) - (maphash (lambda (server server-hash) - (push `(lj-server-put ,server :mood-max - ,(or (lj-server-get server :mood-max) - "0")) - forms) - (push `(lj-server-put ,server :moods - ',(lj-server-get server :moods)) - forms) - (maphash (lambda (username user-hash) - (when (stringp username) - ;; handle users - (mapc (lambda (field) - (let ((val (lj-user-get server username field))) - (when val - (push `(lj-user-put - ,server ,username ,field - ;; Conservatively quoting everything - ',val) - forms)))) - '(:name :access :pics :friends-groups)) - (let ((pass (lj-user-get server username :password))) - (when (and pass lj-cache-login-information) - (push `(lj-user-put - ,server ,username :password - ,pass) - forms))))) - server-hash)) - (lj-acct-hash)) - (nreverse forms))) - -(defun lj-make-directory (directory &optional parents modes) - "Create DIRECTORY. -If PARENTS is non-null, create any parent directories as necessary. -If MODES is null, 0700 are used." - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes (or modes ?\700)) - (make-directory directory parents)) - (set-default-file-modes umask)))) - -(defun lj-cache-save (&optional filename) - "Save server and user information out to cache FILENAME. -We use our default cache location if FILENAME is nil." - (setq filename (lj-cache-file filename)) - (let ((dir (file-name-directory filename))) - (unless (file-exists-p dir) - (lj-make-directory dir t)) - (unless (file-directory-p dir) - (error "File `%s' is not a directory" dir))) - (unless (file-writable-p filename) - (error "Unable to write to `%s'" filename)) - (find-file filename nil) - (delete-region (point-min) (point-max)) - (insert ";; -*- emacs-lisp -*-\n" - ";; ljupdate configuration cache file\n") - (let ((standard-output (current-buffer))) - (mapc (lambda (form) - (prin1 form) - (terpri)) - (lj-cache-save-forms))) - (save-buffer) - (kill-buffer (current-buffer))) - -(add-hook 'kill-emacs-hook 'lj-cache-save) - -(provide 'lj-acct) -;;; lj-acct.el ends here diff --git a/emacs/external/ljupdate/lj-acct.elc b/emacs/external/ljupdate/lj-acct.elc deleted file mode 100644 index 62b4b5c0f1940013a944fd44a799a3330f297e84..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 6456 zcwW6&3vb)V5jF}Gm1ML{(nBw~1KJ67ttIzl^QDL77LAiANDAi?*hvnDlY!9W%I29O z6_T>!qCdVfv%3^2$-V@KHi=^{cV~9Kc@OtThfluT*w|?7@9)EtWI78Y5y0s+WN8>Y zdj9I==x}s=3`q>n(h#1BQ!oekZ)o?1Ru62`95Cf1O{OqGTJVRvZ!?i*yToAkb(;Jn z{5;zYlAN})T`~3iY&ZI8J`22D;6umr{d`A6%qNUtLV2dT~C_&ndI<)?dCsHwi$_})w4zwZ>pP_J7nsyuhdBBuO zy3Bl*_~*l+J_$=}q@h18DS8JLm(7;0HCS*1FKO^mk*0Wy@qVGvEx7VB@U>AVxLtw_ zxQx&QDY9S<{?b2YdMk^4LOAiH=pgQNoCJrNLHNSx!=vlosUEuD)lT;uW@E{gf zaOp*J!GMuC^iI(!-j`WyDb`*TqJ~J=sdphtS2Ta5ON_B&n)qYkk3BZVw%Iq}M?OlY zIyrM5<^sJ6fqT&jI7+g<<+M*oG|L&lk;vz14EebL<}T?zR~wD*Lv(#F&&70>L!LmC zcmX8y6nxJ=M+5swJPFU{sUn;}m=n2o>4g#9xB_|wZw(>3zu6$jFt#m|*1g};+NQO2 zN2#DfOQt3PIxNqME>FN#IvMo#q)xhpN<4@{R9-TH!|+o43&D^cFn^Gjqr$u#t^{1f z$rX4QI{69&eRN?k>pok{F&+GIfy~B0oPJwLuW5*4>dlk_TJp8JoJDV=M(U3V_}vPr z77(GGR9tgmf6H=R3D()ew3(xs$^6nW5$^Hm=-udOD}&cZuU?Oi-u!R_vd)>vOTx|4 zWG2%5y3J6X+5)2W07dNnZi9ix^|8@jC$hAd<^srEo3Mnz)fk+CB{B4@RfEkb%Tr;H zP|%l?OlTL*$ZWnB)2S6?lCl7`jKwj#4+zj#1n3?C>fuj+97|Kyx2wP;w=%qSsFsaQ zR7_eJdY`Vl!}_Z~l+U$s%+|lBZmbfin-`g&Gb4v6>95=GOZ~YP9HSkT(HCBzjZe}1 z?%?q4=q4|i&DVK>WF+=v33>Qha(aq+Wa(<|&+#1b+Wjb;=P@mofDyP>|x!EbZ z>g||rc3YO9>a;81%HG>8Lv+7b^4xpMb7Sqc_U3qktIxnMVN|tno8MMLZ^eu4?!Z*( zeX!!ipKSfAJOAITzv|P2fxDXMsgYtfQajvyQw_`L5=^BtYN`S8U?X#I_~Q7@3P{#1 zjRqZ$s|I4_2MMgG(PQI22P)dUuFAE>#`jC&+pLAs_}C>Pe-VkPi1iJ%N40}`Q}I$; z5>sJO_heDD9dl1vwd+>(AVpZK0;PfH2glD>8!RG|8qkGDl^c@ozE;38YI)nbvULHM zswt^fCVVetlohA|K;*mZ_#6j zGFwkdFL~}F?+Y3RH-iT0Hhj*1&CEav;S~r#jht#{ONTNZFOMSTy$L5o=Aaf~c>wAtj z?!pP%Jj&IPDDjIvd`X`-D1zJPn-n26aEI$0cPC$OaOhy%Jbb{}(zbeO{ew)9W}gmm zsx;wm%Zh4R|7Z?ris+oqClirE)fTKXoTdWV(_pcP1?H+Xl2+r`NdW zCxMXdH;acYXkj!f$4j3N*i$C z4pa{A!aFq;qlw5Lr41w;Heq#^RA_kzEXB{Y_vAF$w{@r-hB$W9u}qC>SIImIFdTR! z!<*2c`csA)zsTMsZdA;#%XZGZOL_O|)KYsaEzG}MofOy2Fp{1p;Y{QoRzbBF8;fqH zwKAQd#(!=E8tdMQT&q+4vGG)HVwZ^}TlVkeiX}0Wd$DTO z9Zr)ZKzTnd)i1*|Un7d{4FD7fv21&QsY*UaPPtEVH$fvL^DX#$dwepUmKV?eXJCSxoX zi}Wk6MT22(%TzN4vQ@!kJLYyp$3efyw>VLa4LzgIr(Sj;8NlKS%~(|one61D7Da7m z%?5MAXuVi zS7VpA{D_kO-jqQf* zK*85`L7um}vxm!-l{$|sN3D8k&_O*?ysas&bhhMv{7!tt?k&S|yXu~~JW;&BL+WGi zGh+GvFWHt1ogBN>;*=q&uF_C_oB-o(%$+kDm)`ON5z|T4D{)0J_V=N)-BI70BdUS8 z9LEOlEY&;xxp7f(>0puL(5u>uzJRL(eM&597|tkRY(Xwke9+(1R_Y`_s@9{@F%&M| tv$z*nYDOv_Z~1cWx3%58An2SY$%W)8;qtobsW?VmhJn!e4R38X{tMOixH|v< diff --git a/emacs/external/ljupdate/lj-compat.el b/emacs/external/ljupdate/lj-compat.el deleted file mode 100644 index 900bf0c..0000000 --- a/emacs/external/ljupdate/lj-compat.el +++ /dev/null @@ -1,48 +0,0 @@ -;;; lj-compat.el --- Cross-Emacsen compatibility code for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'cl) - -;; This should probably be less of a hack. -(defvar lj-coding-system (find-if 'coding-system-p '(utf-8 iso-8859-1)) - "Coding system for use when talking to LiveJournal.") - -(if (fboundp 'warn) - (defalias 'lj-warn 'warn) - (defalias 'lj-warn 'message)) - -(provide 'lj-compat) -;;; lj-compat.el ends here diff --git a/emacs/external/ljupdate/lj-compat.elc b/emacs/external/ljupdate/lj-compat.elc deleted file mode 100644 index 8566cbf4e1abaa15ffb83a67a23c63cc60b295c1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 894 zcwVJaO^?$s5bc#5xNzXekVUF1k#E}V$4V?(b%jt7NDC*5gd01p7sn2^)2jS>Cf@F< z?G-1M?3sBpZ{~S6U);Rx^?Jcr5m+}b;uOEkdw0TZfJzCvaiSJ~slyN(2j2N@BkTi-)^ZDMuV^hw zV7j!<2(`9v(QB*&${05JR4JRp`6LdAsDMz#fUI<@SOa~}H98O(1kZq6VT9oooOpm_ z5fI7M8p)kv1_OBi!6UUfPu}QqGo3z0!r2`$-69XvBOIM=&dP?Kc!)&;AIgovD&eo= znf75vEtHSKRv2*9G~iXD3XH;rAV)9rh`WZIH`nU5o*;xu}3&k(z+@dgRnXp zkB5^e!|{`gHxR=pE3iYd+B@E*;}9;3G{v30Ugl}>yobjechQ-a;WE!swC695?e7lu tA|2u$b->FIepClRcho3A(o_nZIMVip8g-*<4vo=Ufpwp>`3c1!_y+?W56b`m diff --git a/emacs/external/ljupdate/lj-compose.el b/emacs/external/ljupdate/lj-compose.el deleted file mode 100644 index 9e03431..0000000 --- a/emacs/external/ljupdate/lj-compose.el +++ /dev/null @@ -1,404 +0,0 @@ -;;; lj-compose.el --- post composition for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'cl) -(require 'message) -(require 'sendmail) - -(require 'lj-custom) -(require 'lj-acct) -(require 'lj-compat) -(require 'lj-fill) -(require 'lj-pcomplete) -(require 'lj-protocol) -(require 'lj-login) -(require 'lj-util) - -(eval-when-compile - ;; for `viper-change-state' - (require 'viper-cmd) - ;; from viper-init.el - (defvar viper-current-state) - ;; from viper.el - (defvar viper-mode)) - -;;; Utilities - -(defun lj-compose-fetch-field (field) - "Return this buffer's value of FIELD." - (save-excursion - (save-restriction - (widen) - (message-narrow-to-headers) - (message-fetch-field field)))) - -(defun lj-this-header () - "Return the header of line at point." - (save-excursion - (beginning-of-line) - (when (looking-at "\\([^:]+\\)[:]") - (match-string 1)))) - -(defun lj-this-server () - "Return the current value of the Server header." - (lj-compose-fetch-field "Server")) - -(defun lj-this-user () - "Return the current value of the User header." - (lj-compose-fetch-field "User")) - -;;; Code for submitting this post to LiveJournal. - -(defun lj-compose-prepare-body () - "Massage this buffer's body for submittal to LiveJournal and return as string." - (save-excursion - (save-restriction - (widen) - (message-goto-body) - (narrow-to-region (point) (point-max)) - (run-hooks 'lj-compose-pre-prepare-body-hook) - (funcall lj-fill-function) - (run-hooks 'lj-compose-post-prepare-body-hook) - (buffer-substring-no-properties (point-min) (point-max))))) - -(defun lj-compose-submit () - "Submit this entry to the server." - (interactive) - (let* ((buf (current-buffer)) - ;; The text of the entry. - (event (lj-compose-prepare-body)) - - ;; Some convenience variables for oft-used headers - (server (lj-compose-fetch-field "Server")) - (user (lj-compose-fetch-field "User")) - - ;; The current time -- or use the specified time if it exists - (time-field (lj-compose-fetch-field "Time")) - (timestamp (if (eq nil time-field) - () - (date-to-time (concat time-field " " (cadr (current-time-zone)))))) - - (time (split-string (format-time-string "%Y:%m:%d:%H:%M" timestamp) "[:]")) - (year (pop time)) - (month (pop time)) - (day (pop time)) - (hour (pop time)) - (minute (pop time)) - - ;; LJ Authentication information - challenge - - ;; The actual request packet, and the response we receive from - ;; the server. - (request (list '("auth_method" . "challenge") - '("ver" . "1") - (cons "year" year) - (cons "mon" month) - (cons "day" day) - (cons "hour" hour) - (cons "min" minute) - (cons "event" event)))) - - ;; Build up the request packet. - (add-to-list 'request (cons "user" user)) - (let ((itemid (lj-compose-fetch-field "Itemid"))) - (if itemid - (progn (add-to-list 'request (cons "itemid" itemid)) - (add-to-list 'request '("mode" . "editevent"))) - (add-to-list 'request '("mode" . "postevent")))) - (let ((subject (lj-compose-fetch-field "Subject"))) - (when subject - (add-to-list 'request (cons "subject" subject)))) - - ;; FIXME: use moodid if available - (let ((mood (lj-compose-fetch-field "Mood"))) - (when mood - (add-to-list 'request (cons "prop_current_mood" mood)))) - - (let ((location (lj-compose-fetch-field "Location"))) - (when location - (add-to-list 'request (cons "prop_current_location" location)))) - - (let ((tags (lj-compose-fetch-field "Tags"))) - (when tags - (add-to-list 'request (cons "prop_taglist" tags)))) - - (let ((music (lj-compose-fetch-field "Music"))) - (when music - (add-to-list 'request (cons "prop_current_music" music)))) - - (let ((community (lj-compose-fetch-field "Community"))) - (when community - (add-to-list 'request (cons "usejournal" community)))) - - (let ((picture (lj-compose-fetch-field "Picture"))) - (when picture - (add-to-list 'request (cons "prop_picture_keyword" picture)))) - - (let ((comments (lj-compose-fetch-field "Allow-Comments"))) - (when (and comments (string-match "[Nn][Oo]" comments)) - (add-to-list 'request '("prop_opt_nocomments" . "1")))) - - (let ((email (lj-compose-fetch-field "Receive-Mail-Notification"))) - (when (and email (string-match "[Nn][Oo]" email)) - (add-to-list 'request '("prop_opt_noemail" . "1")))) - - (let* ((access (lj-compose-fetch-field "Access")) - (friends-group-number - (cdr (assoc access (lj-user-get server user :friends-groups))))) - (if (stringp access) - (cond ((string-match "public" access) - (add-to-list 'request '("security" . "public"))) - ((string-match "private" access) - (add-to-list 'request '("security" . "private"))) - ((string-match "friends" access) - (add-to-list 'request '("allowmask" . "1")) - (add-to-list 'request '("security" . "usemask"))) - (friends-group-number - (add-to-list 'request (cons "allowmask" - (lj-exp2 friends-group-number))) - (add-to-list 'request '("security" . "usemask"))) - (t - (lj-warn - "Unable to understand Access: %s; presuming private." - access) - (add-to-list 'request '("security" . "private")))) - (add-to-list 'request '("security" . "public")))) - - ;; Actually talk to the LJ server. - (message "Connecting to `%s' as `%s'. Please wait." server user) - (setq challenge (lj-getchallenge server)) - - (add-to-list 'request (cons "auth_challenge" challenge)) - (add-to-list 'request - (cons "auth_response" - (lj-md5 (concat challenge (lj-password server user))))) - - (message "Submitting to `%s' as `%s'. Please wait." server user) - - (let ((response (lj-protocol-send-request server request))) - (set-buffer buf) ; return to the *LiveJournal* buffer - (if (and (hash-table-p response) - (string= (gethash "success" response) "OK")) - (progn - (set-buffer-modified-p nil) - (message "Successfully posted as %s." (gethash "url" response)) - t) - (let ((errmsg (gethash "errmsg" response))) - (if errmsg - (message "Posting to %s failed: %s" server errmsg) - (message "Posting to %s failed!" server))) - nil)))) - -(defun lj-compose-submit-then-exit () - "Submit this entry to the server, and exit if successful." - (interactive) - (when (lj-compose-submit) - (quit-window))) - -;;; Code for handling the separator between headers and body. - -(defvar lj-compose-header/body-marker nil - "The marker between the lj message's header and body sections. -Anything before this marker will be in `message-mode' and anything below -in `html-mode'.") -(make-variable-buffer-local 'lj-compose-header/body-marker) -(put 'lj-compose-header/body-marker 'permanent-local t) - -(defun lj-compose-find-separator () - "If non-null, the position of mail-header-separator in this buffer." - (save-excursion - (goto-char (point-min)) - (re-search-forward (regexp-quote mail-header-separator) nil t))) - -(defun lj-compose-propertize-separator (&optional pos) - "Puts the `mail-header-separator' property on the header separator." - (save-excursion - (goto-char (or pos (lj-compose-find-separator))) - (let ((beg (line-beginning-position)) - (end (line-end-position))) - (put-text-property beg end 'category 'mail-header-separator)))) - -(defun lj-compose-mark-separator (&optional pos) - "Initialize `lj-compose-header/body-marker' " - (set (make-local-variable 'lj-compose-header/body-marker) - (let ((marker (make-marker)) - (sep-pos (or pos (lj-compose-find-separator)))) - (lj-compose-propertize-separator sep-pos) - (set-marker marker sep-pos) - marker))) - -;;; Major modes for editing LiveJournal posts. - -(defun lj-compose-check-mode () - "Ensure we're using the correct major mode for this part of the buffer." - (let ((there (if (and (boundp 'lj-compose-header/body-marker) - (markerp lj-compose-header/body-marker)) - (marker-position lj-compose-header/body-marker) - (lj-compose-mark-separator))) - (here (point)) - (lj-saved-viper-state (and (boundp 'viper-current-state) - viper-current-state))) - (cond ((and (< here there) - (not (eq major-mode 'lj-compose-header-mode))) - (lj-compose-header-mode)) - ((and (> here there) - (not (eq major-mode 'lj-compose-body-mode))) - (lj-compose-body-mode))) - (when (and (boundp 'viper-mode) viper-mode) - (viper-change-state lj-saved-viper-state)))) - -(define-derived-mode lj-compose-header-mode message-mode "LJ:H" - (mml-mode -1) - (set (make-local-variable 'message-auto-save-directory) "~/.ljupdate/drafts") - (lj-pcomplete-setup) - (define-key lj-compose-header-mode-map "\t" 'pcomplete) - (run-hooks 'lj-compose-common-hook) - (add-hook 'post-command-hook 'lj-compose-check-mode nil t)) - -(define-derived-mode lj-compose-body-mode html-mode "LJ:B" - (run-hooks 'lj-compose-common-hook) - (add-hook 'post-command-hook 'lj-compose-check-mode nil t)) - -;;;###autoload -(defun lj-compose-mode () - "Major mode for editing LiveJournal posts." - (lj-compose-mark-separator) - (lj-compose-check-mode)) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.lj\\'" . lj-compose-mode)) - -;;; Key bindings. - -(define-key lj-compose-header-mode-map (kbd "C-c C-s") 'lj-compose-submit) -(define-key lj-compose-body-mode-map (kbd "C-c C-s") 'lj-compose-submit) - -(define-key lj-compose-header-mode-map (kbd "C-c C-c") 'lj-compose-submit-then-exit) -(define-key lj-compose-body-mode-map (kbd "C-c C-c") 'lj-compose-submit-then-exit) - -;; (define-key lj-compose-body-mode-map (kbd "C-c ") 'lj-complete-body) - -;; Ensure that unwanted Message bindings get shadowed. -;; I should probably do this in a nicer way. -(mapc (lambda (key) - (define-key lj-compose-header-mode-map key 'undefined)) - (list (kbd "C-c C-a") (kbd "C-c C-e") (kbd "C-c C-f a") - (kbd "C-c C-f s") (kbd "C-c C-f t") (kbd "C-c C-f w") - (kbd "C-c C-f x") (kbd "C-c C-f C-a") (kbd "C-c C-f C-b") - (kbd "C-c C-f C-c") (kbd "C-c C-f C-d") (kbd "C-c C-f C-f") - (kbd "C-c C-f C-k") (kbd "C-c C-f C-n") (kbd "C-c C-f C-o") - (kbd "C-c C-f C-r") (kbd "C-c C-f C-t") (kbd "C-c C-f C-u") - (kbd "C-c C-f ") ; (kbd "C-c C-f ") - (kbd "C-c C-j") (kbd "C-c C-l") (kbd "C-c C-n") - (kbd "C-c C-q") (kbd "C-c C-r") (kbd "C-c C-t") - (kbd "C-c C-u") (kbd "C-c C-v") (kbd "C-c C-w") - (kbd "C-c C-y") (kbd "C-c C-z") (kbd "C-c f") - (kbd "C-c h") (kbd "C-c m") (kbd "C-c n") - (kbd "C-c r") (kbd "C-c y") ; (kbd "C-c ") - )) - -;; Ensure that unwanted HTML mode bindings get shadowed. -(mapc (lambda (key) - (define-key lj-compose-body-mode-map key 'undefined)) - (list (kbd "C-c C-v"))) - -;;; `lj-compose' is the major interactive entry point into this file. - -;;;###autoload -(defun lj-compose () - "Compose a new LiveJournal post." - (interactive) - - ;; Create the composition buffer. - (switch-to-buffer (get-buffer-create "*LiveJournal*")) - - (unless (buffer-modified-p) - (delete-region (point-min) (point-max)) - (lj-compose-populate-buffer) - (goto-char (point-min)) - (lj-compose-header-mode) - (if (or lj-last-username lj-default-username) - (message-position-on-field "Subject") - (message-position-on-field "User")))) - -(defun lj-compose-populate-buffer (&optional values) - "Populate the current buffer as a LiveJournal post." - ;; Insert the essential headers. - (unless (hash-table-p values) - (setq values (make-hash-table))) - (insert "Server: " (or (gethash :server values) - lj-last-server - lj-default-server - "www.livejournal.com") - "\n" - - "User: " (or (gethash :username values) - lj-last-username - lj-default-username - "") - "\n" - - "Community: " (or (gethash :community values) "") "\n" - "Mood: " (or (gethash :mood values) "") "\n" - "Location: " (or (gethash :location values) "") "\n" - "Picture: " (or (gethash :picture values) "") "\n" - "Access: " (or (gethash :access values) "public") "\n" - "Subject: " (or (gethash :subject values) "") "\n" - "Tags: " (or (gethash :tags values) "") "\n") - - ;; Give the user an opportunity to add additional headers to the - ;; buffer. - (insert lj-default-headers) - (run-hooks 'lj-compose-init-headers-hook) - - (insert mail-header-separator) - (lj-compose-mark-separator) - (insert "\n") - - (insert (gethash :body values "")) - - ;; Give the user an opportunity to pre-populate the buffer in some - ;; way. - (run-hooks 'lj-compose-init-body-hook) - - ;; The user hasn't actually done anything to this buffer, so it - ;; shouldn't be marked as modified. - (set-buffer-modified-p nil)) - -(provide 'lj-compose) - -;;; lj-compose.el ends here diff --git a/emacs/external/ljupdate/lj-compose.elc b/emacs/external/ljupdate/lj-compose.elc deleted file mode 100644 index 3d77de555088f61bb717b4c120cbd58e2d96ff9b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 13873 zcwX&0k9!lxu}adWw)jxnw2vksb=C*2CCUliPZ`sGH4q383?z{Dwa9^!w6YFPcjA6n zIDPHk{$^%(?^d#8^U{9rwcq!Qy?3`eJ3BKwJ3BMG+_>}b_OEKSTK&e28|-#6nT8P` zvi>p4(r~zU@A3Yfhj*SnWl7BLrXjn_`>eAAzq_`-Yjv63>FiL?QJPHH2>P0Z>Y1dA$fwC*yt}I)*}^yU!Jnoe-2~ZX(}iITBHVyM>IBNu6h<*# z&Ixs!&4P>#)YOguLgSjjX9N?G0u~bDKl)Rz*PH$0oC5_z&WxVZ>A;`0*|V*V{IK;8 zNB?m34^RK_^^dOhVRiHmeH=?4$HH+sU4uPO`I{n4K~W<%0htDeoMk*7PJ%FED7Yfa zL6_kz7z}bIMH$c=s20IYu`1#@r;jwrlR-iaQE~`M1usP&MhDDp)i3QiJM0^t7ir9L zRL_1f8u4@+)H{d@&XN(kd;iYEFWR5in?pVdq7Wu)yP80A#Ph)zM&{9wU3%W6mlnv? zwru!w|1Mdyn0&FrjB9p4gMxH~!*gCb3NoL6&z zl}~vJ3rljioS{sBD26KCCYo2wnjsJy8ddG(0}+8CNRKak-kKA|Bu#QEK}kELSmXTEylUv?^osgv}90 z5OV-YmM?)2f-*rm(qP94nuaM)^N?o;%u%BDJWnnxmpvs}3Q5Dnr^hH$oOGdRE2Ssq zK*??TF&aqr30g)nh@Z+gYxAOfBU5O7hIa7xf50Vo8J3*o_C`>8@aLmItzX~VYkj@B zu?H2<$p)F)R%5RRT4mckoE~fACYCoZ+}zu^)u`TYYwurZ?{~EKyEyp9mw*day6wWB z*SK{H9)9CCKDv!B;Nf%{ckp2~?&8BB?m#~W`Z?aYTSQGqFz3+TU~Sw3 zzMP)zxHS#7+qhQ(t4g;cYi!UT+qE=!*Ah)Ff!Y;v+qf@K`;HFkH16M;hjs<@1A+#9 z)SCN}_H#fe4N4EiGx6_Ny!Na=LGj47?ZG3Y>NW=0Z%B~GygtE|3b{$PSKv5O2 ztAKI&=*^@;_^hr<;pf4fTIs#DbN7 zp)SvBf|~gbz21o)TI+#qM2l*DM`&KuK%|#s59=j-ZC?0N?-SG-UoN4nPrV1wh|eKn z=^0N-9!mUt4*v+g8lUxyjc03bRNY~%@eDUN=j-?Jb4=Yrs3ciiui)G1RPC>8()H6v ziE35XiRfC=5o4`=tRYV%a!|-`5pn!}g=vZueya$!XIj%6XexEna@s%bNynyu;Nb{& zdFf2h_6@NNmwWSDwrZO^!@rQbIy0UDGK1mPfFTxoe2AVwi}En2!u&n~wtO~J;UFz)p*SC?LqnxBUc3H*lAJAqDedBI+I{1Bxsco1?1!S#X%C z<~%q=su5?Ag@Y4FWhKPdlOhgt6aet`N;ppN@gy98-^5kFsrY>Hnjg=S6zRDcMc}(* zf4~RBN*{y#UYL<91V7igA#Q%^ZbfP8m>y-?-YP?i!E3f@Q;VQ#$HkCP4f7 z5P)HH0vZ)j1XGV@V~E3VWo=xjDXauAL}FTTu>yc3bPIGLz_bcZ!HT9$h_kGY^8T+| zJ1sQL6ajcUXGH*4DXQXc0VEu;tfcdd$N&OE9-Gun3k<=>?|46{$;fIkK9n)Vn*zGe z!g!d>fNn{)d;Pjyk!^W4dj=#ABhWaXL;^xe1mr%(J?Ft95G13S&&nRZxQBk`&w|c+E{1C?tiGI)yeRI%DW*kuwMiCqaz+u;`H= zFc$^u@38wL7AG;-lqkAN5(PXV*{Nj2&<07Ip!?t$1UUrc;ap~Ebs`DoRO_Y1+`KP2 zrHstlX31--WOmuO;Fe@yebEm|QZP~&{U3rgGv5>mm|sMXj445TwoEYqmrn{XsmR^S zrKq==jGT`#@vNntN{CbP3L@nGp3m{x{0-)d6HHS8n9QH80ee2J2Zt#UxC{d~_6dg2 zelK2EG4|5z5dPLhG)JRumn2 z#Srb&=N0szf1wExMnWm5Wq*8@xjrp0Ip0@7UN?ao+^gE1exCbOlPXdi74g*P9e zNV{w0yVaq0`$ogzz&~5_v32rIS zf0Ci2UPROZ>7*hH@${PS(qA1CV*IR1rrX;O2j$S9W>aP$f>ovY`?ONvX?j^UU2C8$LysX zO-H`nuHT3GiNP?0;3v>&udu0NRB$bW90K4zM0wd&Ftp_SGlWfMF%!&RtqTU2U;uqb z!KJ9!t=HL-owA&e?W-$Wb-@UybQPp7*6n(IHVz?LpMb+_f~~^?U6zdlaJ1*dxSfeD z2E(NxZ8}1Y>h=3ErbvVpgeU=AVJ40*kaIO5DDz2pI7XQqaa%zUp7Wfp77wPCK zx=HJ=VhDtwFhAe{Ku|QT4+~mZp>j585dvkszpj?#-&XB_x?Z2$0)=_}7_F4tnJnw) zXrDfkhKua4b5WdQkPRYJCz?u=c#cfjHbVL5(2kW>5KP&K^31b{fCAu#G1en7&su!-u07aI6c!fg?9y$8pZ}&_QU` z)$Py$gyY(Hx`6ComP5OAg0LyA>ySsmaWzw!zIjsZDHgAv542zNHPz06Ln5)TF{di7m%T9e0rAE>!H8=KtPWCSTtkc<=1rlD zBbjNH9HQwb&&3>u==PysZv6dPyS%_MOoI`o*dpy(0Qe+%F;#{X7-Yt}!KzyWOAj95 zIY~r4Q(F%uBd7&9K5-JMxsbSe5UZvXr|qWiVA+@ulwNhfeCZZ-yS}gT0srqB{qtO- z(m!447*!DefLnCyU)C+E*gL~1syz80>=IRD{SzIcG8v`3Aqdu1dP7y_>R-wgnwx|L zM`*c*o^*qj3-?qfsFKG2jR!Qpw0^k%Gbg^4-cO~#|E|8z#)Z!pd>@Bg9&~ub;cw-@ z2&d-9<-FYeXY`Hx_zvb4ymEZEe?M^K0L1$WrQ(XzG)7f#Wvjx}D%_VLf zc)CmbmUh()`N&qL))rP(b>VQysmJORQYDV+9K^C*%UYEWq8(rD{oa~#bCeU|t)Hk_ zTXZzM^+m_UmP=cCHGWUKn?);CyHBN- zhVY6I-Uh<^KX}y#uVh_TtRjg%qVsRl9gL;w(MN>uuw4 z<-%0A<{a%0eqrbU@>I+C;DaUA+A$eWFu;^I;1G#!dkyEyxpX#1IIKni9?#;(@PN4o zFz|Z@6hFq|!+^?+%ACp>m2asezz^T2@&hV=MCFH6o};osnh{|75`5#oC$Fdhw zIl_{_e~twK6D)yVz~Wa}e1gTNSX`to7spgis3cSuQ!0;*ca+ckw4NrN1Lo||O-P6S z>j89T0gL(U#9Cjq)U{P!F2PN;fqIN?IyP&3_+KhiAX8ADcXjC#&oJE0+B)ujTQ#)+ zX|IwW_GZN;>3>9K2;pM*w&jtxgCBDaXXOaYf_sios5vNo(?) zCes41=qq%~Rk4g%r!rA)!mqj@R9<$Ub=IsX0OR z+<6k+aF$0(KAmj1>vZD5ex@b><-SH1#s8Eh2OhmxKIe@h!uk^SYVDkO(9s1x$zUR^ zE%Dlxg!T1CTQ)kfaZhhlp`0fhALxy~Z0yR$XIi5p$8^+~7&@X=rbb6Ly0USs_mrGD zinFw8w0-L$s_yxLbiBx<%aoL?bJc$du-t)iBGKUErqjKocU0$j^I0Y_MNFx@ysf4w zd{uMyn$YTm&SvxXHONz|YSf*!U1pS5IdgYyLdFhL)%KJg;au(I9dqIY}c>{IwQc!vINi8>ORCkW(x){~a zeWRr=8-^81JSSYM1xICf@kStZuCAjmzv+U;a>c2#y;ItR9m^*lXPPEQAy^h|Rk!N@ E4dA+(B>(^b diff --git a/emacs/external/ljupdate/lj-custom.el b/emacs/external/ljupdate/lj-custom.el deleted file mode 100644 index 50da4e0..0000000 --- a/emacs/external/ljupdate/lj-custom.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; lj-custom.el --- Custom declarations for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(defgroup ljupdate nil - "Emacs LiveJournal client." - :group 'processes - :prefix "lj-" - :link '(url-link "http://edward.oconnor.cx/ljupdate/") - :link '(url-link "http://community.livejournal.com/ljupdate/")) - -(defcustom lj-cache-dir "~/.ljupdate" - "Directory in which ljupdate saves cached server information." - :group 'ljupdate - :type '(directory)) - -(defcustom lj-cache-login-information nil - "If non-null, ljupdate will cache the md5 hashes of your paswords. -You might enable this if you don't want to have to log in each time. -However, be warned that ljupdate won't try to update its other cached -information (your friends groups, your journal access list, etc.) if -this is enabled." - :group 'ljupdate - :type '(boolean)) - -(defcustom lj-fill-function 'lj-fill-by-paragraph - "We use this function to fill your post contents before sending. -When this function is called, the buffer is narrowed to the body. -Set this to `ignore' to send article contents to the server unaltered. -See `lj-fill.el' for several possible values, or write your own!" - :group 'ljupdate - :type '(choice (const :tag "Raw (don't fill)" ignore) - (const :tag "Default (by paragraph)" lj-fill-by-paragraph) - (const :tag "Pipe through shell command" - lj-fill-by-shell-command) - (function))) - -(defcustom lj-fill-by-shell-command-command "cat" - "Shell command to pipe your LiveJournal post through. - -Your post will be filtered through this command. The output is what will -actually be posted to your LiveJournal. - -This only has an effect when you use \"Pipe through shell command\" as your -Lj Fill Function, above." - :group 'ljupdate - :type '(string)) - -(defcustom lj-default-server "www.livejournal.com" - "LiveJournal server to use by default in various contexts." - :group 'ljupdate - :type '(string)) - -(defcustom lj-default-username nil - "Username to use by default in various contexts." - :group 'ljupdate - :type '(choice string (const nil))) - -(defcustom lj-compose-common-hook nil - "Normal hook run by `lj-compose-header-mode' and `lj-compose-body-mode'. -Note that this hook will be run each time your cursor moves from the headers -to the body and vice-versa." - :group 'ljupdate - :type 'hook) - -(defcustom lj-compose-init-headers-hook nil - "Hook to be run after headers have been added to a composition buffer. -Use this hook to insert additional headers into the buffer. The point is -left after the end of the headers." - :group 'ljupdate - :type 'hook) - -(defcustom lj-compose-init-body-hook nil - "Hook to be run after a new composition buffer has been initialized. -Use this hook to insert initial contents into the body of the post. The -point is left at the beginning of the body." - :group 'ljupdate - :type 'hook) - -(defcustom lj-compose-pre-prepare-body-hook nil - "Hook run by `lj-compose-prepare-body' before running `lj-fill-function'. -The buffer is narrowed to the body when this hook is run." - :group 'ljupdate - :type 'hook) - -(defcustom lj-compose-post-prepare-body-hook nil - "Hook run by `lj-compose-prepare-body' after running `lj-fill-function'. -The buffer is narrowed to the body when this hook is run." - :group 'ljupdate - :type 'hook) - -(defcustom lj-default-headers "" - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines." - :group 'ljupdate - :type 'string) - -;; FIXME: use -(defcustom lj-default-access-level "public" - "Current possible values are ``public'', ``private'', and ``friends''." - :group 'ljupdate - :type '(choice (const :tag "Public (anyone)" "public") - (const :tag "Private (you only)" "private") - (const :tag "Friends-only" "friends"))) - -;; FIXME: use -(defcustom lj-allow-comments "yes" - "Whether or not comments on your posts are allowed by default." - :group 'ljupdate - :type '(choice (const :tag "Allow comments" "yes") - (const :tag "Disallow comments" "no"))) - -;; FIXME: use -(defcustom lj-default-mail-notification "yes" - "Non-nil if you should receive comment notification email by default." - :group 'ljupdate - :type '(choice (const :tag "Receive Mail Notification" "yes") - (const :tag "Do Not Receive Mail Notification" "no"))) - -(provide 'lj-custom) - -;;; lj-custom.el ends here diff --git a/emacs/external/ljupdate/lj-custom.elc b/emacs/external/ljupdate/lj-custom.elc deleted file mode 100644 index 0489d06520c9c0b878f4c13fcc7302be8766761f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 5137 zcwWU=-*4MS63*-KAGpVxss~6aOxltyTT%+NK^h}1(p+$9QS>b{vX#odef_T= zU%h$t{yiB@_m!f1xuB~l{?5m@^YImpudb$Eb6J@+Eul;4{PJfjD|^WXF5gw=qfDK> z%#7pL_EN4zYA=hAb(sk#@g+`c>&!Zlg}0IDpM)JFbb>Pm}((n3k?k{-<)g|ad!oJJt$B`8;) zs0YXJzEJu%>JRFwi2c`I?p!&)yp-8iR9RwDqqV7$^wUF@^@g8U12^khE4NDu!1);9 zBzU^7K8(Kn_I6C)sS4R_svRfKHdkp*onKaLfHf6q4xUi~h!Uhg_}V9F@{d0;vk{dN z3#4nGBgTqxrYh?9{&ShMW_y7AF8$Ianl_-ce@h$gRBMSk&b6$`hH2;=vdc9 zaq$3ht57@sD029>&L)%#n*+F6(hj~;DeTr%8EWcRQ`1_laz|2on2zg9c{vo7?mOg` zcH|6fY$SgcX2r}%96+c~nMAM6R)UEOTHtU|X>j9m;r0-DLk^Tezj>w{@Bm-c&>8LV zNCOXZSs`6AOP&xEwtv_Jk3`CuLxr;Lf}~56Az()VzHPk8&I<@UQaav0zt0KW1Z6gz zoCwOom_iC2LUMaYzxc)!Xk6Ah_2%I9l7kY+H|S2tUx!k#pbV!XvEV3LKob3uOMRfN zIO7Utf=>Iv86%CUp71JQD9>DSnNBw6m{Xy zuy@oQ3*lpE4piT%lEVy4tDI0>Tyy9$X#bDY{hPRX0~4*w!zN>9^nPEL<599@&*OgY z^l8(ahgtY*mrB0eQF%Dghpq$Vlc2Gi5GJQ2Q@gTuoI6`CP*#mZ>T0Cdj%~2PkWYu_ z<48YxjfN!J2??|SBw`9HoU+_6IPp*N0yVZ9z4=J@jQYMI6r zu4|>E+2ra(&V-5UV=$RL;<>2=Zd7mwd66|af}Y1{Ol?E;d~)_Fz>R9$*zEVV+wI{5 z>JX2wukX%7d^00nzp(kp|1ZwEwYuN`#*@*h2G~?zfY+7?)I)-g?xysX+iF3%F~3n& zYsTu=7wjv>$~c!IlU2Mn8Tu3la{nc_wD2m4-Wn&vVDXvl?X}6zcDsobk~gg@i?*~j zJhJ`n%8f3ZW~059=?~q&3BPoSr^srdao%D0dKi!Rx}BbgBZ~)OX7rj>0i?k%mZ;wr zU>LUxiP8$2EaU`*vz70eVGbnG&+WL$8*@q{jD7+3f=qp5Q|Z?2pzC`=Y48{=Au8n3 zH6U1q#|0LKJ<`r)Mq$%x!fKE3GrK*}%{zXkljHmd(sFx*2;Y=EUwph0h5DVx*yq@3 zgdPUr12>!!jpN)8Jxfu`5(SoA5S3UQH0OOI?Bzr)oR<9=mWZjDu0tRxox?|l+? zLQQ7y^p#ZQwD%{8LmKNo7aTHrdqkqA^T z81GQuj8BE^=r;P!Tj2j2*cmOcU$!<6cgg_WUw{0j zxJdZh6@sRX^E;UDb4EX0LjrwR{(Rm)><~{8m@7yr@1GWyuM*si- diff --git a/emacs/external/ljupdate/lj-edit.el b/emacs/external/ljupdate/lj-edit.el deleted file mode 100644 index f139941..0000000 --- a/emacs/external/ljupdate/lj-edit.el +++ /dev/null @@ -1,322 +0,0 @@ -;;; lj-edit.el --- post editing for ljupdate -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor -;; Copyright (C) 2006 Paul Huff - -;; Author: Edward O'Connor -;; Author: Paul Huff -;; Keywords: convenience - -;; This file is an addition to ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: -(require 'cl) -(require 'message) -(require 'sendmail) - -(require 'lj-compose) -(require 'lj-custom) -(require 'lj-acct) -(require 'lj-fill) -(require 'lj-pcomplete) -(require 'lj-protocol) -(require 'lj-login) -(require 'lj-util) - -(defun lj-edit-post (&optional edit-itemid) - (interactive) - (message (if edit-itemid - (concat "Editing id: " edit-itemid) - "Editing last post.")) - (let* ((edit-server (or lj-last-server lj-default-server - "www.livejournal.com")) - (edit-username (or lj-last-username lj-default-username "")) - (edit-request (list '("mode" . "getevents") - '("auth_method" . "challenge") - '("ver" . "1") - '("selecttype" . "one") - (cons "itemid" (if edit-itemid - edit-itemid - "-1")) - )) - (edit-challenge (lj-getchallenge edit-server))) - (when (string= edit-username "") - (setq edit-username (read-from-minibuffer (format "Username @%s: " edit-server)))) - (add-to-list 'edit-request (cons "user" edit-username)) - (add-to-list 'edit-request (cons "auth_challenge" edit-challenge)) - (add-to-list 'edit-request - (cons "auth_response" - (lj-md5 (concat edit-challenge (lj-password edit-server edit-username))))) - (let ((edit-response (lj-protocol-send-request edit-server edit-request))) - (with-output-to-temp-buffer "lj-list" - (set-buffer "lj-list") - ;; (lj-list-props response) - (if (not (eq (get-buffer "*LiveJournal*") nil)) - (kill-buffer (get-buffer "*LiveJournal*"))) - (lj-compose) - (goto-char (- 1 (lj-compose-find-separator))) - (lj-add-props edit-response edit-server edit-username) - (goto-char (+ 1 (lj-compose-find-separator))) - (insert (replace-regexp-in-string "\r" "" (decode-coding-string (string-make-unibyte (lj-html-decode-string (gethash "events_1_event" edit-response))) lj-coding-system))) - )))(delete-windows-on "lj-list")) - -(defun lj-add-prop (prop value) - (let ((found-field (message-position-on-field prop))) - (beginning-of-line) - (re-search-forward (concat "^" (regexp-quote prop) ":") nil t) - (kill-region (point) (line-end-position)) - (insert (concat " " value)))) - -(defun lj-add-props-helper (response n) - (if (> n 0) - (progn - (let ((prop_name (gethash (concat "prop_" (number-to-string n) "_name") response)) - (prop_value (gethash (concat "prop_" (number-to-string n) "_value") response))) - (cond ((string= prop_name "current_mood") (lj-add-prop "Mood" prop_value)) - ((string= prop_name "current_music") (lj-add-prop "Music" prop_value)) - ((string= prop_name "taglist") (lj-add-prop "Tags" prop_value)) - ((string= prop_name "picture_keyword") (lj-add-prop "Picture" prop_value)) - ((and (string= prop_name "opt_nocomments") (string= prop_value "1")) - (lj-add-prop "Allow-Comments" "no")) - ((and (string= prop_name "opt_noemail") (string= prop_value "1")) - (lj-add-prop "Receive-Mail-Notification" "no")) - )) - (lj-add-props-helper response (- n 1))))) - -(defun lj-add-props (response edit-server edit-username) - (let ((subject (gethash "events_1_subject" response))) - (when subject - (lj-add-prop "Subject" subject))) - (let ((time (gethash "events_1_eventtime" response))) - (when time - (lj-add-prop "Time" time))) - (let ((itemid (gethash "events_1_itemid" response))) - (when itemid - (lj-add-prop "Itemid" itemid))) - - (let* ((access (gethash "events_1_security" response)) - (allowmask (gethash "events_1_allowmask" response))) - (if (stringp access) - (cond ((string-match "public" access) - (lj-add-prop "Access" "public")) - ((string-match "private" access) - (lj-add-prop "Access" "private")) - ((string-match "usemask" access) - (if (eq (truncate (log (string-to-number allowmask) 2)) 0) - (lj-add-prop "Access" "friends") - (lj-add-prop "Access" (car (rassoc (truncate (log (string-to-number allowmask) 2)) (lj-user-get edit-server edit-username :friends-groups))))))))) - (lj-add-props-helper response (string-to-number (gethash "prop_count" response)))) -;;;###autoload -;; (defun lj-edit-submit () -;; "Submit this entry to the server." -;; (interactive) -;; (let* ((buf (current-buffer)) -;; ;; The text of the entry. -;; (event (lj-compose-prepare-body)) - -;; ;; Some convenience variables for oft-used headers -;; (server (lj-compose-fetch-field "Server")) -;; (user (lj-compose-fetch-field "User")) -;; (itemid (lj-compose-fetch-field "Itemid")) -;; ;; The current time -- or use the specified time if it exists -;; (time (lj-compose-fetch-field "Time")) -;; (timestamp (if (eq nil time) -;; () -;; (date-to-time (concat time " " (cadr (current-time-zone)))))) - -;; (time (split-string (format-time-string "%Y:%m:%d:%H:%M" timestamp) "[:]")) -;; (year (pop time)) -;; (month (pop time)) -;; (day (pop time)) -;; (hour (pop time)) -;; (minute (pop time)) - -;; ;; LJ Authentication information -;; challenge - -;; ;; The actual request packet, and the response we receive from -;; ;; the server. -;; (request (list '("mode" . "editevent") -;; '("auth_method" . "challenge") -;; '("ver" . "1") -;; (cons "itemid" itemid) -;; (cons "year" year) -;; (cons "mon" month) -;; (cons "day" day) -;; (cons "hour" hour) -;; (cons "min" minute) -;; (cons "event" event)))) - -;; ;; Build up the request packet. -;; (add-to-list 'request (cons "user" user)) - -;; (let ((subject (lj-compose-fetch-field "Subject"))) -;; (when subject -;; (add-to-list 'request (cons "subject" subject)))) -;; ;; FIXME: use moodid if available -;; (let ((mood (lj-compose-fetch-field "Mood"))) -;; (when mood -;; (add-to-list 'request (cons "prop_current_mood" mood)))) - -;; (let ((tags (lj-compose-fetch-field "Tags"))) -;; (when tags -;; (add-to-list 'request (cons "prop_taglist" tags)))) - -;; (let ((music (lj-compose-fetch-field "Music"))) -;; (when music -;; (add-to-list 'request (cons "prop_current_music" music)))) - -;; (let ((community (lj-compose-fetch-field "Community"))) -;; (when community -;; (add-to-list 'request (cons "usejournal" community)))) - -;; (let ((picture (lj-compose-fetch-field "Picture"))) -;; (when picture -;; (add-to-list 'request (cons "prop_picture_keyword" picture)))) - -;; (let ((comments (lj-compose-fetch-field "Allow-Comments"))) -;; (when (and comments (string-match "[Nn][Oo]" comments)) -;; (add-to-list 'request '("prop_opt_nocomments" . "1")))) - -;; (let ((email (lj-compose-fetch-field "Receive-Mail-Notification"))) -;; (when (and email (string-match "[Nn][Oo]" email)) -;; (add-to-list 'request '("prop_opt_noemail" . "1")))) - -;; (let* ((access (lj-compose-fetch-field "Access")) -;; (friends-group-number -;; (cdr (assoc access (lj-user-get server user :friends-groups))))) -;; (if (stringp access) -;; (cond ((string-match "public" access) -;; (add-to-list 'request '("security" . "public"))) -;; ((string-match "private" access) -;; (add-to-list 'request '("security" . "private"))) -;; ((string-match "friends" access) -;; (add-to-list 'request '("allowmask" . "1")) -;; (add-to-list 'request '("security" . "usemask"))) -;; (friends-group-number -;; (add-to-list 'request (cons "allowmask" -;; (lj-exp2 friends-group-number))) -;; (add-to-list 'request '("security" . "usemask"))) -;; (t -;; (warn "Unable to understand Access: %s; presuming private.") -;; (add-to-list 'request '("security" . "private")))) -;; (add-to-list 'request '("security" . "public")))) - -;; ;; Actually talk to the LJ server. -;; (message "Connecting to `%s' as `%s'. Please wait." server user) -;; (setq challenge (lj-getchallenge server)) - -;; (add-to-list 'request (cons "auth_challenge" challenge)) -;; (add-to-list 'request -;; (cons "auth_response" -;; (lj-md5 (concat challenge (lj-password server user))))) - -;; (message "Submitting to `%s' as `%s'. Please wait." server user) - -;; (let ((response (lj-protocol-send-request server request))) -;; (set-buffer buf) ; return to the *LiveJournal* buffer -;; (if (and (hash-table-p response) -;; (string= (gethash "success" response) "OK")) -;; (progn -;; (set-buffer-modified-p nil) -;; (message "Successfully posted as %s." (gethash "url" response)) -;; t) -;; (let ((errmsg (gethash "errmsg" response))) -;; (if errmsg -;; (message "Posting to %s failed: %s" server errmsg) -;; (message "Posting to %s failed!" server))) -;; nil)))) - -(defun lj-html-decode-string (string) - (interactive) - (let ((string (replace-regexp-in-string "%\\([0-9A-F]\\{2\\}\\)" (lambda (match) (char-to-string (string-to-number (substring match 1) 16))) string))) - (replace-regexp-in-string "+" " " string))) - -(defun lj-list-props (response n) - (interactive) - (if (> n 0) - (progn - (insert (gethash (concat "prop_" (number-to-string n) "_name") response)) - (insert "\t") - (insert (gethash (concat "prop_" (number-to-string n) "_value") response)) - (insert "\n") - (lj-list-props response (- n 1))))) - -(defun lj-insert-entry-into-entry-list (hash n) - (lexical-let* ((event_string (concat "events_" (number-to-string n))) - (event_subject (concat event_string "_subject")) - (event_time (concat event_string "_eventtime")) - (event_itemid_string (concat event_string "_itemid")) - (event_itemid (gethash event_itemid_string hash)) - (button_start -1) - (button_end -1) - (which_event n)) - (if (<= n (string-to-number (gethash "events_count" hash))) - (progn - (insert-button (concat (gethash event_time hash) " - " - (if (gethash event_subject hash) - (gethash event_subject hash) - "(no subject)")) 'action (lambda (event) (lj-edit-post event_itemid))) - (insert "\n") - (lj-insert-entry-into-entry-list hash (+ n 1)))))) - -(defun lj-get-last-n (n) - (let* ((server (or lj-last-server lj-default-server - "www.livejournal.com")) - (username (or lj-last-username lj-default-username "")) - (request (list '("mode" . "getevents") - '("auth_method" . "challenge") - '("ver" . "1") - '("selecttype" . "lastn") - (cons "howmany" (number-to-string n)))) - (challenge (lj-getchallenge server))) - (when (string= username "") - (setq username (read-from-minibuffer (format "Username @%s: " server)))) - (add-to-list 'request (cons "user" username)) - (add-to-list 'request (cons "auth_challenge" challenge)) - (add-to-list 'request - (cons "auth_response" - (lj-md5 (concat challenge (lj-password server username))))) - (let ((response (lj-protocol-send-request server request))) - (with-output-to-temp-buffer "lj-list" - (set-buffer "lj-list") - (lj-insert-entry-into-entry-list response 1) - (print-help-return-message))))) - -;;;###autoload -(defun lj-browse-entries () - (interactive) - (lj-get-last-n 10)) - -;;;###autoload -(defalias 'lj-edit-last 'lj-edit-post) - -(provide 'lj-edit) - -(provide 'lj-edit) - -;;; lj-edit.el ends here diff --git a/emacs/external/ljupdate/lj-edit.elc b/emacs/external/ljupdate/lj-edit.elc deleted file mode 100644 index 9d49873de5e0619103c0580d4de9348895f81cd4..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 6585 zcwW6&ZFAek5$2c9NaBcJJarN~mXF8SqTGPOD{0Bi)Q&B;b?rupolYkPtAM~!gbe~T z0E%VP{P*te-GLw_C6h@fwrSkH+}+;Z?z4CI=;Y`zaqXO?dcKFh+%@v+uq8#MI6KV50M0gfwX8`E+!oWmqLq$=_pX5rtjJi5;oLBT@3 zsbdh=mdt=mU<+~>f;{+Z|LpASbVtil7-1F(#(l>$;b*md+cFhl*9oUixOKv-6a6|d zs1cS~C+hQ9^?59u#~g6>HWwe}aSkDxuqik+I2WuCX*3Pugn`%4QCT6VIWI~GXlMmt zSmGA~iogm<*sW7&+y1ywEp{6i{f`=cs=l!9+x{4dc4Jq5aQS;Z zTsQn&_<8W_!*4(%n+^Qf7U2v95&2-Gx;bo=;Kf84Z|2s{Xf}gf49mj39Zu)!=o1Smm^!=b@ z*cW!(am_El9v6RLl515Wwau>0R0Aw^UH08bkzUJ$2|J2%*&8i@?(Trr>UcnVFr3=nu|n+~Sh#?kf%MQH%;L3SdETR%@K4k@psqzovP14N0s zdd1W6$xomsAOMS_W5!n`j=(UQdca&P7QH0C5bv@%^iFyZqQK>>%cqcuob?z#hlsrp zX<6_CU@^6Wo9HXEQs8MSt@|w=nR;Fj9po% z7`Z5Bfc=7IpGF>~V^9=}ERX7`X<&x0#zg1COq_wihO&%5cnQvXA)WVtvlQUqJ*2yq z*Py|w5daA=av^3x9+VlW;aXtgSphDXB|#`);&buunGvUkL~_P=Ig11$B*G+OyAmj* zp9b%RF$b?LCB#h1X=11jN)t?<1jU4Lxua*+88vWR1SVqvc4dpgfEqy#t%8cE)ix<_ zOFznmNrRRJ?Cy|RCbrW??sTzg#<8XtNjTAx=KmYLr^0$Ya@((jhKa* zr?S#=zDJy58V~@k($nxjWf=`V#+nK47D*&0(&>SC8Y7UxT9tex0ESasMmC16PB9u` zlY%^)7!ZPs0K$X+i!-$`ALbeOnIFqtFXg_23=1swHZXehESP{p=3eWK!kCC;1`z{Z zsr(AHoo}H({sBw!er#Ofk!_z};#$bP1ug-6uR(IRQ2~3ZJO*ICXf(-jN~y1v`j?dk zTIrcm0>s@^Ld26w-)JTKvXY~f##oM^K-6g2Ny7g|x5|LUMz@9P=9sH)53qP_Z@or} z;vr>~W6|ShG90K$A#Sd+gP5?d^XW+B2r)VXNfWkGc7{ec&vQtivuTESSPyUhidZX+ zc@c*|zf#{aIG1q3-vs9cd}eW2&U110UMvxbfO9H2(1MzOmI5YCrv$_Zu#7)Rl5Al- zT`|+FQWbbI0qPqO3P3316_Cc?voapXAsv0!jMdRMWc}+SbS*UNRcQ?=)JcSbkv78m z1b3)K=MW6eZMi)MQp>WH)-BY!qqQ6zGg{46YPV7CbFJnz*R|jP#6MMSoc@kKeuN!B z$E8CH1?ZSU!ugvTg^nrKD%R@Cj#mDzuIyZ`>}qArtWG<-ZHi5f9}CYT&P8oJ$G$XP zC33DC#%-|{e!Y&*AFm=FJb-yZE^yEV?JEAOy({J;yjU@~2MMN*A#hd&T*M1fwwMOR z`ztDi>b4Q(uQhk0q~PEf+wxP%s^b4w-B^t;AXVaWS?5*u@Kuq6(*h*Re3VccJt4y} zee(DMt|Xj_zwA=x^Aw^T3RG4VNl0dy*35>C=i@vEn1=p2900PA4&e~Vcqn1VN@$$t z*&O2kD!7(V5ki##7hIbZLw0m2udb-hkYKVUlL$&31O!&a&c}*$5$v}*y2Pn|*Pj^f z`F{7UX&gNlGm#@}6JeooaEh;}pm2Ryl@5o}UkAcV&a|iqTKysO zhK&D#t9p0sDFC7G3Ruw<&!&pE-_SPEvfCKeSldE%JQ(Q4nvSfBN@Q8OVP8`VehKVv z*P-8+7`j@?PpvnGsqzwz1ZBPi0>+k2I=g}g$bhs4o_Ia6KCVEsefmN_ntJ?ji2g`EsVc`D@d=z(n6HgQQWxNP*hvp<~EGwtGqJcI#iZf3LS%-rZ%h^7thHCjj))+;Y7}i zoJ%O97pU-7C6yco5XV5&>86>kZ~$~cNT=^4n2w@=b?@hRl_S?;%PXgKrf^KlC7VUoE9U*(aIjf z*BwJ`;Lkqd{F3*Zs_~mX&Y)c>KF>_>z?Ckqz>xpjTg`9tO!IS@V!_=HcyyA3?r_se z4gGeOvidTm9Ygl;QYMV@Y*7drH5Pc3!TMi+zSiMUOBu_A{H`Aqu6X#yBan_YdAezD c5HxUQi$)K6+p9wf-fu7BNNDDeIR`uc1FcM*UH||9 diff --git a/emacs/external/ljupdate/lj-fill.el b/emacs/external/ljupdate/lj-fill.el deleted file mode 100644 index a16aad4..0000000 --- a/emacs/external/ljupdate/lj-fill.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; lj-fill.el --- various filling methods for livejournal posts - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; -;; The intent is for several different filling methods to live here. -;; Currently, there are only two recommended values of -;; `lj-fill-function': `lj-fill-by-paragraph' and `ignore'. -;; Read the `lj-fill-function' doc string for more. - -;;; History: -;; - -;;; Code: - -(require 'lj-custom) - -(defvar lj-fill-by-paragraph-fill-column 10000 - "*Value to be used for `fill-column' by `lj-fill-by-paragraph'.") - -(defvar lj-fill-flush-empty-lines-flag t - "*Non-nil means that `lj-fill-by-paragraph' will remove blank lines.") - -(defvar lj-fill-inter-paragraph-newline-count 2 - "*How many newlines to use in between paragraphs. -Yuo probably want this to be at least 1.") - -(defun lj-fill-by-paragraph () - "Fills your LiveJournal post while assuming you wrote text with auto fill. - -Assumes that consecutive non-blank lines are paragraphs, unfills them, -and kills any extra blank lines. If your posts are predominately text, -with little to no markup, this is probably the behavior you will like. - -This is like the default filling behavior of the old ljupdate code. If -you didn't like it then, you won't like it now. You may want to fiddle -with the values of `lj-fill-by-paragraph-fill-column', -`lj-fill-flush-empty-lines-flag', and/or -`lj-fill-inter-paragraph-newline-count' in order to produce the sort of -behavior you'd like this function to exhibit. Or, you may change the -value of `lj-fill-function' to a function more to your liking (e.g. -`ignore')." - ;; Fill paragraphs - (goto-char (point-min)) - (let ((fill-column lj-fill-by-paragraph-fill-column)) - (fill-paragraph nil) - (while (zerop (forward-paragraph 1)) - (fill-paragraph nil))) - ;; Kill blank lines - (when lj-fill-flush-empty-lines-flag - (flush-lines "^$" (point-min) (point-max))) - ;; Restore paragraph separation - (goto-char (point-min)) - (let ((newlines (make-string lj-fill-inter-paragraph-newline-count ?\n))) - (while (search-forward "\n" nil t) - (replace-match newlines)))) - -(defun lj-fill-by-shell-command () - "Filters your LiveJournal post through a shell command." - (shell-command-on-region (point-min) (point-max) - lj-fill-by-shell-command-command t)) - - -(provide 'lj-fill) -;;; lj-fill.el ends here diff --git a/emacs/external/ljupdate/lj-fill.elc b/emacs/external/ljupdate/lj-fill.elc deleted file mode 100644 index eadb4d99f9f784a4fd172200b6c15f99dbc81e37..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 2439 zcwVJdZExE)5YER|`vKd40lPW{WM`Hw$%*qeU@eLi-O#NA+6^e`4xz=f#fBm^lCtam z`W-3TvAeV#Fxj$1-rIA}9nY6n&!2pKaBvV^US7fzUDZM&hv^Ee5&Y4!7r$OTzk2x+ zw1THbz*C$;dPd)ie0-7Tkf-Tcu$&oP!HjI7xETIn(b%DPF#O%ws}iDQ+WW=Y#xw5Ou{2x=eBCPIaSr4RJu4tbz2R z`_TQ7Gz`vQPXgU6fv!X~Cvf{Vy&nAZI9O`)vGZCN<;BHD6Fyp#jla4r^n{4B^+#bl z0eFXkL_rmep(vf}TSjA8G7H6~s527pqztr_R02aT0)zkeilV4%@b5+#gqTnijdi-} zMTd{Z$8hu~lMRB?FbxH2;aq#9Nugy^sn~bj27NMJB{ef_ZdhH$gYTm*$Jv4r;ydKY zju*&Mx}bab5C)KpvvDr~IESO(v`UnaP$5$mT*=%gqEVYsiy5r+0%0ndx&bK^+B;Cp zWMj(&tJRd?uF2PB3X@{(`Bot=&XxYOe^cuIB_R=P3p zTrBVxdQnV5ttrH^^oNRB+f>wxUI~^)J1Qo=ck46R5UkL3QS{g=;+o-t&LdHYO;h(;+hY&xmEmZE5*Kbwc%(yG~$srMN5v=#u2D!m(G}P$n$f$QH3Ag z-VooHVk+DKUYM2#pKwt!H4o0BkmFv88|&Dcvs-7CHlfO)FDRI=OBV<8L3AzViiB}* zeO#CnG#cZ(ID^ACeoS<5I?1#2-nWxcdP4X3fnU15=eS@wW-($O~u`wDrQ-#_S0 zl$RZnEX(O0AwTre)+cQoe?>nhlg@Ya7}I^~9ZW`fN^0rJ1=;1h@ql(~uYFN3_=w?n632cdUeCgkh zhA#hP*@ITH*4mVwijg6|N00pBzj@y?*_!U}(x@{y4-NhnPS$DUc|P`Obm^!p1jj9q GUi1&AULI%w diff --git a/emacs/external/ljupdate/lj-login.el b/emacs/external/ljupdate/lj-login.el deleted file mode 100644 index 6fe8ab2..0000000 --- a/emacs/external/ljupdate/lj-login.el +++ /dev/null @@ -1,212 +0,0 @@ -;;; lj-login.el --- lj protocol login support for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'cl) - -(require 'lj-compat) -(require 'lj-custom) -(require 'lj-acct) -(require 'lj-protocol) -(require 'lj-util) - -;; from ljupdate.el -(eval-when-compile (defvar lj-client-version)) - -(defvar lj-last-server nil - "The last LJ server we used during this Emacs session.") - -(defvar lj-last-username nil - "The last LJ username we used during this Emacs session.") - -(defun lj-process-login-response (server username info) - "Process SERVER's login information returned when we logged in as USERNAME. -Argument INFO is the bundle of values returned by the server." - - (let ((name (gethash "name" info)) - (access-count (lj-number (gethash "access_count" info 0))) - (pickw-count (lj-number (gethash "pickw_count" info 0))) - (frgrp-maxnum (lj-number (gethash "frgrp_maxnum" info 0))) - (mood-count (lj-number (gethash "mood_count" info 0))) - (message (gethash "message" info))) - - (when message - (message "%s" message) - (sit-for 2)) - - (when name - (lj-user-put server username :name name)) - - (let ((access-list '())) - (dotimes (access-num access-count) - (let ((name (gethash (format "access_%d" (1+ access-num)) info))) - (push name access-list))) - (lj-user-put server username :access access-list)) - - (let ((pickw-list '())) - (dotimes (pickw-num pickw-count) - (let ((name (gethash (format "pickw_%d" (1+ pickw-num)) info))) - (push name pickw-list))) - (lj-user-put server username :pics pickw-list)) - - (let ((frgrp-alist '())) - (dotimes (frgrp-num frgrp-maxnum) - (let ((name (gethash (format "frgrp_%d_name" (1+ frgrp-num)) info)) - (sort (gethash (format "frgrp_%d_sortorder" (1+ frgrp-num)) info))) - (when name - (push (cons name (1+ frgrp-num)) frgrp-alist)))) - (lj-user-put server username :friends-groups frgrp-alist)) - - (let ((mood-max (or (lj-number (lj-server-get server :mood-max)) 0)) - (mood-alist (lj-server-get server :moods))) - (dotimes (mood-num mood-count) - (let ((name (gethash (format "mood_%d_name" (1+ mood-num)) info)) - (id (lj-number (or (gethash (format "mood_%d_id" (1+ mood-num)) info) - 0)))) - (when (> id mood-max) - (lj-server-put server :mood-max id)) - (push (cons name id) mood-alist))) - (lj-server-put server :moods mood-alist)))) - -(defun lj-attempt-login-once (server username password) - "Try to log in to SERVER with USERNAME and PASSWORD. -Returns a boolean indicating whether or not the login attempt succeeded. -PASSWORD is the downcased MD5sum of the user's password." - (message "Logging into `%s' as `%s'. Please wait." server username) - - (let ((challenge (lj-getchallenge server))) - (let* ((auth-response (lj-md5 (concat challenge password))) - (response - (lj-protocol-send-request - server - `(("mode" . "login") - ("ver" . ,(if (eq lj-coding-system 'utf-8) - "1" - "0")) - ("clientversion" . ,lj-client-version) - ("user" . ,username) - ("auth_method" . "challenge") - ("auth_challenge" . ,challenge) - ("auth_response" . ,auth-response) - ("getmoods" . ,(format "%s" - (or (lj-server-get server :mood-max) - 0))) - ("getpickws" . "1"))))) ; get userpics - (if (hash-table-p response) - (cond ((string= (gethash "success" response) "OK") - (lj-process-login-response server username response) - t) - ((string= (gethash "success" response) "FAIL") - (message "Logging into `%s' failed; error message is `%s'." - server (gethash "errmsg" response)) - nil) - (t - (message - "Logging into `%s' failed (empty response); please try again later." - server))) - (message "Logging into `%s' failed (null response); please try again later." - server) - nil)))) - -(defun lj-attempt-login (server username explicit-login) - "Attempt to log into SERVER (as USERNAME) once. - -If EXPLICIT-LOGIN is non-nil, the user has requested this login -explicitly, so we message useful feedback to the echo area." - (let ((tries 0) - (logged-in nil) - (password nil)) - (while (and (not logged-in) (< tries 3)) - (setq password - (lj-md5 (read-passwd - (format "Password for %s@%s: " username server)))) - (setq tries (+ tries 1) - logged-in (lj-attempt-login-once server username password))) - (if logged-in - (progn - (setq lj-last-username username - lj-last-server server) - (lj-user-put server username :password password) - (when explicit-login - (message "Successfully logged in as %s@%s." username server)) - password) - (when explicit-login - (message "Login failure for %s@%s." username server) - nil)))) - -(defun lj-read-server () - "Read a server name from the user." - (let ((guess (or lj-last-server lj-default-server "www.livejournal.com"))) - (completing-read "Server: " - (mapcar (lambda (item) (cons item item)) - (lj-servers)) - nil nil guess nil guess nil))) - -(defun lj-read-username (&optional server) - "Read a username (of SERVER, if supplied) from the user." - (completing-read "Username: " - (mapcar (lambda (item) (cons item item)) - (lj-users (or server - lj-last-server - lj-default-server))) - nil nil lj-default-username nil lj-default-username nil)) - -(defun lj-read-server-username-pair () - "Read a server and a username at that server from the user." - (let ((server (lj-read-server))) - (list server (lj-read-username server)))) - -;;;###autoload -(defun lj-login (server username) - "Logs into SERVER as USERNAME, and return the md5sum of USERNAME's password." - (interactive (lj-read-server-username-pair)) - (or (lj-user-get server username :password) - (lj-attempt-login server username (interactive-p)) - (error "Unable to log into %s as %s" server username))) - -;;;###autoload -(defun lj-logout (server username) - "Logs off of SERVER (as USERNAME)." - (interactive (lj-read-server-username-pair)) - (lj-user-rem server username :password)) - -;; Internally, I call this to get the password for the given user@host. -;; So let's make code calling this easier to read. -;;;###autoload -(defalias 'lj-password 'lj-login) - -(provide 'lj-login) - -;;; lj-login.el ends here diff --git a/emacs/external/ljupdate/lj-login.elc b/emacs/external/ljupdate/lj-login.elc deleted file mode 100644 index 80b191398d0f460acb4f60942dde9dbdc0a72120..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 5840 zcwVJg`*YjI5vG5m=qaYJsEwO4E6|b%S)lMF^+=``Z8=dZTdHIyoiQ~I1b`GA5MTjN zjM{&`yL$i#Qj*7QWs}6+?d$e-zum*Z(aDQH)M~ZH!NCE%h{uy4^gXz`g)|Ag=ii^c zJ~}zNxPUlN8ioT z9WTykIojuRUhJk>5=5hP8&{Jw1IP1lkEJGkuVd_W z8tq^RZ71@eeHBk5ZvvZas+t?3G*+Pf4N@fj5EfRTt*g)u{b+>7E%GP|{N<22<78R* zBzCX&_X|o`8Y2(=wT0;_dM=$Tsg>Dq8I?4c)K3!BBL7rz=_bsa6x`xihqzwZGvF}9 zLr72tyYT=0Ycv||tJ}<1-PrR%9+;YjAAN0L=vqE7sspn+u&M*QI_Tm+>&fsw@&7pu z5{$7BaFetxC*!ASnqmCmljFKPGfCnsc4MZSWf^q2o zPfAMWxtd+uU^TkA3z%Fk^1{W@`430unNF0M(RA!b863ZPbqZ)&hI_ceNX2Z5hj8PBQ%tE+8sY;H2q)x*J7It# zH-+=bE)j)l;-?c#QXg9H+qu`ueUYgO2TB(|z4`zj`Pgx&>vjAxT5FXl^X`;&cgilO zc-Td;Uq1QMSATA{Rxpsv-5LcYF7#GVABUMi9}%Zgi)g+>8pDvDO6&M*O0B0koz>j< z6$x){Hrvvs)c%o()0)s^*!by6n{Nkloh9qdmbB4d-B4%_hpU@NZk*S)D#Clx1`AhM zx-uBD_^swMX-j&>;s=IpRy3HJw6&l?>8~mZ&5?#J(tuA!Rf(xfN=3=`W7eTIJCZ7O zgbuUYtLiW$HPeP*$_Vt^QHJYYmNG6->KbqTRX_8UcT7&@4>*YL({)R=bH7#_Q zCFwtql)vMgWe5u-t0hifvig$NU)8pVn>J$5M!tTuRnqn(t<|aLkVFv-V~loZ+AMk^BlXL>6Qpm`nx@ zWR_8kWfuQIh{qu*F4uBv@M%4jAq_H>aNl4k#Kco4(+u`YSP@uJDqQzu*cZ=*PM*TY zv{1Y5eGvA}$7!5oapGYqf&F0;_>q^Yqa>bAQc^3@Ud7$QKKlp_7f)$!`&?u(3_Q8Q zN;b2}%LtOYGYrzwwdC=Z{%vbtRozg<#v?$FsF^>WsA_%`OfDXo+IWCkoT9_z;+e_K z2gu0_A_xRaxmSK*R_g)Qz`KOK9OL)wu5!sBziYzV1hFJU zlza=8o@2AN#A6u+&%bjFwy4k%iDeNmXO3Ht588HO72&YU3YaPnfp z&o$wA?Ag`k43j(ZRBGycOqMpLzK00V0hz-@#xS@cK$&Jkbr-u`1P2X2Ziw)bSPY?oKPu}$)|sl;o$}emA*PWK9TQp^3b6U{s2UiUz|peyB=9^VVsU+#`FjI z@sfaPcngI}XXGFZ@QtAJ2_v8#P4No$IWj1W__)eTOTl#sx}C$FVRh{s z?|LR2<|tHR-W>AUm6lZjLJ_?A9S`B?A7>}WFOJ`;C#T;XzaghYaipRnwo7oLlYu4X0Qj5eu&z_h+(*#QE-Z40sE4K8jV$_Zy1oG z8n?KwYLCAd3|D{0XgH*HuUF^3OZq)6_iIJVOVVh*E*eu_w$F=YqgW;z3oI!SLtG_P zs!CY#)A=^@ZQr@YXdIkofduG6Pi1LdnRI7`aB5lB)935yK5!V_Q$ZH`nbN8fs4hg- z;Sq+ni`O2On@2d#P*hLxR#~bPfm^-iEgsw@^zzU(d&Zs!UDJkh+z*!A;$}!Y=GP)c z4Bm+sc0f+vde4bV=g?i@L&P7tB0r(4G2MvESi#r;ZgzD#cMg{Pd!w%8hqPor4oUMg zEN4bj?(k-_Stkr`{Esm<3{Kd=JGIR33qqfo1vU{~$vkutV`t(zWNkaZ^HA7eUGEpo zFwWsk`*Mz(DINK|v#~6rC;WxiL(IyX?<*`O1IiQIfap&z`9Z ze|EK{_@j=n;#`M1J^ad7Kf|SY;VUFyrUqr0(ghkAwCILcUsGP*aZ@$8mrv;utb7Bu z*3AQ=*8@z)bOG=yc)!gX5-%Xwa72*20WC;A)qp+($s#t4`U<5QU1+;sP}W)Xm25uZ zu;EVh-e#)6A#M@o=(t=D^4D|kB5Ds7%G-J>P)V-%#pr4Zv_EwgCGN1>;^7d={8_A& z_c*d}_N1c7^43E0)_m{WC1T?>!;uE_zpbv%oJ4*@n`5YMv?{7M{g+>L&0o Is!XNvAG@T}h5!Hn diff --git a/emacs/external/ljupdate/lj-maint.el b/emacs/external/ljupdate/lj-maint.el deleted file mode 100644 index 934430f..0000000 --- a/emacs/external/ljupdate/lj-maint.el +++ /dev/null @@ -1,63 +0,0 @@ -;;; lj-maint.el --- compilation and maintenance hacks for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -;; `load-path' frobbing; used for compiling - -(add-to-list 'load-path default-directory) -(mapc (lambda (dir) (add-to-list 'load-path dir)) - (parse-colon-path (getenv "LOAD_PATH"))) - -;; autoload generation; used to create `ljupdate.el' - -(defvar generated-autoload-file) -(defvar command-line-args-left) -(defun lj-generate-autoloads () - "Generate autoloads for ljupdate." - (interactive) - (require 'autoload) - (setq generated-autoload-file - (expand-file-name (car command-line-args-left) default-directory)) - (setq command-line-args-left (cdr command-line-args-left)) - (batch-update-autoloads)) - -(defun lj-debug-response (response) - "Dump RESPONSE into a buffer so we can look at it." - (switch-to-buffer (get-buffer-create "*LJ DEBUG*")) - (maphash (lambda (k v) (insert (format "%s\n%s\n" k v))) response)) - -(provide 'lj-maint) - -;;; lj-maint.el ends here diff --git a/emacs/external/ljupdate/lj-pcomplete.el b/emacs/external/ljupdate/lj-pcomplete.el deleted file mode 100644 index 08d741c..0000000 --- a/emacs/external/ljupdate/lj-pcomplete.el +++ /dev/null @@ -1,123 +0,0 @@ -;;; lj-pcomplete.el --- programmable completion for ljupdate composition buffers - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'pcomplete) - -(defun lj-pcomplete-setup () - "Configure this buffer for programmable completion." - (set (make-local-variable 'pcomplete-termination-string) "") - (set (make-local-variable 'pcomplete-ignore-case) t) - (set (make-local-variable 'pcomplete-use-paring) nil) - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'lj-pcomplete-parse-header-arguments) - (set (make-local-variable 'pcomplete-command-name-function) - 'lj-this-header)) - -;; header completion - -(defun pcomplete/lj-compose-header-mode/Subject () - "Attempt to complete the Subject header." - (pcomplete-here nil)) - -(defun pcomplete/lj-compose-header-mode/Mood () - "Attempt to complete the Mood header." - (pcomplete-here (sort (mapcar 'car (lj-server-get (lj-this-server) :moods)) - 'string-lessp) - nil nil t)) - -(defun pcomplete/lj-compose-header-mode/Server () - "Attempt to complete the Server header." - (pcomplete-here (sort (lj-servers) 'string-lessp) - nil nil t)) - -(defun pcomplete/lj-compose-header-mode/User () - "Attempt to complete the User header." - (pcomplete-here (sort (lj-users (lj-this-server)) 'string-lessp) - nil nil t)) - -(defun pcomplete/lj-compose-header-mode/Community () - "Attempt to complete the Community header." - (pcomplete-here (sort (copy-list (lj-user-get (lj-this-server) - (lj-this-user) - :access)) - 'string-lessp) - nil nil t)) - -(defun pcomplete/lj-compose-header-mode/Picture () - "Attempt to complete the Picture header." - (pcomplete-here (sort (copy-list (lj-user-get (lj-this-server) - (lj-this-user) - :pics)) - 'string-lessp) - nil nil t)) - -(defun pcomplete/lj-compose-header-mode/Access () - "Attempt to complete the Access header." - (pcomplete-here (sort - (append - (list "public" "private" "friends") - (mapcar 'car - (lj-user-get (lj-this-server) - (lj-this-user) - :friends-groups))) - 'string-lessp) - nil nil t)) - -;; pcomplete support code - -(defun lj-pcomplete-parse-header-arguments () - "Return a list of parsed whitespace-separated arguments. -These are the words from the beginning of the line up to where point is -right now." - (let* ((start (save-excursion (beginning-of-line) (point))) - (end (point)) - args beginnings) - (save-excursion - (if (< (skip-chars-backward " \t\n" start) 0) - (setq args '("") - beginnings (list end))) - (setq end (point)) - (while (< (skip-chars-backward "^ \t\n" start) 0) - (setq beginnings (cons (point) beginnings) - args (cons (buffer-substring-no-properties - (point) end) - args)) - (skip-chars-backward " \t\n" start) - (setq end (point)))) - (cons args beginnings))) - -(provide 'lj-pcomplete) -;;; lj-pcomplete.el ends here diff --git a/emacs/external/ljupdate/lj-pcomplete.elc b/emacs/external/ljupdate/lj-pcomplete.elc deleted file mode 100644 index b9e8b4f51c9c40d1378ddc0e77318c3591a23020..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 3178 zcwW6$>u=jO5ckJL{jxLz_9%+olmeE3%9doucANog5~SFN7Auwx`%q^vEm1Z*iPT6c zUiR1TNXw5n%RIQi{G{%E_dDtC?CQBN#yDIVDY!*D3|+^aR*3J&a_3CXfaE!dQnP~nMKp@2 zmSdUkXG|^Ps1#L@-f>c}1X7VGEg7Gxm&lb$14&cNbLA;IZN;Z8$730Igs0$5M8(q* znl{{^4#am3!22F0B+cL+2fQc%FQzwFz^gAX&njq0C0!fR{OfA<>R4s2sryDwNE1ZyUnav^Du5Jfkr*pop?wnUMDWFn_kLAh2zR`J9b-4MY;fsGSj zGt)J{AivWf7YWIOTQq8`=DMK4RO4Qm7A|I#q*Sgw85sjX&A5RWyyF+pf?nM7Zwy-9 z2+p;pMX5oHB_akl3fI-d+}N$J`RnwxnIh)?*2)y@>Dx>>Gt|N!84;| zzf7#=C*@I@G4=qeooV&@Q4LY&(X?>T78PguZok~t>iZ{{i1IGTnOf)i&z-p<7!hn# zk|db-?lKGpyB{L&Sfb4!*sBOj<^R6~B};Y}Adb4HJ8#uU})nscq?`ISzFOiEf&xK6YVn;QX6FOy_n<+i+awMD1aG;9$zbqk-OxGnaF)k3eO@P@Z#{O61ukC(;5PkEk=Jh`N6My@^ zB3zwk4ZD>bTpo=N%{H>ZI&F-fTpXE&WPC7kNBrVxt!oS)qD1_>;g9%}mlrkeN)yD{ zV2n|zb=n)pKxBc<-o^?CBkn>7o{N~fzb!5o3tFJ6NsSv90d8s~m6}m?1KlNX{m3@F Ohs;}+()(5NoxcHijPj5G diff --git a/emacs/external/ljupdate/lj-protocol.el b/emacs/external/ljupdate/lj-protocol.el deleted file mode 100644 index 411ce1f..0000000 --- a/emacs/external/ljupdate/lj-protocol.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; lj-protocol.el --- "flat" protocol support for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'http-post) - -(require 'lj-compat) -(require 'lj-util) - -(defun lj-protocol-server-url (hostname) - "Return the URL to the LJ protocol's \"flat\" interface on HOSTNAME." - (concat "http://" hostname "/interface/flat")) - -(defsubst lj-this-line () - "Return a string containing the current line in the current buffer." - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))) - -(defun lj-protocol-send-request (server request) - "Send to SERVER a REQUEST via the LiveJournal protocol. -If the request succeeds, this returns a hash table whose keys and values -contain the server's response. Or, if the request was unsuccessful, this -returns nil ." - (let ((process (http-post (lj-protocol-server-url server) request - lj-coding-system '(("Connection" . "close")) - 'ignore 1.0 nil " *LiveJournal response*"))) - (while (accept-process-output process)) - (with-current-buffer (process-buffer process) - ;; (if (and (stringp http-status-code) (= http-status-code 200)) ; HTTP 200 OK - (let ((response (make-hash-table :test 'equal)) - (have-frobbed nil)) - (goto-char (point-min)) - (let ((on-variable-name-line t) - var) - (while (< (point) (point-max)) - (cond (on-variable-name-line (setq var (lj-this-line))) - (t - (puthash var (decode-coding-string (string-make-unibyte (lj-this-line)) lj-coding-system) response) - (setq have-frobbed t))) - (forward-line 1) - (setq on-variable-name-line (not on-variable-name-line)))) - (if have-frobbed - (prog1 response - (kill-buffer (current-buffer))) - (rename-buffer "*LiveJournal debug*")))))) - -(defun lj-getchallenge (server) - "Get an authentication challenge from SERVER." - (let* ((response (lj-protocol-send-request - server '(("mode" . "getchallenge")))) - (challenge (and (hash-table-p response) (gethash "challenge" response)))) - (unless (stringp challenge) - (error "Unable to connect to %s" server)) - challenge)) - -(provide 'lj-protocol) - -;;; lj-protocol.el ends here diff --git a/emacs/external/ljupdate/lj-protocol.elc b/emacs/external/ljupdate/lj-protocol.elc deleted file mode 100644 index 8e7f6da8e5af564167b65f5bcd8124ff48553555..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 2479 zcwVJeQB&JS5cVS|6Z+Cgr)i;!Xp785wj~>5OlOh|<222X(qL#GVmgtf6TTpyl+(#6 z{q_CsB!NxZzQk~r?)Gl?+ud*Xd^9>a{;JVvSVu=kbezsJp0J3fH|)fw_(IGTbY!wV!vCB>Mnf@atiC@#@MptHes3|6%uMp6hHT4S(Y=s zQOpg~h><<%b~+f|_Qdx()x=+(bTR21*z{Ji4+WQuW=dslmLg5?L&FZtTcLPzNq*DX zdDcImGo}hDNX-~soSl$L&Fjf4svY0W$&TTejWol%I0%`h@ypZk`LEAkk6PbZPQ>CM z;fT%dQovlW7x8rqnb6K#X9gT#5o;PxyfuyfO$E4?k*y&Q+ijcd_N}$Hv3^Nia(2F_ z7WEGgnwJLsphh21nOr1CsDKOos@(_+DVc!RTrkbj<+W)M$4q_#UxE6r*}wBv@Z>J; zq!H7^t}vI!-MpAqyb`H)J!4XFl#JHkPT3U~8jQ{Y*9BItGZEdc-1#*a7{8pXQ1_7R z8X8oE%49XKi0E=rD*Y=%Rp_|*UZ2LWp_4fto&7#KLx9dkZ!SjTb6W7A%rIZDS1E!Q zB)6$K|UiDOwl1eB72Ok*$viVa}gvsYE_9a z+Danq>hpPqCc|2EDxVNvwWVvT5XNGj$3;@wv}&6=7yrjKgtXQKwv{Gp-6iMx7zbk~2Q>Z0*H3?HM5(fe`j8$9+O=pyQEG$bbd2iqUY`tlAYT^~>1L;i8#+f6ntCB9Lx zwYjzRF8TvUyMHz|w)FE^143v;71;_cu224W-@A{axFDXFuGjwSS2{ z-i@AZY(0IXHT!#wy-BQ1TsIy<>StvWfJ8ud7uveL?I#sYR|8Qtf=DwmzsVJw>(uLb zBcTiC;`W(N(b?)et#*)qD{RNHk5eIVHG#@DNNk4*=ztbT{7R%~LSCz5a%a=tGUaL$ zdo~5gc&6M6iJKNmS3o^2>x|~XHFGuV+>&)erQLy7&{fy+=NBWvvY~dwbkn_!RoPrB z-3Ce_xGqBS=$a=zela zUo`46S=W8e^By1RYIxkJ3uetMcP3)*KD{c!+*$k2>I7xxh^-;ZGCs|jy9B!#L1=Pe q-)*7lV!jZD1n6&J$v*x1Lyk+LSB22`x`VQt%5=eTe=fI+ru7f=)em?8 diff --git a/emacs/external/ljupdate/lj-util.el b/emacs/external/ljupdate/lj-util.el deleted file mode 100644 index c8b01c6..0000000 --- a/emacs/external/ljupdate/lj-util.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; lj-util.el --- misc elisp utilities for ljupdate - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'md5) - -(require 'lj-compat) - -(defun lj-md5 (string) - "MD5s STRING and downcases the result. -The LiveJournal server code doesn't accept upcased MD5sums. Case -sensitivity is dumb." - (downcase (md5 string nil nil lj-coding-system))) - -(defun lj-number (thing) - "Convert THING to a number, if necessary." - (cond ((numberp thing) thing) - ((stringp thing) (string-to-number thing)) - (t 0))) - -(defun lj-exp2 (n) - "Return a string representation of 2^N for 0 <= N <= 30." - (cond ((or (< n 0) (> n 30)) - (signal 'args-out-of-range n)) - ((< n 27) (number-to-string (lsh 1 n))) - ;; Emacs integers aren't 32-bit quantities, so we cheat. - ((= n 27) "134217728") - ((= n 28) "268435456") - ((= n 29) "536870912") - ((= n 30) "1073741824"))) - -(provide 'lj-util) - -;;; lj-util.el ends here diff --git a/emacs/external/ljupdate/lj-util.elc b/emacs/external/ljupdate/lj-util.elc deleted file mode 100644 index 9d41db8d9ea01c1249bc7faca79014b85ee516f6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 1449 zcwVKGTa()~6oB(a>L+;O4Nkos;>2l85~Pa)UhQa$-9JK z&ynI3x_!inJvuk(I~T1lF3-OljYi&jy@qqycD!K}wg=FP(-*IPetmIyaeWO^z)Qv9 zCEG%@!2gQmE0O_;qJ@jBm29ELSg2O>x0)$Ew;RlVQSv>jjGj|ztXa=lTUL7Byze_& z8itEmZ+H{3#_hueTv!LV!!0+-0Y!j8jzjgE&sbT=%Pc<8E^Jn9}#-Z zG|+=6TV4T`l{Sitoqmc|r45vnVu~M5ikBf-hF-vH2ueXA*veke4knItHh@gMM-V(i z55;Qu$O1t;gP>tzhj1UqOsDYecP>(@hnsh@+OJk8Pk10>jD3P5`V0%Fy9dYm4&28> zJm<=k!c+V|{;lW)?n@2Tsi`%Z|C2JH*kB73Zs98Ue;?2Dg6+YuStTh0f0INJzVYJ? ziK9UvC`5%1?-cv9=ZZl~GeBU=SejcPQ}66WjDz+1`%J_2&6^*uegIoHD(^*A+P<1S z1I2XTn9#ey^(DV!KgnK+vH_estPZ&IsbpGAu-jF|Is<)Y!>QZ2Z*>UgD0-R+%?-cf z<^VW7v~RcJ*IqzbT{awRH$gUwc=m4S#MI?Q#`sAvulUiE4I#yl)Y0Xb54CO62W?pE zk`%nTg$#nTClErOC(~P-YD)0V31l{K^UCIGB$OZ!gQ=&06De4QtuNK#6Re|?B{TaY z*my%yi;{dc8e5|A+6teKY!k+=@D_bwbwMzUmyxIKBJ9BcxmXrQ$gF@j%wUBPZAekE z4tv0aaW@cT4dnMLH((Jwdk$CjlSH2|v%flGiG`y@tly9(-P9v1kY6qC7b92NBud8{ z-(`X8%=#r?SyPTL<`G9|e*D4y*4n>8dmInCm^fW%b;(JWI$dsc*(uifWzVfHA8I2o zizEWgcXp^swbL`%o0+Ufb^-)I5%IVv8PhO5Smt;>mEEr`|ui9HI*V diff --git a/emacs/external/ljupdate/ljupdate.el b/emacs/external/ljupdate/ljupdate.el deleted file mode 100644 index a35a82c..0000000 --- a/emacs/external/ljupdate/ljupdate.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; ljupdate.el --- a LiveJournal client for Emacs -*- emacs-lisp -*- - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'lj-custom) - -(defconst lj-client-revision "24M" - "The Subversion revision of your ljupdate.") - -(defun lj-client-version () - (format "%sEmacs-ljupdate/4.0.%s" - (cond ((featurep 'sxemacs) "SX") - ((featurep 'xemacs) "X") - (t "")) - ;; `lj-client-revision' might be a simple number, or it might - ;; match X:YM?S?, where X and Y are revision numbers. - (apply 'max - (mapcar 'string-to-number - (split-string lj-client-revision "[:MS]"))))) - -(defconst lj-client-version (lj-client-version) - "The client version to report to the server.") - -(provide 'ljupdate) - -;;; Generated autoloads follow (made by autoload.el). -;;; ljupdate.in ends here - -;;;### (autoloads (lj-compose lj-compose-mode) "lj-compose" "lj-compose.el" -;;;;;; (18347 50208)) -;;; Generated autoloads from lj-compose.el - -(autoload 'lj-compose-mode "lj-compose" "\ -Major mode for editing LiveJournal posts. - -\(fn)" nil nil) - -(add-to-list 'auto-mode-alist '("\\.lj\\'" . lj-compose-mode)) - -(autoload 'lj-compose "lj-compose" "\ -Compose a new LiveJournal post. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (lj-browse-entries lj-html-decode-string) "lj-edit" -;;;;;; "lj-edit.el" (18347 50208)) -;;; Generated autoloads from lj-edit.el - -(autoload 'lj-html-decode-string "lj-edit" "\ -Not documented - -\(fn STRING)" t nil) - -(autoload 'lj-browse-entries "lj-edit" "\ -Not documented - -\(fn)" t nil) - -(defalias 'lj-edit-last 'lj-edit-post) - -;;;*** - -;;;### (autoloads (lj-logout lj-login) "lj-login" "lj-login.el" (18347 -;;;;;; 50208)) -;;; Generated autoloads from lj-login.el - -(autoload 'lj-login "lj-login" "\ -Logs into SERVER as USERNAME, and return the md5sum of USERNAME's password. - -\(fn SERVER USERNAME)" t nil) - -(autoload 'lj-logout "lj-login" "\ -Logs off of SERVER (as USERNAME). - -\(fn SERVER USERNAME)" t nil) - -(defalias 'lj-password 'lj-login) - -;;;*** - -;;;### (autoloads nil nil ("http-cookies.el" "http-post.el" "lj-acct.el" -;;;;;; "lj-compat.el" "lj-custom.el" "lj-fill.el" "lj-maint.el" -;;;;;; "lj-pcomplete.el" "lj-protocol.el" "lj-util.el") (18347 50393 -;;;;;; 974000)) - -;;;*** - -;;;### (autoloads (http-get) "http-get" "http-get.el" (18347 50285)) -;;; Generated autoloads from http-get.el - -(autoload 'http-get "http-get" "\ -Get URL in a buffer, and return the process. -You can get the buffer associated with this process using -`process-buffer'. - -The optional HEADERS are an alist where each element has the form -\(NAME . VALUE). Both must be strings and will be passed along with -the request. - -With optional argument SENTINEL, the buffer is not shown. It is the -responsibility of the sentinel to show it, if appropriate. A sentinel -function takes two arguments, process and message. It is called when -the process is killed, for example. This is useful when specifying a -non-persistent connection. By default, connections are persistent. -Add (\"Connection\" . \"close\") to HEADERS in order to specify a -non-persistent connection. Usually you do not need to specify a -sentinel, and `ignore' is used instead, to prevent a message being -printed when the connection is closed. - -If you want to filter the content as it arrives, bind -`http-filter-pre-insert-hook' and `http-filter-post-insert-hook'. - -The optional argument VERSION specifies the HTTP version to use. It -defaults to version 1.0, such that the connection is automatically -closed when the entire document has been downloaded. This will then -call SENTINEL, if provided. If no sentinel is provided, `ignore' will -be used in order to prevent a message in the buffer when the process -is killed. - -CONTENT-TYPE is a coding system to use for the encoding of the url -param value. Its upper case print name will be used for the server. -Possible values are `iso-8859-1' or `euc-jp' and others. - -The coding system of the process is set to `binary', because we need to -distinguish between \\r and \\n. To correctly decode the text later, -use `decode-coding-region' and get the coding system to use from -`http-headers'. - -\(fn URL &optional HEADERS SENTINEL VERSION BUFNAME CONTENT-TYPE)" t nil) - -;;;*** diff --git a/emacs/external/ljupdate/ljupdate.elc b/emacs/external/ljupdate/ljupdate.elc deleted file mode 100644 index 4af63b70133cb4d10b0646e2974dc602085f071b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 3763 zcwVJfZExGi5l+9g1p2ujJEeP-1emg3?AUS&G`^g2abY`wU#>kw0lXqt(mEuUx4X2W z{`x+%BqiDMwFPRM#)>;T^UO1Et2g6|cYk>G>Q(UO%^P~BvqGgZq3MdOQOVm6A1}uj z(RM^n;9@JxH|U zZF?Xy5!-|Gp)3;NW{jEQ8#F-8MQ^8P1iWL&pzV}|FkRU z5ty^ZGqa%w9>PfAMWr#Y65el7+M=bf6gOd=VSmeK!p9VX20A>2|L;!_1Z^XKDV34b zN*|)Qv`%N8VDIhW5aE$@Q%)Q7Mm{RP&@)=;5=a`@e+=4*oW%&NBUX|snY(B$9}W&L ze-l!B@6Xhw*ZmVY>IsDUPfW_<;)<;+le$T7d zc#bE-eh&|%`;hJre~W*IlaPP+AbA|p=NDjs+e|nLzq6jc!&Ahi52QYL7g% z6`pn3I1PpiZ5*#0_ED4A`xSE6nY{C=QxiRUeZ)i;Mn9^=N4Ij%BN)-8ctA2`8e5!X zGEt7PUZ_X;cLX;VDHYl}F4gud?*N4;oldn#s*oW=wUv=q5N=+C)T+$)d!wTcaUk&k z2TGXvNfq2^u_}Kw64i@#IGJ?QhsmTB;_Ng19fmv{`DTZABq*259i;ym=*t)f$A=wq z6~eu@sIM#Sxc!tF2$hM~NH@3F=T|@OC|bBivD{JI%m|1`cPoVvsE>g;m7 zPu%Q`M8@Yn{j%i9mKhg&Bhs=|2y2(xB;A^tN=+lM<4LOLXxd@3+IVop$+70;=(vKW zXEU}}Yi)0#>-_Hqb?IKRczpD0oHage5HqI!Nq;~;N=J9s7d&|cP0QI#njM}{U@>}q zH~3kX6pNhZIK&&3JUF&GRw%rr8itOCUVR924|x;Z*B_(mNDIz#gW!>=IlVuO&wdzR z-w-AltW#Ap%Z0>8DPoMURB}Gi0v@qt?rcGu34-T8on734Kceq7tY>KOG?jJ7vfi1c z!hFU%CITo$s*%f#HDF~t9;7d?e=z(tC}HM4ixHEn+w-gO#s0R}@G(cK+l5}{uzl|M z4fX>gZGm2vTYiQ_Y?=mdJT&_XHxQ%cu7BUaE;>TNG6>sfV4e^`EijzEI;>RftoO!|sA*~%3DY&NV9<>pK`I7@KT2;Z$GxDAGJ%H68N zq%p@m~w6ibVH_rX-0oR<|PdZ%x9J^B;@bHnv3jd8khet4{ zDo=v@g>ywz2}ghs0g^N>T4?>XRe^pYfu{FF2Hsl;Z2+TqRy z+UhLymFhTiS=CnMp;YQY&$6I6*PEKE`iDw?v>Ti$;r_u>bLkNeJ{&6dMK*&L32bn z>oj?axyH8DD6I6kdymupOW71xkf0c$q*Qi+ZMWozPK>uT;kvxlFk=j| zB;_8#_Xuys$#1T@ - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'lj-custom) - -(defconst lj-client-revision "24M" - "The Subversion revision of your ljupdate.") - -(defun lj-client-version () - (format "%sEmacs-ljupdate/4.0.%s" - (cond ((featurep 'sxemacs) "SX") - ((featurep 'xemacs) "X") - (t "")) - ;; `lj-client-revision' might be a simple number, or it might - ;; match X:YM?S?, where X and Y are revision numbers. - (apply 'max - (mapcar 'string-to-number - (split-string lj-client-revision "[:MS]"))))) - -(defconst lj-client-version (lj-client-version) - "The client version to report to the server.") - -(provide 'ljupdate) - -;;; Generated autoloads follow (made by autoload.el). -;;; ljupdate.in ends here diff --git a/emacs/external/ljupdate/ljupdate.in b/emacs/external/ljupdate/ljupdate.in deleted file mode 100644 index 9468b95..0000000 --- a/emacs/external/ljupdate/ljupdate.in +++ /dev/null @@ -1,59 +0,0 @@ -;;; ljupdate.el --- a LiveJournal client for Emacs -*- emacs-lisp -*- - -;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor - -;; Author: Edward O'Connor -;; Keywords: convenience - -;; This file is part of ljupdate, a LiveJournal client for Emacs. - -;; ljupdate 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. - -;; ljupdate 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, or type `C-h C-c'. If -;; not, write to the Free Software Foundation at this address: - -;; Free Software Foundation -;; 51 Franklin Street, Fifth Floor -;; Boston, MA 02110-1301 -;; USA - -;;; Commentary: -;; - -;;; History: -;; - -;;; Code: - -(require 'lj-custom) - -(defconst lj-client-revision "##revision##" - "The Subversion revision of your ljupdate.") - -(defun lj-client-version () - (format "%sEmacs-ljupdate/4.0.%s" - (cond ((featurep 'sxemacs) "SX") - ((featurep 'xemacs) "X") - (t "")) - ;; `lj-client-revision' might be a simple number, or it might - ;; match X:YM?S?, where X and Y are revision numbers. - (apply 'max - (mapcar 'string-to-number - (split-string lj-client-revision "[:MS]"))))) - -(defconst lj-client-version (lj-client-version) - "The client version to report to the server.") - -(provide 'ljupdate) - -;;; Generated autoloads follow (made by autoload.el). -;;; ljupdate.in ends here diff --git a/emacs/external/ml/caml-compat.el b/emacs/external/ml/caml-compat.el deleted file mode 100644 index d7bad84..0000000 --- a/emacs/external/ml/caml-compat.el +++ /dev/null @@ -1,42 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -;(* *) -;(* Copyright 1998 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: caml-compat.el,v 1.2.18.1 2004/08/09 16:09:33 doligez Exp $ *) - -;; function definitions for old versions of emacs - -;; indent-line-to - -(if (not (fboundp 'indent-line-to)) - (defun indent-line-to (column) - "Indent current line to COLUMN. - -This function removes or adds spaces and tabs at beginning of line -only if necessary. It leaves point at end of indentation." - (if (= (current-indentation) column) - (back-to-indentation) - (beginning-of-line 1) - (delete-horizontal-space) - (indent-to column)))) - -;; buffer-substring-no-properties - -(cond - ((fboundp 'buffer-substring-no-properties)) - ((fboundp 'buffer-substring-without-properties) - (defalias 'buffer-substring-no-properties - 'buffer-substring-without-properties)) - (t - (defalias 'buffer-substring-no-properties 'buffer-substring))) - -(provide 'caml-compat) - diff --git a/emacs/external/ml/caml-emacs.el b/emacs/external/ml/caml-emacs.el deleted file mode 100644 index 8b7ed35..0000000 --- a/emacs/external/ml/caml-emacs.el +++ /dev/null @@ -1,43 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Didier Remy, projet Cristal, INRIA Rocquencourt *) -;(* *) -;(* Copyright 2003 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: caml-emacs.el,v 1.6.6.1 2004/08/09 16:09:33 doligez Exp $ *) - -;; for caml-help.el -(defalias 'caml-info-other-window 'info-other-window) - -;; for caml-types.el - -(defalias 'caml-line-beginning-position 'line-beginning-position) - -(defalias 'caml-read-event 'read-event) -(defalias 'caml-window-edges 'window-edges) -(defun caml-mouse-vertical-position () - (cddr (mouse-position))) -(defalias 'caml-ignore-event-p 'integer-or-marker-p) -(defalias 'caml-mouse-movement-p 'mouse-movement-p) -(defalias 'caml-sit-for 'sit-for) - -(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body)) - -(defun caml-event-window (e) (posn-window (event-start e))) -(defun caml-event-point-start (e) (posn-point (event-start e))) -(defun caml-event-point-end (e) (posn-point (event-end e))) - -(defun caml-release-event-p (original event) - (and (equal (event-basic-type original) (event-basic-type event)) - (let ((modifiers (event-modifiers event))) - (or (member 'drag modifiers) - (member 'click modifiers))))) - - -(provide 'caml-emacs) diff --git a/emacs/external/ml/caml-emacs.elc b/emacs/external/ml/caml-emacs.elc deleted file mode 100644 index 56a3a0212b28f824b000f382bef803acb7d4606b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 1754 zcwVJc&2Q5%6z_411Sb&NPH&w=6A7nH((a>0qG3$h0kjJehjkKe;-*#;JF>Hu^4Ig? zr0d5DhY`t&{XT#1_ntkt`Fj1P(P&tM!2qshmh+UwFkXV5%IWa#HvATn+q-W!AO-wD z%@-Dd*8|V*d*^-62fx$l8sCYM8BEX{;(j}yCA!Tr8foHtZqU}eU?k-_Z$~ssiP5+$ zHI7`sO?ienQ<`I%(!=$PZo!Kwf+<*p$kqn#WzX$yn$R=_nHN0cziELc+O>@G`;_Yn z)T3q^;-#P&k06$jE)*Au{(xGg3!rg~#XUjsu3Z1hwQN2Cn~E6hv3wM94y~%D8i->Z zg8dOK6q~@725gUjoidRixNRTDfls0FlxjD4E~9C`zp{j#Gy0UDT|p-)(>mWt+cdzN zn8Y%sOexIL{JF(?3l>yEwCeQ)EjFqKJf^f@3ZobjU;J5?WtY7pk&GEMM?t59%fsc5 znj_!q)RF*KcT3X4b-pFJ7zMaTN#~*o_c5E$l$S-6b#XC~L>5z~$bySlF5tPu7^Yk> zGG+-Eq9ibvIF==Af0G+0#b`{}oQVQ9wnkOOCM-^Hwl)tB5IC0ogtBFvw5OoUXds*U8xU%?V2Pb!j8HN#yF z8#QEd&a%q#nZTGKT2hWx{ohMRp=dO#0z%8i`BM^HB*T8M7+%P+jF(Qu%E9Lvb18!j zKSRg!$W;|}<1rw^I0q%O$KlW^|0ly0!3?T)?hw2;U@nmsq6?~u{ZYeVAHxQ38zT`8 zhq(2R%=YEU7`_gxRL5mg4=+uMR}Ir)%<#J0bq_DM5WpJ2**_704<0sW4+_OnM)i6k z5QS76ZwO7R7*%hAgHr?RbmRv" . font-lock-function-name-face) -;definition - (cons (concat - "\\<\\(a\\(nd\\|s\\)\\|c\\(onstraint\\|lass\\)" - "\\|ex\\(ception\\|ternal\\)\\|fun\\(ct\\(ion\\|or\\)\\)?" - "\\|in\\(herit\\|itializer\\)?\\|let" - "\\|m\\(ethod\\|utable\\|odule\\)" - "\\|of\\|p\\(arser\\|rivate\\)\\|rec\\|type" - "\\|v\\(al\\|irtual\\)\\)\\>") - 'font-lock-type-face) -;blocking - '("\\<\\(begin\\|end\\|object\\|s\\(ig\\|truct\\)\\)\\>" - . font-lock-keyword-face) -;control - (cons (concat - "\\<\\(do\\(ne\\|wnto\\)?\\|else\\|for\\|i\\(f\\|gnore\\)" - "\\|lazy\\|match\\|new\\|or\\|t\\(hen\\|o\\|ry\\)" - "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>" - "\\|\|\\|->\\|&\\|#") - 'font-lock-reference-face) - '("\\" . font-lock-comment-face) -;labels (and open) - '("\\(\\([~?]\\|\\<\\)[a-z][a-zA-Z0-9_']*:\\)[^:=]" 1 - font-lock-variable-name-face) - '("\\<\\(assert\\|open\\|include\\)\\>\\|[~?][ (]*[a-z][a-zA-Z0-9_']*" - . font-lock-variable-name-face))) - -(defconst inferior-caml-font-lock-keywords - (append - (list -;inferior - '("^[#-]" . font-lock-comment-face)) - caml-font-lock-keywords)) - -;; font-lock commands are similar for caml-mode and inferior-caml-mode -(add-hook 'caml-mode-hook - '(lambda () - (cond - ((fboundp 'global-font-lock-mode) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '(caml-font-lock-keywords nil nil ((?' . "w") (?_ . "w"))))) - (t - (setq font-lock-keywords caml-font-lock-keywords))) - (make-local-variable 'font-lock-keywords-only) - (setq font-lock-keywords-only t) - (font-lock-mode 1))) - -(defun inferior-caml-mode-font-hook () - (cond - ((fboundp 'global-font-lock-mode) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '(inferior-caml-font-lock-keywords - nil nil ((?' . "w") (?_ . "w"))))) - (t - (setq font-lock-keywords inferior-caml-font-lock-keywords))) - (make-local-variable 'font-lock-keywords-only) - (setq font-lock-keywords-only t) - (font-lock-mode 1)) - -(add-hook 'inferior-caml-mode-hooks 'inferior-caml-mode-font-hook) - -(provide 'caml-font) diff --git a/emacs/external/ml/caml-help.el b/emacs/external/ml/caml-help.el deleted file mode 100644 index 1456665..0000000 --- a/emacs/external/ml/caml-help.el +++ /dev/null @@ -1,829 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Didier Remy, projet Cristal, INRIA Rocquencourt *) -;(* *) -;(* Copyright 2001 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id$ *) - -;; caml-info.el --- contextual completion and help to caml-mode - -;; Didier Remy, November 2001. - -;; This provides two functions completion and help -;; look for caml-complete and caml-help - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This is a preliminary version. -;; -;; Possible improvements? -;; - dump some databaes: Info, Lib, ... -;; - accept a search path for local libraries instead of current dir -;; (then distinguish between different modules lying in different -;; directories) -;; - improve the construction for info files. -;; -;; Abstract over -;; - the viewing method and the database, so that the documentation for -;; and identifier could be search in -;; * info / html / man / mli's sources -;; * viewed in emacs or using an external previewer. -;; -;; Take all identifiers (labels, Constructors, exceptions, etc.) -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(eval-and-compile - (if (and (boundp 'running-xemacs) running-xemacs) - (require 'caml-xemacs) - (require 'caml-emacs))) - -;; Loading or building databases. -;; - -;; variables to be customized - -(defvar ocaml-lib-path 'lazy - "Path list for ocaml lib sources (mli files) - -'lazy means ask ocaml to find it for your at first use.") -(defun ocaml-lib-path () - "Computes if necessary and returns the path for ocaml libs" - (if (listp ocaml-lib-path) nil - (setq ocaml-lib-path - (split-string - (shell-command-to-string - (or - (and (boundp 'inferior-caml-program) - (string-match "\\([^ ]*/ocaml\\)\\( \\|$\\)" - inferior-caml-program) - (let ((file - (concat (match-string 1 inferior-caml-program) - "c"))) - (and (file-executable-p file) - (concat file " -where")))) - "ocamlc -where"))))) - ocaml-lib-path) - - - -;; General purpose auxiliary functions - -(defun ocaml-capitalize (s) - (concat (capitalize (substring s 0 1)) (substring s 1))) - -(defun ocaml-uncapitalize (s) - (if (> (length s) 0) - (concat (downcase (substring s 0 1)) (substring s 1)) - s)) - -(defun iter (f l) (while (consp l) (apply f (list (car l))) (setq l (cdr l)))) - -(defun ocaml-find-files (path filter &optional depth split) - (let* ((path-string - (if (stringp path) - (if (file-directory-p path) path nil) - (mapconcat '(lambda (d) (if (file-directory-p d) d)) - path " "))) - (command - (and path-string - (concat "find " path-string - " '(' " filter " ')' " - (if depth (concat " -maxdepth " (int-to-string depth))) - (if split nil " -printf '%\p '") - ))) - (files - (and command (shell-command-to-string command)))) - (if (and split (stringp files)) (split-string files "\n") files) - )) - -;; Specialized auxiliary functions - - -;; Global table of modules contents of modules loaded lazily. - -(defvar ocaml-module-alist 'lazy - "A-list of modules with how and where to find help information. - 'delay means non computed yet") - -(defun ocaml-add-mli-modules (modules tag &optional path) - (let ((files - (ocaml-find-files (or path (ocaml-lib-path)) - "-type f -name '*.mli'" 1 t))) - (while (consp files) - (if (string-match "\\([^/]*\\).mli" (car files)) - (let* ((module (ocaml-capitalize (match-string 1 (car files)))) - (dir (file-name-directory (car files))) - (dirp (member dir (ocaml-lib-path)))) - (if (and (consp dirp) (string-equal dir (car dirp))) - (setq dir (car dirp))) - (if (assoc module modules) nil - (setq modules - (cons (cons module (cons (cons tag dir) 'lazy)) modules)) - ))) - (setq files (cdr files))) - modules)) - -(defun ocaml-add-path (dir &optional path) - "Extend ocaml-module-alist with modules of DIR relative to PATH" - (interactive "D") - (let* ((old (ocaml-lib-path)) - (new - (if (file-name-absolute-p dir) dir - (concat - (or (find-if '(lambda (p) (file-directory-p (concat p "/" dir))) - (cons default-directory old)) - (error "Directory not found")) - "/" dir)))) - (setq ocaml-lib-path (cons (car old) (cons new (cdr old)))) - (setq ocaml-module-alist - (ocaml-add-mli-modules (ocaml-module-alist) 'lib new)))) - -(defun ocaml-module-alist () - "Call by need value of variable ocaml-module-alist" - (if (listp ocaml-module-alist) - nil - ;; build list of mli files - (setq ocaml-module-alist (ocaml-add-mli-modules nil 'lib)) - ;; dumping information ? TODO - ) - ocaml-module-alist) - -(defun ocaml-get-or-make-module (module &optional tag) - (let ((info (assoc module (ocaml-module-alist)))) - (if info nil - (setq info (cons module (cons (cons 'local default-directory) 'lazy))) - (setq ocaml-module-alist (cons info ocaml-module-alist)) - ) - info)) - -;; Symbols of module are lazily computed - -(defun ocaml-module-filename (module) - (let ((module (ocaml-uncapitalize module)) (name)) - (if (file-exists-p (setq name (concat module ".mli"))) nil - (let ((tmp (ocaml-lib-path))) - (while (consp tmp) - (setq name (concat (car tmp) "/" module ".mli")) - (if (file-exists-p name) (setq tmp nil) - (setq name nil))))) - name)) - -(defun ocaml-module-symbols (module-info) - (let* ((module (car module-info)) - (tail (and module-info (cdr module-info))) - (tag (caar tail)) - (dir (cdar tail)) - (file) - (alist)) - (if (listp (cdr tail)) - (cdr tail) - (if (equal tag 'info) - (setq dir (car ocaml-lib-path)) ; XXX to be fixed - ) - (setq file (concat dir "/" (ocaml-uncapitalize module) ".mli")) - (message file) - (save-window-excursion - (set-buffer (get-buffer-create "*caml-help*")) - (if (and file (file-exists-p file)) - (progn - (message "Scanning module %s" file) - (insert-file-contents file)) - (message "Module %s not found" module)) - (while (re-search-forward - "\\([ \t]*val\\|let\\|external\\| [|]\\) \\([a-zA-Z_0-9'][a-zA-Z_0-9']*\\)\\|^ *[{]* \\([a-z_][A-Za-z_0-9]*\\) : [^;\n][^;\n]*;" - (point-max) 'move) - (pop-to-buffer (current-buffer)) - (setq alist (cons (or (match-string 2) (match-string 3)) alist))) - (erase-buffer) - ) - (setcdr tail alist) - alist) - )) - -;; Local list of visible modules. - -(defvar ocaml-visible-modules 'lazy - "A-list of open modules, local to every file.") -(make-variable-buffer-local 'ocaml-visible-modules) -(defun ocaml-visible-modules () - (if (listp ocaml-visible-modules) nil - (progn - (setq ocaml-visible-modules - (list (ocaml-get-or-make-module "Pervasives"))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^ *open *\\([A-Z][a-zA-Z'_0-9]*\\)" - (point-max) t) - (let ((module (match-string 1))) - (if (assoc module ocaml-visible-modules) nil - (setq ocaml-visible-modules - (cons (ocaml-get-or-make-module module) - ocaml-visible-modules))))) - ))) - ocaml-visible-modules) - -(defun ocaml-open-module (arg) - "*Make module of name ARG visible whe ARG is a string. -When call interactively, make completion over known modules." - (interactive "P") - (if (not (stringp arg)) - (let ((modules (ocaml-module-alist))) - (setq arg - (completing-read "Open module: " modules)))) - (if (and (stringp arg) (not (equal arg ""))) - (progn - (if (assoc arg (ocaml-visible-modules)) - (ocaml-close-module arg)) - (setq ocaml-visible-modules - (cons (ocaml-get-or-make-module arg) (ocaml-visible-modules))) - )) - (message "%S" (mapcar 'car (ocaml-visible-modules)))) - -(defun ocaml-close-module (arg) - "*Close module of name ARG when ARG is a string. -When call interactively, make completion over visible modules. -Otherwise if ARG is true, close all modules and reset to default. " - (interactive "P") - (if (= (prefix-numeric-value arg) 4) - (setq ocaml-visible-modules 'lazy) - (let* ((modules (ocaml-visible-modules))) - (if (null modules) (error "No visible module to close")) - (unless (stringp arg) - (setq arg - (completing-read - (concat "Close module [" (caar modules) "] : ") - modules)) - (if (equal arg "") (setq arg (caar modules)))) - (setq ocaml-visible-modules - (remove-if '(lambda (m) (equal (car m) arg)) - ocaml-visible-modules)) - )) - (message "%S" (mapcar 'car (ocaml-visible-modules)))) - - -;; Look for identifiers around point - -(defun ocaml-qualified-identifier (&optional show) - "Search for a qualified identifier (Path. entry) around point. - -Entry may be nil. -Currently, the path may only be nil or a single Module. -For paths is of the form Module.Path', it returns Module -and always nil for entry. - -If defined Module and Entry are represented by a region in the buffer, -and are nil otherwise. - -For debugging purposes, it returns the string Module.entry if called -with an optional non-nil argument. -" - (save-excursion - (let ((module) (entry)) - (if (looking-at "[ \n]") (skip-chars-backward " ")) - (if (re-search-backward - "\\([^A-Za-z0-9_.']\\|\\`\\)\\([A-Za-z0-9_']*[.]\\)*[A-Za-z0-9_']*\\=" - (- (point) 100) t) - (progn - (or (looking-at "\\`[A-Za-z)-9_.]") (forward-char 1)) - (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)[.]") - (progn - (setq module (cons (match-beginning 1) (match-end 1))) - (goto-char (match-end 0)))) - (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)\\>") - (setq entry (cons (match-beginning 1) (match-end 1)))))) - (if show - (concat - (and module (buffer-substring (car module) (cdr module))) - "." - (and entry (buffer-substring (car entry) (cdr entry)))) - (cons module entry)) - ))) - -;; completion around point - -(defun ocaml-completion (pattern module) - (let ((list - (or - (and module - (list - (or (assoc module (ocaml-module-alist)) - (error "Unknown module %s" module)))) - (ocaml-visible-modules)))) - (message "Completion from %s" (mapconcat 'car list " ")) - (if (null pattern) - (apply 'append (mapcar 'ocaml-module-symbols list)) - (let ((pat (concat "^" (regexp-quote pattern))) (res)) - (iter - '(lambda (l) - (iter '(lambda (x) - (if (string-match pat (car l)) - (if (member x res) nil (setq res (cons x res))))) - (ocaml-module-symbols l))) - list) - res) - ))) - -(defun caml-complete (arg) - "Does completion for OCaml identifiers qualified. - -It attemps to recognize an qualified identifier Module . entry -around point using function \\[ocaml-qualified-identifier]. - -If Module is defined, it does completion for identifier in Module. - -If Module is undefined, it does completion in visible modules. -Then, if completion fails, it does completion among all modules -where identifier is defined." - (interactive "p") - (let* ((module-entry (ocaml-qualified-identifier)) (entry) - (module) - (beg) (end) (pattern)) - (if (car module-entry) - (progn - (setq module - (buffer-substring (caar module-entry) (cdar module-entry))) - (or (assoc module (ocaml-module-alist)) - (and (setq module - (completing-read "Module: " (ocaml-module-alist) - nil nil module)) - (save-excursion - (goto-char (caar module-entry)) - (delete-region (caar module-entry) (cdar module-entry)) - (insert module) t) - (setq module-entry (ocaml-qualified-identifier)) - (car module-entry) - (progn (setq entry (cdr module-entry)) t)) - (error "Unknown module %s" module)))) - (if (consp (cdr module-entry)) - (progn - (setq beg (cadr module-entry)) - (setq end (cddr module-entry))) - (if (and module - (save-excursion - (goto-char (cdar module-entry)) - (looking-at " *[.]"))) - (progn - (setq beg (match-end 0)) - (setq end beg)))) - (if (not (and beg end)) - (error "Did not find anything to complete around point") - - (setq pattern (buffer-substring beg end)) - (let* ((all-completions (ocaml-completion pattern module)) - (completion - (try-completion pattern (mapcar 'list all-completions)))) - (cond ((eq completion t)) - - ((null completion) - (let* - ((modules (ocaml-find-module pattern)) - (visible (intersection modules (ocaml-visible-modules))) - (hist) - (module - (cond - ((null modules) - nil) - ((equal (length modules) 1) - (caar modules)) - ((equal (length visible) 1) - (caar visible)) - (t - (setq hist (mapcar 'car modules)) - (completing-read "Module: " modules nil t - "" (cons hist 0))) - ))) - (if (null module) - (error "Can't find completion for \"%s\"" pattern) - (message "Completion found in module %s" module) - (if (and (consp module-entry) (consp (cdr module-entry))) - (delete-region (caar module-entry) end) - (delete-region beg end)) - (insert module "." pattern)))) - - ((not (string-equal pattern completion)) - (delete-region beg end) - (goto-char beg) - (insert completion)) - - (t - (with-output-to-temp-buffer "*Completions*" - (display-completion-list all-completions)) - )) - )))) - - -;; Info files (only in ocamldoc style) - - -(defvar ocaml-info-prefix "ocaml-lib" - "Prefix of ocaml info files describing library modules. -Suffix .info will be added to info files. -Additional suffix .gz may be added if info files are compressed. -") -;; - -(defun ocaml-hevea-info-add-entries (entries dir name) - (let* - ((filter - (concat "-type f -regex '.*/" name - "\\(.info\\|\\)\\(-[0-9]*\\|\\)\\([.]gz\\|\\)'" - )) - (section-regexp - "\\* \\(Section [1-9][0-9--]*\\)::[ \t][ \t]*Module *\\([A-Z][A-Za-z_0-9]*\\)") - (files (ocaml-find-files dir filter)) - (command)) - ;; scanning info files - (if (or (null files) - (not (stringp files)) - (string-match files "^ *$")) - (message "No info file found: %s." (mapconcat 'identity files " ")) - (message "Scanning info files %s." files) - (save-window-excursion - (set-buffer (get-buffer-create "*caml-help*")) - (setq command - (concat "zcat -f " files - " | grep -e '" section-regexp "'")) - (message "Scanning files with: %s" command) - (or (shell-command command (current-buffer)) - (error "Error while scanning")) - (goto-char (point-min)) - (while (re-search-forward section-regexp (point-max) t) - (let* ((module (match-string 2)) - (section (match-string 1))) - ;; (message "%s %s" module section) - (if (assoc module entries) nil - (setq entries - (cons (cons module (concat "(" name ")" section)) - entries)) - ))) - (let ((buf (get-buffer "*caml-help*"))) - (if buf (kill-buffer buf))))) - entries)) - -(defun ocaml-hevea-info () - "The default way to create an info data base from the value -of \\[Info-default-directory-list] and the base name \\[ocaml-info-name] -of files to look for. - -This uses info files produced by HeVeA. -" - (let ((collect) (seen)) - (iter '(lambda (d) - (if (member d seen) nil - (setq collect - (ocaml-hevea-info-add-entries - collect d ocaml-info-prefix)) - (setq done (cons d seen)))) - Info-directory-list) - collect)) - -(defun ocaml-ocamldoc-info-add-entries (entries dir name) - (let* - ((module-regexp "^Node: \\([A-Z][A-Za-z_0-9]*\\)[^ ]") - (command - (concat - "find " dir " -type f -regex '.*/" name - "\\(.info\\|\\)\\([.]gz\\|\\)' -print0" - " | xargs -0 zcat -f | grep '" module-regexp "'"))) - (message "Scanning info files in %s" dir) - (save-window-excursion - (set-buffer (get-buffer-create "*caml-help*")) - (or (shell-command command (current-buffer)) (error "HERE")) - (goto-char (point-min)) - (while (re-search-forward module-regexp (point-max) t) - (if (equal (char-after (match-end 1)) 127) - (let* ((module (match-string 1))) - (if (assoc module entries) nil - (setq entries - (cons (cons module (concat "(" name ")" module)) - entries)) - )))) - ; (kill-buffer (current-buffer)) - ) - entries)) - -(defun ocaml-ocamldoc-info () - "The default way to create an info data base from the value -of \\[Info-default-directory-list] and the base name \\[ocaml-info-name] -of files to look for. - -This uses info files produced by ocamldoc." - (require 'info) - (let ((collect) (seen)) - (iter '(lambda (d) - (if (member d seen) nil - (setq collect - (ocaml-ocamldoc-info-add-entries collect d - ocaml-info-prefix)) - (setq done (cons d seen)))) - Info-directory-list) - collect)) - -;; Continuing - -(defvar ocaml-info-alist 'ocaml-ocamldoc-info - "A-list binding module names to info entries: - - nil means do not use info. - - A function to build the list lazily (at the first call). The result of -the function call will be assign permanently to this variable for future -uses. We provide two default functions \\[ocaml-info-default-function] -(info produced by HeVeA is the default) and \\[ocaml-info-default-function] -(info produced by ocamldoc). - - Otherwise, this value should be an alist binding module names to info -entries of the form to \"(entry)section\" be taken by the \\[info] -command. An entry may be an info module or a complete file name." -) - -(defun ocaml-info-alist () - "Call by need value of variable ocaml-info-alist" - (cond - ((listp ocaml-info-alist)) - ((functionp ocaml-info-alist) - (setq ocaml-info-alist (apply ocaml-info-alist nil))) - (t - (error "wrong type for ocaml-info-alist"))) - ocaml-info-alist) - -;; help around point - -(defun ocaml-find-module (symbol &optional module-list) - (let ((list (or module-list (ocaml-module-alist))) - (collect)) - (while (consp list) - (if (member symbol (ocaml-module-symbols (car list))) - (setq collect (cons (car list) collect))) - (setq list (cdr list))) - (nreverse collect) - )) - -(defun ocaml-buffer-substring (region) - (and region (buffer-substring-no-properties (car region) (cdr region)))) - -;; Help function. - - -(defun ocaml-goto-help (&optional module entry same-window) - "Searches info manual for MODULE and ENTRY in MODULE. -If unspecified, MODULE and ENTRY are inferred from the position in the -current buffer using \\[ocaml-qualified-identifier]." - (interactive) - (let ((window (selected-window)) - (info-section (assoc module (ocaml-info-alist)))) - (if info-section - (caml-info-other-window (cdr info-section)) - (ocaml-visible-modules) - (let* ((module-info - (or (assoc module (ocaml-module-alist)) - (and (file-exists-p - (concat (ocaml-uncapitalize module) ".mli")) - (ocaml-get-or-make-module module)))) - (location (cdr (cadr module-info)))) - (cond - (location - (let ((file (concat location (ocaml-uncapitalize module) ".mli"))) - (if (window-live-p same-window) - (progn (select-window same-window) - (view-mode-exit view-return-to-alist view-exit-action)) - ;; (view-buffer (find-file-noselect file) 'view)) - ) - (view-file-other-window file) - (bury-buffer (current-buffer)))) - (info-section (error "Aborted")) - (t (error "No help for module %s" module)))) - ) - (if (stringp entry) - (let ((here (point)) - (case-fold-search nil)) - (goto-char (point-min)) - (if (or (re-search-forward - (concat "\\(val\\|exception\\|type\\|external\\|[|{;]\\) +" - (regexp-quote entry)) - (point-max) t) - (re-search-forward - (concat "type [^{]*{[^}]*" (regexp-quote entry) " :") - (point-max) t) - (progn - (if (window-live-p window) (select-window window)) - (error "Entry %s not found in module %s" - entry module)) - ;; (search-forward entry (point-max) t) - ) - (recenter 1) - (progn - (message "Help for entry %s not found in module %s" - entry module) - (goto-char here))))) - (ocaml-link-activate (cdr info-section)) - (if (window-live-p window) (select-window window)) - )) - -(defun caml-help (arg) - "Find documentation for OCaml qualified identifiers. - -It attemps to recognize an qualified identifier of the form -``Module . entry'' around point using function `ocaml-qualified-identifier'. - -If Module is undetermined it is temptatively guessed from the identifier name -and according to visible modules. If this is still unsucessful, the user is -then prompted for a Module name. - -The documentation for Module is first seach in the info manual if available, -then in the ``module.mli'' source file. The entry is then searched in the documentation. - -Visible modules are computed only once, at the first call. -Modules can be made visible explicitly with `ocaml-open-module' and -hidden with `ocaml-close-module'. - -Prefix arg 0 forces recompilation of visible modules (and their content) -from the file content. - -Prefix arg 4 prompts for Module and identifier instead of guessing values -from the possition of point in the current buffer. -" - (interactive "p") - (let ((module) (entry) (module-entry)) - (cond - ((= arg 4) - (or (and - (setq module - (completing-read "Module: " (ocaml-module-alist) - nil t "" (cons 'hist 0))) - (not (string-equal module ""))) - (error "Quit")) - (let ((symbols - (mapcar 'list - (ocaml-module-symbols - (assoc module (ocaml-module-alist)))))) - (setq entry (completing-read "Value: " symbols nil t))) - (if (string-equal entry "") (setq entry nil)) - ) - (t - (if (= arg 0) (setq ocaml-visible-modules 'lazy)) - (setq module-entry (ocaml-qualified-identifier)) - (setq entry (ocaml-buffer-substring (cdr module-entry))) - (setq module - (or (ocaml-buffer-substring (car module-entry)) - (let ((modules - (or (ocaml-find-module entry (ocaml-visible-modules)) - (ocaml-find-module entry))) - (hist) (default)) - (cond - ((null modules) - (error "No module found for entry %s" entry)) - ((equal (length modules) 1) - (caar modules)) - (t - (setq hist (mapcar 'car modules)) - (setq default (car hist)) - (setq module - (completing-read - (concat "Module: " - (and default (concat "[" default "] "))) - modules nil t "" (cons 'hist 0))) - (if (string-equal module "") default module)) - )))) - )) - (message "Help for %s%s%s" module (if entry "." "") (or entry "")) - (ocaml-goto-help module entry) - )) - -;; auto-links - -(defconst ocaml-link-regexp - "\\(type\\|and\\) \\('[a-z] +\\|(\\('[a-z], *\\)*'[a-z])\\|\\) *\\([a-zA-Z0-9_]*\\)\\( *$\\| =\\)") -(defconst ocaml-longident-regexp - "\\([A-Z][a-zA-Z_0]*\\)[.]\\([a-zA-Z][A-Za-z0-9_]*\\)") - -(defvar ocaml-links nil - "Local links in the current of last info node or interface file. - -The car of the list is a key that indentifies the module to prevent -recompilation when next help command is relative to the same module. -The cdr is a list of elments, each of which is an string and a pair of -buffer positions." -) -(make-variable-buffer-local 'ocaml-links) - -(defun ocaml-info-links (section) - (cdr - (if (and ocaml-links section (equal (car ocaml-links) section)) - ocaml-links - (save-excursion - (goto-char (point-min)) - (let ((regexp (concat (if (equal major-mode 'Info-mode) "^ - " "^") - ocaml-link-regexp)) - (all)) - (while (re-search-forward regexp (point-max) t) - (setq all - (cons (cons (match-string 4) - (cons (match-beginning 4) - (match-end 4))) - all))) - (setq ocaml-links (cons section all)) - ))))) - -(defvar ocaml-link-map (make-sparse-keymap)) -(define-key ocaml-link-map [mouse-2] 'ocaml-link-goto) - -(defun ocaml-link-goto (click) - (interactive "e") - (let* ((pos (caml-event-point-start click)) - (win (caml-event-window click)) - (buf (window-buffer win)) - (window (selected-window)) - (link)) - (setq link - (with-current-buffer buf - (buffer-substring - (previous-single-property-change (+ pos 1) 'local-map - buf (- pos 100)) - (next-single-property-change pos 'local-map - buf (+ pos 100))))) - (if (string-match (concat "^" ocaml-longident-regexp "$") link) - (ocaml-goto-help (match-string 1 link) (match-string 2 link) win) - (if (not (equal (window-buffer window) buf)) - (switch-to-buffer-other-window buf)) - (if (setq link (assoc link (cdr ocaml-links))) - (progn - (goto-char (cadr link)) - (recenter 1))) - (if (window-live-p window) (select-window window)) - ))) - -(cond - ((and (x-display-color-p) - (not (memq 'ocaml-link-face (face-list)))) - (make-face 'ocaml-link-face) - (set-face-foreground 'ocaml-link-face "Purple"))) - - -(defun ocaml-link-activate (section) - (let ((links (ocaml-info-links section))) - (if links - (let ((regexp (concat "[^A-Za-z0-9'_]\\(" - ocaml-longident-regexp "\\|" - (mapconcat 'car links "\\|") - "\\)[^A-Za-z0-9'_]")) - (case-fold-search nil)) - (goto-char (point-min)) - (let ((buffer-read-only nil) - ;; use of dynamic scoping, need not be restored! - (modified-p (buffer-modified-p))) - (unwind-protect - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp (point-max) t) - (put-text-property (match-beginning 1) (match-end 1) - 'mouse-face 'highlight) - (put-text-property (match-beginning 1) (match-end 1) - 'local-map ocaml-link-map) - (if (x-display-color-p) - (put-text-property (match-beginning 1) (match-end 1) - 'face 'ocaml-link-face))) - ) - ;; need to restore flag if buffer was unmodified. - (unless modified-p (set-buffer-modified-p nil)) - )) - )))) - - - -;; bindings ---now in caml.el - -; (and -; (boundp 'caml-mode-map) -; (keymapp caml-mode-map) -; (progn -; (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path) -; (define-key caml-mode-map [?\C-c?]] 'ocaml-close-module) -; (define-key caml-mode-map [?\C-c?[] 'ocaml-open-module) -; (define-key caml-mode-map [?\C-c?\C-h] 'caml-help) -; (define-key caml-mode-map [?\C-c?\t] 'caml-complete) -; (let ((map (lookup-key caml-mode-map [menu-bar caml]))) -; (and -; (keymapp map) -; (progn -; (define-key map [separator-help] '("---")) -; (define-key map [open] '("Open add path" . ocaml-add-path )) -; (define-key map [close] -; '("Close module for help" . ocaml-close-module)) -; (define-key map [open] '("Open module for help" . ocaml-open-module)) -; (define-key map [help] '("Help for identifier" . caml-help)) -; (define-key map [complete] '("Complete identifier" . caml-complete)) -; ) -; )))) - - -(provide 'caml-help) diff --git a/emacs/external/ml/caml-help.elc b/emacs/external/ml/caml-help.elc deleted file mode 100644 index 21e2c63267943b1068593e855b3946eb9d525e23..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 19348 zcwW_9`FGn!lBVCj%}~@6$7kO7(zIYXJS@@#z{8T0SxL5Mk~eWIJIA~kL5?93l(41% z1^_L|_Wti%Uv)PKkd%{|*NKNDdf{ziA6dVOJbglTP=-7V7=R;$(KXNOUEB8K#|7;HTp zzdec{dM9o_Zdhj1ei-|S*BJTn_+j5Y88wc*(YWc2_&Gli&rngk^P$BBR9zjqU=5;seH^M_+UmSdX4UMvRZfqUZj#USj* zN#qAd@dn+E;zYQE0nIHPin-aeHk+lYKNM9r7>Md&I0*)0QIS(p1F4mkMDbw%M}8o=aOn5}5FeL)4+KhawIqQJ-X^dNT4^RAQQUW#qm;7bl(@#KMi= zs_IEd6==hJ*~U3NDcnR!5D8fGkEQCs8@_W@`y}v(jWPO_?N#rsi>Bzc+cgZTv&rf< zNvLy@v%sTK#BOvhAQO?7Od{$$Irap%kQ;O?J90-p?PO)9uY3D}KN3dqOIo+~2A0#t za?(!+tI6wMMRAvYdP|O>3$WUzi2~cS_HNOq?F6XaSuZ#NeQod6=v%jjx}CMP%SE*_ zGXwC0p%?jK)ZpTA6dpycLWX!e@{@)XU;-F#G$QFZIiVRhl2DhcomFCf;wJrL5+A3! z|5_Z>A981oQ=CaoP%VzcP`Kmq==_3lLm3*ZGH6|jsXszzUjU55z#WN!H>P6Vcl7-j6Z$<% zUy()YIwOH~9YsCJU=c!i4}-ah`wt;(){+!P$lx+cD=dQa(_LQMbB6zgvIfd}j@51b z4o}}jS&z!B*2>!IHD`#P|5_+tdn_;LhFQKwpB8I?^_*@!P!s2=;6sa)npS2qLdmU^ zvjIU+KMA9A60;L`+z)9-6D-O=iwaNncLlv!^Uo1f9gv99e~dA>s#GiTcTN5#T{x3N zFi6RgjLOixFQMpfs#JEtmatdfTfz%Vi$;|^`(q>QWG#Dhqp*RT#6YMQp*yHe& zfr&LHMM9Vq=zAEQu-$Ev*{KY?k*mQoAfwcmC^r!2UNVc2vX6$#eP&UTa0W0rCv#+| z8-&yiJvdrpeVMpN8NtK$$;Izt(YwE62@@LTAXV!uWl#tEhXP9&$=A}hM8xN*h%qWs z=^7xhx3mqzWZssoS#}5C?roSYy*!Ou9|lsOHY0b!$&oR2+H;0941PgLqnS~U_3QzVO! z_2EICfE0BMF$Z}$bY;0kn^WN>6B&nn!MjJBa3H!YOx=!nc9wV~CW|(kr7E4xP(1zS z6Z=;Rk0|GHoPtVfNfu5Q@2uB!s^~h0mcc6ySyFUn*}Wi zYuNpzm$!@C%f+4D-Rlqp7)*#uXPMFHMqOLG(LinojchVXGRqKnr?cCzVB*sSbPwZj zM4CaM!5ay-IdV@92d=1&Yoa;_EmZ|9WXm2J7zEg);&@M|!wA7o$c7qRZL!|a2np4- zvUNLcTDqqO?_0+dPe7;-F(XpjckXE7VT(v@eb~|kvs$oIxk=|pi4zpGL1VLN%rJ@E zlZ%Is)_4lGnu6WhY%et3M_$q(E^^|&_0-c-%*aR&$*mF|Hsyk?BAcN0=WKsFPOuB9 z+TCT1UEaO6q}5e51{_=<6$|F1^o8z>SZgk@uj(0y0V{DjZaGq$j0%nSCWO6%A$Iq8 zXb}6hDdFyx6EHNj2zj=Zd2MxHUBM$#KOUfB8xLMh4RM zmMGFibBsZ_vUoB@riUP0pO|laesUO&GSJ?@%7Q&?--MuamI{)s++rZ!-mcvtYQUE} zwY!+#>I#3BonQw7XA@%$b}%I}`$NV7%eHXCE|h=2ePbo%zQ6(N)#oU%%PZ;xVq$e{ zz7EP|$7-9nE|;61z1aGY2PTmTSK- zPs6Zp7kJCp(rc#jMakrNm(%ljRw-HiKT-&fft<;MqWan9$BL(-~u7` zKOT_96R77l-tRR2@pG%OSvkmksq;DG<7*-6`yUSKy7JEl`&0!NREsN#EwTUlu@fA~ z&-!E9%aH8YI2?m~$rZ`lQH!9{#cL@Us%y~t#z^Bzls?5FZb~nS&!m$@<8@i$J zgiNRR&LiAGQ*$TMcYf^SG^BAfOS#$|+XUresMJ`mcT+ZAS=h<~Ri5o<{!l89{ZHt` zVOrjyI_tC19YA95rP#zqd+jERa8dH8iaflm6?ZQKgROF*mbW0Y-7B%W&>|RnUi8k5 ziF(8frRlY(^ID5KM1VG5%Sj~_0fUIu%rTTCUUa2sK`? zYyR%X!c{b_S^C>C_1uR=CWcQU(+5Qwoo@)tfY~*PH@rV2aglf%gr})cG#A)qOeA9o z-RMXk%-ZDw+rFE6CkQew*W{UPgNXFEzYCMT1-iF{Q zvLjS4oAe{aUII)|yrd}>NJMURQjvfV@FsSCbeKnD|Ctzk#q>=m6WnV5VXCHVqF9!C zDY@3hdAkNNcu8Lk>1$xiDh+Y3Fs*gjQ3o#)zbkmA$A>7gJA7K_uJhvaDW#9e438sk z=$|!$$%z;F{e~p8ZFyi(^!dARX0fqoyfDVRu;uoApQPpWY$*w%-KDtLF}lx5 zS&jhoeDQ=H%vgYUY8Qa1v-tO$+(y8RBbykb>9IDIC$R5DFcMBivIlhCByTxrN_8UY6Omp=FITrf8!yNC8I{Onw1Uf>*o}_a<+MVs%HGR2LyUtK=S$07h26;(ina)U!MBA)7Y*E!q#kM$PgrEjz;xHvmv87~JX?z^D}sQROcrkWsG{ z$F^Hv0T>6D$`!Qs%_S-_SJqam^xG=q6TZGxEJts(P6gr4Ck{qJlp{I?{>v}UW3c$Ec3uAZ7b*#tk7oVl{`j407^zEJu zBUsOA7tzoDu?h+FEg}uK6DuxHY)6f(7EpMf)JF zx6FH1uJmOcdI(#FuG{4=XfrIcKI;XO20mxz54|G+DAxAj6Qqc#)J0}vj)zNZ0QK&> zV9x{kxY)L2NrtFvEB@3UNLLc#S#EHi90TP*{Cv3jQg=;7>i9KkJrylo_L5b>eEVb9RY-RJaV(6 zm!73FU|^;+hmv}b8f=g0i372zlN-9N9^u|t9gw>nvBzgG_Ez=TQo#)>LskPX?nnM1 z)_de1Ms6xG1l`{go2SQ`T>aEXIKop|I1@L8jQeUzo*gf&ms3d9q zOHj2I0*mG{ajQGPgu60Uy-EQ1SX}_}hfLwZvvdh;ul-9DlLWQ@LR5m0f;_=EA)3NSpP?4*MO0)jZU`o#W#6%n{ys@vmV(L5T z+R=OYt-|%$mHNF>f_;-J&8=NHa?$B_Ji|G9I5gr!z9d56rsh*$Xe-^p4JCSYnj7x~>1bniBFL^~86a zU@UF>-PGQ)4@G-Kt=7^&?ksKlpQWjU9lWis+H0WZon;kZ-YqP{#*}Zt5IVzGh%qCC z!+v|44~-nXUcHU>5cIaq^6j;h5I9r6empA%4#bLJx_J!YhK9MRtOrTgS- z?%?~>3moCXME4}Q&XG@=;@Ijh`k796bx`Ge9xppEQFNjF#hB*N-i zgL(MI!HQcNgn_3HU8);CS?S=h+3NHbAI$l45cdBGVDHG}1Lkyrqauq%4Fkp78U~g! zD4^qu!+g9oi^RPDsraj&jo051_-u)b@DV9<*^Hv!h~HVfR+&XDskUcyu8BpXCA2mx zO}Zn-D{GYvvWl)eje%cCMev~OV9i9YoNCfw7!1!>e*tDGKFdN z@=%q7sRPl0*gjJ5v-$rRezamOj8J8jE{8#xwBSw(NL{6B|0E#k%wg{2-$$p5k>dXX zpv<22s3xl1w761hHv~zj=_CcSOZRa+=1k(jMZxFlrgrw+~8HUWGY}#{sjc*3?+a z|LLamX4iND)1cgjo)qFs@o_kzl{{o!bbocjN?Kg9(G!aLX(h1DQ(|ka8>&GZ*Qll1$68ZO&(JZ~nHl zv1z*tR6o;cE@gmU3y@i~czHl@qH_AKfP8%*p8}9+N$=!XBk*YiPoK1f;rx6FXRUO4 zn=Nx8GsvFlk+aP%+e|{4G9GA8dGNcRac~BHyUtDa?y$4w9ymLJSb)S*q?5MnJIK~r z+P%VAODZwT2@q>gd<|vV&!MPApJ}kws>-=Y!OXUhTPPI zIx3M5v7R&@tAcW~4>tl}UPu^_Fom|I4eRw(OjBD55@Cc&u`SPEJpJ+8XEF%*-4Cz+ z&Yoc|Yr-)+3F5KWXAjcGd|g)}J8d}LanYu49LB!(7Ss1qUxq)`XqAWi(~j*0LVFY@ zAzS=>OfN$i&P9xb&r^~a8Rui?tIVJ7>_F8IzKrF z@Kb8nLHWME(H^S#=K+@vq(svysrC*oL~d;o%{hm0qC$2)L|`#L<7_Ry8+*`Qk}_2- z>;BAu*z`LGwRLS-?>A)37QIC5_;z2%4YqTLQBdr}xRsKJTpWvBJ?c06m}PxBv0OV@~sX zFcauYgu(E?|N6s0{lot2|2cq*LTu5;GuGGpnFPZbS1Pec4^CX7>*;ytYdv)D*PfQ^ zJMx3K4Nm@XwGqxBgj_(Gm4N&~xr1DY_2macZRPvOAsmLIfm$SinAJ3A$+X+uF7sCT zhDX~Jf5vf;>^LVZxT#B7MiLi=1>=7ql9-_}r8jSsBTvN@D;4pn$l{xe@wc)lC`fy8 z!f7KUdZ2eS$i$U-RpMyEUf!t*$Oao|#bvrkzaK^e<@cYBB8qQ@lGf4xaRN$9mS=*O z^@fwthTuktvLZGJ4jh0e(g4(}m98Eub1WQ;yah`?osT5gw3Gc~o!FAKi*zD!-?{z> zd}>2>r)s@D-WLm_OwgA@!N_dpw*R6b60b zyK~2aX6d{ zJMU5IDTmcrg{i)dM0y2>xI*G_1>7KIWFDHJI<}qdx*z-pX?a%rN znt{eS2lHaQ7Z)5w=Feat5b9Ez-K;e>bWBwyYZ?m-_x%|E$w28Wt=G;6y<}(8fT!7h z)NSdA=j{9L#ofzbyLj8ilGp94&h(9TrSy$a=nfjWoPQz*%Il~~=)B5{qKiR*6x|^l zQZF)8kd%HP9#CO5{knnZS*{A#*YR$|R~%V0W>VdMZt3i| z>BHHiHyMyqZ`@m(w)i&W_nT-k@hr>{{Egf=QNA~<7jl3=s)nw%TGCc>?$&VXkK$zN zw;o&{2-F2yQlwW$2|xmGjrWdjmGUNmbFu>>h>~k+$E+XcUOhxhU}LJerX0v1lAY_9 zFT4>9X1pQTR#U<0u@9q-#A}^J%H%?fT_2MuDe9{aq49#h7l5^57o!xeUd!D4ZLehT zqYDo4d}5I8!b>4fBs!(=nmoN-D-^evrp|MIA^RyO@2JyR;7n8h?X`lVQe$LxX=`~8 zz;)*?5Nl=Xoc~jLKIQZyl|9{Hj6| zH0nQXz}p#*-G~?s$ujQ9tTKE9niHRFSO?js0Y-R5Xwe^jP`9zceWF)yb%MbfC!G~J z2!b;!LQkfUIR??Pj#Jx9KVYMlVYxg1Sa&$_J}q#Z^$)chjv@tR#GTETGTLnK7P8y` zh4Qk4%YaQ?DCx*>ZCSrL@*SJ~Wlb-7E9E;o(%#-co5O;%=XZCub;6jaqa<6bYO7)m9Zc+MU#DsZBd;Op}mC zq~Y1#8`2ightwt38ZL{ygfF1W-jO^>8hew77z`O8`ywSt&)Yd9l&S)u<3Bj@y@aA{{0L-Fx>>nME=qJgj^}Nt>)mh0^0|A|G$Rl&k7|1woRR_7Ir@UI}e*rZh B4$%Mr diff --git a/emacs/external/ml/caml-hilit.el b/emacs/external/ml/caml-hilit.el deleted file mode 100644 index c4160d9..0000000 --- a/emacs/external/ml/caml-hilit.el +++ /dev/null @@ -1,67 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Jacques Garrigue and Ian T Zimmerman *) -;(* *) -;(* Copyright 1997 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: caml-hilit.el,v 1.8.4.1 2004/08/09 16:09:33 doligez Exp $ *) - -; Highlighting patterns for hilit19 under caml-mode - -; defined also in caml.el -(defvar caml-quote-char "'" - "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.") - -(defconst caml-mode-patterns - (list -;comments - '("\\(^\\|[^\"]\\)\\((\\*[^*]*\\*+\\([^)*][^*]*\\*+\\)*)\\)" - 2 comment) -;string - (list 'hilit-string-find (string-to-char caml-quote-char) 'string) - (list (concat caml-quote-char "\\(\\\\\\([ntbr" caml-quote-char "\\]\\|" - "[0-9][0-9][0-9]\\)\\|.\\)" caml-quote-char) - nil - 'string) -;labels - '("\\(\\([~?]\\|\\<\\)[a-z][a-zA-Z0-9_']*:\\)[^:=]" 1 brown) - '("[~?][ (]*[a-z][a-zA-Z0-9_']*" nil brown) -;modules - '("\\<\\(assert\\|open\\|include\\)\\>" nil brown) - '("`?\\<[A-Z][A-Za-z0-9_\']*\\>" nil MidnightBlue) -;definition - (list (concat - "\\<\\(a\\(nd\\|s\\)\\|c\\(onstraint\\|lass\\)" - "\\|ex\\(ception\\|ternal\\)\\|fun\\(ct\\(ion\\|or\\)\\)?" - "\\|in\\(herit\\)?\\|let\\|m\\(ethod\\|utable\\|odule\\)" - "\\|of\\|p\\(arser\\|rivate\\)\\|rec\\|type" - "\\|v\\(al\\|irtual\\)\\)\\>") - nil 'ForestGreen) -;blocking - '("\\<\\(object\\|struct\\|sig\\|begin\\|end\\)\\>" 2 include) -;control - (list (concat - "\\<\\(do\\(ne\\|wnto\\)?\\|else\\|for\\|i\\(f\\|gnore\\)" - "\\|lazy\\|match\\|new\\|or\\|t\\(hen\\|o\\|ry\\)" - "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>" - "\\|\|\\|->\\|&\\|#") - nil 'keyword) - '(";" nil struct)) - "Hilit19 patterns used for Caml mode") - -(hilit-set-mode-patterns 'caml-mode caml-mode-patterns) -(hilit-set-mode-patterns - 'inferior-caml-mode - (append - (list -;inferior - '("^[#-]" nil firebrick)) - caml-mode-patterns)) - -(provide 'caml-hilit) diff --git a/emacs/external/ml/caml-types.el b/emacs/external/ml/caml-types.el deleted file mode 100644 index 08c9fd0..0000000 --- a/emacs/external/ml/caml-types.el +++ /dev/null @@ -1,572 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Damien Doligez, projet Moscova, INRIA Rocquencourt *) -;(* *) -;(* Copyright 2003 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: caml-types.el,v 1.29.6.2 2004/11/15 12:50:54 doligez Exp $ *) - -; An emacs-lisp complement to the "-dtypes" option of ocamlc and ocamlopt. - -;; XEmacs compatibility - -(eval-and-compile - (if (and (boundp 'running-xemacs) running-xemacs) - (require 'caml-xemacs) - (require 'caml-emacs))) - - - -(defvar caml-types-location-re nil "Regexp to parse *.annot files. - -Annotation files *.annot may be generated with the \"-dtypes\" option -of ocamlc and ocamlopt. - -Their format is: - - file ::= block * - block ::= position position annotation * - position ::= filename num num num - annotation ::= keyword open-paren data close-paren - - is a space character (ASCII 0x20) - is a line-feed character (ASCII 0x0A) - num is a sequence of decimal digits - filename is a string with the lexical conventions of O'Caml - open-paren is an open parenthesis (ASCII 0x28) - close-paren is a closed parenthesis (ASCII 0x29) - data is any sequence of characters where is always followed by - at least two space characters. - -- in each block, the two positions are respectively the start and the -- end of the range described by the block. -- in a position, the filename is the name of the file, the first num - is the line number, the second num is the offset of the beginning - of the line, the third num is the offset of the position itself. -- the char number within the line is the difference between the third - and second nums. - -For the moment, the only possible keyword is \"type\"." -) - -(let* ((caml-types-filename-re "\"\\(\\([^\\\"]\\|\\\\.\\)*\\)\"") - (caml-types-number-re "\\([0-9]*\\)") - (caml-types-position-re - (concat caml-types-filename-re " " - caml-types-number-re " " - caml-types-number-re " " - caml-types-number-re))) - (setq caml-types-location-re - (concat "^" caml-types-position-re " " caml-types-position-re))) - -(defvar caml-types-expr-ovl (make-overlay 1 1)) - -(make-face 'caml-types-face) -(set-face-doc-string 'caml-types-face - "face for hilighting expressions and types") -(if (not (face-differs-from-default-p 'caml-types-face)) - (set-face-background 'caml-types-face "#88FF44")) - -(defvar caml-types-typed-ovl (make-overlay 1 1)) - -(make-face 'caml-types-typed-face) -(set-face-doc-string 'caml-types-typed-face - "face for hilighting typed expressions") -(if (not (face-differs-from-default-p 'caml-types-typed-face)) - (set-face-background 'caml-types-typed-face "#FF8844")) - -(overlay-put caml-types-expr-ovl 'face 'caml-types-face) -(overlay-put caml-types-typed-ovl 'face 'caml-types-typed-face) - - -(defvar caml-types-annotation-tree nil) -(defvar caml-types-annotation-date nil) -(make-variable-buffer-local 'caml-types-annotation-tree) -(make-variable-buffer-local 'caml-types-annotation-date) - -(defvar caml-types-buffer-name "*caml-types*" - "Name of buffer for diplaying caml types") -(defvar caml-types-buffer nil - "buffer for diplaying caml types") - -(defun caml-types-show-type (arg) - "Show the type of expression or pattern at point. - The smallest expression or pattern that contains point is - temporarily highlighted. Its type is highlighted in the .annot - file and the mark is set to the beginning of the type. - The type is also displayed in the mini-buffer. - - Hints on using the type display: - . If you want the type of an identifier, put point within any - occurrence of this identifier. - . If you want the result type of a function application, put point - at the first space after the function name. - . If you want the type of a list, put point on a bracket, on a - semicolon, or on the :: constructor. - . Even if type checking fails, you can still look at the types - in the file, up to where the type checker failed. - -Types are also displayed in the buffer *caml-types*, which is -displayed when the command is called with Prefix argument 4. - -See also `caml-types-explore' for exploration by mouse dragging. -See `caml-types-location-re' for annotation file format. -" - (interactive "p") - (let* ((target-buf (current-buffer)) - (target-file (file-name-nondirectory (buffer-file-name))) - (target-line (1+ (count-lines (point-min) - (caml-line-beginning-position)))) - (target-bol (caml-line-beginning-position)) - (target-cnum (point)) - (type-file (concat (file-name-sans-extension (buffer-file-name)) - ".annot"))) - (caml-types-preprocess type-file) - (unless caml-types-buffer - (setq caml-types-buffer (get-buffer-create caml-types-buffer-name))) - (let* ((targ-loc (vector target-file target-line target-bol target-cnum)) - (node (caml-types-find-location targ-loc () - caml-types-annotation-tree))) - (cond - ((null node) - (delete-overlay caml-types-expr-ovl) - (message "Point is not within a typechecked expression or pattern.") - ; (with-current-buffer type-buf (narrow-to-region 1 1)) - ) - (t - (let ((left (caml-types-get-pos target-buf (elt node 0))) - (right (caml-types-get-pos target-buf (elt node 1))) - (type (elt node 2))) - (move-overlay caml-types-expr-ovl left right target-buf) - (with-current-buffer caml-types-buffer - (erase-buffer) - (insert type) - (message (format "type: %s" type))) - )))) - (if (and (= arg 4) - (not (window-live-p (get-buffer-window caml-types-buffer)))) - (display-buffer caml-types-buffer)) - (unwind-protect - (caml-sit-for 60) - (delete-overlay caml-types-expr-ovl) - ))) - -(defun caml-types-preprocess (type-file) - (let* ((type-date (nth 5 (file-attributes type-file))) - (target-file (file-name-nondirectory (buffer-file-name))) - (target-date (nth 5 (file-attributes target-file)))) - (unless (and caml-types-annotation-tree - type-date - caml-types-annotation-date - (not (caml-types-date< caml-types-annotation-date type-date))) - (if (and type-date target-date (caml-types-date< type-date target-date)) - (error (format "%s is more recent than %s" target-file type-file))) - (message "Reading annotation file...") - (let* ((type-buf (caml-types-find-file type-file)) - (tree (with-current-buffer type-buf - (widen) - (goto-char (point-min)) - (caml-types-build-tree target-file)))) - (setq caml-types-annotation-tree tree - caml-types-annotation-date type-date) - (kill-buffer type-buf) - (message "")) - ))) - -(defun caml-types-date< (date1 date2) - (or (< (car date1) (car date2)) - (and (= (car date1) (car date2)) - (< (nth 1 date1) (nth 1 date2))))) - - -; we use an obarray for hash-consing the strings within each tree - -(defun caml-types-make-hash-table () - (make-vector 255 0)) - -(defun caml-types-hcons (elem table) - (symbol-name (intern elem table))) - - -; tree of intervals -; each node is a vector -; [ pos-left pos-right type-info child child child... ] -; type-info = -; () if this node does not correspond to an annotated interval -; (type-start . type-end) address of the annotation in the .annot file - -(defun caml-types-build-tree (target-file) - (let ((stack ()) - (accu ()) - (table (caml-types-make-hash-table)) - (type-info ())) - (while (re-search-forward caml-types-location-re () t) - (let ((l-file (file-name-nondirectory (match-string 1))) - (l-line (string-to-int (match-string 3))) - (l-bol (string-to-int (match-string 4))) - (l-cnum (string-to-int (match-string 5))) - (r-file (file-name-nondirectory (match-string 6))) - (r-line (string-to-int (match-string 8))) - (r-bol (string-to-int (match-string 9))) - (r-cnum (string-to-int (match-string 10)))) - (unless (caml-types-not-in-file l-file r-file target-file) - (while (and (re-search-forward "^" () t) - (not (looking-at "type")) - (not (looking-at "\\\""))) - (forward-char 1)) - (setq type-info - (if (looking-at - "^type(\n\\( \\([^\n)]\\|.)\\|\n[^)]\\)*\\)\n)") - (caml-types-hcons (match-string 1) table))) - (setq accu ()) - (while (and stack - (caml-types-pos-contains l-cnum r-cnum (car stack))) - (setq accu (cons (car stack) accu)) - (setq stack (cdr stack))) - (let* ((left-pos (vector l-file l-line l-bol l-cnum)) - (right-pos (vector r-file r-line r-bol r-cnum)) - (node (caml-types-make-node left-pos right-pos type-info - accu))) - (setq stack (cons node stack)))))) - (if (null stack) - (error "no annotations found for this source file") - (let* ((left-pos (elt (car (last stack)) 0)) - (right-pos (elt (car stack) 1))) - (if (null (cdr stack)) - (car stack) - (caml-types-make-node left-pos right-pos () (nreverse stack))))))) - -(defun caml-types-not-in-file (l-file r-file target-file) - (or (and (not (string= l-file target-file)) - (not (string= l-file ""))) - (and (not (string= r-file target-file)) - (not (string= r-file ""))))) - -(defun caml-types-make-node (left-pos right-pos type-info children) - (let ((result (make-vector (+ 3 (length children)) ())) - (i 3)) - (aset result 0 left-pos) - (aset result 1 right-pos) - (aset result 2 type-info) - (while children - (aset result i (car children)) - (setq children (cdr children)) - (setq i (1+ i))) - result)) - -(defun caml-types-pos-contains (l-cnum r-cnum node) - (and (<= l-cnum (elt (elt node 0) 3)) - (>= r-cnum (elt (elt node 1) 3)))) - -(defun caml-types-find-location (targ-pos curr node) - (if (not (caml-types-pos-inside targ-pos node)) - curr - (if (elt node 2) - (setq curr node)) - (let ((i (caml-types-search node targ-pos))) - (if (and (> i 3) - (caml-types-pos-inside targ-pos (elt node (1- i)))) - (caml-types-find-location targ-pos curr (elt node (1- i))) - curr)))) - -; trouve le premier fils qui commence apres la position -; ou (length node) si tous commencent avant -(defun caml-types-search (node pos) - (let ((min 3) - (max (length node)) - med) - (while (< min max) - (setq med (/ (+ min max) 2)) - (if (caml-types-pos<= (elt (elt node med) 0) pos) - (setq min (1+ med)) - (setq max med))) - min)) - -(defun caml-types-pos-inside (pos node) - (let ((left-pos (elt node 0)) - (right-pos (elt node 1))) - (and (caml-types-pos<= left-pos pos) - (caml-types-pos> right-pos pos)))) - -(defun caml-types-find-interval (buf targ-pos node) - (let ((nleft (elt node 0)) - (nright (elt node 1)) - (left ()) - (right ()) - i) - (cond - ((not (caml-types-pos-inside targ-pos node)) - (if (not (caml-types-pos<= nleft targ-pos)) - (setq right nleft)) - (if (not (caml-types-pos> nright targ-pos)) - (setq left nright))) - (t - (setq left nleft - right nright) - (setq i (caml-types-search node targ-pos)) - (if (< i (length node)) - (setq right (elt (elt node i) 0))) - (if (> i 3) - (setq left (elt (elt node (1- i)) 1))))) - (cons (if left - (caml-types-get-pos buf left) - (with-current-buffer buf (point-min))) - (if right - (caml-types-get-pos buf right) - (with-current-buffer buf (point-max)))))) - - -;; Warning: these comparison functions are not symmetric. -;; The first argument determines the format: -;; when its file component is empty, only the cnum is compared. - -(defun caml-types-pos<= (pos1 pos2) - (let ((file1 (elt pos1 0)) - (line1 (elt pos1 1)) - (bol1 (elt pos1 2)) - (cnum1 (elt pos1 3)) - (file2 (elt pos2 0)) - (line2 (elt pos2 1)) - (bol2 (elt pos2 2)) - (cnum2 (elt pos2 3))) - (if (string= file1 "") - (<= cnum1 cnum2) - (and (string= file1 file2) - (or (< line1 line2) - (and (= line1 line2) - (<= (- cnum1 bol1) (- cnum2 bol2)))))))) - -(defun caml-types-pos> (pos1 pos2) - (let ((file1 (elt pos1 0)) - (line1 (elt pos1 1)) - (bol1 (elt pos1 2)) - (cnum1 (elt pos1 3)) - (file2 (elt pos2 0)) - (line2 (elt pos2 1)) - (bol2 (elt pos2 2)) - (cnum2 (elt pos2 3))) - (if (string= file1 "") - (> cnum1 cnum2) - (and (string= file1 file2) - (or (> line1 line2) - (and (= line1 line2) - (> (- cnum1 bol1) (- cnum2 bol2)))))))) - -(defun caml-types-get-pos (buf pos) - (save-excursion - (set-buffer buf) - (goto-line (elt pos 1)) - (forward-char (- (elt pos 3) (elt pos 2))) - (point))) - -; find-file-read-only-noselect seems to be missing from emacs... -(defun caml-types-find-file (name) - (let (buf) - (cond - ((setq buf (get-file-buffer name)) - (unless (verify-visited-file-modtime buf) - (if (buffer-modified-p buf) - (find-file-noselect name) - (with-current-buffer buf (revert-buffer t t))) - )) - ((and (file-readable-p name) - (setq buf (find-file-noselect name))) - (with-current-buffer buf (toggle-read-only 1)) - ) - (t - (error "No annotation file. You should compile with option \"-dtypes\".")) - ) - buf)) - -(defun caml-types-mouse-ignore (event) - (interactive "e") - nil) - -(defun caml-types-time () - (let ((time (current-time))) - (+ (* (mod (cadr time) 1000) 1000) - (/ (cadr (cdr time)) 1000)))) - -(defun caml-types-explore (event) - "Explore type annotations by mouse dragging. - -The expression under the mouse is highlighted and its type is displayed -in the minibuffer, until the move is released, much as `caml-types-show-type'. -The function uses two overlays. - - . One overlay delimits the largest region whose all subnodes - are well-typed. - . Another overlay delimits the current node under the mouse (whose type - annotation is beeing displayed). -" - (interactive "e") - (set-buffer (window-buffer (caml-event-window event))) - (let* ((target-buf (current-buffer)) - (target-file (file-name-nondirectory (buffer-file-name))) - (type-file (concat (file-name-sans-extension (buffer-file-name)) - ".annot")) - (target-line) (target-bol) - target-pos - Left Right limits cnum node mes type - region - (window (caml-event-window event)) - target-tree - (speed 100) - (last-time (caml-types-time)) - (original-event event) - ) - (select-window window) - (unwind-protect - (progn - (caml-types-preprocess type-file) - (setq target-tree caml-types-annotation-tree) - (unless caml-types-buffer - (setq caml-types-buffer - (get-buffer-create caml-types-buffer-name))) - ;; (message "Drag the mouse to explore types") - (unwind-protect - (caml-track-mouse - (while event - (cond - ;; we ignore non mouse events - ((caml-ignore-event-p event)) - ;; we stop when the original button is released - ((caml-release-event-p original-event event) - (setq event nil)) - ;; we scroll when the motion is outside the window - ((and (caml-mouse-movement-p event) - (not (and (equal window (caml-event-window event)) - (integer-or-marker-p - (caml-event-point-end event))))) - (let* ((win (caml-window-edges window)) - (top (nth 1 win)) - (bottom (- (nth 3 win) 1)) - mouse - time - ) - (while (and - (caml-sit-for 0 (/ 500 speed)) - (setq time (caml-types-time)) - (> (- time last-time) (/ 500 speed)) - (setq mouse (caml-mouse-vertical-position)) - (or (< mouse top) (>= mouse bottom)) - ) - (setq last-time time) - (cond - ((< mouse top) - (setq speed (- top mouse)) - (condition-case nil - (scroll-down 1) - (error (message "Beginning of buffer!")))) - ((>= mouse bottom) - (setq speed (+ 1 (- mouse bottom))) - (condition-case nil - (scroll-up 1) - (error (message "End of buffer!")))) - ) - (setq speed (* speed speed)) - ))) - ;; main action, when the motion is inside the window - ;; or on orginal button down event - ((or (caml-mouse-movement-p event) - (equal original-event event)) - (setq cnum (caml-event-point-end event)) - (if (and region - (<= (car region) cnum) (< cnum (cdr region))) - ;; mouse remains in outer region - nil - ;; otherwise, reset the outer region - (setq region - (caml-types-typed-make-overlay - target-buf (caml-event-point-start event)))) - (if - (and limits - (>= cnum (car limits)) (< cnum (cdr limits))) - ;; inner region is unchanged - nil - ;; recompute the inner region and type annotation - (setq target-bol - (save-excursion - (goto-char cnum) (caml-line-beginning-position)) - target-line (1+ (count-lines (point-min) - target-bol)) - target-pos - (vector target-file target-line target-bol cnum)) - (save-excursion - (setq node (caml-types-find-location - target-pos () target-tree)) - (set-buffer caml-types-buffer) - (erase-buffer) - (cond - (node - (setq Left - (caml-types-get-pos target-buf (elt node 0)) - Right - (caml-types-get-pos target-buf (elt node 1))) - (move-overlay - caml-types-expr-ovl Left Right target-buf) - (setq limits - (caml-types-find-interval target-buf - target-pos node) - type (elt node 2)) - ) - (t - (delete-overlay caml-types-expr-ovl) - (setq type "*no type information*") - (setq limits - (caml-types-find-interval - target-buf target-pos target-tree)) - )) - (setq mes (format "type: %s" type)) - (insert type) - )) - (message mes) - ) - ) - ;; we read next event, unless it is nil, and loop back. - (if event (setq event (caml-read-event))) - ) - ) - ;; delete overlays at end of exploration - (delete-overlay caml-types-expr-ovl) - (delete-overlay caml-types-typed-ovl) - )) - ;; When an error occurs, the mouse release event has not been read. - ;; We could wait for mouse release to prevent execution of - ;; a binding of mouse release, such as cut or paste. - ;; In most common cases, next event will be the mouse release. - ;; However, it could also be a key stroke before mouse release. - ;; Emacs does not allow to test whether mouse is up or down. - ;; Not sure it is robust to loop for mouse release after an error - ;; occured, as is done for exploration. - ;; So far, we just ignore next event. (Next line also be uncommenting.) - (if event (caml-read-event)) - ))) - -(defun caml-types-typed-make-overlay (target-buf pos) - (interactive "p") - (let ((start pos) (end pos) len node left right) - (setq len (length caml-types-annotation-tree)) - (while (> len 3) - (setq len (- len 1)) - (setq node (aref caml-types-annotation-tree len)) - (if (and (equal target-buf (current-buffer)) - (setq left (caml-types-get-pos target-buf (elt node 0)) - right (caml-types-get-pos target-buf (elt node 1))) - (<= left pos) (> right pos) - ) - (setq start (min start left) - end (max end right)) - )) - (move-overlay caml-types-typed-ovl - (max (point-min) (- start 1)) - (min (point-max) (+ end 1)) target-buf) - (cons start end))) - -(provide 'caml-types) diff --git a/emacs/external/ml/caml-types.elc b/emacs/external/ml/caml-types.elc deleted file mode 100644 index 0b9dbca2763206eb3ad4e4b39a669a7b91ca8cf5..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 13421 zcwWUiiE`UUmQ2;whLlQ3d~xC&OpB6ZQWj_e;33OSA|IpQEl1exc8BJU;%F*HFk1}wAI?t4 z$wN8y28n4~E$3n4r_v1kWcG02O#?H%n8~Ci1DfcE;weIkGZ`m7EQ2#z7LA?z=>&*L zlJP{TO*Y^-|#{`)hDOB$)gAUy73;8k~w9=;Al* zn?;~BNXwI>pT8=!ethU$9|e92GU*`l=LD$oIt+y2LL{Z!ZR6? zSwJj5-TxL&1!fmEi}OS35Yz$F6X?r#u!lqycFrqO$MA|Nk8ldHjj&%VY$e-xBF-lg z#5dzkaPD1z&5D8`Iwwm^nhgIyZUX6ntxC_MWnQEBnrObHH<+*x?Gg_VR*MH9hlOI9 z%;X^T&tz~xAW7=QDTynz0EIgv5LBw+M`6eS7R6OBfROf|L>IrhmQ;8Bh;9BSVaKfY#erZFH# zG8o}rup9ZQXdp3y{bi&nJVSppg7d;-Jdx?SlwrOe>D916I3CM0u%`$yjiw+ZOkETL z?}3KIKLHD%l@C^^qcy3wK3{7L<>(BE$qly&Oecjk;SfVV5RI*E(GvYmAMEs!o$Y-D zkN(}V>sakd;bHgM?|%%hmK$P+8~%Fh0YG-$(KolD1Fdcs&2wiPjIiavUk7Zk<<{@O zYZv}{$|hTVY`BiycI(_@TWYx7*@MZptpJ=1pp&m+cL?zL(kj*4yo}u~EMsFwueglO zG`g-@hambI!f9{7gQ(fkJ;rVBvb(y=&WUksLU#t(9H$EGaSD_=Oey**9{&`cT{Vd? zbu|#WsKRk+MKHB*;%=6%rA{r5OWnm2AIxJkGSKG@F_KD)fZ*0*Gdc_4@awMIfd5~= zab355?7II2zi!KQn>+C5*6RWRUboFh$JhZ){O?U&d()|RDgl#>1MqnkH%DY@3OmC# zC=PzMw=&Lz*xZ zU_uKcLfLN);}8W!T*}qK0mY{{1N{O7g$q7KI|{^_QLdNpf+PYqCdkKpm8l>4if1hh zjKp&wJ;A(bo{-#W3~J^+!nDK>BXJSUAtZ-=7P$%Wh(E-zW#pqrM1f>xD8~d51xE(a zfNjG-`B@+^pV(Tx2=E);)yTul38Q+PO<~n) znNTWJ)XrT%>O+tQGM$6NIy?cgvMI`^k4a1r=v?Dx$T0o4u+VspQH1Eg+DB5YTFCCu z69iE#?~|r;gQI*1-KG&F!D1MDV-WIjix3p&7TgWb_ZAZ(mA$mq*jjjj4{7B60)hlA z0=|&7cSBxTD+wPZC*w8b!HdT1RoqgzFG##K8XlALy;Gp7L83sv4loYJb75e7klQdrh*KeVMlHHfvTA0dAdB;majJ}(^0v%GW>HH4 zVd8}-gQ*O;9Kn`%!DoZbpT*Gt48Kr2!Bq#bM4x#^v@8T0emKk|lYG%o1~Scqlqq2H zAWNzLtXze_lwBK1+BU20aJ9o}El`If!M;Qrf*%_+<}6 zHNzn&Kme%~1Tlrp@qo4t8bzbAw38J9U9-u(z-SXSve#bWps$Dt@bHmy*M=~dF{}zC zNsD82qmXotQnWnBqNn2k%dt_n>&MM2EJ5Lr!4zbo*W~O3wY|K#NA`fMz~;xg+YLAO zK5<7N?OnHCs;J)$^^2xrqvF=T{u(<5H12#^TIU}et*m1npjw<-U`i2|wPK-CS$%CB z+U3pK?bx_Y%KT4!$dfG52sfK#R_@%c+(E@QZWnNXP1$*%l`>N;dZXxXg?3W^HHUFc zEZJop1Br!1e4fhWUsvKBDPnpexFo3M_g;b;GmWS)Fp%V@!B3(q=Q-vO$dS#lnh;MCmIZR1W?I2hjUd z3188;cH#B#pmIq4crb+-$HKmH1&Y)sUNSLLjMZT+v@~2@I zkA-t3;t7T+NIEDwSYSlXDnKRAa)lfOq0IqAaxn$l&8G(z4NTOr=v=u(fx)P0xzuT0 z!^|4JE0qQAe*6h3-H7$gvbM-4Iph@44YST{ZgL_{t=>YbUu@ZJYN>g)wJ>Hcw48+& ztngWFs|H@Y_C@V}tx;>DGd7yWJ!5B!Jz~F8V*6nC7Koje$TfpQCfAuYt*mKv=GxsK z=~2q@yBCzhXS)Rce~7qmt}D;n!|{&s#m4%Mr_u zB4C~eG{jLB{1iP0gMlBW*o53Ny&)~f!m_Tk4n;PCc~Ds6OUTilf-`kcX*wIFGMXoB zqMz-3RC2?LZgsI$97Z`?L9JS&UVo?IC59q#m-m;;?_dIE4w77D)ym&fu;7w~s8g{M z^^9_g^&d$4Lo!UGyy0xnJKa0&;+Dz>+;R9}<;4wDr@PR*qqd|M6uwTDucfc(793I^ ziXgAE+zY}+heKkZH4wPMr^3AM;Efpm{)UHegN_6%w}p}4v(v~hXl!jD%DT=|Er!|3 zlh7WqxS*-QmC$RUlvGd-V8NUWy3ecJ#Pg|?sT^y4f=BZbN6^9Gu!h< zhO+~vJVYS`QM5bV8?>7W9|?F}{2lR5@0BVqwEwWn$RzlEzqGC+NLpzMDazD)i-jay zRmqXPwBaXTV$5;9SSg;s7Burvl(d|b^@-i(ush_KxqAzbsE-l!PLZr!+%pZ(8PX-n z7CXLrr^HcwbLIs|s?KT6C7OGh=Dy-=n_?RHgQNHq%LSJ4L79cpM(H)*I#T>0G}n=~LvzZ{qbym&EuN7&=m8M9(dX9gcC` zp79}b(jJy#<3q|RWRtYSnJEBh5yW{0F>IRO6xr<;)2@);Luw$$mmG89u-|nS@6r#Q z`DRA|=W(5y@FFZ?7D|M@^1RA?VEjTlQPD6J4O7uD6%B(2TU)QWquK_=PX-xt_D^6o z4A48YgZ57)!`M*$U1)5$BgzT*^{=XT-Ec>*K+IqLMj;roIwM-3eY6F*UYqXuZ1UH( zDgZc`sUU=f5EemL1Oe96YG22kul^r-^YRMbyu5}tFaNK2qXkW=yt1#hWtUY+4Ps>N z^eEx3Xv3AcnpYIy|DoN4LLm(H%wWbBVF%rhT9yW(w{(`cCbQ(ck9Cf*MW&6&tp0g+e&dFUX8hzC&U@|BM5 zW9bd)Dhn&)7=`P#S5%FK5OJxG_do;(d$>zaOe{{q}ZT@6NxcVa+x8AB>cV<+- zHvMsk)e20i@vDxe%F~qv^@C$&CF}C)@)U6*&+=_S$6h9%a(K`rd81(G@8!dVPVn-W zN2urovAoT0W~m8$1=(*a550BJvAg0a*W|gTR?HVx)a3Cyp<O#2Cspr2zM@$uRSd?_byhW38Aig|Es0S9PX-X1XNhiF0ri2Y_{}zjpElZlB-RJOZXJ; zM@=Q+OMC312YnBPlbzK+@x9M^Slg*mriISN#sSM>FXq}9NtXK#J)2*tWx+o9(Jm%rDc;<>R)wz95Pp*uGl55THE$oh;2hWRRo zepv)|7>np%cyMTfluU=#m zdVKZA6Ob~?`g;{CYWCM9bBTjkr?g7IWyL!h0=`vS#zR66YnP0N2S)3+ya{86v=gk{ zmFQ}bE)oG_z539w7_vu@*1_)!O`dr19-g+*Qg;=OEt*xjbCibd)?ZW|Dr0sG#{i)1 zD#->_D6#(9HhNptzOkn-FnfG~*~fKWzel%_*dlv^nR@k6-q+E6`&g(n9vhF0eWSh2 zm^wB9b&dX3)goAm;HpoMWmCZ0=@^go?PeFcH9Sy*mz;Rn**Bg5?k|le0}gkfF~9(F}uVJ%+UF5}5c4)*d*a(yR^R3sJh{TM8_Q(tk{ ztC_RpJ5=z&E@_6}H)GXT9Us;9H~=a*S{=|_y0b4j*`o8+DLTBayunp``4I~Szf$pF zmH(k#!Y&}e#{(_kE=*Lk<;BFQRFS3*Uk-w{N%Zk+{NVAQN?{CwE85c5-z`q>b#uWPbEyI{;%YTDxkpbDa zF8$SS<~=s|Ale%WIxPRjZ(et}Hf4c}DV(MIJMBQu+DI>rYQMvjh$8!z4%2H9F@ zZ?yhhmyKq+Car2lcvOK5=|gU`U@OZ!?PWbFXzA($DsXL8_=2AYP(sC@1whPnhGnV3 IX*AdV8xKm`JOBUy diff --git a/emacs/external/ml/caml-xemacs.el b/emacs/external/ml/caml-xemacs.el deleted file mode 100644 index c066c79..0000000 --- a/emacs/external/ml/caml-xemacs.el +++ /dev/null @@ -1,53 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Didier Remy, projet Cristal, INRIA Rocquencourt *) -;(* *) -;(* Copyright 2003 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: caml-xemacs.el,v 1.5.6.2 2004/11/02 10:21:03 doligez Exp $ *) - -(require 'overlay) - -;; for caml-help.el -(defun caml-info-other-window (arg) - (save-excursion (info arg)) - (view-buffer-other-window "*info*")) - -;; for caml-types.el -(defun caml-line-beginning-position () - (save-excursion (beginning-of-line) (point))) - -(defalias 'caml-read-event 'next-event) -(defalias 'caml-window-edges 'window-pixel-edges) -(defun caml-mouse-vertical-position () - (let ((e (mouse-position-as-motion-event))) - (and e (event-y-pixel e)))) -(defalias 'caml-mouse-movement-p 'motion-event-p) -(defun caml-event-window (e) - (and (mouse-event-p e) (event-window e))) -(defun caml-event-point-start (e) (event-closest-point e)) -(defun caml-event-point-end (e) (event-closest-point e)) -(defun caml-ignore-event-p (e) - (if (and (key-press-event-p e) (equal (key-binding e) 'keyboard-quit)) - (keyboard-quit)) - (not (mouse-event-p e))) - - -(defun caml-sit-for (sec &optional mili) - (sit-for (+ sec (if mili (* 0.001 mili) 0)))) - - - -(defmacro caml-track-mouse (&rest body) (cons 'progn body)) - -(defun caml-release-event-p (original event) - (and (button-release-event-p event) - (equal (event-button original) (event-button event)))) - -(provide 'caml-xemacs) diff --git a/emacs/external/ml/caml-xemacs.elc b/emacs/external/ml/caml-xemacs.elc deleted file mode 100644 index 03a7cea7f89b39fbd9aa805476c729d9d3bcd9b5..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 1929 zcwVJd-*4MC5cXptpbrD~u*ZuF)KW1jlI(1&GoZ`50DV}|mjZo=jg^)tn+Qd!Bpt{5 z>vtq2$3FrLXbr?B@9z8VyW^3$zWw{%kAuM=y1u@KcdBW*U==L3U{-4N$H(_KA8yF| zj~{M9N%)MOzgP+R739S<|7DsNP-NM}V{5G%s1Xg-^s>EQnoHKu(vTug$Crj%Mg%wQ zWl0-B9=$7N!XvqaTepV?rVYnD4wB~Hx8Zh$YAh>J+EYOK+f_Q*51~SUYAtX0ztm!g zNh9z4wBjbHS{r7d+Dh8+5-L?1tGQg7pV6z01zJ^D-A+pWCN18iQOs+IsjMJgsI{zG z7=@xbAxU%&@$VR+Sq%psh;st5U~-A#4lzjrZ*M$O>0|O%m8?kj1*Lk>h}A_}ckj59d(KPcsWH8CkF;m(n$~RXC@vi!bja7rX2kxa41w zF6mResy)LTa>wnal$5Gs2t<&R?e#jEth0>qZ{jSTX{W}E(TrAvJuqoOvPau3y(<($ zShd6%?lvudWFna6Fg~rVQ8@8#E-WvpIIRukxw`V7P|Vd#4xHAri@rz(0pG(2HOS~! zL6`p~+aLo4Jk#C4(BQc@E*9r|pMkWeh~Rh{0+s}!?)bB-^G@TD#EuR2!OtIe7pXXY z8%wo4$q{%%TqzVj8D0GU6EeKW-$}=pQt79Hj@iaP^bK%>RE&$AZ4BLvP0lXf?(*I< zJRXgY#E#Kf7T6#hUbkK-sw;xm(;l|+d387l#JviAKVl#27cyeeLo!5A)x2W(hNs2o5SRpq*l}NK1>pfVtk{tg49WPg@svIsA}7{ z=+FLsq77QDmeSX8%Bh)P)Ex9#X^xi~Yw@ -;;copying: covered by the current FSF General Public License. - -;; indentation code adapted for Objective Caml by Jacques Garrigue, -;; july 1997. - -;;user customizable variables -(defvar caml-quote-char "'" - "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.") - -(defvar caml-imenu-enable nil - "*Enable Imenu support.") - -(defvar caml-mode-indentation 2 - "*Used for \\[caml-unindent-command].") - -(defvar caml-lookback-limit 5000 - "*How far to look back for syntax things in caml mode.") - -(defvar caml-max-indent-priority 8 - "*Bounds priority of operators permitted to affect caml indentation. - -Priorities are assigned to `interesting' caml operators as follows: - - all keywords 0 to 7 8 - type, val, ... + 0 7 - :: ^ 6 - @ 5 - := <- 4 - if 3 - fun, let, match ... 2 - module 1 - opening keywords 0.") - -(defvar caml-apply-extra-indent 2 - "*How many spaces to add to indentation for an application in caml mode.") -(make-variable-buffer-local 'caml-apply-extra-indent) - -(defvar caml-begin-indent 2 - "*How many spaces to indent from a begin keyword in caml mode.") -(make-variable-buffer-local 'caml-begin-indent) - -(defvar caml-class-indent 2 - "*How many spaces to indent from a class keyword in caml mode.") -(make-variable-buffer-local 'caml-class-indent) - -(defvar caml-exception-indent 2 - "*How many spaces to indent from a exception keyword in caml mode.") -(make-variable-buffer-local 'caml-exception-indent) - -(defvar caml-for-indent 2 - "*How many spaces to indent from a for keyword in caml mode.") -(make-variable-buffer-local 'caml-for-indent) - -(defvar caml-fun-indent 2 - "*How many spaces to indent from a fun keyword in caml mode.") -(make-variable-buffer-local 'caml-fun-indent) - -(defvar caml-function-indent 4 - "*How many spaces to indent from a function keyword in caml mode.") -(make-variable-buffer-local 'caml-function-indent) - -(defvar caml-if-indent 2 - "*How many spaces to indent from a if keyword in caml mode.") -(make-variable-buffer-local 'caml-if-indent) - -(defvar caml-if-else-indent 0 - "*How many spaces to indent from an if .. else line in caml mode.") -(make-variable-buffer-local 'caml-if-else-indent) - -(defvar caml-inherit-indent 2 - "*How many spaces to indent from a inherit keyword in caml mode.") -(make-variable-buffer-local 'caml-inherit-indent) - -(defvar caml-initializer-indent 2 - "*How many spaces to indent from a initializer keyword in caml mode.") -(make-variable-buffer-local 'caml-initializer-indent) - -(defvar caml-include-indent 2 - "*How many spaces to indent from a include keyword in caml mode.") -(make-variable-buffer-local 'caml-include-indent) - -(defvar caml-let-indent 2 - "*How many spaces to indent from a let keyword in caml mode.") -(make-variable-buffer-local 'caml-let-indent) - -(defvar caml-let-in-indent 0 - "*How many spaces to indent from a let .. in keyword in caml mode.") -(make-variable-buffer-local 'caml-let-in-indent) - -(defvar caml-match-indent 2 - "*How many spaces to indent from a match keyword in caml mode.") -(make-variable-buffer-local 'caml-match-indent) - -(defvar caml-method-indent 2 - "*How many spaces to indent from a method keyword in caml mode.") -(make-variable-buffer-local 'caml-method-indent) - -(defvar caml-module-indent 2 - "*How many spaces to indent from a module keyword in caml mode.") -(make-variable-buffer-local 'caml-module-indent) - -(defvar caml-object-indent 2 - "*How many spaces to indent from a object keyword in caml mode.") -(make-variable-buffer-local 'caml-object-indent) - -(defvar caml-of-indent 2 - "*How many spaces to indent from a of keyword in caml mode.") -(make-variable-buffer-local 'caml-of-indent) - -(defvar caml-parser-indent 4 - "*How many spaces to indent from a parser keyword in caml mode.") -(make-variable-buffer-local 'caml-parser-indent) - -(defvar caml-sig-indent 2 - "*How many spaces to indent from a sig keyword in caml mode.") -(make-variable-buffer-local 'caml-sig-indent) - -(defvar caml-struct-indent 2 - "*How many spaces to indent from a struct keyword in caml mode.") -(make-variable-buffer-local 'caml-struct-indent) - -(defvar caml-try-indent 2 - "*How many spaces to indent from a try keyword in caml mode.") -(make-variable-buffer-local 'caml-try-indent) - -(defvar caml-type-indent 4 - "*How many spaces to indent from a type keyword in caml mode.") -(make-variable-buffer-local 'caml-type-indent) - -(defvar caml-val-indent 2 - "*How many spaces to indent from a val keyword in caml mode.") -(make-variable-buffer-local 'caml-val-indent) - -(defvar caml-while-indent 2 - "*How many spaces to indent from a while keyword in caml mode.") -(make-variable-buffer-local 'caml-while-indent) - -(defvar caml-::-indent 2 - "*How many spaces to indent from a :: operator in caml mode.") -(make-variable-buffer-local 'caml-::-indent) - -(defvar caml-@-indent 2 - "*How many spaces to indent from a @ operator in caml mode.") -(make-variable-buffer-local 'caml-@-indent) - -(defvar caml-:=-indent 2 - "*How many spaces to indent from a := operator in caml mode.") -(make-variable-buffer-local 'caml-:=-indent) - -(defvar caml-<--indent 2 - "*How many spaces to indent from a <- operator in caml mode.") -(make-variable-buffer-local 'caml-<--indent) - -(defvar caml-->-indent 2 - "*How many spaces to indent from a -> operator in caml mode.") -(make-variable-buffer-local 'caml-->-indent) - -(defvar caml-lb-indent 2 - "*How many spaces to indent from a \[ operator in caml mode.") -(make-variable-buffer-local 'caml-lb-indent) - -(defvar caml-lc-indent 2 - "*How many spaces to indent from a \{ operator in caml mode.") -(make-variable-buffer-local 'caml-lc-indent) - -(defvar caml-lp-indent 1 - "*How many spaces to indent from a \( operator in caml mode.") -(make-variable-buffer-local 'caml-lp-indent) - -(defvar caml-and-extra-indent nil - "*Extra indent for caml lines starting with the and keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-and-extra-indent) - -(defvar caml-do-extra-indent nil - "*Extra indent for caml lines starting with the do keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-do-extra-indent) - -(defvar caml-done-extra-indent nil - "*Extra indent for caml lines starting with the done keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-done-extra-indent) - -(defvar caml-else-extra-indent nil - "*Extra indent for caml lines starting with the else keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-else-extra-indent) - -(defvar caml-end-extra-indent nil - "*Extra indent for caml lines starting with the end keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-end-extra-indent) - -(defvar caml-in-extra-indent nil - "*Extra indent for caml lines starting with the in keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-in-extra-indent) - -(defvar caml-then-extra-indent nil - "*Extra indent for caml lines starting with the then keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-then-extra-indent) - -(defvar caml-to-extra-indent -1 - "*Extra indent for caml lines starting with the to keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-to-extra-indent) - -(defvar caml-with-extra-indent nil - "*Extra indent for caml lines starting with the with keyword. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-with-extra-indent) - -(defvar caml-comment-indent 3 - "*Indent inside comments.") -(make-variable-buffer-local 'caml-comment-indent) - -(defvar caml-|-extra-indent -2 - "*Extra indent for caml lines starting with the | operator. -Usually negative. nil is align on master.") -(make-variable-buffer-local 'caml-|-extra-indent) - -(defvar caml-rb-extra-indent -2 - "*Extra indent for caml lines statring with ]. -Usually negative. nil is align on master.") - -(defvar caml-rc-extra-indent -2 - "*Extra indent for caml lines starting with }. -Usually negative. nil is align on master.") - -(defvar caml-rp-extra-indent -1 - "*Extra indent for caml lines starting with ). -Usually negative. nil is align on master.") - -(defvar caml-electric-indent t - "*Non-nil means electrically indent lines starting with |, ] or }. - -Many people find eletric keys irritating, so you can disable them if -you are one.") - -(defvar caml-electric-close-vector t - "*Non-nil means electrically insert a | before a vector-closing ]. - -Many people find eletric keys irritating, so you can disable them if -you are one. You should probably have this on, though, if you also -have caml-electric-indent on, which see.") - -;;code -(if (or (not (fboundp 'indent-line-to)) - (not (fboundp 'buffer-substring-no-properties))) - (require 'caml-compat)) - -(defvar caml-shell-active nil - "Non nil when a subshell is running.") - -(defvar running-xemacs (string-match "XEmacs" emacs-version) - "Non-nil if we are running in the XEmacs environment.") - -(defvar caml-mode-map nil - "Keymap used in Caml mode.") -(if caml-mode-map - () - (setq caml-mode-map (make-sparse-keymap)) - (define-key caml-mode-map "|" 'caml-electric-pipe) - (define-key caml-mode-map "}" 'caml-electric-pipe) - (define-key caml-mode-map "]" 'caml-electric-rb) - (define-key caml-mode-map "\t" 'caml-indent-command) - (define-key caml-mode-map [backtab] 'caml-unindent-command) - -;itz 04-21-96 instead of defining a new function, use defadvice -;that way we get out effect even when we do \C-x` in compilation buffer -; (define-key caml-mode-map "\C-x`" 'caml-next-error) - - (if running-xemacs - (define-key caml-mode-map 'backspace 'backward-delete-char-untabify) - (define-key caml-mode-map "\177" 'backward-delete-char-untabify)) - - ;; caml-types - (define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type) - ;; must be a mouse-down event. Can be any button and any prefix - (define-key caml-mode-map [?\C-c down-mouse-1] 'caml-types-explore) - ;; caml-help - (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path) - (define-key caml-mode-map [?\C-c?]] 'ocaml-close-module) - (define-key caml-mode-map [?\C-c?[] 'ocaml-open-module) - (define-key caml-mode-map [?\C-c?\C-h] 'caml-help) - (define-key caml-mode-map [?\C-c?\t] 'caml-complete) - ;; others - (define-key caml-mode-map "\C-cb" 'caml-insert-begin-form) - (define-key caml-mode-map "\C-cf" 'caml-insert-for-form) - (define-key caml-mode-map "\C-ci" 'caml-insert-if-form) - (define-key caml-mode-map "\C-cl" 'caml-insert-let-form) - (define-key caml-mode-map "\C-cm" 'caml-insert-match-form) - (define-key caml-mode-map "\C-ct" 'caml-insert-try-form) - (define-key caml-mode-map "\C-cw" 'caml-insert-while-form) - (define-key caml-mode-map "\C-c`" 'caml-goto-phrase-error) - (define-key caml-mode-map "\C-c\C-a" 'caml-find-alternate-file) - (define-key caml-mode-map "\C-c\C-c" 'compile) - (define-key caml-mode-map "\C-c\C-e" 'caml-eval-phrase) - (define-key caml-mode-map "\C-c\C-\[" 'caml-backward-to-less-indent) - (define-key caml-mode-map "\C-c\C-\]" 'caml-forward-to-less-indent) - (define-key caml-mode-map "\C-c\C-q" 'caml-indent-phrase) - (define-key caml-mode-map "\C-c\C-r" 'caml-eval-region) - (define-key caml-mode-map "\C-c\C-s" 'caml-show-subshell) - (define-key caml-mode-map "\M-\C-h" 'caml-mark-phrase) - (define-key caml-mode-map "\M-\C-q" 'caml-indent-phrase) - (define-key caml-mode-map "\M-\C-x" 'caml-eval-phrase) - - (if running-xemacs nil ; if not running xemacs - (let ((map (make-sparse-keymap "Caml")) - (forms (make-sparse-keymap "Forms"))) - (define-key caml-mode-map "\C-c\C-d" 'caml-show-imenu) - (define-key caml-mode-map [menu-bar] (make-sparse-keymap)) - (define-key caml-mode-map [menu-bar caml] (cons "Caml" map)) - ;; caml-help - - (define-key map [open] '("Open add path" . ocaml-add-path )) - (define-key map [close] - '("Close module for help" . ocaml-close-module)) - (define-key map [open] '("Open module for help" . ocaml-open-module)) - (define-key map [help] '("Help for identifier" . caml-help)) - (define-key map [complete] '("Complete identifier" . caml-complete)) - (define-key map [separator-help] '("---")) - - ;; caml-types - (define-key map [show-type] - '("Show type at point" . caml-types-show-type )) - (define-key map [separator-types] '("---")) - - ;; others - (define-key map [run-caml] '("Start subshell..." . run-caml)) - (define-key map [compile] '("Compile..." . compile)) - (define-key map [switch-view] - '("Switch view" . caml-find-alternate-file)) - (define-key map [separator-format] '("--")) - (define-key map [forms] (cons "Forms" forms)) - (define-key map [show-imenu] '("Show index" . caml-show-imenu)) - (put 'caml-show-imenu 'menu-enable '(not caml-imenu-shown)) - (define-key map [show-subshell] '("Show subshell" . caml-show-subshell)) - (put 'caml-show-subshell 'menu-enable 'caml-shell-active) - (define-key map [eval-phrase] '("Eval phrase" . caml-eval-phrase)) - (put 'caml-eval-phrase 'menu-enable 'caml-shell-active) - (define-key map [indent-phrase] '("Indent phrase" . caml-indent-phrase)) - (define-key forms [while] - '("while .. do .. done" . caml-insert-while-form)) - (define-key forms [try] '("try .. with .." . caml-insert-try-form)) - (define-key forms [match] '("match .. with .." . caml-insert-match-form)) - (define-key forms [let] '("let .. in .." . caml-insert-let-form)) - (define-key forms [if] '("if .. then .. else .." . caml-insert-if-form)) - (define-key forms [begin] '("for .. do .. done" . caml-insert-for-form)) - (define-key forms [begin] '("begin .. end" . caml-insert-begin-form))))) - -(defvar caml-mode-xemacs-menu - (if running-xemacs - '("Caml" - [ "Indent phrase" caml-indent-phrase :keys "C-M-q" ] - [ "Eval phrase" caml-eval-phrase - :active caml-shell-active :keys "C-M-x" ] - [ "Show subshell" caml-show-subshell caml-shell-active ] - ("Forms" - [ "while .. do .. done" caml-insert-while-form t] - [ "try .. with .." caml-insert-try-form t ] - [ "match .. with .." caml-insert-match-form t ] - [ "let .. in .." caml-insert-let-form t ] - [ "if .. then .. else .." caml-insert-if-form t ] - [ "for .. do .. done" caml-insert-for-form t ] - [ "begin .. end" caml-insert-begin-form t ]) - "---" - [ "Switch view" caml-find-alternate-file t ] - [ "Compile..." compile t ] - [ "Start subshell..." run-caml t ] - "---" - [ "Show type at point" caml-types-show-type t ] - "---" - [ "Complete identifier" caml-complete t ] - [ "Help for identifier" caml-help t ] - [ "Add path for documentation" ocaml-add-path t ] - [ "Open module for documentation" ocaml-open t ] - [ "Close module for documentation" ocaml-close t ] - )) - "Menu to add to the menubar when running Xemacs") - -(defvar caml-mode-syntax-table nil - "Syntax table in use in Caml mode buffers.") -(if caml-mode-syntax-table - () - (setq caml-mode-syntax-table (make-syntax-table)) - ; backslash is an escape sequence - (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table) - ; ( is first character of comment start - (modify-syntax-entry ?\( "()1" caml-mode-syntax-table) - ; * is second character of comment start, - ; and first character of comment end - (modify-syntax-entry ?* ". 23" caml-mode-syntax-table) - ; ) is last character of comment end - (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table) - ; backquote was a string-like delimiter (for character literals) - ; (modify-syntax-entry ?` "\"" caml-mode-syntax-table) - ; quote and underscore are part of words - (modify-syntax-entry ?' "w" caml-mode-syntax-table) - (modify-syntax-entry ?_ "w" caml-mode-syntax-table) - ; ISO-latin accented letters and EUC kanjis are part of words - (let ((i 160)) - (while (< i 256) - (modify-syntax-entry i "w" caml-mode-syntax-table) - (setq i (1+ i))))) - -(defvar caml-mode-abbrev-table nil - "Abbrev table used for Caml mode buffers.") -(if caml-mode-abbrev-table nil - (setq caml-mode-abbrev-table (make-abbrev-table)) - (define-abbrev caml-mode-abbrev-table "and" "and" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "do" "do" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "done" "done" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "else" "else" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "end" "end" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "in" "in" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "then" "then" 'caml-abbrev-hook) - (define-abbrev caml-mode-abbrev-table "with" "with" 'caml-abbrev-hook)) - -;; Other internal variables - -(defvar caml-last-noncomment-pos nil - "Caches last buffer position determined not inside a caml comment.") -(make-variable-buffer-local 'caml-last-noncomment-pos) - -;;last-noncomment-pos can be a simple position, because we nil it -;;anyway whenever buffer changes upstream. last-comment-start and -end -;;have to be markers, because we preserve them when the changes' end -;;doesn't overlap with the comment's start. - -(defvar caml-last-comment-start nil - "A marker caching last determined caml comment start.") -(make-variable-buffer-local 'caml-last-comment-start) - -(defvar caml-last-comment-end nil - "A marker caching last determined caml comment end.") -(make-variable-buffer-local 'caml-last-comment-end) - -(make-variable-buffer-local 'before-change-function) - -(defvar caml-imenu-shown nil - "True if we have computed definition list.") -(make-variable-buffer-local 'caml-imenu-shown) - -(defconst caml-imenu-search-regexp - (concat "\\\\|" - "^[ \t]*\\(let\\|class\\|type\\|m\\(odule\\|ethod\\)" - "\\|functor\\|and\\|val\\)[ \t]+" - "\\(\\('[a-zA-Z0-9]+\\|([^)]+)" - "\\|mutable\\|private\\|rec\\|type\\)[ \t]+\\)?" - "\\([a-zA-Z][a-zA-Z0-9_']*\\)")) - -;;; The major mode -(eval-when-compile - (if (and (boundp 'running-xemacs) running-xemacs) nil - (require 'imenu))) - -;; -(defvar caml-mode-hook nil - "Hook for caml-mode") - -(defun caml-mode () - "Major mode for editing Caml code. - -\\{caml-mode-map}" - - (interactive) - (kill-all-local-variables) - (setq major-mode 'caml-mode) - (setq mode-name "caml") - (use-local-map caml-mode-map) - (set-syntax-table caml-mode-syntax-table) - (setq local-abbrev-table caml-mode-abbrev-table) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'require-final-newline) - (setq require-final-newline t) - (make-local-variable 'comment-start) - (setq comment-start "(*") - (make-local-variable 'comment-end) - (setq comment-end "*)") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "(\\*+ *") - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'caml-indent-command) - ;itz Fri Sep 25 13:23:49 PDT 1998 - (make-local-variable 'add-log-current-defun-function) - (setq add-log-current-defun-function 'caml-current-defun) - ;itz 03-25-96 - (setq before-change-function 'caml-before-change-function) - (setq caml-last-noncomment-pos nil) - (setq caml-last-comment-start (make-marker)) - (setq caml-last-comment-end (make-marker)) - ;garrigue 27-11-96 - (setq case-fold-search nil) - ;garrigue july 97 - (if running-xemacs ; from Xemacs lisp mode - (if (and (featurep 'menubar) - current-menubar) - (progn - ;; make a local copy of the menubar, so our modes don't - ;; change the global menubar - (set-buffer-menubar current-menubar) - (add-submenu nil caml-mode-xemacs-menu))) - ;imenu support (not for Xemacs) - (make-local-variable 'imenu-create-index-function) - (setq imenu-create-index-function 'caml-create-index-function) - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression caml-imenu-search-regexp) - (if (and caml-imenu-enable (< (buffer-size) 10000)) - (caml-show-imenu))) - (run-hooks 'caml-mode-hook)) - -(defun caml-set-compile-command () - "Hook to set compile-command locally, unless there is a Makefile in the - current directory." - (interactive) - (unless (or (null buffer-file-name) - (file-exists-p "makefile") - (file-exists-p "Makefile")) - (let* ((filename (file-name-nondirectory buffer-file-name)) - (basename (file-name-sans-extension filename)) - (command nil)) - (cond - ((string-match ".*\\.mli\$" filename) - (setq command "ocamlc -c")) - ((string-match ".*\\.ml\$" filename) - (setq command "ocamlc -c") ; (concat "ocamlc -o " basename) - ) - ((string-match ".*\\.mll\$" filename) - (setq command "ocamllex")) - ((string-match ".*\\.mll\$" filename) - (setq command "ocamlyacc")) - ) - (if command - (progn - (make-local-variable 'compile-command) - (setq compile-command (concat command " " filename)))) - ))) - -(add-hook 'caml-mode-hook 'caml-set-compile-command) - -;;; Auxiliary function. Garrigue 96-11-01. - -(defun caml-find-alternate-file () - (interactive) - (let ((name (buffer-file-name))) - (if (string-match "^\\(.*\\)\\.\\(ml\\|mli\\)$" name) - (find-file - (concat - (caml-match-string 1 name) - (if (string= "ml" (caml-match-string 2 name)) ".mli" ".ml")))))) - -;;; subshell support - -(defun caml-eval-region (start end) - "Send the current region to the inferior Caml process." - (interactive"r") - (require 'inf-caml) - (inferior-caml-eval-region start end)) - -;; old version ---to be deleted later -; -; (defun caml-eval-phrase () -; "Send the current Caml phrase to the inferior Caml process." -; (interactive) -; (save-excursion -; (let ((bounds (caml-mark-phrase))) -; (inferior-caml-eval-region (car bounds) (cdr bounds))))) - -(defun caml-eval-phrase (arg &optional min max) - "Send the phrase containing the point to the CAML process. -With prefix-arg send as many phrases as its numeric value, -If an error occurs during evalutaion, stop at this phrase and -repport the error. - -Return nil if noerror and position of error if any. - -If arg's numeric value is zero or negative, evaluate the current phrase -or as many as prefix arg, ignoring evaluation errors. -This allows to jump other erroneous phrases. - -Optional arguments min max defines a region within which the phrase -should lies." - (interactive "p") - (require 'inf-caml) - (inferior-caml-eval-phrase arg min max)) - -(defun caml-eval-buffer (arg) - "Evaluate the buffer from the beginning to the phrase under the point. -With prefix arg, evaluate past the whole buffer, no stopping at -the current point." - (interactive "p") - (let ((here (point)) err) - (goto-char (point-min)) - (setq err - (caml-eval-phrase 500 (point-min) (if arg (point-max) here))) - (if err (set-mark err)) - (goto-char here))) - -(defun caml-show-subshell () - (interactive) - (require 'inf-caml) - (inferior-caml-show-subshell)) - - -;;; Imenu support -(defun caml-show-imenu () - (interactive) - (require 'imenu) - (switch-to-buffer (current-buffer)) - (imenu-add-to-menubar "Defs") - (setq caml-imenu-shown t)) - -(defun caml-prev-index-position-function () - (let (found data) - (while (and (setq found - (re-search-backward caml-imenu-search-regexp nil 'move)) - (progn (setq data (match-data)) t) - (or (caml-in-literal-p) - (caml-in-comment-p) - (if (looking-at "in") (caml-find-in-match))))) - (set-match-data data) - found)) -(defun caml-create-index-function () - (let (value-alist - type-alist - class-alist - method-alist - module-alist - and-alist - all-alist - menu-alist - (prev-pos (point-max)) - index) - (goto-char prev-pos) - (imenu-progress-message prev-pos 0 t) - ;; collect definitions - (while (caml-prev-index-position-function) - (setq index (cons (caml-match-string 5) (point))) - (imenu-progress-message prev-pos nil t) - (setq all-alist (cons index all-alist)) - (cond - ((looking-at "[ \t]*and") - (setq and-alist (cons index and-alist))) - ((looking-at "[ \t]*let") - (setq value-alist (cons index (append and-alist value-alist))) - (setq and-alist nil)) - ((looking-at "[ \t]*type") - (setq type-alist (cons index (append and-alist type-alist))) - (setq and-alist nil)) - ((looking-at "[ \t]*class") - (setq class-alist (cons index (append and-alist class-alist))) - (setq and-alist nil)) - ((looking-at "[ \t]*val") - (setq value-alist (cons index value-alist))) - ((looking-at "[ \t]*\\(module\\|functor\\)") - (setq module-alist (cons index module-alist))) - ((looking-at "[ \t]*method") - (setq method-alist (cons index method-alist))))) - ;; build menu - (mapcar - '(lambda (pair) - (if (symbol-value (cdr pair)) - (setq menu-alist - (cons - (cons (car pair) - (sort (symbol-value (cdr pair)) 'imenu--sort-by-name)) - menu-alist)))) - '(("Values" . value-alist) - ("Types" . type-alist) - ("Modules" . module-alist) - ("Methods" . method-alist) - ("Classes" . class-alist))) - (if all-alist (setq menu-alist (cons (cons "Index" all-alist) menu-alist))) - (imenu-progress-message prev-pos 100 t) - menu-alist)) - -;;; Indentation stuff - -(defun caml-in-indentation () - "Tests whether all characters between beginning of line and point -are blanks." - (save-excursion - (skip-chars-backward " \t") - (bolp))) - -;;; The command -;;; Sorry, I didn't like the previous behaviour... Garrigue 96/11/01 - -(defun caml-indent-command (&optional p) - "Indent the current line in Caml mode. - -Compute new indentation based on caml syntax. If prefixed, indent -the line all the way to where point is." - - (interactive "*p") - (cond - ((and p (> p 1)) (indent-line-to (current-column))) - ((caml-in-indentation) (indent-line-to (caml-compute-final-indent))) - (t (save-excursion - (indent-line-to - (caml-compute-final-indent)))))) - -(defun caml-unindent-command () - - "Decrease indentation by one level in Caml mode. - -Works only if the point is at the beginning of an indented line -\(i.e. all characters between beginning of line and point are -blanks\). Does nothing otherwise. The unindent size is given by the -variable caml-mode-indentation." - - (interactive "*") - (let* ((begline - (save-excursion - (beginning-of-line) - (point))) - (current-offset - (- (point) begline))) - (if (and (>= current-offset caml-mode-indentation) - (caml-in-indentation)) - (backward-delete-char-untabify caml-mode-indentation)))) - -;;; -;;; Error processing -;;; - -;; Error positions are given in bytes, not in characters -;; This function switches to monobyte mode - -(if (not (fboundp 'char-bytes)) - (defalias 'forward-byte 'forward-char) - (defun caml-char-bytes (ch) - (let ((l (char-bytes ch))) - (if (> l 1) (- l 1) l))) - (defun forward-byte (count) - (if (> count 0) - (while (> count 0) - (let ((char (char-after))) - (if (null char) - (setq count 0) - (setq count (- count (caml-char-bytes (char-after)))) - (forward-char)))) - (while (< count 0) - (let ((char (char-after))) - (if (null char) - (setq count 0) - (setq count (+ count (caml-char-bytes (char-before)))) - (backward-char)))) - ))) - -(require 'compile) - -;; In Emacs 19, the regexps in compilation-error-regexp-alist do not -;; match the error messages when the language is not English. -;; Hence we add a regexp. - -(defconst caml-error-regexp - "^[A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]" - "Regular expression matching the error messages produced by camlc.") - -(if (boundp 'compilation-error-regexp-alist) - (or (assoc caml-error-regexp - compilation-error-regexp-alist) - (setq compilation-error-regexp-alist - (cons (list caml-error-regexp 1 2) - compilation-error-regexp-alist)))) - -;; A regexp to extract the range info - -(defconst caml-error-chars-regexp - ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):" - "Regular expression extracting the character numbers -from an error message produced by camlc.") - -;; Wrapper around next-error. - -(defvar caml-error-overlay nil) - -;;itz 04-21-96 somebody didn't get the documetation for next-error -;;right. When the optional argument is a number n, it should move -;;forward n errors, not reparse. - -;itz 04-21-96 instead of defining a new function, use defadvice -;that way we get our effect even when we do \C-x` in compilation buffer - -(defadvice next-error (after caml-next-error activate) - "Reads the extra positional information provided by the Caml compiler. - -Puts the point and the mark exactly around the erroneous program -fragment. The erroneous fragment is also temporarily highlighted if -possible." - - (if (eq major-mode 'caml-mode) - (let (bol beg end) - (save-excursion - (set-buffer - (if (boundp 'compilation-last-buffer) - compilation-last-buffer ;Emacs 19 - "*compilation*")) ;Emacs 18 - (save-excursion - (goto-char (window-point (get-buffer-window (current-buffer)))) - (if (looking-at caml-error-chars-regexp) - (setq beg - (string-to-int - (buffer-substring (match-beginning 1) (match-end 1))) - end - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) - (cond (beg - (setq end (- end beg)) - (beginning-of-line) - (forward-byte beg) - (setq beg (point)) - (forward-byte end) - (setq end (point)) - (goto-char beg) - (push-mark end t) - (cond ((fboundp 'make-overlay) - (if caml-error-overlay () - (setq caml-error-overlay (make-overlay 1 1)) - (overlay-put caml-error-overlay 'face 'region)) - (unwind-protect - (progn - (move-overlay caml-error-overlay - beg end (current-buffer)) - (sit-for 60)) - (delete-overlay caml-error-overlay))))))))) - -;; Usual match-string doesn't work properly with font-lock-mode -;; on some emacs. - -(defun caml-match-string (num &optional string) - - "Return string of text matched by last search, without properties. - -NUM specifies which parenthesized expression in the last regexp. -Value is nil if NUMth pair didn't match, or there were less than NUM -pairs. Zero means the entire text matched by the whole regexp or -whole string." - - (let* ((data (match-data)) - (begin (nth (* 2 num) data)) - (end (nth (1+ (* 2 num)) data))) - (if string (substring string begin end) - (buffer-substring-no-properties begin end)))) - -;; itz Thu Sep 24 19:02:42 PDT 1998 this is to have some level of -;; comfort when sending phrases to the toplevel and getting errors. -(defun caml-goto-phrase-error () - "Find the error location in current Caml phrase." - (interactive) - (require 'inf-caml) - (let ((bounds (save-excursion (caml-mark-phrase)))) - (inferior-caml-goto-error (car bounds) (cdr bounds)))) - -;;; Phrases - -;itz the heuristics used to see if we're `between two phrases' -;didn't seem right to me. - -(defconst caml-phrase-start-keywords - (concat "\\<\\(class\\|ex\\(ternal\\|ception\\)\\|functor" - "\\|let\\|module\\|open\\|type\\|val\\)\\>") - "Keywords starting phrases in files") - -;; a phrase starts when a toplevel keyword is at the beginning of a line -(defun caml-at-phrase-start-p () - (and (bolp) - (or (looking-at "#") - (looking-at caml-phrase-start-keywords)))) - -(defun caml-skip-comments-forward () - (skip-chars-forward " \n\t") - (while (or (looking-at comment-start-skip) (caml-in-comment-p)) - (if (= (following-char) ?\)) (forward-char) - (search-forward comment-end)) - (skip-chars-forward " \n\t"))) - -(defun caml-skip-comments-backward () - (skip-chars-backward " \n\t") - (while (and (eq (preceding-char) ?\)) (eq (char-after (- (point) 2)) ?*)) - (backward-char) - (while (caml-in-comment-p) (search-backward comment-start)) - (skip-chars-backward " \n\t"))) - -(defconst caml-phrase-sep-keywords (concat ";;\\|" caml-phrase-start-keywords)) - -(defun caml-find-phrase (&optional min-pos max-pos) - "Find the CAML phrase containing the point. -Return the position of the beginning of the phrase, and move point -to the end. -" - (interactive) - (if (not min-pos) (setq min-pos (point-min))) - (if (not max-pos) (setq max-pos (point-max))) - (let (beg end use-semi kwop) - ;(caml-skip-comments-backward) - (cond - ; shall we have special processing for semicolons? - ;((and (eq (char-before (- (point) 1)) ?\;) (eq (char-before) ?\;)) - ; (forward-char) - ; (caml-skip-comments-forward) - ; (setq beg (point)) - ; (while (and (search-forward ";;" max-pos 'move) - ; (or (caml-in-comment-p) (caml-in-literal-p))))) - (t - (caml-skip-comments-forward) - (if (caml-at-phrase-start-p) (forward-char)) - (while (and (cond - ((re-search-forward caml-phrase-sep-keywords max-pos 'move) - (goto-char (match-beginning 0)) t)) - (or (not (or (bolp) (looking-at ";;"))) - (caml-in-comment-p) - (caml-in-literal-p))) - (forward-char)) - (setq end (+ (point) (if (looking-at ";;") 2 0))) - (while (and - (setq kwop (caml-find-kwop caml-phrase-sep-keywords min-pos)) - (not (string= kwop ";;")) - (not (bolp)))) - (if (string= kwop ";;") (forward-char 2)) - (if (not kwop) (goto-char min-pos)) - (caml-skip-comments-forward) - (setq beg (point)) - (if (>= beg end) (error "no phrase before point")) - (goto-char end))) - (caml-skip-comments-forward) - beg)) - -(defun caml-mark-phrase (&optional min-pos max-pos) - "Put mark at end of this Caml phrase, point at beginning. -" - (interactive) - (let* ((beg (caml-find-phrase min-pos max-pos)) (end (point))) - (push-mark) - (goto-char beg) - (cons beg end))) - -;;itz Fri Sep 25 12:58:13 PDT 1998 support for adding change-log entries -(defun caml-current-defun () - (save-excursion - (caml-mark-phrase) - (if (not (looking-at caml-phrase-start-keywords)) nil - (re-search-forward caml-phrase-start-keywords) - (let ((done nil)) - (while (not done) - (cond - ((looking-at "\\s ") - (skip-syntax-forward " ")) - ((char-equal (following-char) ?\( ) - (forward-sexp 1)) - ((char-equal (following-char) ?') - (skip-syntax-forward "w_")) - (t (setq done t))))) - (re-search-forward "\\(\\sw\\|\\s_\\)+") - (match-string 0)))) - -(defun caml-overlap (b1 e1 b2 e2) - (<= (max b1 b2) (min e1 e2))) - -;this clears the last comment cache if necessary -(defun caml-before-change-function (begin end) - (if (and caml-last-noncomment-pos - (> caml-last-noncomment-pos begin)) - (setq caml-last-noncomment-pos nil)) - (if (and (marker-position caml-last-comment-start) - (marker-position caml-last-comment-end) - (caml-overlap begin end - caml-last-comment-start - caml-last-comment-end)) - (prog2 - (set-marker caml-last-comment-start nil) - (set-marker caml-last-comment-end nil))) - (let ((orig-function (default-value 'before-change-function))) - (if orig-function (funcall orig-function begin end)))) - -(defun caml-in-literal-p () - "Returns non-nil if point is inside a caml literal." - (let* ((start-literal (concat "[\"" caml-quote-char "]")) - (char-literal - (concat "\\([^\\]\\|\\\\\\.\\|\\\\[0-9][0-9][0-9]\\)" - caml-quote-char)) - (pos (point)) - (eol (progn (end-of-line 1) (point))) - state in-str) - (beginning-of-line 1) - (while (and (not state) - (re-search-forward start-literal eol t) - (<= (point) pos)) - (cond - ((string= (caml-match-string 0) "\"") - (setq in-str t) - (while (and in-str (not state) - (re-search-forward "\"\\|\\\\\"" eol t)) - (if (> (point) pos) (setq state t)) - (if (string= (caml-match-string 0) "\"") (setq in-str nil))) - (if in-str (setq state t))) - ((looking-at char-literal) - (if (and (>= pos (match-beginning 0)) (< pos (match-end 0))) - (setq state t) - (goto-char (match-end 0)))))) - (goto-char pos) - state)) - -(defun caml-forward-comment () - "Skip one (eventually nested) comment." - (let ((count 1) match) - (while (> count 0) - (if (not (re-search-forward "(\\*\\|\\*)" nil 'move)) - (setq count -1) - (setq match (caml-match-string 0)) - (cond - ((caml-in-literal-p) - nil) - ((string= match comment-start) - (setq count (1+ count))) - (t - (setq count (1- count)))))) - (= count 0))) - -(defun caml-backward-comment () - "Skip one (eventually nested) comment." - (let ((count 1) match) - (while (> count 0) - (if (not (re-search-backward "(\\*\\|\\*)" nil 'move)) - (setq count -1) - (setq match (caml-match-string 0)) - (cond - ((caml-in-literal-p) - nil) - ((string= match comment-start) - (setq count (1- count))) - (t - (setq count (1+ count)))))) - (= count 0))) - -(defun caml-in-comment-p () - "Returns non-nil if point is inside a caml comment. -Returns nil for the parenthesis openning a comment." - ;;we look for comments differently than literals. there are two - ;;reasons for this. first, caml has nested comments and it is not so - ;;clear that parse-partial-sexp supports them; second, if proper - ;;style is used, literals are never split across lines, so we don't - ;;have to worry about bogus phrase breaks inside literals, while we - ;;have to account for that possibility in comments. - (if caml-last-comment-start - (save-excursion - (let* ((cached-pos caml-last-noncomment-pos) - (cached-begin (marker-position caml-last-comment-start)) - (cached-end (marker-position caml-last-comment-end))) - (cond - ((and cached-begin cached-end - (< cached-begin (point)) (< (point) cached-end)) t) - ((and cached-pos (= cached-pos (point))) nil) - ((and cached-pos (> cached-pos (point)) - (< (abs (- cached-pos (point))) caml-lookback-limit)) - (let (end found (here (point))) - ; go back to somewhere sure - (goto-char cached-pos) - (while (> (point) here) - ; look for the end of a comment - (while (and (if (search-backward comment-end (1- here) 'move) - (setq end (match-end 0)) - (setq end nil)) - (caml-in-literal-p))) - (if end (setq found (caml-backward-comment)))) - (if (and found (= (point) here)) (setq end nil)) - (if (not end) - (setq caml-last-noncomment-pos here) - (set-marker caml-last-comment-start (point)) - (set-marker caml-last-comment-end end)) - end)) - (t - (let (begin found (here (point))) - ;; go back to somewhere sure (or far enough) - (goto-char - (if cached-pos cached-pos (- (point) caml-lookback-limit))) - (while (< (point) here) - ;; look for the beginning of a comment - (while (and (if (search-forward comment-start (1+ here) 'move) - (setq begin (match-beginning 0)) - (setq begin nil)) - (caml-in-literal-p))) - (if begin (setq found (caml-forward-comment)))) - (if (and found (= (point) here)) (setq begin nil)) - (if (not begin) - (setq caml-last-noncomment-pos here) - (set-marker caml-last-comment-start begin) - (set-marker caml-last-comment-end (point))) - begin))))))) - -;; Various constants and regexps - -(defconst caml-before-expr-prefix - (concat "\\<\\(asr\\|begin\\|class\\|do\\(wnto\\)?\\|else" - "\\|i\\(f\\|n\\(herit\\|itializer\\)?\\)" - "\\|f\\(or\\|un\\(ct\\(ion\\|or\\)\\)?\\)" - "\\|l\\(and\\|or\\|s[lr]\\|xor\\)\\|m\\(atch\\|od\\)" - "\\|o[fr]\\|parser\\|s\\(ig\\|truct\\)\\|t\\(hen\\|o\\|ry\\)" - "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>\\|:begin\\>" - "\\|[=<>@^|&+-*/$%][!$%*+-./:<=>?@^|~]*\\|:[:=]\\|[[({,;]") - - "Keywords that may appear immediately before an expression. -Used to distinguish it from toplevel let construct.") - -(defconst caml-matching-kw-regexp - (concat - "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)" - "\\|with\\)\\>\\|[^[|]|") - "Regexp used in caml mode for skipping back over nested blocks.") - -(defconst caml-matching-kw-alist - '(("|" . caml-find-pipe-match) - (";" . caml-find-semi-match) - ("," . caml-find-comma-match) - ("end" . caml-find-end-match) - ("done" . caml-find-done-match) - ("in" . caml-find-in-match) - ("with" . caml-find-with-match) - ("else" . caml-find-else-match) - ("then" . caml-find-then-match) - ("to" . caml-find-done-match) - ("do" . caml-find-done-match) - ("and" . caml-find-and-match)) - - "Association list used in caml mode for skipping back over nested blocks.") - -(defconst caml-kwop-regexps (make-vector 9 nil) - "Array of regexps representing caml keywords of different priorities.") - -(defun caml-in-expr-p () - (let ((pos (point)) (in-expr t)) - (caml-find-kwop - (concat caml-before-expr-prefix "\\|" - caml-matching-kw-regexp "\\|" - (aref caml-kwop-regexps caml-max-indent-priority))) - (cond - ; special case for ;; - ((and (> (point) 1) (= (preceding-char) ?\;) (= (following-char) ?\;)) - (setq in-expr nil)) - ((looking-at caml-before-expr-prefix) - (if (not (looking-at "(\\*")) (goto-char (match-end 0))) - (skip-chars-forward " \t\n") - (while (looking-at "(\\*") - (forward-char) - (caml-forward-comment) - (skip-chars-forward " \t\n")) - (if (<= pos (point)) (setq in-expr nil)))) - (goto-char pos) - in-expr)) - -(defun caml-at-sexp-close-p () - (or (char-equal ?\) (following-char)) - (char-equal ?\] (following-char)) - (char-equal ?} (following-char)))) - -(defun caml-find-kwop (kwop-regexp &optional min-pos) - "Look back for a caml keyword or operator matching KWOP-REGEXP. -Second optional argument MIN-POS bounds the search. - -Ignore occurences inside literals. If found, return a list of two -values: the actual text of the keyword or operator, and a boolean -indicating whether the keyword was one we looked for explicitly -{non-nil}, or on the other hand one of the block-terminating -keywords." - - (let ((start-literal (concat "[\"" caml-quote-char "]")) - found kwop) - (while (and (> (point) 1) (not found) - (re-search-backward kwop-regexp min-pos 'move)) - (setq kwop (caml-match-string 0)) - (cond - ((looking-at "(\\*") - (if (> (point) 1) (backward-char))) - ((caml-in-comment-p) - (search-backward "(" min-pos 'move)) - ((looking-at start-literal)) - ((caml-in-literal-p) - (re-search-backward start-literal min-pos 'move)) ;ugly hack - ((setq found t)))) - (if found - (if (not (string-match "\\`[^|[]|[^]|]?\\'" kwop)) ;arrrrgh!! - kwop - (forward-char 1) "|") nil))) - -; Association list of indentation values based on governing keywords. -; -;Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is -;non-nil for operator-type nodes, which affect indentation in a -;different way from keywords: subsequent lines are indented to the -;actual occurrence of an operator, but relative to the indentation of -;the line where the governing keyword occurs. - -(defconst caml-no-indent 0) - -(defconst caml-kwop-alist - '(("begin" nil 6 caml-begin-indent) - (":begin" nil 6 caml-begin-indent) ; hack - ("class" nil 0 caml-class-indent) - ("constraint" nil 0 caml-val-indent) - ("sig" nil 1 caml-sig-indent) - ("struct" nil 1 caml-struct-indent) - ("exception" nil 0 caml-exception-indent) - ("for" nil 6 caml-for-indent) - ("fun" nil 3 caml-fun-indent) - ("function" nil 3 caml-function-indent) - ("if" nil 6 caml-if-indent) - ("if-else" nil 6 caml-if-else-indent) - ("include" nil 0 caml-include-indent) - ("inherit" nil 0 caml-inherit-indent) - ("initializer" nil 0 caml-initializer-indent) - ("let" nil 6 caml-let-indent) - ("let-in" nil 6 caml-let-in-indent) - ("match" nil 6 caml-match-indent) - ("method" nil 0 caml-method-indent) - ("module" nil 0 caml-module-indent) - ("object" nil 6 caml-object-indent) - ("of" nil 7 caml-of-indent) - ("open" nil 0 caml-no-indent) - ("parser" nil 3 caml-parser-indent) - ("try" nil 6 caml-try-indent) - ("type" nil 0 caml-type-indent) - ("val" nil 0 caml-val-indent) - ("when" nil 2 caml-if-indent) - ("while" nil 6 caml-while-indent) - ("::" t 5 caml-::-indent) - ("@" t 4 caml-@-indent) - ("^" t 4 caml-@-indent) - (":=" nil 3 caml-:=-indent) - ("<-" nil 3 caml-<--indent) - ("->" nil 2 caml-->-indent) - ("\[" t 8 caml-lb-indent) - ("{" t 8 caml-lc-indent) - ("\(" t 8 caml-lp-indent) - ("|" nil 2 caml-no-indent) - (";;" nil 0 caml-no-indent)) -; if-else and let-in are not keywords but idioms -; "|" is not in the regexps -; all these 3 values correspond to hard-coded names - -"Association list of indentation values based on governing keywords. - -Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is -non-nil for operator-type nodes, which affect indentation in a -different way from keywords: subsequent lines are indented to the -actual occurrence of an operator, but relative to the indentation of -the line where the governing keyword occurs.") - -;;Originally, we had caml-kwop-regexp create these at runtime, from an -;;additional field in caml-kwop-alist. That proved way too slow, -;;although I still can't understand why. itz - -(aset caml-kwop-regexps 0 - (concat - "\\<\\(begin\\|object\\|for\\|s\\(ig\\|truct\\)\\|while\\)\\>" - "\\|:begin\\>\\|[[({]\\|;;")) -(aset caml-kwop-regexps 1 - (concat (aref caml-kwop-regexps 0) "\\|\\<\\(class\\|module\\)\\>")) -(aset caml-kwop-regexps 2 - (concat - (aref caml-kwop-regexps 1) - "\\|\\<\\(fun\\(ction\\)?\\|initializer\\|let\\|m\\(atch\\|ethod\\)" - "\\|parser\\|try\\|val\\)\\>\\|->")) -(aset caml-kwop-regexps 3 - (concat (aref caml-kwop-regexps 2) "\\|\\")) -(aset caml-kwop-regexps 4 - (concat (aref caml-kwop-regexps 3) "\\|:=\\|<-")) -(aset caml-kwop-regexps 5 - (concat (aref caml-kwop-regexps 4) "\\|@")) -(aset caml-kwop-regexps 6 - (concat (aref caml-kwop-regexps 5) "\\|::\\|\\^")) -(aset caml-kwop-regexps 7 - (concat - (aref caml-kwop-regexps 0) - "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)" - "\\|o\\(f\\|pen\\)\\|type\\|val\\)\\>")) -(aset caml-kwop-regexps 8 - (concat (aref caml-kwop-regexps 6) - "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)" - "\\|o\\(f\\|pen\\)\\|type\\)\\>")) - -(defun caml-find-done-match () - (let ((unbalanced 1) (kwop t)) - (while (and (not (= 0 unbalanced)) kwop) - (setq kwop (caml-find-kwop "\\<\\(done\\|for\\|while\\)\\>")) - (cond - ((not kwop)) - ((string= kwop "done") (setq unbalanced (1+ unbalanced))) - (t (setq unbalanced (1- unbalanced))))) - kwop)) - -(defun caml-find-end-match () - (let ((unbalanced 1) (kwop t)) - (while (and (not (= 0 unbalanced)) kwop) - (setq kwop - (caml-find-kwop - "\\<\\(end\\|begin\\|object\\|s\\(ig\\|truct\\)\\)\\>\\|:begin\\>\\|;;")) - (cond - ((not kwop)) - ((string= kwop ";;") (setq kwop nil) (forward-line 1)) - ((string= kwop "end") (setq unbalanced (1+ unbalanced))) - ( t (setq unbalanced (1- unbalanced))))) - (if (string= kwop ":begin") "begin" - kwop))) - -(defun caml-find-in-match () - (let ((unbalanced 1) (kwop t)) - (while (and (not (= 0 unbalanced)) kwop) - (setq kwop (caml-find-kwop "\\<\\(in\\|let\\|end\\)\\>")) - (cond - ((not kwop)) - ((string= kwop "end") (caml-find-end-match)) - ((string= kwop "in") (setq unbalanced (1+ unbalanced))) - (t (setq unbalanced (1- unbalanced))))) - kwop)) - -(defun caml-find-with-match () - (let ((unbalanced 1) (kwop t)) - (while (and (not (= 0 unbalanced)) kwop) - (setq kwop - (caml-find-kwop - "\\<\\(with\\|try\\|m\\(atch\\|odule\\)\\|functor\\)\\>\\|[{}()]")) - (cond - ((not kwop)) - ((caml-at-sexp-close-p) - (caml-find-paren-match (following-char))) - ((string= kwop "with") - (setq unbalanced (1+ unbalanced))) - ((or (string= kwop "module") - (string= kwop "functor") - (string= kwop "{") - (string= kwop "(")) - (setq unbalanced 0)) - (t (setq unbalanced (1- unbalanced))))) - kwop)) - -(defun caml-find-paren-match (close) - (let ((unbalanced 1) - (regexp (cond ((= close ?\)) "[()]") - ((= close ?\]) "[][]") - ((= close ?\}) "[{}]")))) - (while (and (> unbalanced 0) - (caml-find-kwop regexp)) - (if (= close (following-char)) - (setq unbalanced (1+ unbalanced)) - (setq unbalanced (1- unbalanced)))))) - -(defun caml-find-then-match (&optional from-else) - (let ((bol (if from-else - (save-excursion - (progn (beginning-of-line) (point))))) - kwop done matching-fun) - (while (not done) - (setq kwop - (caml-find-kwop - "\\<\\(e\\(nd\\|lse\\)\\|done\\|then\\|if\\|with\\)\\>\\|[])};]")) - (cond - ((not kwop) (setq done t)) - ((caml-at-sexp-close-p) - (caml-find-paren-match (following-char))) - ((string= kwop "if") (setq done t)) - ((string= kwop "then") - (if (not from-else) (setq kwop (caml-find-then-match)))) - ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist))) - (setq kwop (funcall matching-fun))))) - (if (and bol (>= (point) bol)) - "if-else" - kwop))) - -(defun caml-find-pipe-match () - (let ((done nil) (kwop) - (re (concat - "\\<\\(try\\|match\\|with\\|function\\|parser\\|type" - "\\|e\\(nd\\|lse\\)\\|done\\|then\\|in\\)\\>" - "\\|[^[|]|\\|[])}]"))) - (while (not done) - (setq kwop (caml-find-kwop re)) - (cond - ((not kwop) (setq done t)) - ((looking-at "[^[|]\\(|\\)") - (goto-char (match-beginning 1)) - (setq kwop "|") - (setq done t)) - ((caml-at-sexp-close-p) - (caml-find-paren-match (following-char))) - ((string= kwop "with") - (setq kwop (caml-find-with-match)) - (setq done t)) - ((string= kwop "parser") - (if (re-search-backward "\\" (- (point) 5) t) - (setq kwop (caml-find-with-match))) - (setq done t)) - ((string= kwop "done") (caml-find-done-match)) - ((string= kwop "end") (caml-find-end-match)) - ((string= kwop "then") (caml-find-then-match)) - ((string= kwop "else") (caml-find-else-match)) - ((string= kwop "in") (caml-find-in-match)) - (t (setq done t)))) - kwop)) - -(defun caml-find-and-match () - (let ((done nil) (kwop)) - (while (not done) - (setq kwop (caml-find-kwop - "\\<\\(object\\|exception\\|let\\|type\\|end\\|in\\)\\>")) - (cond - ((not kwop) (setq done t)) - ((string= kwop "end") (caml-find-end-match)) - ((string= kwop "in") (caml-find-in-match)) - (t (setq done t)))) - kwop)) - -(defun caml-find-else-match () - (caml-find-then-match t)) - -(defun caml-find-semi-match () - (caml-find-kwop-skipping-blocks 2)) - -(defun caml-find-comma-match () - (caml-find-kwop-skipping-blocks 3)) - -(defun caml-find-kwop-skipping-blocks (prio) - "Look back for a caml keyword matching caml-kwop-regexps [PRIO]. - - Skip nested blocks." - - (let ((done nil) (kwop nil) (matching-fun) - (kwop-list (aref caml-kwop-regexps prio))) - (while (not done) - (setq kwop (caml-find-kwop - (concat caml-matching-kw-regexp - (cond ((> prio 3) "\\|[])},;]\\|") - ((> prio 2) "\\|[])};]\\|") - (t "\\|[])}]\\|")) - kwop-list))) - (cond - ((not kwop) (setq done t)) - ((caml-at-sexp-close-p) - (caml-find-paren-match (following-char))) - ((or (string= kwop ";;") - (and (string= kwop ";") (= (preceding-char) ?\;))) - (forward-line 1) - (setq kwop ";;") - (setq done t)) - ((and (>= prio 2) (string= kwop "|")) (setq done t)) - ((string= kwop "end") (caml-find-end-match)) - ((string= kwop "done") (caml-find-done-match)) - ((string= kwop "in") - (cond ((and (caml-find-in-match) (>= prio 2)) - (setq kwop "let-in") - (setq done t)))) - ((and (string= kwop "parser") (>= prio 2) - (re-search-backward "\\" (- (point) 5) t)) - (setq kwop (caml-find-with-match)) - (setq done t)) - ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist))) - (setq kwop (funcall matching-fun)) - (if (looking-at kwop-list) (setq done t))) - (t (let* ((kwop-info (assoc kwop caml-kwop-alist)) - (is-op (and (nth 1 kwop-info) - ; check that we are not at beginning of line - (let ((pos (point)) bti) - (back-to-indentation) - (setq bti (point)) - (goto-char pos) - (< bti pos))))) - (if (and is-op (looking-at - (concat (regexp-quote kwop) - "|?[ \t]*\\(\n\\|(\\*\\)"))) - (setq kwop-list - (aref caml-kwop-regexps (nth 2 kwop-info))) - (setq done t)))))) - kwop)) - -(defun caml-compute-basic-indent (prio) - "Compute indent of current caml line, ignoring leading keywords. - -Find the `governing node' for current line. Compute desired -indentation based on the node and the indentation alists. -Assumes point is exactly at line indentation. -Does not preserve point." - - (let* (in-expr - (kwop (cond - ((looking-at ";;") - (beginning-of-line 1)) - ((looking-at "|\\([^]|]\\|\\'\\)") - (caml-find-pipe-match)) - ((and (looking-at caml-phrase-start-keywords) - (caml-in-expr-p)) - (caml-find-end-match)) - ((and (looking-at caml-matching-kw-regexp) - (assoc (caml-match-string 0) caml-matching-kw-alist)) - (funcall (cdr-safe (assoc (caml-match-string 0) - caml-matching-kw-alist)))) - ((looking-at - (aref caml-kwop-regexps caml-max-indent-priority)) - (let* ((kwop (caml-match-string 0)) - (kwop-info (assoc kwop caml-kwop-alist)) - (prio (if kwop-info (nth 2 kwop-info) - caml-max-indent-priority))) - (if (and (looking-at (aref caml-kwop-regexps 0)) - (not (looking-at "object")) - (caml-in-expr-p)) - (setq in-expr t)) - (caml-find-kwop-skipping-blocks prio))) - (t - (if (and (= prio caml-max-indent-priority) (caml-in-expr-p)) - (setq in-expr t)) - (caml-find-kwop-skipping-blocks prio)))) - (kwop-info (assoc kwop caml-kwop-alist)) - (indent-diff - (cond - ((not kwop-info) (beginning-of-line 1) 0) - ((looking-at "[[({][|<]?[ \t]*") - (length (caml-match-string 0))) - ((nth 1 kwop-info) (symbol-value (nth 3 kwop-info))) - (t - (let ((pos (point))) - (back-to-indentation) -; (if (looking-at "\\") (goto-char pos)) - (- (symbol-value (nth 3 kwop-info)) - (if (looking-at "|") caml-|-extra-indent 0)))))) - (extra (if in-expr caml-apply-extra-indent 0))) - (+ indent-diff extra (current-column)))) - -(defconst caml-leading-kwops-regexp - (concat - "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in" - "\\|t\\(hen\\|o\\)\\|with\\)\\>\\|[]|})]") - - "Regexp matching caml keywords which need special indentation.") - -(defconst caml-leading-kwops-alist - '(("and" caml-and-extra-indent 2) - ("do" caml-do-extra-indent 0) - ("done" caml-done-extra-indent 0) - ("else" caml-else-extra-indent 3) - ("end" caml-end-extra-indent 0) - ("in" caml-in-extra-indent 2) - ("then" caml-then-extra-indent 3) - ("to" caml-to-extra-indent 0) - ("with" caml-with-extra-indent 2) - ("|" caml-|-extra-indent 2) - ("]" caml-rb-extra-indent 0) - ("}" caml-rc-extra-indent 0) - (")" caml-rp-extra-indent 0)) - - "Association list of special caml keyword indent values. - -Each member is of the form (KEYWORD EXTRA-INDENT PRIO) where -EXTRA-INDENT is the variable holding extra indentation amount for -KEYWORD (usually negative) and PRIO is upper bound on priority of -matching nodes to determine KEYWORD's final indentation.") - -(defun caml-compute-final-indent () - (save-excursion - (back-to-indentation) - (cond - ((and (bolp) (looking-at comment-start-skip)) (current-column)) - ((caml-in-comment-p) - (let ((closing (looking-at "\\*)")) - (comment-mark (looking-at "\\*"))) - (caml-backward-comment) - (looking-at comment-start-skip) - (+ (current-column) - (cond - (closing 1) - (comment-mark 1) - (t caml-comment-indent))))) - (t (let* ((leading (looking-at caml-leading-kwops-regexp)) - (assoc-val (if leading (assoc (caml-match-string 0) - caml-leading-kwops-alist))) - (extra (if leading (symbol-value (nth 1 assoc-val)) 0)) - (prio (if leading (nth 2 assoc-val) - caml-max-indent-priority)) - (basic (caml-compute-basic-indent prio))) - (max 0 (if extra (+ extra basic) (current-column)))))))) - - - -(defun caml-split-string () - "Called whenever a line is broken inside a caml string literal." - (insert-before-markers "\"^\"") - (backward-char 1)) - -(defadvice indent-new-comment-line (around - caml-indent-new-comment-line - activate) - - "Handle multi-line strings in caml mode." - -;this advice doesn't make sense in other modes. I wish there were a -;cleaner way to do this: I haven't found one. - - (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p))) - (split-mark)) - (if (not hooked) nil - (setq split-mark (set-marker (make-marker) (point))) - (caml-split-string)) - ad-do-it - (if (not hooked) nil - (goto-char split-mark) - (set-marker split-mark nil)))) - -(defadvice newline-and-indent (around - caml-newline-and-indent - activate) - - "Handle multi-line strings in caml mode." - - (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p))) - (split-mark)) - (if (not hooked) nil - (setq split-mark (set-marker (make-marker) (point))) - (caml-split-string)) - ad-do-it - (if (not hooked) nil - (goto-char split-mark) - (set-marker split-mark nil)))) - -(defun caml-electric-pipe () - "If inserting a | or } operator at beginning of line, reindent the line. - -Unfortunately there is a situation where this mechanism gets -confused. It's when | is the first character of a |] sequence. This is -a misfeature of caml syntax and cannot be fixed, however, as a -workaround, the electric ] inserts | itself if the matching [ is -followed by |." - - (interactive "*") - (let ((electric (and caml-electric-indent - (caml-in-indentation) - (not (caml-in-comment-p))))) - (self-insert-command 1) - (if electric (save-excursion (caml-indent-command))))) - -(defun caml-electric-rb () - "If inserting a ] operator at beginning of line, reindent the line. - -Also, if the matching [ is followed by a | and this ] is not preceded -by |, insert one." - - (interactive "*") - (let* ((prec (preceding-char)) - (use-pipe (and caml-electric-close-vector - (not (caml-in-comment-p)) - (not (caml-in-literal-p)) - (or (not (numberp prec)) - (not (char-equal ?| prec))))) - (electric (and caml-electric-indent - (caml-in-indentation) - (not (caml-in-comment-p))))) - (self-insert-command 1) - (if electric (save-excursion (caml-indent-command))) - (if (and use-pipe - (save-excursion - (condition-case nil - (prog2 - (backward-list 1) - (looking-at "\\[|")) - (error "")))) - (save-excursion - (backward-char 1) - (insert "|"))))) - -(defun caml-abbrev-hook () - "If inserting a leading keyword at beginning of line, reindent the line." - ;itz unfortunately we need a special case - (if (and (not (caml-in-comment-p)) (not (= last-command-char ?_))) - (let* ((bol (save-excursion (beginning-of-line) (point))) - (kw (save-excursion - (and (re-search-backward "^[ \t]*\\(\\sw+\\)\\=" bol t) - (caml-match-string 1))))) - (if kw - (let ((indent (save-excursion - (goto-char (match-beginning 1)) - (caml-indent-command) - (current-column))) - (abbrev-correct (if (= last-command-char ?\ ) 1 0))) - (indent-to (- indent - (or - (symbol-value - (nth 1 - (assoc kw caml-leading-kwops-alist))) - 0) - abbrev-correct))))))) - -; (defun caml-indent-phrase () -; (interactive "*") -; (let ((bounds (caml-mark-phrase))) -; (indent-region (car bounds) (cdr bounds) nil))) - -;;; Additional commands by Didier to report errors in toplevel mode - -(defun caml-skip-blank-forward () - (if (looking-at "[ \t\n]*\\((\\*\\([^*]\\|[^(]\\*[^)]\\)*\\*)[ \t\n]*\\)*") - (goto-char (match-end 0)))) - -;; to mark phrases, so that repeated calls will take several of them -;; knows little about Ocaml appart literals and comments, so it should work -;; with other dialects as long as ;; marks the end of phrase. - -(defun caml-indent-phrase (arg) - "Indent current phrase -with prefix arg, indent that many phrases starting with the current phrase." - (interactive "p") - (save-excursion - (let ((beg (caml-find-phrase))) - (while (progn (setq arg (- arg 1)) (> arg 0)) (caml-find-phrase)) - (indent-region beg (point) nil)))) - -(defun caml-indent-buffer () - (interactive) - (indent-region (point-min) (point-max) nil)) - -(defun caml-backward-to-less-indent (&optional n) - "Move cursor back N lines with less or same indentation." - (interactive "p") - (beginning-of-line 1) - (if (< n 0) (caml-forward-to-less-indent (- n)) - (while (> n 0) - (let ((i (current-indentation))) - (forward-line -1) - (while (or (> (current-indentation) i) - (caml-in-comment-p) - (looking-at - (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)"))) - (forward-line -1))) - (setq n (1- n)))) - (back-to-indentation)) - -(defun caml-forward-to-less-indent (&optional n) - "Move cursor back N lines with less or same indentation." - (interactive "p") - (beginning-of-line 1) - (if (< n 0) (caml-backward-to-less-indent (- n)) - (while (> n 0) - (let ((i (current-indentation))) - (forward-line 1) - (while (or (> (current-indentation) i) - (caml-in-comment-p) - (looking-at - (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)"))) - (forward-line 1))) - (setq n (1- n)))) - (back-to-indentation)) - -(defun caml-insert-begin-form () - "Inserts a nicely formatted begin-end form, leaving a mark after end." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation)) (i (+ caml-begin-indent c))) - (insert "begin\n\nend") - (push-mark) - (indent-line-to c) - (forward-line -1) - (indent-line-to i))) - -(defun caml-insert-for-form () - "Inserts a nicely formatted for-do-done form, leaving a mark after do(ne)." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation)) (i (+ caml-for-indent c))) - (insert "for do\n\ndone") - (push-mark) - (indent-line-to c) - (forward-line -1) - (indent-line-to i) - (push-mark) - (beginning-of-line 1) - (backward-char 4))) - -(defun caml-insert-if-form () - "Insert nicely formatted if-then-else form leaving mark after then, else." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation)) (i (+ caml-if-indent c))) - (insert "if\n\nthen\n\nelse\n") - (indent-line-to i) - (push-mark) - (forward-line -1) - (indent-line-to c) - (forward-line -1) - (indent-line-to i) - (push-mark) - (forward-line -1) - (indent-line-to c) - (forward-line -1) - (indent-line-to i))) - -(defun caml-insert-match-form () - "Insert nicely formatted match-with form leaving mark after with." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation)) (i (+ caml-match-indent c))) - (insert "match\n\nwith\n") - (indent-line-to i) - (push-mark) - (forward-line -1) - (indent-line-to c) - (forward-line -1) - (indent-line-to i))) - -(defun caml-insert-let-form () - "Insert nicely formatted let-in form leaving mark after in." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation))) - (insert "let in\n") - (indent-line-to c) - (push-mark) - (forward-line -1) - (forward-char (+ c 4)))) - -(defun caml-insert-try-form () - "Insert nicely formatted try-with form leaving mark after with." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation)) (i (+ caml-try-indent c))) - (insert "try\n\nwith\n") - (indent-line-to i) - (push-mark) - (forward-line -1) - (indent-line-to c) - (forward-line -1) - (indent-line-to i))) - -(defun caml-insert-while-form () - "Insert nicely formatted while-do-done form leaving mark after do, done." - (interactive "*") - (let ((prec (preceding-char))) - (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let* ((c (current-indentation)) (i (+ caml-if-indent c))) - (insert "while do\n\ndone") - (push-mark) - (indent-line-to c) - (forward-line -1) - (indent-line-to i) - (push-mark) - (beginning-of-line 1) - (backward-char 4))) - -(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t) - -(autoload 'caml-types-show-type "caml-types" - "Show the type of expression or pattern at point." t) -(autoload 'caml-types-explore "caml-types" - "Explore type annotations by mouse dragging." t) - -(autoload 'caml-help "caml-help" - "Show documentation for qualilifed OCaml identifier." t) -(autoload 'caml-complete "caml-help" - "Does completion for documented qualified OCaml identifier." t) -(autoload 'ocaml-open-module "caml-help" - "Add module in documentation search path." t) -(autoload 'ocaml-close-module "caml-help" - "Remove module from documentation search path." t) -(autoload 'ocaml-add-path "caml-help" - "Add search path for documentation." t) - -;;; caml.el ends here - -(provide 'caml) diff --git a/emacs/external/ml/caml.elc b/emacs/external/ml/caml.elc deleted file mode 100644 index 4fd0fefa6ffaad45466207d2e47b46a5e625def6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 52438 zcwX&&>34*|}W7)DTA2C6NLtsFT1b;Yae~|k+>BfPs2$t z5(iI2augq3|LV?-yEoc*zPfu`#F6*`a{dwwh2;s$-m$tnmM!c~$ECXCS$r(UP+N?4 zKAb*0Og;>b{bAC!tu5!nB%BBBNtjGO9QwzTtzbe`!bsf4GU8D%OG4-X%WheecM{Hz z0E~Gs1enqSTYYcKHH-L@iHN83@HqUJKZhd8)*5BrKME5DXORSn7(I#n<8UZO@i3Xs z!ssyBgxpy&7yf7j!_uHw+gtYb)><4oqMDrkCM5C#=%A=8hwANNd^J6G63&tXo zBbruQG$%oH2*73Qv|8e`8&or%xpY$FXDMX{S1%% znLmWaq5CMA`_Vkv5{;`3%KYl!=U_Mw9|htT0J;ePb2|QNe-R!Y&9~lNYmS2PBOmHx z;xE{68ylrYnpfTvTcYi4Zv*I8uG_A-c02M9VBSAJ4x)uf7Sm}wE3^_~W;@`LQ8-cU z^lY2jabO7FB@$DEU8=K)!e|sk^EROI7^ZJ8-{^5X3ff$TXi?a@*=?7a^*nLyPJAN9 zP-PyANgO{E2mbIOb(1`SdXL5Y2+0#E5*roRXucz?ht*(79fxz_bvhl@Q@?LfPp;b) z*KQ(tC1N@Y<5@U=BH}Tum0;%2;~As|GpIa=F#;t1cntHvJsKl`#dMD=hp>o%+J&Da z;bFv;_QMFKHAvE^)mq8~*dsHa-y_w@XU6x&*BM(*GP?V!Vhp z#Uz+-ierC1JR)%MKUj-26!R)9EA}a?)A!hUK2LgU9okFQG_D+j9Fo=)HOD zKMdMXBg7@uK3D)j&45sc{zP0|(g?!bEr(h5LYs;&4uV4fPa^3|NU3BI#%{M7jAr%9 z&?{vr_>~ z;G|Um497*}b#1p2Xu57y+(if#@atfb1Y#0K!P7v)f(kyp*V?^aHKNNlKtOs=2NHfA z1;FX6p^wWJak%aDtHGFQfMDFN1S7}>{v`ZYP;K!V!UgYrc_Z!0B+Z7zGt! zrLsjh?Os)!nhjKDI3QG1f)C0SVRPMTI7};7-bxTISTq&4V(y@@XdG|5+M>?Xue=$v zELH_RDp|x|&#N}KW_5zjtpZ&zKZ-}yz@wr?__nQXHTcZ>)d6IYwGx0-v;d&n=~dfL zGW9D17}J5V5`bK^2%ue&BWCJX-tOXR+g)7T?p%isu@wLtKP%Rz{w%4;pt-05PKyby z=T^g7rha9X2Zzc^&_TH(-g=#CcuOl+MqDzVEh>^57cD~9?^@NMGwWAI+kU_a3${f2It)-PKZ(S!x zVMW$UC5y1R{c4nERog!deryA09-OAkddNrV~7h&r4tHE^rnGy9# zHJEljDFU_aRNLHj-O5mX+^z=I$L#`C-A=z6RJv|usM?=agR1>$5h}YPu5{hXM73KD zsL4SQD5oN-blu88{aO*IVG$_LsiuR_bt?natO(Rp0cB~Ry8UV#Ue`sStPU{J+o(d+ zfW+Jfo#GSNul*USquDq#KMDleStL*0TKg_p_>;*K5e0`nS{=4X_a7z#4wHuw+PIGW zWFE}&1As=d>QBRD(Cs_bMv`xY2V_6%fJX7}AI~UWI-Fj|t)|q-wZWrtpM5k@@FK<& z1;EZL|>sC~z_9Q=6!H_tJ;w%&mHPN!3C zI4^|H(Z}x|4z{vx$Q4)><^cFY{&|04ZLZ&MS9NmAfqG~GJ zz;jZ^sTMt+ADyQ;;?N>fzh6;{dRo9^fBUH;AukRd$=>q=KRZ|k{dUJ?cY_MB7+C%7 zcfc}S3X9c$9#~qx1D5HsCBN<142$J~aQkH(wXwzHz>gBxvx6bb%aFR1HOl}y-4uK1 zE(6F~yNjanG>E5gY#&1%Yy{iDb)JZDHVe_*9vyCqBoUZWDFL&q8?N8#{DB*Ah# z;h12((f|!?b-Tou(3=c+4{)}|0GL1gu{H*F#~F-k^0$q@-B};i?(`aB zcP#z27^pVV2W$^Q@`Yq^ARV-#xDBHQ_C#(ov*4FSI14oMoci-UVdL~UJpq$PbbW#w zxG%7cqhLaGK3hcS98%CTVt(6auc?&%TOG?{-zCo#iX;HJCjrfhYz)O7D!r$Hs{MCg&y(@B_Foiy{DHi;(Gbu2;mYYfO;7^xQR*@#` zn#$-69J|9s?T+17>9&=o%M=^_IGGd|{&<-b0N2g{=fHA6}*%58ClE?Re0Rmubg?cDzhGUHIr`+UY_& z-Ap@OXs4TLrwi?LGwt-?qnBx?2krDS?ew6XUZ$NMw9_-&u{+lF8vcEwmQB4`%e4k+ zw`v-$)s*Hi=P$Jl^?AFt@#b5)%3rDRzvUXggVf@RY~trNZt2`joqi5e{)5v0UdyI_ zL8*6hsb5m+SGm-Cl=^ip^&3k4HkW#zQoqZkeov`C=B!Y3nw$!#VrGm%P3Cc)N#_D(==24zM8nt1|KEmW}N2Ri;AvJ2R?r&Mq+6$B7|(RlelqXeZj>4by;2NapR!yu%od$83B39nJvZ z=tBSU#fB2GfLydF*1&}$bB_JlL*2^2wyg&K<3M%;#T)qNuefmF-T8cVB~B-+Y# zu(Xmvy-)}9u+AMMUMw6U8pClI%&>|kY=lbEGXbV(yQH`(2UU^)xC)-&+p3>-yWPMH zwOldnTlm4|WPdKEaTv{YTe-!ZX_E4cHi5sj8P(7v9_h5Ky|uN4Evf=?EI^oQDDWxE z$PDZVPJ^&`9)-aPwMah&{?yQw(0v9%TtavhKoAi^V!3;A^h7Xv_(;Bwb;D_amY6Q) z!o17SjN-W@c}m8zkwU2&v2Ir-WSds0EtO^*IChOCip|_cYdZhbjTl9s=giW>DpJdo ztCT4Q)rietaW;!@ZK2_V{*KH_IhF(!fpcLsbc}%FbZD28SHj+)JaIv+q1^bF)k)bU z)B+O5I;l%svAkluh=VZ}W}j11)hgf9VlBzXp%U!_SPvK8nd4Wxf?0`u=CPk>lrNv| zFs(h|;c3n7i@V67=K8t-o)VFQkVVnqRGlDyBmtr92*;vBn^;}`;O6}iWnoK-9{Cfd zWS+Zu+9=`OJEW6n+-l!#|I&cflBK{r{fQk(w?#@e8hT6((UHawGv#nHzF@r*fls zxIhIAUBhYQg-$A;-?B@q;La`4la~uh%aeG3Gq5Ktt-f*Cm<tM}n=>pbMyTeTK~SU5aoMjFcFl9>jj;AEoG zU>acAZ`&X@4jRJkh(@yoQltwBTf%nW%My)N(`^W6TQp!PYGOI9InZeUkWm4q9meWMT*Q`sHI>HN^jZxgdzmWemkZa;USh5kq;%Xp2 zg@2G!H{^_UdoVY{qaYCzKbgzf0mhSrbbn_A%wu*O;;l-Q-lX}>r=FD+uHaGw4Yi{< zQnoZ`EHjxsyP9>gq#db4z9I0igV%Neblms}b^}%uJhqaQ0;yW25*Zl#+tm!p#byXZ z`x!xmIXV+Sba61i>vq`1qTFmi^hK1nA&KmaVU+j978%rEM2CUCUL{Qfz<=-07J<~@ zvtb1GnFZe0B`RgonS{xbyUir{XU1dm1-|TfY+TW5Jl4uhT;}e1lhG|^GctC>{s^z| zXHOS_KLgPN4$#44sVO=G114a={XPz(!Qj)u;Pk<+Slzoe7&KuQg`afI5&p#;82&ki z4BE=zo9;9W1}*p`e8n^Pf>jECgUkmR*wP130sen=*KhypM*F8udmEEZo4XHMdmmuc z;{~mD_?phbM<80j*DM(7E>$b7&!8FE%3j*qKd&ONt%jT_yCd!(TNuX%mn~zw#5~Li zVZU{tWJlcfe}?MByRn^M6q3pD7Sr!2*jif~{F*j(>`#B=F8oR8C+UrfKwR0yE^unQ zLQZS%Rb;Q{iJL}pt}XiZ+vP`Z^~$9hu}<>#xfs)t2L|zbTVcTaLH>woFoOIlcAE zXb@TdkZN?$Fe271{)db!>rNe&pbjc-ywbc!{&65OWUx%+ zTC(NQYRo1*4DmQKnea;0>o-Z85Dolnpr9cOVaExaC9-l3F8^#Jc=5zPocYru$^IJ; z-h*Y$Y1Z+A3W(Pv3vZCUl06K_*6S}sU-CP>YYYkzt*v7S1nlOwf zi{l7Iu1u|V@-Uo2)xqG}2jW_T@5%sJkEaR{xGBmI?*t?-J5z z73il-^O6b{mUvxBjw>{8-n(SzRwRXqlAP!h_eux%OXqEza6FaS@8FkxZ=)rrl4mVH zpIK}^0C5b_1v1&6wmYal-@Lq%bmKabTHtEE;zOV$GuE{!slfnPs*^FjPEmF@D z-y+vQ#iv?h(lR8~pUk2gUD8f&Oo8saaHwe5|w+J@ZJ|AOv1-1dkLqKFAMhlt+1REsp5Pi9l zc|1ks8@Yo?@PHE6U{}L%P3&@xZGhnWO#r(cuP!(ZMKQOHi&&qaBxrZRk_H@Kq0`4wA%Q!Aq$gA>Kpy+TrE|L` zo$V%Ju#_Stnt>v5O5cxFud*+u&Wzui2hrV$6j)UVR2h6+O`xuAK_^otP|I`0 zZ4>cQD?&Gm=r^i~nOI|!iWeZI%u)i*5G&7&p3f<&1IYXOD4wVuHi3kQ{-)TrKVQqt zIyJcjff7PSAdF-m@%8!}!GT)Lh_ZmZE}RRs5wf|9wN=z3TCZXn@;u;zZkHZggSMm8z#EckFLU!*4LTZ0u3OwEN!pzSj`9*#f=Zrlr-1)OE69vs1ZL4 z;3*!2SnyTcB$Y$cA&_eE^*0FWNG=od5F_2N^FGZi=}3EsRQC@gK&7ALg1DiIT27kd zN_tS_F!JXZ3TY9ImP?)p)htkn$~^*(h>!3ThPa_txPAm@71+p;oOFtosVM{v@Yr!eEhC&oNpmwsR)XmBv2r3H}-G7$~C_y1fwX5IJPcttdhJr_#QLA zs}&nuId}8ofNcalnytgy%3yr+(tz~;oMU$==hqs0fsX6%4jMPt-^DRx%h^(+VD)s- z%UJYsv8Yl$xQ;IR4i2YtSB^R-MKiTZ%emHOK^*WXrI zc27B>G8)b?J{_-yikEXY2hq(7b&2F|2NRvrsff0S@gWHl6$n~ccxdCrNvcDiR1Ne+ z0w#X3ol5>ddg(xoB!PpXc=`%0%6gvU2C!Bpw7=_GVxFOPQaX}`pFbzTynzw%NN+$X zs0~!Pq?A-YfH$j8ltYzvQmZ6eDwl(>pa?%5`m}RQ{cr|Md*#M|0J6M`wUz709PuYI zmB!80n~JF*Cb6`MzXW9?IX?VuA3PyJ85gB!HXGlgkdvUfpTr%m)e_CdeKc%hIt5J7 z$#)5K$}p#avIum};!rX=>lWgIYjH?A&VgZl&VDLZr<18<7Be6)fs~_4hCUzB6$!xP z?Fq{wk)hWY_X9Yvp+5o%Qy5NChZjviVwj%5qK8>J*h*ihpkYPKZSw%szU(M`zVT;VN^#T_k<4}f2- zsd$(fj8;b|HkfF%Ze80H_@^9yZS%*DMx@)ZN)Rbc(HfsF-_mo=D>M$IOAsc$m#$jM zaI{WsiS?R+hvU+00{f)IC=x1^!egXAdK3Or~_-Rmq<|ovX>|7pDer{3skTj!6UOv#$cKgc%Cc(Y?hyG4>^2YV%MH08PU@ z!p`N-=%}a`g;Xug;=`GLJc!0K{}2y)yqly2R61X$O=2+*j;HYq_7l9P86F-@F!VZJ z+ZzuefIkUgo7sXX!?5_lFT$`(rds9}#=W0oQ2PmTde(S06aNt^+EEdRqi&|QDsD}M zz&EL$EIC}LC6;6W<2Q1yHCiQo(X9kxL(LP|Vd9fEW3qXe8q7EY=2udR>=vW-6MV*z zVF}&0Xi&e>=!?ty&*f(klo_{U|=!5G(f;1 znACb(um{Q^mMCn?ke1oku$(za!eT35O3t_LLzhaYfg74GlA|_LF_Nx^v8guNt7P(! z%aiA!WZ9A{1$9@F*)*E~HfbRs@@E^J=1b~a9pn9?tE_3o@{0(m1Ml+AG3aCy*AREK9GJe9uU!*AjHzYq<(e2_VJZkSD1$Kk<#%^QG7X04u$oBq^3+G@j{+1vN9L{~FA-C# zyau+`zE}Ensi%hqQ7wxH*ikr&u1a_|QT0BjQ^^VbB@Ldi13`r~ES`W&{1fWv`93>w zwrGxGLVi@KW>;=N@obHMGbTzT;EbvOgelkt4NW+wvyA46*H=kFHK3hlu+o1s^ZWiv z|E<9oclvj0@NabPD-?mQkgf`T4I0WwNvb&PhdrW^Fl7IRs;={tOXP;w>v^s`VY=Jm zuc5*GXJkp9%NbG!PTE&klU#z3;>E2}y{$SRw9xYBu3TTaF=!}B^?+ZQC@7I7!qW>= zS*vlXlwVOL#yhDy5Q;aYS%KQXFL~~zKkWA!g*tz4Os*et5Ab=?6vfwfN zAp0g-5oN^syk{BvqiOvPdRV7^Y3y(|7<{TFnXb*DZ*wU2=UI@Z3dN`|^IoYLnC^7> z=ZZRdoG~C%mvsf5(aO~E55uW;Us1Q@j2Wg$JsBulBnevoMkgaW?Y&<+L}LFAsr)Sx zzZUBJL>AxPsx~F04MFA~(t|+3(I(@bBL)#`P(*&4%_yl|OENDtges%eYVjOFlM3eu z;r#^1*sAU0*nb-1sAUQcdLc*FW8G(iw8bkMne$`X-ttkKgLKgl?b;ZUq&Uc&HeU`g zcf4S!*jc@IVenKJ&2qBIWCc@Wfqe84x@JkQM$2|n=EBC|BL)B{SulBFmOc2`D=|V2e$2!VFFjKOBM%ZU0}Z!t4oF*`eefStI;McoBd3s zuWM*fz?^TmhruP(|JN^(V})g1z(Pkgv^iOx^rCQ&YGh)(pG|gtp|-dy0`PHdMVTgf zr2E+9YlHDWh@^pdY6BUzg6VpkE&j@;B(NNg#lw@B!g>G!9fwMiOb`0yTxSU{Ozl{z zAkjo8!{0vos8OTahylD94H;f+fa zUVV1fAgTtr$Jl2#)roDMQhymyo15cPhMc&+hOR{I2WuC9-+_jraW=e^og*BvQ zaAWiBZF_pC1p{BkQ!%SIw3VZ=LpzA~_nO*G_(c8&EyP>2fefU}nX|!?60AMVQ!((4 zWgX(8V|TC*c}-~F1NB&B@;5vUZRUTuC&}CNEE!q)_UnPxFv_e~_-A6fN|;qP z0^qYNtKZ8noMkeGlfQY#`G6+roc_kZDkw9*CljKSLEC6CMQ^`s!XUMwTh=>BWxd)f z*hnKYi)Buu3~HKP#dVYx_AES1$Bfg;{8Kv7Ihief?LC0Th)%wu zDzB9`C$0G~*X!7z`%#S>ext@a9&Tf>(%<9_jEU@x+BshLwyQQcM<;nd=%hjmT;M>l z4`_$JU)lPTNm|CkgUlo(>UlM*A4qUPJfSduAhYcb8XO2kYMBRnw3zX~E%`+%(ey8} z9$Q3iMRQ4!+bB~@hATjC*e$BIxik1>@GKx3C~53*+a1s4BPB4OZ&6A|w$}_E!E#VR z_>y@rYUOUDWdt;3``{88-x=V(ufrw)TLDeHNBn`=Hu7Z)<7ly|g2gksZ}~?i0rU}i zb&$Hute|YeM6y*gu4n#{OepCOtoWU>Qn4e8G)rWbza?D`ikPJv0fa!jL_k7`lG`)b zF04cou{~@1_aauC!~SP6n?dIN7lK)RB6|U-bvm7{q*;u{TAiCJM6c;8P<$Lqk3y~S zO6YAyI=1*{Oio4~RUY<$8t>09A+KD0li2abTQn`>jd#eq<|=VV_~+dI5B#zJiu|Cd z12n()61x$?ghu<{si|fDr1A!K*TL-X(;sxhYyYQ>`uQKsM7mnLfBC}Yie-{ zLDsW6L=N@W>KDF6Y9J;(WzG$3k$5nN=)<*Z^$SE?1KaazEBoAy-1o=zOXlx7IsYRLGQ(PzC;_Uk(I zb)eVtKdIp|Mw}kqP3YDCy?)`o9xh(o zI@R<>mR72*we+B!j&0Rmztl;G4it{5MPjXMl>B~ni(&Jzh!nQqmqNAlohT0oL((=Q%qmbUbU4+Sz2<2l4bBvyf zUM3T|;S=$5K1I8!6b!Lhb-7KdCjA6;jx-eG7VId7tdnRS^L^A)yl@WxgpfLhf1zlT z9`3_5^(Y<}C0!<7p2cPtSa1lXnxyAEB{#LS+ywild$d$K*`3T#Qh6+k(Is5u%veBP zz>RmuRE8gX!b;fqAu335fE-#U!OIL0`MY^BQ@D)0@mF*vtJ{98BV&b{R8fQ+Xw{AD(C{xSUPG zCe2HYpYhQ(e7 zSDQ@?^=F2*!a#pq5}g7+%4VWwD9zl=X5vEi)7-#_P(=BVkmhCr9#J;E)1dRwYuU_I ze#@9gK^QW*6#G2wd6MMXruPzb{+wbtnE9AuKD9=6OBr;wrWsDV&L$}+sN)yK)U@h z(*`|WfQ(GZKKlc5<>sS5ZeizW9~-}N2V{}XAL*!xTO0clUacMBHu)WY9~$4dGr!70 z1Z~TF!prz`cU%%Ay6M@CBDq+~o?&QNzoho0V%P47Vrl5BRVKvQ)#zGaOUZ|;)~1^_kM;>(G;xT z4^n6ofB)gDd+l#-|LyjV_qNu)4ahYh&fky{cR&BKeebJpg)}~*@Xm4t-uh zh=zea0!YauAs$c?28znulX#7EILQt*>ksj$#>Qu9!6<>B%^5zx6Hfv^ zT7&tcm(^iF%3Im2dEzH@6g**Nq72}J0Z7APIG;RO`&FJ~ej|f<%%&B-LUx2bVP$1t zK_=ejm?zZZn&Jax$8=3tS9Y5QNs5BcpIetaU(?6yQ z_58rRPhr*4>Z`TXUIFWme)4q=3^~Mh3Dsm;#Ojh7(WT<#l}SlT57- zF^M8@ORv1c8fvC(Ot&n_9-NLc+!MYGtq)<1<pCgRNVPY` zHD1MF2xU_vNh*WSbC+lbgZHQET6*_@ydR|+*4F?o_o`9G@n5Z>?Zgryh z_uK#Y;j3@{B7lM1|Hr-C;@&r(e*j6LTdCkE#m_aGHV5cs87K+c}!ZKHDv1Sk+7sW_Lyjc}vOwCi{9dmLVscY?;gh z(olvUY|eC*eZv{c$hqjrd~+^P3ObwV-gr0{bLl>r(Z2b5 zE#%X+vZbry0Gj1)2U#W1Swrjd(E3jw+IytP zCkgh6IwMdKG>mZ(>#Wh!5l0rhNg4voxb=K!2}n6uSa>B%u4Jj<64RVaMjlndnUv$s zK&!sie+E{&jMeVbu`2x{#S)Bu_@e2F@WmV)Rru91(rKKHj8q$V7CP=TI_{UE zV~}$ZJ=~~<3zMMSztK-8`_s+-)P8<ZBx5h7pZVsm{wE!8k zV?gI!!qqnHM!S2v@MYPsWPb7A0?S{ub?uMXbVj~l+Az~N8V&A0PJ^YNj207W(zo0T7Ux2ICidplNO-21RWCq6IutB>Z;N>&LqJS>GFIL0Qg5vR2SQT0W?RlmP9)I8RnFzKFlwG~SmILDMWm%@h#ZyA zl)p-`w_NN`QC|#OmL6sEQ#dcb5=6yPTlCYLq$9F2n77$Jj(6;rHg4FmpR;v`TfcI> z-#gn}rnWCeXy!1#i>hvX%9p(i%gp2`sl%-C=Z zcE91@ng#En5!q(L@g8z>htGFVW?dHvZ1RGd6dLU$eV}g2~(`df9zK z7BP1U+GJ^`V6Lx$!LqPrt?W1I5ajwm$gxENdP zYASJ&gBrqFJBOuR)GTuKBqU(a?e}k8Eo>bEp16yKCOIzhOM)7 z>t%V;*yqXTZmx8rY;KYvNXQ%tgZWGaKO5lo!0x=QMp4Q(9UzL*cRH8+n?5l{hB%mq zP@ zw$@a9C_&ynGj(6GgsTr_%q)N=eK|eL&|lAp@pWe0GBl-)o-{RCz>!xfkaLSnCY_F* z7O@ARKfBpNl8f9TX0C+yjdOfut1OlHhS|XQl{*`fwW1HREPENx>b?4#^|vG&!Z?P` z5DVD#xABn$dsKVn@;lrFR^e8DmE+<_i|(%}^u*fTSCQM--`V&;15tnHmG8KJdLu%X zmcP;pr2qlb_8b$pR!5y%ku57&x^jTMPCCH9=|c6liNjJ@D$MV}`2IuZ?q9x~?l&rv znswx>_87vk{w`ObLzr#-)VeJAvX%qz)p^n#&!x=EgGOD{@yGVr|Ocdl9Sz6+TeNL2L$#H-|v6i}(-2UU`z_b&_m?yO4*}0o7>@BE#Q!BQ!HVe!RZW` zDdA8F4MC8Hpu?UGsRL9IKI8mP=f-0Db2Wl_*$52f1qn~Z9+WoZv?NcdR%Qn!P5-7c zhb5Vcm(8a6%$8mPHox|^L>?F$F*I{mxA{yXBbMX-K{vSJJLHX!uS;@x1bx#QHW>b} zH{PK4nB*?RwXIIbmvLBKjP3Nv&(7%?3FlB`OuN9{nofswwf74?dnm`j`h`K`@%j>wO)z>#J|2u8amw2n~z`lB^{_lf< z?Axk^du@G#czLuEy6}(kzCM1d9EsND>`#fEW$gdVs3#4+9@iibK*}y$rLoT3t};ZB z5ekkYdw{nLd@0T*;$Rj(45HjsJPGRZ z`_0J|^3rHcdF2YxoW0PZihNy`+_L%h5{CV0JU~xOj5w*H$GUFU?v{8sQo92qT&Q|S z(vuk~ekd2!;Ro|YyQ(O`l?^E<@fZasdZr0SO*#MNxj6FjV1svn8ROeqi^)9XvW%`I za}5MT_fc%V<`H`v<8FLrBtJ!t+L4rE$?=3BZdG_ZJeY8s6gff$WJ}9&z(4tLRnvII zs-*+Osou=l#(-yd3T}t`zSs^Zn=pM%=l{{ojznL z-Q;*k6F70;12%gSM+pKoPlCx#=eK6{g%O=HunP@mWY1^tjZ9oVGE zrrwuxXt80k#Wy6rP^nt@g5SNCnWb)QfOIu%DZ?cWS!4&q%29cl3}ZzRxm6>Rlq3qQ z&y1aeG0Ms)t1=xi_d4T&Uy=lr8AnTBBq>=L)x==1%c0YNt;?8G7?HMZ@!bj)VhIF~ zZ7(I)o|C86oQ|?G$rdTge6iXH4Z}qA6?<`gCx6IEXKm7c>kavvv{&?G3Yrx>!Qwk! z>S>{<{w5}VnNp154Zz2Wu!TDP9;wlGSfsb{o*fd=TiC+eq!o)^88ld?@6!8!ouAJA z^z$`kv(#7AaSP@kvN2w{5psaTcs5HfX)Kp)i?p@vof%;z)uHS6i7^-x#RwmKqIEzS zsk@xY92>-OlC0DC6>fK1-m=NdycjczUI!?N*Qm{k-YT(bdH0bKm3`Y}5E00%ns4qt zxJEalA2i{gYxoi}4C5LeFm%xt-X&C~$n9$<&VuWQMA`aLi`Jpn#tWT_X^N}6|x$q>wZnzgzZ{d4cfh2Ypu{cqUVEskr;!JD1#$n+3UPzT3_Wi zCojC_My+n9nfpTNExN*!K+32^CvP}^mz>)TGU<0ZUizpVh#!Rsect(8GO!msogKGy zIy>of(k?*L>7>)Cs+CWt`~1_njEc+V^Tki5+v}v0+3NrgWQiLOctbo=j46CS`Bu=~ zHw-?4X`8rnKjJ-{gF{ldZVYBx#^$7^0$U&zvl9IfjjyA4r)Q8v@0EY?eN~>*Aq#9g zfzj$r4(Z+hX{Q0U2#R0*d)%4YkW9ise}bP7sV?qK|Xt$<1+=M zmQ7>2ORh)9=6TFdeP{%4JC-5-cxNFPZ{oqBlZ^Lgpm-EFqoB1M%h=5SFpl%3^b2$( z8ZFAEAiZ{2eFD%#4a3JNVD0)Db5OeE+O9D*+jieIrpA?1Q=FG@EcNH;aZ8w0^J2^j zme>?nWckcMLoa+{H1btU(sW|1;#@s@@v^zo_wcGu9X_iuh{zig7Z94jqDFq!(&@~s zq3y1Dgy?pcP83U~wCyaLCd^zuLEOOq{W&T_I>Yv?c&A#3axy4ZMY-3p?2du*&Qg@K zOU_bshh_V`L^f7^3aaTennAUzQSH%Y-jzsBBeSc!Ier`7O>dP{*^ z|4hsY*TkK>ZLs|Aa=wChWq${;V)g$wNj1F$T%AzSJ4M zP@|!q)@X>Us#&jZx5S*z9v$)RQG7xtZ3<<9kD{kncEhxa?}YLz z&eTRDO*J}22NLeo^~CMR(+P&#q4K2LCKM*9AU%#3AS8@t{vn{}aA|*mY@)okUf)qe zba;rPct}xzc&<E$T|-CIC-hLMOW90N+O6H`SPG%GxG@^Z*I3bRlpQPUrf?>YvYo`#EJiSpaS_Tp zqK%9@!dLeA#b_>1VN9N>H&*eU)tzm7vOA|s<1$*zpi>`$^L?P{luDPj?>J0|P5GD_ IBfGWsUm}L_X8-^I diff --git a/emacs/external/ml/camldebug.el b/emacs/external/ml/camldebug.el deleted file mode 100644 index 146a307..0000000 --- a/emacs/external/ml/camldebug.el +++ /dev/null @@ -1,768 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Jacques Garrigue and Ian T Zimmerman *) -;(* *) -;(* Copyright 1997 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: camldebug.el,v 1.8.4.1 2004/08/09 16:09:33 doligez Exp $ *) - -;;; Run camldebug under Emacs -;;; Derived from gdb.el. -;;; gdb.el is Copyright (C) 1988 Free Software Foundation, Inc, and is part -;;; of GNU Emacs -;;; Modified by Jerome Vouillon, 1994. -;;; Modified by Ian T. Zimmerman, 1996. -;;; Modified by Xavier Leroy, 1997. - -;; 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 1, 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. - -;;itz 04-06-96 I pondered basing this on gud. The potential advantages -;;were: automatic bugfix , keymaps and menus propagation. -;;Disadvantages: gud is not so clean itself, there is little common -;;functionality it abstracts (most of the stuff is done in the -;;debugger specific parts anyway), and, most seriously, gud sees it -;;fit to add C-x C-a bindings to the _global_ map, so there would be a -;;conflict between camldebug and gdb, for instance. While it's OK to -;;assume that a sane person doesn't use gdb and dbx at the same time, -;;it's not so OK (IMHO) for gdb and camldebug. - -;; Xavier Leroy, 21/02/97: adaptation to ocamldebug. - -(require 'comint) -(require 'shell) -(require 'caml) -(require 'derived) -(require 'thingatpt) - -;;; Variables. - -(defvar camldebug-last-frame) -(defvar camldebug-delete-prompt-marker) -(defvar camldebug-filter-accumulator nil) -(defvar camldebug-last-frame-displayed-p) -(defvar camldebug-filter-function) - -(defvar camldebug-prompt-pattern "^(ocd) *" - "A regexp to recognize the prompt for ocamldebug.") - -(defvar camldebug-overlay-event nil - "Overlay for displaying the current event.") -(defvar camldebug-overlay-under nil - "Overlay for displaying the current event.") -(defvar camldebug-event-marker nil - "Marker for displaying the current event.") - -(defvar camldebug-track-frame t - "*If non-nil, always display current frame position in another window.") - -(cond - (window-system - (make-face 'camldebug-event) - (make-face 'camldebug-underline) - (if (not (face-differs-from-default-p 'camldebug-event)) - (invert-face 'camldebug-event)) - (if (not (face-differs-from-default-p 'camldebug-underline)) - (set-face-underline-p 'camldebug-underline t)) - (setq camldebug-overlay-event (make-overlay 1 1)) - (overlay-put camldebug-overlay-event 'face 'camldebug-event) - (setq camldebug-overlay-under (make-overlay 1 1)) - (overlay-put camldebug-overlay-under 'face 'camldebug-underline)) - (t - (setq camldebug-event-marker (make-marker)) - (setq overlay-arrow-string "=>"))) - -;;; Camldebug mode. - -(define-derived-mode camldebug-mode comint-mode "Inferior CDB" - - "Major mode for interacting with an inferior Camldebug process. - -The following commands are available: - -\\{camldebug-mode-map} - -\\[camldebug-display-frame] displays in the other window -the last line referred to in the camldebug buffer. - -\\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the camldebug window, -call camldebug to step, backstep or next and then update the other window -with the current file and position. - -If you are in a source file, you may select a point to break -at, by doing \\[camldebug-break]. - -Commands: -Many commands are inherited from comint mode. -Additionally we have: - -\\[camldebug-display-frame] display frames file in other window -\\[camldebug-step] advance one line in program -C-x SPACE sets break point at current line." - - (mapcar 'make-local-variable - '(camldebug-last-frame-displayed-p camldebug-last-frame - camldebug-delete-prompt-marker camldebug-filter-function - camldebug-filter-accumulator paragraph-start)) - (setq - camldebug-last-frame nil - camldebug-delete-prompt-marker (make-marker) - camldebug-filter-accumulator "" - camldebug-filter-function 'camldebug-marker-filter - comint-prompt-regexp camldebug-prompt-pattern - comint-dynamic-complete-functions (cons 'camldebug-complete - comint-dynamic-complete-functions) - paragraph-start comint-prompt-regexp - camldebug-last-frame-displayed-p t) - (make-local-variable 'shell-dirtrackp) - (setq shell-dirtrackp t) - (setq comint-input-sentinel 'shell-directory-tracker)) - -;;; Keymaps. - -(defun camldebug-numeric-arg (arg) - (and arg (prefix-numeric-value arg))) - -(defmacro def-camldebug (name key &optional doc args) - - "Define camldebug-NAME to be a command sending NAME ARGS and bound -to KEY, with optional doc string DOC. Certain %-escapes in ARGS are -interpreted specially if present. These are: - - %m module name of current module. - %d directory of current source file. - %c number of current character position - %e text of the caml variable surrounding point. - - The `current' source file is the file of the current buffer (if -we're in a caml buffer) or the source file current at the last break -or step (if we're in the camldebug buffer), and the `current' module -name is the filename stripped of any *.ml* suffixes (this assumes the -usual correspondence between module and file naming is observed). The -`current' position is that of the current buffer (if we're in a source -file) or the position of the last break or step (if we're in the -camldebug buffer). - -If a numeric is present, it overrides any ARGS flags and its string -representation is simply concatenated with the COMMAND." - - (let* ((fun (intern (format "camldebug-%s" name)))) - (list 'progn - (if doc - (list 'defun fun '(arg) - doc - '(interactive "P") - (list 'camldebug-call name args - '(camldebug-numeric-arg arg)))) - (list 'define-key 'camldebug-mode-map - (concat "\C-c" key) - (list 'quote fun)) - (list 'define-key 'caml-mode-map - (concat "\C-x\C-a" key) - (list 'quote fun))))) - -(def-camldebug "step" "\C-s" "Step one event forward.") -(def-camldebug "backstep" "\C-k" "Step one event backward.") -(def-camldebug "run" "\C-r" "Run the program.") -(def-camldebug "reverse" "\C-v" "Run the program in reverse.") -(def-camldebug "last" "\C-l" "Go to latest time in execution history.") -(def-camldebug "backtrace" "\C-t" "Print the call stack.") -(def-camldebug "finish" "\C-f" "Finish executing current function.") -(def-camldebug "print" "\C-p" "Print value of symbol at point." "%e") -(def-camldebug "display" "\C-d" "Display value of symbol at point." "%e") -(def-camldebug "next" "\C-n" "Step one event forward (skip functions)") -(def-camldebug "up" "<" "Go up N stack frames (numeric arg) with display") -(def-camldebug "down" ">" "Go down N stack frames (numeric arg) with display") -(def-camldebug "break" "\C-b" "Set breakpoint at current line." - "@ \"%m\" # %c") - -(defun camldebug-mouse-display (click) - "Display value of $NNN clicked on." - (interactive "e") - (let* ((start (event-start click)) - (window (car start)) - (pos (car (cdr start))) - symb) - (save-excursion - (select-window window) - (goto-char pos) - (setq symb (thing-at-point 'symbol)) - (if (string-match "^\\$[0-9]+$" symb) - (camldebug-call "display" symb))))) - -(define-key camldebug-mode-map [mouse-2] 'camldebug-mouse-display) - -(defun camldebug-kill-filter (string) - ;gob up stupid questions :-) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (if (not (string-match "\\(.* \\)(y or n) " - camldebug-filter-accumulator)) nil - (setq camldebug-kill-output - (cons t (match-string 1 camldebug-filter-accumulator))) - (setq camldebug-filter-accumulator "")) - (if (string-match comint-prompt-regexp camldebug-filter-accumulator) - (let ((output (substring camldebug-filter-accumulator - (match-beginning 0)))) - (setq camldebug-kill-output - (cons nil (substring camldebug-filter-accumulator 0 - (1- (match-beginning 0))))) - (setq camldebug-filter-accumulator "") - output) - "")) - -(def-camldebug "kill" "\C-k") - -(defun camldebug-kill () - "Kill the program." - (interactive) - (let ((camldebug-kill-output)) - (save-excursion - (set-buffer current-camldebug-buffer) - (let ((proc (get-buffer-process (current-buffer))) - (camldebug-filter-function 'camldebug-kill-filter)) - (camldebug-call "kill") - (while (not (and camldebug-kill-output - (zerop (length camldebug-filter-accumulator)))) - (accept-process-output proc)))) - (if (not (car camldebug-kill-output)) - (error (cdr camldebug-kill-output)) - (sit-for 0 300) - (camldebug-call-1 (if (y-or-n-p (cdr camldebug-kill-output)) "y" "n"))))) -;;FIXME: camldebug doesn't output the Hide marker on kill - -(defun camldebug-goto-filter (string) - ;accumulate onto previous output - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (if (not (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+" - camldebug-goto-position - "[ \t]*\\(before\\|after\\)\n") - camldebug-filter-accumulator)) nil - (setq camldebug-goto-output - (match-string 2 camldebug-filter-accumulator)) - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator (1- (match-end 0))))) - (if (not (string-match comint-prompt-regexp - camldebug-filter-accumulator)) nil - (setq camldebug-goto-output (or camldebug-goto-output 'fail)) - (setq camldebug-filter-accumulator "")) - (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) - (setq camldebug-filter-accumulator - (match-string 1 camldebug-filter-accumulator))) - "") - -(def-camldebug "goto" "\C-g") -(defun camldebug-goto (&optional time) - - "Go to the execution time TIME. - -Without TIME, the command behaves as follows: In the camldebug buffer, -if the point at buffer end, goto time 0\; otherwise, try to obtain the -time from context around point. In a caml mode buffer, try to find the -time associated in execution history with the current point location. - -With a negative TIME, move that many lines backward in the camldebug -buffer, then try to obtain the time from context around point." - - (interactive "P") - (cond - (time - (let ((ntime (camldebug-numeric-arg time))) - (if (>= ntime 0) (camldebug-call "goto" nil ntime) - (save-selected-window - (select-window (get-buffer-window current-camldebug-buffer)) - (save-excursion - (if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ " - nil t (- 1 ntime)) - (camldebug-goto nil) - (error "I don't have %d times in my history" - (- 1 ntime)))))))) - ((eq (current-buffer) current-camldebug-buffer) - (let ((time (cond - ((eobp) 0) - ((save-excursion - (beginning-of-line 1) - (looking-at "^Time : \\([0-9]+\\) - pc : [0-9]+ ")) - (string-to-int (match-string 1))) - ((string-to-int (camldebug-format-command "%e")))))) - (camldebug-call "goto" nil time))) - (t - (let ((module (camldebug-module-name (buffer-file-name))) - (camldebug-goto-position (int-to-string (1- (point)))) - (camldebug-goto-output) (address)) - ;get a list of all events in the current module - (save-excursion - (set-buffer current-camldebug-buffer) - (let* ((proc (get-buffer-process (current-buffer))) - (camldebug-filter-function 'camldebug-goto-filter)) - (camldebug-call-1 (concat "info events " module)) - (while (not (and camldebug-goto-output - (zerop (length camldebug-filter-accumulator)))) - (accept-process-output proc)) - (setq address (if (eq camldebug-goto-output 'fail) nil - (re-search-backward - (concat "^Time : \\([0-9]+\\) - pc : " - camldebug-goto-output - " - module " - module "$") nil t) - (match-string 1))))) - (if address (camldebug-call "goto" nil (string-to-int address)) - (error "No time at %s at %s" module camldebug-goto-position)))))) - - -(defun camldebug-delete-filter (string) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (if (not (string-match - (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+[ \t]*in " - (regexp-quote camldebug-delete-file) - ", character " - camldebug-delete-position "\n") - camldebug-filter-accumulator)) nil - (setq camldebug-delete-output - (match-string 2 camldebug-filter-accumulator)) - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator (1- (match-end 0))))) - (if (not (string-match comint-prompt-regexp - camldebug-filter-accumulator)) nil - (setq camldebug-delete-output (or camldebug-delete-output 'fail)) - (setq camldebug-filter-accumulator "")) - (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) - (setq camldebug-filter-accumulator - (match-string 1 camldebug-filter-accumulator))) - "") - - -(def-camldebug "delete" "\C-d") - -(defun camldebug-delete (&optional arg) - "Delete the breakpoint numbered ARG. - -Without ARG, the command behaves as follows: In the camldebug buffer, -try to obtain the time from context around point. In a caml mode -buffer, try to find the breakpoint associated with the current point -location. - -With a negative ARG, look for the -ARGth breakpoint pattern in the -camldebug buffer, then try to obtain the breakpoint info from context -around point." - - (interactive "P") - (cond - (arg - (let ((narg (camldebug-numeric-arg arg))) - (if (> narg 0) (camldebug-call "delete" nil narg) - (save-excursion - (set-buffer current-camldebug-buffer) - (if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file " - nil t (- 1 narg)) - (camldebug-delete nil) - (error "I don't have %d breakpoints in my history" - (- 1 narg))))))) - ((eq (current-buffer) current-camldebug-buffer) - (let* ((bpline "^Breakpoint \\([0-9]+\\) at [0-9]+ : file ") - (arg (cond - ((eobp) - (save-excursion (re-search-backward bpline nil t)) - (string-to-int (match-string 1))) - ((save-excursion - (beginning-of-line 1) - (looking-at bpline)) - (string-to-int (match-string 1))) - ((string-to-int (camldebug-format-command "%e")))))) - (camldebug-call "delete" nil arg))) - (t - (let ((camldebug-delete-file - (concat (camldebug-format-command "%m") ".ml")) - (camldebug-delete-position (camldebug-format-command "%c"))) - (save-excursion - (set-buffer current-camldebug-buffer) - (let ((proc (get-buffer-process (current-buffer))) - (camldebug-filter-function 'camldebug-delete-filter) - (camldebug-delete-output)) - (camldebug-call-1 "info break") - (while (not (and camldebug-delete-output - (zerop (length - camldebug-filter-accumulator)))) - (accept-process-output proc)) - (if (eq camldebug-delete-output 'fail) - (error "No breakpoint in %s at %s" - camldebug-delete-file - camldebug-delete-position) - (camldebug-call "delete" nil - (string-to-int camldebug-delete-output))))))))) - -(defun camldebug-complete-filter (string) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (while (string-match "\\(\n\\|\\`\\)\\(.+\\)\n" - camldebug-filter-accumulator) - (setq camldebug-complete-list - (cons (match-string 2 camldebug-filter-accumulator) - camldebug-complete-list)) - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator - (1- (match-end 0))))) - (if (not (string-match comint-prompt-regexp - camldebug-filter-accumulator)) nil - (setq camldebug-complete-list - (or camldebug-complete-list 'fail)) - (setq camldebug-filter-accumulator "")) - (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) - (setq camldebug-filter-accumulator - (match-string 1 camldebug-filter-accumulator))) - "") - -(defun camldebug-complete () - - "Perform completion on the camldebug command preceding point." - - (interactive) - (let* ((end (point)) - (command (save-excursion - (beginning-of-line) - (and (looking-at comint-prompt-regexp) - (goto-char (match-end 0))) - (buffer-substring (point) end))) - (camldebug-complete-list nil) (command-word)) - - ;; Find the word break. This match will always succeed. - (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) - (setq command-word (match-string 2 command)) - - ;itz 04-21-96 if we are trying to complete a word of nonzero - ;length, chop off the last character. This is a nasty hack, but it - ;works - in general, not just for this set of words: the comint - ;call below will weed out false matches - and it avoids further - ;mucking with camldebug's lexer. - (if (> (length command-word) 0) - (setq command (substring command 0 (1- (length command))))) - - (let ((camldebug-filter-function 'camldebug-complete-filter)) - (camldebug-call-1 (concat "complete " command)) - (set-marker camldebug-delete-prompt-marker nil) - (while (not (and camldebug-complete-list - (zerop (length camldebug-filter-accumulator)))) - (accept-process-output (get-buffer-process - (current-buffer))))) - (if (eq camldebug-complete-list 'fail) - (setq camldebug-complete-list nil)) - (setq camldebug-complete-list - (sort camldebug-complete-list 'string-lessp)) - (comint-dynamic-simple-complete command-word camldebug-complete-list))) - -(define-key camldebug-mode-map "\C-l" 'camldebug-refresh) -(define-key camldebug-mode-map "\t" 'comint-dynamic-complete) -(define-key camldebug-mode-map "\M-?" 'comint-dynamic-list-completions) - -(define-key caml-mode-map "\C-x " 'camldebug-break) - - -(defvar current-camldebug-buffer nil) - - -;;;###autoload -(defvar camldebug-command-name "ocamldebug" - "*Pathname for executing camldebug.") - -;;;###autoload -(defun camldebug (path) - "Run camldebug on program FILE in buffer *camldebug-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for camldebug. If you wish to change this, use -the camldebug commands `cd DIR' and `directory'." - (interactive "fRun ocamldebug on file: ") - (setq path (expand-file-name path)) - (let ((file (file-name-nondirectory path))) - (pop-to-buffer (concat "*camldebug-" file "*")) - (setq default-directory (file-name-directory path)) - (message "Current directory is %s" default-directory) - (make-comint (concat "camldebug-" file) - (substitute-in-file-name camldebug-command-name) - nil - "-emacs" "-cd" default-directory file) - (set-process-filter (get-buffer-process (current-buffer)) - 'camldebug-filter) - (set-process-sentinel (get-buffer-process (current-buffer)) - 'camldebug-sentinel) - (camldebug-mode) - (camldebug-set-buffer))) - -(defun camldebug-set-buffer () - (if (eq major-mode 'camldebug-mode) - (setq current-camldebug-buffer (current-buffer)) - (save-selected-window (pop-to-buffer current-camldebug-buffer)))) - -;;; Filter and sentinel. - -(defun camldebug-marker-filter (string) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (let ((output "") (begin)) - ;; Process all the complete markers in this chunk. - (while (setq begin - (string-match - "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n" - camldebug-filter-accumulator)) - (setq camldebug-last-frame - (if (char-equal ?H (aref camldebug-filter-accumulator - (1+ (1+ begin)))) nil - (list (match-string 2 camldebug-filter-accumulator) - (string-to-int - (match-string 3 camldebug-filter-accumulator)) - (string= "before" - (match-string 4 - camldebug-filter-accumulator)))) - output (concat output - (substring camldebug-filter-accumulator - 0 begin)) - ;; Set the accumulator to the remaining text. - camldebug-filter-accumulator (substring - camldebug-filter-accumulator - (match-end 0)) - camldebug-last-frame-displayed-p nil)) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; camldebug-filter-accumulator until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "\032.*\\'" camldebug-filter-accumulator) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring camldebug-filter-accumulator - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator (match-beginning 0)))) - - (setq output (concat output camldebug-filter-accumulator) - camldebug-filter-accumulator "")) - - output)) - -(defun camldebug-filter (proc string) - (let ((output)) - (if (buffer-name (process-buffer proc)) - (let ((process-window)) - (save-excursion - (set-buffer (process-buffer proc)) - ;; If we have been so requested, delete the debugger prompt. - (if (marker-buffer camldebug-delete-prompt-marker) - (progn - (delete-region (process-mark proc) - camldebug-delete-prompt-marker) - (set-marker camldebug-delete-prompt-marker nil))) - (setq output (funcall camldebug-filter-function string)) - ;; Don't display the specified file unless - ;; (1) point is at or after the position where output appears - ;; and (2) this buffer is on the screen. - (setq process-window (and camldebug-track-frame - (not camldebug-last-frame-displayed-p) - (>= (point) (process-mark proc)) - (get-buffer-window (current-buffer)))) - ;; Insert the text, moving the process-marker. - (comint-output-filter proc output)) - (if process-window - (save-selected-window - (select-window process-window) - (camldebug-display-frame))))))) - -(defun camldebug-sentinel (proc msg) - (cond ((null (buffer-name (process-buffer proc))) - ;; buffer killed - ;; Stop displaying an arrow in a source file. - (camldebug-remove-current-event) - (set-process-buffer proc nil)) - ((memq (process-status proc) '(signal exit)) - ;; Stop displaying an arrow in a source file. - (camldebug-remove-current-event) - ;; Fix the mode line. - (setq mode-line-process - (concat ": " - (symbol-name (process-status proc)))) - (let* ((obuf (current-buffer))) - ;; save-excursion isn't the right thing if - ;; process-buffer is current-buffer - (unwind-protect - (progn - ;; Write something in *compilation* and hack its mode line, - (set-buffer (process-buffer proc)) - ;; Force mode line redisplay soon - (set-buffer-modified-p (buffer-modified-p)) - (if (eobp) - (insert ?\n mode-name " " msg) - (save-excursion - (goto-char (point-max)) - (insert ?\n mode-name " " msg))) - ;; If buffer and mode line will show that the process - ;; is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc)) - ;; Restore old buffer, but don't restore old point - ;; if obuf is the cdb buffer. - (set-buffer obuf)))))) - - -(defun camldebug-refresh (&optional arg) - "Fix up a possibly garbled display, and redraw the mark." - (interactive "P") - (camldebug-display-frame) - (recenter arg)) - -(defun camldebug-display-frame () - "Find, obey and delete the last filename-and-line marker from CDB. -The marker looks like \\032\\032FILENAME:CHARACTER\\n. -Obeying it means displaying in another window the specified file and line." - (interactive) - (camldebug-set-buffer) - (if (not camldebug-last-frame) - (camldebug-remove-current-event) - (camldebug-display-line (car camldebug-last-frame) - (car (cdr camldebug-last-frame)) - (car (cdr (cdr camldebug-last-frame))))) - (setq camldebug-last-frame-displayed-p t)) - -;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen -;; and that its character CHARACTER is visible. -;; Put the mark on this character in that buffer. - -(defun camldebug-display-line (true-file character kind) - (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen - (pop-up-windows t) - (buffer (find-file-noselect true-file)) - (window (display-buffer buffer t)) - (pos)) - (save-excursion - (set-buffer buffer) - (save-restriction - (widen) - (setq pos (+ (point-min) character)) - (camldebug-set-current-event pos (current-buffer) kind)) - (cond ((or (< pos (point-min)) (> pos (point-max))) - (widen) - (goto-char pos)))) - (set-window-point window pos))) - -;;; Events. - -(defun camldebug-remove-current-event () - (if window-system - (progn - (delete-overlay camldebug-overlay-event) - (delete-overlay camldebug-overlay-under)) - (setq overlay-arrow-position nil))) - -(defun camldebug-set-current-event (pos buffer before) - (if window-system - (if before - (progn - (move-overlay camldebug-overlay-event pos (1+ pos) buffer) - (move-overlay camldebug-overlay-under - (+ pos 1) (+ pos 3) buffer)) - (move-overlay camldebug-overlay-event (1- pos) pos buffer) - (move-overlay camldebug-overlay-under (- pos 3) (- pos 1) buffer)) - (save-excursion - (set-buffer buffer) - (goto-char pos) - (beginning-of-line) - (move-marker camldebug-event-marker (point)) - (setq overlay-arrow-position camldebug-event-marker)))) - -;;; Miscellaneous. - -(defun camldebug-module-name (filename) - (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1))) - -;;; The camldebug-call function must do the right thing whether its -;;; invoking keystroke is from the camldebug buffer itself (via -;;; major-mode binding) or a caml buffer. In the former case, we want -;;; to supply data from camldebug-last-frame. Here's how we do it: - -(defun camldebug-format-command (str) - (let* ((insource (not (eq (current-buffer) current-camldebug-buffer))) - (frame (if insource nil camldebug-last-frame)) (result)) - (while (and str (string-match "\\([^%]*\\)%\\([mdcep]\\)" str)) - (let ((key (string-to-char (substring str (match-beginning 2)))) - (cmd (substring str (match-beginning 1) (match-end 1))) - (subst)) - (setq str (substring str (match-end 2))) - (cond - ((eq key ?m) - (setq subst (camldebug-module-name - (if insource (buffer-file-name) (nth 0 frame))))) - ((eq key ?d) - (setq subst (file-name-directory - (if insource (buffer-file-name) (nth 0 frame))))) - ((eq key ?c) - (setq subst (int-to-string - (if insource (1- (point)) (nth 1 frame))))) - ((eq key ?e) - (setq subst (thing-at-point 'symbol)))) - (setq result (concat result cmd subst)))) - ;; There might be text left in STR when the loop ends. - (concat result str))) - -(defun camldebug-call (command &optional fmt arg) - "Invoke camldebug COMMAND displaying source in other window. - -Certain %-escapes in FMT are interpreted specially if present. -These are: - - %m module name of current module. - %d directory of current source file. - %c number of current character position - %e text of the caml variable surrounding point. - - The `current' source file is the file of the current buffer (if -we're in a caml buffer) or the source file current at the last break -or step (if we're in the camldebug buffer), and the `current' module -name is the filename stripped of any *.ml* suffixes (this assumes the -usual correspondence between module and file naming is observed). The -`current' position is that of the current buffer (if we're in a source -file) or the position of the last break or step (if we're in the -camldebug buffer). - -If ARG is present, it overrides any FMT flags and its string -representation is simply concatenated with the COMMAND." - - ;; Make sure debugger buffer is displayed in a window. - (camldebug-set-buffer) - (message "Command: %s" (camldebug-call-1 command fmt arg))) - -(defun camldebug-call-1 (command &optional fmt arg) - - ;; Record info on the last prompt in the buffer and its position. - (save-excursion - (set-buffer current-camldebug-buffer) - (goto-char (process-mark (get-buffer-process current-camldebug-buffer))) - (let ((pt (point))) - (beginning-of-line) - (if (looking-at comint-prompt-regexp) - (set-marker camldebug-delete-prompt-marker (point))))) - (let ((cmd (cond - (arg (concat command " " (int-to-string arg))) - (fmt (camldebug-format-command - (concat command " " fmt))) - (command)))) - (process-send-string (get-buffer-process current-camldebug-buffer) - (concat cmd "\n")) - cmd)) - - -(provide 'camldebug) diff --git a/emacs/external/ml/camldebug.elc b/emacs/external/ml/camldebug.elc deleted file mode 100644 index 2cb50cb2297e508492f474e98fe9d3fe21b26df1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 24280 zcwX&X3wPVbmFBkDgrbhPj_s(n|xj+_&u+~ z_D@-S7#`l={&ws6mj3Pb^T#X<*bk8N$ZIpR!Axt@Y;Kx$W*J7E>UN{B&$>{XbvEw} zjt=5`Uf*rUx@E4}_hLWs^qwCN?zP>1ujB0x57xXM)$;@P7z?svFN%HW1uLwXly~AM zhcK4JYs0{@0&DAywYplw?e$nVNc_J4vztJXc&$X4uMhp0k7*ctG3%TLZr^XSPS}o< z$PW(URmhFvgt?s#%q<;?xv^$#td**MmsQ=M!>aq?Fz5`}GM|zdNUb!-s$W8h$m_CP z4y&3vtM(FWwy0(pjW#|A+lQN*vLqXMhdTIQl@DF-d2u`#=~knGYtTuF zih5B5y=Z$X(U;kY8?&}t=`IvdCe7fr=O$hRjSvmb{a>k6s^Ze=?Xcr9&9My&{@E4B zG7a%kS6>?HOH+Mmi5Jr-KDY!wCjA)v$HWpQlrZYm0=(KE!=F0OYVaQ$GFuvZ(;h~V z7bJQwbUVn52}|js1Czj{b+_Ff_J=?KAVcK+H1s16N#zF#$b$!5hBa8ni~M7tU2+Hu z;U)vMp`IHjdN*?Wo|4${dLB?>03tF-^u8M%c@Y!K9{9b9)%6aDOV2&^I{ILIpxt56 zMo!;lR;{#jzhST~81RAjZorZdp4#C-;Q#Ew5Ix4brIijdPWXMP+VQ%_Zlp9W1~_mN z=mXg4Z8dCnYHUSg)ur2PjcqhHYS>-fX4}AXFgj{gj1-7L{RuiV?->40>?h=vbt*v= z;O(2ny771I04NNURyr_SE#85}p7UimSNoJB7gA~7YSpRvmdRG0by*MwI^?c`f;w?e zW7$vI0q2uJ2?uvj8G)=it1MwPfCu)V!mKxtBh z2wzM?N|Y&bjQV0h$Wlwmqk4Q)bWw}evSniY!OQ|v&<%C?qX)kv2AG7hF%sI z;n$*4wvCTGnGeT?dNvHn1`60XMp6o#(0Y6tCtiOli%#RLDI6gSxuAccZBp25T>bRj zBTw(TZEv(4<(>NJ`GLoLT$cH)N4035W=6oHgl6eC#G9n@=Zc5r^brj1Da~;I~zd+)t5{f>Q z@IasvTp^AnP!55{K4d9kq4KSUN;%l8G` zJ=k4kYSKQakzIxeL`@C6cL@|6Yn6{F^_2yBBIh9&|w9CQFs zj8BQEt*ToBYFJGwM3@68(bI59)J5&c;&2!NvtrRz%IO0)$6#LD&?8htOATWJW^s>7 zZnBCLdZ@o+uXeT`K1PX;`IH3( z+$1F`)Xm<_55c_EqDQ>12@_5Fjxgl5O0VXz8p2!NW(!D~#b zht04IVRB~2#APshya-6J+ao?Hb%vx1{Q!pI_5@rPW)9w=!t#h@FTFt(f%vh>G81OB zUZ8pVkAkpDWXRBhN!w#yO2MELkg@oEflN|>Mv0|HtTm7J&b*1OtreUuS}67vzSYSz z&7)-!#cK&Br2sX~z zC6Kkg&K{8nD1&~n_53jzX0Y(m%z_{U9kd3Nx%KktE3*CsGD}eQyT?DSa!iK49W=J+ zxnTlMKiYn{#@IuEy)GEVJGvLQ-GN8wi8mE_C6Z7WD;ja3xWHcfT^v7>2pRx57kgM3 z%r|3q`sg7FO17~i&}kpH1z9mvUVu6wQGy*T z>|x;q(GwJv_=}~=Aco3F9GpHG`ZXLg0@6Lv?y}lH^QHOid1-^9e-08^)$f*0yk&{5 zs5_ojLm-DW)COg3z!xbX6Z%7!S=!(vTv}U|$WR$Hr)-G`t_+&qak&QrSU{Ko z!j_e_es2Xx(FF#C<*pJWapQQ1unKCHhVc+Mr5!@s@gRgf5CW)uFFEl5jEbejA<&Fa z{t%DEEZmR12(}P4&J?9=blLtKJ8+Zfv}6h`Io(RwOG?YMCDB4gKsJqlr7;3>RO~V# zd^jq>&H&pJ+So;Y2Z({xB2nn}+=H0rjA)O`Pbu<5EmzJh_CX6F2oBl+*aH`(CI#sa zx1T@XdhsX^)!<3b#e6&XdS~c7kDb`w5r&L*>0_=7IFw=gk zv7d%v!UaZ2zxHq1E;9|G#p}(DdTp0nOjd)vqWu==S?)A|X`BF3nuex{y;9ANDqW%> zgh0j0lA_;7=A~g>ZDg;m%rG-EO{3MUA#HYRWA5Lg>}yFncjp8j)MeijD3hm$LPhPj zS5&w`(*tr{(ZpuoYK{^J_o%Zdl{!N~zxE~iYiF-jKH%YZPwDE6jOh-aUhO1%2n zD78_)IC)#lQA$h_sI@4mRX5qw5Mdr3A%SU2{65(+@155kl9>TxjfiO)<;WnOlWbV` zOf+j*_4Ny*nbTE?M)L!TL8@dho9#s8wIZ<8Lq7?~=PVV4`=WC*SK7eYNY!XuoRYda zs-*Ztfm~N5wd^K);s<_wC|N4=t24QGnnt=VuXs+n@!Dr2+Ir*SwAY6!(Zm#iVjrdy zll(<{Gz6Z)vjKpI?;)m;Ye2QmNiC|ZG3}10y^mV!X4AefYF$!?!)FM@x|9;D!5#@e z?XM-5^zWXNV50gNNmg&xFN|a#sKb%71fqSQDE-MmlvU#+e~`*$T$@5VIxaXT-LUSN zgmS℞Qo~=avws2Lvmp1lvF>IUKMTT-VDpfvVim5g};jCFnhcaKm#W)#2GN>W0y} zI7|7ZO0*%N(=R2-8U!pl;Ysi}6O9@*$8K^U!2{{oz>FxfOKCg2H=$^ybP01 zho(Ud@=KhPQdAkV*?s0{clwUTme`&4dllP8%P=mCY`@9D4Vo;_?KiV*!R;3>Ua)r0 zZy%vQYR0)0I{X!jKvlRq)ikef-LK*Ajr*TE!PfnoFoWi2kU+r~{P4)>?u!#2I?Aei zLf#PDwCTjjXe<}#T+22akf6)iV<$obbDuFkRz$B8SutW zCr=jee1`^%1fJWuB)FnkBwE>5(Ri<2v3XJEUZF^yCJSRr%=-3C@;UJ& z)5PRg+p=1hTuQVcqg*%Pz(B@+3rAGC`?I6kY!kx3U`b5G3OqMOK}T}Sr7Ozuyi8I6I}df@*?*A0(lal z@D`o*R%&Ae$}OWf##FQk_Xv-1MtWL=;UwePD&rtE4!lG(rHlBJQAQd+TqCK(JdOSA zMd5%!quwBq4ahO`$k5nNbPR$qm~9v%t>`8@)x$^+bTGvTOaoY2I}6mS+cS@o4#FgS zpM;`+*Jyn&gz!dsmJbP6id@31#w%RZZCu?_h3;xDDQS*giyc% z)R7Z*i%UA|x+pYI6`KbYfn}X#jhPpu13uD5h=MxcqZH`Y*M&a_wLsneAGh||G+593boY)8af#hdKe210bM#-Gj1G*ZJ!QN zCV9ZvSojkkJD&fG*ry*T9E}CuflDV2oJ9Tb*yG1geLUbn1Q(~C?Xgq0QaVNq#TuJ2 zd(VugXl$Y=NOg9$gYDEr%;}dDb6TXhn(HXxKVs^l5~>609r?}LB#q5(pcq5xrqs;y z6`{ll^|VCPD4y+@sF~;fj8Pi4Edp^&3WKpW3L-YN!OJ+>UDDfwc?#z_D)jN^4;&6a z`F4S~Z_&At4Bw%M9a8xA+X6-IP#7r`sEA5D&BpMZO68h5sp68r20YA^RWNpE?^T7X zGSj^I*{!>`R-F+IVdbnkB{a%< zYUq%3g#}1#e)SE!gQ{zp1x~nn3(^}#c@_QwkZBtKE(s}AfSBCXyH1z-gQ?^eil*Bo ztdAuPLF9&2UM=5US`}J@*eIaCF$k^BQKr`sI8(ySsg~01bfUa@%W2p&RXtT3HCRl; zI+}uV)Bag?L=*C82HOb=q!wjtv?-=DYYyVA2NJ0d@^Bi1@oOUpTe0CHCBmlN2$Xp$ zwc6X)NV-kNO#;)|pq;%T)H6r*thn0o3^v8VvIx<;(;+#e7>NF<)HE7s(gQyT&>n?d zox%uvVR*!mf7Z8Zk;X=~>H1wpE|NU^ANj;c!qKH|#i)6qK*krEWa!*QN~78Dv6 zP0j>9DzX@ZESev5L%s=$*=z{JZRf1ngI$G3K5l%0{g3uSm=d7eotXa}wSgI65LG9m zy)(sJ?Xp&Sbz!|_rJLi4o(&$(G#zv`)16R&ItgPNQ89s15U7blBvA*z=103)?vkFt$bCcfV40%GrfAHvI0Undb3w3dR+B=v#-W+W`TK%1{ziEq zTbj6Pqw^DcZB+^9AuRUm(OUB&&|2P=OLWS6a*aBB#FG&lC@v!&zywfc>*Z4gw87io zfZ2XE8X3V~r78F;=j+N)*kr&}ngO_IdZ;StrT|veAqlS}W*x{dzbVl=Q-PP#1gR`_ z)}^yxFtL6)6y~NudlbE#17Uxf2Er_kg8~6bxcqa|&(WBGTXzMd5O51&0^c?BGLBZ` zaLWk@Z~a7@=uZiB?Fgs^yK~tv@pR1*k<{1(2UxyDWz@A2R85eqQ*#Ah@Mc=KZr{3d>vMTqh=+9F7KjXiXWb|-r-+Oa%<|`X zLP|4flDNsc?%HI!EUW9p_F%f=@7{95Ix zp@#Qz>ZDuo5~yijL6d=rO-H*z3cfqkNV^Oo(V%rL?^(t4&6d4xiD+bl0wpsI6{a^8*^_5~e2f-L zkY*+80drQ?=uT~Rn*vcVz+@aB)!fI=fAHXbd2x_|Jfe7IwMulMgktVF#L3$0suy?G z7!!9&PcT#pKsoH)f&<*~`0*;<)GAHXv@zRjci5w6FPABhelKl)d5X?OGYFf5!93cD>i>@iF4(4w~Q>tZkV3}hV z7DIa|_Gnp_9~0K$m&y5ETup5<9`479pA12H_<=GyvUfUtCk6V|+Z~NA;7NrjH0ewr zC(5YR83e}mL0`Phx-TxCV9zjASOsw$i5(aq2GpXqna@f*L4HaR*YcQ0|8n=CtT zE^=&h83(>qkTP0yg4eIVbu@CguN9=IVqt!?jIVUJg+E&cWr5&Yw(y4~yjgjcy*)+i#%Z|-aW5*lv@ zBOtUJ2&o?1+ulLjZn$}NVRJcUCfbtq46i$Slr-v8B?X7#GEHyULuy5tIYqx z5iIhL0%@J@Lgi8!<*@Npp?vup{;vKhM)tq03`cKSjuv-G9h?s@+ zuDQWhYEqMnm7@tsEj1>jX9H;|tQ7>uMHR}CRH|%V=m#NC;!S2^>V(q|0crSXGtK(X zQycl?8iiEq_ZyUS_47OLm53Q5;~Tyynq62D$)NpMa3>FJBF3!aR?Uzm9V22818a^5 zPAa0_vA;$p+Rhc^8#XFY+4*>IBjYS=Su!`_3`T?|4<7$c4}A;)9sf=91GyLbjvRI! z5wJF1hJ1X*)Zp;>AfV=7rV++A1TIlNT>ulF#c?W_#`ADp+Ab0OrWk5b16eq=-HDqF zV^)p*19X~t@B9R)i^o0cE&gg%F|as1;+2%0VXS`Fr$ru5F%3F9%A^hZMDFmd+zsw& zjE?>UyyXbOA#aWwcHNW?APnrP;~k97Di8%WH#p8tc4j~qT)N`!u8ug7cEdu`kdyo2 zqX!)Ei^LvX?eFb@xZuR;C%970_^Is=7Rq=jt3;w@#Uv4%VDfY@4 z-(O=(C*r*K@csBqi1G{2XAx`@x|=y@d{WkLm>~yRa`b2<(ZvN~r4~N{J=q zF>`GK3>*%Gl7&rUI(|VzB`6lxH=$!Av0n(qmxS_dkF3SGt`T~jduH=w5^-3Q#dg9H zrbr&mU6;6PPMSOMA)A(Duq%QZqWg1x!Yu!-vh>_QdXmKl!^oR36;h9r1uYj)Se{Z4 zIFmV8)l@O$&V&h)PH*fC=N90<+cRPzDoCu@yCnS6;1w9Xn7>8t< z*9q;;7o6ZzT(X-YqRDC!Ai)LV@$53qG#4Bm^@;nL=5}Sl$)d8w_#yq);;rA^x+aSf zB-;LjoXOlF{6_-K#AA=h$H!1rKPk-LuPiP){B+JPP=yv%@DSV>RAD!(@Rtb{ER!ny zFFB>D!f|2m6&5)y%x{es7rSwMcSLX+mg$y%S6=-7>Rl{cE`Vy=xhsvuv`x4lh!1g0 zG$+z_$HN}^Zzp@4-@Ls;YkLQu`<=Eo*o8OstPGVG7=9BF%m$mxWK!Rz4i?ieCi-$V zHb$a)Ou!;jE*zlmhPC@0{3-)y_NDt9c7r_&j>99>8z(+Pp_+a{mywUD;m6%3eH-S< z^Vj0*ZprLV!yrWY*Oy`b^<|j~~5a8t}VIH!*Nw=S5 z`x9I4Pw0%8cA;}lu*7$=s1ZeVQE4(T&iux_^ybL9I6ofSWzF(J{gvs%yF1)xRQ|a3J}WYqa;B}||4AMqqI-JcJlVe^ck(lj mLJ8c$|MG@mDxy%l?HyT|!s~Dqz+4Dy0>zGjyOkxZmHrRpy1xPd diff --git a/emacs/external/ml/inf-caml.el b/emacs/external/ml/inf-caml.el deleted file mode 100644 index 450fd9e..0000000 --- a/emacs/external/ml/inf-caml.el +++ /dev/null @@ -1,362 +0,0 @@ -;(***********************************************************************) -;(* *) -;(* Objective Caml *) -;(* *) -;(* Xavier Leroy and Jacques Garrigue *) -;(* *) -;(* Copyright 1997 Institut National de Recherche en Informatique et *) -;(* en Automatique. All rights reserved. This file is distributed *) -;(* under the terms of the GNU General Public License. *) -;(* *) -;(***********************************************************************) - -;(* $Id: inf-caml.el,v 1.10.8.1 2004/08/09 16:09:33 doligez Exp $ *) - -;;; inf-caml.el --- run the Caml toplevel in an Emacs buffer - -;; Xavier Leroy, july 1993. - -;; modified by Jacques Garrigue, july 1997. - -(require 'comint) -(require 'caml) - -;; User modifiable variables - -;; Whether you want the output buffer to be diplayed when you send a phrase - -(defvar caml-display-when-eval t - "*If true, display the inferior caml buffer when evaluating expressions.") - - -;; End of User modifiable variables - - -(defvar inferior-caml-mode-map nil) -(if inferior-caml-mode-map nil - (setq inferior-caml-mode-map - (copy-keymap comint-mode-map))) - -;; Augment Caml mode, so you can process Caml code in the source files. - -(defvar inferior-caml-program "ocaml" - "*Program name for invoking an inferior Caml from Emacs.") - -(defun inferior-caml-mode () - "Major mode for interacting with an inferior Caml process. -Runs a Caml toplevel as a subprocess of Emacs, with I/O through an -Emacs buffer. A history of input phrases is maintained. Phrases can -be sent from another buffer in Caml mode. - -\\{inferior-caml-mode-map}" - (interactive) - (comint-mode) - (setq comint-prompt-regexp "^# ?") - (setq major-mode 'inferior-caml-mode) - (setq mode-name "Inferior Caml") - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'require-final-newline) - (setq require-final-newline t) - (make-local-variable 'comment-start) - (setq comment-start "(*") - (make-local-variable 'comment-end) - (setq comment-end "*)") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "(\\*+ *") - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (use-local-map inferior-caml-mode-map) - (run-hooks 'inferior-caml-mode-hooks)) - - -(defconst inferior-caml-buffer-subname "inferior-caml") -(defconst inferior-caml-buffer-name - (concat "*" inferior-caml-buffer-subname "*")) - -;; for compatibility with xemacs - -(defun caml-sit-for (second &optional mili redisplay) - (if (and (boundp 'running-xemacs) running-xemacs) - (sit-for (if mili (+ second (* mili 0.001)) second) redisplay) - (sit-for second mili redisplay))) - -;; To show result of evaluation at toplevel - -(defvar inferior-caml-output nil) -(defun inferior-caml-signal-output (s) - (if (string-match "[^ ]" s) (setq inferior-caml-output t))) - -(defun inferior-caml-mode-output-hook () - (setq comint-output-filter-functions - (list (function inferior-caml-signal-output)))) -(add-hook 'inferior-caml-mode-hooks 'inferior-caml-mode-output-hook) - -;; To launch ocaml whenever needed - -(defun caml-run-process-if-needed (&optional cmd) - (if (comint-check-proc inferior-caml-buffer-name) nil - (if (not cmd) - (if (comint-check-proc inferior-caml-buffer-name) - (setq cmd inferior-caml-program) - (setq cmd (read-from-minibuffer "Caml toplevel to run: " - inferior-caml-program)))) - (setq inferior-caml-program cmd) - (let ((cmdlist (inferior-caml-args-to-list cmd)) - (process-connection-type nil)) - (set-buffer (apply (function make-comint) - inferior-caml-buffer-subname - (car cmdlist) nil (cdr cmdlist))) - (inferior-caml-mode) - (display-buffer inferior-caml-buffer-name) - t) - (setq caml-shell-active t) - )) - -;; patched to from original run-caml sharing code with -;; caml-run-process-when-needed - -(defun run-caml (&optional cmd) - "Run an inferior Caml process. -Input and output via buffer `*inferior-caml*'." - (interactive - (list (if (not (comint-check-proc inferior-caml-buffer-name)) - (read-from-minibuffer "Caml toplevel to run: " - inferior-caml-program)))) - (caml-run-process-if-needed cmd) - (switch-to-buffer-other-window inferior-caml-buffer-name)) - - -(defun inferior-caml-args-to-list (string) - (let ((where (string-match "[ \t]" string))) - (cond ((null where) (list string)) - ((not (= where 0)) - (cons (substring string 0 where) - (inferior-caml-args-to-list (substring string (+ 1 where) - (length string))))) - (t (let ((pos (string-match "[^ \t]" string))) - (if (null pos) - nil - (inferior-caml-args-to-list (substring string pos - (length string))))))))) - -(defun inferior-caml-show-subshell () - (interactive) - (caml-run-process-if-needed) - (display-buffer inferior-caml-buffer-name) - ; Added by Didier to move the point of inferior-caml to end of buffer - (let ((buf (current-buffer)) - (caml-buf (get-buffer inferior-caml-buffer-name)) - (count 0)) - (while - (and (< count 10) - (not (equal (buffer-name (current-buffer)) - inferior-caml-buffer-name))) - (next-multiframe-window) - (setq count (+ count 1))) - (if (equal (buffer-name (current-buffer)) - inferior-caml-buffer-name) - (end-of-buffer)) - (while - (> count 0) - (previous-multiframe-window) - (setq count (- count 1))) - ) -) - -;; patched by Didier to move cursor after evaluation - -(defun inferior-caml-eval-region (start end) - "Send the current region to the inferior Caml process." - (interactive "r") - (save-excursion (caml-run-process-if-needed)) - (save-excursion - (goto-char end) - (caml-skip-comments-backward) - (comint-send-region inferior-caml-buffer-name start (point)) - ;; normally, ";;" are part of the region - (if (and (>= (point) 2) - (prog2 (backward-char 2) (looking-at ";;"))) - (comint-send-string inferior-caml-buffer-name "\n") - (comint-send-string inferior-caml-buffer-name ";;\n")) - ;; the user may not want to see the output buffer - (if caml-display-when-eval - (display-buffer inferior-caml-buffer-name t)))) - -;; jump to errors produced by ocaml compiler - -(defun inferior-caml-goto-error (start end) - "Jump to the location of the last error as indicated by inferior toplevel." - (interactive "r") - (let ((loc (+ start - (save-excursion - (set-buffer (get-buffer inferior-caml-buffer-name)) - (re-search-backward - (concat comint-prompt-regexp - "[ \t]*Characters[ \t]+\\([0-9]+\\)-[0-9]+:$")) - (string-to-int (match-string 1)))))) - (goto-char loc))) - - -;;; orgininal inf-caml.el ended here - -;; as eval-phrase, but ignores errors. - -(defun inferior-caml-just-eval-phrase (arg &optional min max) - "Send the phrase containing the point to the CAML process. -With prefix-arg send as many phrases as its numeric value, -ignoring possible errors during evaluation. - -Optional arguments min max defines a region within which the phrase -should lies." - (interactive "p") - (let ((beg)) - (while (> arg 0) - (setq arg (- arg 1)) - (setq beg (caml-find-phrase min max)) - (caml-eval-region beg (point))) - beg)) - -(defvar caml-previous-output nil - "tells the beginning of output in the shell-output buffer, so that the -output can be retreived later, asynchronously.") - -;; enriched version of eval-phrase, to repport errors. - -(defun inferior-caml-eval-phrase (arg &optional min max) - "Send the phrase containing the point to the CAML process. -With prefix-arg send as many phrases as its numeric value, -If an error occurs during evalutaion, stop at this phrase and -repport the error. - -Return nil if noerror and position of error if any. - -If arg's numeric value is zero or negative, evaluate the current phrase -or as many as prefix arg, ignoring evaluation errors. -This allows to jump other erroneous phrases. - -Optional arguments min max defines a region within which the phrase -should lies." - (interactive "p") - (if (save-excursion (caml-run-process-if-needed)) - (progn - (setq inferior-caml-output nil) - (caml-wait-output 10 1))) - (if (< arg 1) (inferior-caml-just-eval-phrase (max 1 (- 0 arg)) min max) - (let ((proc (get-buffer-process inferior-caml-buffer-name)) - (buf (current-buffer)) - previous-output orig beg end err) - (save-window-excursion - (while (and (> arg 0) (not err)) - (setq previous-output (marker-position (process-mark proc))) - (setq caml-previous-output previous-output) - (setq inferior-caml-output nil) - (setq orig (inferior-caml-just-eval-phrase 1 min max)) - (caml-wait-output) - (switch-to-buffer inferior-caml-buffer-name nil) - (goto-char previous-output) - (cond ((re-search-forward - " *Characters \\([01-9][01-9]*\\)-\\([1-9][01-9]*\\):\n[^W]" - (point-max) t) - (setq beg (string-to-int (caml-match-string 1))) - (setq end (string-to-int (caml-match-string 2))) - (switch-to-buffer buf) - (goto-char orig) - (forward-byte end) - (setq end (point)) - (goto-char orig) - (forward-byte beg) - (setq beg (point)) - (setq err beg) - ) - ((looking-at - "Toplevel input:\n[>]\\([^\n]*\\)\n[>]\\(\\( *\\)^*\\)\n") - (let ((expr (caml-match-string 1)) - (column (- (match-end 3) (match-beginning 3))) - (width (- (match-end 2) (match-end 3)))) - (if (string-match "^\\(.*\\)[<]EOF[>]$" expr) - (setq expr (substring expr (match-beginning 1) (match-end 1)))) - (switch-to-buffer buf) - (re-search-backward - (concat "^" (regexp-quote expr) "$") - (- orig 10)) - (goto-char (+ (match-beginning 0) column)) - (setq end (+ (point) width))) - (setq err beg)) - ((looking-at - "Toplevel input:\n>[.]*\\([^.].*\n\\)\\([>].*\n\\)*[>]\\(.*[^.]\\)[.]*\n") - (let* ((e1 (caml-match-string 1)) - (e2 (caml-match-string 3)) - (expr - (concat - (regexp-quote e1) "\\(.*\n\\)*" (regexp-quote e2)))) - (switch-to-buffer buf) - (re-search-backward expr orig 'move) - (setq end (match-end 0))) - (setq err beg)) - (t - (switch-to-buffer buf))) - (setq arg (- arg 1)) - ) - (pop-to-buffer inferior-caml-buffer-name) - (if err - (goto-char (point-max)) - (goto-char previous-output) - (goto-char (point-max))) - (pop-to-buffer buf)) - (if err (progn (beep) (caml-overlay-region (point) end)) - (if inferior-caml-output - (message "No error") - (message "No output yet...") - )) - err))) - -(defun caml-overlay-region (beg end &optional wait) - (interactive "%r") - (cond ((fboundp 'make-overlay) - (if caml-error-overlay () - (setq caml-error-overlay (make-overlay 1 1)) - (overlay-put caml-error-overlay 'face 'region)) - (unwind-protect - (progn - (move-overlay caml-error-overlay beg end (current-buffer)) - (beep) (if wait (read-event) (caml-sit-for 60))) - (delete-overlay caml-error-overlay))))) - -;; wait some amount for ouput, that is, until inferior-caml-output is set -;; to true. Hence, interleaves sitting for shorts delays and checking the -;; flag. Give up after some time. Typing into the source buffer will cancel -;; waiting, i.e. may report 'No result yet' - -(defun caml-wait-output (&optional before after) - (let ((c 1)) - (caml-sit-for 0 (or before 1)) - (let ((c 1)) - (while (and (not inferior-caml-output) (< c 99) (caml-sit-for 0 c t)) - (setq c (+ c 1)))) - (caml-sit-for (or after 0) 1))) - -;; To insert the last output from caml at point -(defun caml-insert-last-output () - "Insert the result of the evaluation of previous phrase" - (interactive) - (let ((pos (process-mark (get-buffer-process inferior-caml-buffer-name)))) - (insert-buffer-substring inferior-caml-buffer-name - caml-previous-output (- pos 2)))) - -;; additional bindings - -;(let ((map (lookup-key caml-mode-map [menu-bar caml]))) -; (define-key map [indent-buffer] '("Indent buffer" . caml-indent-buffer)) -; (define-key map [eval-buffer] '("Eval buffer" . caml-eval-buffer)) -;) -;(define-key caml-mode-map "\C-c\C-b" 'caml-eval-buffer) - - -(provide 'inf-caml) diff --git a/emacs/external/ml/inf-caml.elc b/emacs/external/ml/inf-caml.elc deleted file mode 100644 index 4175d863c7fa6ad7ba464be26dc4ac492bf38995..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcwPel00001 literal 8949 zcwWU>`*#z^6&C#^mN=+Th(bc*jMflKLMyZnt+2^SLMUnI2{k07oZ_|XwKOYjyxLv% zVdJ#@-+S+!8NDovoc5fSgKf>7*PZ+L?n95B{_x~hsZ^>wdi01ri6==A@*z7uXW2L& zf3x@f;a#6 zgG@J#j`bi5a;}F#mOKa|Umtjru){;z7DVhRu4AV>%>uXt*LMt>I}7qLu#)ou@HJb| zdD!dN^Gm!iWO0%Qli*h`hb393LX)q?K_*x#GM=&FdE`xk0UO4HEKh@Il(k_t&2r`q zhw!v1E5=U8-04&rfzKLVG-QqAxQK=c+ZHd9j5I4{*7y=uq}*ocMx7nGO zv4PUF5A${9ZtJ{SiqwbnUR}M@Vbo(0HPx;#- zNI7y9L^(rF5184kY<<(WSnHY3^0eS>HU#qty>ph2IjG9#X#m{fVs>2kFl1+A9x;CE zg#}naG-CW+l7f`TAU>}&hTK2(#137arQ;SIx3HWww(hbH)1AHvk6&Wm*!cE3{ITR4 zy0+_=;InAk? z!;bAV@j}zF*mLg}I1m|>*MWt21Cp`uzvXM;%mGNgQ~9xoGUf?l9w#9`;DOB8Hj~V!M9;fHHD~OUJXURDA(7nOeCm!$yKYZ9> zFC=*YXB=~ufi8qNyeI|}N|n`s*AsjAJirb2AFI{$FCjlK41oRZi)+}{K57h&#bMIQ z`(QIh7mUI%{s6yBv<~S3hIRGDElKMMn*X5~8`Cwtn(IrNGow`{sV_-pxAuEMGL?Us zX6=R~S&C%WZc0*5k(`>m(o|ku*^ zVUbxT-iYf%9s(wVvA{6(z{--bp5Fzs-QeXXr<7^Xd&H#7|{KY_pk zrW@*D+JSc*;_kby`%i7|l3*0YDc2zspuKZHcnAJ2VF#!Y?2hIqyld2hsx_k!5SYkwLHrIe&riJO;(ENe~90D~Z@mdWMZ51dYgimt*?z%8GZ^QVitKriGN|�slZc25ysMY6h_5O^8V?C3XT^n`qn2Wx{K4G%7fsAL#7Bp1sjB=^hA zV&dh4G1K-B*@4D#(AU8l4#@h%ezMLv7&M;Xo!1wkLoNkR1X$4hA{tP_#@4(GM1UMX zjwWtc#er~)_waVn?$Fs}6w(79Fo0to2y&d6-(WHnGIciUU!y#COBD0T;(&%GR|6A6 z*_uS`Bj~%4tKBFg>Ko-cg6y475%dw=uets=1iSv@dv6u0%aCEviAJ}D_>SVMDfwOQ zWWeDiAzeKUEIQ&OXgxnqXvh1#S}JTX=7SRw68HodErw7XW&#;LwZ+(;$B1CNY#F@0 zbd>3NENmVv#7mO!T)?-?`&OX6O4HE|NM#G)TMP^+Ygfclnh9aP#`oGRs7QC6?i#e??Jzi$rmA`KRe#t91YU zcmlykdK!??N7fnal8cUbu0D1l5n=NONBkY+cSV>7K9~-dM$I6t(qmukg7oY(h>Psv zLI}Eq93ruSQmDs%!juf_K^a#8qDEKy+K-XbT5NsE5Cya+;`zZXw~_K!w()bPJVllL2>8J)J4BCx};3l@3y! zGKB<988yEAavciJiF~otU87B5$B@2GQ&j!f8=RbZ=}-lP4D}^tWHQ}kVNAuR?tz~? zdZaC^ldh+^k%p7_XBpE`tpe0+^I;DpooWKnd+g7}BvHD=3>lFZ>pmKL;FqGo;bHnP z3}9Y#uBK{ND7H@JqZpiAoU^3y4W;sO{jJh8gmqB!3kCQh)Pq{<^(JPUhH>Y3hB|oE zIyYNUOTjDWT`0w}!Al_^OtnC8)p|1aumb04hQs@=+t}~wJNTigi%+|EHHCBVK#Z>h zcS<9W!uFKd`;I*myJ_1qw-Ti_uu4@m?jvf9$4R|BdHno`S(JT^1-z)R5J9o(9-@9G zUUWV!)KOnp`xFxp&46LUhPNwJ8sQay&{=?W9BCzE!-B}Fu@gs7rSGXI43`w5lmcnO zHSZWG8tOP~F-RlDrUJ~JjRQdY*{do5*F`vFVZhg7!Y@UZ3t*7a05id-%~vRNvn)++ zQ}jX%wr-coKVkOoPz7?GqSevN+kaQuP{wl1NBETKBM|4h!W-c=Lv{5sNI`NgmDn?E zsQI)+DA6z;vK)d?M(>5g11faTcVzYh_u!OBrBu~HM%QK;Y8Jd17F6Wa01~TX4ie2% z4q4YwbP3y_%JXP2PU8p=J3L?RvQ4pEo`SEE?DlpnYA^L5M*LsQ?U|3sqHz3p0P$nd z(13wB0#N{jFcL+ODfS?TtfV|i;*>-r&H$VIk>^Dk(IX)vi(&~*z!6w}CDR(-`})5g&P&>9&;z@P&vcjak4Ty&L|@9tWJdeKIgs?MPK6re zUKqw_84CCp#9PrE!xa$+-6=8tZ=LS9`kO##hoK)?RjR(OD@>*uOOsiVVN#0qSxHu5 zW_kYryplQr6odVGLVyk!KL7LC=FQDpn;&l0Hb2_DO>xk4&AIbM>CRS66sp!gOxd%beefsxICJGzShNcY9{0KnHQ)c9Mdy{y$9@O z!APCT8uNV*OwSzxJJ)hdQ5w^ySs`4dNv^b_U80PpQ{y+q1EW;|877B*|9q$x}?b+91kNtuasB7DVK)woM7L zYxOL=qKEBKO4MAFUL!BWUa4!+H2$^U;I(sv-kZ(V=Kak!wo<8)+NLfHnv7L~0a_ny zlYe`Awe}pps@)1dcC`(6S-qE4kdfuQk#>c#1h!Wp(94L|kCup|{eU)1vUBL8u+cz${ z%yM}?m!bJ_DiSm{mz^=n%nV4##P1d+Xh>Tm?Yhza;cINSE#+*)z(V3?GI^1XUbv8a zzfwgzeJ_G%eszF%9l8$GqIUX07JW)Pgv5{*sbQ%nbv zIr%GOgb+7c1CN+rVQzrM>{&2`tU>nf@jF7s4aQAKh?`AV$P*!TxGTjvMFzA9SdKS> zC;lZC;ZviJ(k{+<-syBSaR=N*>@1rpUXC_+!1^i;>N}Ro+Ln8hOZP(*RF9ZNLNv`; zM;yP`>GnDlckB6+Y?Q~}9Yds;1WZ-zdrmlPb= zRoW_IHA+LVJC!uD#(dexrZ%5iVKDVH6pHT+xJnutAcK(Sv!xf$2Nj_e%v}fiqDB_j zn{pV{t9QCsXNSsZ(H(Kvvnb;- zM@@NFgt@An=Q6?ApPH#m(LTQ*rGU=SvErTyOEtGd8?Rpf7@xBtzj}GIrQUJ5OJXB# oC7Lh5^osmLvNLN}D`cFNv=5!WG5rP%_MHZht6+*rY&0wX20HlQQvd(} diff --git a/emacs/external/org-install.el b/emacs/external/org-install.el deleted file mode 100644 index 309f4f6..0000000 --- a/emacs/external/org-install.el +++ /dev/null @@ -1,539 +0,0 @@ -;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files -;;;;;; org-export-icalendar-this-file org-diary org-agenda-list-stuck-projects -;;;;;; org-tags-view org-todo-list org-agenda-list org-cycle-agenda-files -;;;;;; org-batch-store-agenda-views org-store-agenda-views org-batch-agenda-csv -;;;;;; org-batch-agenda org-agenda org-agenda-to-appt org-remember-handler -;;;;;; org-remember org-remember-apply-template org-remember-annotation -;;;;;; org-remember-insinuate org-open-at-point-global org-insert-link-global -;;;;;; org-store-link orgtbl-mode turn-on-orgtbl org-run-like-in-org-mode -;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle -;;;;;; org-cycle org-mode) "org" "org.el" (18282 28738)) -;;; Generated autoloads from org.el - -(autoload (quote org-mode) "org" "\ -Outline-based notes management and organizer, alias -\"Carsten's outline-mode for keeping track of everything.\" - -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content -of large files well structured. It supports ToDo items, deadlines and -time stamps, which magically appear in the diary listing of the Emacs -calendar. Tables are easily created with a built-in table editor. -Plain text URL-like links connect to websites, emails (VM), Usenet -messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) -can be exported as a structured ASCII or HTML file. - -The following commands are available: - -\\{org-mode-map} - -\(fn)" t nil) - -(autoload (quote org-cycle) "org" "\ -Visibility cycling for Org-mode. - -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute - `indent-relative', like TAB normally does. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t. - -\(fn &optional ARG)" t nil) - -(autoload (quote org-global-cycle) "org" "\ -Cycle the global visibility. For details see `org-cycle'. - -\(fn &optional ARG)" t nil) - -(autoload (quote orgstruct-mode) "org" "\ -Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). - -M-up Move entry/item up -M-down Move entry/item down -M-left Promote -M-right Demote -M-S-up Move entry/item up -M-S-down Move entry/item down -M-S-left Promote subtree -M-S-right Demote subtree -M-q Fill paragraph and items like in Org-mode -C-c ^ Sort entries -C-c - Cycle list bullet -TAB Cycle item visibility -M-RET Insert new heading/item -S-M-RET Insert new TODO heading / Chekbox item -C-c C-c Set tags / toggle checkbox - -\(fn &optional ARG)" t nil) - -(autoload (quote turn-on-orgstruct) "org" "\ -Unconditionally turn on `orgstruct-mode'. - -\(fn)" nil nil) - -(autoload (quote turn-on-orgstruct++) "org" "\ -Unconditionally turn on `orgstruct-mode', and force org-mode indentations. -In addition to setting orgstruct-mode, this also exports all indentation and -autofilling variables from org-mode into the buffer. Note that turning -off orgstruct-mode will *not* remove these additonal settings. - -\(fn)" nil nil) - -(autoload (quote org-run-like-in-org-mode) "org" "\ -Not documented - -\(fn CMD)" nil nil) - -(autoload (quote turn-on-orgtbl) "org" "\ -Unconditionally turn on `orgtbl-mode'. - -\(fn)" nil nil) - -(autoload (quote orgtbl-mode) "org" "\ -The `org-mode' table editor as a minor mode for use in other modes. - -\(fn &optional ARG)" t nil) - -(autoload (quote org-store-link) "org" "\ -\\Store an org-link to the current location. -This link can later be inserted into an org-buffer with -\\[org-insert-link]. -For some link types, a prefix arg is interpreted: -For links to usenet articles, arg negates `org-usenet-links-prefer-google'. -For file links, arg negates `org-context-in-file-links'. - -\(fn ARG)" t nil) - -(autoload (quote org-insert-link-global) "org" "\ -Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax. - -\(fn)" t nil) - -(autoload (quote org-open-at-point-global) "org" "\ -Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax. - -\(fn)" t nil) - -(autoload (quote org-remember-insinuate) "org" "\ -Setup remember.el for use wiht Org-mode. - -\(fn)" nil nil) - -(autoload (quote org-remember-annotation) "org" "\ -Return a link to the current location as an annotation for remember.el. -If you are using Org-mode files as target for data storage with -remember.el, then the annotations should include a link compatible with the -conventions in Org-mode. This function returns such a link. - -\(fn)" nil nil) - -(autoload (quote org-remember-apply-template) "org" "\ -Initialize *remember* buffer with template, invoke `org-mode'. -This function should be placed into `remember-mode-hook' and in fact requires -to be run from that hook to function properly. - -\(fn &optional USE-CHAR SKIP-INTERACTIVE)" nil nil) - -(autoload (quote org-remember) "org" "\ -Call `remember'. If this is already a remember buffer, re-apply template. -If there is an active region, make sure remember uses it as initial content -of the remember buffer. - -When called interactively with a `C-u' prefix argument GOTO, don't remember -anything, just go to the file/headline where the selected templated usually -stores its notes. With a double prefix arg `C-u C-u', got to the last -note stored by remember. - -Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character -associated with a template in `org-remember-tempates'. - -\(fn &optional GOTO ORG-FORCE-REMEMBER-TEMPLATE-CHAR)" t nil) - -(autoload (quote org-remember-handler) "org" "\ -Store stuff from remember.el into an org file. -First prompts for an org file. If the user just presses return, the value -of `org-default-notes-file' is used. -Then the command offers the headings tree of the selected file in order to -file the text at a specific location. -You can either immediately press RET to get the note appended to the -file, or you can use vertical cursor motion and visibility cycling (TAB) to -find a better place. Then press RET or or in insert the note. - -Key Cursor position Note gets inserted ------------------------------------------------------------------------------ -RET buffer-start as level 1 heading at end of file -RET on headline as sublevel of the heading at cursor -RET no heading at cursor position, level taken from context. - Or use prefix arg to specify level manually. - on headline as same level, before current heading - on headline as same level, after current heading - -So the fastest way to store the note is to press RET RET to append it to -the default file. This way your current train of thought is not -interrupted, in accordance with the principles of remember.el. -You can also get the fast execution without prompting by using -C-u C-c C-c to exit the remember buffer. See also the variable -`org-remember-store-without-prompt'. - -Before being stored away, the function ensures that the text has a -headline, i.e. a first line that starts with a \"*\". If not, a headline -is constructed from the current date and some additional data. - -If the variable `org-adapt-indentation' is non-nil, the entire text is -also indented so that it starts in the same column as the headline -\(i.e. after the stars). - -See also the variable `org-reverse-note-order'. - -\(fn)" nil nil) - -(autoload (quote org-agenda-to-appt) "org" "\ -Activate appointments found in `org-agenda-files'. -When prefixed, prompt for a regular expression and use it as a -filter: only add entries if they match this regular expression. - -FILTER can be a string. In this case, use this string as a -regular expression to filter results. - -FILTER can also be an alist, with the car of each cell being -either 'headline or 'category. For example: - - '((headline \"IMPORTANT\") - (category \"Work\")) - -will only add headlines containing IMPORTANT or headlines -belonging to the category \"Work\". - -\(fn &optional FILTER)" t nil) - -(autoload (quote org-agenda) "org" "\ -Dispatch agenda commands to collect entries to the agenda buffer. -Prompts for a command to execute. Any prefix arg will be passed -on to the selected command. The default selections are: - -a Call `org-agenda-list' to display the agenda for current day or week. -t Call `org-todo-list' to display the global todo list. -T Call `org-todo-list' to display the global todo list, select only - entries with a specific TODO keyword (the user gets a prompt). -m Call `org-tags-view' to display headlines with tags matching - a condition (the user is prompted for the condition). -M Like `m', but select only TODO entries, no ordinary headlines. -L Create a timeline for the current buffer. -e Export views to associated files. - -More commands can be added by configuring the variable -`org-agenda-custom-commands'. In particular, specific tags and TODO keyword -searches can be pre-defined in this way. - -If the current buffer is in Org-mode and visiting a file, you can also -first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. -Pressing `<' twice means to restrict to the current subtree or region -\(if active). - -\(fn ARG &optional KEYS RESTRICTION)" t nil) - -(autoload (quote org-batch-agenda) "org" "\ -Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string is is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound -before running the agenda command. - -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) - -(autoload (quote org-batch-agenda-csv) "org" "\ -Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string is is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound -before running the agenda command. - -The output gives a line for each selected agenda item. Each -item is a list of comma-separated values, like this: - -category,head,type,todo,tags,date,time,extra,priority-l,priority-n - -category The category of the item -head The headline, without TODO kwd, TAGS and PRIORITY -type The type of the agenda entry, can be - todo selected in TODO match - tagsmatch selected in tags match - diary imported from diary - deadline a deadline on given date - scheduled scheduled on given date - timestamp entry has timestamp on given date - closed entry was closed on given date - upcoming-deadline warning about deadline - past-scheduled forwarded scheduled item - block entry has date block including g. date -todo The todo keyword, if any -tags All tags including inherited ones, separated by colons -date The relevant date, like 2007-2-14 -time The time, like 15:00-16:50 -extra Sting with extra planning info -priority-l The priority letter if any was given -priority-n The computed numerical priority -agenda-day The day in the agenda where this is listed - -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) - -(autoload (quote org-store-agenda-views) "org" "\ -Not documented - -\(fn &rest PARAMETERS)" t nil) - -(autoload (quote org-batch-store-agenda-views) "org" "\ -Run all custom agenda commands that have a file argument. - -\(fn &rest PARAMETERS)" nil (quote macro)) - -(autoload (quote org-cycle-agenda-files) "org" "\ -Cycle through the files in `org-agenda-files'. -If the current buffer visits an agenda file, find the next one in the list. -If the current buffer does not, find the first agenda file. - -\(fn)" t nil) - -(autoload (quote org-agenda-list) "org" "\ -Produce a daily/weekly view from all files in variable `org-agenda-files'. -The view will be for the current day or week, but from the overview buffer -you will be able to go to other days/weeks. - -With one \\[universal-argument] prefix argument INCLUDE-ALL, -all unfinished TODO items will also be shown, before the agenda. -This feature is considered obsolete, please use the TODO list or a block -agenda instead. - -With a numeric prefix argument in an interactive call, the agenda will -span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change -the number of days. NDAYS defaults to `org-agenda-ndays'. - -START-DAY defaults to TODAY, or to the most recent match for the weekday -given in `org-agenda-start-on-weekday'. - -\(fn &optional INCLUDE-ALL START-DAY NDAYS)" t nil) - -(autoload (quote org-todo-list) "org" "\ -Show all TODO entries from all agenda file in a single list. -The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted -for a keyword. A numeric prefix directly selects the Nth keyword in -`org-todo-keywords-1'. - -\(fn ARG)" t nil) - -(autoload (quote org-tags-view) "org" "\ -Show all headlines for all `org-agenda-files' matching a TAGS criterion. -The prefix arg TODO-ONLY limits the search to TODO entries. - -\(fn &optional TODO-ONLY MATCH)" t nil) - -(autoload (quote org-agenda-list-stuck-projects) "org" "\ -Create agenda view for projects that are stuck. -Stuck projects are project that have no next actions. For the definitions -of what a project is and how to check if it stuck, customize the variable -`org-stuck-projects'. -MATCH is being ignored. - -\(fn &rest IGNORE)" t nil) - -(autoload (quote org-diary) "org" "\ -Return diary information from org-files. -This function can be used in a \"sexp\" diary entry in the Emacs calendar. -It accesses org files and extracts information from those files to be -listed in the diary. The function accepts arguments specifying what -items should be listed. The following arguments are allowed: - - :timestamp List the headlines of items containing a date stamp or - date range matching the selected date. Deadlines will - also be listed, on the expiration day. - - :sexp List entries resulting from diary-like sexps. - - :deadline List any deadlines past due, or due within - `org-deadline-warning-days'. The listing occurs only - in the diary for *today*, not at any other date. If - an entry is marked DONE, it is no longer listed. - - :scheduled List all items which are scheduled for the given date. - The diary for *today* also contains items which were - scheduled earlier and are not yet marked DONE. - - :todo List all TODO items from the org-file. This may be a - long list - so this is not turned on by default. - Like deadlines, these entries only show up in the - diary for *today*, not at any other date. - -The call in the diary file should look like this: - - &%%(org-diary) ~/path/to/some/orgfile.org - -Use a separate line for each org file to check. Or, if you omit the file name, -all files listed in `org-agenda-files' will be checked automatically: - - &%%(org-diary) - -If you don't give any arguments (as in the example above), the default -arguments (:deadline :scheduled :timestamp :sexp) are used. -So the example above may also be written as - - &%%(org-diary :deadline :timestamp :sexp :scheduled) - -The function expects the lisp variables `entry' and `date' to be provided -by the caller, because this is how the calendar works. Don't use this -function from a program - use `org-agenda-get-day-entries' instead. - -\(fn &rest ARGS)" nil nil) - -(autoload (quote org-export-icalendar-this-file) "org" "\ -Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'. - -\(fn)" t nil) - -(autoload (quote org-export-icalendar-all-agenda-files) "org" "\ -Export all files in `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'. - -\(fn)" t nil) - -(autoload (quote org-export-icalendar-combine-agenda-files) "org" "\ -Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-publish-all org-publish-current-file org-publish-current-project -;;;;;; org-publish) "org-publish" "org-publish.el" (18207 29024)) -;;; Generated autoloads from org-publish.el - -(autoload (quote org-publish) "org-publish" "\ -Publish the project PROJECT-NAME. - -\(fn PROJECT-NAME &optional FORCE)" t nil) - -(autoload (quote org-publish-current-project) "org-publish" "\ -Publish the project associated with the current file. -With prefix argument, force publishing all files in project. - -\(fn &optional FORCE)" t nil) - -(autoload (quote org-publish-current-file) "org-publish" "\ -Publish the current file. -With prefix argument, force publish the file. - -\(fn &optional FORCE)" t nil) - -(autoload (quote org-publish-all) "org-publish" "\ -Publish all projects. -With prefix argument, force publish all files. - -\(fn &optional FORCE)" t nil) - -;;;*** - -;;;### (autoloads (org-export-as-latex org-export-region-as-latex -;;;;;; org-replace-region-by-latex org-export-as-latex-to-buffer -;;;;;; org-export-as-latex-batch) "org-export-latex" "org-export-latex.el" -;;;;;; (18252 7249)) -;;; Generated autoloads from org-export-latex.el - -(autoload (quote org-export-as-latex-batch) "org-export-latex" "\ -Call `org-export-as-latex', may be used in batch processing as -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-latex-batch - -\(fn)" nil nil) - -(autoload (quote org-export-as-latex-to-buffer) "org-export-latex" "\ -Call `org-exort-as-latex` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-latex'. - -\(fn ARG)" t nil) - -(autoload (quote org-replace-region-by-latex) "org-export-latex" "\ -Replace the region from BEG to END with its LaTeX export. -It assumes the region has `org-mode' syntax, and then convert it to -LaTeX. This can be used in any buffer. For example, you could -write an itemized list in `org-mode' syntax in an LaTeX buffer and -then use this command to convert it. - -\(fn BEG END)" t nil) - -(autoload (quote org-export-region-as-latex) "org-export-latex" "\ -Convert region from BEG to END in `org-mode' buffer to LaTeX. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted LaTeX. If BUFFER is the symbol `string', return the -produced LaTeX as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq latex (org-export-region-as-latex beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only retunr the buffer. - -\(fn BEG END &optional BODY-ONLY BUFFER)" t nil) - -(autoload (quote org-export-as-latex) "org-export-latex" "\ -Export current buffer to a LaTeX file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will be exported -depending on `org-export-latex-low-levels'. The default is to -convert them as description lists. When HIDDEN is non-nil, don't -display the LaTeX buffer. EXT-PLIST is a property list with -external parameters overriding org-mode's default settings, but -still inferior to file-local settings. When TO-BUFFER is -non-nil, create a buffer with that name and export to that -buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind but just return the resulting LaTeX as a string. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of egin{document}...nd{document}, -without even the egin{document} and nd{document} commands. - -\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY)" t nil) - -;;;*** - -(provide (quote org-install)) diff --git a/emacs/external/org.el b/emacs/external/org.el deleted file mode 100644 index a8557d3..0000000 --- a/emacs/external/org.el +++ /dev/null @@ -1,27696 +0,0 @@ -;;; org.el --- Outline-based notes management and organizer -;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; Version: 5.17a -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing -;; project planning with a fast and effective plain-text system. -;; -;; Org-mode develops organizational tasks around NOTES files that contain -;; information about projects as plain text. Org-mode is implemented on -;; top of outline-mode, which makes it possible to keep the content of -;; large files well structured. Visibility cycling and structure editing -;; help to work with the tree. Tables are easily created with a built-in -;; table editor. Org-mode supports ToDo items, deadlines, time stamps, -;; and scheduling. It dynamically compiles entries into an agenda that -;; utilizes and smoothly integrates much of the Emacs calendar and diary. -;; Plain text URL-like links connect to websites, emails, Usenet -;; messages, BBDB entries, and any files related to the projects. For -;; printing and sharing of notes, an Org-mode file can be exported as a -;; structured ASCII file, as HTML, or (todo and agenda items only) as an -;; iCalendar file. It can also serve as a publishing tool for a set of -;; linked webpages. -;; -;; Installation and Activation -;; --------------------------- -;; See the corresponding sections in the manual at -;; -;; http://orgmode.org/org.html#Installation -;; -;; Documentation -;; ------------- -;; The documentation of Org-mode can be found in the TeXInfo file. The -;; distribution also contains a PDF version of it. At the homepage of -;; Org-mode, you can read the same text online as HTML. There is also an -;; excellent reference card made by Philip Rooke. This card can be found -;; in the etc/ directory of Emacs 22. -;; -;; A list of recent changes can be found at -;; http://orgmode.org/Changes.html -;; -;;; Code: - -;;;; Require other packages - -(eval-when-compile - (require 'cl) - (require 'gnus-sum) - (require 'calendar)) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el -(require 'outline) (require 'noutline) -;; Other stuff we need. -(require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) - -;;;; Customization variables - -;;; Version - -(defconst org-version "5.17a" - "The version number of the file org.el.") -(defun org-version () - (interactive) - (message "Org-mode version %s" org-version)) - -;;; Compatibility constants -(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself -(defconst org-format-transports-properties-p - (let ((x "a")) - (add-text-properties 0 1 '(test t) x) - (get-text-property 0 'test (format "%s" x))) - "Does format transport text properties?") - -(defmacro org-bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - `(and (boundp (quote ,var)) ,var)) - -(defmacro org-unmodified (&rest body) - "Execute body without changing buffer-modified-p." - `(set-buffer-modified-p - (prog1 (buffer-modified-p) ,@body))) - -(defmacro org-re (s) - "Replace posix classes in regular expression." - (if (featurep 'xemacs) - (let ((ss s)) - (save-match-data - (while (string-match "\\[:alnum:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:alpha:\\]" ss) - (setq ss (replace-match "a-zA-Z" t t ss))) - ss)) - s)) - -(defmacro org-preserve-lc (&rest body) - `(let ((_line (org-current-line)) - (_col (current-column))) - (unwind-protect - (progn ,@body) - (goto-line _line) - (move-to-column _col)))) - -(defmacro org-without-partial-completion (&rest body) - `(let ((pc-mode (and (boundp 'partial-completion-mode) - partial-completion-mode))) - (unwind-protect - (progn - (if pc-mode (partial-completion-mode -1)) - ,@body) - (if pc-mode (partial-completion-mode 1))))) - -;;; The custom variables - -(defgroup org nil - "Outline-based notes management and organizer." - :tag "Org" - :group 'outlines - :group 'hypermedia - :group 'calendar) - -;; FIXME: Needs a separate group... -(defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[org-complete] in normal context. -Normal means, no org-mode-specific context." - :group 'org - :type 'function) - -(defgroup org-startup nil - "Options concerning startup of Org-mode." - :tag "Org Startup" - :group 'org) - -(defcustom org-startup-folded t - "Non-nil means, entering Org-mode will switch to OVERVIEW. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: fold - #+STARTUP: nofold - #+STARTUP: content" - :group 'org-startup - :type '(choice - (const :tag "nofold: show all" nil) - (const :tag "fold: overview" t) - (const :tag "content: all headlines" content))) - -(defcustom org-startup-truncated t - "Non-nil means, entering Org-mode will set `truncate-lines'. -This is useful since some lines containing links can be very long and -uninteresting. Also tables look terrible when wrapped." - :group 'org-startup - :type 'boolean) - -(defcustom org-startup-align-all-tables nil - "Non-nil means, align all tables when visiting a file. -This is useful when the column width in tables is forced with cookies -in table fields. Such tables will look correct only after the first re-align. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - #+STARTUP: align - #+STARTUP: noalign" - :group 'org-startup - :type 'boolean) - -(defcustom org-insert-mode-line-in-empty-file nil - "Non-nil means insert the first line setting Org-mode in empty files. -When the function `org-mode' is called interactively in an empty file, this -normally means that the file name does not automatically trigger Org-mode. -To ensure that the file will always be in Org-mode in the future, a -line enforcing Org-mode will be inserted into the buffer, if this option -has been set." - :group 'org-startup - :type 'boolean) - -(defcustom org-replace-disputed-keys nil - "Non-nil means use alternative key bindings for some keys. -Org-mode uses S- keys for changing timestamps and priorities. -These keys are also used by other packages like `CUA-mode' or `windmove.el'. -If you want to use Org-mode together with one of these other modes, -or more generally if you would like to move some Org-mode commands to -other keys, set this variable and configure the keys with the variable -`org-disputed-keys'. - -This option is only relevant at load-time of Org-mode, and must be set -*before* org.el is loaded. Changing it requires a restart of Emacs to -become effective." - :group 'org-startup - :type 'boolean) - -(if (fboundp 'defvaralias) - (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)) - -(defcustom org-disputed-keys - '(([(shift up)] . [(meta p)]) - ([(shift down)] . [(meta n)]) - ([(shift left)] . [(meta -)]) - ([(shift right)] . [(meta +)]) - ([(control shift right)] . [(meta shift +)]) - ([(control shift left)] . [(meta shift -)])) - "Keys for which Org-mode and other modes compete. -This is an alist, cars are the default keys, second element specifies -the alternative to use when `org-replace-disputed-keys' is t. - -Keys can be specified in any syntax supported by `define-key'. -The value of this option takes effect only at Org-mode's startup, -therefore you'll have to restart Emacs to apply it after changing." - :group 'org-startup - :type 'alist) - -(defun org-key (key) - "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed." - (if org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (if x (cdr x) key)) - key)) - -(defun org-find-if (predicate seq) - (catch 'exit - (while seq - (if (funcall predicate (car seq)) - (throw 'exit (car seq)) - (pop seq))))) - -(defun org-defkey (keymap key def) - "Define a key, possibly translated, as returned by `org-key'." - (define-key keymap (org-key key) def)) - -(defcustom org-ellipsis nil - "The ellipsis to use in the Org-mode outline. -When nil, just use the standard three dots. When a string, use that instead, -When a face, use the standart 3 dots, but with the specified face. -The change affects only Org-mode (which will then use its own display table). -Changing this requires executing `M-x org-mode' in a buffer to become -effective." - :group 'org-startup - :type '(choice (const :tag "Default" nil) - (face :tag "Face" :value org-warning) - (string :tag "String" :value "...#"))) - -(defvar org-display-table nil - "The display table for org-mode, in case `org-ellipsis' is non-nil.") - -(defgroup org-keywords nil - "Keywords in Org-mode." - :tag "Org Keywords" - :group 'org) - -(defcustom org-deadline-string "DEADLINE:" - "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-scheduled-string "SCHEDULED:" - "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-string "CLOSED:" - "String used as the prefix for timestamps logging closing a TODO entry." - :group 'org-keywords - :type 'string) - -(defcustom org-clock-string "CLOCK:" - "String used as prefix for timestamps clocking work hours on an item." - :group 'org-keywords - :type 'string) - -(defcustom org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. -An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-quote-string "QUOTE" - "Entries starting with this keyword will be exported in fixed-width font. -Quoting applies only to the text in the entry following the headline, and does -not extend beyond the next headline, even if that is lower level. -An entry can be toggled between QUOTE and normal with -\\[org-toggle-fixed-width-section]." - :group 'org-keywords - :type 'string) - -(defconst org-repeat-re - (concat "\\(?:\\<\\(?:" org-scheduled-string "\\|" org-deadline-string "\\)" - " +<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\)\\(\\+[0-9]+[dwmy]\\)") - "Regular expression for specifying repeated events. -After a match, group 1 contains the repeat expression.") - -(defgroup org-structure nil - "Options concerning the general structure of Org-mode files." - :tag "Org Structure" - :group 'org) - -(defgroup org-reveal-location nil - "Options about how to make context of a location visible." - :tag "Org Reveal Location" - :group 'org-structure) - -(defconst org-context-choice - '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (boolean)))) - "Contexts for the reveal options.") - -(defcustom org-show-hierarchy-above '((default . t)) - "Non-nil means, show full hierarchy when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the hierarchy of headings -above the exposed location is shown. -Turning this off for example for sparse trees makes them very compact. -Instead of t, this can also be an alist specifying this option for different -contexts. Valid contexts are - agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' on key C-c C-j - occur-tree when using the command `org-occur' on key C-c / - tags-tree when constructing a sparse tree based on tags matches - link-search when exposing search matches associated with a link - mark-goto when exposing the jump goal of a mark - bookmark-jump when exposing a bookmark location - isearch when exiting from an incremental search - default default for all contexts not set explicitly" - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-following-heading '((default . nil)) - "Non-nil means, show following heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the heading following the -match is shown. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-siblings '((default . nil) (isearch t)) - "Non-nil means, show all sibling heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the sibling of the current entry -heading are all made visible. If `org-show-hierarchy-above' is t, -the same happens on each level of the hierarchy above the current entry. - -By default this is on for the isearch context, off for all other contexts. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-entry-below '((default . nil)) - "Non-nil means, show the entry below a headline when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the text below the headline that is -exposed is also shown. - -By default this is off for all contexts. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defgroup org-cycle nil - "Options concerning visibility cycling in Org-mode." - :tag "Org Cycle" - :group 'org-structure) - -(defcustom org-drawers '("PROPERTIES" "CLOCK") - "Names of drawers. Drawers are not opened by cycling on the headline above. -Drawers only open with a TAB on the drawer line itself. A drawer looks like -this: - :DRAWERNAME: - ..... - :END: -The drawer \"PROPERTIES\" is special for capturing properties through -the property API. - -Drawers can be defined on the per-file basis with a line like: - -#+DRAWERS: HIDDEN STATE PROPERTIES" - :group 'org-structure - :type '(repeat (string :tag "Drawer Name"))) - -(defcustom org-cycle-global-at-bob nil - "Cycle globally if cursor is at beginning of buffer and not at a headline. -This makes it possible to do global cycling without having to use S-TAB or -C-u TAB. For this special case to work, the first line of the buffer -must not be a headline - it may be empty ot some other text. When used in -this way, `org-cycle-hook' is disables temporarily, to make sure the -cursor stays at the beginning of the buffer. -When this option is nil, don't do anything special at the beginning -of the buffer." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-emulate-tab t - "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -whitestart Only at the beginning of lines, before the first non-white char. -t Everywhere except in headlines -exc-hl-bol Everywhere except at the start of a headline -If TAB is used in a place where it does not emulate TAB, the current subtree -visibility is cycled." - :group 'org-cycle - :type '(choice (const :tag "Never" nil) - (const :tag "Only in completely white lines" white) - (const :tag "Before first char in a line" whitestart) - (const :tag "Everywhere except in headlines" t) - (const :tag "Everywhere except at bol in headlines" exc-hl-bol) - )) - -(defcustom org-cycle-separator-lines 2 - "Number of empty lines needed to keep an empty line between collapsed trees. -If you leave an empty line between the end of a subtree and the following -headline, this empty line is hidden when the subtree is folded. -Org-mode will leave (exactly) one empty line visible if the number of -empty lines is equal or larger to the number given in this variable. -So the default 2 means, at least 2 empty lines after the end of a subtree -are needed to produce free space between a collapsed subtree and the -following headline. - -Special case: when 0, never leave empty lines in collapsed view." - :group 'org-cycle - :type 'integer) - -(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees - org-cycle-hide-drawers - org-cycle-show-empty-lines - org-optimize-window-after-visibility-change) - "Hook that is run after `org-cycle' has changed the buffer visibility. -The function(s) in this hook must accept a single argument which indicates -the new state that was set by the most recent `org-cycle' command. The -argument is a symbol. After a global state change, it can have the values -`overview', `content', or `all'. After a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defgroup org-edit-structure nil - "Options concerning structure editing in Org-mode." - :tag "Org Edit Structure" - :group 'org-structure) - -(defcustom org-special-ctrl-a/e nil - "Non-nil means `C-a' and `C-e' behave specially in headlines and items. -When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO keyword. -In an item, this will be the position after the bullet. -When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line. -`C-e' will jump to the end of the headline, ignoring the presence of tags -in the headline. A second `C-e' will then jump to the true end of the -line, after any tags. -When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -and only a directly following, identical keypress will bring the cursor -to the special positions." - :group 'org-edit-structure - :type '(choice - (const :tag "off" nil) - (const :tag "after bullet first" t) - (const :tag "border first" reversed))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) - -(defcustom org-odd-levels-only nil - "Non-nil means, skip even levels and only use odd levels for the outline. -This has the effect that two stars are being added/taken away in -promotion/demotion commands. It also influences how levels are -handled by the exporters. -Changing it requires restart of `font-lock-mode' to become effective -for fontification also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: odd - #+STARTUP: oddeven" - :group 'org-edit-structure - :group 'org-font-lock - :type 'boolean) - -(defcustom org-adapt-indentation t - "Non-nil means, adapt indentation when promoting and demoting. -When this is set and the *entire* text in an entry is indented, the -indentation is increased by one space in a demotion command, and -decreased by one in a promotion command. If any line in the entry -body starts at column 0, indentation is not changed at all." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-blank-before-new-entry '((heading . nil) - (plain-list-item . nil)) - "Should `org-insert-heading' leave a blank line before new heading/item? -The value is an alist, with `heading' and `plain-list-item' as car, -and a boolean flag as cdr." - :group 'org-edit-structure - :type '(list - (cons (const heading) (boolean)) - (cons (const plain-list-item) (boolean)))) - -(defcustom org-insert-heading-hook nil - "Hook being run after inserting a new heading." - :group 'org-edit-structure - :type 'hook) - -(defcustom org-enable-fixed-width-editor t - "Non-nil means, lines starting with \":\" are treated as fixed-width. -This currently only means, they are never auto-wrapped. -When nil, such lines will be treated like ordinary lines. -See also the QUOTE keyword." - :group 'org-edit-structure - :type 'boolean) - -(defgroup org-sparse-trees nil - "Options concerning sparse trees in Org-mode." - :tag "Org Sparse Trees" - :group 'org-structure) - -(defcustom org-highlight-sparse-tree-matches t - "Non-nil means, highlight all matches that define a sparse tree. -The highlights will automatically disappear the next time the buffer is -changed by an edit command." - :group 'org-sparse-trees - :type 'boolean) - -(defcustom org-remove-highlights-with-change t - "Non-nil means, any change to the buffer will remove temporary highlights. -Such highlights are created by `org-occur' and `org-clock-display'. -When nil, `C-c C-c needs to be used to get rid of the highlights. -The highlights created by `org-preview-latex-fragment' always need -`C-c C-c' to be removed." - :group 'org-sparse-trees - :group 'org-time - :type 'boolean) - - -(defcustom org-occur-hook '(org-first-headline-recenter) - "Hook that is run after `org-occur' has constructed a sparse tree. -This can be used to recenter the window to show as much of the structure -as possible." - :group 'org-sparse-trees - :type 'hook) - -(defgroup org-plain-lists nil - "Options concerning plain lists in Org-mode." - :tag "Org Plain lists" - :group 'org-structure) - -(defcustom org-cycle-include-plain-lists nil - "Non-nil means, include plain lists into visibility cycling. -This means that during cycling, plain list items will *temporarily* be -interpreted as outline headlines with a level given by 1000+i where i is the -indentation of the bullet. In all other operations, plain list items are -not seen as headlines. For example, you cannot assign a TODO keyword to -such an item." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-plain-list-ordered-item-terminator t - "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t. While -?. may look nicer, it creates the danger that a line with leading -number may be incorrectly interpreted as an item. ?\) therefore is -the safe choice." - :group 'org-plain-lists - :type '(choice (const :tag "dot like in \"2.\"" ?.) - (const :tag "paren like in \"2)\"" ?\)) - (const :tab "both" t))) - -(defcustom org-auto-renumber-ordered-lists t - "Non-nil means, automatically renumber ordered plain lists. -Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, -use \\[org-ctrl-c-ctrl-c] to trigger renumbering." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-provide-checkbox-statistics t - "Non-nil means, update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you either insert -a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox -with \\[org-ctrl-c-ctrl-c\\]." - :group 'org-plain-lists - :type 'boolean) - -(defgroup org-archive nil - "Options concerning archiving in Org-mode." - :tag "Org Archive" - :group 'org-structure) - -(defcustom org-archive-tag "ARCHIVE" - "The tag that marks a subtree as archived. -An archived subtree does not open during visibility cycling, and does -not contribute to the agenda listings. -After changing this, font-lock must be restarted in the relevant buffers to -get the proper fontification." - :group 'org-archive - :group 'org-keywords - :type 'string) - -(defcustom org-agenda-skip-archived-trees t - "Non-nil means, the agenda will skip any items located in archived trees. -An archived tree is a tree marked with the tag ARCHIVE." - :group 'org-archive - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-cycle-open-archived-trees nil - "Non-nil means, `org-cycle' will open archived trees. -An archived tree is a tree marked with the tag ARCHIVE. -When nil, archived trees will stay folded. You can still open them with -normal outline commands like `show-all', but not with the cycling commands." - :group 'org-archive - :group 'org-cycle - :type 'boolean) - -(defcustom org-sparse-tree-open-archived-trees nil - "Non-nil means sparse tree construction shows matches in archived trees. -When nil, matches in these trees are highlighted, but the trees are kept in -collapsed state." - :group 'org-archive - :group 'org-sparse-trees - :type 'boolean) - -(defcustom org-archive-location "%s_archive::" - "The location where subtrees should be archived. -This string consists of two parts, separated by a double-colon. - -The first part is a file name - when omitted, archiving happens in the same -file. %s will be replaced by the current file name (without directory part). -Archiving to a different file is useful to keep archived entries from -contributing to the Org-mode Agenda. - -The part after the double colon is a headline. The archived entries will be -filed under that headline. When omitted, the subtrees are simply filed away -at the end of the file, as top-level entries. - -Here are a few examples: -\"%s_archive::\" - If the current file is Projects.org, archive in file - Projects.org_archive, as top-level trees. This is the default. - -\"::* Archived Tasks\" - Archive in the current file, under the top-level headline - \"* Archived Tasks\". - -\"~/org/archive.org::\" - Archive in file ~/org/archive.org (absolute path), as top-level trees. - -\"basement::** Finished Tasks\" - Archive in file ./basement (relative path), as level 3 trees - below the level 2 heading \"** Finished Tasks\". - -You may set this option on a per-file basis by adding to the buffer a -line like - -#+ARCHIVE: basement::** Finished Tasks" - :group 'org-archive - :type 'string) - -(defcustom org-archive-mark-done t - "Non-nil means, mark entries as DONE when they are moved to the archive file. -This can be a string to set the keyword to use. When t, Org-mode will -use the first keyword in its list that means done." - :group 'org-archive - :type '(choice - (const :tag "No" nil) - (const :tag "Yes" t) - (string :tag "Use this keyword"))) - -(defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to entries moved to an archive file. -This variable is obsolete and has no effect anymore, instead add ot remove -`time' from the variablle `org-archive-save-context-info'." - :group 'org-archive - :type 'boolean) - -(defcustom org-archive-save-context-info '(time file category todo itags) - "Parts of context info that should be stored as properties when archiving. -When a subtree is moved to an archive file, it looses information given by -context, like inherited tags, the category, and possibly also the TODO -state (depending on the variable `org-archive-mark-done'). -This variable can be a list of any of the following symbols: - -time The time of archiving. -file The file where the entry originates. -itags The local tags, in the headline of the subtree. -ltags The tags the subtree inherits from further up the hierarchy. -todo The pre-archive TODO state. -category The category, taken from file name or #+CATEGORY lines. - -For each symbol present in the list, a property will be created in -the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this -information." - :group 'org-archive - :type '(set :greedy t - (const :tag "Time" time) - (const :tag "File" file) - (const :tag "Category" category) - (const :tag "TODO state" todo) - (const :tag "TODO state" priority) - (const :tag "Inherited tags" itags) - (const :tag "Local tags" ltags))) - -(defgroup org-imenu-and-speedbar nil - "Options concerning imenu and speedbar in Org-mode." - :tag "Org Imenu and Speedbar" - :group 'org-structure) - -(defcustom org-imenu-depth 2 - "The maximum level for Imenu access to Org-mode headlines. -This also applied for speedbar access." - :group 'org-imenu-and-speedbar - :type 'number) - -(defgroup org-table nil - "Options concerning tables in Org-mode." - :tag "Org Table" - :group 'org) - -(defcustom org-enable-table-editor 'optimized - "Non-nil means, lines starting with \"|\" are handled by the table editor. -When nil, such lines will be treated like ordinary lines. - -When equal to the symbol `optimized', the table editor will be optimized to -do the following: -- Automatic overwrite mode in front of whitespace in table fields. - This makes the structure of the table stay in tact as long as the edited - field does not exceed the column width. -- Minimize the number of realigns. Normally, the table is aligned each time - TAB or RET are pressed to move to another field. With optimization this - happens only if changes to a field might have changed the column width. -Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org-mode buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is -very good at guessing when a re-align will be necessary, but you can always -force one with \\[org-ctrl-c-ctrl-c]. - -If you would like to use the optimized version in Org-mode, but the -un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. - -This variable can be used to turn on and off the table editor during a session, -but in order to toggle optimization, a restart is required. - -See also the variable `org-table-auto-blank-field'." - :group 'org-table - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (const :tag "on, optimized" optimized))) - -(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) - "Non-nil means, use the optimized table editor version for `orgtbl-mode'. -In the optimized version, the table editor takes over all simple keys that -normally just insert a character. In tables, the characters are inserted -in a way to minimize disturbing the table structure (i.e. in overwrite mode -for empty fields). Outside tables, the correct binding of the keys is -restored. - -The default for this option is t if the optimized version is also used in -Org-mode. See the variable `org-enable-table-editor' for details. Changing -this variable requires a restart of Emacs to become effective." - :group 'org-table - :type 'boolean) - -(defcustom orgtbl-radio-table-templates - '((latex-mode "% BEGIN RECEIVE ORGTBL %n -% END RECEIVE ORGTBL %n -\\begin{comment} -#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 -| | | -\\end{comment}\n") - (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n -@c END RECEIVE ORGTBL %n -@ignore -#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 -| | | -@end ignore\n") - (html-mode " - -\n")) - "Templates for radio tables in different major modes. -All occurrences of %n in a template will be replaced with the name of the -table, obtained by prompting the user." - :group 'org-table - :type '(repeat - (list (symbol :tag "Major mode") - (string :tag "Format")))) - -(defgroup org-table-settings nil - "Settings for tables in Org-mode." - :tag "Org Table Settings" - :group 'org-table) - -(defcustom org-table-default-size "5x2" - "The default size for newly created tables, Columns x Rows." - :group 'org-table-settings - :type 'string) - -(defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" - "Regular expression for recognizing numbers in table columns. -If a table column contains mostly numbers, it will be aligned to the -right. If not, it will be aligned to the left. - -The default value of this option is a regular expression which allows -anything which looks remotely like a number as used in scientific -context. For example, all of the following will be considered a -number: - 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 - -Other options offered by the customize interface are more restrictive." - :group 'org-table-settings - :type '(choice - (const :tag "Positive Integers" - "^[0-9]+$") - (const :tag "Integers" - "^[-+]?[0-9]+$") - (const :tag "Floating Point Numbers" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") - (const :tag "Floating Point Number or Integer" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") - (const :tag "Exponential, Floating point, Integer" - "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") - (string :tag "Regexp:"))) - -(defcustom org-table-number-fraction 0.5 - "Fraction of numbers in a column required to make the column align right. -In a column all non-white fields are considered. If at least this -fraction of fields is matched by `org-table-number-fraction', -alignment to the right border applies." - :group 'org-table-settings - :type 'number) - -(defgroup org-table-editing nil - "Behavior of tables during editing in Org-mode." - :tag "Org Table Editing" - :group 'org-table) - -(defcustom org-table-automatic-realign t - "Non-nil means, automatically re-align table when pressing TAB or RETURN. -When nil, aligning is only done with \\[org-table-align], or after column -removal/insertion." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-auto-blank-field t - "Non-nil means, automatically blank table field when starting to type into it. -This only happens when typing immediately after a field motion -command (TAB, S-TAB or RET). -Only relevant when `org-enable-table-editor' is equal to `optimized'." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-tab-jumps-over-hlines t - "Non-nil means, tab in the last column of a table with jump over a hline. -If a horizontal separator line is following the current line, -`org-table-next-field' can either create a new row before that line, or jump -over the line. When this option is nil, a new line will be created before -this line." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-tab-recognizes-table.el t - "Non-nil means, TAB will automatically notice a table.el table. -When it sees such a table, it moves point into it and - if necessary - -calls `table-recognize-table'." - :group 'org-table-editing - :type 'boolean) - -(defgroup org-table-calculation nil - "Options concerning tables in Org-mode." - :tag "Org Table Calculation" - :group 'org-table) - -(defcustom org-table-use-standard-references t - "Should org-mode work with table refrences like B3 instead of @3$2? -Possible values are: -nil never use them -from accept as input, do not present for editing -t: accept as input and present for editing" - :group 'org-table-calculation - :type '(choice - (const :tag "Never, don't even check unser input for them" nil) - (const :tag "Always, both as user input, and when editing" t) - (const :tag "Convert user input, don't offer during editing" 'from))) - -(defcustom org-table-copy-increment t - "Non-nil means, increment when copying current field with \\[org-table-copy-down]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-calc-default-modes - '(calc-internal-prec 12 - calc-float-format (float 5) - calc-angle-mode deg - calc-prefer-frac nil - calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm)) - calc-display-working-message t - ) - "List with Calc mode settings for use in calc-eval for table formulas. -The list must contain alternating symbols (Calc modes variables and values). -Don't remove any of the default settings, just change the values. Org-mode -relies on the variables to be present in the list." - :group 'org-table-calculation - :type 'plist) - -(defcustom org-table-formula-evaluate-inline t - "Non-nil means, TAB and RET evaluate a formula in current table field. -If the current field starts with an equal sign, it is assumed to be a formula -which should be evaluated as described in the manual and in the documentation -string of the command `org-table-eval-formula'. This feature requires the -Emacs calc package. -When this variable is nil, formula calculation is only available through -the command \\[org-table-eval-formula]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-use-constants t - "Non-nil means, interpret constants in formulas in tables. -A constant looks like `$c' or `$Grav' and will be replaced before evaluation -by the value given in `org-table-formula-constants', or by a value obtained -from the `constants.el' package." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-constants nil - "Alist with constant names and values, for use in table formulas. -The car of each element is a name of a constant, without the `$' before it. -The cdr is the value as a string. For example, if you'd like to use the -speed of light in a formula, you would configure - - (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) - -and then use it in an equation like `$1*$c'. - -Constants can also be defined on a per-file basis using a line like - -#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" - :group 'org-table-calculation - :type '(repeat - (cons (string :tag "name") - (string :tag "value")))) - -(defvar org-table-formula-constants-local nil - "Local version of `org-table-formula-constants'.") -(make-variable-buffer-local 'org-table-formula-constants-local) - -(defcustom org-table-allow-automatic-line-recalculation t - "Non-nil means, lines marked with |#| or |*| will be recomputed automatically. -Automatically means, when TAB or RET or C-c C-c are pressed in the line." - :group 'org-table-calculation - :type 'boolean) - -(defgroup org-link nil - "Options concerning links in Org-mode." - :tag "Org Link" - :group 'org) - -(defvar org-link-abbrev-alist-local nil - "Buffer-local version of `org-link-abbrev-alist', which see. -The value of this is taken from the #+LINK lines.") -(make-variable-buffer-local 'org-link-abbrev-alist-local) - -(defcustom org-link-abbrev-alist nil - "Alist of link abbreviations. -The car of each element is a string, to be replaced at the start of a link. -The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated -links in Org-mode buffers can have an optional tag after a double colon, e.g. - - [[linkkey:tag][description]] - -If REPLACE is a string, the tag will simply be appended to create the link. -If the string contains \"%s\", the tag will be inserted there. - -REPLACE may also be a function that will be called with the tag as the -only argument to create the link, which should be returned as a string. - -See the manual for examples." - :group 'org-link - :type 'alist) - -(defcustom org-descriptive-links t - "Non-nil means, hide link part and only show description of bracket links. -Bracket links are like [[link][descritpion]]. This variable sets the initial -state in new org-mode buffers. The setting can then be toggled on a -per-buffer basis from the Org->Hyperlinks menu." - :group 'org-link - :type 'boolean) - -(defcustom org-link-file-path-type 'adaptive - "How the path name in file links should be stored. -Valid values are: - -relative relative to the current directory, i.e. the directory of the file - into which the link is being inserted. -absolute absolute path, if possible with ~ for home directory. -noabbrev absolute path, no abbreviation of home directory. -adaptive Use relative path for files in the current directory and sub- - directories of it. For other files, use an absolute path." - :group 'org-link - :type '(choice - (const relative) - (const absolute) - (const noabbrev) - (const adaptive))) - -(defcustom org-activate-links '(bracket angle plain radio tag date) - "Types of links that should be activated in Org-mode files. -This is a list of symbols, each leading to the activation of a certain link -type. In principle, it does not hurt to turn on most link types - there may -be a small gain when turning off unused link types. The types are: - -bracket The recommended [[link][description]] or [[link]] links with hiding. -angular Links in angular brackes that may contain whitespace like - . -plain Plain links in normal text, no whitespace, like http://google.com. -radio Text that is matched by a radio target, see manual for details. -tag Tag settings in a headline (link to tag search). -date Time stamps (link to calendar). - -Changing this variable requires a restart of Emacs to become effective." - :group 'org-link - :type '(set (const :tag "Double bracket links (new style)" bracket) - (const :tag "Angular bracket links (old style)" angular) - (const :tag "plain text links" plain) - (const :tag "Radio target matches" radio) - (const :tag "Tags" tag) - (const :tag "Tags" target) - (const :tag "Timestamps" date))) - -(defgroup org-link-store nil - "Options concerning storing links in Org-mode" - :tag "Org Store Link" - :group 'org-link) - -(defcustom org-email-link-description-format "Email %c: %.30s" - "Format of the description part of a link to an email or usenet message. -The following %-excapes will be replaced by corresponding information: - -%F full \"From\" field -%f name, taken from \"From\" field, address if no name -%T full \"To\" field -%t first name in \"To\" field, address if no name -%c correspondent. Unually \"from NAME\", but if you sent it yourself, it - will be \"to NAME\". See also the variable `org-from-is-user-regexp'. -%s subject -%m message-id. - -You may use normal field width specification between the % and the letter. -This is for example useful to limit the length of the subject. - -Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" - :group 'org-link-store - :type 'string) - -(defcustom org-from-is-user-regexp - (let (r1 r2) - (when (and user-mail-address (not (string= user-mail-address ""))) - (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) - (when (and user-full-name (not (string= user-full-name ""))) - (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) - (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) - "Regexp mached against the \"From:\" header of an email or usenet message. -It should match if the message is from the user him/herself." - :group 'org-link-store - :type 'regexp) - -(defcustom org-context-in-file-links t - "Non-nil means, file links from `org-store-link' contain context. -A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command -`org-open-at-point'. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defcustom org-keep-stored-link-after-insertion nil - "Non-nil means, keep link in list for entire session. - -The command `org-store-link' adds a link pointing to the current -location to an internal list. These links accumulate during a session. -The command `org-insert-link' can be used to insert links into any -Org-mode file (offering completion for all stored links). When this -option is nil, every link which has been inserted once using \\[org-insert-link] -will be removed from the list, to make completing the unused links -more efficient." - :group 'org-link-store - :type 'boolean) - -(defcustom org-usenet-links-prefer-google nil - "Non-nil means, `org-store-link' will create web links to Google groups. -When nil, Gnus will be used for such links. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defgroup org-link-follow nil - "Options concerning following links in Org-mode" - :tag "Org Follow Link" - :group 'org-link) - -(defcustom org-tab-follows-link nil - "Non-nil means, on links TAB will follow the link. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-return-follows-link nil - "Non-nil means, on links RET will follow the link. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mouse-1-follows-link t - "Non-nil means, mouse-1 on a link will follow the link. -A longer mouse click will still set point. Does not wortk on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring -Changing this requires a restart of Emacs to work correctly." - :group 'org-link-follow - :type 'interger) - -(defcustom org-link-frame-setup - '((vm . vm-visit-folder-other-frame) - (gnus . gnus-other-frame) - (file . find-file-other-window)) - "Setup the frame configuration for following links. -When following a link with Emacs, it may often be useful to display -this link in another window or frame. This variable can be used to -set this up for the different types of links. -For VM, use any of - `vm-visit-folder' - `vm-visit-folder-other-frame' -For Gnus, use any of - `gnus' - `gnus-other-frame' -For FILE, use any of - `find-file' - `find-file-other-window' - `find-file-other-frame' -For the calendar, use the variable `calendar-setup'. -For BBDB, it is currently only possible to display the matches in -another window." - :group 'org-link-follow - :type '(list - (cons (const vm) - (choice - (const vm-visit-folder) - (const vm-visit-folder-other-window) - (const vm-visit-folder-other-frame))) - (cons (const gnus) - (choice - (const gnus) - (const gnus-other-frame))) - (cons (const file) - (choice - (const find-file) - (const find-file-other-window) - (const find-file-other-frame))))) - -(defcustom org-display-internal-link-with-indirect-buffer nil - "Non-nil means, use indirect buffer to display infile links. -Activating internal links (from one location in a file to another location -in the same file) normally just jumps to the location. When the link is -activated with a C-u prefix (or with mouse-3), the link is displayed in -another window. When this option is set, the other window actually displays -an indirect buffer clone of the current buffer, to avoid any visibility -changes to the current buffer." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-open-non-existing-files nil - "Non-nil means, `org-open-file' will open non-existing files. -When nil, an error will be generated." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") - "Function and arguments to call for following mailto links. -This is a list with the first element being a lisp function, and the -remaining elements being arguments to the function. In string arguments, -%a will be replaced by the address, and %s will be replaced by the subject -if one was given like in ." - :group 'org-link-follow - :type '(choice - (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) - (const :tag "compose-mail" (compose-mail "%a" "%s")) - (const :tag "message-mail" (message-mail "%a" "%s")) - (cons :tag "other" (function) (repeat :tag "argument" sexp)))) - -(defcustom org-confirm-shell-link-function 'yes-or-no-p - "Non-nil means, ask for confirmation before executing shell links. -Shell links can be dangerous: just think about a link - - [[shell:rm -rf ~/*][Google Search]] - -This link would show up in your Org-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a -single keystroke rather than having to type \"yes\"." - :group 'org-link-follow - :type '(choice - (const :tag "with yes-or-no (safer)" yes-or-no-p) - (const :tag "with y-or-n (faster)" y-or-n-p) - (const :tag "no confirmation (dangerous)" nil))) - -(defcustom org-confirm-elisp-link-function 'yes-or-no-p - "Non-nil means, ask for confirmation before executing Emacs Lisp links. -Elisp links can be dangerous: just think about a link - - [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] - -This link would show up in your Org-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a -single keystroke rather than having to type \"yes\"." - :group 'org-link-follow - :type '(choice - (const :tag "with yes-or-no (safer)" yes-or-no-p) - (const :tag "with y-or-n (faster)" y-or-n-p) - (const :tag "no confirmation (dangerous)" nil))) - -(defconst org-file-apps-defaults-gnu - '((remote . emacs) - (t . mailcap)) - "Default file applications on a UNIX or GNU/Linux system. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-macosx - '((remote . emacs) - (t . "open %s") - ("ps" . "gv %s") - ("ps.gz" . "gv %s") - ("eps" . "gv %s") - ("eps.gz" . "gv %s") - ("dvi" . "xdvi %s") - ("fig" . "xfig %s")) - "Default file applications on a MacOS X system. -The system \"open\" is known as a default, but we use X11 applications -for some files for which the OS does not have a good default. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-windowsnt - (list - '(remote . emacs) - (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) - "Default file applications on a Windows NT system. -The system \"open\" is used for most files. -See `org-file-apps'.") - -(defcustom org-file-apps - '( - ("txt" . emacs) - ("tex" . emacs) - ("ltx" . emacs) - ("org" . emacs) - ("el" . emacs) - ("bib" . emacs) - ) - "External applications for opening `file:path' items in a document. -Org-mode uses system defaults for different file types, but -you can use this variable to set the application for a given file -extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. Possible values for the -file identifier are - \"ext\" A string identifying an extension - `directory' Matches a directory - `remote' Matches a remote file, accessible through tramp or efs. - Remote files most likely should be visited through Emacs - because external applications cannot handle such paths. - t Default for all remaining files - -Possible values for the command are: - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. -For more examples, see the system specific constants -`org-file-apps-defaults-macosx' -`org-file-apps-defaults-windowsnt' -`org-file-apps-defaults-gnu'." - :group 'org-link-follow - :type '(repeat - (cons (choice :value "" - (string :tag "Extension") - (const :tag "Default for unrecognized files" t) - (const :tag "Remote file" remote) - (const :tag "Links to a directory" directory)) - (choice :value "" - (const :tag "Visit with Emacs" emacs) - (const :tag "Use system default" default) - (string :tag "Command") - (sexp :tag "Lisp form"))))) - -(defcustom org-mhe-search-all-folders nil - "Non-nil means, that the search for the mh-message will be extended to -all folders if the message cannot be found in the folder given in the link. -Searching all folders is very efficient with one of the search engines -supported by MH-E, but will be slow with pick." - :group 'org-link-follow - :type 'boolean) - -(defgroup org-remember nil - "Options concerning interaction with remember.el." - :tag "Org Remember" - :group 'org) - -(defcustom org-directory "~/org" - "Directory with org files. -This directory will be used as default to prompt for org files. -Used by the hooks for remember.el." - :group 'org-remember - :type 'directory) - -(defcustom org-default-notes-file "~/.notes" - "Default target for storing notes. -Used by the hooks for remember.el. This can be a string, or nil to mean -the value of `remember-data-file'. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type '(choice - (const :tag "Default from remember-data-file" nil) - file)) - -(defcustom org-remember-store-without-prompt t - "Non-nil means, `C-c C-c' stores remember note without further promts. -In this case, you need `C-u C-c C-c' to get the prompts for -note file and headline. -When this variable is nil, `C-c C-c' give you the prompts, and -`C-u C-c C-c' trigger the fasttrack." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-default-headline "" - "The headline that should be the default location in the notes file. -When filing remember notes, the cursor will start at that position. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type 'string) - -(defcustom org-remember-templates nil - "Templates for the creation of remember buffers. -When nil, just let remember make the buffer. -When not nil, this is a list of 5-element lists. In each entry, the first -element is a the name of the template, It should be a single short word. -The second element is a character, a unique key to select this template. -The third element is the template. The forth element is optional and can -specify a destination file for remember items created with this template. -The default file is given by `org-default-notes-file'. An optional fifth -element can specify the headline in that file that should be offered -first when the user is asked to file the entry. The default headline is -given in the variable `org-remember-default-headline'. - -The template specifies the structure of the remember buffer. It should have -a first line starting with a star, to act as the org-mode headline. -Furthermore, the following %-escapes will be replaced with content: - - %^{prompt} Prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: - %^{prompt|default|completion2|completion3|...} - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U - You may define a prompt like %^{Please specify birthday}t - %n user name (taken from `user-full-name') - %a annotation, normally the link created with org-store-link - %i initial content, the region when remember is called with C-u. - If %i is indented, the entire inserted text will be indented - as well. - %c content of the clipboard, or current kill ring head - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion all tags in all agenda files - %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - - - %? After completing the template, position cursor here. - -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `remember' in emails or gnus -will record the author and the subject of the message, which you can access -with %:author and %:subject, respectively. Here is a complete list of what -is recorded for each link type. - -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-remember - :get (lambda (var) ; Make sure all entries have 5 elements - (mapcar (lambda (x) - (if (not (stringp (car x))) (setq x (cons "" x))) - (cond ((= (length x) 4) (append x '(""))) - ((= (length x) 3) (append x '("" ""))) - (t x))) - (default-value var))) - :type '(repeat - :tag "enabled" - (list :value ("" ?a "\n" nil nil) - (string :tag "Name") - (character :tag "Selection Key") - (string :tag "Template") - (choice - (file :tag "Destination file") - (const :tag "Prompt for file" nil)) - (choice - (string :tag "Destination headline") - (const :tag "Selection interface for heading"))))) - -(defcustom org-reverse-note-order nil - "Non-nil means, store new notes at the beginning of a file or entry. -When nil, new notes will be filed to the end of a file or entry. -This can also be a list with cons cells of regular expressions that -are matched against file names, and values." - :group 'org-remember - :type '(choice - (const :tag "Reverse always" t) - (const :tag "Reverse never" nil) - (repeat :tag "By file name regexp" - (cons regexp boolean)))) - -(defcustom org-refile-targets '((nil . (:level . 1))) - "Targets for refiling entries with \\[org-refile]. -This is list of cons cells. Each cell contains: -- a specification of the files to be considered, either a list of files, - or a symbol whose function or value fields will be used to retrieve - a file name or a list of file names. Nil means, refile to a different - heading in the current buffer. -- A specification of how to find candidate refile targets. This may be - any of - - a cons cell (:tag . \"TAG\") to identify refile targes by a tag. - This tag has to be present in all target headlines, inheritance will - not be considered. - - a cons cell (:todo . \"KEYWORD\" to identify refile targets by - todo keyword. - - a cons cell (:regexp . \"REGEXP\") with a regular expression matching - headlines that are refiling targets. - - a cons cell (:level . N). Any headline of level N is considered a target. - - a cons cell (:maxlevel . N). Any headline with level <= N is a target." -;; FIXME: what if there are a var and func with same name??? - :group 'org-remember - :type '(repeat - (cons - (choice :value org-agenda-files - (const :tag "All agenda files" org-agenda-files) - (const :tag "Current buffer" nil) - (function) (variable) (file)) - (choice :tag "Identify target headline by" - (cons :tag "Specific tag" (const :tag) (string)) - (cons :tag "TODO keyword" (const :todo) (string)) - (cons :tag "Regular expression" (const :regexp) (regexp)) - (cons :tag "Level number" (const :level) (integer)) - (cons :tag "Max Level number" (const :maxlevel) (integer)))))) - -(defcustom org-refile-use-outline-path nil - "Non-nil means, provide refile targets as paths. -So a level 3 headline will be available as level1/level2/level3." - :group 'org-remember - :type 'boolean) - -(defgroup org-todo nil - "Options concerning TODO items in Org-mode." - :tag "Org TODO" - :group 'org) - -(defgroup org-progress nil - "Options concerning Progress logging in Org-mode." - :tag "Org Progress" - :group 'org-time) - -(defcustom org-todo-keywords '((sequence "TODO" "DONE")) - "List of TODO entry keyword sequences and their interpretation. -\\This is a list of sequences. - -Each sequence starts with a symbol, either `sequence' or `type', -indicating if the keywords should be interpreted as a sequence of -action steps, or as different types of TODO items. The first -keywords are states requiring action - these states will select a headline -for inclusion into the global TODO list Org-mode produces. If one of -the \"keywords\" is the vertical bat \"|\" the remaining keywords -signify that no further action is necessary. If \"|\" is not found, -the last keyword is treated as the only DONE state of the sequence. - -The command \\[org-todo] cycles an entry through these states, and one -additional state where no keyword is present. For details about this -cycling, see the manual. - -TODO keywords and interpretation can also be set on a per-file basis with -the special #+SEQ_TODO and #+TYP_TODO lines. - -For backward compatibility, this variable may also be just a list -of keywords - in this case the interptetation (sequence or type) will be -taken from the (otherwise obsolete) variable `org-todo-interpretation'." - :group 'org-todo - :group 'org-keywords - :type '(choice - (repeat :tag "Old syntax, just keywords" - (string :tag "Keyword")) - (repeat :tag "New syntax" - (cons - (choice - :tag "Interpretation" - (const :tag "Sequence (cycling hits every state)" sequence) - (const :tag "Type (cycling directly to DONE)" type)) - (repeat - (string :tag "Keyword")))))) - -(defvar org-todo-keywords-1 nil) -(make-variable-buffer-local 'org-todo-keywords-1) -(defvar org-todo-keywords-for-agenda nil) -(defvar org-done-keywords-for-agenda nil) -(defvar org-not-done-keywords nil) -(make-variable-buffer-local 'org-not-done-keywords) -(defvar org-done-keywords nil) -(make-variable-buffer-local 'org-done-keywords) -(defvar org-todo-heads nil) -(make-variable-buffer-local 'org-todo-heads) -(defvar org-todo-sets nil) -(make-variable-buffer-local 'org-todo-sets) -(defvar org-todo-log-states nil) -(make-variable-buffer-local 'org-todo-log-states) -(defvar org-todo-kwd-alist nil) -(make-variable-buffer-local 'org-todo-kwd-alist) -(defvar org-todo-key-alist nil) -(make-variable-buffer-local 'org-todo-key-alist) -(defvar org-todo-key-trigger nil) -(make-variable-buffer-local 'org-todo-key-trigger) - -(defcustom org-todo-interpretation 'sequence - "Controls how TODO keywords are interpreted. -This variable is in principle obsolete and is only used for -backward compatibility, if the interpretation of todo keywords is -not given already in `org-todo-keywords'. See that variable for -more information." - :group 'org-todo - :group 'org-keywords - :type '(choice (const sequence) - (const type))) - -(defcustom org-use-fast-todo-selection 'prefix - "Non-nil means, use the fast todo selection scheme with C-c C-t. -This variable describes if and under what circumstances the cycling -mechanism for TODO keywords will be replaced by a single-key, direct -selection scheme. - -When nil, fast selection is never used. - -When the symbol `prefix', it will be used when `org-todo' is called with -a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' -in an agenda buffer. - -When t, fast selection is used by default. In this case, the prefix -argument forces cycling instead. - -In all cases, the special interface is only used if access keys have actually -been assigned by the user, i.e. if keywords in the configuration are followed -by a letter in parenthesis, like TODO(t)." - :group 'org-todo - :type '(choice - (const :tag "Never" nil) - (const :tag "By default" t) - (const :tag "Only with C-u C-c C-t" prefix))) - -(defcustom org-after-todo-state-change-hook nil - "Hook which is run after the state of a TODO item was changed. -The new state (a string with a TODO keyword, or nil) is available in the -Lisp variable `state'." - :group 'org-todo - :type 'hook) - -(defcustom org-log-done nil - "When set, insert a (non-active) time stamp when TODO entry is marked DONE. -When the state of an entry is changed from nothing or a DONE state to -a not-done TODO state, remove a previous closing date. - -This can also be a list of symbols indicating under which conditions -the time stamp recording the action should be annotated with a short note. -Valid members of this list are - - done Offer to record a note when marking entries done - state Offer to record a note whenever changing the TODO state - of an item. This is only relevant if TODO keywords are - interpreted as sequence, see variable `org-todo-interpretation'. - When `state' is set, this includes tracking `done'. - clock-out Offer to record a note when clocking out of an item. - -A separate window will then pop up and allow you to type a note. -After finishing with C-c C-c, the note will be added directly after the -timestamp, as a plain list item. See also the variable -`org-log-note-headings'. - -Logging can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: logdone - #+STARTUP: nologging - #+STARTUP: lognotedone - #+STARTUP: lognotestate - #+STARTUP: lognoteclock-out - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (set :tag "on, with notes, detailed control" :greedy t :value (done) - (const :tag "when item is marked DONE" done) - (const :tag "when TODO state changes" state) - (const :tag "when clocking out" clock-out)))) - -(defcustom org-log-done-with-time t - "Non-nil means, the CLOSED time stamp will contain date and time. -When nil, only the date will be recorded." - :group 'org-progress - :type 'boolean) - -(defcustom org-log-note-headings - '((done . "CLOSING NOTE %t") - (state . "State %-12s %t") - (clock-out . "")) - "Headings for notes added when clocking out or closing TODO items. -The value is an alist, with the car being a symbol indicating the note -context, and the cdr is the heading to be used. The heading may also be the -empty string. -%t in the heading will be replaced by a time stamp. -%s will be replaced by the new TODO state, in double quotes. -%u will be replaced by the user name. -%U will be replaced by the full user name." - :group 'org-todo - :group 'org-progress - :type '(list :greedy t - (cons (const :tag "Heading when closing an item" done) string) - (cons (const :tag - "Heading when changing todo state (todo sequence only)" - state) string) - (cons (const :tag "Heading when clocking out" clock-out) string))) - -(defcustom org-log-states-order-reversed t - "Non-nil means, the latest state change note will be directly after heading. -When nil, the notes will be orderer according to time." - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-log-repeat t - "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry. -When nil, no note will be taken. -This option can also be set with on a per-file-basis with - - #+STARTUP: logrepeat - #+STARTUP: nologrepeat - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords." - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-clock-into-drawer 2 - "Should clocking info be wrapped into a drawer? -When t, clocking info will always be inserted into a :CLOCK: drawer. -If necessary, the drawer will be created. -When nil, the drawer will not be created, but used when present. -When an integer and the number of clocking entries in an item -reaches or exceeds this number, a drawer will be created." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "Always" t) - (const :tag "Only when drawer exists" nil) - (integer :tag "When at least N clock entries"))) - -(defcustom org-clock-out-when-done t - "When t, the clock will be stopped when the relevant entry is marked DONE. -Nil means, clock will keep running until stopped explicitly with -`C-c C-x C-o', or until the clock is started in a different item." - :group 'org-progress - :type 'boolean) - -(defgroup org-priorities nil - "Priorities in Org-mode." - :tag "Org Priorities" - :group 'org-todo) - -(defcustom org-highest-priority ?A - "The highest priority of TODO items. A character like ?A, ?B etc. -Must have a smaller ASCII number than `org-lowest-priority'." - :group 'org-priorities - :type 'character) - -(defcustom org-lowest-priority ?C - "The lowest priority of TODO items. A character like ?A, ?B etc. -Must have a larger ASCII number than `org-highest-priority'." - :group 'org-priorities - :type 'character) - -(defcustom org-default-priority ?B - "The default priority of TODO items. -This is the priority an item get if no explicit priority is given." - :group 'org-priorities - :type 'character) - -(defcustom org-priority-start-cycle-with-default t - "Non-nil means, start with default priority when starting to cycle. -When this is nil, the first step in the cycle will be (depending on the -command used) one higher or lower that the default priority." - :group 'org-priorities - :type 'boolean) - -(defgroup org-time nil - "Options concerning time stamps and deadlines in Org-mode." - :tag "Org Time" - :group 'org) - -(defcustom org-insert-labeled-timestamps-at-point nil - "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. -When nil, these labeled time stamps are forces into the second line of an -entry, just after the headline. When scheduling from the global TODO list, -the time stamp will always be forced into the second line." - :group 'org-time - :type 'boolean) - -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - -(defcustom org-time-stamp-rounding-minutes 0 - "Number of minutes to round time stamps to upon insertion. -When zero, insert the time unmodified. Useful rounding numbers -should be factors of 60, so for example 5, 10, 15. -When this is not zero, you can still force an exact time-stamp by using -a double prefix argument to a time-stamp command like `C-c .' or `C-c !'." - :group 'org-time - :type 'integer) - -(defcustom org-display-custom-times nil - "Non-nil means, overlay custom formats over all time stamps. -The formats are defined through the variable `org-time-stamp-custom-formats'. -To turn this on on a per-file basis, insert anywhere in the file: - #+STARTUP: customtime" - :group 'org-time - :set 'set-default - :type 'sexp) -(make-variable-buffer-local 'org-display-custom-times) - -(defcustom org-time-stamp-custom-formats - '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american - "Custom formats for time stamps. See `format-time-string' for the syntax. -These are overlayed over the default ISO format if the variable -`org-display-custom-times' is set. Time like %H:%M should be at the -end of the second format." - :group 'org-time - :type 'sexp) - -(defun org-time-stamp-format (&optional long inactive) - "Get the right format for a time string." - (let ((f (if long (cdr org-time-stamp-formats) - (car org-time-stamp-formats)))) - (if inactive - (concat "[" (substring f 1 -1) "]") - f))) - -(defcustom org-read-date-prefer-future t - "Non-nil means, assume future for incomplete date input from user. -This affects the following situations: -1. The user gives a day, but no month. - For example, if today is the 15th, and you enter \"3\", Org-mode will - read this as the third of *next* month. However, if you enter \"17\", - it will be considered as *this* month. -2. The user gives a month but not a year. - For example, if it is april and you enter \"feb 2\", this will be read - as feb 2, *next* year. \"May 5\", however, will be this year. - -When this option is nil, the current month and year will always be used -as defaults." - :group 'org-time - :type 'boolean) - -(defcustom org-read-date-display-live t - "Non-nil means, display current interpretation of date prompt live. -This display will be in an overlay, in the minibuffer." - :group 'org-time - :type 'boolean) - -(defcustom org-read-date-popup-calendar t - "Non-nil means, pop up a calendar when prompting for a date. -In the calendar, the date can be selected with mouse-1. However, the -minibuffer will also be active, and you can simply enter the date as well. -When nil, only the minibuffer will be available." - :group 'org-time - :type 'boolean) -(if (fboundp 'defvaralias) - (defvaralias 'org-popup-calendar-for-date-prompt - 'org-read-date-popup-calendar)) - -(defcustom org-extend-today-until 0 - "The hour when your day really ends. -This has influence for the following applications: -- When switching the agenda to \"today\". It it is still earlier than - the time given here, the day recognized as TODAY is actually yesterday. -- When a date is read from the user and it is still before the time given - here, the current date and time will be assumed to be yesterday, 23:59. - -FIXME: -IMPORTANT: This is still a very experimental feature, it may disappear -again or it may be extended to mean more things." - :group 'org-time - :type 'number) - -(defcustom org-edit-timestamp-down-means-later nil - "Non-nil means, S-down will increase the time in a time stamp. -When nil, S-up will increase." - :group 'org-time - :type 'boolean) - -(defcustom org-calendar-follow-timestamp-change t - "Non-nil means, make the calendar window follow timestamp changes. -When a timestamp is modified and the calendar window is visible, it will be -moved to the new date." - :group 'org-time - :type 'boolean) - -(defcustom org-clock-heading-function nil - "When non-nil, should be a function to create `org-clock-heading'. -This is the string shown in the mode line when a clock is running. -The function is called with point at the beginning of the headline." - :group 'org-time ; FIXME: Should we have a separate group???? - :type 'function) - -(defgroup org-tags nil - "Options concerning tags in Org-mode." - :tag "Org Tags" - :group 'org) - -(defcustom org-tag-alist nil - "List of tags allowed in Org-mode files. -When this list is nil, Org-mode will base TAG input on what is already in the -buffer. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details." - :group 'org-tags - :type '(repeat - (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) - (const :tag "Start radio group" (:startgroup)) - (const :tag "End radio group" (:endgroup))))) - -(defcustom org-use-fast-tag-selection 'auto - "Non-nil means, use fast tag selection scheme. -This is a special interface to select and deselect tags with single keys. -When nil, fast selection is never used. -When the symbol `auto', fast selection is used if and only if selection -characters for tags have been configured, either through the variable -`org-tag-alist' or through a #+TAGS line in the buffer. -When t, fast selection is always used and selection keys are assigned -automatically if necessary." - :group 'org-tags - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When selection characters are configured" 'auto))) - -(defcustom org-fast-tag-selection-single-key nil - "Non-nil means, fast tag selection exits after first change. -When nil, you have to press RET to exit it. -During fast tag selection, you can toggle this flag with `C-c'. -This variable can also have the value `expert'. In this case, the window -displaying the tags menu is not even shown, until you press C-c again." - :group 'org-tags - :type '(choice - (const :tag "No" nil) - (const :tag "Yes" t) - (const :tag "Expert" expert))) - -(defvar org-fast-tag-selection-include-todo nil - "Non-nil means, fast tags selection interface will also offer TODO states. -This is an undocumented feature, you should not rely on it.") - -(defcustom org-tags-column -80 - "The column to which tags should be indented in a headline. -If this number is positive, it specifies the column. If it is negative, -it means that the tags should be flushright to that column. For example, --80 works well for a normal 80 character screen." - :group 'org-tags - :type 'integer) - -(defcustom org-auto-align-tags t - "Non-nil means, realign tags after pro/demotion of TODO state change. -These operations change the length of a headline and therefore shift -the tags around. With this options turned on, after each such operation -the tags are again aligned to `org-tags-column'." - :group 'org-tags - :type 'boolean) - -(defcustom org-use-tag-inheritance t - "Non-nil means, tags in levels apply also for sublevels. -When nil, only the tags directly given in a specific line apply there. -If you turn off this option, you very likely want to turn on the -companion option `org-tags-match-list-sublevels'." - :group 'org-tags - :type 'boolean) - -(defcustom org-tags-match-list-sublevels nil - "Non-nil means list also sublevels of headlines matching tag search. -Because of tag inheritance (see variable `org-use-tag-inheritance'), -the sublevels of a headline matching a tag search often also match -the same search. Listing all of them can create very long lists. -Setting this variable to nil causes subtrees of a match to be skipped. -This option is off by default, because inheritance in on. If you turn -inheritance off, you very likely want to turn this option on. - -As a special case, if the tag search is restricted to TODO items, the -value of this variable is ignored and sublevels are always checked, to -make sure all corresponding TODO items find their way into the list." - :group 'org-tags - :type 'boolean) - -(defvar org-tags-history nil - "History of minibuffer reads for tags.") -(defvar org-last-tags-completion-table nil - "The last used completion table for tags.") -(defvar org-after-tags-change-hook nil - "Hook that is run after the tags in a line have changed.") - -(defgroup org-properties nil - "Options concerning properties in Org-mode." - :tag "Org Properties" - :group 'org) - -(defcustom org-property-format "%-10s %s" - "How property key/value pairs should be formatted by `indent-line'. -When `indent-line' hits a property definition, it will format the line -according to this format, mainly to make sure that the values are -lined-up with respect to each other." - :group 'org-properties - :type 'string) - -(defcustom org-use-property-inheritance nil - "Non-nil means, properties apply also for sublevels. -This setting is only relevant during property searches, not when querying -an entry with `org-entry-get'. To retrieve a property with inheritance, -you need to call `org-entry-get' with the inheritance flag. -Turning this on can cause significant overhead when doing a search, so -this is turned off by default. -When nil, only the properties directly given in the current entry count. -The value may also be a list of properties that shouldhave inheritance. - -However, note that some special properties use inheritance under special -circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, -and the properties ending in \"_ALL\" when they are used as descriptor -for valid values of a property." - :group 'org-properties - :type '(choice - (const :tag "Not" nil) - (const :tag "Always" nil) - (repeat :tag "Specific properties"))) - -(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" - "The default column format, if no other format has been defined. -This variable can be set on the per-file basis by inserting a line - -#+COLUMNS: %25ITEM ....." - :group 'org-properties - :type 'string) - -(defcustom org-global-properties nil - "List of property/value pairs that can be inherited by any entry. -You can set buffer-local values for this by adding lines like - -#+PROPERTY: NAME VALUE" - :group 'org-properties - :type '(repeat - (cons (string :tag "Property") - (string :tag "Value")))) - -(defvar org-local-properties nil - "List of property/value pairs that can be inherited by any entry. -Valid for the current buffer. -This variable is populated from #+PROPERTY lines.") - -(defgroup org-agenda nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda" - :group 'org) - -(defvar org-category nil - "Variable used by org files to set a category for agenda display. -Such files should use a file variable to set it, for example - -# -*- mode: org; org-category: \"ELisp\" - -or contain a special line - -#+CATEGORY: ELisp - -If the file does not specify a category, then file's base name -is used instead.") -(make-variable-buffer-local 'org-category) - -(defcustom org-agenda-files nil - "The files to be used for agenda display. -Entries may be added to this list with \\[org-agenda-file-to-front] and removed with -\\[org-remove-file]. You can also use customize to edit the list. - -If an entry is a directory, all files in that directory that are matched by -`org-agenda-file-regexp' will be part of the file list. - -If the value of the variable is not a list but a single file name, then -the list of agenda files is actually stored and maintained in that file, one -agenda file per line." - :group 'org-agenda - :type '(choice - (repeat :tag "List of files and directories" file) - (file :tag "Store list in a file\n" :value "~/.agenda_files"))) - -(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" - "Regular expression to match files for `org-agenda-files'. -If any element in the list in that variable contains a directory instead -of a normal file, all files in that directory that are matched by this -regular expression will be included." - :group 'org-agenda - :type 'regexp) - -(defcustom org-agenda-skip-unavailable-files nil - "t means to just skip non-reachable files in `org-agenda-files'. -Nil means to remove them, after a query, from the list." - :group 'org-agenda - :type 'boolean) - -(defcustom org-agenda-multi-occur-extra-files nil - "List of extra files to be searched by `org-occur-in-agenda-files'. -The files in `org-agenda-files' are always searched." - :group 'org-agenda - :type '(repeat file)) - -(defcustom org-agenda-confirm-kill 1 - "When set, remote killing from the agenda buffer needs confirmation. -When t, a confirmation is always needed. When a number N, confirmation is -only needed when the text to be killed contains more than N non-white lines." - :group 'org-agenda - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (number :tag "When more than N lines"))) - -(defcustom org-calendar-to-agenda-key [?c] - "The key to be installed in `calendar-mode-map' for switching to the agenda. -The command `org-calendar-goto-agenda' will be bound to this key. The -default is the character `c' because then `c' can be used to switch back and -forth between agenda and calendar." - :group 'org-agenda - :type 'sexp) - -(defcustom org-agenda-compact-blocks nil - "Non-nil means, make the block agenda more compact. -This is done by leaving out unnecessary lines." - :group 'org-agenda - :type nil) - -(defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." - :tag "Org Agenda Export" - :group 'org-agenda) - -(defcustom org-agenda-with-colors t - "Non-nil means, use colors in agenda views." - :group 'org-agenda-export - :type 'boolean) - -(defcustom org-agenda-exporter-settings nil - "Alist of variable/value pairs that should be active during agenda export. -This is a good place to set uptions for ps-print and for htmlize." - :group 'org-agenda-export - :type '(repeat - (list - (variable) - (sexp :tag "Value")))) - -(defcustom org-agenda-export-html-style "" - "The style specification for exported HTML Agenda files. -If this variable contains a string, it will replace the default - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to also add other text to the header. However, - is required, if not present the variable will be ignored." - :group 'org-agenda-export - :group 'org-export-html - :type 'string) - -(defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda Custom Commands" - :group 'org-agenda) - -(defcustom org-agenda-custom-commands nil - "Custom commands for the agenda. -These commands will be offered on the splash screen displayed by the -agenda dispatcher \\[org-agenda]. Each entry is a list like this: - - (key desc type match options files) - -key The key (one or more characters as a string) to be associated - with the command. -desc A description of the commend, when omitted or nil, a default - description is built using MATCH. -type The command type, any of the following symbols: - todo Entries with a specific TODO keyword, in all agenda files. - tags Tags match in all agenda files. - tags-todo Tags match in all agenda files, TODO entries only. - todo-tree Sparse tree of specific TODO keyword in *current* file. - tags-tree Sparse tree with all tags matches in *current* file. - occur-tree Occur sparse tree for *current* file. - ... A user-defined function. -match What to search for: - - a single keyword for TODO keyword searches - - a tags match expression for tags searches - - a regular expression for occur searches -options A list of option settings, similar to that in a let form, so like - this: ((opt1 val1) (opt2 val2) ...) -files A list of files file to write the produced agenda buffer to - with the command `org-store-agenda-views'. - If a file name ends in \".html\", an HTML version of the buffer - is written out. If it ends in \".ps\", a postscript version is - produced. Otherwide, only the plain text is written to the file. - -You can also define a set of commands, to create a composite agenda buffer. -In this case, an entry looks like this: - - (key desc (cmd1 cmd2 ...) general-options file) - -where - -desc A description string to be displayed in the dispatcher menu. -cmd An agenda command, similar to the above. However, tree commands - are no allowed, but instead you can get agenda and global todo list. - So valid commands for a set are: - (agenda) - (alltodo) - (stuck) - (todo \"match\" options files) - (tags \"match\" options files) - (tags-todo \"match\" options files) - -Each command can carry a list of options, and another set of options can be -given for the whole set of commands. Individual command options take -precedence over the general options. - -When using several characters as key to a command, the first characters -are prefix commands. For the dispatcher to display useful information, you -should provide a description for the prefix, like - - (setq org-agenda-custom-commands - '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" - (\"hl\" tags \"+HOME+Lisa\") - (\"hp\" tags \"+HOME+Peter\") - (\"hk\" tags \"+HOME+Kim\")))" - :group 'org-agenda-custom-commands - :type '(repeat - (choice :value ("a" "" tags "" nil) - (list :tag "Single command" - (string :tag "Access Key(s) ") - (option (string :tag "Description")) - (choice - (const :tag "Agenda" agenda) - (const :tag "TODO list" alltodo) - (const :tag "Stuck projects" stuck) - (const :tag "Tags search (all agenda files)" tags) - (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) - (const :tag "TODO keyword search (all agenda files)" todo) - (const :tag "Tags sparse tree (current buffer)" tags-tree) - (const :tag "TODO keyword tree (current buffer)" todo-tree) - (const :tag "Occur tree (current buffer)" occur-tree) - (sexp :tag "Other, user-defined function")) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (list :tag "Command series, all agenda files" - (string :tag "Access Key(s)") - (string :tag "Description ") - (repeat - (choice - (const :tag "Agenda" (agenda)) - (const :tag "TODO list" (alltodo)) - (const :tag "Stuck projects" (stuck)) - (list :tag "Tags search" - (const :format "" tags) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "Tags search, TODO entries only" - (const :format "" tags-todo) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "TODO keyword search" - (const :format "" todo) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "Other, user-defined function" - (symbol :tag "function") - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))))) - - (repeat :tag "General options" - (list (variable :tag "Option") - (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (cons :tag "Prefix key documentation" - (string :tag "Access Key(s)") - (string :tag "Description "))))) - -(defcustom org-stuck-projects - '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") - "How to identify stuck projects. -This is a list of four items: -1. A tags/todo matcher string that is used to identify a project. - The entire tree below a headline matched by this is considered one project. -2. A list of TODO keywords identifying non-stuck projects. - If the project subtree contains any headline with one of these todo - keywords, the project is considered to be not stuck. If you specify - \"*\" as a keyword, any TODO keyword will mark the project unstuck. -3. A list of tags identifying non-stuck projects. - If the project subtree contains any headline with one of these tags, - the project is considered to be not stuck. If you specify \"*\" as - a tag, any tag will mark the project unstuck. -4. An arbitrary regular expression matching non-stuck projects. - -After defining this variable, you may use \\[org-agenda-list-stuck-projects] -or `C-c a #' to produce the list." - :group 'org-agenda-custom-commands - :type '(list - (string :tag "Tags/TODO match to identify a project") - (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) - (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) - - -(defgroup org-agenda-skip nil - "Options concerning skipping parts of agenda files." - :tag "Org Agenda Skip" - :group 'org-agenda) - -(defcustom org-agenda-todo-list-sublevels t - "Non-nil means, check also the sublevels of a TODO entry for TODO entries. -When nil, the sublevels of a TODO entry are not checked, resulting in -potentially much shorter TODO lists." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-with-date nil - "Non-nil means, don't show entries with a date in the global todo list. -You can use this if you prefer to mark mere appointments with a TODO keyword, -but don't want them to show up in the TODO list. -When this is set, it also covers deadlines and scheduled items, the settings -of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' -will be ignored." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-scheduled nil - "Non-nil means, don't show scheduled entries in the global todo list. -The idea behind this is that by scheduling it, you have already taken care -of this item. -See also `org-agenda-todo-ignore-with-date'." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-deadlines nil - "Non-nil means, don't show near deadline entries in the global todo list. -Near means closer than `org-deadline-warning-days' days. -The idea behind this is that such items will appear in the agenda anyway. -See also `org-agenda-todo-ignore-with-date'." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-skip-scheduled-if-done nil - "Non-nil means don't show scheduled items in agenda when they are done. -This is relevant for the daily/weekly agenda, not for the TODO list. And -it applies only to the actual date of the scheduling. Warnings about -an item with a past scheduling dates are always turned off when the item -is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-deadline-if-done nil - "Non-nil means don't show deadines when the corresponding item is done. -When nil, the deadline is still shown and should give you a happy feeling. -This is relevant for the daily/weekly agenda. And it applied only to the -actualy date of the deadline. Warnings about approching and past-due -deadlines are always turned off when the item is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-timestamp-if-done nil - "Non-nil means don't don't select item by timestamp or -range if it is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-timeline-show-empty-dates 3 - "Non-nil means, `org-timeline' also shows dates without an entry. -When nil, only the days which actually have entries are shown. -When t, all days between the first and the last date are shown. -When an integer, show also empty dates, but if there is a gap of more than -N days, just insert a special line indicating the size of the gap." - :group 'org-agenda-skip - :type '(choice - (const :tag "None" nil) - (const :tag "All" t) - (number :tag "at most"))) - - -(defgroup org-agenda-startup nil - "Options concerning initial settings in the Agenda in Org Mode." - :tag "Org Agenda Startup" - :group 'org-agenda) - -(defcustom org-finalize-agenda-hook nil - "Hook run just before displaying an agenda buffer." - :group 'org-agenda-startup - :type 'hook) - -(defcustom org-agenda-mouse-1-follows-link nil - "Non-nil means, mouse-1 on a link will follow the link in the agenda. -A longer mouse click will still set point. Does not wortk on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow-mode in a newly created agenda window." - :group 'org-agenda-startup - :type 'boolean) - -(defgroup org-agenda-windows nil - "Options concerning the windows used by the Agenda in Org Mode." - :tag "Org Agenda Windows" - :group 'org-agenda) - -(defcustom org-agenda-window-setup 'reorganize-frame - "How the agenda buffer should be displayed. -Possible values for this option are: - -current-window Show agenda in the current window, keeping all other windows. -other-frame Use `switch-to-buffer-other-frame' to display agenda. -other-window Use `switch-to-buffer-other-window' to display agenda. -reorganize-frame Show only two windows on the current frame, the current - window and the agenda. -See also the variable `org-agenda-restore-windows-after-quit'." - :group 'org-agenda-windows - :type '(choice - (const current-window) - (const other-frame) - (const other-window) - (const reorganize-frame))) - -(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) - "The min and max height of the agenda window as a fraction of frame height. -The value of the variable is a cons cell with two numbers between 0 and 1. -It only matters if `org-agenda-window-setup' is `reorganize-frame'." - :group 'org-agenda-windows - :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) - -(defcustom org-agenda-restore-windows-after-quit nil - "Non-nil means, restore window configuration open exiting agenda. -Before the window configuration is changed for displaying the agenda, -the current status is recorded. When the agenda is exited with -`q' or `x' and this option is set, the old state is restored. If -`org-agenda-window-setup' is `other-frame', the value of this -option will be ignored.." - :group 'org-agenda-windows - :type 'boolean) - -(defcustom org-indirect-buffer-display 'other-window - "How should indirect tree buffers be displayed? -This applies to indirect buffers created with the commands -\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. -Valid values are: -current-window Display in the current window -other-window Just display in another window. -dedicated-frame Create one new frame, and re-use it each time. -new-frame Make a new frame each time. Note that in this case - previously-made indirect buffers are kept, and you need to - kill these buffers yourself." - :group 'org-structure - :group 'org-agenda-windows - :type '(choice - (const :tag "In current window" current-window) - (const :tag "In current frame, other window" other-window) - (const :tag "Each time a new frame" new-frame) - (const :tag "One dedicated frame" dedicated-frame))) - -(defgroup org-agenda-daily/weekly nil - "Options concerning the daily/weekly agenda." - :tag "Org Agenda Daily/Weekly" - :group 'org-agenda) - -(defcustom org-agenda-ndays 7 - "Number of days to include in overview display. -Should be 1 or 7." - :group 'org-agenda-daily/weekly - :type 'number) - -(defcustom org-agenda-start-on-weekday 1 - "Non-nil means, start the overview always on the specified weekday. -0 denotes Sunday, 1 denotes Monday etc. -When nil, always start on the current day." - :group 'org-agenda-daily/weekly - :type '(choice (const :tag "Today" nil) - (number :tag "Weekday No."))) - -(defcustom org-agenda-show-all-dates t - "Non-nil means, `org-agenda' shows every day in the selected range. -When nil, only the days which actually have entries are shown." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-format-date 'org-agenda-format-date-aligned - "Format string for displaying dates in the agenda. -Used by the daily/weekly agenda and by the timeline. This should be -a format string understood by `format-time-string', or a function returning -the formatted date as a string. The function must take a single argument, -a calendar-style date list like (month day year)." - :group 'org-agenda-daily/weekly - :type '(choice - (string :tag "Format string") - (function :tag "Function"))) - -(defun org-agenda-format-date-aligned (date) - "Format a date string for display in the daily/weekly agenda, or timeline. -This function makes sure that dates are aligned for easy reading." - (format "%-9s %2d %s %4d" - (calendar-day-name date) - (extract-calendar-day date) - (calendar-month-name (extract-calendar-month date)) - (extract-calendar-year date))) - -(defcustom org-agenda-include-diary nil - "If non-nil, include in the agenda entries from the Emacs Calendar's diary." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-include-all-todo nil - "Set means weekly/daily agenda will always contain all TODO entries. -The TODO entries will be listed at the top of the agenda, before -the entries for specific days." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-repeating-timestamp-show-all t - "Non-nil means, show all occurences of a repeating stamp in the agenda. -When nil, only one occurence is shown, either today or the -nearest into the future." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-deadline-warning-days 14 - "No. of days before expiration during which a deadline becomes active. -This variable governs the display in sparse trees and in the agenda. -When negative, it means use this number (the absolute value of it) -even if a deadline has a different individual lead time specified." - :group 'org-time - :group 'org-agenda-daily/weekly - :type 'number) - -(defcustom org-scheduled-past-days 10000 - "No. of days to continue listing scheduled items that are not marked DONE. -When an item is scheduled on a date, it shows up in the agenda on this -day and will be listed until it is marked done for the number of days -given here." - :group 'org-agenda-daily/weekly - :type 'number) - -(defgroup org-agenda-time-grid nil - "Options concerning the time grid in the Org-mode Agenda." - :tag "Org Agenda Time Grid" - :group 'org-agenda) - -(defcustom org-agenda-use-time-grid t - "Non-nil means, show a time grid in the agenda schedule. -A time grid is a set of lines for specific times (like every two hours between -8:00 and 20:00). The items scheduled for a day at specific times are -sorted in between these lines. -For details about when the grid will be shown, and what it will look like, see -the variable `org-agenda-time-grid'." - :group 'org-agenda-time-grid - :type 'boolean) - -(defcustom org-agenda-time-grid - '((daily today require-timed) - "----------------" - (800 1000 1200 1400 1600 1800 2000)) - - "The settings for time grid for agenda display. -This is a list of three items. The first item is again a list. It contains -symbols specifying conditions when the grid should be displayed: - - daily if the agenda shows a single day - weekly if the agenda shows an entire week - today show grid on current date, independent of daily/weekly display - require-timed show grid only if at least one item has a time specification - -The second item is a string which will be places behing the grid time. - -The third item is a list of integers, indicating the times that should have -a grid line." - :group 'org-agenda-time-grid - :type - '(list - (set :greedy t :tag "Grid Display Options" - (const :tag "Show grid in single day agenda display" daily) - (const :tag "Show grid in weekly agenda display" weekly) - (const :tag "Always show grid for today" today) - (const :tag "Show grid only if any timed entries are present" - require-timed) - (const :tag "Skip grid times already present in an entry" - remove-match)) - (string :tag "Grid String") - (repeat :tag "Grid Times" (integer :tag "Time")))) - -(defgroup org-agenda-sorting nil - "Options concerning sorting in the Org-mode Agenda." - :tag "Org Agenda Sorting" - :group 'org-agenda) - -(defconst org-sorting-choice - '(choice - (const time-up) (const time-down) - (const category-keep) (const category-up) (const category-down) - (const tag-down) (const tag-up) - (const priority-up) (const priority-down)) - "Sorting choices.") - -(defcustom org-agenda-sorting-strategy - '((agenda time-up category-keep priority-down) - (todo category-keep priority-down) - (tags category-keep priority-down)) - "Sorting structure for the agenda items of a single day. -This is a list of symbols which will be used in sequence to determine -if an entry should be listed before another entry. The following -symbols are recognized: - -time-up Put entries with time-of-day indications first, early first -time-down Put entries with time-of-day indications first, late first -category-keep Keep the default order of categories, corresponding to the - sequence in `org-agenda-files'. -category-up Sort alphabetically by category, A-Z. -category-down Sort alphabetically by category, Z-A. -tag-up Sort alphabetically by last tag, A-Z. -tag-down Sort alphabetically by last tag, Z-A. -priority-up Sort numerically by priority, high priority last. -priority-down Sort numerically by priority, high priority first. - -The different possibilities will be tried in sequence, and testing stops -if one comparison returns a \"not-equal\". For example, the default - '(time-up category-keep priority-down) -means: Pull out all entries having a specified time of day and sort them, -in order to make a time schedule for the current day the first thing in the -agenda listing for the day. Of the entries without a time indication, keep -the grouped in categories, don't sort the categories, but keep them in -the sequence given in `org-agenda-files'. Within each category sort by -priority. - -Leaving out `category-keep' would mean that items will be sorted across -categories by priority. - -Instead of a single list, this can also be a set of list for specific -contents, with a context symbol in the car of the list, any of -`agenda', `todo', `tags' for the corresponding agenda views." - :group 'org-agenda-sorting - :type `(choice - (repeat :tag "General" org-sorting-choice) - (list :tag "Individually" - (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for TODO lists" todo) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for Tags matches" tags) - (repeat ,org-sorting-choice))))) - -(defcustom org-sort-agenda-notime-is-late t - "Non-nil means, items without time are considered late. -This is only relevant for sorting. When t, items which have no explicit -time like 15:30 will be considered as 99:01, i.e. later than any items which -do have a time. When nil, the default time is before 0:00. You can use this -option to decide if the schedule for today should come before or after timeless -agenda entries." - :group 'org-agenda-sorting - :type 'boolean) - -(defgroup org-agenda-line-format nil - "Options concerning the entry prefix in the Org-mode agenda display." - :tag "Org Agenda Line Format" - :group 'org-agenda) - -(defcustom org-agenda-prefix-format - '((agenda . " %-12:c%?-12t% s") - (timeline . " % s") - (todo . " %-12:c") - (tags . " %-12:c")) - "Format specifications for the prefix of items in the agenda views. -An alist with four entries, for the different agenda types. The keys to the -sublists are `agenda', `timeline', `todo', and `tags'. The values -are format strings. -This format works similar to a printf format, with the following meaning: - - %c the category of the item, \"Diary\" for entries from the diary, or - as given by the CATEGORY keyword or derived from the file name. - %T the *last* tag of the item. Last because inherited tags come - first in the list. - %t the time-of-day specification if one applies to the entry, in the - format HH:MM - %s Scheduling/Deadline information, a short string - -All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: A question mark just after the `%' and -a whitespace/punctuation character just before the final letter. - -If the first character after `%' is a question mark, the entire field -will only be included if the corresponding value applies to the -current entry. This is useful for fields which should have fixed -width when present, but zero width when absent. For example, -\"%?-12t\" will result in a 12 character time field if a time of the -day is specified, but will completely disappear in entries which do -not contain a time. - -If there is punctuation or whitespace character just before the final -format letter, this character will be appended to the field value if -the value is not empty. For example, the format \"%-12:c\" leads to -\"Diary: \" if the category is \"Diary\". If the category were be -empty, no additional colon would be interted. - -The default value of this option is \" %-12:c%?-12t% s\", meaning: -- Indent the line with two space characters -- Give the category in a 12 chars wide field, padded with whitespace on - the right (because of `-'). Append a colon if there is a category - (because of `:'). -- If there is a time-of-day, put it into a 12 chars wide field. If no - time, don't put in an empty field, just skip it (because of '?'). -- Finally, put the scheduling information and append a whitespace. - -As another example, if you don't want the time-of-day of entries in -the prefix, you could use: - - (setq org-agenda-prefix-format \" %-11:c% s\") - -See also the variables `org-agenda-remove-times-when-in-prefix' and -`org-agenda-remove-tags'." - :type '(choice - (string :tag "General format") - (list :greedy t :tag "View dependent" - (cons (const agenda) (string :tag "Format")) - (cons (const timeline) (string :tag "Format")) - (cons (const todo) (string :tag "Format")) - (cons (const tags) (string :tag "Format")))) - :group 'org-agenda-line-format) - -(defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") - -(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceeding scheduled items in the agenda view. -THis is a list with two strings. The first applies when the item is -scheduled on the current day. The second applies when it has been scheduled -previously, it may contain a %d to capture how many days ago the item was -scheduled." - :group 'org-agenda-line-format - :type '(list - (string :tag "Scheduled today ") - (string :tag "Scheduled previously"))) - -(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") - "Text preceeding deadline items in the agenda view. -This is a list with two strings. The first applies when the item has its -deadline on the current day. The second applies when it is in the past or -in the future, it may contain %d to capture how many days away the deadline -is (was)." - :group 'org-agenda-line-format - :type '(list - (string :tag "Deadline today ") - (string :tag "Deadline relative"))) - -(defcustom org-agenda-remove-times-when-in-prefix t - "Non-nil means, remove duplicate time specifications in agenda items. -When the format `org-agenda-prefix-format' contains a `%t' specifier, a -time-of-day specification in a headline or diary entry is extracted and -placed into the prefix. If this option is non-nil, the original specification -\(a timestamp or -range, or just a plain time(range) specification like -11:30-4pm) will be removed for agenda display. This makes the agenda less -cluttered. -The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed what it is located at the beginning of -the headline/diary entry." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When at beginning of entry" beg))) - - -(defcustom org-agenda-default-appointment-duration nil - "Default duration for appointments that only have a starting time. -When nil, no duration is specified in such cases. -When non-nil, this must be the number of minutes, e.g. 60 for one hour." - :group 'org-agenda-line-format - :type '(choice - (integer :tag "Minutes") - (const :tag "No default duration"))) - - -(defcustom org-agenda-remove-tags nil - "Non-nil means, remove the tags from the headline copy in the agenda. -When this is the symbol `prefix', only remove tags when -`org-agenda-prefix-format' contains a `%T' specifier." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When prefix format contains %T" prefix))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-remove-tags-when-in-prefix - 'org-agenda-remove-tags)) - -(defcustom org-agenda-tags-column -80 - "Shift tags in agenda items to this column. -If this number is positive, it specifies the column. If it is negative, -it means that the tags should be flushright to that column. For example, --80 works well for a normal 80 character screen." - :group 'org-agenda-line-format - :type 'integer) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) - -(defcustom org-agenda-fontify-priorities t - "Non-nil means, highlight low and high priorities in agenda. -When t, the highest priority entries are bold, lowest priority italic. -This may also be an association list of priority faces. The face may be -a names face, or a list like `(:background \"Red\")'." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Never" nil) - (const :tag "Defaults" t) - (repeat :tag "Specify" - (list (character :tag "Priority" :value ?A) - (sexp :tag "face"))))) - -(defgroup org-latex nil - "Options for embedding LaTeX code into Org-mode" - :tag "Org LaTeX" - :group 'org) - -(defcustom org-format-latex-options - '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 - :matchers ("begin" "$" "$$" "\\(" "\\[")) - "Options for creating images from LaTeX fragments. -This is a property list with the following properties: -:foreground the foreground color for images embedded in emacs, e.g. \"Black\". - `default' means use the forground of the default face. -:background the background color, or \"Transparent\". - `default' means use the background of the default face. -:scale a scaling factor for the size of the images -:html-foreground, :html-background, :html-scale - The same numbers for HTML export. -:matchers a list indicating which matchers should be used to - find LaTeX fragments. Valid members of this list are: - \"begin\" find environments - \"$\" find math expressions surrounded by $...$ - \"$$\" find math expressions surrounded by $$....$$ - \"\\(\" find math expressions surrounded by \\(...\\) - \"\\ [\" find math expressions surrounded by \\ [...\\]" - :group 'org-latex - :type 'plist) - -(defcustom org-format-latex-header "\\documentclass{article} -\\usepackage{fullpage} % do not remove -\\usepackage{amssymb} -\\usepackage[usenames]{color} -\\usepackage{amsmath} -\\usepackage{latexsym} -\\usepackage[mathscr]{eucal} -\\pagestyle{empty} % do not remove" - "The document header used for processing LaTeX fragments." - :group 'org-latex - :type 'string) - -(defgroup org-export nil - "Options for exporting org-listings." - :tag "Org Export" - :group 'org) - -(defgroup org-export-general nil - "General options for exporting Org-mode files." - :tag "Org Export General" - :group 'org-export) - -;; FIXME -(defvar org-export-publishing-directory nil) - -(defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - - Org HTML LaTeX - -----+----------+-------- - \\- ­ \\- - -- – -- - --- — --- - ... … \ldots - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-language-setup - '(("en" "Author" "Date" "Table of Contents") - ("cs" "Autor" "Datum" "Obsah") - ("da" "Ophavsmand" "Dato" "Indhold") - ("de" "Autor" "Datum" "Inhaltsverzeichnis") - ("es" "Autor" "Fecha" "\xcdndice") - ("fr" "Auteur" "Date" "Table des mati\xe8res") - ("it" "Autore" "Data" "Indice") - ("nl" "Auteur" "Datum" "Inhoudsopgave") - ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) - ("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll")) - "Terms used in export text, translated to different languages. -Use the variable `org-export-default-language' to set the language, -or use the +OPTION lines for a per-file setting." - :group 'org-export-general - :type '(repeat - (list - (string :tag "HTML language tag") - (string :tag "Author") - (string :tag "Date") - (string :tag "Table of Contents")))) - -(defcustom org-export-default-language "en" - "The default language of HTML export, as a string. -This should have an association in `org-export-language-setup'." - :group 'org-export-general - :type 'string) - -(defcustom org-export-skip-text-before-1st-heading t - "Non-nil means, skip all text before the first headline when exporting. -When nil, that text is exported as well." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-headline-levels 3 - "The last level which is still exported as a headline. -Inferior levels will produce itemize lists when exported. -Note that a numeric prefix argument to an exporter function overrides -this setting. - -This option can also be set with the +OPTIONS line, e.g. \"H:2\"." - :group 'org-export-general - :type 'number) - -(defcustom org-export-with-section-numbers t - "Non-nil means, add section numbers to headlines when exporting. - -This option can also be set with the +OPTIONS line, e.g. \"num:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-toc t - "Non-nil means, create a table of contents in exported files. -The TOC contains headlines with levels up to`org-export-headline-levels'. -When an integer, include levels up to N in the toc, this may then be -different from `org-export-headline-levels', but it will not be allowed -to be larger than the number of headline levels. -When nil, no table of contents is made. - -Headlines which contain any TODO items will be marked with \"(*)\" in -ASCII export, and with red color in HTML output, if the option -`org-export-mark-todo-in-toc' is set. - -In HTML output, the TOC will be clickable. - -This option can also be set with the +OPTIONS line, e.g. \"toc:nil\" -or \"toc:3\"." - :group 'org-export-general - :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) - -(defcustom org-export-mark-todo-in-toc nil - "Non-nil means, mark TOC lines that contain any open TODO items." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-preserve-breaks nil - "Non-nil means, preserve all line breaks when exporting. -Normally, in HTML output paragraphs will be reformatted. In ASCII -export, line breaks will always be preserved, regardless of this variable. - -This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-archived-trees 'headline - "Whether subtrees with the ARCHIVE tag should be exported. -This can have three different values -nil Do not export, pretend this tree is not present -t Do export the entire tree -headline Only export the headline, but skip the tree below it." - :group 'org-export-general - :group 'org-archive - :type '(choice - (const :tag "not at all" nil) - (const :tag "headline only" 'headline) - (const :tag "entirely" t))) - -(defcustom org-export-author-info t - "Non-nil means, insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"author-info:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-time-stamp-file t - "Non-nil means, insert a time stamp into the exported file. -The time stamp shows when the file was created. - -This option can also be set with the +OPTIONS line, -e.g. \"timestamp:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-timestamps t - "If nil, do not export time stamps and associated keywords." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-remove-timestamps-from-toc t - "If nil, remove timestamps from the table of contents entries." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tags 'not-in-toc - "If nil, do not export tags, just remove them from headlines. -If this is the symbol `not-in-toc', tags will be removed from table of -contents entries, but still be shown in the headlines of the document. - -This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) - -(defcustom org-export-with-drawers nil - "Non-nil means, export with drawers like the property drawer. -When t, all drawers are exported. This may also be a list of -drawer names to export." - :group 'org-export-general - :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) - -(defgroup org-export-translation nil - "Options for translating special ascii sequences for the export backends." - :tag "Org Export Translation" - :group 'org-export) - -(defcustom org-export-with-emphasize t - "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text. -If the export target supports emphasizing text, the word will be -typeset in bold, italic, or underlined, respectively. Works only for -single words, but you can say: I *really* *mean* *this*. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-footnotes t - "If nil, export [1] as a footnote marker. -Lines starting with [1] will be formatted as footnotes. - -This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-sub-superscripts t - "Non-nil means, interpret \"_\" and \"^\" for export. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. If you set this variable to the symbol `{}', -the braces are *required* in order to trigger interpretations as -sub/superscript. This can be helpful in documents that need \"_\" -frequently in plain text. - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." - :group 'org-export-translation - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - -(defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - -\\- : ­ --- : – ---- : — - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-TeX-macros t - "Non-nil means, interpret simple TeX-like macros when exporting. -For example, HTML export converts \\alpha to α and \\AA to Å. -No only real TeX macros will work here, but the standard HTML entities -for math can be used as macro names as well. For a list of supported -names in HTML export, see the constant `org-html-entities'. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-LaTeX-fragments nil - "Non-nil means, convert LaTeX fragments to images when exporting to HTML. -When set, the exporter will find LaTeX environments if the \\begin line is -the first non-white thing on a line. It will also find the math delimiters -like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for -display math. - -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-fixed-width t - "Non-nil means, lines starting with \":\" will be in fixed width font. -This can be used to have pre-formatted text, fragments of code etc. For -example: - : ;; Some Lisp examples - : (while (defc cnt) - : (ding)) -will be looking just like this in also HTML. See also the QUOTE keyword. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"::nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation - :type 'integer) - -(defgroup org-export-tables nil - "Options for exporting tables in Org-mode." - :tag "Org Export Tables" - :group 'org-export) - -(defcustom org-export-with-tables t - "If non-nil, lines starting with \"|\" define a table. -For example: - - | Name | Address | Birthday | - |-------------+----------+-----------| - | Arthur Dent | England | 29.2.2100 | - -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-highlight-first-table-line t - "Non-nil means, highlight the first table line. -In HTML export, this means use instead of . -In tables created with table.el, this applies to the first table line. -In Org-mode tables, all lines before the first horizontal separator -line will be formatted with tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-special-lines t - "Remove special lines and marking characters in calculating tables. -This removes the special marking character column from tables that are set -up for spreadsheet calculations. It also removes the entire lines -marked with `!', `_', or `^'. The lines with `$' are kept, because -the values of constants may be useful to have." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-prefer-native-exporter-for-tables nil - "Non-nil means, always export tables created with table.el natively. -Natively means, use the HTML code generator in table.el. -When nil, Org-mode's own HTML generator is used when possible (i.e. if -the table does not use row- or column-spanning). This has the -advantage, that the automatic HTML conversions for math symbols and -sub/superscripts can be applied. Org-mode's HTML generator is also -much faster." - :group 'org-export-tables - :type 'boolean) - -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) - -(defgroup org-export-xml nil - "Options specific for XML export of Org-mode files." - :tag "Org Export XML" - :group 'org-export) - -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-coding-system nil - "" - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-style -"" - "The default style specification for exported HTML files. -Since there are different ways of setting style information, this variable -needs to contain the full HTML structure to provide a style, including the -surrounding HTML tags. The style specifications should include definitions -for new classes todo, done, title, and deadline. For example, legal values -would be: - - - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to add arbitrary text to the header." - :group 'org-export-html - :type 'string) - - -(defcustom org-export-html-title-format "

%s

\n" - "Format for typesetting the document title in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The level for level 1 headings in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means, make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "Non-nil means, inline images into exported HTML pages. -This is done using an tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -;; FIXME: rename -(defcustom org-export-html-expand t - "Non-nil means, for HTML export, treat @<...> as HTML tag. -When nil, these tags will be exported as plain text and therefore -not be interpreted by a browser. - -This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-table-tag - "" - "The HTML tag that is used to start a table. -This must be a
tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-html-with-timestamp nil - "If non-nil, write `org-export-html-html-helper-timestamp' -into the exported HTML text. Otherwise, the buffer will just be saved -to a file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-html-helper-timestamp - "

\n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode." - :group 'org-export-html - :type 'string) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-include-todo nil - "Non-nil means, export to iCalendar files should also cover TODO items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "All" all))) - -(defcustom org-icalendar-include-sexps t - "Non-nil means, export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defgroup org-font-lock nil - "Font-lock settings for highlighting in Org-mode." - :tag "Org Font Lock" - :group 'org) - -(defcustom org-level-color-stars-only nil - "Non-nil means fontify only the stars in each headline. -When nil, the entire headline is fontified. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-hide-leading-stars nil - "Non-nil means, hide the first N-1 stars in a headline. -This works by using the face `org-hide' for these stars. This -face is white for a light background, and black for a dark -background. You may have to customize the face `org-hide' to -make this work. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: hidestars - #+STARTUP: showstars" - :group 'org-font-lock - :type 'boolean) - -(defcustom org-fontify-done-headline nil - "Non-nil means, change the face of a headline if it is marked DONE. -Normally, only the TODO/DONE keyword indicates the state of a headline. -When this is non-nil, the headline after the keyword is set to the -`org-headline-done' as an additional indication." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-fontify-emphasized-text t - "Non-nil means fontify *bold*, /italic/ and _underlined_ text. -Changing this variable requires a restart of Emacs to take effect." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-highlight-latex-fragments-and-specials nil - "Non-nil means, fontify what is treated specially by the exporters." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-hide-emphasis-markers nil - "Non-nil mean font-lock should hide the emphasis marker characters." - :group 'org-font-lock - :type 'boolean) - -(defvar org-emph-re nil - "Regular expression for matching emphasis.") -(defvar org-verbatim-re nil - "Regular expression for matching verbatim text.") -(defvar org-emphasis-regexp-components) ; defined just below -(defvar org-emphasis-alist) ; defined just below -(defun org-set-emph-re (var val) - "Set variable and compute the emphasis regular expression." - (set var val) - (when (and (boundp 'org-emphasis-alist) - (boundp 'org-emphasis-regexp-components) - org-emphasis-alist org-emphasis-regexp-components) - (let* ((e org-emphasis-regexp-components) - (pre (car e)) - (post (nth 1 e)) - (border (nth 2 e)) - (body (nth 3 e)) - (nl (nth 4 e)) - (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil - (body1 (concat body "*?")) - (markers (mapconcat 'car org-emphasis-alist "")) - (vmarkers (mapconcat - (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) - org-emphasis-alist ""))) - ;; make sure special characters appear at the right position in the class - (if (string-match "\\^" markers) - (setq markers (concat (replace-match "" t t markers) "^"))) - (if (string-match "-" markers) - (setq markers (concat (replace-match "" t t markers) "-"))) - (if (string-match "\\^" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) - (if (string-match "-" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) - (if (> nl 0) - (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," - (int-to-string nl) "\\}"))) - ;; Make the regexp - (setq org-emph-re - (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)" - "\\(" - "\\([" markers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border (if (and nil stacked) markers) "]" - body1 - "[^" border (if (and nil stacked) markers) "]" - "\\)" - "\\3\\)" - "\\([" post (if (and nil stacked) markers) "]\\|$\\)")) - (setq org-verbatim-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" vmarkers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)"))))) - -(defcustom org-emphasis-regexp-components - '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) - "Components used to build the regular expression for emphasis. -This is a list with 6 entries. Terminology: In an emphasis string -like \" *strong word* \", we call the initial space PREMATCH, the final -space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters -and \"trong wor\" is the body. The different components in this variable -specify what is allowed/forbidden in each part: - -pre Chars allowed as prematch. Beginning of line will be allowed too. -post Chars allowed as postmatch. End of line will be allowed too. -border The chars *forbidden* as border characters. -body-regexp A regexp like \".\" to match a body character. Don't use - non-shy groups here, and don't allow newline here. -newline The maximum number of newlines allowed in an emphasis exp. - -Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock - :set 'org-set-emph-re - :type '(list - (sexp :tag "Allowed chars in pre ") - (sexp :tag "Allowed chars in post ") - (sexp :tag "Forbidden chars in border ") - (sexp :tag "Regexp for body ") - (integer :tag "number of newlines allowed") - (option (boolean :tag "Stacking (DISABLED) ")))) - -(defcustom org-emphasis-alist - '(("*" bold "" "") - ("/" italic "" "") - ("_" underline "" "") - ("=" org-code "" "" verbatim) - ("~" org-verbatim "" "" verbatim) - ("+" (:strike-through t) "" "") - ) - "Special syntax for emphasized text. -Text starting and ending with a special character will be emphasized, for -example *bold*, _underlined_ and /italic/. This variable sets the marker -characters, the face to be used by font-lock for highlighting in Org-mode -Emacs buffers, and the HTML tags to be used for this. -Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock - :set 'org-set-emph-re - :type '(repeat - (list - (string :tag "Marker character") - (choice - (face :tag "Font-lock-face") - (plist :tag "Face property list")) - (string :tag "HTML start tag") - (string :tag "HTML end tag") - (option (const verbatim))))) - -;;; The faces - -(defgroup org-faces nil - "Faces in Org-mode." - :tag "Org Faces" - :group 'org-font-lock) - -(defun org-compatible-face (inherits specs) - "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If not, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) (> emacs-major-version 22)) - ;; In Emacs 23, we use inheritance where possible. - ;; We only do this in Emacs 23, because only there the outline - ;; faces have been changed to the original org-mode-level-faces. - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) - -(defface org-hide - '((((background light)) (:foreground "white")) - (((background dark)) (:foreground "black"))) - "Face used to hide leading stars in headlines. -The forground color of this face should be equal to the background -color of the frame." - :group 'org-faces) - -(defface org-level-1 ;; font-lock-function-name-face - (org-compatible-face 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for level 1 headlines." - :group 'org-faces) - -(defface org-level-2 ;; font-lock-variable-name-face - (org-compatible-face 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) - "Face used for level 2 headlines." - :group 'org-faces) - -(defface org-level-3 ;; font-lock-keyword-face - (org-compatible-face 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) - "Face used for level 3 headlines." - :group 'org-faces) - -(defface org-level-4 ;; font-lock-comment-face - (org-compatible-face 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face used for level 4 headlines." - :group 'org-faces) - -(defface org-level-5 ;; font-lock-type-face - (org-compatible-face 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 5 headlines." - :group 'org-faces) - -(defface org-level-6 ;; font-lock-constant-face - (org-compatible-face 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) - "Face used for level 6 headlines." - :group 'org-faces) - -(defface org-level-7 ;; font-lock-builtin-face - (org-compatible-face 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) - "Face used for level 7 headlines." - :group 'org-faces) - -(defface org-level-8 ;; font-lock-string-face - (org-compatible-face 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 8 headlines." - :group 'org-faces) - -(defface org-special-keyword ;; font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) - "Face used for special keywords." - :group 'org-faces) - -(defface org-drawer ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for drawers." - :group 'org-faces) - -(defface org-property-value nil - "Face used for the value of a property." - :group 'org-faces) - -(defface org-column - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90")) - (((class color) (min-colors 16) (background dark)) - (:background "grey30")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for column display of entry properties." - :group 'org-faces) - -(when (fboundp 'set-face-attribute) - ;; Make sure that a fixed-width face is used when we have a column table. - (set-face-attribute 'org-column nil - :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - -(defface org-warning - (org-compatible-face 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for deadlines and TODO keywords." - :group 'org-faces) - -(defface org-archived ; similar to shadow - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for headline with the ARCHIVE tag." - :group 'org-faces) - -(defface org-link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-ellipsis - '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) - (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) - (t (:strike-through t))) - "Face for the ellipsis in folded text." - :group 'org-faces) - -(defface org-target - '((((class color) (background light)) (:underline t)) - (((class color) (background dark)) (:underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-date - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-sexp-date - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-tag - '((t (:bold t))) - "Face for tags." - :group 'org-faces) - -(defface org-todo ; font-lock-warning-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) - "Face for TODO keywords." - :group 'org-faces) - -(defface org-done ;; font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) - "Face used for todo keywords that indicate DONE items." - :group 'org-faces) - -(defface org-headline-done ;; font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) - "Face used to indicate that a headline is DONE. -This face is only used if `org-fontify-done-headline' is set. If applies -to the part of the headline after the DONE keyword." - :group 'org-faces) - -(defcustom org-todo-keyword-faces nil - "Faces for specific TODO keywords. -This is a list of cons cells, with TODO keywords in the car -and faces in the cdr. The face can be a symbol, or a property -list of attributes, like (:foreground \"blue\" :weight bold :underline t)." - :group 'org-faces - :group 'org-todo - :type '(repeat - (cons - (string :tag "keyword") - (sexp :tag "face")))) - -(defface org-table ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) - "Face used for tables." - :group 'org-faces) - -(defface org-formula - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) - "Face for formulas." - :group 'org-faces) - -(defface org-code - (org-compatible-face nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-verbatim - (org-compatible-face nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50" :underline t)) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70" :underline t)) - (((class color) (min-colors 8) (background light)) - (:foreground "green" :underline t)) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow" :underline t)))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-agenda-structure ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used in agenda for captions and dates." - :group 'org-faces) - -(defface org-scheduled-today - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) - "Face for items scheduled for a certain day." - :group 'org-faces) - -(defface org-scheduled-previously - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defface org-upcoming-deadline - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defcustom org-agenda-deadline-faces - '((1.0 . org-warning) - (0.5 . org-upcoming-deadline) - (0.0 . default)) - "Faces for showing deadlines in the agenda. -This is a list of cons cells. The cdr of each cess is a face to be used, -and it can also just be a like like '(:foreground \"yellow\"). -Each car is a fraction of the head-warning time that must have passed for -this the face in the cdr to be used for display. The numbers must be -given in descending order. The head-warning time is normally taken -from `org-deadline-warning-days', but can also be specified in the deadline -timestamp itself, like this: - - DEADLINE: <2007-08-13 Mon -8d> - -You may use d for days, w for weeks, m for months and y for years. Months -and years will only be treated in an approximate fashion (30.4 days for a -month and 365.24 days for a year)." - :group 'org-faces - :group 'org-agenda-daily/weekly - :type '(repeat - (cons - (number :tag "Fraction of head-warning time passed") - (sexp :tag "Face")))) - -;; FIXME: this is not a good face yet. -(defface org-agenda-restriction-lock - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 16) (background light)) (:background "yellow1")) - (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for showing the agenda restriction lock." - :group 'org-faces) - -(defface org-time-grid ;; font-lock-variable-name-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) - "Face used for time grids." - :group 'org-faces) - -(defconst org-level-faces - '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) - -(defcustom org-n-level-faces (length org-level-faces) - "The number different faces to be used for headlines. -Org-mode defines 8 different headline faces, so this can be at most 8. -If it is less than 8, the level-1 face gets re-used for level N+1 etc." - :type 'number - :group 'org-faces) - -;;; Functions and variables from ther packages -;; Declared here to avoid compiler warnings - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions - -;; Emacs only -(defvar mark-active) - -;; Various packages -;; FIXME: get the argument lists for the UNKNOWN stuff -(declare-function add-to-diary-list "diary-lib" - (date string specifier &optional marker globcolor literal)) -(declare-function table--at-cell-p "table" (position &optional object at-column)) -(declare-function Info-find-node "info" (filename nodename &optional no-going-back)) -(declare-function Info-goto-node "info" (nodename &optional fork)) -(declare-function bbdb "ext:bbdb-com" (string elidep)) -(declare-function bbdb-company "ext:bbdb-com" (string elidep)) -(declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying)) -(declare-function bbdb-name "ext:bbdb-com" (string elidep)) -(declare-function bbdb-record-getprop "ext:bbdb" (record property)) -(declare-function bbdb-record-name "ext:bbdb" (record)) -(declare-function bibtex-beginning-of-entry "bibtex" ()) -(declare-function bibtex-generate-autokey "bibtex" ()) -(declare-function bibtex-parse-entry "bibtex" (&optional content)) -(declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(declare-function calendar-astro-date-string "cal-julian" (&optional date)) -(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) -(declare-function calendar-check-holidays "holidays" (date)) -(declare-function calendar-chinese-date-string "cal-china" (&optional date)) -(declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-forward-day "cal-move" (arg)) -(declare-function calendar-french-date-string "cal-french" (&optional date)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-goto-today "cal-move" ()) -(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) -(declare-function calendar-islamic-date-string "cal-islam" (&optional date)) -(declare-function calendar-iso-date-string "cal-iso" (&optional date)) -(declare-function calendar-julian-date-string "cal-julian" (&optional date)) -(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) -(declare-function calendar-persian-date-string "cal-persia" (&optional date)) -(defvar calendar-mode-map) -(defvar original-date) ; dynamically scoped in calendar.el does scope this -(declare-function cdlatex-tab "ext:cdlatex" ()) -(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) -(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) -(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) -(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t) -(defvar font-lock-unfontify-region-function) -(declare-function gnus-article-show-summary "gnus-art" ()) -(declare-function gnus-summary-last-subject "gnus-sum" ()) -(defvar gnus-other-frame-object) -(defvar gnus-group-name) -(defvar gnus-article-current) -(defvar Info-current-file) -(defvar Info-current-node) -(declare-function mh-display-msg "mh-show" (msg-num folder-name)) -(declare-function mh-find-path "mh-utils" ()) -(declare-function mh-get-header-field "mh-utils" (field)) -(declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) -(declare-function mh-header-display "mh-show" ()) -(declare-function mh-index-previous-folder "mh-search" ()) -(declare-function mh-normalize-folder-name "mh-utils" (folder &optional empty-string-okay dont-remove-trailing-slash return-nil-if-folder-empty)) -(declare-function mh-search "mh-search" (folder search-regexp &optional redo-search-flag window-config)) -(declare-function mh-search-choose "mh-search" (&optional searcher)) -(declare-function mh-show "mh-show" (&optional message redisplay-flag)) -(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) -(declare-function mh-show-header-display "mh-show" t t) -(declare-function mh-show-msg "mh-show" (msg)) -(declare-function mh-show-show "mh-show" t t) -(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) -(defvar mh-progs) -(defvar mh-current-folder) -(defvar mh-show-folder-buffer) -(defvar mh-index-folder) -(defvar mh-searcher) -(declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) -(declare-function parse-time-string "parse-time" (string)) -(declare-function remember "remember" (&optional initial)) -(declare-function remember-buffer-desc "remember" ()) -(defvar remember-save-after-remembering) -(defvar remember-data-file) -(defvar remember-register) -(defvar remember-buffer) -(declare-function rmail-narrow-to-non-pruned-header "rmail" ()) -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-what-message "rmail" ()) -(defvar texmathp-why) -(declare-function vm-beginning-of-message "ext:vm-page" ()) -(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) -(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) -(declare-function vm-isearch-narrow "ext:vm-search" ()) -(declare-function vm-isearch-update "ext:vm-search" ()) -(declare-function vm-select-folder-buffer "ext:vm-macro" ()) -(declare-function vm-su-message-id "ext:vm-summary" (m)) -(declare-function vm-su-subject "ext:vm-summary" (m)) -(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) -(defvar vm-message-pointer) -(defvar vm-folder-directory) -(defvar w3m-current-url) -(defvar w3m-current-title) -(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t) -(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) -(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) -(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) -(declare-function wl-summary-line-from "ext:wl-summary" ()) -(declare-function wl-summary-line-subject "ext:wl-summary" ()) -(declare-function wl-summary-message-number "ext:wl-summary" ()) -(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(declare-function speedbar-line-directory "speedbar" (&optional depth)) - -(defvar org-latex-regexps) -(defvar constants-unit-system) - -;;; Variables for pre-computed regular expressions, all buffer local - -(defvar org-drawer-regexp nil - "Matches first line of a hidden block.") -(make-variable-buffer-local 'org-drawer-regexp) -(defvar org-todo-regexp nil - "Matches any of the TODO state keywords.") -(make-variable-buffer-local 'org-todo-regexp) -(defvar org-not-done-regexp nil - "Matches any of the TODO state keywords except the last one.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-todo-line-regexp nil - "Matches a headline and puts TODO state into group 2 if present.") -(make-variable-buffer-local 'org-todo-line-regexp) -(defvar org-complex-heading-regexp nil - "Matches a headline and puts everything into groups: -group 1: the stars -group 2: The todo keyword, maybe -group 3: Priority cookie -group 4: True headline -group 5: Tags") -(make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-todo-line-tags-regexp nil - "Matches a headline and puts TODO state into group 2 if present. -Also put tags into group 4 if tags are present.") -(make-variable-buffer-local 'org-todo-line-tags-regexp) -(defvar org-nl-done-regexp nil - "Matches newline followed by a headline with the DONE keyword.") -(make-variable-buffer-local 'org-nl-done-regexp) -(defvar org-looking-at-done-regexp nil - "Matches the DONE keyword a point.") -(make-variable-buffer-local 'org-looking-at-done-regexp) -(defvar org-ds-keyword-length 12 - "Maximum length of the Deadline and SCHEDULED keywords.") -(make-variable-buffer-local 'org-ds-keyword-length) -(defvar org-deadline-regexp nil - "Matches the DEADLINE keyword.") -(make-variable-buffer-local 'org-deadline-regexp) -(defvar org-deadline-time-regexp nil - "Matches the DEADLINE keyword together with a time stamp.") -(make-variable-buffer-local 'org-deadline-time-regexp) -(defvar org-deadline-line-regexp nil - "Matches the DEADLINE keyword and the rest of the line.") -(make-variable-buffer-local 'org-deadline-line-regexp) -(defvar org-scheduled-regexp nil - "Matches the SCHEDULED keyword.") -(make-variable-buffer-local 'org-scheduled-regexp) -(defvar org-scheduled-time-regexp nil - "Matches the SCHEDULED keyword together with a time stamp.") -(make-variable-buffer-local 'org-scheduled-time-regexp) -(defvar org-closed-time-regexp nil - "Matches the CLOSED keyword together with a time stamp.") -(make-variable-buffer-local 'org-closed-time-regexp) - -(defvar org-keyword-time-regexp nil - "Matches any of the 4 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-regexp) -(defvar org-keyword-time-not-clock-regexp nil - "Matches any of the 3 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-not-clock-regexp) -(defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceeded by a keyword.") -(make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-planning-or-clock-line-re nil - "Matches a line with planning or clock info.") -(make-variable-buffer-local 'org-planning-or-clock-line-re) - -(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t) - "Properties to remove when a string without properties is wanted.") - -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (match-string-no-properties num string))) - -(defsubst org-no-properties (s) - (if (fboundp 'set-text-properties) - (set-text-properties 0 (length s) nil s) - (remove-text-properties 0 (length s) org-rm-props s)) - s) - -(defsubst org-get-alist-option (option key) - (cond ((eq key t) t) - ((eq option t) t) - ((assoc key option) (cdr (assoc key option))) - (t (cdr (assq 'default option))))) - -(defsubst org-inhibit-invisibility () - "Modified `buffer-invisibility-spec' for Emacs 21. -Some ops with invisible text do not work correctly on Emacs 21. For these -we turn off invisibility temporarily. Use this in a `let' form." - (if (< emacs-major-version 22) nil buffer-invisibility-spec)) - -(defsubst org-set-local (var value) - "Make VAR local in current buffer and set it to VALUE." - (set (make-variable-buffer-local var) value)) - -(defsubst org-mode-p () - "Check if the current buffer is in Org-mode." - (eq major-mode 'org-mode)) - -(defsubst org-last (list) - "Return the last element of LIST." - (car (last list))) - -(defun org-let (list &rest body) - (eval (cons 'let (cons list body)))) -(put 'org-let 'lisp-indent-function 1) - -(defun org-let2 (list1 list2 &rest body) - (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) -(put 'org-let2 'lisp-indent-function 2) -(defconst org-startup-options - '(("fold" org-startup-folded t) - ("overview" org-startup-folded t) - ("nofold" org-startup-folded nil) - ("showall" org-startup-folded nil) - ("content" org-startup-folded content) - ("hidestars" org-hide-leading-stars t) - ("showstars" org-hide-leading-stars nil) - ("odd" org-odd-levels-only t) - ("oddeven" org-odd-levels-only nil) - ("align" org-startup-align-all-tables t) - ("noalign" org-startup-align-all-tables nil) - ("customtime" org-display-custom-times t) - ("logging" org-log-done t) - ("logdone" org-log-done t) - ("nologging" org-log-done nil) - ("lognotedone" org-log-done done push) - ("lognotestate" org-log-done state push) - ("lognoteclock-out" org-log-done clock-out push) - ("logrepeat" org-log-repeat t) - ("nologrepeat" org-log-repeat nil) - ("constcgs" constants-unit-system cgs) - ("constSI" constants-unit-system SI)) - "Variable associated with STARTUP options for org-mode. -Each element is a list of three items: The startup options as written -in the #+STARTUP line, the corresponding variable, and the value to -set this variable to if the option is found. An optional forth element PUSH -means to push this value onto the list in the variable.") - -(defun org-set-regexps-and-options () - "Precompute regular expressions for current buffer." - (when (org-mode-p) - (org-set-local 'org-todo-kwd-alist nil) - (org-set-local 'org-todo-key-alist nil) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) - (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" - "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS"))) - (splitre "[ \t]+") - kwds kws0 kwsa key value cat arch tags const links hw dws - tail sep kws1 prio props drawers - ex log) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq key (match-string 1) value (org-match-string-no-properties 2)) - (cond - ((equal key "CATEGORY") - (if (string-match "[ \t]+$" value) - (setq value (replace-match "" t t value))) - (setq cat value)) - ((member key '("SEQ_TODO" "TODO")) - (push (cons 'sequence (org-split-string value splitre)) kwds)) - ((equal key "TYP_TODO") - (push (cons 'type (org-split-string value splitre)) kwds)) - ((equal key "TAGS") - (setq tags (append tags (org-split-string value splitre)))) - ((equal key "COLUMNS") - (org-set-local 'org-columns-default-format value)) - ((equal key "LINK") - (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) - (push (cons (match-string 1 value) - (org-trim (match-string 2 value))) - links))) - ((equal key "PRIORITIES") - (setq prio (org-split-string value " +"))) - ((equal key "PROPERTY") - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (push (cons (match-string 1 value) (match-string 2 value)) - props))) - ((equal key "DRAWERS") - (setq drawers (org-split-string value splitre))) - ((equal key "CONSTANTS") - (setq const (append const (org-split-string value splitre)))) - ((equal key "STARTUP") - (let ((opts (org-split-string value splitre)) - l var val) - (while (setq l (pop opts)) - (when (setq l (assoc l org-startup-options)) - (setq var (nth 1 l) val (nth 2 l)) - (if (not (nth 3 l)) - (set (make-local-variable var) val) - (if (not (listp (symbol-value var))) - (set (make-local-variable var) nil)) - (set (make-local-variable var) (symbol-value var)) - (add-to-list var val)))))) - ((equal key "ARCHIVE") - (string-match " *$" value) - (setq arch (replace-match "" t t value)) - (remove-text-properties 0 (length arch) - '(face t fontified t) arch))) - ))) - (when cat - (org-set-local 'org-category (intern cat)) - (push (cons "CATEGORY" cat) props)) - (when prio - (if (< (length prio) 3) (setq prio '("A" "C" "B"))) - (setq prio (mapcar 'string-to-char prio)) - (org-set-local 'org-highest-priority (nth 0 prio)) - (org-set-local 'org-lowest-priority (nth 1 prio)) - (org-set-local 'org-default-priority (nth 2 prio))) - (and props (org-set-local 'org-local-properties (nreverse props))) - (and drawers (org-set-local 'org-drawers drawers)) - (and arch (org-set-local 'org-archive-location arch)) - (and links (setq org-link-abbrev-alist-local (nreverse links))) - ;; Process the TODO keywords - (unless kwds - ;; Use the global values as if they had been given locally. - (setq kwds (default-value 'org-todo-keywords)) - (if (stringp (car kwds)) - (setq kwds (list (cons org-todo-interpretation - (default-value 'org-todo-keywords))))) - (setq kwds (reverse kwds))) - (setq kwds (nreverse kwds)) - (let (inter kws kw) - (while (setq kws (pop kwds)) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - (if (string-match "^\\(.*?\\)\\(?:(\\(..?\\))\\)?$" x) - (progn - (setq kw (match-string 1 x) - ex (and (match-end 2) (match-string 2 x)) - log (and ex (string-match "@" ex)) - key (and ex (substring ex 0 1))) - (if (equal key "@") (setq key nil)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push kw org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws))) - (add-to-list 'org-todo-heads hw 'append) - (push kws1 org-todo-sets) - (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-key-alist (append org-todo-key-alist kwsa)) - (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) - (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) - (setq org-todo-sets (nreverse org-todo-sets) - org-todo-kwd-alist (nreverse org-todo-kwd-alist) - org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) - org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) - ;; Process the constants - (when const - (let (e cst) - (while (setq e (pop const)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))) - - ;; Process the tags. - (when tags - (let (e tgs) - (while (setq e (pop tags)) - (cond - ((equal e "{") (push '(:startgroup) tgs)) - ((equal e "}") (push '(:endgroup) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) - tgs)) - (t (push (list e) tgs)))) - (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist)))))) - - ;; Compute the regular expressions and other local variables - (if (not org-done-keywords) - (setq org-done-keywords (list (org-last org-todo-keywords-1)))) - (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) - (length org-scheduled-string))) - org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$") - org-not-done-keywords - (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) - org-todo-regexp - (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 - "\\|") "\\)\\>") - org-not-done-regexp - (concat "\\<\\(" - (mapconcat 'regexp-quote org-not-done-keywords "\\|") - "\\)\\>") - org-todo-line-regexp - (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?[ \t]*\\(.*\\)") - org-complex-heading-regexp - (concat "^\\(\\*+\\)\\(?:[ \t]+\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") - org-nl-done-regexp - (concat "\n\\*+[ \t]+" - "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)" "\\>") - org-todo-line-tags-regexp - (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - (org-re - "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) - org-looking-at-done-regexp - (concat "^" "\\(?:" - (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" - "\\>") - org-deadline-regexp (concat "\\<" org-deadline-string) - org-deadline-time-regexp - (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") - org-deadline-line-regexp - (concat "\\<\\(" org-deadline-string "\\).*") - org-scheduled-regexp - (concat "\\<" org-scheduled-string) - org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") - org-closed-time-regexp - (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") - org-keyword-time-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-keyword-time-not-clock-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-maybe-keyword-time-regexp - (concat "\\(\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)\\)?" - " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-planning-or-clock-line-re - (concat "\\(?:^[ \t]*\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string "\\|" org-clock-string - "\\)\\>\\)") - ) - (org-compute-latex-and-specials-regexp) - (org-set-font-lock-defaults))) - -(defun org-remove-keyword-keys (list) - (mapcar (lambda (x) - (if (string-match "(..?)$" x) - (substring x 0 (match-beginning 0)) - x)) - list)) - -;; FIXME: this could be done much better, using second characters etc. -(defun org-assign-fast-keys (alist) - "Assign fast keys to a keyword-key alist. -Respect keys that are already there." - (let (new e k c c1 c2 (char ?a)) - (while (setq e (pop alist)) - (cond - ((equal e '(:startgroup)) (push e new)) - ((equal e '(:endgroup)) (push e new)) - (t - (setq k (car e) c2 nil) - (if (cdr e) - (setq c (cdr e)) - ;; automatically assign a character. - (setq c1 (string-to-char - (downcase (substring - k (if (= (string-to-char k) ?@) 1 0))))) - (if (or (rassoc c1 new) (rassoc c1 alist)) - (while (or (rassoc char new) (rassoc char alist)) - (setq char (1+ char))) - (setq c2 c1)) - (setq c (or c2 char))) - (push (cons k c) new)))) - (nreverse new))) - -;;; Some variables ujsed in various places - -(defvar org-window-configuration nil - "Used in various places to store a window configuration.") -(defvar org-finish-function nil - "Function to be called when `C-c C-c' is used. -This is for getting out of special buffers like remember.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(defvar entry) -(defvar state) -(defvar last-state) -(defvar date) -(defvar description) - -;; Defined somewhere in this file, but used before definition. -(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized -(defvar org-agenda-buffer-name) -(defvar org-agenda-undo-list) -(defvar org-agenda-pending-undo-list) -(defvar org-agenda-overriding-header) -(defvar orgtbl-mode) -(defvar org-html-entities) -(defvar org-struct-menu) -(defvar org-org-menu) -(defvar org-tbl-menu) -(defvar org-agenda-keymap) - -;;;; Emacs/XEmacs compatibility - -;; Overlay compatibility functions -(defun org-make-overlay (beg end &optional buffer) - (if (featurep 'xemacs) - (make-extent beg end buffer) - (make-overlay beg end buffer))) -(defun org-delete-overlay (ovl) - (if (featurep 'xemacs) (delete-extent ovl) (delete-overlay ovl))) -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-move-overlay (ovl beg end &optional buffer) - (if (featurep 'xemacs) - (set-extent-endpoints ovl beg end (or buffer (current-buffer))) - (move-overlay ovl beg end buffer))) -(defun org-overlay-put (ovl prop value) - (if (featurep 'xemacs) - (set-extent-property ovl prop value) - (overlay-put ovl prop value))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (overlay-put ovl 'display text) - (if face (overlay-put ovl 'face face)) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-before-string (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-get (ovl prop) - (if (featurep 'xemacs) - (extent-property ovl prop) - (overlay-get ovl prop))) -(defun org-overlays-at (pos) - (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) -(defun org-overlays-in (&optional start end) - (if (featurep 'xemacs) - (extent-list nil start end) - (overlays-in start end))) -(defun org-overlay-start (o) - (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) -(defun org-overlay-end (o) - (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) -(defun org-find-overlays (prop &optional pos delete) - "Find all overlays specifying PROP at POS or point. -If DELETE is non-nil, delete all those overlays." - (let ((overlays (org-overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (org-overlay-get ov prop) - (if delete (org-delete-overlay ov) (push ov found)))) - found)) - -;; Region compatibility - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - -(defvar org-ignore-region nil - "To temporarily disable the active region.") - -(defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (and transient-mark-mode mark-active)))) - -;; Invisibility compatibility - -(defun org-add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (cond - ((fboundp 'add-to-invisibility-spec) - (add-to-invisibility-spec arg)) - ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) - (setq buffer-invisibility-spec (list arg))) - (t - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec))))) - -(defun org-remove-from-invisibility-spec (arg) - "Remove elements from `buffer-invisibility-spec'." - (if (fboundp 'remove-from-invisibility-spec) - (remove-from-invisibility-spec arg) - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) - -(defun org-in-invisibility-spec-p (arg) - "Is ARG a member of `buffer-invisibility-spec'?" - (if (consp buffer-invisibility-spec) - (member arg buffer-invisibility-spec) - nil)) - -;;;; Define the Org-mode - -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")) - - -;; We use a before-change function to check if a table might need -;; an update. -(defvar org-table-may-need-update t - "Indicates that a table might need an update. -This variable is set by `org-before-change-function'. -`org-table-align' sets it back to nil.") -(defvar org-mode-map) -(defvar org-mode-hook nil) -(defvar org-inhibit-startup nil) ; Dynamically-scoped param. -(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. -(defvar org-table-buffer-is-an nil) -(defconst org-outline-regexp "\\*+ ") - -;;;###autoload -(define-derived-mode org-mode outline-mode "Org" - "Outline-based notes management and organizer, alias -\"Carsten's outline-mode for keeping track of everything.\" - -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content -of large files well structured. It supports ToDo items, deadlines and -time stamps, which magically appear in the diary listing of the Emacs -calendar. Tables are easily created with a built-in table editor. -Plain text URL-like links connect to websites, emails (VM), Usenet -messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) -can be exported as a structured ASCII or HTML file. - -The following commands are available: - -\\{org-mode-map}" - - ;; Get rid of Outline menus, they are not needed - ;; Need to do this here because define-derived-mode sets up - ;; the keymap so late. Still, it is a waste to call this each time - ;; we switch another buffer into org-mode. - (if (featurep 'xemacs) - (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it used easymenu - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) - - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu) - (org-install-agenda-files-menu) - (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (featurep 'xemacs) - (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp org-outline-regexp) - (org-set-local 'outline-level 'org-outline-level) - (when (and org-ellipsis - (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) - (fboundp 'make-glyph-code)) - (unless org-display-table - (setq org-display-table (make-display-table))) - (set-display-table-slot - org-display-table 4 - (vconcat (mapcar - (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) - (if (stringp org-ellipsis) org-ellipsis "...")))) - (setq buffer-display-table org-display-table)) - (org-set-regexps-and-options) - ;; Calc embedded - (org-set-local 'calc-embedded-open-mode "# ") - (modify-syntax-entry ?# "<") - (modify-syntax-entry ?@ "w") - (if org-startup-truncated (setq truncate-lines t)) - (org-set-local 'font-lock-unfontify-region-function - 'org-unfontify-region) - ;; Activate before-change-function - (org-set-local 'org-table-may-need-update t) - (org-add-hook 'before-change-functions 'org-before-change-function nil - 'local) - ;; Check for running clock before killing a buffer - (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Paragraphs and auto-filling - (org-set-autofill-regexps) - (setq indent-line-function 'org-indent-line-function) - (org-update-radio-target-regexp) - - ;; Comment characters -; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping - (org-set-local 'comment-padding " ") - - ;; Imenu - (org-set-local 'imenu-create-index-function - 'org-imenu-get-tree) - - ;; Make isearch reveal context - (if (or (featurep 'xemacs) - (not (boundp 'outline-isearch-open-invisible-function))) - ;; Emacs 21 and XEmacs make use of the hook - (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) - ;; Emacs 22 deals with this through a special variable - (org-set-local 'outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch)))) - - ;; If empty file that did not turn on org-mode automatically, make it to. - (if (and org-insert-mode-line-in-empty-file - (interactive-p) - (= (point-min) (point-max))) - (insert "# -*- mode: org -*-\n\n")) - - (unless org-inhibit-startup - (when org-startup-align-all-tables - (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align) - (set-buffer-modified-p bmp))) - (org-cycle-hide-drawers 'all) - (cond - ((eq org-startup-folded t) - (org-cycle '(4))) - ((eq org-startup-folded 'content) - (let ((this-command 'org-cycle) (last-command 'org-cycle)) - (org-cycle '(4)) (org-cycle '(4))))))) - -(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) - -(defsubst org-call-with-arg (command arg) - "Call COMMAND interactively, but pretend prefix are was ARG." - (let ((current-prefix-arg arg)) (call-interactively command))) - -(defsubst org-current-line (&optional pos) - (save-excursion - (and pos (goto-char pos)) - ;; works also in narrowed buffer, because we start at 1, not point-min - (+ (if (bolp) 1 0) (count-lines 1 (point))))) - -(defun org-current-time () - "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." - (if (> org-time-stamp-rounding-minutes 0) - (let ((r org-time-stamp-rounding-minutes) - (time (decode-time))) - (apply 'encode-time - (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) - (nthcdr 2 time)))) - (current-time))) - -(defun org-add-props (string plist &rest props) - "Add text properties to entire string, from beginning to end. -PLIST may be a list of properties, PROPS are individual properties and values -that will be added to PLIST. Returns the string that was modified." - (add-text-properties - 0 (length string) (if props (append plist props) plist) string) - string) -(put 'org-add-props 'lisp-indent-function 2) - - -;;;; Font-Lock stuff, including the activators - -(defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) -(when org-mouse-1-follows-link - (org-defkey org-mouse-map [follow-link] 'mouse-face)) -(when org-tab-follows-link - (org-defkey org-mouse-map [(tab)] 'org-open-at-point) - (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) -(when org-return-follows-link - (org-defkey org-mouse-map [(return)] 'org-open-at-point) - (org-defkey org-mouse-map "\C-m" 'org-open-at-point)) - -(require 'font-lock) - -(defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" - "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) -(defvar org-link-re-with-space nil - "Matches a link with spaces, optional angular brackets around it.") -(defvar org-link-re-with-space2 nil - "Matches a link with spaces, optional angular brackets around it.") -(defvar org-angle-link-re nil - "Matches link with angular brackets, spaces are allowed.") -(defvar org-plain-link-re nil - "Matches plain link, without spaces.") -(defvar org-bracket-link-regexp nil - "Matches a link in double brackets.") -(defvar org-bracket-link-analytic-regexp nil - "Regular expression used to analyze links. -Here is what the match groups contain after a match: -1: http: -2: http -3: path -4: [desc] -5: desc") -(defvar org-any-link-re nil - "Regular expression matching any link.") - -(defun org-make-link-regexps () - "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (setq org-link-re-with-space - (concat - "?") - org-link-re-with-space2 - (concat - "?") - org-angle-link-re - (concat - "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "\\)>") - org-plain-link-re - (concat - "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^]\t\n\r<>,;() ]+\\)") - org-bracket-link-regexp - "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" - org-bracket-link-analytic-regexp - (concat - "\\[\\[" - "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-any-link-re - (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" - org-angle-link-re "\\)\\|\\(" - org-plain-link-re "\\)"))) - -(org-make-link-regexps) - -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis. -This one does not require the space after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) \\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis.") -(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") - "Regular expression matching time stamps, with groups.") -(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") - "Regular expression matching time stamps (also [..]), with groups.") -(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) - "Regular expression matching a time stamp range.") -(defconst org-tr-regexp-both - (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) - "Regular expression matching a time stamp range.") -(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" - org-ts-regexp "\\)?") - "Regular expression matching a time stamp or time stamp range.") -(defconst org-tsr-regexp-both (concat org-ts-regexp-both "\\(--?-?" - org-ts-regexp-both "\\)?") - "Regular expression matching a time stamp or time stamp range. -The time stamps may be either active or inactive.") - -(defvar org-emph-face nil) - -(defun org-do-emphasis-faces (limit) - "Run through the buffer and add overlays to links." - (let (rtn) - (while (and (not rtn) (re-search-forward org-emph-re limit t)) - (if (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (progn - (setq rtn t) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 (assoc (match-string 3) - org-emphasis-alist))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t)) - (when org-hide-emphasis-markers - (add-text-properties (match-end 4) (match-beginning 5) - '(invisible org-link)) - (add-text-properties (match-beginning 3) (match-end 3) - '(invisible org-link))))) - (backward-char 1)) - rtn)) - -(defun org-emphasize (&optional char) - "Insert or change an emphasis, i.e. a font like bold or italic. -If there is an active region, change that region to a new emphasis. -If there is no region, just insert the marker characters and position -the cursor between them. -CHAR should be either the marker character, or the first character of the -HTML tag associated with that emphasis. If CHAR is a space, the means -to remove the emphasis of the selected region. -If char is not given (for example in an interactive call) it -will be prompted for." - (interactive) - (let ((eal org-emphasis-alist) e det - (erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move tag c s) - (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) - string (buffer-substring beg end)) - (setq move t)) - - (while (setq e (pop eal)) - (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) - c (aref tag 0)) - (push (cons c (string-to-char (car e))) det) - (setq prompt (concat prompt (format " [%s%c]%s" (car e) c - (substring tag 1))))) - (unless char - (message "%s" (concat "Emphasis marker or tag:" prompt)) - (setq char (read-char-exclusive))) - (setq char (or (cdr (assoc char det)) char)) - (if (equal char ?\ ) - (setq s "" move nil) - (unless (assoc (char-to-string char) org-emphasis-alist) - (error "No such emphasis marker: \"%c\"" char)) - (setq s (char-to-string char))) - (while (and (> (length string) 1) - (equal (substring string 0 1) (substring string -1)) - (assoc (substring string 0 1) org-emphasis-alist)) - (setq string (substring string 1 -1))) - (setq string (concat s string s)) - (if beg (delete-region beg end)) - (unless (or (bolp) - (string-match (concat "[" (nth 0 erc) "\n]") - (char-to-string (char-before (point))))) - (insert " ")) - (unless (string-match (concat "[" (nth 1 erc) "\n]") - (char-to-string (char-after (point)))) - (insert " ") (backward-char 1)) - (insert string) - (and move (backward-char 1)))) - -(defconst org-nonsticky-props - '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) - - -(defun org-activate-plain-links (limit) - "Run through the buffer and add overlays to links." - (catch 'exit - (let (f) - (while (re-search-forward org-plain-link-re limit t) - (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - (throw 'exit t)))))) - -(defun org-activate-code (limit) - (if (re-search-forward "^[ \t]*\\(:.*\\)" limit t) - (unless (get-text-property (match-beginning 1) 'face) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - t))) - -(defun org-activate-angle-links (limit) - "Run through the buffer and add overlays to links." - (if (re-search-forward org-angle-link-re limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - t))) - -(defmacro org-maybe-intangible (props) - "Add '(intangigble t) to PROPS if Emacs version is earlier than Emacs 22. -In emacs 21, invisible text is not avoided by the command loop, so the -intangible property is needed to make sure point skips this text. -In Emacs 22, this is not necessary. The intangible text property has -led to problems with flyspell. These problems are fixed in flyspell.el, -but we still avoid setting the property in Emacs 22 and later. -We use a macro so that the test can happen at compilation time." - (if (< emacs-major-version 22) - `(append '(intangible t) ,props) - props)) - -(defun org-activate-bracket-links (limit) - "Run through the buffer and add overlays to bracketed links." - (if (re-search-forward org-bracket-link-regexp limit t) - (let* ((help (concat "LINK: " - (org-match-string-no-properties 1))) - ;; FIXME: above we should remove the escapes. - ;; but that requires another match, protecting match data, - ;; a lot of overhead for font-lock. - (ip (org-maybe-intangible - (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) - (vp (list 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - ' font-lock-multiline t 'help-echo help))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (add-text-properties (match-end 3) (match-end 0) ip)) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (add-text-properties (match-end 1) (match-end 0) ip)) - t))) - -(defun org-activate-dates (limit) - "Run through the buffer and add overlays to dates." - (if (re-search-forward org-tsr-regexp-both limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map)) - (when org-display-custom-times - (if (match-end 3) - (org-display-custom-time (match-beginning 3) (match-end 3))) - (org-display-custom-time (match-beginning 1) (match-end 1))) - t))) - -(defvar org-target-link-regexp nil - "Regular expression matching radio targets in plain text.") -(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" - "Regular expression matching a link target.") -(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" - "Regular expression matching a radio target.") -(defvar org-any-target-regexp "<<\n\r]+\\)>>>?" ; FIXME, not exact, would match <<> as a radio target. - "Regular expression matching any target.") - -(defun org-activate-target-links (limit) - "Run through the buffer and add overlays to target matches." - (when org-target-link-regexp - (let ((case-fold-search t)) - (if (re-search-forward org-target-link-regexp limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - 'help-echo "Radio target link" - 'org-linked-text t)) - t))))) - -(defun org-update-radio-target-regexp () - "Find all radio targets in this file and update the regular expression." - (interactive) - (when (memq 'radio org-activate-links) - (setq org-target-link-regexp - (org-make-target-link-regexp (org-all-targets 'radio))) - (org-restart-font-lock))) - -(defun org-hide-wide-columns (limit) - (let (s e) - (setq s (text-property-any (point) (or limit (point-max)) - 'org-cwidth t)) - (when s - (setq e (next-single-property-change s 'org-cwidth)) - (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) - (goto-char e) - t))) - -(defvar org-latex-and-specials-regexp nil - "Regular expression for highlighting export special stuff.") -(defvar org-match-substring-regexp) -(defvar org-match-substring-with-braces-regexp) -(defvar org-export-html-special-string-regexps) - -(defun org-compute-latex-and-specials-regexp () - "Compute regular expression for stuff treated specially by exporters." - (if (not org-highlight-latex-fragments-and-specials) - (org-set-local 'org-latex-and-specials-regexp nil) - (let* - ((matchers (plist-get org-format-latex-options :matchers)) - (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) - org-latex-regexps))) - (options (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (org-export-with-sub-superscripts (plist-get options :sub-superscript)) - (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) - (org-export-with-TeX-macros (plist-get options :TeX-macros)) - (org-export-html-expand (plist-get options :expand-quoted-html)) - (org-export-with-special-strings (plist-get options :special-strings)) - (re-sub - (cond - ((equal org-export-with-sub-superscripts '{}) - (list org-match-substring-with-braces-regexp)) - (org-export-with-sub-superscripts - (list org-match-substring-regexp)) - (t nil))) - (re-latex - (if org-export-with-LaTeX-fragments - (mapcar (lambda (x) (nth 1 x)) latexs))) - (re-macros - (if org-export-with-TeX-macros - (list (concat "\\\\" - (regexp-opt - (append (mapcar 'car org-html-entities) - (if (boundp 'org-latex-entities) - org-latex-entities nil)) - 'words))) ; FIXME - )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) - (re-special (if org-export-with-special-strings - (mapcar (lambda (x) (car x)) - org-export-html-special-string-regexps))) - (re-rest - (delq nil - (list - (if org-export-html-expand "@<[^>\n]+>") - )))) - (org-set-local - 'org-latex-and-specials-regexp - (mapconcat 'identity (append re-latex re-sub re-macros re-special - re-rest) "\\|"))))) - -(defface org-latex-and-export-specials - (let ((font (cond ((assq :inherit custom-face-attributes) - '(:inherit underline)) - (t '(:underline t))))) - `((((class grayscale) (background light)) - (:foreground "DimGray" ,@font)) - (((class grayscale) (background dark)) - (:foreground "LightGray" ,@font)) - (((class color) (background light)) - (:foreground "SaddleBrown")) - (((class color) (background dark)) - (:foreground "burlywood")) - (t (,@font)))) - "Face used to highlight math latex and other special exporter stuff." - :group 'org-faces) - -(defun org-do-latex-and-special-faces (limit) - "Run through the buffer and add overlays to links." - (when org-latex-and-specials-regexp - (let (rtn d) - (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp - limit t)) - (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline))) - (progn - (setq rtn t - d (cond ((member (char-after (1+ (match-beginning 0))) - '(?_ ?^)) 1) - (t 0))) - (font-lock-prepend-text-property - (+ d (match-beginning 0)) (match-end 0) - 'face 'org-latex-and-export-specials) - (add-text-properties (+ d (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))))) - rtn))) - -(defun org-restart-font-lock () - "Restart font-lock-mode, to force refontification." - (when (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode -1) - (font-lock-mode 1))) - -(defun org-all-targets (&optional radio) - "Return a list of all targets in this file. -With optional argument RADIO, only find radio targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) - rtn) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re nil t) - (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) - rtn))) - -(defun org-make-target-link-regexp (targets) - "Make regular expression matching all strings in TARGETS. -The regular expression finds the targets also if there is a line break -between words." - (and targets - (concat - "\\<\\(" - (mapconcat - (lambda (x) - (while (string-match " +" x) - (setq x (replace-match "\\s-+" t t x))) - x) - targets - "\\|") - "\\)\\>"))) - -(defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) - (progn - (add-text-properties (match-beginning 1) (match-end 1) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map)) - t))) - -(defun org-outline-level () - (save-excursion - (looking-at outline-regexp) - (if (match-beginning 1) - (+ (org-get-string-indentation (match-string 1)) 1000) - (1- (- (match-end 0) (match-beginning 0)))))) - -(defvar org-font-lock-keywords nil) - -(defconst org-property-re (org-re "^[ \t]*\\(:\\([[:alnum:]_]+\\):\\)[ \t]*\\(\\S-.*\\)") - "Regular expression matching a property line.") - -(defun org-set-font-lock-defaults () - (let* ((em org-fontify-emphasized-text) - (lk org-activate-links) - (org-font-lock-extra-keywords - (list - ;; Headlines - '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) - (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) - ;; Table lines - '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" - (1 'org-table t)) - ;; Table internals - '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) - '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) - '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) - ;; Drawers - (list org-drawer-regexp '(0 'org-special-keyword t)) - (list "^[ \t]*:END:" '(0 'org-special-keyword t)) - ;; Properties - (list org-property-re - '(1 'org-special-keyword t) - '(3 'org-property-value t)) - (if org-format-transports-properties-p - '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) - ;; Links - (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) - (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) - '(org-hide-wide-columns (0 nil append)) - ;; TODO lines - (list (concat "^\\*+[ \t]+" org-todo-regexp) - '(1 (org-get-todo-face 1) t)) - ;; DONE - (if org-fontify-done-headline - (list (concat "^[*]+ +\\<\\(" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)\\(.*\\)") - '(2 'org-headline-done t)) - nil) - ;; Priorities - (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) - ;; Special keywords - (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) - ;; Emphasis - (if em - (if (featurep 'xemacs) - '(org-do-emphasis-faces (0 nil append)) - '(org-do-emphasis-faces))) - ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" - 2 'bold prepend) - (if org-provide-checkbox-statistics - '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" - (0 (org-get-checkbox-statistics-face) t))) - (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") - '(1 'org-archived prepend)) - ;; Specials - '(org-do-latex-and-special-faces) - ;; Code - '(org-activate-code (1 'org-code t)) - ;; COMMENT - (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string - "\\|" org-quote-string "\\)\\>") - '(1 'org-special-keyword t)) - '("^#.*" (0 'font-lock-comment-face t)) - ))) - (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) - ;; Now set the full font-lock-keywords - (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) - (org-set-local 'font-lock-defaults - '(org-font-lock-keywords t nil nil backward-paragraph)) - (kill-local-variable 'font-lock-keywords) nil)) - -(defvar org-m nil) -(defvar org-l nil) -(defvar org-f nil) -(defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of healdines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) - (cond - ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) - ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) - -(defun org-get-todo-face (kwd) - "Get the right face for a TODO keyword KWD. -If KWD is a number, get the corresponding match group." - (if (numberp kwd) (setq kwd (match-string kwd))) - (or (cdr (assoc kwd org-todo-keyword-faces)) - (and (member kwd org-done-keywords) 'org-done) - 'org-todo)) - -(defun org-unfontify-region (beg end &optional maybe_loudly) - "Remove fontification and activation overlays from links." - (font-lock-default-unfontify-region beg end) - (let* ((buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t)))) - -;;;; Visibility cycling, including org-goto and indirect buffer - -;;; Cycling - -(defvar org-cycle-global-status nil) -(make-variable-buffer-local 'org-cycle-global-status) -(defvar org-cycle-subtree-status nil) -(make-variable-buffer-local 'org-cycle-subtree-status) - -;;;###autoload -(defun org-cycle (&optional arg) - "Visibility cycling for Org-mode. - -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute - `indent-relative', like TAB normally does. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t." - (interactive "P") - (let* ((outline-regexp - (if (and (org-mode-p) org-cycle-include-plain-lists) - "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" - outline-regexp)) - (bob-special (and org-cycle-global-at-bob (bobp) - (not (looking-at outline-regexp)))) - (org-cycle-hook - (if bob-special - (delq 'org-optimize-window-after-visibility-change - (copy-sequence org-cycle-hook)) - org-cycle-hook)) - (pos (point))) - - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - - (cond - - ((org-at-table-p 'any) - ;; Enter the table or move to the next field in the table - (or (org-table-recognize-table.el) - (progn - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-field))))) - - ((eq arg t) ;; Global cycling - - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (message "CONTENTS...") - (org-content) - (message "CONTENTS...done") - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (show-all) - (message "SHOW ALL") - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) - - (t - ;; Default action: go to overview - (org-overview) - (message "OVERVIEW") - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview)))) - - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - ;; Toggle block visibility - (org-flag-drawer - (not (get-char-property (match-end 0) 'invisible)))) - - ((integerp arg) - ;; Show-subtree, ARG levels up from here. - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) - - ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - ;; At a heading: rotate between three different views - (org-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; First, some boundaries - (save-excursion - (org-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (outline-end-of-heading) (setq eoh (point)) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil)))) - ((or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - ;; Entire subtree is hidden in one line: open it - (org-show-entry) - (show-children) - (message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (run-hook-with-args 'org-cycle-hook 'children)) - ((and (eq last-command this-command) - (eq org-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - (org-show-subtree) - (message "SUBTREE") - (setq org-cycle-subtree-status 'subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)) - (t - ;; Default action: hide the subtree. - (hide-subtree) - (message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (run-hook-with-args 'org-cycle-hook 'folded))))) - - ;; TAB emulation - (buffer-read-only (org-back-to-heading)) - - ((org-try-cdlatex-tab)) - - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at outline-regexp)))) - (call-interactively (global-key-binding "\t"))) - - ((if (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) - (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) - (and (eq org-cycle-emulate-tab 'whitestart) - (>= (match-end 0) pos)))) - t - (eq org-cycle-emulate-tab t)) -; (if (and (looking-at "[ \n\r\t]") -; (string-match "^[ \t]*$" (buffer-substring -; (point-at-bol) (point)))) -; (progn -; (beginning-of-line 1) -; (and (looking-at "[ \t]+") (replace-match "")))) - (call-interactively (global-key-binding "\t"))) - - (t (save-excursion - (org-back-to-heading) - (org-cycle)))))) - -;;;###autoload -(defun org-global-cycle (&optional arg) - "Cycle the global visibility. For details see `org-cycle'." - (interactive "P") - (let ((org-cycle-include-plain-lists - (if (org-mode-p) org-cycle-include-plain-lists nil))) - (if (integerp arg) - (progn - (show-all) - (hide-sublevels arg) - (setq org-cycle-global-status 'contents)) - (org-cycle '(4))))) - -(defun org-overview () - "Switch to overview mode, shoing only top-level headlines. -Really, this shows all headlines with level equal or greater than the level -of the first headline in the buffer. This is important, because if the -first headline is not level one, then (hide-sublevels 1) gives confusing -results." - (interactive) - (let ((level (save-excursion - (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) - (progn - (goto-char (match-beginning 0)) - (funcall outline-level)))))) - (and level (hide-sublevels level)))) - -(defun org-content (&optional arg) - "Show all headlines in the buffer, like a table of contents. -With numerical argument N, show content up to level N." - (interactive "P") - (save-excursion - ;; Visit all headings and show their offspring - (and (integerp arg) (org-overview)) - (goto-char (point-max)) - (catch 'exit - (while (and (progn (condition-case nil - (outline-previous-visible-heading 1) - (error (goto-char (point-min)))) - t) - (looking-at outline-regexp)) - (if (integerp arg) - (show-children (1- arg)) - (show-branches)) - (if (bobp) (throw 'exit nil)))))) - - -(defun org-optimize-window-after-visibility-change (state) - "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." - (when (get-buffer-window (current-buffer)) - (cond -; ((eq state 'overview) (org-first-headline-recenter 1)) -; ((eq state 'overview) (org-beginning-of-line)) - ((eq state 'content) nil) - ((eq state 'all) nil) - ((eq state 'folded) nil) - ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) - - -(defun org-cycle-show-empty-lines (state) - "Show empty lines above all visible headlines. -The region to be covered depends on STATE when called through -`org-cycle-hook'. Lisp program can use t for STATE to get the -entire buffer covered. Note that an empty line is only shown if there -are at least `org-cycle-separator-lines' empty lines before the headeline." - (when (> org-cycle-separator-lines 0) - (save-excursion - (let* ((n org-cycle-separator-lines) - (re (cond - ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") - ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") - (t (let ((ns (number-to-string (- n 2)))) - (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" - "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) - beg end) - (cond - ((memq state '(overview contents t)) - (setq beg (point-min) end (point-max))) - ((memq state '(children folded)) - (setq beg (point) end (progn (org-end-of-subtree t t) - (beginning-of-line 2) - (point))))) - (when beg - (goto-char beg) - (while (re-search-forward re end t) - (if (not (get-char-property (match-end 1) 'invisible)) - (outline-flag-region - (match-beginning 1) (match-end 1) nil))))))) - ;; Never hide empty lines at the end of the file. - (save-excursion - (goto-char (point-max)) - (outline-previous-heading) - (outline-end-of-heading) - (if (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (outline-flag-region (point) (match-end 0) nil)))) - -(defun org-subtree-end-visible-p () - "Is the end of the current subtree visible?" - (pos-visible-in-window-p - (save-excursion (org-end-of-subtree t) (point)))) - -(defun org-first-headline-recenter (&optional N) - "Move cursor to the first headline and recenter the headline. -Optional argument N means, put the headline into the Nth line of the window." - (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) - (beginning-of-line) - (recenter (prefix-numeric-value N)))) - -;;; Org-goto - -(defvar org-goto-window-configuration nil) -(defvar org-goto-marker nil) -(defvar org-goto-map - (let ((map (make-sparse-keymap))) - (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd) - (while (setq cmd (pop cmds)) - (substitute-key-definition cmd cmd map global-map))) - (suppress-keymap map) - (org-defkey map "\C-m" 'org-goto-ret) - (org-defkey map [(left)] 'org-goto-left) - (org-defkey map [(right)] 'org-goto-right) - (org-defkey map [(?q)] 'org-goto-quit) - (org-defkey map [(control ?g)] 'org-goto-quit) - (org-defkey map "\C-i" 'org-cycle) - (org-defkey map [(tab)] 'org-cycle) - (org-defkey map [(down)] 'outline-next-visible-heading) - (org-defkey map [(up)] 'outline-previous-visible-heading) - (org-defkey map "n" 'outline-next-visible-heading) - (org-defkey map "p" 'outline-previous-visible-heading) - (org-defkey map "f" 'outline-forward-same-level) - (org-defkey map "b" 'outline-backward-same-level) - (org-defkey map "u" 'outline-up-heading) - (org-defkey map "/" 'org-occur) - (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) - (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) - (org-defkey map "\C-c\C-f" 'outline-forward-same-level) - (org-defkey map "\C-c\C-b" 'outline-backward-same-level) - (org-defkey map "\C-c\C-u" 'outline-up-heading) - map)) - -(defconst org-goto-help -"Browse copy of buffer to find location or copy text. -RET=jump to location [Q]uit and return to previous location -\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" -) - -(defvar org-goto-start-pos) ; dynamically scoped parameter - -(defun org-goto () - "Look up a different location in the current file, keeping current visibility. - -When you want look-up or go to a different location in a document, the -fastest way is often to fold the entire buffer and then dive into the tree. -This method has the disadvantage, that the previous location will be folded, -which may not be what you want. - -This command works around this by showing a copy of the current buffer -in an indirect buffer, in overview mode. You can dive into the tree in -that copy, use org-occur and incremental search to find a location. -When pressing RET or `Q', the command returns to the original buffer in -which the visibility is still unchanged. After RET is will also jump to -the location selected in the indirect buffer and expose the -the headline hierarchy above." - (interactive) - (let* ((org-goto-start-pos (point)) - (selected-point - (car (org-get-location (current-buffer) org-goto-help)))) - (if selected-point - (progn - (org-mark-ring-push org-goto-start-pos) - (goto-char selected-point) - (if (or (org-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) - (message "Quit")))) - -(defvar org-goto-selected-point nil) ; dynamically scoped parameter -(defvar org-goto-exit-command nil) ; dynamically scoped parameter - -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. -This function uses a recursive edit. It returns the selected position -or nil." - (let (org-goto-selected-point org-goto-exit-command) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (switch-to-buffer - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) - (with-output-to-temp-buffer "*Help*" - (princ help)) - (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) - (setq buffer-read-only nil) - (let ((org-startup-truncated t) - (org-startup-folded nil) - (org-startup-align-all-tables nil)) - (org-mode) - (org-overview)) - (setq buffer-read-only t) - (if (and (boundp 'org-goto-start-pos) - (integer-or-marker-p org-goto-start-pos)) - (let ((org-show-hierarchy-above t) - (org-show-siblings t) - (org-show-following-heading t)) - (goto-char org-goto-start-pos) - (and (org-invisible-p) (org-show-context))) - (goto-char (point-min))) - (org-beginning-of-line) - (message "Select location and press RET") - ;; now we make sure that during selection, ony very few keys work - ;; and that it is impossible to switch to another window. -; (let ((gm (current-global-map)) -; (overriding-local-map org-goto-map)) -; (unwind-protect -; (progn -; (use-global-map org-goto-map) -; (recursive-edit)) -; (use-global-map gm))) - (use-local-map org-goto-map) - (recursive-edit) - )) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command))) - -(defun org-goto-ret (&optional arg) - "Finish `org-goto' by going to the new location." - (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) - (throw 'exit nil)) - -(defun org-goto-left () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-on-heading-p) - (progn - (beginning-of-line 1) - (setq org-goto-selected-point (point) - org-goto-exit-command 'left) - (throw 'exit nil)) - (error "Not on a heading"))) - -(defun org-goto-right () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-on-heading-p) - (progn - (setq org-goto-selected-point (point) - org-goto-exit-command 'right) - (throw 'exit nil)) - (error "Not on a heading"))) - -(defun org-goto-quit () - "Finish `org-goto' without cursor motion." - (interactive) - (setq org-goto-selected-point nil) - (setq org-goto-exit-command 'quit) - (throw 'exit nil)) - -;;; Indirect buffer display of subtrees - -(defvar org-indirect-dedicated-frame nil - "This is the frame being used for indirect tree display.") -(defvar org-last-indirect-buffer nil) - -(defun org-tree-to-indirect-buffer (&optional arg) - "Create indirect buffer and narrow it to current subtree. -With numerical prefix ARG, go up to this level and then take that tree. -If ARG is negative, go up that many levels. -If `org-indirect-buffer-display' is not `new-frame', the command removes the -indirect buffer previously made with this command, to avoid proliferation of -indirect buffers. However, when you call the command with a `C-u' prefix, or -when `org-indirect-buffer-display' is `new-frame', the last buffer -is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also -requests that a new frame be made for the new buffer, so that the dedicated -frame is not changed." - (interactive "P") - (let ((cbuf (current-buffer)) - (cwin (selected-window)) - (pos (point)) - beg end level heading ibuf) - (save-excursion - (org-back-to-heading t) - (when (numberp arg) - (setq level (org-outline-level)) - (if (< arg 0) (setq arg (+ level arg))) - (while (> (setq level (org-outline-level)) arg) - (outline-up-heading 1 t))) - (setq beg (point) - heading (org-get-heading)) - (org-end-of-subtree t) (setq end (point))) - (if (and (buffer-live-p org-last-indirect-buffer) - (not (eq org-indirect-buffer-display 'new-frame)) - (not arg)) - (kill-buffer org-last-indirect-buffer)) - (setq ibuf (org-get-indirect-buffer cbuf) - org-last-indirect-buffer ibuf) - (cond - ((or (eq org-indirect-buffer-display 'new-frame) - (and arg (eq org-indirect-buffer-display 'dedicated-frame))) - (select-frame (make-frame)) - (delete-other-windows) - (switch-to-buffer ibuf) - (org-set-frame-title heading)) - ((eq org-indirect-buffer-display 'dedicated-frame) - (raise-frame - (select-frame (or (and org-indirect-dedicated-frame - (frame-live-p org-indirect-dedicated-frame) - org-indirect-dedicated-frame) - (setq org-indirect-dedicated-frame (make-frame))))) - (delete-other-windows) - (switch-to-buffer ibuf) - (org-set-frame-title (concat "Indirect: " heading))) - ((eq org-indirect-buffer-display 'current-window) - (switch-to-buffer ibuf)) - ((eq org-indirect-buffer-display 'other-window) - (pop-to-buffer ibuf)) - (t (error "Invalid value."))) - (if (featurep 'xemacs) - (save-excursion (org-mode) (turn-on-font-lock))) - (narrow-to-region beg end) - (show-all) - (goto-char pos) - (and (window-live-p cwin) (select-window cwin)))) - -(defun org-get-indirect-buffer (&optional buffer) - (setq buffer (or buffer (current-buffer))) - (let ((n 1) (base (buffer-name buffer)) bname) - (while (buffer-live-p - (get-buffer (setq bname (concat base "-" (number-to-string n))))) - (setq n (1+ n))) - (condition-case nil - (make-indirect-buffer buffer bname 'clone) - (error (make-indirect-buffer buffer bname))))) - -(defun org-set-frame-title (title) - "Set the title of the current frame to the string TITLE." - ;; FIXME: how to name a single frame in XEmacs??? - (unless (featurep 'xemacs) - (modify-frame-parameters (selected-frame) (list (cons 'name title))))) - -;;;; Structure editing - -;;; Inserting headlines - -(defun org-insert-heading (&optional force-heading) - "Insert a new heading or item with same depth at point. -If point is in a plain list and FORCE-HEADING is nil, create a new list item. -If point is at the beginning of a headline, insert a sibling before the -current headline. If point is in the middle of a headline, split the headline -at that position and make the rest of the headline part of the sibling below -the current headline." - (interactive "P") - (if (= (buffer-size) 0) - (insert "\n* ") - (when (or force-heading (not (org-insert-item))) - (let* ((head (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (match-string 0)) - (error "*")))) - (blank (cdr (assq 'heading org-blank-before-new-entry))) - pos) - (cond - ((and (org-on-heading-p) (bolp) - (or (bobp) - (save-excursion (backward-char 1) (not (org-invisible-p))))) - (open-line (if blank 2 1))) - ((and (bolp) - (or (bobp) - (save-excursion - (backward-char 1) (not (org-invisible-p))))) - nil) - (t (newline (if blank 2 1)))) - (insert head) (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) - (run-hooks 'org-insert-heading-hook))))) - -(defun org-insert-heading-after-current () - "Insert a new heading with same level as current, after current subtree." - (interactive) - (org-back-to-heading) - (org-insert-heading) - (org-move-subtree-down) - (end-of-line 1)) - -(defun org-insert-todo-heading (arg) - "Insert a new heading with the same level and TODO state as current heading. -If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with prefix arg, force first state." - (interactive "P") - (when (not (org-insert-item 'checkbox)) - (org-insert-heading) - (save-excursion - (org-back-to-heading) - (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (if (or arg - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (insert (car org-todo-keywords-1) " ") - (insert (match-string 2) " ")))) - -(defun org-insert-subheading (arg) - "Insert a new subheading and demote it. -Works for outline headings and for plain lists alike." - (interactive "P") - (org-insert-heading arg) - (cond - ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) - -(defun org-insert-todo-subheading (arg) - "Insert a new subheading with TODO keyword or checkbox and demote it. -Works for outline headings and for plain lists alike." - (interactive "P") - (org-insert-todo-heading arg) - (cond - ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) - -;;; Promotion and Demotion - -(defun org-promote-subtree () - "Promote the entire subtree. -See also `org-promote'." - (interactive) - (save-excursion - (org-map-tree 'org-promote)) - (org-fix-position-after-promote)) - -(defun org-demote-subtree () - "Demote the entire subtree. See `org-demote'. -See also `org-promote'." - (interactive) - (save-excursion - (org-map-tree 'org-demote)) - (org-fix-position-after-promote)) - - -(defun org-do-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (interactive) - (save-excursion - (if (org-region-active-p) - (org-map-region 'org-promote (region-beginning) (region-end)) - (org-promote))) - (org-fix-position-after-promote)) - -(defun org-do-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (interactive) - (save-excursion - (if (org-region-active-p) - (org-map-region 'org-demote (region-beginning) (region-end)) - (org-demote))) - (org-fix-position-after-promote)) - -(defun org-fix-position-after-promote () - "Make sure that after pro/demotion cursor position is right." - (let ((pos (point))) - (when (save-excursion - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (or (equal pos (match-end 1)) (equal pos (match-end 2)))) - (cond ((eobp) (insert " ")) - ((eolp) (insert " ")) - ((equal (char-after) ?\ ) (forward-char 1)))))) - -(defun org-reduced-level (l) - (if org-odd-levels-only (1+ (floor (/ l 2))) l)) - -(defun org-get-legal-level (level &optional change) - "Rectify a level change under the influence of `org-odd-levels-only' -LEVEL is a current level, CHANGE is by how much the level should be -modified. Even if CHANGE is nil, LEVEL may be returned modified because -even level numbers will become the next higher odd number." - (if org-odd-levels-only - (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) - ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) - ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) - (max 1 (+ level change)))) - -(defun org-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (up-head (concat (make-string (org-get-legal-level level -1) ?*) " ")) - (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))))) - -(defun org-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (down-head (concat (make-string (org-get-legal-level level 1) ?*) " ")) - (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation diff)))) - -(defun org-map-tree (fun) - "Call FUN for every heading underneath the current one." - (org-back-to-heading) - (let ((level (funcall outline-level))) - (save-excursion - (funcall fun) - (while (and (progn - (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (funcall fun))))) - -(defun org-map-region (fun beg end) - "Call FUN for every heading between BEG and END." - (let ((org-ignore-region t)) - (save-excursion - (setq end (copy-marker end)) - (goto-char beg) - (if (and (re-search-forward (concat "^" outline-regexp) nil t) - (< (point) end)) - (funcall fun)) - (while (and (progn - (outline-next-heading) - (< (point) end)) - (not (eobp))) - (funcall fun))))) - -(defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF -However, if any line in the current entry has no indentation, or if it -would end up with no indentation after the change, nothing at all is done." - (save-excursion - (let ((end (save-excursion (outline-next-heading) - (point-marker))) - (prohibit (if (> diff 0) - "^\\S-" - (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) - col) - (unless (save-excursion (end-of-line 1) - (re-search-forward prohibit end t)) - (while (and (< (point) end) - (re-search-forward "^[ \t]+" end t)) - (goto-char (match-end 0)) - (setq col (current-column)) - (if (< diff 0) (replace-match "")) - (indent-to (+ diff col)))) - (move-marker end nil)))) - -(defun org-convert-to-odd-levels () - "Convert an org-mode file with all levels allowed to one with odd levels. -This will leave level 1 alone, convert level 2 to level 3, level 3 to -level 5 etc." - (interactive) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") - (let ((org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (- (length (match-string 0)) 2)) - (while (>= (setq n (1- n)) 0) - (org-demote)) - (end-of-line 1)))))) - - -(defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd and even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a -section with an even level, conversion would destroy the structure of the file. An error -is signaled in this case." - (interactive) - (goto-char (point-min)) - ;; First check if there are no even levels - (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-context t) - (error "Not all levels are odd in this file. Conversion not possible.")) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") - (let ((org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (/ (1- (length (match-string 0))) 2)) - (while (>= (setq n (1- n)) 0) - (org-promote)) - (end-of-line 1)))))) - -(defun org-tr-level (n) - "Make N odd if required." - (if org-odd-levels-only (1+ (/ n 2)) n)) - -;;; Vertical tree motion, cutting and pasting of subtrees - -(defun org-move-subtree-up (&optional arg) - "Move the current subtree up past ARG headlines of the same level." - (interactive "p") - (org-move-subtree-down (- (prefix-numeric-value arg)))) - -(defun org-move-subtree-down (&optional arg) - "Move the current subtree down past ARG headlines of the same level." - (interactive "p") - (setq arg (prefix-numeric-value arg)) - (let ((movfunc (if (> arg 0) 'outline-get-next-sibling - 'outline-get-last-sibling)) - (ins-point (make-marker)) - (cnt (abs arg)) - beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) - ;; Select the tree - (org-back-to-heading) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) - (outline-end-of-subtree)) - (outline-next-heading) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - ;; Find insertion point, with error handling - (while (> cnt 0) - (or (and (funcall movfunc) (looking-at outline-regexp)) - (progn (goto-char beg0) - (error "Cannot move past superior level or buffer limit"))) - (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (outline-end-of-subtree) - (org-back-over-empty-lines) - (or (bolp) (newline)))) - (setq ne-ins (org-back-over-empty-lines)) - (move-marker ins-point (point)) - (setq txt (buffer-substring beg end)) - (delete-region beg end) - (insert txt) - (or (bolp) (insert "\n")) - (setq ins-end (point)) - (goto-char ins-point) - (org-skip-whitespace) - (when (and (< arg 0) - (org-first-sibling-p) - (> ne-ins ne-beg)) - ;; Move whitespace back to beginning - (save-excursion - (goto-char ins-end) - (let ((kill-whole-line t)) - (kill-line (- ne-ins ne-beg)) (point))) - (insert (make-string (- ne-ins ne-beg) ?\n))) - (if folded (hide-subtree)) - (move-marker ins-point nil))) - -(defvar org-subtree-clip "" - "Clipboard for cut and paste of subtrees. -This is actually only a copy of the kill, because we use the normal kill -ring. We need it to check if the kill was created by `org-copy-subtree'.") - -(defvar org-subtree-clip-folded nil - "Was the last copied subtree folded? -This is used to fold the tree back after pasting.") - -(defun org-cut-subtree (&optional n) - "Cut the current subtree into the clipboard. -With prefix arg N, cut this many sequential subtrees. -This is a short-hand for marking the subtree and then cutting it." - (interactive "p") - (org-copy-subtree n 'cut)) - -(defun org-copy-subtree (&optional n cut) - "Cut the current subtree into the clipboard. -With prefix arg N, cut this many sequential subtrees. -This is a short-hand for marking the subtree and then copying it. -If CUT is non-nil, actually cut the subtree." - (interactive "p") - (let (beg end folded) - (if (interactive-p) - (org-back-to-heading nil) ; take what looks like a subtree - (org-back-to-heading t)) ; take what is really there - (org-back-over-empty-lines) - (setq beg (point)) - (skip-chars-forward " \t\r\n") - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) - (condition-case nil - (outline-forward-same-level (1- n)) - (error nil)) - (org-end-of-subtree t t)) - (org-back-over-empty-lines) - (setq end (point)) - (goto-char beg) - (when (> end beg) - (setq org-subtree-clip-folded folded) - (if cut (kill-region beg end) (copy-region-as-kill beg end)) - (setq org-subtree-clip (current-kill 0)) - (message "%s: Subtree(s) with %d characters" - (if cut "Cut" "Copied") - (length org-subtree-clip))))) - -(defun org-paste-subtree (&optional level tree) - "Paste the clipboard as a subtree, with modification of headline level. -The entire subtree is promoted or demoted in order to match a new headline -level. By default, the new level is derived from the visible headings -before and after the insertion point, and taken to be the inferior headline -level of the two. So if the previous visible heading is level 3 and the -next is level 4 (or vice versa), level 4 will be used for insertion. -This makes sure that the subtree remains an independent subtree and does -not swallow low level entries. - -You can also force a different level, either by using a numeric prefix -argument, or by inserting the heading marker by hand. For example, if the -cursor is after \"*****\", then the tree will be shifted to level 5. - -If you want to insert the tree as is, just use \\[yank]. - -If optional TREE is given, use this text instead of the kill ring." - (interactive "P") - (unless (org-kill-is-subtree-p tree) - (error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((txt (or tree (and kill-ring (current-kill 0)))) - (^re (concat "^\\(" outline-regexp "\\)")) - (re (concat "\\(" outline-regexp "\\)")) - (^re_ (concat "\\(\\*+\\)[ \t]*")) - - (old-level (if (string-match ^re txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level (cond (level (prefix-numeric-value level)) - ((string-match - ^re_ (buffer-substring (point-at-bol) (point))) - (- (match-end 1) (match-beginning 1))) - (t nil))) - (previous-level (save-excursion - (condition-case nil - (progn - (outline-previous-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (next-level (save-excursion - (condition-case nil - (progn - (or (looking-at outline-regexp) - (outline-next-visible-heading 1)) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) 'org-demote 'org-promote)) - (org-odd-levels-only nil) - beg end) - ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) - ;; Paste - (beginning-of-line 1) - (setq beg (point)) - (insert txt) - (unless (string-match "\n\\'" txt) (insert "\n")) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - ;; Shift if necessary - (unless (= shift 0) - (save-restriction - (narrow-to-region beg end) - (while (not (= shift 0)) - (org-map-region func (point-min) (point-max)) - (setq shift (+ delta shift))) - (goto-char (point-min)))) - (when (interactive-p) - (message "Clipboard pasted as level %d subtree" new-level)) - (if (and kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)))) - -(defun org-kill-is-subtree-p (&optional txt) - "Check if the current kill is an outline subtree, or a set of trees. -Returns nil if kill does not start with a headline, or if the first -headline level is not the largest headline level in the tree. -So this will actually accept several entries of equal levels as well, -which is OK for `org-paste-subtree'. -If optional TXT is given, check this string instead of the current kill." - (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) - (start-level (and kill - (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" - org-outline-regexp "\\)") - kill) - (- (match-end 2) (match-beginning 2) 1))) - (re (concat "^" org-outline-regexp)) - (start (1+ (match-beginning 2)))) - (if (not start-level) - (progn - nil) ;; does not even start with a heading - (catch 'exit - (while (setq start (string-match re kill (1+ start))) - (when (< (- (match-end 0) (match-beginning 0) 1) start-level) - (throw 'exit nil))) - t)))) - -(defun org-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (narrow-to-region - (progn (org-back-to-heading) (point)) - (progn (org-end-of-subtree t t) (point))))) - - -;;; Outline Sorting - -(defun org-sort (with-case) - "Call `org-sort-entries-or-items' or `org-table-sort-lines'. -Optional argument WITH-CASE means sort case-sensitively." - (interactive "P") - (if (org-at-table-p) - (org-call-with-arg 'org-table-sort-lines with-case) - (org-call-with-arg 'org-sort-entries-or-items with-case))) - -(defvar org-priority-regexp) ; defined later in the file - -(defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property) - "Sort entries on a certain level of an outline tree. -If there is an active region, the entries in the region are sorted. -Else, if the cursor is before the first entry, sort the top-level items. -Else, the children of the entry at point are sorted. - -Sorting can be alphabetically, numerically, and by date/time as given by -the first time stamp in the entry. The command prompts for the sorting -type unless it has been given to the function through the SORTING-TYPE -argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F). -If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be -called with point at the beginning of the record. It must return either -a string or a number that should serve as the sorting key for that record. - -Comparing entries ignores case by default. However, with an optional argument -WITH-CASE, the sorting considers case as well." - (interactive "P") - (let ((case-func (if with-case 'identity 'downcase)) - start beg end stars re re2 - txt what tmp plain-list-p) - ;; Find beginning and end of region to sort - (cond - ((org-region-active-p) - ;; we will sort the region - (setq end (region-end) - what "region") - (goto-char (region-beginning)) - (if (not (org-on-heading-p)) (outline-next-heading)) - (setq start (point))) - ((org-at-item-p) - ;; we will sort this plain list - (org-beginning-of-item-list) (setq start (point)) - (org-end-of-item-list) (setq end (point)) - (goto-char start) - (setq plain-list-p t - what "plain list")) - ((or (org-on-heading-p) - (condition-case nil (progn (org-back-to-heading) t) (error nil))) - ;; we will sort the children of the current headline - (org-back-to-heading) - (setq start (point) end (org-end-of-subtree) what "children") - (goto-char start) - (show-subtree) - (outline-next-heading)) - (t - ;; we will sort the top-level entries in this file - (goto-char (point-min)) - (or (org-on-heading-p) (outline-next-heading)) - (setq start (point) end (point-max) what "top-level") - (goto-char start) - (show-all))) - - (setq beg (point)) - (if (>= beg end) (error "Nothing to sort")) - - (unless plain-list-p - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry"))) - - (unless sorting-type - (message - (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty [f]unc A/N/T/P/F means reversed:") - what) - (setq sorting-type (read-char-exclusive)) - - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (completing-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func))) - - (and (= (downcase sorting-type) ?r) - (setq property - (completing-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) - - (message "Sorting entries...") - - (save-restriction - (narrow-to-region start end) - - (let ((dcst (downcase sorting-type)) - (now (current-time))) - (sort-subr - (/= dcst sorting-type) - ;; This function moves to the beginning character of the "record" to - ;; be sorted. - (if plain-list-p - (lambda nil - (if (org-at-item-p) t (goto-char (point-max)))) - (lambda nil - (if (re-search-forward re nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))))) - ;; This function moves to the last character of the "record" being - ;; sorted. - (if plain-list-p - 'org-end-of-item - (lambda nil - (save-match-data - (condition-case nil - (outline-forward-same-level 1) - (error - (goto-char (point-max))))))) - - ;; This function returns the value that gets sorted against. - (if plain-list-p - (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (point-at-eol) t) - (org-time-string-to-time (match-string 0)) - now)) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at outline-regexp) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol))) - nil)) - ((= dcst ?a) - (funcall case-func (buffer-substring (point-at-bol) - (point-at-eol)))) - ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (save-excursion - (forward-line 2) - (point)) t) - (org-time-string-to-time (match-string 0)) - now)) - ((= dcst ?p) - (if (re-search-forward org-priority-regexp (point-at-eol) t) - (string-to-char (match-string 2)) - org-default-priority)) - ((= dcst ?r) - (or (org-entry-get nil property) "")) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - nil - (cond - ((= dcst ?a) 'string<) - ((= dcst ?t) 'time-less-p) - (t nil))))) - (message "Sorting entries...done"))) - -(defun org-do-sort (table what &optional with-case sorting-type) - "Sort TABLE of WHAT according to SORTING-TYPE. -The user will be prompted for the SORTING-TYPE if the call to this -function does not specify it. WHAT is only for the prompt, to indicate -what is being sorted. The sorting key will be extracted from -the car of the elements of the table. -If WITH-CASE is non-nil, the sorting will be case-sensitive." - (unless sorting-type - (message - "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:" - what) - (setq sorting-type (read-char-exclusive))) - (let ((dcst (downcase sorting-type)) - extractfun comparefun) - ;; Define the appropriate functions - (cond - ((= dcst ?n) - (setq extractfun 'string-to-number - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?a) - (setq extractfun (if with-case 'identity 'downcase) - comparefun (if (= dcst sorting-type) - 'string< - (lambda (a b) (and (not (string< a b)) - (not (string= a b))))))) - ((= dcst ?t) - (setq extractfun - (lambda (x) - (if (string-match org-ts-regexp x) - (time-to-seconds - (org-time-string-to-time (match-string 0 x))) - 0)) - comparefun (if (= dcst sorting-type) '< '>))) - (t (error "Invalid sorting type `%c'" sorting-type))) - - (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) - table) - (lambda (a b) (funcall comparefun (car a) (car b)))))) - -;;;; Plain list items, including checkboxes - -;;; Plain list items - -(defun org-at-item-p () - "Is point in a line starting a hand-formatted item?" - (let ((llt org-plain-list-ordered-item-terminator)) - (save-excursion - (goto-char (point-at-bol)) - (looking-at - (cond - ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) - -(defun org-in-item-p () - "It the cursor inside a plain list item. -Does not have to be the first line." - (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - t) - (error nil)))) - -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -Return t when things worked, nil when we are not in an item." - (when (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - (if (org-invisible-p) (error "Invisible item")) - t) - (error nil))) - (let* ((bul (match-string 0)) - (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") - (match-end 0))) - (blank (cdr (assq 'plain-list-item org-blank-before-new-entry))) - pos) - (cond - ((and (org-at-item-p) (<= (point) eow)) - ;; before the bullet - (beginning-of-line 1) - (open-line (if blank 2 1))) - ((<= (point) eow) - (beginning-of-line 1)) - (t (newline (if blank 2 1)))) - (insert bul (if checkbox "[ ]" "")) - (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) - (org-maybe-renumber-ordered-list) - (and checkbox (org-update-checkbox-count-maybe)) - t)) - -;;; Checkboxes - -(defun org-at-item-checkbox-p () - "Is point at a line starting a plain-list item with a checklet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\[[- X]\\]")))) - -(defun org-toggle-checkbox (&optional arg) - "Toggle the checkbox in the current line." - (interactive "P") - (catch 'exit - (let (beg end status (firstnew 'unknown)) - (cond - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - ((org-on-heading-p) - (setq beg (point) end (save-excursion (outline-next-heading) (point)))) - ((org-at-item-checkbox-p) - (let ((pos (point))) - (replace-match - (cond (arg "[-]") - ((member (match-string 0) '("[ ]" "[-]")) "[X]") - (t "[ ]")) - t t) - (goto-char pos)) - (throw 'exit t)) - (t (error "Not at a checkbox or heading, and no active region"))) - (save-excursion - (goto-char beg) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (setq status (equal (match-string 0) "[X]")) - (when (eq firstnew 'unknown) - (setq firstnew (not status))) - (replace-match - (if (if arg (not status) firstnew) "[X]" "[ ]") t t)) - (beginning-of-line 2))))) - (org-update-checkbox-count-maybe)) - -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when org-provide-checkbox-statistics - (org-update-checkbox-count))) - -(defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and update them -with the current numbers. With optional prefix argument ALL, do this for -the whole buffer." - (interactive "P") - (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (outline-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - b1 e1 f1 c-on c-off lim (cstat 0)) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char beg) - (while (re-search-forward re end t) - (setq cstat (1+ cstat) - b1 (match-beginning 0) - e1 (match-end 0) - f1 (match-beginning 1) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 c-off 0) - (goto-char e1) - (when lim - (while (re-search-forward re-box lim t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) -; (delete-region b1 e1) - (goto-char b1) - (insert (if f1 - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (and (looking-at "\\[.*?\\]") - (replace-match "")))) - (when (interactive-p) - (message "Checkbox satistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) - -(defun org-get-checkbox-statistics-face () - "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. Otherwise -it will be `org-todo'." - (if (match-end 1) - (if (equal (match-string 1) "100%") 'org-done 'org-todo) - (if (and (> (match-end 2) (match-beginning 2)) - (equal (match-string 2) (match-string 3))) - 'org-done - 'org-todo))) - -(defun org-get-indentation (&optional line) - "Get the indentation of the current line, interpreting tabs. -When LINE is given, assume it represents a line and compute its indentation." - (if line - (if (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (current-column)))) - -(defun org-remove-tabs (s &optional width) - "Replace tabulators in S with spaces. -Assumes that s is a single line, starting in column 0." - (setq width (or width tab-width)) - (while (string-match "\t" s) - (setq s (replace-match - (make-string - (- (* width (/ (+ (match-beginning 0) width) width)) - (match-beginning 0)) ?\ ) - t t s))) - s) - -(defun org-fix-indentation (line ind) - "Fix indentation in LINE. -IND is a cons cell with target and minimum indentation. -If the current indenation in LINE is smaller than the minimum, -leave it alone. If it is larger than ind, set it to the target." - (let* ((l (org-remove-tabs line)) - (i (org-get-indentation l)) - (i1 (car ind)) (i2 (cdr ind))) - (if (>= i i2) (setq l (substring line i2))) - (if (> i1 0) - (concat (make-string i1 ?\ ) l) - l))) - -(defcustom org-empty-line-terminates-plain-lists nil - "Non-nil means, an empty line ends all plain list levels. -When nil, empty lines are part of the preceeding item." - :group 'org-plain-lists - :type 'boolean) - -(defun org-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let ((pos (point)) - (limit (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (beginning-of-line 2) (point)) - (error (point-min))))) - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - ind ind1) - (if (org-at-item-p) - (beginning-of-line 1) - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq ind (current-column)) - (if (catch 'exit - (while t - (beginning-of-line 0) - (if (or (bobp) (< (point) limit)) (throw 'exit nil)) - - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (< ind1 ind) - (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) - nil - (goto-char pos) - (error "Not in an item"))))) - -(defun org-end-of-item () - "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let* ((pos (point)) - ind1 - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - (limit (save-excursion (outline-next-heading) (point))) - (ind (save-excursion - (org-beginning-of-item) - (skip-chars-forward " \t") - (current-column))) - (end (catch 'exit - (while t - (beginning-of-line 2) - (if (eobp) (throw 'exit (point))) - (if (>= (point) limit) (throw 'exit (point-at-bol))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (<= ind1 ind) - (throw 'exit (point-at-bol))))))) - (if end - (goto-char end) - (goto-char pos) - (error "Not in an item")))) - -(defun org-next-item () - "Move to the beginning of the next item in the current plain list. -Error if not at a plain list, or if this is the last item in the list." - (interactive) - (let (ind ind1 (pos (point))) - (org-beginning-of-item) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq ind1 (org-get-indentation)) - (unless (and (org-at-item-p) (= ind ind1)) - (goto-char pos) - (error "On last item")))) - -(defun org-previous-item () - "Move to the beginning of the previous item in the current plain list. -Error if not at a plain list, or if this is the first item in the list." - (interactive) - (let (beg ind ind1 (pos (point))) - (org-beginning-of-item) - (setq beg (point)) - (setq ind (org-get-indentation)) - (goto-char beg) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - nil - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (if (or (not (org-at-item-p)) - (< ind1 (1- ind))) - (error "") - (org-beginning-of-item)) - (error (goto-char pos) - (error "On first item"))))) - -(defun org-move-item-down () - "Move the plain list item at point down, i.e. swap with following item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive) - (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg) - (org-beginning-of-item) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq end0 (point)) - (setq ind1 (org-get-indentation)) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (org-first-list-item-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - (goto-char end0) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (org-end-of-item) - (org-back-over-empty-lines) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (goto-char pos) (org-skip-whitespace) - (org-maybe-renumber-ordered-list)) - (goto-char pos) - (error "Cannot move this item further down")))) - -(defun org-move-item-up (arg) - "Move the plain list item at point up, i.e. swap with previous item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive "p") - (let (beg beg0 end end0 ind ind1 (pos (point)) txt - ne-beg ne-end ne-ins ins-end) - (org-beginning-of-item) - (setq beg0 (point)) - (setq ind (org-get-indentation)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (org-end-of-item) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (if org-empty-line-terminates-plain-lists - (progn - (goto-char pos) - (error "Cannot move this item further up")) - nil) - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (org-beginning-of-item) - (error (goto-char beg) - (error "Cannot move this item further up"))) - (setq ind1 (org-get-indentation)) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (setq ne-ins (org-back-over-empty-lines)) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (setq ins-end (point)) - (goto-char pos) (org-skip-whitespace) - - (when (and (org-first-list-item-p) (> ne-ins ne-beg)) - ;; Move whitespace back to beginning - (save-excursion - (goto-char ins-end) - (let ((kill-whole-line t)) - (kill-line (- ne-ins ne-beg)) (point))) - (insert (make-string (- ne-ins ne-beg) ?\n))) - - (org-maybe-renumber-ordered-list)) - (goto-char pos) - (error "Cannot move this item further up")))) - -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." - (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) - -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) - -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: - - `-' -> `+' -> `*' -> `1.' -> `1)' - -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 meand `-', 1 means `+' etc." - (interactive "P") - (org-preserve-lc - (org-beginning-of-item-list) - (org-at-item-p) - (beginning-of-line 1) - (let ((current (match-string 0)) - (prevp (eq which 'previous)) - new) - (setq new (cond - ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) (if prevp "*" "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) - (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) - -(defun org-get-string-indentation (s) - "What indentation has S due to SPACE and TAB at the beginning of the string?" - (let ((n -1) (i 0) (w tab-width) c) - (catch 'exit - (while (< (setq n (1+ n)) (length s)) - (setq c (aref s n)) - (cond ((= c ?\ ) (setq i (1+ i))) - ((= c ?\t) (setq i (* (/ (+ w i) w) w))) - (t (throw 'exit t))))) - i)) - -(defun org-renumber-ordered-list (arg) - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\"." - (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (org-get-string-indentation - (buffer-substring (point-at-bol) (match-beginning 3)))) - ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg)) - fmt) - ;; find where this list begins - (org-beginning-of-item-list) - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (match-string 1))) - (beginning-of-line 0) - ;; walk forward and replace these numbers - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert (format fmt (setq n (1+ n))))))) - (goto-line line) - (move-to-column col))) - -(defun org-fix-bullet-type () - "Make sure all items in this list have the same bullet as the firsst item." - (interactive) - (unless (org-at-item-p) (error "This is not a list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (current-indentation)) - ind1 bullet) - ;; find where this list begins - (org-beginning-of-item-list) - (beginning-of-line 1) - ;; find out what the bullet type is - (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (match-string 1)) - ;; walk forward and replace these numbers - (beginning-of-line 0) - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (skip-chars-forward " \t") - (looking-at "\\S-+") - (replace-match bullet)))) - (goto-line line) - (move-to-column col) - (if (string-match "[0-9]" bullet) - (org-renumber-ordered-list 1)))) - -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (throw (if (bobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (bobp)) - (throw 'exit t) - (when (org-at-item-p) (setq pos (point-at-bol))))))) - (goto-char pos))) - - -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (looking-at "[ \t]*$") - (throw (if (eobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (eobp)) - (progn - (setq pos (point-at-bol)) - (throw 'exit t)))))) - (goto-char pos))) - - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) - -(defun org-outdent-item (arg) - "Outdent a local list item." - (interactive "p") - (org-indent-item (- arg))) - -(defun org-indent-item (arg) - "Indent a local list item." - (interactive "p") - (unless (org-at-item-p) - (error "Not on an item")) - (save-excursion - (let (beg end ind ind1 tmp delta ind-down ind-up) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) - (setq end (move-marker org-last-indent-end-marker (point)))) - (goto-char beg) - (setq tmp (org-item-indent-positions) - ind (car tmp) - ind-down (nth 2 tmp) - ind-up (nth 1 tmp) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (indent-to-column (+ ind1 delta))) - (beginning-of-line 2)))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe))) - -(defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should habe. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - ind-down ind-up pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (setq ind-up (org-get-indentation)))) - (setq pos (point)) - (save-excursion - (cond - ((and (condition-case nil (progn (org-previous-item) t) - (error nil)) - (or (forward-char 1) t) - (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column))))) - (list ind ind-up ind-down))) - -;;; The orgstruct minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode structure editing commands. - -;; This is really a hack, because the org-mode structure commands use -;; keys which normally belong to the major mode. Here is how it -;; works: The minor mode defines all the keys necessary to operate the -;; structure commands, but wraps the commands into a function which -;; tests if the cursor is currently at a headline or a plain list -;; item. If that is the case, the structure command is used, -;; temporarily setting many Org-mode variables like regular -;; expressions for filling etc. However, when any of those keys is -;; used at a different location, function uses `key-binding' to look -;; up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that -;; command. There might be problems if any of the keys is otherwise -;; used as a prefix key. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -(defvar orgstruct-mode-map (make-sparse-keymap) - "Keymap for the minor `orgstruct-mode'.") - -(defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'") - -;;;###autoload -(define-minor-mode orgstruct-mode - "Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). - -M-up Move entry/item up -M-down Move entry/item down -M-left Promote -M-right Demote -M-S-up Move entry/item up -M-S-down Move entry/item down -M-S-left Promote subtree -M-S-right Demote subtree -M-q Fill paragraph and items like in Org-mode -C-c ^ Sort entries -C-c - Cycle list bullet -TAB Cycle item visibility -M-RET Insert new heading/item -S-M-RET Insert new TODO heading / Chekbox item -C-c C-c Set tags / toggle checkbox" - nil " OrgStruct" nil - (and (orgstruct-setup) (defun orgstruct-setup () nil))) - -;;;###autoload -(defun turn-on-orgstruct () - "Unconditionally turn on `orgstruct-mode'." - (orgstruct-mode 1)) - -;;;###autoload -(defun turn-on-orgstruct++ () - "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. -In addition to setting orgstruct-mode, this also exports all indentation and -autofilling variables from org-mode into the buffer. Note that turning -off orgstruct-mode will *not* remove these additonal settings." - (orgstruct-mode 1) - (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars))) - -(defun orgstruct-error () - "Error when there is no default binding for a structure key." - (interactive) - (error "This key is has no function outside structure elements")) - -(defun orgstruct-setup () - "Setup orgstruct keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta up)] org-metaup) - '([(meta down)] org-metadown) - '([(meta left)] org-metaleft) - '([(meta right)] org-metaright) - '([(meta shift up)] org-shiftmetaup) - '([(meta shift down)] org-shiftmetadown) - '([(meta shift left)] org-shiftmetaleft) - '([(meta shift right)] org-shiftmetaright) - '([(shift up)] org-shiftup) - '([(shift down)] org-shiftdown) - '("\C-c\C-c" org-ctrl-c-ctrl-c) - '("\M-q" fill-paragraph) - '("\C-c^" org-sort) - '("\C-c-" org-cycle-list-bullet))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgstruct-make-binding fun nfunc key)) - (org-defkey orgstruct-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgstruct-mode-map [(tab)] - (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) - (org-defkey orgstruct-mode-map "\C-i" - (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) - - (org-defkey orgstruct-mode-map "\M-\C-m" - (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgstruct-mode-map [(meta return)] - (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map [(shift meta return)] - (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) - - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - - t)) - -(defun orgstruct-make-binding (fun n &rest keys) - "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-context-p 'headline 'item) - (list 'org-run-like-in-org-mode (list 'quote fun)) - (list 'let '(orgstruct-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgstruct-error)))))))) - -(defun org-context-p (&rest contexts) - "Check if local context is and of CONTEXTS. -Possible values in the list of contexts are `table', `headline', and `item'." - (let ((pos (point))) - (goto-char (point-at-bol)) - (prog1 (or (and (memq 'table contexts) - (looking-at "[ \t]*|")) - (and (memq 'headline contexts) - (looking-at "\\*+")) - (and (memq 'item contexts) - (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) - (goto-char pos)))) - -(defun org-get-local-variables () - "Return a list of all local variables in an org-mode buffer." - (let (varlist) - (with-current-buffer (get-buffer-create "*Org tmp*") - (erase-buffer) - (org-mode) - (setq varlist (buffer-local-variables))) - (kill-buffer "*Org tmp*") - (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (list 'quote (cdr x))))) - (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - x nil)) - varlist)))) - -;;;###autoload -(defun org-run-like-in-org-mode (cmd) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (eval (list 'let org-local-vars - (list 'call-interactively (list 'quote cmd))))) - -;;;; Archiving - -(defalias 'org-advertized-archive-subtree 'org-archive-subtree) - -(defun org-archive-subtree (&optional find-done) - "Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -If the cursor is not at a headline when this comand is called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading." - (interactive "P") - (if find-done - (org-archive-all-done) - ;; Save all relevant TODO keyword-relatex variables - - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords-1 org-todo-keywords-1) - (tr-org-todo-kwd-alist org-todo-kwd-alist) - (tr-org-done-keywords org-done-keywords) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (tr-org-odd-levels-only org-odd-levels-only) - (this-buffer (current-buffer)) - (org-archive-location org-archive-location) - (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") - ;; start of variables that will be used for saving context - ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name (buffer-file-name))) - (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) - afile heading buffer level newfile-p - category todo priority - ;; start of variables that will be used for savind context - ltags itags prop) - - ;; Try to find a local archive location - (save-excursion - (save-restriction - (widen) - (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) - (if (and prop (string-match "\\S-" prop)) - (setq org-archive-location prop) - (if (or (re-search-backward re nil t) - (re-search-forward re nil t)) - (setq org-archive-location (match-string 1)))))) - - (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) - (progn - (setq afile (format (match-string 1 org-archive-location) - (file-name-nondirectory buffer-file-name)) - heading (match-string 2 org-archive-location))) - (error "Invalid `org-archive-location'")) - (if (> (length afile) 0) - (setq newfile-p (not (file-exists-p afile)) - buffer (find-file-noselect afile)) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" afile)) - (if (and (> (length heading) 0) - (string-match "^\\*+" heading)) - (setq level (match-end 0)) - (setq heading nil level 0)) - (save-excursion - (org-back-to-heading t) - ;; Get context information that will be lost by moving the tree - (org-refresh-category-properties) - (setq category (org-get-category) - todo (and (looking-at org-todo-line-regexp) - (match-string 2)) - priority (org-get-priority (if (match-end 3) (match-string 3) "")) - ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at))) - (setq ltags (mapconcat 'identity ltags " ") - itags (mapconcat 'identity itags " ")) - ;; We first only copy, in case something goes wrong - ;; we need to protect this-command, to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (org-mode-p)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t) - (org-inhibit-startup t)) - (call-interactively 'org-mode))) - (when newfile-p - (goto-char (point-max)) - (insert (format "\nArchived entries from file %s\n\n" - (buffer-file-name this-buffer)))) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords-1 tr-org-todo-keywords-1) - (org-todo-kwd-alist tr-org-todo-kwd-alist) - (org-done-keywords tr-org-done-keywords) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp) - (org-odd-levels-only - (if (local-variable-p 'org-odd-levels-only (current-buffer)) - org-odd-levels-only - tr-org-odd-levels-only))) - (goto-char (point-min)) - (if heading - (progn - (if (re-search-forward - (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "\n" heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (show-subtree) - (org-end-of-subtree t) - (skip-chars-backward " \t\r\n") - (and (looking-at "[ \t\r\n]*") - (replace-match "\n\n"))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (insert "\n")) - ;; Paste - (org-paste-subtree (org-get-legal-level level 1)) - - ;; Mark the entry as done - (when (and org-archive-mark-done - (looking-at org-todo-line-regexp) - (or (not (match-end 2)) - (not (member (match-string 2) org-done-keywords)))) - (let (org-log-done) - (org-todo - (car (or (member org-archive-mark-done org-done-keywords) - org-done-keywords))))) - - ;; Add the context info - (when org-archive-save-context-info - (let ((l org-archive-save-context-info) e n v) - (while (setq e (pop l)) - (when (and (setq v (symbol-value e)) - (stringp v) (string-match "\\S-" v)) - (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) - (org-entry-put (point) n v))))) - - ;; Save the buffer, if it is not the same buffer. - (if (not (eq this-buffer buffer)) (save-buffer)))) - ;; Here we are back in the original buffer. Everything seems to have - ;; worked. So now cut the tree and finish up. - (let (this-command) (org-cut-subtree)) - (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) - (message "Subtree archived %s" - (if (eq this-buffer buffer) - (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name afile))))))) - -(defun org-refresh-category-properties () - "Refresh category text properties in teh buffer." - (let ((def-cat (cond - ((null org-category) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - "???")) - ((symbolp org-category) (symbol-name org-category)) - (t org-category))) - beg end cat pos optionp) - (org-unmodified - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (put-text-property (point) (point-max) 'org-category def-cat) - (while (re-search-forward - "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) - (setq pos (match-end 0) - optionp (equal (char-after (match-beginning 0)) ?#) - cat (org-trim (match-string 2))) - (if optionp - (setq beg (point-at-bol) end (point-max)) - (org-back-to-heading t) - (setq beg (point) end (org-end-of-subtree t t))) - (put-text-property beg end 'org-category cat) - (goto-char pos))))))) - -(defun org-archive-all-done (&optional tag) - "Archive sublevels of the current tree without open TODO items. -If the cursor is not on a headline, try all level 1 trees. If -it is on a headline, try all direct children. -When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." - (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 - (rea (concat ".*:" org-archive-tag ":")) - (begm (make-marker)) - (endm (make-marker)) - (question (if tag "Set ARCHIVE tag (no open TODO items)? " - "Move subtree to archive (no open TODO items)? ")) - beg end (cntarch 0)) - (if (org-on-heading-p) - (progn - (setq re1 (concat "^" (regexp-quote - (make-string - (1+ (- (match-end 0) (match-beginning 0))) - ?*)) - " ")) - (move-marker begm (point)) - (move-marker endm (org-end-of-subtree t))) - (setq re1 "^* ") - (move-marker begm (point-min)) - (move-marker endm (point-max))) - (save-excursion - (goto-char begm) - (while (re-search-forward re1 endm t) - (setq beg (match-beginning 0) - end (save-excursion (org-end-of-subtree t) (point))) - (goto-char beg) - (if (re-search-forward re end t) - (goto-char end) - (goto-char beg) - (if (and (or (not tag) (not (looking-at rea))) - (y-or-n-p question)) - (progn - (if tag - (org-toggle-tag org-archive-tag 'on) - (org-archive-subtree)) - (setq cntarch (1+ cntarch))) - (goto-char end))))) - (message "%d trees archived" cntarch))) - -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change." - (when (and (org-mode-p) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (goto-char beg) - (while (re-search-forward org-drawer-regexp end t) - (org-flag-drawer t)))))) - -(defun org-flag-drawer (flag) - (save-excursion - (beginning-of-line 1) - (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) - (if (re-search-forward - "^[ \t]*:END:" - (save-excursion (outline-next-heading) (point)) t) - (outline-flag-region b (point-at-eol) flag) - (error ":END: line missing")))))) - -(defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change." - (when (and (not org-cycle-open-archived-trees) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (org-hide-archived-subtrees beg end) - (goto-char beg) - (if (looking-at (concat ".*:" org-archive-tag ":")) - (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) - -(defun org-force-cycle-archived () - "Cycle subtree even if it is archived." - (interactive) - (setq this-command 'org-cycle) - (let ((org-cycle-open-archived-trees t)) - (call-interactively 'org-cycle))) - -(defun org-hide-archived-subtrees (beg end) - "Re-hide all archived subtrees after a visibility state change." - (save-excursion - (let* ((re (concat ":" org-archive-tag ":"))) - (goto-char beg) - (while (re-search-forward re end t) - (and (org-on-heading-p) (hide-subtree)) - (org-end-of-subtree t))))) - -(defun org-toggle-tag (tag &optional onoff) - "Toggle the tag TAG for the current line. -If ONOFF is `on' or `off', don't toggle but set to this state." - (unless (org-on-heading-p t) (error "Not on headling")) - (let (res current) - (save-excursion - (beginning-of-line) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") - (point-at-eol) t) - (progn - (setq current (match-string 1)) - (replace-match "")) - (setq current "")) - (setq current (nreverse (org-split-string current ":"))) - (cond - ((eq onoff 'on) - (setq res t) - (or (member tag current) (push tag current))) - ((eq onoff 'off) - (or (not (member tag current)) (setq current (delete tag current)))) - (t (if (member tag current) - (setq current (delete tag current)) - (setq res t) - (push tag current)))) - (end-of-line 1) - (if current - (progn - (insert " :" (mapconcat 'identity (nreverse current) ":") ":") - (org-set-tags nil t)) - (delete-horizontal-space)) - (run-hooks 'org-after-tags-change-hook)) - res)) - -(defun org-toggle-archive-tag (&optional arg) - "Toggle the archive tag for the current headline. -With prefix ARG, check all children of current headline and offer tagging -the children that do not contain any open TODO items." - (interactive "P") - (if arg - (org-archive-all-done 'tag) - (let (set) - (save-excursion - (org-back-to-heading t) - (setq set (org-toggle-tag org-archive-tag)) - (when set (hide-subtree))) - (and set (beginning-of-line 1)) - (message "Subtree %s" (if set "archived" "unarchived"))))) - - -;;;; Tables - -;;; The table editor - -;; Watch out: Here we are talking about two different kind of tables. -;; Most of the code is for the tables created with the Org-mode table editor. -;; Sometimes, we talk about tables created and edited with the table.el -;; Emacs package. We call the former org-type tables, and the latter -;; table.el-type tables. - -(defun org-before-change-function (beg end) - "Every change indicates that a table might need an update." - (setq org-table-may-need-update t)) - -(defconst org-table-line-regexp "^[ \t]*|" - "Detects an org-type table line.") -(defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detects an org-type table line.") -(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-hline-regexp "^[ \t]*|-" - "Detects an org-type table hline.") -(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detects a table-type table hline.") -(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detects an org-type or table-type table.") -(defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") -(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") - -(defvar org-table-last-highlighted-reference nil) -(defvar org-table-formula-history nil) - -(defvar org-table-column-names nil - "Alist with column names, derived from the `!' line.") -(defvar org-table-column-name-regexp nil - "Regular expression matching the current column names.") -(defvar org-table-local-parameters nil - "Alist with parameter names, derived from the `$' line.") -(defvar org-table-named-field-locations nil - "Alist with locations of named fields.") - -(defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a comand.") -(defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a comand.") -(defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a comand.") -(defvar org-table-dlines nil - "Vector of data line line numbers in the current table.") -(defvar org-table-hlines nil - "Vector of hline line numbers in the current table.") - -(defconst org-table-range-regexp - "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" - ;; 1 2 3 4 5 - "Regular expression for matching ranges in formulas.") - -(defconst org-table-range-regexp2 - (concat - "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" - "\\.\\." - "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") - "Match a range for reference display.") - -(defconst org-table-translate-regexp - (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") - "Match a reference that needs translation, for reference display.") - -(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param - -(defun org-table-create-with-table.el () - "Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables -and table.el tables." - (interactive) - (require 'table) - (cond - ((org-at-table.el-p) - (if (y-or-n-p "Convert table to Org-mode table? ") - (org-table-convert))) - ((org-at-table-p) - (if (y-or-n-p "Convert table to table.el table? ") - (org-table-convert))) - (t (call-interactively 'table-insert)))) - -(defun org-table-create-or-convert-from-region (arg) - "Convert region to table, or create an empty table. -If there is an active region, convert it to a table, using the function -`org-table-convert-region'. See the documentation of that function -to learn how the prefix argument is interpreted to determine the field -separator. -If there is no such region, create an empty table with `org-table-create'." - (interactive "P") - (if (org-region-active-p) - (org-table-convert-region (region-beginning) (region-end) arg) - (org-table-create arg))) - -(defun org-table-create (&optional size) - "Query for a size and insert a table skeleton. -SIZE is a string Columns x Rows like for example \"3x2\"." - (interactive "P") - (unless size - (setq size (read-string - (concat "Table size Columns x Rows [e.g. " - org-table-default-size "]: ") - "" nil org-table-default-size))) - - (let* ((pos (point)) - (indent (make-string (current-column) ?\ )) - (split (org-split-string size " *x *")) - (rows (string-to-number (nth 1 split))) - (columns (string-to-number (car split))) - (line (concat (apply 'concat indent "|" (make-list columns " |")) - "\n"))) - (if (string-match "^[ \t]*$" (buffer-substring-no-properties - (point-at-bol) (point))) - (beginning-of-line 1) - (newline)) - ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) - (dotimes (i rows) (insert line)) - (goto-char pos) - (if (> rows 1) - ;; Insert a hline after the first row. - (progn - (end-of-line 1) - (insert "\n|-") - (goto-char pos))) - (org-table-align))) - -(defun org-table-convert-region (beg0 end0 &optional separator) - "Convert region to a table. -The region goes from BEG0 to END0, but these borders will be moved -slightly, to make sure a beginning of line in the first line is included. - -SEPARATOR specifies the field separator in the lines. It can have the -following values: - -'(4) Use the comma as a field separator -'(16) Use a TAB as field separator -integer When a number, use that many spaces as field separator -nil When nil, the command tries to be smart and figure out the - separator in the following way: - - when each line contains a TAB, assume TAB-separated material - - when each line contains a comme, assume CSV material - - else, assume one or more SPACE charcters as separator." - (interactive "rP") - (let* ((beg (min beg0 end0)) - (end (max beg0 end0)) - re) - (goto-char beg) - (beginning-of-line 1) - (setq beg (move-marker (make-marker) (point))) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (move-marker (make-marker) (point))) - ;; Get the right field separator - (unless separator - (goto-char beg) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (setq re (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (format "^ *\\| *\t *\\| \\{%d,\\}" separator)) - (t (error "This should not happen")))) - (goto-char beg) - (while (re-search-forward re end t) - (replace-match "| " t t)) - (goto-char beg) - (insert " ") - (org-table-align))) - -(defun org-table-import (file arg) - "Import FILE as a table. -The file is assumed to be tab-separated. Such files can be produced by most -spreadsheet and database applications. If no tabs (at least one per line) -are found, lines will be split on whitespace into fields." - (interactive "f\nP") - (or (bolp) (newline)) - (let ((beg (point)) - (pm (point-max))) - (insert-file-contents file) - (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) - -(defun org-table-export () - "Export table as a tab-separated file. -Such a file can be imported into a spreadsheet program like Excel." - (interactive) - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (table (buffer-substring beg end)) - (file (read-file-name "Export table to: ")) - buf) - (unless (or (not (file-exists-p file)) - (y-or-n-p (format "Overwrite file %s? " file))) - (error "Abort")) - (with-current-buffer (find-file-noselect file) - (setq buf (current-buffer)) - (erase-buffer) - (fundamental-mode) - (insert table) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*|[ \t]*" nil t) - (replace-match "" t t) - (end-of-line 1)) - (goto-char (point-min)) - (while (re-search-forward "[ \t]*|[ \t]*$" nil t) - (replace-match "" t t) - (goto-char (min (1+ (point)) (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "^-[-+]*$" nil t) - (replace-match "") - (if (looking-at "\n") - (delete-char 1))) - (goto-char (point-min)) - (while (re-search-forward "[ \t]*|[ \t]*" nil t) - (replace-match "\t" t t)) - (save-buffer)) - (kill-buffer buf))) - -(defvar org-table-aligned-begin-marker (make-marker) - "Marker at the beginning of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-aligned-end-marker (make-marker) - "Marker at the end of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-last-alignment nil - "List of flags for flushright alignment, from the last re-alignment. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-last-column-widths nil - "List of max width of fields in each column. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-overlay-coordinates nil - "Overlay coordinates after each align of a table.") -(make-variable-buffer-local 'org-table-overlay-coordinates) - -(defvar org-last-recalc-line nil) -(defconst org-narrow-column-arrow "=>" - "Used as display property in narrowed table columns.") - -(defun org-table-align () - "Align the table at point by aligning all vertical bars." - (interactive) - (let* ( - ;; Limits of table - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (org-table-current-column)) - (winstart (window-start)) - (winstartline (org-current-line (min winstart (1- (point-max))))) - lines (new "") lengths l typenums ty fields maxfields i - column - (indent "") cnt frac - rfmt hfmt - (spaces '(1 . 1)) - (sp1 (car spaces)) - (sp2 (cdr spaces)) - (rfmt1 (concat - (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) - (hfmt1 (concat - (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph narrow fmax f1 len c e) - (untabify beg end) - (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) - ;; Check if we have links or dates - (goto-char beg) - (setq links (re-search-forward org-bracket-link-regexp end t)) - (goto-char beg) - (setq emph (and org-hide-emphasis-markers - (re-search-forward org-emph-re end t))) - (goto-char beg) - (setq dates (and org-display-custom-times - (re-search-forward org-ts-regexp-both end t))) - ;; Make sure the link properties are right - (when links (goto-char beg) (while (org-activate-bracket-links end))) - ;; Make sure the date properties are right - (when dates (goto-char beg) (while (org-activate-dates end))) - (when emph (goto-char beg) (while (org-do-emphasis-faces end))) - - ;; Check if we are narrowing any columns - (goto-char beg) - (setq narrow (and org-format-transports-properties-p - (re-search-forward "<[0-9]+>" end t))) - ;; Get the rows - (setq lines (org-split-string - (buffer-substring beg end) "\n")) - ;; Store the indentation of the first line - (if (string-match "^ *" (car lines)) - (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - ;; Mark the hlines by setting the corresponding element to nil - ;; At the same time, we remove trailing space. - (setq lines (mapcar (lambda (l) - (if (string-match "^ *|-" l) - nil - (if (string-match "[ \t]+$" l) - (substring l 0 (match-beginning 0)) - l))) - lines)) - ;; Get the data fields by splitting the lines. - (setq fields (mapcar - (lambda (l) - (org-split-string l " *| *")) - (delq nil (copy-sequence lines)))) - ;; How many fields in the longest line? - (condition-case nil - (setq maxfields (apply 'max (mapcar 'length fields))) - (error - (kill-region beg end) - (org-table-create org-table-default-size) - (error "Empty table - created default table"))) - ;; A list of empty strings to fill any short rows on output - (setq emptystrings (make-list maxfields "")) - ;; Check for special formatting. - (setq i -1) - (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns - (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) - ;; Check if there is an explicit width specified - (when narrow - (setq c column fmax nil) - (while c - (setq e (pop c)) - (if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e)) - (setq fmax (string-to-number (match-string 1 e)) c nil))) - ;; Find fields that are wider than fmax, and shorten them - (when fmax - (loop for xx in column do - (when (and (stringp xx) - (> (org-string-width xx) fmax)) - (org-add-props xx nil - 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) - (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) - (unless (> f1 1) - (error "Cannot narrow field starting with wide link \"%s\"" - (match-string 0 xx))) - (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) - (add-text-properties (- f1 2) f1 - (list 'display org-narrow-column-arrow) - xx))))) - ;; Get the maximum width for each column - (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) - ;; Get the fraction of numbers, to decide about alignment of the column - (setq cnt 0 frac 0.0) - (loop for x in column do - (if (equal x "") - nil - (setq frac ( / (+ (* frac cnt) - (if (string-match org-table-number-regexp x) 1 0)) - (setq cnt (1+ cnt)))))) - (push (>= frac org-table-number-fraction) typenums)) - (setq lengths (nreverse lengths) typenums (nreverse typenums)) - - ;; Store the alignment of this table, for later editing of single fields - (setq org-table-last-alignment typenums - org-table-last-column-widths lengths) - - ;; With invisible characters, `format' does not get the field width right - ;; So we need to make these fields wide by hand. - (when (or links emph) - (loop for i from 0 upto (1- maxfields) do - (setq len (nth i lengths)) - (loop for j from 0 upto (1- (length fields)) do - (setq c (nthcdr i (car (nthcdr j fields)))) - (if (and (stringp (car c)) - (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) -; (string-match org-bracket-link-regexp (car c)) - (< (org-string-width (car c)) len)) - (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) - - ;; Compute the formats needed for output of the table - (setq rfmt (concat indent "|") hfmt (concat indent "|")) - (while (setq l (pop lengths)) - (setq ty (if (pop typenums) "" "-")) ; number types flushright - (setq rfmt (concat rfmt (format rfmt1 ty l)) - hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) - (setq rfmt (concat rfmt "\n") - hfmt (concat (substring hfmt 0 -1) "|\n")) - - (setq new (mapconcat - (lambda (l) - (if l (apply 'format rfmt - (append (pop fields) emptystrings)) - hfmt)) - lines "")) - ;; Replace the old one - (delete-region beg end) - (move-marker end nil) - (move-marker org-table-aligned-begin-marker (point)) - (insert new) - (move-marker org-table-aligned-end-marker (point)) - (when (and orgtbl-mode (not (org-mode-p))) - (goto-char org-table-aligned-begin-marker) - (while (org-hide-wide-columns org-table-aligned-end-marker))) - ;; Try to move to the old location - (goto-line winstartline) - (setq winstart (point-at-bol)) - (goto-line linepos) - (set-window-start (selected-window) winstart 'noforce) - (org-table-goto-column colpos) - (and org-table-overlay-coordinates (org-table-overlay-coordinates)) - (setq org-table-may-need-update nil) - )) - -(defun org-string-width (s) - "Compute width of string, ignoring invisible characters. -This ignores character with invisibility property `org-link', and also -characters with property `org-cwidth', because these will become invisible -upon the next fontification round." - (let (b l) - (when (or (eq t buffer-invisibility-spec) - (assq 'org-link buffer-invisibility-spec)) - (while (setq b (text-property-any 0 (length s) - 'invisible 'org-link s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) (length s))))))) - (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'org-cwidth s) (length s)))))) - (setq l (string-width s) b -1) - (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) - (setq l (- l (get-text-property b 'org-dwidth-n s)))) - l)) - -(defun org-table-begin (&optional table-type) - "Find the beginning of the table and return its position. -With argument TABLE-TYPE, go to the beginning of a table.el-type table." - (save-excursion - (if (not (re-search-backward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (progn (goto-char (point-min)) (point)) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (point)))) - -(defun org-table-end (&optional table-type) - "Find the end of the table and return its position. -With argument TABLE-TYPE, go to the end of a table.el-type table." - (save-excursion - (if (not (re-search-forward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (goto-char (point-max)) - (goto-char (match-beginning 0))) - (point-marker))) - -(defun org-table-justify-field-maybe (&optional new) - "Justify the current field, text to left, number to right. -Optional argument NEW may specify text to replace the current field content." - (cond - ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway - ((org-at-table-hline-p)) - ((and (not new) - (or (not (equal (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) - (< (point) org-table-aligned-begin-marker) - (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align - (setq org-table-may-need-update t)) - (t ;; realign the current field, based on previous full realign - (let* ((pos (point)) s - (col (org-table-current-column)) - (num (if (> col 0) (nth (1- col) org-table-last-alignment))) - l f n o e) - (when (> col 0) - (skip-chars-backward "^|\n") - (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") - (progn - (setq s (match-string 1) - o (match-string 0) - l (max 1 (- (match-end 0) (match-beginning 0) 3)) - e (not (= (match-beginning 2) (match-end 2)))) - (setq f (format (if num " %%%ds %s" " %%-%ds %s") - l (if e "|" (setq org-table-may-need-update t) "")) - n (format f s)) - (if new - (if (<= (length new) l) ;; FIXME: length -> str-width? - (setq n (format f new)) - (setq n (concat new "|") org-table-may-need-update t))) - (or (equal n o) - (let (org-table-may-need-update) - (replace-match n t t)))) - (setq org-table-may-need-update t)) - (goto-char pos)))))) - -(defun org-table-next-field () - "Go to the next field in the current table, creating new lines as needed. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((end (org-table-end))) - (if (org-at-table-hline-p) - (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "|" end) - (if (looking-at "[ \t]*$") - (re-search-forward "|" end)) - (if (and (looking-at "-") - org-table-tab-jumps-over-hlines - (re-search-forward "^[ \t]*|\\([^-]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "-") - (progn - (beginning-of-line 0) - (org-table-insert-row 'below)) - (if (looking-at " ") (forward-char 1)))) - (error - (org-table-insert-row 'below))))) - -(defun org-table-previous-field () - "Go to the previous field in the table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-justify-field-maybe) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (if (org-at-table-hline-p) - (end-of-line 1)) - (re-search-backward "|" (org-table-begin)) - (re-search-backward "|" (org-table-begin)) - (while (looking-at "|\\(-\\|[ \t]*$\\)") - (re-search-backward "|" (org-table-begin))) - (if (looking-at "| ?") - (goto-char (match-end 0)))) - -(defun org-table-next-row () - "Go to the next row (same column) in the current table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((col (org-table-current-column))) - (beginning-of-line 2) - (if (or (not (org-at-table-p)) - (org-at-table-hline-p)) - (progn - (beginning-of-line 0) - (org-table-insert-row 'below))) - (org-table-goto-column col) - (skip-chars-backward "^|\n\r") - (if (looking-at " ") (forward-char 1))))) - -(defun org-table-copy-down (n) - "Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of the nearest -non-empty field above. With argument N, use the Nth non-empty field. -If the current field is not empty, it is copied down to the next row, and -the cursor is moved with it. Therefore, repeating this command causes the -column to be filled row-by-row. -If the variable `org-table-copy-increment' is non-nil and the field is an -integer or a timestamp, it will be incremented while copying. In the case of -a timestamp, if the cursor is on the year, change the year. If it is on the -month or the day, change that. Point will stay on the current date field -in order to easily repeat the interval." - (interactive "p") - (let* ((colpos (org-table-current-column)) - (col (current-column)) - (field (org-table-get-field)) - (non-empty (string-match "[^ \t]" field)) - (beg (org-table-begin)) - txt) - (org-table-check-inside-data-field) - (if non-empty - (progn - (setq txt (org-trim field)) - (org-table-next-row) - (org-table-blank-field)) - (save-excursion - (setq txt - (catch 'exit - (while (progn (beginning-of-line 1) - (re-search-backward org-table-dataline-regexp - beg t)) - (org-table-goto-column colpos t) - (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))))) - (if txt - (progn - (if (and org-table-copy-increment - (string-match "^[0-9]+$" txt)) - (setq txt (format "%d" (+ (string-to-number txt) 1)))) - (insert txt) - (move-to-column col) - (if (and org-table-copy-increment (org-at-timestamp-p t)) - (org-timestamp-up 1) - (org-table-maybe-recalculate-line)) - (org-table-align) - (move-to-column col)) - (error "No non-empty field found")))) - -(defun org-table-check-inside-data-field () - "Is point inside a table data field? -I.e. not on a hline or before the first or after the last column? -This actually throws an error, so it aborts the current command." - (if (or (not (org-at-table-p)) - (= (org-table-current-column) 0) - (org-at-table-hline-p) - (looking-at "[ \t]*$")) - (error "Not in table data field"))) - -(defvar org-table-clip nil - "Clipboard for table regions.") - -(defun org-table-blank-field () - "Blank the current table field or active region." - (interactive) - (org-table-check-inside-data-field) - (if (and (interactive-p) (org-region-active-p)) - (let (org-table-clip) - (org-table-cut-region (region-beginning) (region-end))) - (skip-chars-backward "^|") - (backward-char 1) - (if (looking-at "|[^|\n]+") - (let* ((pos (match-beginning 0)) - (match (match-string 0)) - (len (org-string-width match))) - (replace-match (concat "|" (make-string (1- len) ?\ ))) - (goto-char (+ 2 pos)) - (substring match 1))))) - -(defun org-table-get-field (&optional n replace) - "Return the value of the field in column N of current row. -N defaults to current field. -If REPLACE is a string, replace field with this value. The return value -is always the old value." - (and n (org-table-goto-column n)) - (skip-chars-backward "^|\n") - (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (if replace - (replace-match (concat "|" replace) t t)) - (goto-char (min (point-at-eol) (+ 2 pos))) - val) - (forward-char 1) "")) - -(defun org-table-field-info (arg) - "Show info about the current field, and highlight any reference at point." - (interactive "P") - (org-table-get-specials) - (save-excursion - (let* ((pos (point)) - (col (org-table-current-column)) - (cname (car (rassoc (int-to-string col) org-table-column-names))) - (name (car (rassoc (list (org-current-line) col) - org-table-named-field-locations))) - (eql (org-table-get-stored-formulas)) - (dline (org-table-current-dline)) - (ref (format "@%d$%d" dline col)) - (ref1 (org-table-convert-refs-to-an ref)) - (fequation (or (assoc name eql) (assoc ref eql))) - (cequation (assoc (int-to-string col) eql)) - (eqn (or fequation cequation))) - (goto-char pos) - (condition-case nil - (org-table-show-reference 'local) - (error nil)) - (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" - dline col - (if cname (concat " or $" cname) "") - dline col ref1 - (if name (concat " or $" name) "") - ;; FIXME: formula info not correct if special table line - (if eqn - (concat ", formula: " - (org-table-formula-to-user - (concat - (if (string-match "^[$@]"(car eqn)) "" "$") - (car eqn) "=" (cdr eqn)))) - ""))))) - -(defun org-table-current-column () - "Find out which column we are in. -When called interactively, column is also displayed in echo area." - (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (beginning-of-line 1) - (while (search-forward "|" pos t) - (setq cnt (1+ cnt))) - (if (interactive-p) (message "This is table column %d" cnt)) - cnt))) - -(defun org-table-current-dline () - "Find out what table data line we are in. -Only datalins count for this." - (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (goto-char (org-table-begin)) - (while (<= (point) pos) - (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) - (beginning-of-line 2)) - (if (interactive-p) (message "This is table line %d" cnt)) - cnt))) - -(defun org-table-goto-column (n &optional on-delim force) - "Move the cursor to the Nth column in the current table line. -With optional argument ON-DELIM, stop with point before the left delimiter -of the field. -If there are less than N fields, just go to after the last delimiter. -However, when FORCE is non-nil, create new columns if necessary." - (interactive "p") - (let ((pos (point-at-eol))) - (beginning-of-line 1) - (when (> n 0) - (while (and (> (setq n (1- n)) -1) - (or (search-forward "|" pos t) - (and force - (progn (end-of-line 1) - (skip-chars-backward "^|") - (insert " | ")))))) -; (backward-char 2) t))))) - (when (and force (not (looking-at ".*|"))) - (save-excursion (end-of-line 1) (insert " | "))) - (if on-delim - (backward-char 1) - (if (looking-at " ") (forward-char 1)))))) - -(defun org-at-table-p (&optional table-type) - "Return t if the cursor is inside an org-type table. -If TABLE-TYPE is non-nil, also check for table.el-type tables." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at (if table-type org-table-any-line-regexp - org-table-line-regexp))) - nil)) - -(defun org-at-table.el-p () - "Return t if and only if we are at a table.el table." - (and (org-at-table-p 'any) - (save-excursion - (goto-char (org-table-begin 'any)) - (looking-at org-table1-hline-regexp)))) - -(defun org-table-recognize-table.el () - "If there is a table.el table nearby, recognize it and move into it." - (if org-table-tab-recognizes-table.el - (if (org-at-table.el-p) - (progn - (beginning-of-line 1) - (if (looking-at org-table-dataline-regexp) - nil - (if (looking-at org-table1-hline-regexp) - (progn - (beginning-of-line 2) - (if (looking-at org-table-any-border-regexp) - (beginning-of-line -1))))) - (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) - t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) - (error "This should not happen...")) - t) - nil) - nil)) - -(defun org-at-table-hline-p () - "Return t if the cursor is inside a hline in a table." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at org-table-hline-regexp)) - nil)) - -(defun org-table-insert-column () - "Insert a new column into the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (let* ((col (max 1 (org-table-current-column))) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (insert "| ")) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas "$" nil (1- col) 1))) - -(defun org-table-find-dataline () - "Find a dataline in the current table, which is needed for column commands." - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (let ((col (current-column)) - (end (org-table-end))) - (move-to-column col) - (while (and (< (point) end) - (or (not (= (current-column) col)) - (org-at-table-hline-p))) - (beginning-of-line 2) - (move-to-column col)) - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (error - "Please position cursor in a data line for column operations"))))) - -(defun org-table-delete-column () - "Delete a column from the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (and (looking-at "|[^|\n]+|") - (replace-match "|"))) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) - col -1 col))) - -(defun org-table-move-column-right () - "Move column to the right." - (interactive) - (org-table-move-column nil)) -(defun org-table-move-column-left () - "Move column to the left." - (interactive) - (org-table-move-column 'left)) - -(defun org-table-move-column (&optional left) - "Move the current column to the right. With arg LEFT, move to the left." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (col1 (if left (1- col) col)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (if left (1- col) (1+ col)))) - (if (and left (= col 1)) - (error "Cannot move column further left")) - (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (error "Cannot move column further right")) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col1 t) - (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|"))) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas - "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))))) - -(defun org-table-move-row-down () - "Move table row down." - (interactive) - (org-table-move-row nil)) -(defun org-table-move-row-up () - "Move table row up." - (interactive) - (org-table-move-row 'up)) - -(defun org-table-move-row (&optional up) - "Move the current table line down. With arg UP, move it up." - (interactive "P") - (let* ((col (current-column)) - (pos (point)) - (hline1p (save-excursion (beginning-of-line 1) - (looking-at org-table-hline-regexp))) - (dline1 (org-table-current-dline)) - (dline2 (+ dline1 (if up -1 1))) - (tonew (if up 0 2)) - txt hline2p) - (beginning-of-line tonew) - (unless (org-at-table-p) - (goto-char pos) - (error "Cannot move row further")) - (setq hline2p (looking-at org-table-hline-regexp)) - (goto-char pos) - (beginning-of-line 1) - (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (point-at-eol)))) - (delete-region (point) (1+ (point-at-eol))) - (beginning-of-line tonew) - (insert txt) - (beginning-of-line 0) - (move-to-column col) - (unless (or hline1p hline2p) - (org-table-fix-formulas - "@" (list (cons (number-to-string dline1) (number-to-string dline2)) - (cons (number-to-string dline2) (number-to-string dline1))))))) - -(defun org-table-insert-row (&optional arg) - "Insert a new row above the current line into the table. -With prefix ARG, insert below the current line." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) - (new (org-table-clean-line line))) - ;; Fix the first field if necessary - (if (string-match "^[ \t]*| *[#$] *|" line) - (setq new (replace-match (match-string 0 line) t t new))) - (beginning-of-line (if arg 2 1)) - (let (org-table-may-need-update) (insert-before-markers new "\n")) - (beginning-of-line 0) - (re-search-forward "| ?" (point-at-eol) t) - (and (or org-table-may-need-update org-table-overlay-coordinates) - (org-table-align)) - (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) - -(defun org-table-insert-hline (&optional above) - "Insert a horizontal-line below the current line into the table. -With prefix ABOVE, insert above the current line." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (let ((line (org-table-clean-line - (buffer-substring (point-at-bol) (point-at-eol)))) - (col (current-column))) - (while (string-match "|\\( +\\)|" line) - (setq line (replace-match - (concat "+" (make-string (- (match-end 1) (match-beginning 1)) - ?-) "|") t t line))) - (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) - (beginning-of-line (if above 1 2)) - (insert line "\n") - (beginning-of-line (if above 1 -1)) - (move-to-column col) - (and org-table-overlay-coordinates (org-table-align)))) - -(defun org-table-hline-and-move (&optional same-column) - "Insert a hline and move to the row below that line." - (interactive "P") - (let ((col (org-table-current-column))) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (org-table-insert-hline) - (end-of-line 2) - (if (looking-at "\n[ \t]*|-") - (progn (insert "\n|") (org-table-align)) - (org-table-next-field)) - (if same-column (org-table-goto-column col)))) - -(defun org-table-clean-line (s) - "Convert a table line S into a string with only \"|\" and space. -In particular, this does handle wide and invisible characters." - (if (string-match "^[ \t]*|-" s) - ;; It's a hline, just map the characters - (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) - (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) - (setq s (replace-match - (concat "|" (make-string (org-string-width (match-string 1 s)) - ?\ ) "|") - t t s))) - s)) - -(defun org-table-kill-row () - "Delete the current row or horizontal line from the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (let ((col (current-column)) - (dline (org-table-current-dline))) - (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) - (if (not (org-at-table-p)) (beginning-of-line 0)) - (move-to-column col) - (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) - dline -1 dline))) - -(defun org-table-sort-lines (with-case &optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, you will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically, numerically, or by time (as given in a time stamp -in the field). Sorting in reverse order is also possible. - -With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. - -If SORTING-TYPE is specified when this function is called from a Lisp -program, no prompting will take place. SORTING-TYPE must be a character, -any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting -should be done in reverse order." - (interactive "P") - (let* ((thisline (org-current-line)) - (thiscol (org-table-current-column)) - beg end bcol ecol tend tbeg column lns pos) - (when (equal thiscol 0) - (if (interactive-p) - (setq thiscol - (string-to-number - (read-string "Use column N for sorting: "))) - (setq thiscol 1)) - (org-table-goto-column thiscol)) - (org-table-check-inside-data-field) - (if (org-region-active-p) - (progn - (setq beg (region-beginning) end (region-end)) - (goto-char beg) - (setq column (org-table-current-column) - beg (point-at-bol)) - (goto-char end) - (setq end (point-at-bol 2))) - (setq column (org-table-current-column) - pos (point) - tbeg (org-table-begin) - tend (org-table-end)) - (if (re-search-backward org-table-hline-regexp tbeg t) - (setq beg (point-at-bol 2)) - (goto-char tbeg) - (setq beg (point-at-bol 1))) - (goto-char pos) - (if (re-search-forward org-table-hline-regexp tend t) - (setq end (point-at-bol 1)) - (goto-char tend) - (setq end (point-at-bol)))) - (setq beg (move-marker (make-marker) beg) - end (move-marker (make-marker) end)) - (untabify beg end) - (goto-char beg) - (org-table-goto-column column) - (skip-chars-backward "^|") - (setq bcol (current-column)) - (org-table-goto-column (1+ column)) - (skip-chars-backward "^|") - (setq ecol (1- (current-column))) - (org-table-goto-column column) - (setq lns (mapcar (lambda(x) (cons (org-sort-remove-invisible - (org-trim (substring x bcol ecol))) x)) - (org-split-string (buffer-substring beg end) "\n"))) - (setq lns (org-do-sort lns "Table" with-case sorting-type)) - (delete-region beg end) - (move-marker beg nil) - (move-marker end nil) - (insert (mapconcat 'cdr lns "\n") "\n") - (goto-line thisline) - (org-table-goto-column thiscol) - (message "%d lines sorted, based on column %d" (length lns) column))) - -;; FIXME: maybe we will not need this? Table sorting is broken.... -(defun org-sort-remove-invisible (s) - (remove-text-properties 0 (length s) org-rm-props s) - (if (string-match org-bracket-link-regexp s) - (setq s (replace-match (if (match-end 2) (match-string 3 s) - (match-string 1 s))))) - s) - -(defun org-table-cut-region (beg end) - "Copy region in table to the clipboard and blank all relevant fields." - (interactive "r") - (org-table-copy-region beg end 'cut)) - -(defun org-table-copy-region (beg end &optional cut) - "Copy rectangular region in table to clipboard. -A special clipboard is used which can only be accessed -with `org-table-paste-rectangle'." - (interactive "rP") - (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) - (goto-char beg) - (org-table-check-inside-data-field) - (setq l01 (org-current-line) - c01 (org-table-current-column)) - (goto-char end) - (org-table-check-inside-data-field) - (setq l02 (org-current-line) - c02 (org-table-current-column)) - (setq l1 (min l01 l02) l2 (max l01 l02) - c1 (min c01 c02) c2 (max c01 c02)) - (catch 'exit - (while t - (catch 'nextline - (if (> l1 l2) (throw 'exit t)) - (goto-line l1) - (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) - (setq cols nil ic1 c1 ic2 c2) - (while (< ic1 (1+ ic2)) - (push (org-table-get-field ic1 rpl) cols) - (setq ic1 (1+ ic1))) - (push (nreverse cols) region) - (setq l1 (1+ l1))))) - (setq org-table-clip (nreverse region)) - (if cut (org-table-align)) - org-table-clip)) - -(defun org-table-paste-rectangle () - "Paste a rectangular region into a table. -The upper right corner ends up in the current field. All involved fields -will be overwritten. If the rectangle does not fit into the present table, -the table is enlarged as needed. The process ignores horizontal separator -lines." - (interactive) - (unless (and org-table-clip (listp org-table-clip)) - (error "First cut/copy a region to paste!")) - (org-table-check-inside-data-field) - (let* ((clip org-table-clip) - (line (org-current-line)) - (col (org-table-current-column)) - (org-enable-table-editor t) - (org-table-automatic-realign nil) - c cols field) - (while (setq cols (pop clip)) - (while (org-at-table-hline-p) (beginning-of-line 2)) - (if (not (org-at-table-p)) - (progn (end-of-line 0) (org-table-next-field))) - (setq c col) - (while (setq field (pop cols)) - (org-table-goto-column c nil 'force) - (org-table-get-field nil field) - (setq c (1+ c))) - (beginning-of-line 2)) - (goto-line line) - (org-table-goto-column col) - (org-table-align))) - -(defun org-table-convert () - "Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables." - (interactive) - (require 'table) - (if (org-at-table.el-p) - ;; convert to Org-mode table - (let ((beg (move-marker (make-marker) (org-table-begin t))) - (end (move-marker (make-marker) (org-table-end t)))) - (table-unrecognize-region beg end) - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) - (replace-match "")) - (goto-char beg)) - (if (org-at-table-p) - ;; convert to table.el table - (let ((beg (move-marker (make-marker) (org-table-begin))) - (end (move-marker (make-marker) (org-table-end)))) - ;; first, get rid of all horizontal lines - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) - (replace-match "")) - ;; insert a hline before first - (goto-char beg) - (org-table-insert-hline 'above) - (beginning-of-line -1) - ;; insert a hline after each line - (while (progn (beginning-of-line 3) (< (point) end)) - (org-table-insert-hline)) - (goto-char beg) - (setq end (move-marker end (org-table-end))) - ;; replace "+" at beginning and ending of hlines - (while (re-search-forward "^\\([ \t]*\\)|-" end t) - (replace-match "\\1+-")) - (goto-char beg) - (while (re-search-forward "-|[ \t]*$" end t) - (replace-match "-+")) - (goto-char beg))))) - -(defun org-table-wrap-region (arg) - "Wrap several fields in a column like a paragraph. -This is useful if you'd like to spread the contents of a field over several -lines, in order to keep the table compact. - -If there is an active region, and both point and mark are in the same column, -the text in the column is wrapped to minimum width for the given number of -lines. Generally, this makes the table more compact. A prefix ARG may be -used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' -formats the selected text to two lines. If the region was longer than two -lines, the remaining lines remain empty. A negative prefix argument reduces -the current number of lines by that amount. The wrapped text is pasted back -into the table. If you formatted it to more lines than it was before, fields -further down in the table get overwritten - so you might need to make space in -the table first. - -If there is no region, the current field is split at the cursor position and -the text fragment to the right of the cursor is prepended to the field one -line down. - -If there is no region, but you specify a prefix ARG, the current field gets -blank, and the content is appended to the field above." - (interactive "P") - (org-table-check-inside-data-field) - (if (org-region-active-p) - ;; There is a region: fill as a paragraph - (let* ((beg (region-beginning)) - (cline (save-excursion (goto-char beg) (org-current-line))) - (ccol (save-excursion (goto-char beg) (org-table-current-column))) - nlines) - (org-table-cut-region (region-beginning) (region-end)) - (if (> (length (car org-table-clip)) 1) - (error "Region must be limited to single column")) - (setq nlines (if arg - (if (< arg 1) - (+ (length org-table-clip) arg) - arg) - (length org-table-clip))) - (setq org-table-clip - (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") - nil nlines))) - (goto-line cline) - (org-table-goto-column ccol) - (org-table-paste-rectangle)) - ;; No region, split the current field at point - (if arg - ;; combine with field above - (let ((s (org-table-blank-field)) - (col (org-table-current-column))) - (beginning-of-line 0) - (while (org-at-table-hline-p) (beginning-of-line 0)) - (org-table-goto-column col) - (skip-chars-forward "^|") - (skip-chars-backward " ") - (insert " " (org-trim s)) - (org-table-align)) - ;; split field - (when (looking-at "\\([^|]+\\)+|") - (let ((s (match-string 1))) - (replace-match " |") - (goto-char (match-beginning 0)) - (org-table-next-row) - (insert (org-trim s) " ") - (org-table-align)))))) - -(defvar org-field-marker nil) - -(defun org-table-edit-field (arg) - "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place." - (interactive "P") - (if arg - (let ((b (save-excursion (skip-chars-backward "^|") (point))) - (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(org-cwidth t invisible t - display t intangible t)) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-fontify-block))) - (let ((pos (move-marker (make-marker) (point))) - (field (org-table-get-field)) - (cw (current-window-configuration)) - p) - (org-switch-to-buffer-other-window "*Org tmp*") - (erase-buffer) - (insert "#\n# Edit field and finish with C-c C-c\n#\n") - (let ((org-inhibit-startup t)) (org-mode)) - (goto-char (setq p (point-max))) - (insert (org-trim field)) - (remove-text-properties p (point-max) - '(invisible t org-cwidth t display t - intangible t)) - (goto-char p) - (org-set-local 'org-finish-function 'org-table-finish-edit-field) - (org-set-local 'org-window-configuration cw) - (org-set-local 'org-field-marker pos) - (message "Edit and finish with C-c C-c")))) - -(defun org-table-finish-edit-field () - "Finish editing a table data field. -Remove all newline characters, insert the result into the table, realign -the table and kill the editing buffer." - (let ((pos org-field-marker) - (cw org-window-configuration) - (cb (current-buffer)) - text) - (goto-char (point-min)) - (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) - (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) - (replace-match " ")) - (setq text (org-trim (buffer-string))) - (set-window-configuration cw) - (kill-buffer cb) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (org-table-check-inside-data-field) - (org-table-get-field nil text) - (org-table-align) - (message "New field value inserted"))) - -(defun org-trim (s) - "Remove whitespace at beginning and end of string." - (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) - s) - -(defun org-wrap (string &optional width lines) - "Wrap string to either a number of lines, or a width in characters. -If WIDTH is non-nil, the string is wrapped to that width, however many lines -that costs. If there is a word longer than WIDTH, the text is actually -wrapped to the length of that word. -IF WIDTH is nil and LINES is non-nil, the string is forced into at most that -many lines, whatever width that takes. -The return value is a list of lines, without newlines at the end." - (let* ((words (org-split-string string "[ \t\n]+")) - (maxword (apply 'max (mapcar 'org-string-width words))) - w ll) - (cond (width - (org-do-wrap words (max maxword width))) - (lines - (setq w maxword) - (setq ll (org-do-wrap words maxword)) - (if (<= (length ll) lines) - ll - (setq ll words) - (while (> (length ll) lines) - (setq w (1+ w)) - (setq ll (org-do-wrap words w))) - ll)) - (t (error "Cannot wrap this"))))) - - -(defun org-do-wrap (words width) - "Create lines of maximum width WIDTH (in characters) from word list WORDS." - (let (lines line) - (while words - (setq line (pop words)) - (while (and words (< (+ (length line) (length (car words))) width)) - (setq line (concat line " " (pop words)))) - (setq lines (push line lines))) - (nreverse lines))) - -(defun org-split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -No empty strings are returned if there are matches at the beginning -and end of string." - (let ((rexp (or separators "[ \f\t\n\r\v]+")) - (start 0) - notfirst - (list nil)) - (while (and (string-match rexp string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (or (eq start (length string)) - (setq list - (cons (substring string start) - list))) - (nreverse list))) - -(defun org-table-map-tables (function) - "Apply FUNCTION to the start of all tables in the buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-table-any-line-regexp nil t) - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) - (beginning-of-line 1) - (if (looking-at org-table-line-regexp) - (save-excursion (funcall function))) - (re-search-forward org-table-any-border-regexp nil 1)))) - (message "Mapping tables: done")) - -(defvar org-timecnt) ; dynamically scoped parameter - -(defun org-table-sum (&optional beg end nlast) - "Sum numbers in region of current table column. -The result will be displayed in the echo area, and will be available -as kill to be inserted with \\[yank]. - -If there is an active region, it is interpreted as a rectangle and all -numbers in that rectangle will be summed. If there is no active -region and point is located in a table column, sum all numbers in that -column. - -If at least one number looks like a time HH:MM or HH:MM:SS, all other -numbers are assumed to be times as well (in decimal hours) and the -numbers are added as such. - -If NLAST is a number, only the NLAST fields will actually be summed." - (interactive) - (save-excursion - (let (col (org-timecnt 0) diff h m s org-table-clip) - (cond - ((and beg end)) ; beg and end given explicitly - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - (t - (setq col (org-table-current-column)) - (goto-char (org-table-begin)) - (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (error "No table data")) - (org-table-goto-column col) - (setq beg (point)) - (goto-char (org-table-end)) - (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (error "No table data")) - (org-table-goto-column col) - (setq end (point)))) - (let* ((items (apply 'append (org-table-copy-region beg end))) - (items1 (cond ((not nlast) items) - ((>= nlast (length items)) items) - (t (setq items (reverse items)) - (setcdr (nthcdr (1- nlast) items) nil) - (nreverse items)))) - (numbers (delq nil (mapcar 'org-table-get-number-for-summing - items1))) - (res (apply '+ numbers)) - (sres (if (= org-timecnt 0) - (format "%g" res) - (setq diff (* 3600 res) - h (floor (/ diff 3600)) diff (mod diff 3600) - m (floor (/ diff 60)) diff (mod diff 60) - s diff) - (format "%d:%02d:%02d" h m s)))) - (kill-new sres) - (if (interactive-p) - (message "%s" - (substitute-command-keys - (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" - (length numbers) sres)))) - sres)))) - -(defun org-table-get-number-for-summing (s) - (let (n) - (if (string-match "^ *|? *" s) - (setq s (replace-match "" nil nil s))) - (if (string-match " *|? *$" s) - (setq s (replace-match "" nil nil s))) - (setq n (string-to-number s)) - (cond - ((and (string-match "0" s) - (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) - ((string-match "\\`[ \t]+\\'" s) nil) - ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) - (let ((h (string-to-number (or (match-string 1 s) "0"))) - (m (string-to-number (or (match-string 2 s) "0"))) - (s (string-to-number (or (match-string 4 s) "0")))) - (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) - (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) - ((equal n 0) nil) - (t n)))) - -(defun org-table-current-field-formula (&optional key noerror) - "Return the formula active for the current field. -Assumes that specials are in place. -If KEY is given, return the key to this formula. -Otherwise return the formula preceeded with \"=\" or \":=\"." - (let* ((name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (col (org-table-current-column)) - (scol (int-to-string col)) - (ref (format "@%d$%d" (org-table-current-dline) col)) - (stored-list (org-table-get-stored-formulas noerror)) - (ass (or (assoc name stored-list) - (assoc ref stored-list) - (assoc scol stored-list)))) - (if key - (car ass) - (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") - (cdr ass)))))) - -(defun org-table-get-formula (&optional equation named) - "Read a formula from the minibuffer, offer stored formula as default. -When NAMED is non-nil, look for a named equation." - (let* ((stored-list (org-table-get-stored-formulas)) - (name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (ref (format "@%d$%d" (org-table-current-dline) - (org-table-current-column))) - (refass (assoc ref stored-list)) - (scol (if named - (if name name ref) - (int-to-string (org-table-current-column)))) - (dummy (and (or name refass) (not named) - (not (y-or-n-p "Replace field formula with column formula? " )) - (error "Abort"))) - (name (or name ref)) - (org-table-may-need-update nil) - (stored (cdr (assoc scol stored-list))) - (eq (cond - ((and stored equation (string-match "^ *=? *$" equation)) - stored) - ((stringp equation) - equation) - (t (org-table-formula-from-user - (read-string - (org-table-formula-to-user - (format "%s formula %s%s=" - (if named "Field" "Column") - (if (member (string-to-char scol) '(?$ ?@)) "" "$") - scol)) - (if stored (org-table-formula-to-user stored) "") - 'org-table-formula-history - ))))) - mustsave) - (when (not (string-match "\\S-" eq)) - ;; remove formula - (setq stored-list (delq (assoc scol stored-list) stored-list)) - (org-table-store-formulas stored-list) - (error "Formula removed")) - (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) - (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) - (if (and name (not named)) - ;; We set the column equation, delete the named one. - (setq stored-list (delq (assoc name stored-list) stored-list) - mustsave t)) - (if stored - (setcdr (assoc scol stored-list) eq) - (setq stored-list (cons (cons scol eq) stored-list))) - (if (or mustsave (not (equal stored eq))) - (org-table-store-formulas stored-list)) - eq)) - -(defun org-table-store-formulas (alist) - "Store the list of formulas below the current table." - (setq alist (sort alist 'org-table-formula-less-p)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 0))) - (insert "#+TBLFM:")) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n"))) - -(defsubst org-table-formula-make-cmp-string (a) - (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a) - (concat - (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "") - (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "") - (if (match-end 5) (concat "@@" (match-string 5 a)))))) - -(defun org-table-formula-less-p (a b) - "Compare two formulas for sorting." - (let ((as (org-table-formula-make-cmp-string (car a))) - (bs (org-table-formula-make-cmp-string (car b)))) - (and as bs (string< as bs)))) - -(defun org-table-get-stored-formulas (&optional noerror) - "Return an alist with the stored formulas directly after current table." - (interactive) - (let (scol eq eq-alist strings string seen) - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") - (setq strings (org-split-string (match-string 2) " *:: *")) - (while (setq string (pop strings)) - (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) - (setq scol (if (match-end 2) - (match-string 2 string) - (match-string 1 string)) - eq (match-string 3 string) - eq-alist (cons (cons scol eq) eq-alist)) - (if (member scol seen) - (if noerror - (progn - (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) - (ding) - (sit-for 2)) - (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) - (push scol seen)))))) - (nreverse eq-alist))) - -(defun org-table-fix-formulas (key replace &optional limit delta remove) - "Modify the equations after the table structure has been edited. -KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. -For all numbers larger than LIMIT, shift them by DELTA." - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "#\\+TBLFM:") - (let ((re (concat key "\\([0-9]+\\)")) - (re2 - (when remove - (if (equal key "$") - (format "\\(@[0-9]+\\)?\\$%d=.*?\\(::\\|$\\)" remove) - (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) - s n a) - (when remove - (while (re-search-forward re2 (point-at-eol) t) - (replace-match ""))) - (while (re-search-forward re (point-at-eol) t) - (setq s (match-string 1) n (string-to-number s)) - (cond - ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t)) - ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t)))))))) - -(defun org-table-get-specials () - "Get the column names and local parameters for this table." - (save-excursion - (let ((beg (org-table-begin)) (end (org-table-end)) - names name fields fields1 field cnt - c v l line col types dlines hlines) - (setq org-table-column-names nil - org-table-local-parameters nil - org-table-named-field-locations nil - org-table-current-begin-line nil - org-table-current-begin-pos nil - org-table-current-line-types nil) - (goto-char beg) - (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) - (setq names (org-split-string (match-string 1) " *| *") - cnt 1) - (while (setq name (pop names)) - (setq cnt (1+ cnt)) - (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name) - (push (cons name (int-to-string cnt)) org-table-column-names)))) - (setq org-table-column-names (nreverse org-table-column-names)) - (setq org-table-column-name-regexp - (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) - (setq fields (org-split-string (match-string 1) " *| *")) - (while (setq field (pop fields)) - (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) - (push (cons (match-string 1 field) (match-string 2 field)) - org-table-local-parameters)))) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) - (setq c (match-string 1) - fields (org-split-string (match-string 2) " *| *")) - (save-excursion - (beginning-of-line (if (equal c "_") 2 0)) - (setq line (org-current-line) col 1) - (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") - (setq fields1 (org-split-string (match-string 1) " *| *")))) - (while (and fields1 (setq field (pop fields))) - (setq v (pop fields1) col (1+ col)) - (when (and (stringp field) (stringp v) - (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) - ;; Analyse the line types - (goto-char beg) - (setq org-table-current-begin-line (org-current-line) - org-table-current-begin-pos (point) - l org-table-current-begin-line) - (while (looking-at "[ \t]*|\\(-\\)?") - (push (if (match-end 1) 'hline 'dline) types) - (if (match-end 1) (push l hlines) (push l dlines)) - (beginning-of-line 2) - (setq l (1+ l))) - (setq org-table-current-line-types (apply 'vector (nreverse types)) - org-table-dlines (apply 'vector (cons nil (nreverse dlines))) - org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) - -(defun org-table-maybe-eval-formula () - "Check if the current field starts with \"=\" or \":=\". -If yes, store the formula and apply it." - ;; We already know we are in a table. Get field will only return a formula - ;; when appropriate. It might return a separator line, but no problem. - (when org-table-formula-evaluate-inline - (let* ((field (org-trim (or (org-table-get-field) ""))) - named eq) - (when (string-match "^:?=\\(.*\\)" field) - (setq named (equal (string-to-char field) ?:) - eq (match-string 1 field)) - (if (or (fboundp 'calc-eval) - (equal (substring eq 0 (min 2 (length eq))) "'(")) - (org-table-eval-formula (if named '(4) nil) - (org-table-formula-from-user eq)) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) - -(defvar org-recalc-commands nil - "List of commands triggering the recalculation of a line. -Will be filled automatically during use.") - -(defvar org-recalc-marks - '((" " . "Unmarked: no special line, no automatic recalculation") - ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") - ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") - ("!" . "Column name definition line. Reference in formula as $name.") - ("$" . "Parameter definition line name=value. Reference in formula as $name.") - ("_" . "Names for values in row below this one.") - ("^" . "Names for values in row above this one."))) - -(defun org-table-rotate-recalc-marks (&optional newchar) - "Rotate the recalculation mark in the first column. -If in any row, the first field is not consistent with a mark, -insert a new column for the markers. -When there is an active region, change all the lines in the region, -after prompting for the marking character. -After each change, a message will be displayed indicating the meaning -of the new mark." - (interactive) - (unless (org-at-table-p) (error "Not at a table")) - (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) - (beg (org-table-begin)) - (end (org-table-end)) - (l (org-current-line)) - (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) - (l2 (if (org-region-active-p) (org-current-line (region-end)))) - (have-col - (save-excursion - (goto-char beg) - (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) - (col (org-table-current-column)) - (forcenew (car (assoc newchar org-recalc-marks))) - epos new) - (when l1 - (message "Change region to what mark? Type # * ! $ or SPC: ") - (setq newchar (char-to-string (read-char-exclusive)) - forcenew (car (assoc newchar org-recalc-marks)))) - (if (and newchar (not forcenew)) - (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" - newchar)) - (if l1 (goto-line l1)) - (save-excursion - (beginning-of-line 1) - (unless (looking-at org-table-dataline-regexp) - (error "Not at a table data line"))) - (unless have-col - (org-table-goto-column 1) - (org-table-insert-column) - (org-table-goto-column (1+ col))) - (setq epos (point-at-eol)) - (save-excursion - (beginning-of-line 1) - (org-table-get-field - 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") - (concat " " - (setq new (or forcenew - (cadr (member (match-string 1) marks)))) - " ") - " # "))) - (if (and l1 l2) - (progn - (goto-line l1) - (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) - (and (looking-at org-table-dataline-regexp) - (org-table-get-field 1 (concat " " new " ")))) - (goto-line l1))) - (if (not (= epos (point-at-eol))) (org-table-align)) - (goto-line l) - (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) - -(defun org-table-maybe-recalculate-line () - "Recompute the current line if marked for it, and if we haven't just done it." - (interactive) - (and org-table-allow-automatic-line-recalculation - (not (and (memq last-command org-recalc-commands) - (equal org-last-recalc-line (org-current-line)))) - (save-excursion (beginning-of-line 1) - (looking-at org-table-auto-recalculate-regexp)) - (org-table-recalculate) t)) - -(defvar org-table-formula-debug nil - "Non-nil means, debug table formulas. -When nil, simply write \"#ERROR\" in corrupted fields.") -(make-variable-buffer-local 'org-table-formula-debug) - -(defvar modes) -(defsubst org-set-calc-mode (var &optional value) - (if (stringp var) - (setq var (assoc var '(("D" calc-angle-mode deg) - ("R" calc-angle-mode rad) - ("F" calc-prefer-frac t) - ("S" calc-symbolic-mode t))) - value (nth 2 var) var (nth 1 var))) - (if (memq var modes) - (setcar (cdr (memq var modes)) value) - (cons var (cons value modes))) - modes) - -(defun org-table-eval-formula (&optional arg equation - suppress-align suppress-const - suppress-store suppress-analysis) - "Replace the table field value at the cursor by the result of a calculation. - -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - -In a table, this command replaces the value in the current field with the -result of a formula. It also installs the formula as the \"current\" column -formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must ba a named field, and the -formula is installed as valid in only this specific field. - -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. - -When called, the command first prompts for a formula, which is read in -the minibuffer. Previously entered formulas are available through the -history list, and the last used formula is offered as a default. -These stored formulas are adapted correctly when moving, inserting, or -deleting columns with the corresponding commands. - -The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. - -This function can also be called from Lisp programs and offers -additional arguments: EQUATION can be the formula to apply. If this -argument is given, the user will not be prompted. SUPPRESS-ALIGN is -used to speed-up recursive calls by by-passing unnecessary aligns. -SUPPRESS-CONST suppresses the interpretation of constants in the -formula, assuming that this has been done already outside the function. -SUPPRESS-STORE means the formula should not be stored, either because -it is already stored, or because it is a modified equation that should -not overwrite the stored one." - (interactive "P") - (org-table-check-inside-data-field) - (or suppress-analysis (org-table-get-specials)) - (if (equal arg '(16)) - (let ((eq (org-table-current-field-formula))) - (or eq (error "No equation active for current field")) - (org-table-get-field nil eq) - (org-table-align) - (setq org-table-may-need-update t)) - (let* (fields - (ndown (if (integerp arg) arg 1)) - (org-table-automatic-realign nil) - (case-fold-search nil) - (down (> ndown 1)) - (formula (if (and equation suppress-store) - equation - (org-table-get-formula equation (equal arg '(4))))) - (n0 (org-table-current-column)) - (modes (copy-sequence org-calc-default-modes)) - (numbers nil) ; was a variable, now fixed default - (keep-empty nil) - n form form0 bw fmt x ev orig c lispp literal) - ;; Parse the format string. Since we have a lot of modes, this is - ;; a lot of work. However, I think calc still uses most of the time. - (if (string-match ";" formula) - (let ((tmp (org-split-string formula ";"))) - (setq formula (car tmp) - fmt (concat (cdr (assoc "%" org-table-local-parameters)) - (nth 1 tmp))) - (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) - (setq c (string-to-char (match-string 1 fmt)) - n (string-to-number (match-string 2 fmt))) - (if (= c ?p) - (setq modes (org-set-calc-mode 'calc-internal-prec n)) - (setq modes (org-set-calc-mode - 'calc-float-format - (list (cdr (assoc c '((?n . float) (?f . fix) - (?s . sci) (?e . eng)))) - n)))) - (setq fmt (replace-match "" t t fmt))) - (if (string-match "[NT]" fmt) - (setq numbers (equal (match-string 0 fmt) "N") - fmt (replace-match "" t t fmt))) - (if (string-match "L" fmt) - (setq literal t - fmt (replace-match "" t t fmt))) - (if (string-match "E" fmt) - (setq keep-empty t - fmt (replace-match "" t t fmt))) - (while (string-match "[DRFS]" fmt) - (setq modes (org-set-calc-mode (match-string 0 fmt))) - (setq fmt (replace-match "" t t fmt))) - (unless (string-match "\\S-" fmt) - (setq fmt nil)))) - (if (and (not suppress-const) org-table-formula-use-constants) - (setq formula (org-table-formula-substitute-names formula))) - (setq orig (or (get-text-property 1 :orig-formula formula) "?")) - (while (> ndown 0) - (setq fields (org-split-string - (org-no-properties - (buffer-substring (point-at-bol) (point-at-eol))) - " *| *")) - (if (eq numbers t) - (setq fields (mapcar - (lambda (x) (number-to-string (string-to-number x))) - fields))) - (setq ndown (1- ndown)) - (setq form (copy-sequence formula) - lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) - (if (and lispp literal) (setq lispp 'literal)) - ;; Check for old vertical references - (setq form (org-rewrite-old-row-references form)) - ;; Insert complex ranges - (while (string-match org-table-range-regexp form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-table-get-range (match-string 0 form) nil n0) - keep-empty numbers lispp)) - t t form))) - ;; Insert simple ranges - (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-sublist - fields (string-to-number (match-string 1 form)) - (string-to-number (match-string 2 form))) - keep-empty numbers lispp)) - t t form))) - (setq form0 form) - ;; Insert the references to fields in same row - (while (string-match "\\$\\([0-9]+\\)" form) - (setq n (string-to-number (match-string 1 form)) - x (nth (1- (if (= n 0) n0 n)) fields)) - (unless x (error "Invalid field specifier \"%s\"" - (match-string 0 form))) - (setq form (replace-match - (save-match-data - (org-table-make-reference x nil numbers lispp)) - t t form))) - - (if lispp - (setq ev (condition-case nil - (eval (eval (read form))) - (error "#ERROR")) - ev (if (numberp ev) (number-to-string ev) ev)) - (or (fboundp 'calc-eval) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form modes) - (if numbers 'num)))) - - (when org-table-formula-debug - (with-output-to-temp-buffer "*Substitution History*" - (princ (format "Substitution history of formula -Orig: %s -$xyz-> %s -@r$c-> %s -$1-> %s\n" orig formula form0 form)) - (if (listp ev) - (princ (format " %s^\nError: %s" - (make-string (car ev) ?\-) (nth 1 ev))) - (princ (format "Result: %s\nFormat: %s\nFinal: %s" - ev (or fmt "NONE") - (if fmt (format fmt (string-to-number ev)) ev))))) - (setq bw (get-buffer-window "*Substitution History*")) - (shrink-window-if-larger-than-buffer bw) - (unless (and (interactive-p) (not ndown)) - (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) - (org-table-align) - (error "Abort")) - (delete-window bw) - (message ""))) - (if (listp ev) (setq fmt nil ev "#ERROR")) - (org-table-justify-field-maybe - (if fmt (format fmt (string-to-number ev)) ev)) - (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) - (call-interactively 'org-return) - (setq ndown 0))) - (and down (org-table-maybe-recalculate-line)) - (or suppress-align (and org-table-may-need-update - (org-table-align)))))) - -(defun org-table-put-field-property (prop value) - (save-excursion - (put-text-property (progn (skip-chars-backward "^|") (point)) - (progn (skip-chars-forward "^|") (point)) - prop value))) - -(defun org-table-get-range (desc &optional tbeg col highlight) - "Get a calc vector from a column, accorting to descriptor DESC. -Optional arguments TBEG and COL can give the beginning of the table and -the current column, to avoid unnecessary parsing. -HIGHLIGHT means, just highlight the range." - (if (not (equal (string-to-char desc) ?@)) - (setq desc (concat "@" desc))) - (save-excursion - (or tbeg (setq tbeg (org-table-begin))) - (or col (setq col (org-table-current-column))) - (let ((thisline (org-current-line)) - beg end c1 c2 r1 r2 rangep tmp) - (unless (string-match org-table-range-regexp desc) - (error "Invalid table range specifier `%s'" desc)) - (setq rangep (match-end 3) - r1 (and (match-end 1) (match-string 1 desc)) - r2 (and (match-end 4) (match-string 4 desc)) - c1 (and (match-end 2) (substring (match-string 2 desc) 1)) - c2 (and (match-end 5) (substring (match-string 5 desc) 1))) - - (and c1 (setq c1 (+ (string-to-number c1) - (if (memq (string-to-char c1) '(?- ?+)) col 0)))) - (and c2 (setq c2 (+ (string-to-number c2) - (if (memq (string-to-char c2) '(?- ?+)) col 0)))) - (if (equal r1 "") (setq r1 nil)) - (if (equal r2 "") (setq r2 nil)) - (if r1 (setq r1 (org-table-get-descriptor-line r1))) - (if r2 (setq r2 (org-table-get-descriptor-line r2))) -; (setq r2 (or r2 r1) c2 (or c2 c1)) - (if (not r1) (setq r1 thisline)) - (if (not r2) (setq r2 thisline)) - (if (not c1) (setq c1 col)) - (if (not c2) (setq c2 col)) - (if (or (not rangep) (and (= r1 r2) (= c1 c2))) - ;; just one field - (progn - (goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (prog1 (org-trim (org-table-get-field c1)) - (if highlight (org-table-highlight-rectangle (point) (point))))) - ;; A range, return a vector - ;; First sort the numbers to get a regular ractangle - (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) - (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (org-table-goto-column c1) - (setq beg (point)) - (goto-line r2) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 0)) - (org-table-goto-column c2) - (setq end (point)) - (if highlight - (org-table-highlight-rectangle - beg (progn (skip-chars-forward "^|\n") (point)))) - ;; return string representation of calc vector - (mapcar 'org-trim - (apply 'append (org-table-copy-region beg end))))))) - -(defun org-table-get-descriptor-line (desc &optional cline bline table) - "Analyze descriptor DESC and retrieve the corresponding line number. -The cursor is currently in line CLINE, the table begins in line BLINE, -and TABLE is a vector with line types." - (if (string-match "^[0-9]+$" desc) - (aref org-table-dlines (string-to-number desc)) - (setq cline (or cline (org-current-line)) - bline (or bline org-table-current-begin-line) - table (or table org-table-current-line-types)) - (if (or - (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) - ;; 1 2 3 4 5 6 - (and (not (match-end 3)) (not (match-end 6))) - (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "invalid row descriptor `%s'" desc)) - (let* ((hdir (and (match-end 2) (match-string 2 desc))) - (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) - (odir (and (match-end 5) (match-string 5 desc))) - (on (if (match-end 6) (string-to-number (match-string 6 desc)))) - (i (- cline bline)) - (rel (and (match-end 6) - (or (and (match-end 1) (not (match-end 3))) - (match-end 5))))) - (if (and hn (not hdir)) - (progn - (setq i 0 hdir "+") - (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) - (if (and (not hn) on (not odir)) - (error "should never happen");;(aref org-table-dlines on) - (if (and hn (> hn 0)) - (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn))) - (if on - (setq i (org-find-row-type table i 'dline (equal odir "-") rel on))) - (+ bline i))))) - -(defun org-find-row-type (table i type backwards relative n) - (let ((l (length table))) - (while (> n 0) - (while (and (setq i (+ i (if backwards -1 1))) - (>= i 0) (< i l) - (not (eq (aref table i) type)) - (if (and relative (eq (aref table i) 'hline)) - (progn (setq i (- i (if backwards -1 1)) n 1) nil) - t))) - (setq n (1- n))) - (if (or (< i 0) (>= i l)) - (error "Row descriptior leads outside table") - i))) - -(defun org-rewrite-old-row-references (s) - (if (string-match "&[-+0-9I]" s) - (error "Formula contains old &row reference, please rewrite using @-syntax") - s)) - -(defun org-table-make-reference (elements keep-empty numbers lispp) - "Convert list ELEMENTS to something appropriate to insert into formula. -KEEP-EMPTY indicated to keep empty fields, default is to skip them. -NUMBERS indicates that everything should be converted to numbers. -LISPP means to return something appropriate for a Lisp list." - (if (stringp elements) ; just a single val - (if lispp - (if (eq lispp 'literal) - elements - (prin1-to-string (if numbers (string-to-number elements) elements))) - (if (equal elements "") (setq elements "0")) - (if numbers (number-to-string (string-to-number elements)) elements)) - (unless keep-empty - (setq elements - (delq nil - (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) - elements)))) - (setq elements (or elements '("0"))) - (if lispp - (mapconcat - (lambda (x) - (if (eq lispp 'literal) - x - (prin1-to-string (if numbers (string-to-number x) x)))) - elements " ") - (concat "[" (mapconcat - (lambda (x) - (if numbers (number-to-string (string-to-number x)) x)) - elements - ",") "]")))) - -(defun org-table-recalculate (&optional all noalign) - "Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table." - (interactive "P") - (or (memq this-command org-recalc-commands) - (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (error "Not at a table")) - (if (equal all '(16)) - (org-table-iterate) - (org-table-get-specials) - (let* ((eqlist (sort (org-table-get-stored-formulas) - (lambda (a b) (string< (car a) (car b))))) - (inhibit-redisplay (not debug-on-error)) - (line-re org-table-dataline-regexp) - (thisline (org-current-line)) - (thiscol (org-table-current-column)) - beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) - ;; Insert constants in all formulas - (setq eqlist - (mapcar (lambda (x) - (setcdr x (org-table-formula-substitute-names (cdr x))) - x) - eqlist)) - ;; Split the equation list - (while (setq eq (pop eqlist)) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) - (if all - (progn - (setq end (move-marker (make-marker) (1+ (org-table-end)))) - (goto-char (setq beg (org-table-begin))) - (if (re-search-forward org-table-calculate-mark-regexp end t) - ;; This is a table with marked lines, compute selected lines - (setq line-re org-table-recalculate-regexp) - ;; Move forward to the first non-header line - (if (and (re-search-forward org-table-dataline-regexp end t) - (re-search-forward org-table-hline-regexp end t) - (re-search-forward org-table-dataline-regexp end t)) - (setq beg (match-beginning 0)) - nil))) ;; just leave beg where it is - (setq beg (point-at-bol) - end (move-marker (make-marker) (1+ (point-at-eol))))) - (goto-char beg) - (and all (message "Re-applying formulas to full table...")) - - ;; First find the named fields, and mark them untouchanble - (remove-text-properties beg end '(org-untouchable t)) - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a (list name - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (push (append a (list (cdr eq))) eqlname1) - (org-table-put-field-property :org-untouchable t))) - - ;; Now evauluate the column formulas, but skip fields covered by - ;; field formulas - (goto-char beg) - (while (re-search-forward line-re end t) - (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) - ;; Unprotected line, recalculate - (and all (message "Re-applying formulas to full table...(line %d)" - (setq cnt (1+ cnt)))) - (setq org-last-recalc-line (org-current-line)) - (setq eql eqlnum) - (while (setq entry (pop eql)) - (goto-line org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) - (unless (get-text-property (point) :org-untouchable) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis))))) - - ;; Now evaluate the field formulas - (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) - (goto-line (nth 1 eq)) - (org-table-goto-column (nth 2 eq)) - (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst - 'nostore 'noanalysis)) - - (goto-line thisline) - (org-table-goto-column thiscol) - (remove-text-properties (point-min) (point-max) '(org-untouchable t)) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas to %d lines...done" cnt))) - - ;; back to initial position - (message "Re-applying formulas...done") - (goto-line thisline) - (org-table-goto-column thiscol) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas...done")))))) - -(defun org-table-iterate (&optional arg) - "Recalculate the table until it does not change anymore." - (interactive "P") - (let ((imax (if arg (prefix-numeric-value arg) 10)) - (i 0) - (lasttbl (buffer-substring (org-table-begin) (org-table-end))) - thistbl) - (catch 'exit - (while (< i imax) - (setq i (1+ i)) - (org-table-recalculate 'all) - (setq thistbl (buffer-substring (org-table-begin) (org-table-end))) - (if (not (string= lasttbl thistbl)) - (setq lasttbl thistbl) - (if (> i 1) - (message "Convergence after %d iterations" i) - (message "Table was already stable")) - (throw 'exit t))) - (error "No convergence after %d iterations" i)))) - -(defun org-table-formula-substitute-names (f) - "Replace $const with values in string F." - (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) - ;; First, check for column names - (while (setq start (string-match org-table-column-name-regexp f start)) - (setq start (1+ start)) - (setq a (assoc (match-string 1 f) org-table-column-names)) - (setq f (replace-match (concat "$" (cdr a)) t t f))) - ;; Parameters and constants - (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)" f start)) - (setq start (1+ start)) - (if (setq a (save-match-data - (org-table-get-constant (match-string 1 f)))) - (setq f (replace-match - (concat (if pp "(") a (if pp ")")) t t f)))) - (if org-table-formula-debug - (put-text-property 0 (length f) :orig-formula f1 f)) - f)) - -(defun org-table-get-constant (const) - "Find the value for a parameter or constant in a formula. -Parameters get priority." - (or (cdr (assoc const org-table-local-parameters)) - (cdr (assoc const org-table-formula-constants-local)) - (cdr (assoc const org-table-formula-constants)) - (and (fboundp 'constants-get) (constants-get const)) - (and (string= (substring const 0 (min 5 (length const))) "PROP_") - (org-entry-get nil (substring const 5) 'inherit)) - "#UNDEFINED_NAME")) - -(defvar org-table-fedit-map - (let ((map (make-sparse-keymap))) - (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) - (org-defkey map "\C-c?" 'org-table-show-reference) - (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) - (org-defkey map [(meta shift down)] 'org-table-fedit-line-down) - (org-defkey map [(shift up)] 'org-table-fedit-ref-up) - (org-defkey map [(shift down)] 'org-table-fedit-ref-down) - (org-defkey map [(shift left)] 'org-table-fedit-ref-left) - (org-defkey map [(shift right)] 'org-table-fedit-ref-right) - (org-defkey map [(meta up)] 'org-table-fedit-scroll-down) - (org-defkey map [(meta down)] 'org-table-fedit-scroll) - (org-defkey map [(meta tab)] 'lisp-complete-symbol) - (org-defkey map "\M-\C-i" 'lisp-complete-symbol) - (org-defkey map [(tab)] 'org-table-fedit-lisp-indent) - (org-defkey map "\C-i" 'org-table-fedit-lisp-indent) - (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) - (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) - map)) - -(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" - '("Edit-Formulas" - ["Finish and Install" org-table-fedit-finish t] - ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] - ["Abort" org-table-fedit-abort t] - "--" - ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] - ["Complete Lisp Symbol" lisp-complete-symbol t] - "--" - "Shift Reference at Point" - ["Up" org-table-fedit-ref-up t] - ["Down" org-table-fedit-ref-down t] - ["Left" org-table-fedit-ref-left t] - ["Right" org-table-fedit-ref-right t] - "-" - "Change Test Row for Column Formulas" - ["Up" org-table-fedit-line-up t] - ["Down" org-table-fedit-line-down t] - "--" - ["Scroll Table Window" org-table-fedit-scroll t] - ["Scroll Table Window down" org-table-fedit-scroll-down t] - ["Show Table Grid" org-table-fedit-toggle-coordinates - :style toggle :selected (with-current-buffer (marker-buffer org-pos) - org-table-overlay-coordinates)] - "--" - ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type - :style toggle :selected org-table-buffer-is-an])) - -(defvar org-pos) - -(defun org-table-edit-formulas () - "Edit the formulas of the current table in a separate buffer." - (interactive) - (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM")) - (beginning-of-line 0)) - (unless (org-at-table-p) (error "Not at a table")) - (org-table-get-specials) - (let ((key (org-table-current-field-formula 'key 'noerror)) - (eql (sort (org-table-get-stored-formulas 'noerror) - 'org-table-formula-less-p)) - (pos (move-marker (make-marker) (point))) - (startline 1) - (wc (current-window-configuration)) - (titles '((column . "# Column Formulas\n") - (field . "# Field Formulas\n") - (named . "# Named Field Formulas\n"))) - entry s type title) - (org-switch-to-buffer-other-window "*Edit Formulas*") - (erase-buffer) - ;; Keep global-font-lock-mode from turning on font-lock-mode - (let ((font-lock-global-modes '(not fundamental-mode))) - (fundamental-mode)) - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (org-set-local 'org-pos pos) - (org-set-local 'org-window-configuration wc) - (use-local-map org-table-fedit-map) - (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t) - (easy-menu-add org-table-fedit-menu) - (setq startline (org-current-line)) - (while (setq entry (pop eql)) - (setq type (cond - ((equal (string-to-char (car entry)) ?@) 'field) - ((string-match "^[0-9]" (car entry)) 'column) - (t 'named))) - (when (setq title (assq type titles)) - (or (bobp) (insert "\n")) - (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (delq title titles))) - (if (equal key (car entry)) (setq startline (org-current-line))) - (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") - (car entry) " = " (cdr entry) "\n")) - (remove-text-properties 0 (length s) '(face nil) s) - (insert s)) - (if (eq org-table-use-standard-references t) - (org-table-fedit-toggle-ref-type)) - (goto-line startline) - (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) - -(defun org-table-fedit-post-command () - (when (not (memq this-command '(lisp-complete-symbol))) - (let ((win (selected-window))) - (save-excursion - (condition-case nil - (org-table-show-reference) - (error nil)) - (select-window win))))) - -(defun org-table-formula-to-user (s) - "Convert a formula from internal to user representation." - (if (eq org-table-use-standard-references t) - (org-table-convert-refs-to-an s) - s)) - -(defun org-table-formula-from-user (s) - "Convert a formula from user to internal representation." - (if org-table-use-standard-references - (org-table-convert-refs-to-rc s) - s)) - -(defun org-table-convert-refs-to-rc (s) - "Convert spreadsheet references from AB7 to @7$28. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (let ((start 0)) - (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\)" s start) - (cond - ((match-end 3) - ;; format match, just advance - (setq start (match-end 0))) - ((and (> (match-beginning 0) 0) - (equal ?. (aref s (max (1- (match-beginning 0)) 0))) - (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) - ;; 3.e5 or something like this. - (setq start (match-end 0))) - (t - (setq start (match-beginning 0) - s (replace-match - (if (equal (match-string 2 s) "&") - (format "$%d" (org-letters-to-number (match-string 1 s))) - (format "@%d$%d" - (string-to-number (match-string 2 s)) - (org-letters-to-number (match-string 1 s)))) - t t s))))) - s)) - -(defun org-table-convert-refs-to-an (s) - "Convert spreadsheet references from to @7$28 to AB7. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match - (format "%s%d" - (org-number-to-letters - (string-to-number (match-string 2 s))) - (string-to-number (match-string 1 s))) - t t s))) - (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match (concat "\\1" - (org-number-to-letters - (string-to-number (match-string 2 s))) "&") - t nil s))) - s) - -(defun org-letters-to-number (s) - "Convert a base 26 number represented by letters into an integer. -For example: AB -> 28." - (let ((n 0)) - (setq s (upcase s)) - (while (> (length s) 0) - (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) - s (substring s 1))) - n)) - -(defun org-number-to-letters (n) - "Convert an integer into a base 26 number represented by letters. -For example: 28 -> AB." - (let ((s "")) - (while (> n 0) - (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) - n (/ (1- n) 26))) - s)) - -(defun org-table-fedit-convert-buffer (function) - "Convert all references in this buffer, using FUNTION." - (let ((line (org-current-line))) - (goto-char (point-min)) - (while (not (eobp)) - (insert (funcall function (buffer-substring (point) (point-at-eol)))) - (delete-region (point) (point-at-eol)) - (or (eobp) (forward-char 1))) - (goto-line line))) - -(defun org-table-fedit-toggle-ref-type () - "Convert all references in the buffer from B3 to @3$2 and back." - (interactive) - (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) - (org-table-fedit-convert-buffer - (if org-table-buffer-is-an - 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) - (message "Reference type switched to %s" - (if org-table-buffer-is-an "A1 etc" "@row$column"))) - -(defun org-table-fedit-ref-up () - "Shift the reference at point one row/hline up." - (interactive) - (org-table-fedit-shift-reference 'up)) -(defun org-table-fedit-ref-down () - "Shift the reference at point one row/hline down." - (interactive) - (org-table-fedit-shift-reference 'down)) -(defun org-table-fedit-ref-left () - "Shift the reference at point one field to the left." - (interactive) - (org-table-fedit-shift-reference 'left)) -(defun org-table-fedit-ref-right () - "Shift the reference at point one field to the right." - (interactive) - (org-table-fedit-shift-reference 'right)) - -(defun org-table-fedit-shift-reference (dir) - (cond - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") - (if (memq dir '(left right)) - (org-rematch-and-replace 1 (eq dir 'left)) - (error "Cannot shift reference in this direction"))) - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") - ;; A B3-like reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up)) - (org-rematch-and-replace 1 (eq dir 'left)))) - ((org-at-regexp-p - "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") - ;; An internal reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) - (org-rematch-and-replace 5 (eq dir 'left)))))) - -(defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted refrence." - (or (match-end n) (error "Cannot shift reference in this direction")) - (goto-char (match-beginning n)) - (and (looking-at (regexp-quote (match-string n))) - (replace-match (org-shift-refpart (match-string 0) decr hline) - t t))) - -(defun org-shift-refpart (ref &optional decr hline) - "Shift a refrence part REF. -If DECR is set, decrease the references row/column, else increase. -If HLINE is set, this may be a hline reference, it certainly is not -a translation reference." - (save-match-data - (let* ((sign (string-match "^[-+]" ref)) n) - - (if sign (setq sign (substring ref 0 1) ref (substring ref 1))) - (cond - ((and hline (string-match "^I+" ref)) - (setq n (string-to-number (concat sign (number-to-string (length ref))))) - (setq n (+ n (if decr -1 1))) - (if (= n 0) (setq n (+ n (if decr -1 1)))) - (if sign - (setq sign (if (< n 0) "-" "+") n (abs n)) - (setq n (max 1 n))) - (concat sign (make-string n ?I))) - - ((string-match "^[0-9]+" ref) - (setq n (string-to-number (concat sign ref))) - (setq n (+ n (if decr -1 1))) - (if sign - (concat (if (< n 0) "-" "+") (number-to-string (abs n))) - (number-to-string (max 1 n)))) - - ((string-match "^[a-zA-Z]+" ref) - (org-number-to-letters - (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - - (t (error "Cannot shift reference")))))) - -(defun org-table-fedit-toggle-coordinates () - "Toggle the display of coordinates in the refrenced table." - (interactive) - (let ((pos (marker-position org-pos))) - (with-current-buffer (marker-buffer org-pos) - (save-excursion - (goto-char pos) - (org-table-toggle-coordinate-overlays))))) - -(defun org-table-fedit-finish (&optional arg) - "Parse the buffer for formula definitions and install them. -With prefix ARG, apply the new formulas to the table." - (interactive "P") - (org-table-remove-rectangle-highlight) - (if org-table-use-standard-references - (progn - (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) - (setq org-table-buffer-is-an nil))) - (let ((pos org-pos) eql var form) - (goto-char (point-min)) - (while (re-search-forward - "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" - nil t) - (setq var (if (match-end 2) (match-string 2) (match-string 1)) - form (match-string 3)) - (setq form (org-trim form)) - (when (not (equal form "")) - (while (string-match "[ \t]*\n[ \t]*" form) - (setq form (replace-match " " t t form))) - (when (assoc var eql) - (error "Double formulas for %s" var)) - (push (cons var form) eql))) - (setq org-pos nil) - (set-window-configuration org-window-configuration) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (unless (org-at-table-p) - (error "Lost table position - cannot install formulae")) - (org-table-store-formulas eql) - (move-marker pos nil) - (kill-buffer "*Edit Formulas*") - (if arg - (org-table-recalculate 'all) - (message "New formulas installed - press C-u C-c C-c to apply.")))) - -(defun org-table-fedit-abort () - "Abort editing formulas, without installing the changes." - (interactive) - (org-table-remove-rectangle-highlight) - (let ((pos org-pos)) - (set-window-configuration org-window-configuration) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (message "Formula editing aborted without installing changes"))) - -(defun org-table-fedit-lisp-indent () - "Pretty-print and re-indent Lisp expressions in the Formula Editor." - (interactive) - (let ((pos (point)) beg end ind) - (beginning-of-line 1) - (cond - ((looking-at "[ \t]") - (goto-char pos) - (call-interactively 'lisp-indent-line)) - ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) - ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available.")) - ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") - (goto-char (- (match-end 0) 2)) - (setq beg (point)) - (setq ind (make-string (current-column) ?\ )) - (condition-case nil (forward-sexp 1) - (error - (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) - (setq end (point)) - (save-restriction - (narrow-to-region beg end) - (if (eq last-command this-command) - (progn - (goto-char (point-min)) - (setq this-command nil) - (while (re-search-forward "[ \t]*\n[ \t]*" nil t) - (replace-match " "))) - (pp-buffer) - (untabify (point-min) (point-max)) - (goto-char (1+ (point-min))) - (while (re-search-forward "^." nil t) - (beginning-of-line 1) - (insert ind)) - (goto-char (point-max)) - (backward-delete-char 1))) - (goto-char beg)) - (t nil)))) - -(defvar org-show-positions nil) - -(defun org-table-show-reference (&optional local) - "Show the location/value of the $ expression at point." - (interactive) - (org-table-remove-rectangle-highlight) - (catch 'exit - (let ((pos (if local (point) org-pos)) - (face2 'highlight) - (org-inhibit-highlight-removal t) - (win (selected-window)) - (org-show-positions nil) - var name e what match dest) - (if local (org-table-get-specials)) - (setq what (cond - ((or (org-at-regexp-p org-table-range-regexp2) - (org-at-regexp-p org-table-translate-regexp) - (org-at-regexp-p org-table-range-regexp)) - (setq match - (save-match-data - (org-table-convert-refs-to-rc (match-string 0)))) - 'range) - ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) - ((org-at-regexp-p "\\$[0-9]+") 'column) - ((not local) nil) - (t (error "No reference at point"))) - match (and what (or match (match-string 0)))) - (when (and match (not (equal (match-beginning 0) (point-at-bol)))) - (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) - 'secondary-selection)) - (org-add-hook 'before-change-functions - 'org-table-remove-rectangle-highlight) - (if (eq what 'name) (setq var (substring match 1))) - (when (eq what 'range) - (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) - (setq match (org-table-formula-substitute-names match))) - (unless local - (save-excursion - (end-of-line 1) - (re-search-backward "^\\S-" nil t) - (beginning-of-line 1) - (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") - (setq dest - (save-match-data - (org-table-convert-refs-to-rc (match-string 1)))) - (org-table-add-rectangle-overlay - (match-beginning 1) (match-end 1) face2)))) - (if (and (markerp pos) (marker-buffer pos)) - (if (get-buffer-window (marker-buffer pos)) - (select-window (get-buffer-window (marker-buffer pos))) - (org-switch-to-buffer-other-window (get-buffer-window - (marker-buffer pos))))) - (goto-char pos) - (org-table-force-dataline) - (when dest - (setq name (substring dest 1)) - (cond - ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) - (setq e (assoc name org-table-named-field-locations)) - (goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e))) - ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) - (let ((l (string-to-number (match-string 1 dest))) - (c (string-to-number (match-string 2 dest)))) - (goto-line (aref org-table-dlines l)) - (org-table-goto-column c))) - (t (org-table-goto-column (string-to-number name)))) - (move-marker pos (point)) - (org-table-highlight-rectangle nil nil face2)) - (cond - ((equal dest match)) - ((not match)) - ((eq what 'range) - (condition-case nil - (save-excursion - (org-table-get-range match nil nil 'highlight)) - (error nil))) - ((setq e (assoc var org-table-named-field-locations)) - (goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e)) - (org-table-highlight-rectangle (point) (point)) - (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) - ((setq e (assoc var org-table-column-names)) - (org-table-goto-column (string-to-number (cdr e))) - (org-table-highlight-rectangle (point) (point)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") - (org-table-end) t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Named column (column %s)" (cdr e))) - (error "Column name not found"))) - ((eq what 'column) - ;; column number - (org-table-goto-column (string-to-number (substring match 1))) - (org-table-highlight-rectangle (point) (point)) - (message "Column %s" (substring match 1))) - ((setq e (assoc var org-table-local-parameters)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Local parameter.")) - (error "Parameter not found"))) - (t - (cond - ((not var) (error "No reference at point")) - ((setq e (assoc var org-table-formula-constants-local)) - (message "Local Constant: $%s=%s in #+CONSTANTS line." - var (cdr e))) - ((setq e (assoc var org-table-formula-constants)) - (message "Constant: $%s=%s in `org-table-formula-constants'." - var (cdr e))) - ((setq e (and (fboundp 'constants-get) (constants-get var))) - (message "Constant: $%s=%s, from `constants.el'%s." - var e (format " (%s units)" constants-unit-system))) - (t (error "Undefined name $%s" var))))) - (goto-char pos) - (when (and org-show-positions - (not (memq this-command '(org-table-fedit-scroll - org-table-fedit-scroll-down)))) - (push pos org-show-positions) - (push org-table-current-begin-pos org-show-positions) - (let ((min (apply 'min org-show-positions)) - (max (apply 'max org-show-positions))) - (goto-char min) (recenter 0) - (goto-char max) - (or (pos-visible-in-window-p max) (recenter -1)))) - (select-window win)))) - -(defun org-table-force-dataline () - "Make sure the cursor is in a dataline in a table." - (unless (save-excursion - (beginning-of-line 1) - (looking-at org-table-dataline-regexp)) - (let* ((re org-table-dataline-regexp) - (p1 (save-excursion (re-search-forward re nil 'move))) - (p2 (save-excursion (re-search-backward re nil 'move)))) - (cond ((and p1 p2) - (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) - p1 p2))) - ((or p1 p2) (goto-char (or p1 p2))) - (t (error "No table dataline around here")))))) - -(defun org-table-fedit-line-up () - "Move cursor one line up in the window showing the table." - (interactive) - (org-table-fedit-move 'previous-line)) - -(defun org-table-fedit-line-down () - "Move cursor one line down in the window showing the table." - (interactive) - (org-table-fedit-move 'next-line)) - -(defun org-table-fedit-move (command) - "Move the cursor in the window shoinw the table. -Use COMMAND to do the motion, repeat if necessary to end up in a data line." - (let ((org-table-allow-automatic-line-recalculation nil) - (pos org-pos) (win (selected-window)) p) - (select-window (get-buffer-window (marker-buffer org-pos))) - (setq p (point)) - (call-interactively command) - (while (and (org-at-table-p) - (org-at-table-hline-p)) - (call-interactively command)) - (or (org-at-table-p) (goto-char p)) - (move-marker pos (point)) - (select-window win))) - -(defun org-table-fedit-scroll (N) - (interactive "p") - (let ((other-window-scroll-buffer (marker-buffer org-pos))) - (scroll-other-window N))) - -(defun org-table-fedit-scroll-down (N) - (interactive "p") - (org-table-fedit-scroll (- N))) - -(defvar org-table-rectangle-overlays nil) - -(defun org-table-add-rectangle-overlay (beg end &optional face) - "Add a new overlay." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) - (push ov org-table-rectangle-overlays))) - -(defun org-table-highlight-rectangle (&optional beg end face) - "Highlight rectangular region in a table." - (setq beg (or beg (point)) end (or end (point))) - (let ((b (min beg end)) - (e (max beg end)) - l1 c1 l2 c2 tmp) - (and (boundp 'org-show-positions) - (setq org-show-positions (cons b (cons e org-show-positions)))) - (goto-char (min beg end)) - (setq l1 (org-current-line) - c1 (org-table-current-column)) - (goto-char (max beg end)) - (setq l2 (org-current-line) - c2 (org-table-current-column)) - (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line l1) - (beginning-of-line 1) - (loop for line from l1 to l2 do - (when (looking-at org-table-dataline-regexp) - (org-table-goto-column c1) - (skip-chars-backward "^|\n") (setq beg (point)) - (org-table-goto-column c2) - (skip-chars-forward "^|\n") (setq end (point)) - (org-table-add-rectangle-overlay beg end face)) - (beginning-of-line 2)) - (goto-char b)) - (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) - -(defun org-table-remove-rectangle-highlight (&rest ignore) - "Remove the rectangle overlays." - (unless org-inhibit-highlight-removal - (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'org-delete-overlay org-table-rectangle-overlays) - (setq org-table-rectangle-overlays nil))) - -(defvar org-table-coordinate-overlays nil - "Collects the cooordinate grid overlays, so that they can be removed.") -(make-variable-buffer-local 'org-table-coordinate-overlays) - -(defun org-table-overlay-coordinates () - "Add overlays to the table at point, to show row/column coordinates." - (interactive) - (mapc 'org-delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil) - (save-excursion - (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) - (goto-char (org-table-begin)) - (while (org-at-table-p) - (setq eol (point-at-eol)) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) - (push ov org-table-coordinate-overlays) - (setq hline (looking-at org-table-hline-regexp)) - (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) - (format "%4d" (setq id (1+ id))))) - (org-overlay-before-string ov str 'org-special-keyword 'evaporate) - (when hline - (setq ic 0) - (while (re-search-forward "[+|]\\(-+\\)" eol t) - (setq beg (1+ (match-beginning 0)) - ic (1+ ic) - s1 (concat "$" (int-to-string ic)) - s2 (org-number-to-letters ic) - str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (org-make-overlay beg (+ beg (length str)))) - (push ov org-table-coordinate-overlays) - (org-overlay-display ov str 'org-special-keyword 'evaporate))) - (beginning-of-line 2))))) - -(defun org-table-toggle-coordinate-overlays () - "Toggle the display of Row/Column numbers in tables." - (interactive) - (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Row/Column number display turned %s" - (if org-table-overlay-coordinates "on" "off")) - (if (and (org-at-table-p) org-table-overlay-coordinates) - (org-table-align)) - (unless org-table-overlay-coordinates - (mapc 'org-delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil))) - -(defun org-table-toggle-formula-debugger () - "Toggle the formula debugger in tables." - (interactive) - (setq org-table-formula-debug (not org-table-formula-debug)) - (message "Formula debugging has been turned %s" - (if org-table-formula-debug "on" "off"))) - -;;; The orgtbl minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode table editor. - -;; This is really a hack, because the org-mode table editor uses several -;; keys which normally belong to the major mode, for example the TAB and -;; RET keys. Here is how it works: The minor mode defines all the keys -;; necessary to operate the table editor, but wraps the commands into a -;; function which tests if the cursor is currently inside a table. If that -;; is the case, the table editor command is executed. However, when any of -;; those keys is used outside a table, the function uses `key-binding' to -;; look up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that command. -;; There might be problems if any of the keys used by the table editor is -;; otherwise used as a prefix key. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -;; The optimized version (see variable `orgtbl-optimized') takes over -;; all keys which are bound to `self-insert-command' in the *global map*. -;; Some modes bind other commands to simple characters, for example -;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode -;; active, this binding is ignored inside tables and replaced with a -;; modified self-insert. - -(defvar orgtbl-mode nil - "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode' -table editor in arbitrary modes.") -(make-variable-buffer-local 'orgtbl-mode) - -(defvar orgtbl-mode-map (make-keymap) - "Keymap for `orgtbl-mode'.") - -;;;###autoload -(defun turn-on-orgtbl () - "Unconditionally turn on `orgtbl-mode'." - (orgtbl-mode 1)) - -(defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'") - -(defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\):\\)" - "Matches a line belonging to an orgtbl.") - -(defconst orgtbl-extra-font-lock-keywords - (list (list (concat "^" orgtbl-line-start-regexp ".*") - 0 (quote 'org-table) 'prepend)) - "Extra font-lock-keywords to be added when orgtbl-mode is active.") - -;;;###autoload -(defun orgtbl-mode (&optional arg) - "The `org-mode' table editor as a minor mode for use in other modes." - (interactive) - (if (org-mode-p) - ;; Exit without error, in case some hook functions calls this - ;; by accident in org-mode. - (message "Orgtbl-mode is not useful in org-mode, command ignored") - (setq orgtbl-mode - (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) - (if orgtbl-mode - (progn - (and (orgtbl-setup) (defun orgtbl-setup () nil)) - ;; Make sure we are first in minor-mode-map-alist - (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) - (and c (setq minor-mode-map-alist - (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu) - (run-hooks 'orgtbl-mode-hook)) - (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (org-cleanup-narrow-column-properties) - (org-remove-from-invisibility-spec '(org-cwidth)) - (remove-hook 'before-change-functions 'org-before-change-function t) - (when (fboundp 'font-lock-remove-keywords) - (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) - (force-mode-line-update 'all)))) - -(defun org-cleanup-narrow-column-properties () - "Remove all properties related to narrow-column invisibility." - (let ((s 1)) - (while (setq s (text-property-any s (point-max) - 'display org-narrow-column-arrow)) - (remove-text-properties s (1+ s) '(display t))) - (setq s 1) - (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) - (remove-text-properties s (1+ s) '(org-cwidth t))) - (setq s 1) - (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) - (remove-text-properties s (1+ s) '(invisible t))))) - -;; Install it as a minor mode. -(put 'orgtbl-mode :included t) -(put 'orgtbl-mode :menu-tag "Org Table Mode") -(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) - -(defun orgtbl-make-binding (fun n &rest keys) - "Create a function for binding in the table minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In tables, run `" (symbol-name fun) "'.\n" - "Outside of tables, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-at-table-p) - (list 'call-interactively (list 'quote fun)) - (list 'let '(orgtbl-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgtbl-error)))))))) - -(defun orgtbl-error () - "Error when there is no default binding for a table key." - (interactive) - (error "This key is has no function outside tables")) - -(defun orgtbl-setup () - "Setup orgtbl keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta shift left)] org-table-delete-column) - '([(meta left)] org-table-move-column-left) - '([(meta right)] org-table-move-column-right) - '([(meta shift right)] org-table-insert-column) - '([(meta shift up)] org-table-kill-row) - '([(meta shift down)] org-table-insert-row) - '([(meta up)] org-table-move-row-up) - '([(meta down)] org-table-move-row-down) - '("\C-c\C-w" org-table-cut-region) - '("\C-c\M-w" org-table-copy-region) - '("\C-c\C-y" org-table-paste-rectangle) - '("\C-c-" org-table-insert-hline) - '("\C-c}" org-table-toggle-coordinate-overlays) - '("\C-c{" org-table-toggle-formula-debugger) - '("\C-m" org-table-next-row) - '([(shift return)] org-table-copy-down) - '("\C-c\C-q" org-table-wrap-region) - '("\C-c?" org-table-field-info) - '("\C-c " org-table-blank-field) - '("\C-c+" org-table-sum) - '("\C-c=" org-table-eval-formula) - '("\C-c'" org-table-edit-formulas) - '("\C-c`" org-table-edit-field) - '("\C-c*" org-table-recalculate) - '("\C-c|" org-table-create-or-convert-from-region) - '("\C-c^" org-table-sort-lines) - '([(control ?#)] org-table-rotate-recalc-marks))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgtbl-make-binding fun nfunc key)) - (org-defkey orgtbl-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgtbl-mode-map [(return)] - (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) - (org-defkey orgtbl-mode-map "\C-m" - (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) - - (org-defkey orgtbl-mode-map [(tab)] - (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) - (org-defkey orgtbl-mode-map "\C-i" - (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) - - (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) - - (org-defkey orgtbl-mode-map "\M-\C-m" - (orgtbl-make-binding 'org-table-wrap-region 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgtbl-mode-map [(meta return)] - (orgtbl-make-binding 'org-table-wrap-region 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) - (when orgtbl-optimized - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap orgtbl-mode-map - 'self-insert-command 'orgtbl-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) - (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" - '("OrgTbl" - ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] - ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] - ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] - ["Next Row" org-return :active (org-at-table-p) :keys "RET"] - "--" - ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] - ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] - ["Copy Field from Above" - org-table-copy-down :active (org-at-table-p) :keys "S-RET"] - "--" - ("Column" - ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-"] - ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-"] - ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-"] - ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-"]) - ("Row" - ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-"] - ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-"] - ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-"] - ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-"] - ["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"] - "--" - ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) - ("Rectangle" - ["Copy Rectangle" org-copy-special :active (org-at-table-p)] - ["Cut Rectangle" org-cut-special :active (org-at-table-p)] - ["Paste Rectangle" org-paste-special :active (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) - "--" - ("Radio tables" - ["Insert table template" orgtbl-insert-radio-table - (assq major-mode orgtbl-radio-table-templates)] - ["Comment/uncomment table" orgtbl-toggle-comment t]) - "--" - ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] - ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] - ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] - ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] - ["Debug Formulas" - org-table-toggle-formula-debugger :active (org-at-table-p) - :keys "C-c {" - :style toggle :selected org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays :active (org-at-table-p) - :keys "C-c }" - :style toggle :selected org-table-overlay-coordinates] - )) - t)) - -(defun orgtbl-ctrl-c-ctrl-c (arg) - "If the cursor is inside a table, realign the table. -It it is a table to be sent away to a receiver, do it. -With prefix arg, also recompute table." - (interactive "P") - (let ((pos (point)) action) - (save-excursion - (beginning-of-line 1) - (setq action (cond ((looking-at "#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) - ((looking-at "[ \t]*|") pos) - ((looking-at "#\\+TBLFM:") 'recalc)))) - (cond - ((integerp action) - (goto-char action) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align) - (orgtbl-send-table 'maybe)) - ((eq action 'recalc) - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t (let (orgtbl-mode) - (call-interactively (key-binding "\C-c\C-c"))))))) - -(defun orgtbl-tab (arg) - "Justification and field motion for `orgtbl-mode'." - (interactive "P") - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (org-table-next-field))) - -(defun orgtbl-ret () - "Justification and field motion for `orgtbl-mode'." - (interactive) - (org-table-justify-field-maybe) - (org-table-next-row)) - -(defun orgtbl-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-at-table-p) - (or - (and org-table-auto-blank-field - (member last-command - '(orgtbl-hijacker-command-100 - orgtbl-hijacker-command-101 - orgtbl-hijacker-command-102 - orgtbl-hijacker-command-103 - orgtbl-hijacker-command-104 - orgtbl-hijacker-command-105)) - (org-table-blank-field)) - t) - (eq N 1) - (looking-at "[^|\n]* +|")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (let (orgtbl-mode) - (call-interactively (key-binding (vector last-input-event)))))) - -(defun org-force-self-insert (N) - "Needed to enforce self-insert under remapping." - (interactive "p") - (self-insert-command N)) - -(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" - "Regula expression matching exponentials as produced by calc.") - -(defvar org-table-clean-did-remove-column nil) - -(defun orgtbl-export (table target) - (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) - (lines (org-split-string table "[ \t]*\n[ \t]*")) - org-table-last-alignment org-table-last-column-widths - maxcol column) - (if (not (fboundp func)) - (error "Cannot export orgtbl table to %s" target)) - (setq lines (org-table-clean-before-export lines)) - (setq table - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines)) - (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) - table))) - (loop for i from (1- maxcol) downto 0 do - (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) - (setq column (delq nil column)) - (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) - (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) - (funcall func table nil))) - -(defun orgtbl-send-table (&optional maybe) - "Send a tranformed version of this table to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined for -this table." - (interactive) - (catch 'exit - (unless (org-at-table-p) (error "Not at a table")) - ;; when non-interactive, we assume align has just happened. - (when (interactive-p) (org-table-align)) - (save-excursion - (goto-char (org-table-begin)) - (beginning-of-line 0) - (unless (looking-at "#\\+ORGTBL: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") - (if maybe - (throw 'exit nil) - (error "Don't know how to transform this table.")))) - (let* ((name (match-string 1)) - beg - (transform (intern (match-string 2))) - (params (if (match-end 3) (read (concat "(" (match-string 3) ")")))) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (txt (buffer-substring-no-properties - (org-table-begin) (org-table-end))) - (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) - (lines (org-table-clean-before-export lines)) - (i0 (if org-table-clean-did-remove-column 2 1)) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0))) - - (unless (fboundp transform) - (error "No such transformation function %s" transform)) - (setq txt (funcall transform table params)) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated table")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t) - (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) - (goto-char beg) - (insert txt "\n")) - (message "Table converted and installed at receiver location")))) - -(defun org-remove-by-index (list indices &optional i0) - "Remove the elements in LIST with indices in INDICES. -First element has index 0, or I0 if given." - (if (not indices) - list - (if (integerp indices) (setq indices (list indices))) - (setq i0 (1- (or i0 0))) - (delq :rm (mapcar (lambda (x) - (setq i0 (1+ i0)) - (if (memq i0 indices) :rm x)) - list)))) - -(defun orgtbl-toggle-comment () - "Comment or uncomment the orgtbl at point." - (interactive) - (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) - (re2 (concat "^" orgtbl-line-start-regexp)) - (commented (save-excursion (beginning-of-line 1) - (cond ((looking-at re1) t) - ((looking-at re2) nil) - (t (error "Not at an org table"))))) - (re (if commented re1 re2)) - beg end) - (save-excursion - (beginning-of-line 1) - (while (looking-at re) (beginning-of-line 0)) - (beginning-of-line 2) - (setq beg (point)) - (while (looking-at re) (beginning-of-line 2)) - (setq end (point))) - (comment-region beg end (if commented '(4) nil)))) - -(defun orgtbl-insert-radio-table () - "Insert a radio table template appropriate for this major mode." - (interactive) - (let* ((e (assq major-mode orgtbl-radio-table-templates)) - (txt (nth 1 e)) - name pos) - (unless e (error "No radio table setup defined for %s" major-mode)) - (setq name (read-string "Table name: ")) - (while (string-match "%n" txt) - (setq txt (replace-match name t t txt))) - (or (bolp) (insert "\n")) - (setq pos (point)) - (insert txt) - (goto-char pos))) - -(defun org-get-param (params header i sym &optional hsym) - "Get parameter value for symbol SYM. -If this is a header line, actually get the value for the symbol with an -additional \"h\" inserted after the colon. -If the value is a protperty list, get the element for the current column. -Assumes variables VAL, PARAMS, HEAD and I to be scoped into the function." - (let ((val (plist-get params sym))) - (and hsym header (setq val (or (plist-get params hsym) val))) - (if (consp val) (plist-get val i) val))) - -(defun orgtbl-to-generic (table params) - "Convert the orgtbl-mode TABLE to some other format. -This generic routine can be used for many standard cases. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -For the generic converter, some parameters are obligatory: You need to -specify either :lfmt, or all of (:lstart :lend :sep). If you do not use -:splice, you must have :tstart and :tend. - -Valid parameters are - -:tstart String to start the table. Ignored when :splice is t. -:tend String to end the table. Ignored when :splice is t. - -:splice When set to t, return only table body lines, don't wrap - them into :tstart and :tend. Default is nil. - -:hline String to be inserted on horizontal separation lines. - May be nil to ignore hlines. - -:lstart String to start a new table line. -:lend String to end a table line -:sep Separator between two fields -:lfmt Format for entire line, with enough %s to capture all fields. - If this is present, :lstart, :lend, and :sep are ignored. -:fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in dollars, you could use :fmt \"$%s$\". - This may also be a property list with column numbers and - formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") - -:hlstart :hlend :hlsep :hlfmt :hfmt - Same as above, specific for the header lines in the table. - All lines before the first hline are treated as header. - If any of these is not present, the data line value is used. - -:efmt Use this format to print numbers with exponentials. - The format should have %s twice for inserting mantissa - and exponent, for example \"%s\\\\times10^{%s}\". This - may also be a property list with column numbers and - formats. :fmt will still be applied after :efmt. - -In addition to this, the parameters :skip and :skipcols are always handled -directly by `orgtbl-send-table'. See manual." - (interactive) - (let* ((p params) - (splicep (plist-get p :splice)) - (hline (plist-get p :hline)) - rtn line i fm efm lfmt h) - - ;; Do we have a header? - (if (and (not splicep) (listp (car table)) (memq 'hline table)) - (setq h t)) - - ;; Put header - (unless splicep - (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn)) - - ;; Now loop over all lines - (while (setq line (pop table)) - (if (eq line 'hline) - ;; A horizontal separator line - (progn (if hline (push hline rtn)) - (setq h nil)) ; no longer in header - ;; A normal line. Convert the fields, push line onto the result list - (setq i 0) - (setq line - (mapcar - (lambda (f) - (setq i (1+ i) - fm (org-get-param p h i :fmt :hfmt) - efm (org-get-param p h i :efmt)) - (if (and efm (string-match orgtbl-exp-regexp f)) - (setq f (format - efm (match-string 1 f) (match-string 2 f)))) - (if fm (setq f (format fm f))) - f) - line)) - (if (setq lfmt (org-get-param p h i :lfmt :hlfmt)) - (push (apply 'format lfmt line) rtn) - (push (concat - (org-get-param p h i :lstart :hlstart) - (mapconcat 'identity line (org-get-param p h i :sep :hsep)) - (org-get-param p h i :lend :hlend)) - rtn)))) - - (unless splicep - (push (or (plist-get p :tend) "ERROR: no :tend") rtn)) - - (mapconcat 'identity (nreverse rtn) "\n"))) - -(defun orgtbl-to-latex (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -LaTeX are: - -:splice When set to t, return only table body lines, don't wrap - them into a tabular environment. Default is nil. - -:fmt A format to be used to wrap the field, should contain %s for the - original field value. For example, to wrap everything in dollars, - use :fmt \"$%s$\". This may also be a property list with column - numbers and formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") - -:efmt Format for transforming numbers with exponentials. The format - should have %s twice for inserting mantissa and exponent, for - example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". - This may also be a property list with column numbers and formats. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) - org-table-last-alignment "")) - (params2 - (list - :tstart (concat "\\begin{tabular}{" alignment "}") - :tend "\\end{tabular}" - :lstart "" :lend " \\\\" :sep " & " - :efmt "%s\\,(%s)" :hline "\\hline"))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) - -(defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Currently this function recognizes the following parameters: - -:splice When set to t, return only table body lines, don't wrap - them into a
" . "" . "
environment. Default is nil. - -The general parameters :skip and :skipcols have already been applied when -this function is called. The function does *not* use `orgtbl-to-generic', -so you cannot specify parameters for it." - (let* ((splicep (plist-get params :splice)) - html) - ;; Just call the formatter we already have - ;; We need to make text lines for it, so put the fields back together. - (setq html (org-format-org-table-html - (mapcar - (lambda (x) - (if (eq x 'hline) - "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) - table) - splicep)) - (if (string-match "\n+\\'" html) - (setq html (replace-match "" t t html))) - html)) - -(defun orgtbl-to-texinfo (table params) - "Convert the orgtbl-mode TABLE to TeXInfo. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -TeXInfo are: - -:splice nil/t When set to t, return only table body lines, don't wrap - them into a multitable environment. Default is nil. - -:fmt fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in @kbd{}, you could use :fmt \"@kbd{%s}\". - This may also be a property list with column numbers and - formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). - -:cf \"f1 f2..\" The column fractions for the table. Bye default these - are computed automatically from the width of the columns - under org-mode. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((total (float (apply '+ org-table-last-column-widths))) - (colfrac (or (plist-get params :cf) - (mapconcat - (lambda (x) (format "%.3f" (/ (float x) total))) - org-table-last-column-widths " "))) - (params2 - (list - :tstart (concat "@multitable @columnfractions " colfrac) - :tend "@end multitable" - :lstart "@item " :lend "" :sep " @tab " - :hlstart "@headitem "))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) - -;;;; Link Stuff - -;;; Link abbreviations - -(defun org-link-expand-abbrev (link) - "Apply replacements as defined in `org-link-abbrev-alist." - (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) - (let* ((key (match-string 1 link)) - (as (or (assoc key org-link-abbrev-alist-local) - (assoc key org-link-abbrev-alist))) - (tag (and (match-end 2) (match-string 3 link))) - rpl) - (if (not as) - link - (setq rpl (cdr as)) - (cond - ((symbolp rpl) (funcall rpl tag)) - ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) - (t (concat rpl tag))))) - link)) - -;;; Storing and inserting links - -(defvar org-insert-link-history nil - "Minibuffer history for links inserted with `org-insert-link'.") - -(defvar org-stored-links nil - "Contains the links stored with `org-store-link'.") - -(defvar org-store-link-plist nil - "Plist with info about the most recently link created with `org-store-link'.") - -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") - -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. -Each function will be called in turn until one returns a non-nil -value. Each function should check if it is responsible for creating -this link (for example by looking at the major mode). -If not, it must exit and return nil. -If yes, it should return a non-nil value after a calling -`org-store-link-props' with a list of properties and values. -Special properties are: - -:type The link prefix. like \"http\". This must be given. -:link The link, like \"http://www.astro.uva.nl/~dominik\". - This is obligatory as well. -:description Optional default description for the second pair - of brackets in an Org-mode link. The user can still change - this when inserting this link into an Org-mode buffer. - -In addition to these, any additional properties can be specified -and then used in remember templates.") - -(defun org-add-link-type (type &optional follow publish) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' -FOLLOW and PUBLISH are two functions. Both take the link path as -an argument. -FOLLOW should do whatever is necessary to follow the link, for example -to find a file or display a mail message. - -PUBLISH takes the path and retuns the string that should be used when -this document is published. FIMXE: This is actually not yet implemented." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (add-to-list 'org-link-protocols - (list type follow publish))) - -(defun org-add-agenda-custom-command (entry) - "Replace or add a command in `org-agenda-custom-commands'. -This is mostly for hacking and trying a new command - once the command -works you probably want to add it to `org-agenda-custom-commands' for good." - (let ((ass (assoc (car entry) org-agenda-custom-commands))) - (if ass - (setcdr ass (cdr entry)) - (push entry org-agenda-custom-commands)))) - -;;;###autoload -(defun org-store-link (arg) - "\\Store an org-link to the current location. -This link can later be inserted into an org-buffer with -\\[org-insert-link]. -For some link types, a prefix arg is interpreted: -For links to usenet articles, arg negates `org-usenet-links-prefer-google'. -For file links, arg negates `org-context-in-file-links'." - (interactive "P") - (setq org-store-link-plist nil) ; reset - (let (link cpltxt desc description search txt) - (cond - - ((run-hook-with-args-until-success 'org-store-link-functions) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist :description) link))) - - ((eq major-mode 'bbdb-mode) - (let ((name (bbdb-record-name (bbdb-current-record))) - (company (bbdb-record-getprop (bbdb-current-record) 'company))) - (setq cpltxt (concat "bbdb:" (or name company)) - link (org-make-link cpltxt)) - (org-store-link-props :type "bbdb" :name name :company company))) - - ((eq major-mode 'Info-mode) - (setq link (org-make-link "info:" - (file-name-nondirectory Info-current-file) - ":" Info-current-node)) - (setq cpltxt (concat (file-name-nondirectory Info-current-file) - ":" Info-current-node)) - (org-store-link-props :type "info" :file Info-current-file - :node Info-current-node)) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((or (eq major-mode 'vm-summary-mode) - (eq major-mode 'vm-presentation-mode)) - (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) - (vm-follow-summary-cursor) - (save-excursion - (vm-select-folder-buffer) - (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) - (subject (vm-su-subject message)) - (to (vm-get-header-contents message "To")) - (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message))) - (org-store-link-props :type "vm" :from from :to to :subject subject - :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq folder (abbreviate-file-name folder)) - (if (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder) - (setq folder (replace-match "" t t folder))) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "vm:" folder "#" message-id))))) - - ((eq major-mode 'wl-summary-mode) - (let* ((msgnum (wl-summary-message-number)) - (message-id (elmo-message-field wl-summary-buffer-elmo-folder - msgnum 'message-id)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (from (wl-summary-line-from)) - (to (elmo-message-entity-field wl-message-entity 'to)) - (subject (let (wl-thr-indent-string wl-parent-message-entity) - (wl-summary-line-subject)))) - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "wl:" wl-summary-buffer-folder-name - "#" message-id)))) - - ((or (equal major-mode 'mh-folder-mode) - (equal major-mode 'mh-show-mode)) - (let ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:"))) - (org-store-link-props :type "mh" :from from :to to - :subject subject :message-id message-id) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))))) - - ((eq major-mode 'rmail-mode) - (save-excursion - (save-restriction - (rmail-narrow-to-non-pruned-header) - (let ((folder buffer-file-name) - (message-id (mail-fetch-field "message-id")) - (from (mail-fetch-field "from")) - (to (mail-fetch-field "to")) - (subject (mail-fetch-field "subject"))) - (org-store-link-props - :type "rmail" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "rmail:" folder "#" message-id)))))) - - ((eq major-mode 'gnus-group-mode) - (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus - (gnus-group-group-name)) ; version - ((fboundp 'gnus-group-name) - (gnus-group-name)) - (t "???")))) - (unless group (error "Not on a group")) - (org-store-link-props :type "gnus" :group group) - (setq cpltxt (concat - (if (org-xor arg org-usenet-links-prefer-google) - "http://groups.google.com/groups?group=" - "gnus:") - group) - link (org-make-link cpltxt)))) - - ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) - (let* ((group gnus-newsgroup-name) - (article (gnus-summary-article-number)) - (header (gnus-summary-article-header article)) - (from (mail-header-from header)) - (message-id (mail-header-id header)) - (date (mail-header-date header)) - (subject (gnus-summary-subject-string))) - (org-store-link-props :type "gnus" :from from :subject subject - :message-id message-id :group group) - (setq cpltxt (org-email-link-description)) - (if (org-xor arg org-usenet-links-prefer-google) - (setq link - (concat - cpltxt "\n " - (format "http://groups.google.com/groups?as_umsgid=%s" - (org-fixup-message-id-for-http message-id)))) - (setq link (org-make-link "gnus:" group - "#" (number-to-string article)))))) - - ((eq major-mode 'w3-mode) - (setq cpltxt (url-view-url t) - link (org-make-link cpltxt)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'w3m-mode) - (setq cpltxt (or w3m-current-title w3m-current-url) - link (org-make-link w3m-current-url)) - (org-store-link-props :type "w3m" :url (url-view-url t))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt)) - (org-store-link-props :type "image" :file buffer-file-name)) - - ((eq major-mode 'dired-mode) - ;; link to the file in the current line - (setq cpltxt (concat "file:" - (abbreviate-file-name - (expand-file-name - (dired-get-filename nil t)))) - link (org-make-link cpltxt))) - - ((and buffer-file-name (org-mode-p)) - ;; Just link to current headline - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) - ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - ;; Check if we are on a target - (if (org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt (concat cpltxt "::" (match-string 1))) - (setq txt (cond - ((org-on-heading-p) nil) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))) - (t (buffer-substring (point-at-bol) (point-at-eol))))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link (org-make-link cpltxt))) - - ((interactive-p) - (error "Cannot link to a buffer which is not visiting a file")) - - (t (setq link nil))) - - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (if (equal desc "NONE") (setq desc nil)) - - (if (and (interactive-p) link) - (progn - (setq org-stored-links - (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link))) - (and link (org-make-link-string link desc))))) - -(defun org-store-link-props (&rest plist) - "Store link properties, extract names and addresses." - (let (x adr) - (when (setq x (plist-get plist :from)) - (setq adr (mail-extract-address-components x)) - (plist-put plist :fromname (car adr)) - (plist-put plist :fromaddress (nth 1 adr))) - (when (setq x (plist-get plist :to)) - (setq adr (mail-extract-address-components x)) - (plist-put plist :toname (car adr)) - (plist-put plist :toaddress (nth 1 adr)))) - (let ((from (plist-get plist :from)) - (to (plist-get plist :to))) - (when (and from to org-from-is-user-regexp) - (plist-put plist :fromto - (if (string-match org-from-is-user-regexp from) - (concat "to %t") - (concat "from %f"))))) - (setq org-store-link-plist plist)) - -(defun org-email-link-description (&optional fmt) - "Return the description part of an email link. -This takes information from `org-store-link-plist' and formats it -according to FMT (default from `org-email-link-description-format')." - (setq fmt (or fmt org-email-link-description-format)) - (let* ((p org-store-link-plist) - (to (plist-get p :toaddress)) - (from (plist-get p :fromaddress)) - (table - (list - (cons "%c" (plist-get p :fromto)) - (cons "%F" (plist-get p :from)) - (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) - (cons "%T" (plist-get p :to)) - (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) - (cons "%s" (plist-get p :subject)) - (cons "%m" (plist-get p :message-id))))) - (when (string-match "%c" fmt) - ;; Check if the user wrote this message - (if (and org-from-is-user-regexp from to - (save-match-data (string-match org-from-is-user-regexp from))) - (setq fmt (replace-match "to %t" t t fmt)) - (setq fmt (replace-match "from %f" t t fmt)))) - (org-replace-escapes fmt table))) - -(defun org-make-org-heading-search-string (&optional string heading) - "Make search string for STRING or current headline." - (interactive) - (let ((s (or string (org-get-heading)))) - (unless (and string (not heading)) - ;; We are using a headline, clean up garbage in there. - (if (string-match org-todo-regexp s) - (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) - (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (if (string-match (concat "^\\(" org-quote-string "\\|" - org-comment-string "\\)") s) - (setq s (replace-match "" t t s))) - (while (string-match org-ts-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match "[^a-zA-Z_0-9 \t]+" s) - (setq s (replace-match " " t t s))) - (or string (setq s (concat "*" s))) ; Add * for headlines - (mapconcat 'identity (org-split-string s "[ \t]+") " "))) - -(defun org-make-link (&rest strings) - "Concatenate STRINGS." - (apply 'concat strings)) - -(defun org-make-link-string (link &optional description) - "Make a link with brackets, consisting of LINK and DESCRIPTION." - (unless (string-match "\\S-" link) - (error "Empty link")) - (when (stringp description) - ;; Remove brackets from the description, they are fatal. - (while (string-match "\\[\\|\\]" description) - (setq description (replace-match "" t t description)))) - (when (equal (org-link-escape link) description) - ;; No description needed, it is identical - (setq description nil)) - (when (and (not description) - (not (equal link (org-link-escape link)))) - (setq description link)) - (concat "[[" (org-link-escape link) "]" - (if description (concat "[" description "]") "") - "]")) - -(defconst org-link-escape-chars - '((?\ . "%20") - (?\[ . "%5B") - (?\] . "%5d") - (?\340 . "%E0") ; `a - (?\342 . "%E2") ; ^a - (?\347 . "%E7") ; ,c - (?\350 . "%E8") ; `e - (?\351 . "%E9") ; 'e - (?\352 . "%EA") ; ^e - (?\356 . "%EE") ; ^i - (?\364 . "%F4") ; ^o - (?\371 . "%F9") ; `u - (?\373 . "%FB") ; ^u - (?\; . "%3B") - (?? . "%3F") - (?= . "%3D") - (?+ . "%2B") - ) - "Association list of escapes for some characters problematic in links. -This is the list that is used for internal purposes.") - -(defconst org-link-escape-chars-browser - '((?\ . "%20")) ; 32 for the SPC char - - "Association list of escapes for some characters problematic in links. -This is the list that is used before handing over to the browser.") - -(defun org-link-escape (text &optional table) - "Escape charaters in TEXT that are problematic for links." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote - (char-to-string (car x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (cdr (assoc (string-to-char (match-string 0 text)) - table)) - t t text))) - text))) - -(defun org-link-unescape (text &optional table) - "Reverse the action of `org-link-escape'." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (char-to-string (car (rassoc (match-string 0 text) table))) - t t text))) - text))) - -(defun org-xor (a b) - "Exclusive or." - (if a (not b) b)) - -(defun org-get-header (header) - "Find a header field in the current buffer." - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t) s) - (cond - ((eq header 'from) - (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1))) - (while (string-match "\"" s) - (setq s (replace-match "" t t s))) - (if (string-match "[<(].*" s) - (setq s (replace-match "" t t s)))) - ((eq header 'message-id) - (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1)))) - ((eq header 'subject) - (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1))))) - (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) - s))) - - -(defun org-fixup-message-id-for-http (s) - "Replace special characters in a message id, so it can be used in an http query." - (while (string-match "<" s) - (setq s (replace-match "%3C" t t s))) - (while (string-match ">" s) - (setq s (replace-match "%3E" t t s))) - (while (string-match "@" s) - (setq s (replace-match "%40" t t s))) - s) - -;;;###autoload -(defun org-insert-link-global () - "Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax." - (interactive) - (org-run-like-in-org-mode 'org-insert-link)) - -(defun org-insert-link (&optional complete-file) - "Insert a link. At the prompt, enter the link. - -Completion can be used to select a link previously stored with -`org-store-link'. When the empty string is entered (i.e. if you just -press RET at the prompt), the link defaults to the most recently -stored link. As SPC triggers completion in the minibuffer, you need to -use M-SPC or C-q SPC to force the insertion of a space character. - -You will also be prompted for a description, and if one is given, it will -be displayed in the buffer instead of the link. - -If there is already a link at point, this command will allow you to edit link -and description parts. - -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be -selected using completion. The path to the file will be relative to -the current directory if the file is in the current directory or a -subdirectory. Otherwise, the link will be the absolute path as -completed in the minibuffer (i.e. normally ~/path/to/file). - -With two \\[universal-argument] prefixes, enforce an absolute path even if the file -is in the current directory or below. -With three \\[universal-argument] prefixes, negate the meaning of -`org-keep-stored-link-after-insertion'." - (interactive "P") - (let* ((wcf (current-window-configuration)) - (region (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) - (remove (and region (list (region-beginning) (region-end)))) - (desc region) - tmphist ; byte-compile incorrectly complains about this - link entry file) - (cond - ((org-in-regexp org-bracket-link-regexp 1) - ;; We do have a link at point, and we are going to edit it. - (setq remove (list (match-beginning 0) (match-end 0))) - (setq desc (if (match-end 3) (org-match-string-no-properties 3))) - (setq link (read-string "Link: " - (org-link-unescape - (org-match-string-no-properties 1))))) - ((or (org-in-regexp org-angle-link-re) - (org-in-regexp org-plain-link-re)) - ;; Convert to bracket link - (setq remove (list (match-beginning 0) (match-end 0)) - link (read-string "Link: " - (org-remove-angle-brackets (match-string 0))))) - ((equal complete-file '(4)) - ;; Completing read for file names. - (setq file (read-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond - ((equal complete-file '(16)) - (setq link (org-make-link - "file:" - (abbreviate-file-name (expand-file-name file))))) - ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (org-make-link "file:" (match-string 1 file)))) - ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (setq link (org-make-link - "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (org-make-link "file:" file)))))) - (t - ;; Read link, with completion for stored links. - (with-output-to-temp-buffer "*Org Links*" - (princ "Insert a link. Use TAB to complete valid link prefixes.\n") - (when org-stored-links - (princ "\nStored links are available with / or M-p/n (most recent with RET):\n\n") - (princ (mapconcat - (lambda (x) - (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) - (reverse org-stored-links) "\n")))) - (let ((cw (selected-window))) - (select-window (get-buffer-window "*Org Links*")) - (shrink-window-if-larger-than-buffer) - (setq truncate-lines t) - (select-window cw)) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) - (unwind-protect - (setq link (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (list (concat (car x) ":"))) - (append org-link-abbrev-alist-local org-link-abbrev-alist)) - (mapcar (lambda (x) (list (concat x ":"))) - org-link-types)) - nil nil nil - 'tmphist - (or (car (car org-stored-links))))) - (set-window-configuration wcf) - (kill-buffer "*Org Links*")) - (setq entry (assoc link org-stored-links)) - (or entry (push link org-insert-link-history)) - (if (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) - (setq desc (or desc (nth 1 entry))))) - - (if (string-match org-plain-link-re link) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-make-link (org-remove-angle-brackets link)))) - - ;; Check if we are linking to the current file with a search option - ;; If yes, simplify the link by using only the search option. - (when (and buffer-file-name - (string-match "\\]+\\)" link)) - (let* ((path (match-string 1 link)) - (case-fold-search nil) - (search (match-string 2 link))) - (save-match-data - (if (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) - - ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "\\" "") html)) - (setq tbopen t) - (while (setq line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" line) - (progn - (unless splice - (push (if head "" "") html) - (if lines (push "" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) - (setq nlines (1+ nlines) i -1) - (push (concat "" - (mapconcat - (lambda (x) - (setq i (1+ i)) - (if (and (< i nlines) - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - fields "") - "") - html))) - (unless splice (if tbopen (push "" html))) - (unless splice (push "
\n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortuntely often ignored...) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s%s" - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen "\n" "") - (setq colgropen t)) - "") - (if (> (/ (float x) nlines) org-table-number-fraction) - "right" "left") - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "") - ""))) - fnum "") - html) - (if colgropen (setq html (cons (car html) (cons "" (cdr html))))) - (push html-table-tag html)) - (concat (mapconcat 'identity html "\n") "\n"))) - -(defun org-table-clean-before-export (lines) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match "^[ \t]*| *\\([#!$*_^ /]\\) *|" x))) - lines)) - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((string-match "^[ \t]*| */ *|" x) - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - (t x))) - lines))) - (setq org-table-clean-did-remove-column t) - (delq nil - (mapcar - (lambda (x) - (cond - ((string-match "^[ \t]*| */ *|" x) - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((string-match "^[ \t]*| *[!_^/] *|" x) - nil) ; ignore this line - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) - ;; remove the first column - (replace-match "\\1|" t nil x)))) - lines)))) - -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (head org-export-highlight-first-table-line) - fields html empty) - (setq html (concat html-table-tag "\n")) - (while (setq line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "
" (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines) - "Format a table into html, using `table-generate-source' from table.el. -This has the advantage that cell- or row-spanning is allowed. -But it has the disadvantage, that Org-mode's HTML conversions cannot be used." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max)))) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (while (string-match org-maybe-keyword-time-regexp s) - (if (and (match-end 1) (equal (match-string 1 s) org-clock-string)) - ;; never export CLOCK - (throw 'exit "")) - (or b (setq b (substring s 0 (match-beginning 0)))) - (if (not org-export-with-timestamps) - (setq r (concat r (substring s 0 (match-beginning 0))) - s (substring s (match-end 0))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - (if (match-end 1) - (format "@%s @" - (match-string 1 s))) - (format " @%s@" - (substring - (org-translate-time (match-string 3 s)) 1 -1))) - s (substring s (match-end 0))))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@
"))) - r)))) - -(defun org-html-protect (s) - ;; convert & to &, < to < and > to > - (let ((start 0)) - (while (string-match "&" s start) - (setq s (replace-match "&" t t s) - start (1+ (match-beginning 0)))) - (while (string-match "<" s) - (setq s (replace-match "<" t t s))) - (while (string-match ">" s) - (setq s (replace-match ">" t t s)))) - s) - -(defun org-export-cleanup-toc-line (s) - "Remove tags and time staps from lines going into the toc." - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) - (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - s) - -(defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. -If there are links in the string, don't modify these." - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res)))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (let ((start 0)) - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s))))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd ass) - (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - -(defconst org-export-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defvar org-par-open nil) -(defun org-open-par () - "Insert

, but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n

") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "

") - (setq org-par-open nil))) -(defun org-close-li () - "Close
  • if necessary." - (org-close-par-maybe) - (insert "
    • \n")) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let ((l org-level-max)) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - "   " - (mapconcat 'identity (org-split-string - (match-string 1 title) ":") - " ") - "")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (insert "
  • " title "
    \n")) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (insert "
      \n
    • " title "
      \n"))) - (aset org-levels-open (1- level) t) - (if (and org-export-with-section-numbers (not body-only)) - (setq title (concat (org-section-number level) " " title))) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if with-toc - (insert (format "\n
      \n%s\n" - level level head-count title level)) - (insert (format "\n
      \n%s\n" level level title level))) - (org-open-par))))) - -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "
      \n") - (org-close-li) - (insert "
    \n"))) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-prepare-agenda-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-start-icalendar-file org-icalendar-combined-name)) - (org-start-icalendar-file category)) - (org-print-icalendar-entries combine) - (when (or (and combine (not files)) (not combine)) - (org-finish-icalendar-file) - (set-buffer ical-buffer) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook))))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calenndar application to re-read -the iCalendar file.") - -(defun org-print-icalendar-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-ical-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep tmp pri category entry location summary desc - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (setq pos (match-beginning 0) - ts (match-string 0) - inc t - hd (org-get-heading) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION")) - category (org-get-category)) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) inc nil)) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - ;; donep (org-entry-is-done-p) - )) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (insert (substring ts 1 -1) " " summary "\n")) - (princ (format "BEGIN:VEVENT -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s -END:VEVENT\n" - (org-ical-ts-to-string ts "DTSTART") - (org-ical-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - category))))) - - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")) - (princ (org-diary-to-ical-string sexp-buffer))))) - - (when org-icalendar-include-todo - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (catch :skip - (org-agenda-skip) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (or (not (member state org-done-keywords)) - (eq org-icalendar-include-todo 'all)) - (not (member org-archive-tag (org-get-tags-at))) - ) - (setq hd (match-string 3) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION"))) - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -%s -SUMMARY:%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - dts - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - category pri status))))))))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (when is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))))) - (let ((start 0)) - (while (string-match "\\([,;\\]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (setq s (org-trim s)) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-get-entry () - "Clean-up description string." - (save-excursion - (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) - -(defun org-start-icalendar-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (cadr (current-time-zone)))) - (princ - (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org-mode//EN -X-WR-TIMEZONE:%s -CALSCALE:GREGORIAN\n" name user timezone)))) - -(defun org-finish-icalendar-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-ical-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (org-parse-time-string s 'nodefault)) - t2 fmt have-time time) - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time)))) - -;;; XOXO export - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-*" - (interactive (list (current-buffer))) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "
      \n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n
        \n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n")) - (org-export-as-xoxo-insert-into out "
      \n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "
    1. ") - (org-export-as-xoxo-insert-into out "
    2. " text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "
      3. \n")) - (org-export-as-xoxo-insert-into out "
    \n")) - - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (save-buffer) - (goto-char (point-min)) - ))) - - -;;;; Key bindings - -;; Make `C-c C-x' a prefix key -(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) - -;; TAB key with modifiers -(org-defkey org-mode-map "\C-i" 'org-cycle) -(org-defkey org-mode-map [(tab)] 'org-cycle) -(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) -(org-defkey org-mode-map [(meta tab)] 'org-complete) -(org-defkey org-mode-map "\M-\t" 'org-complete) -(org-defkey org-mode-map "\M-\C-i" 'org-complete) -;; The following line is necessary under Suse GNU/Linux -(unless (featurep 'xemacs) - (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) -(org-defkey org-mode-map [(shift tab)] 'org-shifttab) -(define-key org-mode-map [backtab] 'org-shifttab) - -(org-defkey org-mode-map [(shift return)] 'org-table-copy-down) -(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) -(org-defkey org-mode-map [(meta return)] 'org-meta-return) - -;; Cursor keys with modifiers -(org-defkey org-mode-map [(meta left)] 'org-metaleft) -(org-defkey org-mode-map [(meta right)] 'org-metaright) -(org-defkey org-mode-map [(meta up)] 'org-metaup) -(org-defkey org-mode-map [(meta down)] 'org-metadown) - -(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) -(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) -(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) -(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) - -(org-defkey org-mode-map [(shift up)] 'org-shiftup) -(org-defkey org-mode-map [(shift down)] 'org-shiftdown) -(org-defkey org-mode-map [(shift left)] 'org-shiftleft) -(org-defkey org-mode-map [(shift right)] 'org-shiftright) - -(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) -(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) - -;;; Extra keys for tty access. -;; We only set them when really needed because otherwise the -;; menus don't show the simple keys - -(when (or (featurep 'xemacs) ;; because XEmacs supports multi-device stuff - (not window-system)) - (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) - (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) - (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) - (org-defkey org-mode-map [?\e (return)] 'org-meta-return) - (org-defkey org-mode-map [?\e (left)] 'org-metaleft) - (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) - (org-defkey org-mode-map [?\e (right)] 'org-metaright) - (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) - (org-defkey org-mode-map [?\e (up)] 'org-metaup) - (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) - (org-defkey org-mode-map [?\e (down)] 'org-metadown) - (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) - (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) - (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) - (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) - (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) - (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) - (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) - (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) - (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) - (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) - (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)) - - ;; All the other keys - -(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. -(org-defkey org-mode-map "\C-c\C-r" 'org-reveal) -(org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree) -(org-defkey org-mode-map "\C-c$" 'org-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) -(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) -(org-defkey org-mode-map "\C-c\C-j" 'org-goto) -(org-defkey org-mode-map "\C-c\C-t" 'org-todo) -(org-defkey org-mode-map "\C-c\C-s" 'org-schedule) -(org-defkey org-mode-map "\C-c\C-d" 'org-deadline) -(org-defkey org-mode-map "\C-c;" 'org-toggle-comment) -(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) -(org-defkey org-mode-map "\C-c\C-w" 'org-refile) -(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. -(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) -(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) -(org-defkey org-mode-map [(control return)] 'org-insert-heading-after-current) -(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) -(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) -(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) -(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) -(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) -(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) -(org-defkey org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding -(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. -(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) -(org-defkey org-mode-map "\C-c>" 'org-goto-calendar) -(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) -(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) -(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) -(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) -(org-defkey org-mode-map "\C-c]" 'org-remove-file) -(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) -(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) -(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) -(org-defkey org-mode-map "\C-c^" 'org-sort) -(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) -(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) -(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) -(org-defkey org-mode-map "\C-m" 'org-return) -(org-defkey org-mode-map "\C-j" 'org-return-indent) -(org-defkey org-mode-map "\C-c?" 'org-table-field-info) -(org-defkey org-mode-map "\C-c " 'org-table-blank-field) -(org-defkey org-mode-map "\C-c+" 'org-table-sum) -(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) -(org-defkey org-mode-map "\C-c'" 'org-table-edit-formulas) -(org-defkey org-mode-map "\C-c`" 'org-table-edit-field) -(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) -(org-defkey org-mode-map "\C-c*" 'org-table-recalculate) -(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) -(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) -(org-defkey org-mode-map "\C-c\C-q" 'org-table-wrap-region) -(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) -(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) -(org-defkey org-mode-map "\C-c\C-e" 'org-export) -(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) -(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) - -(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-cut-special) -(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) -(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) -(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) - -(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) -(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) -(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) -(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) -(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) -(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) -(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) -(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) -(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) -(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) -(org-defkey org-mode-map "\C-c\C-xr" 'org-insert-columns-dblock) - -(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) - -(when (featurep 'xemacs) - (org-defkey org-mode-map 'button3 'popup-mode-menu)) - -(defsubst org-table-p () (org-at-table-p)) - -(defun org-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-table-p) - (progn - ;; check if we blank the field, and if that triggers align - (and org-table-auto-blank-field - (member last-command - '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width - (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width - (org-table-blank-field))) - t) - (eq N 1) - (looking-at "[^|\n]* |")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (self-insert-command N) - (org-fix-tags-on-the-fly))) - -(defun org-fix-tags-on-the-fly () - (when (and (equal (char-after (point-at-bol)) ?*) - (org-on-heading-p)) - (org-align-tags-here org-tags-column))) - -(defun org-delete-backward-char (N) - "Like `delete-backward-char', insert whitespace at field end in tables. -When deleting backwards, in tables this function will insert whitespace in -front of the next \"|\" separator, to keep the table aligned. The table will -still be marked for re-alignment if the field did fill the entire column, -because, in this case the deletion might narrow the column." - (interactive "p") - (if (and (org-table-p) - (eq N 1) - (string-match "|" (buffer-substring (point-at-bol) (point))) - (looking-at ".*?|")) - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (backward-delete-char N) - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (backward-delete-char N) - (org-fix-tags-on-the-fly))) - -(defun org-delete-char (N) - "Like `delete-char', but insert whitespace at field end in tables. -When deleting characters, in tables this function will insert whitespace in -front of the next \"|\" separator, to keep the table aligned. The table will -still be marked for re-alignment if the field did fill the entire column, -because, in this case the deletion might narrow the column." - (interactive "p") - (if (and (org-table-p) - (not (bolp)) - (not (= (char-after) ?|)) - (eq N 1)) - (if (looking-at ".*?|") - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (replace-match (concat - (substring (match-string 0) 1 -1) - " |")) - (goto-char pos) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (delete-char N)) - (delete-char N) - (org-fix-tags-on-the-fly))) - -;; Make `delete-selection-mode' work with org-mode and orgtbl-mode -(put 'org-self-insert-command 'delete-selection t) -(put 'orgtbl-self-insert-command 'delete-selection t) -(put 'org-delete-char 'delete-selection 'supersede) -(put 'org-delete-backward-char 'delete-selection 'supersede) - -;; Make `flyspell-mode' delay after some commands -(put 'org-self-insert-command 'flyspell-delayed t) -(put 'orgtbl-self-insert-command 'flyspell-delayed t) -(put 'org-delete-char 'flyspell-delayed t) -(put 'org-delete-backward-char 'flyspell-delayed t) - -;; Make pabbrev-mode expand after org-mode commands -(put 'org-self-insert-command 'pabbrev-expand-after-command t) -(put 'orgybl-self-insert-command 'pabbrev-expand-after-command t) - -;; How to do this: Measure non-white length of current string -;; If equal to column width, we should realign. - -(defun org-remap (map &rest commands) - "In MAP, remap the functions given in COMMANDS. -COMMANDS is a list of alternating OLDDEF NEWDEF command names." - (let (new old) - (while commands - (setq old (pop commands) new (pop commands)) - (if (fboundp 'command-remapping) - (org-defkey map (vector 'remap old) new) - (substitute-key-definition old new map global-map))))) - -(when (eq org-enable-table-editor 'optimized) - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap org-mode-map - 'self-insert-command 'org-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey org-mode-map "|" 'org-force-self-insert)) - -(defun org-shiftcursor-error () - "Throw an error because Shift-Cursor command was applied in wrong context." - (error "This command is active in special context like tables, headlines or timestamps")) - -(defun org-shifttab (&optional arg) - "Global visibility cycling or move to previous table field. -Calls `org-cycle' with argument t, or `org-table-previous-field', depending -on context. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-previous-field)) - (arg (message "Content view to level: ") - (org-content (prefix-numeric-value arg)) - (setq org-cycle-global-status 'overview)) - (t (call-interactively 'org-global-cycle)))) - -(defun org-shiftmetaleft () - "Promote subtree or delete table column. -Calls `org-promote-subtree', `org-outdent-item', -or `org-table-delete-column', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-delete-column)) - ((org-on-heading-p) (call-interactively 'org-promote-subtree)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) - (t (org-shiftcursor-error)))) - -(defun org-shiftmetaright () - "Demote subtree or insert table column. -Calls `org-demote-subtree', `org-indent-item', -or `org-table-insert-column', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-insert-column)) - ((org-on-heading-p) (call-interactively 'org-demote-subtree)) - ((org-at-item-p) (call-interactively 'org-indent-item)) - (t (org-shiftcursor-error)))) - -(defun org-shiftmetaup (&optional arg) - "Move subtree up or kill table row. -Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-kill-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (org-shiftcursor-error)))) -(defun org-shiftmetadown (&optional arg) - "Move subtree down or insert table row. -Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-insert-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (org-shiftcursor-error)))) - -(defun org-metaleft (&optional arg) - "Promote heading or move table column to left. -Calls `org-do-promote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `backward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) - ((or (org-on-heading-p) (org-region-active-p)) - (call-interactively 'org-do-promote)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) - (t (call-interactively 'backward-word)))) - -(defun org-metaright (&optional arg) - "Demote subtree or move table column to right. -Calls `org-do-demote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `forward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-move-column)) - ((or (org-on-heading-p) (org-region-active-p)) - (call-interactively 'org-do-demote)) - ((org-at-item-p) (call-interactively 'org-indent-item)) - (t (call-interactively 'forward-word)))) - -(defun org-metaup (&optional arg) - "Move subtree up or move table row up. -Calls `org-move-subtree-up' or `org-table-move-row' or -`org-move-item-up', depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (transpose-lines 1) (beginning-of-line -1)))) - -(defun org-metadown (&optional arg) - "Move subtree down or move table row down. -Calls `org-move-subtree-down' or `org-table-move-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-move-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) - -(defun org-shiftup (&optional arg) - "Increase item in timestamp or increase priority of current headline. -Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', -depending on context. See the individual commands for more information." - (interactive "P") - (cond - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-down 'org-timestamp-up))) - ((org-on-heading-p) (call-interactively 'org-priority-up)) - ((org-at-item-p) (call-interactively 'org-previous-item)) - (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) - -(defun org-shiftdown (&optional arg) - "Decrease item in timestamp or decrease priority of current headline. -Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' -depending on context. See the individual commands for more information." - (interactive "P") - (cond - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-up 'org-timestamp-down))) - ((org-on-heading-p) (call-interactively 'org-priority-down)) - (t (call-interactively 'org-next-item)))) - -(defun org-shiftright () - "Next TODO keyword or timestamp one day later, depending on context." - (interactive) - (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) - ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) - ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil)) - ((org-at-property-p) (call-interactively 'org-property-next-allowed-value)) - (t (org-shiftcursor-error)))) - -(defun org-shiftleft () - "Previous TODO keyword or timestamp one day earlier, depending on context." - (interactive) - (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) - ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) - ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous)) - ((org-at-property-p) - (call-interactively 'org-property-previous-allowed-value)) - (t (org-shiftcursor-error)))) - -(defun org-shiftcontrolright () - "Switch to next TODO set." - (interactive) - (cond - ((org-on-heading-p) (org-call-with-arg 'org-todo 'nextset)) - (t (org-shiftcursor-error)))) - -(defun org-shiftcontrolleft () - "Switch to previous TODO set." - (interactive) - (cond - ((org-on-heading-p) (org-call-with-arg 'org-todo 'previousset)) - (t (org-shiftcursor-error)))) - -(defun org-ctrl-c-ret () - "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) - (t (call-interactively 'org-insert-heading)))) - -(defun org-copy-special () - "Copy region in table or copy current subtree. -Calls `org-table-copy' or `org-copy-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) - -(defun org-cut-special () - "Cut region in table or cut current subtree. -Calls `org-table-copy' or `org-cut-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) - -(defun org-paste-special (arg) - "Paste rectangular region into table, or past subtree relative to level. -Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. -See the individual commands for more information." - (interactive "P") - (if (org-at-table-p) - (org-table-paste-rectangle) - (org-paste-subtree arg))) - -(defun org-ctrl-c-ctrl-c (&optional arg) - "Set tags in headline, or update according to changed information at point. - -This command does many different things, depending on context: - -- If the cursor is in a headline, prompt for tags and insert them - into the current line, aligned to `org-tags-column'. When called - with prefix arg, realign all tags in the current buffer. - -- If the cursor is in one of the special #+KEYWORD lines, this - triggers scanning the buffer for these lines and updating the - information. - -- If the cursor is inside a table, realign the table. This command - works even if the automatic table editor has been turned off. - -- If the cursor is on a #+TBLFM line, re-apply the formulas to - the entire table. - -- If the cursor is a the beginning of a dynamic block, update it. - -- If the cursor is inside a table created by the table.el package, - activate that table. - -- If the current buffer is a remember buffer, close note and file it. - with a prefix argument, file it without further interaction to the default - location. - -- If the cursor is on a <<>>, update radio targets and corresponding - links in this buffer. - -- If the cursor is on a numbered item in a plain list, renumber the - ordered list. - -- If the cursor is on a checkbox, toggle it." - (interactive "P") - (let ((org-enable-table-editor t)) - (cond - ((or org-clock-overlays - org-occur-highlights - org-latex-fragment-image-overlays) - (org-remove-clock-overlays) - (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) - (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) - (fboundp org-finish-function)) - (funcall org-finish-function)) - ((org-at-property-p) - (call-interactively 'org-property-action)) - ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) - ((org-on-heading-p) (call-interactively 'org-set-tags)) - ((org-at-table.el-p) - (require 'table) - (beginning-of-line 1) - (re-search-forward "|" (save-excursion (end-of-line 2) (point))) - (call-interactively 'table-recognize-table)) - ((org-at-table-p) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align)) - ((org-at-item-checkbox-p) - (call-interactively 'org-toggle-checkbox)) - ((org-at-item-p) - (call-interactively 'org-maybe-renumber-ordered-list)) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) - ;; Dynamic block - (beginning-of-line 1) - (org-update-dblock)) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) - (cond - ((equal (match-string 1) "TBLFM") - ;; Recalculate the table before this line - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t - (call-interactively 'org-mode-restart)))) - (t (error "C-c C-c can do nothing useful at this location."))))) - -(defun org-mode-restart () - "Restart Org-mode, to scan again for special lines. -Also updates the keyword regular expressions." - (interactive) - (let ((org-inhibit-startup t)) (org-mode)) - (message "Org-mode restarted to refresh keyword and special line setup")) - -(defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." - (interactive) - (if (not org-finish-function) - (call-interactively 'show-branches) - (let ((org-note-abort t)) - (funcall org-finish-function)))) - -(defun org-return (&optional indent) - "Goto next table row or insert a newline. -Calls `org-table-next-row' or `newline', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((bobp) (if indent (newline-and-indent) (newline))) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - (t (if indent (newline-and-indent) (newline))))) - -(defun org-return-indent () - (interactive) - "Goto next table row or insert a newline and indent. -Calls `org-table-next-row' or `newline-and-indent', depending on -context. See the individual commands for more information." - (org-return t)) - -(defun org-ctrl-c-minus () - "Insert separator line in table or modify bullet type in list. -Calls `org-table-insert-hline' or `org-cycle-list-bullet', -depending on context." - (interactive) - (cond - ((org-at-table-p) - (call-interactively 'org-table-insert-hline)) - ((org-on-heading-p) - ;; Convert to item - (save-excursion - (beginning-of-line 1) - (if (looking-at "\\*+ ") - (replace-match (concat (make-string (- (match-end 0) (point)) ?\ ) "- "))))) - ((org-in-item-p) - (call-interactively 'org-cycle-list-bullet)) - (t (error "`C-c -' does have no function here.")))) - -(defun org-meta-return (&optional arg) - "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending on context. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) - (call-interactively 'org-table-wrap-region)) - (t (call-interactively 'org-insert-heading)))) - -;;; Menu entries - -;; Define the Org-mode menus -(easy-menu-define org-tbl-menu org-mode-map "Tbl menu" - '("Tbl" - ["Align" org-ctrl-c-ctrl-c (org-at-table-p)] - ["Next Field" org-cycle (org-at-table-p)] - ["Previous Field" org-shifttab (org-at-table-p)] - ["Next Row" org-return (org-at-table-p)] - "--" - ["Blank Field" org-table-blank-field (org-at-table-p)] - ["Edit Field" org-table-edit-field (org-at-table-p)] - ["Copy Field from Above" org-table-copy-down (org-at-table-p)] - "--" - ("Column" - ["Move Column Left" org-metaleft (org-at-table-p)] - ["Move Column Right" org-metaright (org-at-table-p)] - ["Delete Column" org-shiftmetaleft (org-at-table-p)] - ["Insert Column" org-shiftmetaright (org-at-table-p)]) - ("Row" - ["Move Row Up" org-metaup (org-at-table-p)] - ["Move Row Down" org-metadown (org-at-table-p)] - ["Delete Row" org-shiftmetaup (org-at-table-p)] - ["Insert Row" org-shiftmetadown (org-at-table-p)] - ["Sort lines in region" org-table-sort-lines (org-at-table-p)] - "--" - ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) - ("Rectangle" - ["Copy Rectangle" org-copy-special (org-at-table-p)] - ["Cut Rectangle" org-cut-special (org-at-table-p)] - ["Paste Rectangle" org-paste-special (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) - "--" - ("Calculate" - ["Set Column Formula" org-table-eval-formula (org-at-table-p)] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-table-edit-formulas (org-at-table-p)] - "--" - ["Recalculate line" org-table-recalculate (org-at-table-p)] - ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] - "--" - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] - "--" - ["Sum Column/Rectangle" org-table-sum - (or (org-at-table-p) (org-region-active-p))] - ["Which Column?" org-table-current-column (org-at-table-p)]) - ["Debug Formulas" - org-table-toggle-formula-debugger - :style toggle :selected org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays - :style toggle :selected org-table-overlay-coordinates] - "--" - ["Create" org-table-create (and (not (org-at-table-p)) - org-enable-table-editor)] - ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] - ["Import from File" org-table-import (not (org-at-table-p))] - ["Export to File" org-table-export (org-at-table-p)] - "--" - ["Create/Convert from/to table.el" org-table-create-with-table.el t])) - -(easy-menu-define org-org-menu org-mode-map "Org menu" - '("Org" - ("Show/Hide" - ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] - ["Cycle Global Visibility" org-shifttab (not (org-at-table-p))] - ["Sparse Tree" org-occur t] - ["Reveal Context" org-reveal t] - ["Show All" show-all t] - "--" - ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) - "--" - ["New Heading" org-insert-heading t] - ("Navigate Headings" - ["Up" outline-up-heading t] - ["Next" outline-next-visible-heading t] - ["Previous" outline-previous-visible-heading t] - ["Next Same Level" outline-forward-same-level t] - ["Previous Same Level" outline-backward-same-level t] - "--" - ["Jump" org-goto t]) - ("Edit Structure" - ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] - ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] - "--" - ["Copy Subtree" org-copy-special (not (org-at-table-p))] - ["Cut Subtree" org-cut-special (not (org-at-table-p))] - ["Paste Subtree" org-paste-special (not (org-at-table-p))] - "--" - ["Promote Heading" org-metaleft (not (org-at-table-p))] - ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] - ["Demote Heading" org-metaright (not (org-at-table-p))] - ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] - "--" - ["Sort Region/Children" org-sort (not (org-at-table-p))] - "--" - ["Convert to odd levels" org-convert-to-odd-levels t] - ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) - ("Editing" - ["Emphasis..." org-emphasize t]) - ("Archive" - ["Toggle ARCHIVE tag" org-toggle-archive-tag t] -; ["Check and Tag Children" (org-toggle-archive-tag (4)) -; :active t :keys "C-u C-c C-x C-a"] - ["Sparse trees open ARCHIVE trees" - (setq org-sparse-tree-open-archived-trees - (not org-sparse-tree-open-archived-trees)) - :style toggle :selected org-sparse-tree-open-archived-trees] - ["Cycling opens ARCHIVE trees" - (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) - :style toggle :selected org-cycle-open-archived-trees] - ["Agenda includes ARCHIVE trees" - (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) - :style toggle :selected (not org-agenda-skip-archived-trees)] - "--" - ["Move Subtree to Archive" org-advertized-archive-subtree t] - ; ["Check and Move Children" (org-archive-subtree '(4)) - ; :active t :keys "C-u C-c C-x C-s"] - ) - "--" - ("TODO Lists" - ["TODO/DONE/-" org-todo t] - ("Select keyword" - ["Next keyword" org-shiftright (org-on-heading-p)] - ["Previous keyword" org-shiftleft (org-on-heading-p)] - ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] - ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] - ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) - ["Show TODO Tree" org-show-todo-tree t] - ["Global TODO list" org-todo-list t] - "--" - ["Set Priority" org-priority t] - ["Priority Up" org-shiftup t] - ["Priority Down" org-shiftdown t]) - ("TAGS and Properties" - ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] - ["Change tag in region" 'org-change-tag-in-region (org-region-active-p)] - "--" - ["Set property" 'org-set-property t] - ["Column view of properties" org-columns t] - ["Insert Column View DBlock" org-insert-columns-dblock t]) - ("Dates and Scheduling" - ["Timestamp" org-time-stamp t] - ["Timestamp (inactive)" org-time-stamp-inactive t] - ("Change Date" - ["1 Day Later" org-shiftright t] - ["1 Day Earlier" org-shiftleft t] - ["1 ... Later" org-shiftup t] - ["1 ... Earlier" org-shiftdown t]) - ["Compute Time Range" org-evaluate-time-range t] - ["Schedule Item" org-schedule t] - ["Deadline" org-deadline t] - "--" - ["Custom time format" org-toggle-time-stamp-overlays - :style radio :selected org-display-custom-times] - "--" - ["Goto Calendar" org-goto-calendar t] - ["Date from Calendar" org-date-from-calendar t]) - ("Logging work" - ["Clock in" org-clock-in t] - ["Clock out" org-clock-out t] - ["Clock cancel" org-clock-cancel t] - ["Goto running clock" org-clock-goto t] - ["Display times" org-clock-display t] - ["Create clock table" org-clock-report t] - "--" - ["Record DONE time" - (progn (setq org-log-done (not org-log-done)) - (message "Switching to %s will %s record a timestamp" - (car org-done-keywords) - (if org-log-done "automatically" "not"))) - :style toggle :selected org-log-done]) - "--" - ["Agenda Command..." org-agenda t] - ["Set Restriction Lock" org-agenda-set-restriction-lock t] - ("File List for Agenda") - ("Special views current file" - ["TODO Tree" org-show-todo-tree t] - ["Check Deadlines" org-check-deadlines t] - ["Timeline" org-timeline t] - ["Tags Tree" org-tags-sparse-tree t]) - "--" - ("Hyperlinks" - ["Store Link (Global)" org-store-link t] - ["Insert Link" org-insert-link t] - ["Follow Link" org-open-at-point t] - "--" - ["Next link" org-next-link t] - ["Previous link" org-previous-link t] - "--" - ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio :selected (member '(org-link) buffer-invisibility-spec)] - ["Literal Links" - (progn - (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio :selected (not (member '(org-link) buffer-invisibility-spec))]) - "--" - ["Export/Publish..." org-export t] - ("LaTeX" - ["Org CDLaTeX mode" org-cdlatex-mode :style toggle - :selected org-cdlatex-mode] - ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] - ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] - ["Modify math symbol" org-cdlatex-math-modify - (org-inside-LaTeX-fragment-p)] - ["Export LaTeX fragments as images" - (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) - :style toggle :selected org-export-with-LaTeX-fragments]) - "--" - ("Documentation" - ["Show Version" org-version t] - ["Info Documentation" org-info t]) - ("Customize" - ["Browse Org Group" org-customize t] - "--" - ["Expand This Menu" org-create-customize-menu - (fboundp 'customize-menu-create)]) - "--" - ["Refresh setup" org-mode-restart t] - )) - -(defun org-info (&optional node) - "Read documentation for Org-mode in the info system. -With optional NODE, go directly to that node." - (interactive) - (require 'info) - (Info-goto-node (format "(org)%s" (or node "")))) - -(defun org-install-agenda-files-menu () - (let ((bl (buffer-list))) - (save-excursion - (while bl - (set-buffer (pop bl)) - (if (org-mode-p) (setq bl nil))) - (when (org-mode-p) - (easy-menu-change - '("Org") "File List for Agenda" - (append - (list - ["Edit File List" (org-edit-agenda-file-list) t] - ["Add/Move Current File to Front of List" org-agenda-file-to-front t] - ["Remove Current File from List" org-remove-file t] - ["Cycle through agenda files" org-cycle-agenda-files t] - ["Occur in all agenda files" org-occur-in-agenda-files t] - "--") - (mapcar 'org-file-menu-entry (org-agenda-files t)))))))) - -;;;; Documentation - -(defun org-customize () - "Call the customize function with org as argument." - (interactive) - (customize-browse 'org)) - -(defun org-create-customize-menu () - "Create a full customization menu for Org-mode, insert it into the menu." - (interactive) - (if (fboundp 'customize-menu-create) - (progn - (easy-menu-change - '("Org") "Customize" - `(["Browse Org group" org-customize t] - "--" - ,(customize-menu-create 'org) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t])) - (message "\"Org\"-menu now contains full customization menu")) - (error "Cannot expand menu (outdated version of cus-edit.el)"))) - -;;;; Miscellaneous stuff - - -;;; Generally useful functions - -(defun org-context () - "Return a list of contexts of the current cursor position. -If several contexts apply, all are returned. -Each context entry is a list with a symbol naming the context, and -two positions indicating start and end of the context. Possible -contexts are: - -:headline anywhere in a headline -:headline-stars on the leading stars in a headline -:todo-keyword on a TODO keyword (including DONE) in a headline -:tags on the TAGS in a headline -:priority on the priority cookie in a headline -:item on the first line of a plain list item -:item-bullet on the bullet/number of a plain list item -:checkbox on the checkbox in a plain list item -:table in an org-mode table -:table-special on a special filed in a table -:table-table in a table.el table -:link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. -:target on a <> -:radio-target on a <<>> -:latex-fragment on a LaTeX fragment -:latex-preview on a LaTeX fragment with overlayed preview image - -This function expects the position to be visible because it uses font-lock -faces as a help to recognize the following contexts: :table-special, :link, -and :keyword." - (let* ((f (get-text-property (point) 'face)) - (faces (if (listp f) f (list f))) - (p (point)) clist o) - ;; First the large context - (cond - ((org-on-heading-p t) - (push (list :headline (point-at-bol) (point-at-eol)) clist) - (when (progn - (beginning-of-line 1) - (looking-at org-todo-line-tags-regexp)) - (push (org-point-in-group p 1 :headline-stars) clist) - (push (org-point-in-group p 2 :todo-keyword) clist) - (push (org-point-in-group p 4 :tags) clist)) - (goto-char p) - (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1)) - (if (looking-at "\\[#[A-Z0-9]\\]") - (push (org-point-in-group p 0 :priority) clist))) - - ((org-at-item-p) - (push (org-point-in-group p 2 :item-bullet) clist) - (push (list :item (point-at-bol) - (save-excursion (org-end-of-item) (point))) - clist) - (and (org-at-item-checkbox-p) - (push (org-point-in-group p 0 :checkbox) clist))) - - ((org-at-table-p) - (push (list :table (org-table-begin) (org-table-end)) clist) - (if (memq 'org-formula faces) - (push (list :table-special - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist))) - ((org-at-table-p 'any) - (push (list :table-table) clist))) - (goto-char p) - - ;; Now the small context - (cond - ((org-at-timestamp-p) - (push (org-point-in-group p 0 :timestamp) clist)) - ((memq 'org-link faces) - (push (list :link - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist)) - ((memq 'org-special-keyword faces) - (push (list :keyword - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist)) - ((org-on-target-p) - (push (org-point-in-group p 0 :target) clist) - (goto-char (1- (match-beginning 0))) - (if (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) - (goto-char p)) - ((setq o (car (delq nil - (mapcar - (lambda (x) - (if (memq x org-latex-fragment-image-overlays) x)) - (org-overlays-at (point)))))) - (push (list :latex-fragment - (org-overlay-start o) (org-overlay-end o)) clist) - (push (list :latex-preview - (org-overlay-start o) (org-overlay-end o)) clist)) - ((org-inside-LaTeX-fragment-p) - ;; FIXME: positions wrong. - (push (list :latex-fragment (point) (point)) clist))) - - (setq clist (nreverse (delq nil clist))) - clist)) - -;; FIXME: Compare with at-regexp-p Do we need both? -(defun org-in-regexp (re &optional nlines visually) - "Check if point is inside a match of regexp. -Normally only the current line is checked, but you can include NLINES extra -lines both before and after point into the search. -If VISUALLY is set, require that the cursor is not after the match but -really on, so that the block visually is on the match." - (catch 'exit - (let ((pos (point)) - (eol (point-at-eol (+ 1 (or nlines 0)))) - (inc (if visually 1 0))) - (save-excursion - (beginning-of-line (- 1 (or nlines 0))) - (while (re-search-forward re eol t) - (if (and (<= (match-beginning 0) pos) - (>= (+ inc (match-end 0)) pos)) - (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) - -(defun org-at-regexp-p (regexp) - "Is point inside a match of REGEXP in the current line?" - (catch 'exit - (save-excursion - (let ((pos (point)) (end (point-at-eol))) - (beginning-of-line 1) - (while (re-search-forward regexp end t) - (if (and (<= (match-beginning 0) pos) - (>= (match-end 0) pos)) - (throw 'exit t))) - nil)))) - -(defun org-occur-in-agenda-files (regexp &optional nlines) - "Call `multi-occur' with buffers for all agenda files." - (interactive "sOrg-files matching: \np") - (let* ((files (org-agenda-files)) - (tnames (mapcar 'file-truename files)) - (extra org-agenda-multi-occur-extra-files) - f) - (while (setq f (pop extra)) - (unless (member (file-truename f) tnames) - (add-to-list 'files f 'append) - (add-to-list 'tnames (file-truename f) 'append))) - (multi-occur - (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files) - regexp))) - -(defun org-uniquify (list) - "Remove duplicate elements from LIST." - (let (res) - (mapc (lambda (x) (add-to-list 'res x 'append)) list) - res)) - -(defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST." - (while elts - (setq list (delete (pop elts) list))) - list) - -(defun org-back-over-empty-lines () - "Move backwards over witespace, to the beginning of the first empty line. -Returns the number o empty lines passed." - (let ((pos (point))) - (skip-chars-backward " \t\n\r") - (beginning-of-line 2) - (count-lines (point) pos))) - -(defun org-skip-whitespace () - (skip-chars-forward " \t\n\r")) - -(defun org-point-in-group (point group &optional context) - "Check if POINT is in match-group GROUP. -If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the -match. If the match group does ot exist or point is not inside it, -return nil." - (and (match-beginning group) - (>= point (match-beginning group)) - (<= point (match-end group)) - (if context - (list context (match-beginning group) (match-end group)) - t))) - -(defun org-switch-to-buffer-other-window (&rest args) - "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames." - (let (pop-up-frames special-display-buffer-names special-display-regexps - special-display-function) - (apply 'switch-to-buffer-other-window args))) - -(defun org-combine-plists (&rest plists) - "Create a single property list from all plists in PLISTS. -The process starts by copying the first list, and then setting properties -from the other lists. Settings in the last list are the most significant -ones and overrule settings in the other lists." - (let ((rtn (copy-sequence (pop plists))) - p v ls) - (while plists - (setq ls (pop plists)) - (while ls - (setq p (pop ls) v (pop ls)) - (setq rtn (plist-put rtn p v)))) - rtn)) - -(defun org-move-line-down (arg) - "Move the current line down. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (+ 1 arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (move-to-column col))) - -(defun org-move-line-up (arg) - "Move the current line up. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (- arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (move-to-column col))) - -(defun org-replace-escapes (string table) - "Replace %-escapes in STRING with values in TABLE. -TABLE is an association list with keys like \"%a\" and string values. -The sequences in STRING may contain normal field width and padding information, -for example \"%-5s\". Replacements happen in the sequence given by TABLE, -so values can contain further %-escapes if they are define later in TABLE." - (let ((case-fold-search nil) - e re rpl) - (while (setq e (pop table)) - (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) - (while (string-match re string) - (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") - (cdr e))) - (setq string (replace-match rpl t t string)))) - string)) - - -(defun org-sublist (list start end) - "Return a section of LIST, from START to END. -Counting starts at 1." - (let (rtn (c start)) - (setq list (nthcdr (1- start) list)) - (while (and list (<= c end)) - (push (pop list) rtn) - (setq c (1+ c))) - (nreverse rtn))) - -(defun org-find-base-buffer-visiting (file) - "Like `find-buffer-visiting' but alway return the base buffer and -not an indirect buffer" - (let ((buf (find-buffer-visiting file))) - (if buf - (or (buffer-base-buffer buf) buf) - nil))) - -(defun org-image-file-name-regexp () - "Return regexp matching the file names of images." - (if (fboundp 'image-file-name-regexp) - (image-file-name-regexp) - (let ((image-file-name-extensions - '("png" "jpeg" "jpg" "gif" "tiff" "tif" - "xbm" "xpm" "pbm" "pgm" "ppm"))) - (concat "\\." - (regexp-opt (nconc (mapcar 'upcase - image-file-name-extensions) - image-file-name-extensions) - t) - "\\'")))) - -(defun org-file-image-p (file) - "Return non-nil if FILE is an image." - (save-match-data - (string-match (org-image-file-name-regexp) file))) - -;;; Paragraph filling stuff. -;; We want this to be just right, so use the full arsenal. - -(defun org-indent-line-function () - "Indent line like previous, but further if previous was headline or item." - (interactive) - (let* ((pos (point)) - (itemp (org-at-item-p)) - column bpos bcol tpos tcol bullet btype bullet-type) - ;; Find the previous relevant line - (beginning-of-line 1) - (cond - ((looking-at "#") (setq column 0)) - ((looking-at "\\*+ ") (setq column 0)) - (t - (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) - (beginning-of-line 0)) - (cond - ((looking-at "\\*+[ \t]+") - (goto-char (match-end 0)) - (setq column (current-column))) - ((org-in-item-p) - (org-beginning-of-item) -; (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) - (if (not itemp) - (setq column tcol) - (goto-char pos) - (beginning-of-line 1) - (if (looking-at "\\S-") - (progn - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol))) - (setq column (org-get-indentation))))) - (t (setq column (org-get-indentation)))))) - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (indent-line-to column) - (save-excursion (indent-line-to column))) - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at - "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat "\\1" (format org-property-format - (match-string 2) (match-string 3))) - t nil)) - (move-to-column column))) - -(defun org-set-autofill-regexps () - (interactive) - ;; In the paragraph separator we include headlines, because filling - ;; text in a line directly attached to a headline would otherwise - ;; fill the headline as well. - (org-set-local 'comment-start-skip "^#+[ \t]*") - (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") - ;; The paragraph starter includes hand-formatted lists. - (org-set-local 'paragraph-start - "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") - ;; Inhibit auto-fill for headers, tables and fixed-width lines. - ;; But only if the user has not turned off tables or fixed-width regions - (org-set-local - 'auto-fill-inhibit-regexp - (concat "\\*+ \\|#\\+" - "\\|[ \t]*" org-keyword-time-regexp - (if (or org-enable-table-editor org-enable-fixed-width-editor) - (concat - "\\|[ \t]*[" - (if org-enable-table-editor "|" "") - (if org-enable-fixed-width-editor ":" "") - "]")))) - ;; We use our own fill-paragraph function, to make sure that tables - ;; and fixed-width regions are not wrapped. That function will pass - ;; through to `fill-paragraph' when appropriate. - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - ; Adaptive filling: To get full control, first make sure that - ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (org-set-local 'adaptive-fill-regexp "\000") - (org-set-local 'adaptive-fill-function - 'org-adaptive-fill-function)) - -(defun org-fill-paragraph (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p))) - (cond ((and (equal (char-after (point-at-bol)) ?*) - (save-excursion (goto-char (point-at-bol)) - (looking-at outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - (t nil)))) ; call paragraph-fill - -;; For reference, this is the default value of adaptive-fill-regexp -;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" - -(defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files. -In particular, this makes sure hanging paragraphs for hand-formatted lists -work correctly." - (cond ((looking-at "#[ \t]+") - (match-string 0)) - ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] \\)?") - (save-excursion - (goto-char (match-end 0)) - (make-string (current-column) ?\ ))) - (t nil))) - -;;;; Functions extending outline functionality - -(defun org-beginning-of-line (&optional arg) - "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive. -If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the -first attempt, and only move to after the tags when the cursor is already -beyond the end of the headline." - (interactive "P") - (let ((pos (point))) - (beginning-of-line 1) - (if (bobp) - nil - (backward-char 1) - (if (org-invisible-p) - (while (and (not (bobp)) (org-invisible-p)) - (backward-char 1) - (beginning-of-line 1)) - (forward-char 1))) - (when org-special-ctrl-a/e - (cond - ((and (looking-at org-todo-line-regexp) - (= (char-after (match-end 1)) ?\ )) - (goto-char - (if (eq org-special-ctrl-a/e t) - (cond ((> pos (match-beginning 3)) (match-beginning 3)) - ((= pos (point)) (match-beginning 3)) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t (match-beginning 3)))))) - ((org-at-item-p) - (goto-char - (if (eq org-special-ctrl-a/e t) - (cond ((> pos (match-end 4)) (match-end 4)) - ((= pos (point)) (match-end 4)) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t (match-end 4)))))))))) - -(defun org-end-of-line (&optional arg) - "Go to the end of the line. -If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the -first attempt, and only move to after the tags when the cursor is already -beyond the end of the headline." - (interactive "P") - (if (or (not org-special-ctrl-a/e) - (not (org-on-heading-p))) - (end-of-line arg) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) - (if (eq org-special-ctrl-a/e t) - (if (or (< pos (match-beginning 1)) - (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (end-of-line arg))))) - -(define-key org-mode-map "\C-a" 'org-beginning-of-line) -(define-key org-mode-map "\C-e" 'org-end-of-line) - -(defun org-invisible-p () - "Check if point is at a character currently not visible." - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible))) - -(defun org-invisible-p2 () - "Check if point is at a character currently not visible." - (save-excursion - (if (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible)))) - -(defalias 'org-back-to-heading 'outline-back-to-heading) -(defalias 'org-on-heading-p 'outline-on-heading-p) -(defalias 'org-at-heading-p 'outline-on-heading-p) -(defun org-at-heading-or-item-p () - (or (org-on-heading-p) (org-at-item-p))) - -(defun org-on-target-p () - (or (org-in-regexp org-radio-target-regexp) - (org-in-regexp org-target-regexp))) - -(defun org-up-heading-all (arg) - "Move to the heading line of which the present line is a subheading. -This function considers both visible and invisible heading lines. -With argument, move up ARG levels." - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t))) ; emacs 22 version of outline.el - -(defun org-up-heading-safe () - "Move to the heading line of which the present line is a subheading. -This version will not throw an error. It will return the level of the -headline found, or nil if no higher level is found." - (let ((pos (point)) start-level level - (re (concat "^" outline-regexp))) - (catch 'exit - (outline-back-to-heading t) - (setq start-level (funcall outline-level)) - (if (equal start-level 1) (throw 'exit nil)) - (while (re-search-backward re nil t) - (setq level (funcall outline-level)) - (if (< level start-level) (throw 'exit level))) - nil))) - -(defun org-first-sibling-p () - "Is this heading the first child of its parents?" - (interactive) - (let ((re (concat "^" outline-regexp)) - level l) - (unless (org-at-heading-p t) - (error "Not at a heading")) - (setq level (funcall outline-level)) - (save-excursion - (if (not (re-search-backward re nil t)) - t - (setq l (funcall outline-level)) - (< l level))))) - -(defun org-goto-sibling (&optional previous) - "Goto the next sibling, even if it is invisible. -When PREVIOUS is set, go to the previous sibling instead. Returns t -when a sibling was found. When none is found, return nil and don't -move point." - (let ((fun (if previous 're-search-backward 're-search-forward)) - (pos (point)) - (re (concat "^" outline-regexp)) - level l) - (when (condition-case nil (org-back-to-heading t) (error nil)) - (setq level (funcall outline-level)) - (catch 'exit - (or previous (forward-char 1)) - (while (funcall fun re nil t) - (setq l (funcall outline-level)) - (when (< l level) (goto-char pos) (throw 'exit nil)) - (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) - (goto-char pos) - nil)))) - -(defun org-show-siblings () - "Show all siblings of the current headline." - (save-excursion - (while (org-goto-sibling) (org-flag-heading nil))) - (save-excursion - (while (org-goto-sibling 'previous) - (org-flag-heading nil)))) - -(defun org-show-hidden-entry () - "Show an entry where even the heading is hidden." - (save-excursion - (org-show-entry))) - -(defun org-flag-heading (flag &optional entry) - "Flag the current heading. FLAG non-nil means make invisible. -When ENTRY is non-nil, show the entire entry." - (save-excursion - (org-back-to-heading t) - ;; Check if we should show the entire entry - (if entry - (progn - (org-show-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil)))) - (outline-flag-region (max (point-min) (1- (point))) - (save-excursion (outline-end-of-heading) (point)) - flag)))) - -(defun org-end-of-subtree (&optional invisible-OK to-heading) - ;; This is an exact copy of the original function, but it uses - ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-OK argument. - ;; Under Emacs this is not needed, but the old outline.el needs this fix. - (org-back-to-heading invisible-OK) - (let ((first t) - (level (funcall outline-level))) - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading)) - (unless to-heading - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) - (point)) - -(defun org-show-subtree () - "Show everything after this heading at deeper levels." - (outline-flag-region - (point) - (save-excursion - (outline-end-of-subtree) (outline-next-heading) (point)) - nil)) - -(defun org-show-entry () - "Show the body directly following this heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (condition-case nil - (progn - (org-back-to-heading t) - (outline-flag-region - (max (point-min) (1- (point))) - (save-excursion - (re-search-forward - (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) - (or (match-beginning 1) (point-max))) - nil)) - (error nil)))) - -(defun org-make-options-regexp (kwds) - "Make a regular expression for keyword lines." - (concat - "^" - "#?[ \t]*\\+\\(" - (mapconcat 'regexp-quote kwds "\\|") - "\\):[ \t]*" - "\\(.+\\)")) - -;; Make isearch reveal the necessary context -(defun org-isearch-end () - "Reveal context after isearch exits." - (when isearch-success ; only if search was successful - (if (featurep 'xemacs) - ;; Under XEmacs, the hook is run in the correct place, - ;; we directly show the context. - (org-show-context 'isearch) - ;; In Emacs the hook runs *before* restoring the overlays. - ;; So we have to use a one-time post-command-hook to do this. - ;; (Emacs 22 has a special variable, see function `org-mode') - (unless (and (boundp 'isearch-mode-end-hook-quit) - isearch-mode-end-hook-quit) - ;; Only when the isearch was not quitted. - (org-add-hook 'post-command-hook 'org-isearch-post-command - 'append 'local))))) - -(defun org-isearch-post-command () - "Remove self from hook, and show context." - (remove-hook 'post-command-hook 'org-isearch-post-command 'local) - (org-show-context 'isearch)) - - -;;;; Integration with and fixes for other packages - -;;; Imenu support - -(defvar org-imenu-markers nil - "All markers currently used by Imenu.") -(make-variable-buffer-local 'org-imenu-markers) - -(defun org-imenu-new-marker (&optional pos) - "Return a new marker for use by Imenu, and remember the marker." - (let ((m (make-marker))) - (move-marker m (or pos (point))) - (push m org-imenu-markers) - m)) - -(defun org-imenu-get-tree () - "Produce the index for Imenu." - (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) - (setq org-imenu-markers nil) - (let* ((n org-imenu-depth) - (re (concat "^" outline-regexp)) - (subs (make-vector (1+ n) nil)) - (last-level 0) - m tree level head) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (while (re-search-backward re nil t) - (setq level (org-reduced-level (funcall outline-level))) - (when (<= level n) - (looking-at org-complex-heading-regexp) - (setq head (org-match-string-no-properties 4) - m (org-imenu-new-marker)) - (org-add-props head nil 'org-imenu-marker m 'org-imenu t) - (if (>= level last-level) - (push (cons head m) (aref subs level)) - (push (cons head (aref subs (1+ level))) (aref subs level)) - (loop for i from (1+ level) to n do (aset subs i nil))) - (setq last-level level))))) - (aref subs 1))) - -(eval-after-load "imenu" - '(progn - (add-hook 'imenu-after-jump-hook - (lambda () (org-show-context 'org-goto))))) - -;; Speedbar support - -(defun org-speedbar-set-agenda-restriction () - "Restrict future agenda commands to the location at point in speedbar. -To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." - (interactive) - (let (p m tp np dir txt w) - (cond - ((setq p (text-property-any (point-at-bol) (point-at-eol) - 'org-imenu t)) - (setq m (get-text-property p 'org-imenu-marker)) - (save-excursion - (save-restriction - (set-buffer (marker-buffer m)) - (goto-char m) - (org-agenda-set-restriction-lock 'subtree)))) - ((setq p (text-property-any (point-at-bol) (point-at-eol) - 'speedbar-function 'speedbar-find-file)) - (setq tp (previous-single-property-change - (1+ p) 'speedbar-function) - np (next-single-property-change - tp 'speedbar-function) - dir (speedbar-line-directory) - txt (buffer-substring-no-properties (or tp (point-min)) - (or np (point-max)))) - (save-excursion - (save-restriction - (set-buffer (find-file-noselect - (let ((default-directory dir)) - (expand-file-name txt)))) - (unless (org-mode-p) - (error "Cannot restrict to non-Org-mode file")) - (org-agenda-set-restriction-lock 'file)))) - (t (error "Don't know how to restrict Org-mode's agenda"))) - (org-move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) - (setq current-prefix-arg nil) - (org-agenda-maybe-redo))) - -(eval-after-load "speedbar" - '(progn - (speedbar-add-supported-extension ".org") - (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) - (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) - (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) - (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) - (add-hook 'speedbar-visiting-tag-hook - (lambda () (org-show-context 'org-goto))))) - - -;;; Fixes and Hacks - -;; Make flyspell not check words in links, to not mess up our keymap -(defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons." - (not (get-text-property (point) 'keymap))) - -;; Make `bookmark-jump' show the jump location if it was hidden. -(eval-after-load "bookmark" - '(if (boundp 'bookmark-after-jump-hook) - ;; We can use the hook - (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) - ;; Hook not available, use advice - (defadvice bookmark-jump (after org-make-visible activate) - "Make the position visible." - (org-bookmark-jump-unhide)))) - -(defun org-bookmark-jump-unhide () - "Unhide the current position, to show the bookmark location." - (and (org-mode-p) - (or (org-invisible-p) - (save-excursion (goto-char (max (point-min) (1- (point)))) - (org-invisible-p))) - (org-show-context 'bookmark-jump))) - -;; Fix a bug in htmlize where there are text properties (face nil) -(eval-after-load "htmlize" - '(progn - (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate) - "Make sure there are no nil faces" - (setq ad-return-value (delq nil ad-return-value))))) - -;; Make session.el ignore our circular variable -(eval-after-load "session" - '(add-to-list 'session-globals-exclude 'org-mark-ring)) - -;;;; Experimental code - -(defun org-closed-in-range () - "Sparse tree of items closed in a certain time range. -Still experimental, may disappear in the future." - (interactive) - ;; Get the time interval from the user. - (let* ((time1 (time-to-seconds - (org-read-date nil 'to-time nil "Starting date: "))) - (time2 (time-to-seconds - (org-read-date nil 'to-time nil "End date:"))) - ;; callback function - (callback (lambda () - (let ((time - (time-to-seconds - (apply 'encode-time - (org-parse-time-string - (match-string 1)))))) - ;; check if time in interval - (and (>= time time1) (<= time time2)))))) - ;; make tree, check each match with the callback - (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) - -(defun org-first-list-item-p () - "Is this heading the item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list)))) - -;;;; Finish up - -(provide 'org) - -(run-hooks 'org-load-hook) - -;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd -;;; org.el ends here - diff --git a/emacs/external/powershell.el b/emacs/external/powershell.el deleted file mode 100644 index 9962ff4..0000000 --- a/emacs/external/powershell.el +++ /dev/null @@ -1,160 +0,0 @@ -;; powershell.el, version 0.1 -;; -;; Author: Dino Chiesa -;; Thu, 10 Apr 2008 11:10 -;; -;; Run Windows PowerShell v1.0 as an inferior shell within emacs. Tested with -;; emacs v22.2. -;; -;; TODO: -;; - test what happens when you expand the window size beyond the -;; maxWindowWidth for the RawUI -;; - make everything configurable (Powershell exe, initial args, powershell -;; prompt regexp) -;; - implement powershell launch hooks -;; - prevent backspace from deleting the powershell prompt? (do other shells -;; do this?) -;; - -(require 'shell) - - -(defun powershell-gen-window-width-string () - (concat "$a = (Get-Host).UI.RawUI\n" - "$b = $a.WindowSize\n" - "$b.Width = " (number-to-string (window-width)) "\n" - "$a.BufferSize = $b\n" - "$a.WindowSize = $b") - ) - - -(defvar powershell-prompt-pattern "PS [^#$%>]+>" - "Regexp for powershell prompt. This isn't really used, because I couldn't figure out how to get it to work." - ) - -(defgroup powershell nil - "Running shell from within Emacs buffers." - :group 'processes - ) - - -(defcustom powershell-need-rawui-resize t - "set when powershell needs to be resized" - :group 'powershell - ) - -;;;###autoload -(defun powershell (&optional buffer) - "Run an inferior powershell, by invoking the shell function. See the help for shell for more details. -\(Type \\[describe-mode] in the shell buffer for a list of commands.)" - (interactive - (list - (and current-prefix-arg - (read-buffer "Shell buffer: " - (generate-new-buffer-name "*PowerShell*"))))) - ; get a name for the buffer - (setq buffer (get-buffer-create (or buffer "*PowerShell*"))) - - (let ( - (tmp-shellfile explicit-shell-file-name) - ) - ; set arguments for the powershell exe. - ; This needs to be tunable. - (setq explicit-shell-file-name "c:\\windows\\system32\\WindowsPowerShell\\v1.0\\powershell.exe") - (setq explicit-powershell.exe-args '("-Command" "-" )) ; interactive, but no command prompt - - ; launch the shell - (shell buffer) - - ; restore the original shell - (if explicit-shell-file-name - (setq explicit-shell-file-name tmp-shellfile) - ) - ) - - (let ( - (proc (get-buffer-process buffer)) - ) - - ; This sets up the powershell RawUI screen width. By default, - ; the powershell v1.0 assumes terminal width of 80 chars. - ;This means input gets wrapped at the 80th column. We reset the - ; width of the PS terminal to the window width. - (add-hook 'window-size-change-functions 'powershell-window-size-changed) - - (powershell-window-size-changed) - - ; ask for initial prompt - (comint-simple-send proc "prompt") - ) - - ; hook the kill-buffer action so we can kill the inferior process? - (add-hook 'kill-buffer-hook 'powershell-delete-process) - - ; wrap the comint-input-sender with a PS version - ; must do this after launching the shell! - (make-local-variable 'comint-input-sender) - (setq comint-input-sender 'powershell-simple-send) - - ; set a preoutput filter for powershell. This will trim newlines after the prompt. - (add-hook 'comint-preoutput-filter-functions 'powershell-preoutput-filter-for-prompt) - - ;(run-hooks 'powershell-launch-hook) - - ; return the buffer created - buffer - ) - - -(defun powershell-window-size-changed (&optional frame) - ; do not actually resize here. instead just set a flag. - (setq powershell-need-rawui-resize t) - ) - - - -(defun powershell-delete-process (&optional proc) - (or proc - (setq proc (get-buffer-process (current-buffer)))) - (and (processp proc) - (delete-process proc)) - ) - - - -;; This function trims the newline from the prompt that we -;; get back from powershell. It is set into the preoutput -;; filters, so the newline is trimmed before being put into -;; the output buffer. -(defun powershell-preoutput-filter-for-prompt (string) - (if - ; not sure why, but I have not succeeded in using a variable here??? - ;(string-match powershell-prompt-pattern string) - - (string-match "PS [^#$%>]+>" string) - (substring string 0 -1) - - string - - ) - ) - - - -(defun powershell-simple-send (proc string) - "Override of the comint-simple-send function, specific for powershell. -This just sends STRING, plus the prompt command. Normally powershell is in -noninteractive model when run as an inferior shell with stdin/stdout -redirected, which is the case when running as a shell within emacs. -This function insures we get and display the prompt. " - ; resize if necessary. We do this by sending a resize string to the shell, - ; before sending the actual command to the shell. - (if powershell-need-rawui-resize - (and - (comint-simple-send proc (powershell-gen-window-width-string)) - (setq powershell-need-rawui-resize nil) - ) - ) - (comint-simple-send proc string) - (comint-simple-send proc "prompt") - ) diff --git a/emacs/external/rcirc-nick-colors.el b/emacs/external/rcirc-nick-colors.el deleted file mode 100644 index ce3c340..0000000 --- a/emacs/external/rcirc-nick-colors.el +++ /dev/null @@ -1,84 +0,0 @@ -(defvar rcirc-colors - (if (fboundp 'color-distance) - (let ((min-distance (* 0.23 (color-distance "black" "white"))) - (bg (face-background 'default)) - (fg (face-foreground 'rcirc-my-nick)) - candidates) - (dolist (item color-name-rgb-alist) - (let ((color (car item))) - (when (and (not (color-gray-p color)) - (> (color-distance color bg) min-distance) - (> (color-distance color fg) min-distance)) - (setq candidates (cons color candidates))))) - candidates) - (delete (face-background 'default) (defined-colors))) - "Colors to use for nicks in rcirc. -By default, all the non-grey colors that are very different from -the default background are candidates. The minimum -color-distance is half the distance between black and red as -computed by `color-distance'. - -To check out the list, evaluate (list-colors-display rcirc-colors).") - -(defvar rcirc-color-mapping (make-hash-table :test 'equal) - "Hash-map mapping nicks to color names.") - -(eval-after-load 'rcirc - '(defun rcirc-facify (string face) - "Return a copy of STRING with FACE property added. -Also add colors to other nicks based on `rcirc-colors'." - (when (and (eq face 'rcirc-other-nick) - (not (string= string ""))) - (let ((color (gethash string rcirc-color-mapping))) - (unless color - (setq color (elt rcirc-colors (random (length rcirc-colors)))) - (puthash string color rcirc-color-mapping)) - (setq face `((foreground-color . ,color))))) - (if face - (propertize (or string "") 'face face 'rear-nonsticky t) - string))) - -(defadvice rcirc-mangle-text (after rcirc-mangle-text-color-nick activate) - "Highlight nicks according to `rcirc-color-mapping'." - (with-syntax-table rcirc-nick-syntax-table - (maphash (lambda (nick color) - (let ((face (cons 'foreground-color color))) - (rcirc-map-regexp (lambda (start end string) - (add-text-properties - start end `(face ,face rear-nonsticky t) - text)) - (concat "\\b" (regexp-quote nick) "\\b") - text))) - rcirc-color-mapping))) - -(eval-after-load 'rcirc - '(defun-rcirc-command color (args) - "Change one of the nick colors." - (interactive) - (setq args (split-string args)) - (rcirc-do-color (car args) (cadr args) process target))) - -(defun rcirc-do-color (nick color process target) - "Implement /COLOR." - (if (not nick) - (let (names) - (maphash (lambda (key value) - (add-text-properties - 0 (length key) - `(face ((foreground-color . ,value)) help-echo ,value) - key) - (setq names (cons key names))) - rcirc-color-mapping) - (rcirc-print process (rcirc-nick process) "NOTICE" target - (mapconcat 'identity names " "))) - (unless color - (error "Use what color?")) - (puthash nick color rcirc-color-mapping))) - -(defadvice rcirc-handler-NICK (before rcirc-handler-NICK-colors activate) - "Update colors in `rcirc-color-mapping'." - (let* ((old-nick (rcirc-user-nick sender)) - (color (gethash old-nick rcirc-color-mapping)) - (new-nick (car args))) - ;; don't delete the old mapping - (puthash new-nick color rcirc-color-mapping))) diff --git a/emacs/external/smooth-scrolling.el b/emacs/external/smooth-scrolling.el deleted file mode 100644 index 232d6cf..0000000 --- a/emacs/external/smooth-scrolling.el +++ /dev/null @@ -1,75 +0,0 @@ -;; See http://www.emacswiki.org/cgi-bin/wiki/SmoothScrolling -;; for more information on this. - -(setq scroll-margin 0) - -(defvar smooth-scroll-margin 10 - "Number of lines of visible margin at the top and bottom of a window. -If the point is within these margins, then scrolling will occur -smoothly for `previous-line' at the top of the window, and for -`next-line' at the bottom. - -This is very similar in its goal to `scroll-margin'. However, it -is implemented by activating `smooth-scroll-down' and -`smooth-scroll-up' advise via `defadvice' for `previous-line' and -`next-line' respectively. As a result it avoids problems -afflicting `scroll-margin', such as a sudden jump and unexpected -highlighting of a region when the mouse is clicked in the margin. - -Scrolling only occurs when the point is closer to the window -boundary it is heading for (top or bottom) than the middle of the -window. This is to intelligently handle the case where the -margins cover the whole buffer (e.g. if `smooth-scroll-margin' -was 5 and `window-height' returned 10 or less). - -See also `smooth-scroll-strict-margins'.") - -(defvar smooth-scroll-strict-margins t - "If true, the advice code supporting `smooth-scroll-margin' -will use `count-screen-lines' to determine the number of -*visible* lines between the point and the window top/bottom, -rather than `count-lines' which obtains the number of actual -newlines. This is because there might be extra newlines hidden -by a mode such as folding-mode, outline-mode, org-mode etc., or -fewer due to very long lines being displayed wrapped when -`truncate-lines' is nil. - -However, using `count-screen-lines' can supposedly cause -performance issues in buffers with extremely long lines. Setting -`cache-long-line-scans' may be able to address this; -alternatively you can set this variable to nil so that the advice -code uses `count-lines', and put up with the fact that sometimes -the point will be allowed to stray into the margin.") - -(defadvice previous-line (after smooth-scroll-down - (&optional arg try-vscroll) - activate) - "Scroll down smoothly if cursor is within `smooth-scroll-margin' -lines of the top of the window." - (and (> (window-start) (buffer-end -1)) - (let ((lines-from-window-start - (apply (if smooth-scroll-strict-margins - 'count-screen-lines - 'count-lines) - (list (window-start) (point))))) - (and (< lines-from-window-start smooth-scroll-margin) - (< lines-from-window-start (/ (window-height) 2)))) - (save-excursion (scroll-down 1)))) - -(defadvice next-line (after smooth-scroll-up - (&optional arg try-vscroll) - activate) - "Scroll up smoothly if cursor is within `smooth-scroll-margin' -lines of the bottom of the window." - (interactive) - (and (< (window-end) (buffer-end 1)) - (let ((lines-from-window-bottom - (apply (if smooth-scroll-strict-margins - 'count-screen-lines - 'count-lines) - (list (point) (window-end))))) - (and (< lines-from-window-bottom smooth-scroll-margin) - (< lines-from-window-bottom (/ (window-height) 2)))) - (save-excursion (scroll-up 1)))) - -(provide 'smooth-scrolling) diff --git a/emacs/external/tuareg/camldebug.el b/emacs/external/tuareg/camldebug.el deleted file mode 100644 index 9f1fd03..0000000 --- a/emacs/external/tuareg/camldebug.el +++ /dev/null @@ -1,765 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; camldebug.el - Run ocamldebug / camldebug under Emacs. -;; Derived from gdb.el. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Copying is covered by the GNU General Public License. -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; History -;; -;;itz 04-06-96 I pondered basing this on gud. The potential advantages -;;were: automatic bugfix , keymaps and menus propagation. -;;Disadvantages: gud is not so clean itself, there is little common -;;functionality it abstracts (most of the stuff is done in the -;;debugger specific parts anyway), and, most seriously, gud sees it -;;fit to add C-x C-a bindings to the _global_ map, so there would be a -;;conflict between camldebug and gdb, for instance. While it's OK to -;;assume that a sane person doesn't use gdb and dbx at the same time, -;;it's not so OK (IMHO) for gdb and camldebug. - -;;Albert Cohen 04-97: Patch for Tuareg support. -;;Albert Cohen 05-98: A few patches and OCaml customization. -;;Albert Cohen 09-98: XEmacs support and some improvements. -;;Erwan Jahier and Albert Cohen 11-05: support for camldebug 3.09. - -(require 'comint) -(require 'shell) -(require 'tuareg) -(require 'derived) - -;;; Variables. - -(defvar camldebug-last-frame) -(defvar camldebug-delete-prompt-marker) -(defvar camldebug-filter-accumulator nil) -(defvar camldebug-last-frame-displayed-p) -(defvar camldebug-filter-function) - -(defvar camldebug-prompt-pattern "^(\\(ocd\\|cdb\\)) *" - "A regexp to recognize the prompt for camldebug.") - -(defvar camldebug-overlay-event nil - "Overlay for displaying the current event.") -(defvar camldebug-overlay-under nil - "Overlay for displaying the current event.") -(defvar camldebug-event-marker nil - "Marker for displaying the current event.") - -(defvar camldebug-track-frame t - "*If non-nil, always display current frame position in another window.") - -(cond - ((and (fboundp 'make-overlay) window-system) - (make-face 'camldebug-event) - (make-face 'camldebug-underline) - (if (not (face-differs-from-default-p 'camldebug-event)) - (invert-face 'camldebug-event)) - (if (not (face-differs-from-default-p 'camldebug-underline)) - (set-face-underline-p 'camldebug-underline t)) - (setq camldebug-overlay-event (make-overlay 1 1)) - (overlay-put camldebug-overlay-event 'face 'camldebug-event) - (setq camldebug-overlay-under (make-overlay 1 1)) - (overlay-put camldebug-overlay-under 'face 'camldebug-underline)) - (t - (setq camldebug-event-marker (make-marker)) - (setq overlay-arrow-string "=>"))) - -;;; Camldebug mode. - -(define-derived-mode camldebug-mode comint-mode "Caml-Debugger" - - "Major mode for interacting with a Camldebug process. - -The following commands are available: - -\\{camldebug-mode-map} - -\\[camldebug-display-frame] displays in the other window -the last line referred to in the camldebug buffer. - -\\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the camldebug window, -call camldebug to step, backstep or next and then update the other window -with the current file and position. - -If you are in a source file, you may select a point to break -at, by doing \\[camldebug-break]. - -Commands: -Many commands are inherited from comint mode. -Additionally we have: - -\\[camldebug-display-frame] display frames file in other window -\\[camldebug-step] advance one line in program -C-x SPACE sets break point at current line." - - (mapcar 'make-local-variable - '(camldebug-last-frame-displayed-p camldebug-last-frame - camldebug-delete-prompt-marker camldebug-filter-function - camldebug-filter-accumulator paragraph-start)) - (setq - camldebug-last-frame nil - camldebug-delete-prompt-marker (make-marker) - camldebug-filter-accumulator "" - camldebug-filter-function 'camldebug-marker-filter - comint-prompt-regexp camldebug-prompt-pattern - comint-dynamic-complete-functions (cons 'camldebug-complete - comint-dynamic-complete-functions) - paragraph-start comint-prompt-regexp - camldebug-last-frame-displayed-p t) - (make-local-variable 'shell-dirtrackp) - (setq shell-dirtrackp t) - (setq comint-input-sentinel 'shell-directory-tracker)) - -;;; Keymaps. - -(defun camldebug-numeric-arg (arg) - (and arg (prefix-numeric-value arg))) - -(defmacro def-camldebug (name key &optional doc args) - - "Define camldebug-NAME to be a command sending NAME ARGS and bound -to KEY, with optional doc string DOC. Certain %-escapes in ARGS are -interpreted specially if present. These are: - - %m module name of current module. - %d directory of current source file. - %c number of current character position - %e text of the caml variable surrounding point. - - The `current' source file is the file of the current buffer (if -we're in a caml buffer) or the source file current at the last break -or step (if we're in the camldebug buffer), and the `current' module -name is the filename stripped of any *.ml* suffixes (this assumes the -usual correspondence between module and file naming is observed). The -`current' position is that of the current buffer (if we're in a source -file) or the position of the last break or step (if we're in the -camldebug buffer). - -If a numeric is present, it overrides any ARGS flags and its string -representation is simply concatenated with the COMMAND." - - (let* ((fun (intern (format "camldebug-%s" name)))) - (list 'progn - (if doc - (list 'defun fun '(arg) - doc - '(interactive "P") - (list 'camldebug-call name args - '(camldebug-numeric-arg arg)))) - (list 'define-key 'camldebug-mode-map - (concat "\C-c" key) - (list 'quote fun)) - (list 'define-key 'tuareg-mode-map - (concat "\C-x\C-a" key) - (list 'quote fun))))) - -(def-camldebug "step" "\C-s" "Step one source line with display.") -(def-camldebug "run" "\C-r" "Run the program.") -(def-camldebug "reverse" "\C-v" "Run the program in reverse.") -(def-camldebug "last" "\C-l" "Go to latest time in execution history.") -(def-camldebug "backtrace" "\C-t" "Print the call stack.") -(def-camldebug "open" "\C-o" "Open the current module." "%m") -(def-camldebug "close" "\C-c" "Close the current module." "%m") -(def-camldebug "finish" "\C-f" "Finish executing current function.") -(def-camldebug "print" "\C-p" "Print value of symbol at point." "%e") -(def-camldebug "next" "\C-n" "Step one source line (skip functions)") -(def-camldebug "up" "<" "Go up N stack frames (numeric arg) with display") -(def-camldebug "down" ">" "Go down N stack frames (numeric arg) with display") -(def-camldebug "break" "\C-b" "Set breakpoint at current line." - "@ \"%m\" # %c") - -(defun camldebug-kill-filter (string) - ;gob up stupid questions :-) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (if (not (string-match "\\(.* \\)(y or n) " - camldebug-filter-accumulator)) nil - (setq camldebug-kill-output - (cons t (match-string 1 camldebug-filter-accumulator))) - (setq camldebug-filter-accumulator "")) - (if (string-match comint-prompt-regexp camldebug-filter-accumulator) - (let ((output (substring camldebug-filter-accumulator - (match-beginning 0)))) - (setq camldebug-kill-output - (cons nil (substring camldebug-filter-accumulator 0 - (1- (match-beginning 0))))) - (setq camldebug-filter-accumulator "") - output) - "")) - -(def-camldebug "kill" "\C-k") - -(defun camldebug-kill () - "Kill the program." - (interactive) - (let ((camldebug-kill-output)) - (save-excursion - (set-buffer current-camldebug-buffer) - (let ((proc (get-buffer-process (current-buffer))) - (camldebug-filter-function 'camldebug-kill-filter)) - (camldebug-call "kill") - (while (not (and camldebug-kill-output - (zerop (length camldebug-filter-accumulator)))) - (accept-process-output proc)))) - (if (not (car camldebug-kill-output)) - (error (cdr camldebug-kill-output)) - (sit-for 0 300) - (camldebug-call-1 (if (y-or-n-p (cdr camldebug-kill-output)) "y" "n"))))) -;;FIXME: camldebug doesn't output the Hide marker on kill - -(defun camldebug-goto-filter (string) - ;accumulate onto previous output - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (if (not (or (string-match (concat - "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+" - camldebug-goto-position - "-[0-9]+[ \t]*\\(before\\).*\n") - camldebug-filter-accumulator) - (string-match (concat - "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+-" - camldebug-goto-position - "[ \t]*\\(after\\).*\n") - camldebug-filter-accumulator))) - nil - (setq camldebug-goto-output - (match-string 2 camldebug-filter-accumulator)) - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator (1- (match-end 0))))) - (if (not (string-match comint-prompt-regexp - camldebug-filter-accumulator)) nil - (setq camldebug-goto-output (or camldebug-goto-output 'fail)) - (setq camldebug-filter-accumulator "")) - (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) - (setq camldebug-filter-accumulator - (match-string 1 camldebug-filter-accumulator))) - "") - -(def-camldebug "goto" "\C-g") -(defun camldebug-goto (&optional time) - - "Go to the execution time TIME. - -Without TIME, the command behaves as follows: In the camldebug buffer, -if the point at buffer end, goto time 0\; otherwise, try to obtain the -time from context around point. In a caml mode buffer, try to find the -time associated in execution history with the current point location. - -With a negative TIME, move that many lines backward in the camldebug -buffer, then try to obtain the time from context around point." - - (interactive "P") - (cond - (time - (let ((ntime (camldebug-numeric-arg time))) - (if (>= ntime 0) (camldebug-call "goto" nil ntime) - (save-selected-window - (select-window (get-buffer-window current-camldebug-buffer)) - (save-excursion - (if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ " - nil t (- 1 ntime)) - (camldebug-goto nil) - (error "I don't have %d times in my history" - (- 1 ntime)))))))) - ((eq (current-buffer) current-camldebug-buffer) - (let ((time (cond - ((eobp) 0) - ((save-excursion - (beginning-of-line 1) - (looking-at "^Time : \\([0-9]+\\) - pc : [0-9]+ ")) - (string-to-int (match-string 1))) - ((string-to-int (camldebug-format-command "%e")))))) - (camldebug-call "goto" nil time))) - (t - (let ((module (camldebug-module-name (buffer-file-name))) - (camldebug-goto-position (int-to-string (1- (point)))) - (camldebug-goto-output) (address)) - ;get a list of all events in the current module - (save-excursion - (set-buffer current-camldebug-buffer) - (let* ((proc (get-buffer-process (current-buffer))) - (camldebug-filter-function 'camldebug-goto-filter)) - (camldebug-call-1 (concat "info events " module)) - (while (not (and camldebug-goto-output - (zerop (length camldebug-filter-accumulator)))) - (accept-process-output proc)) - (setq address (if (eq camldebug-goto-output 'fail) nil - (re-search-backward - (concat "^Time : \\([0-9]+\\) - pc : " - camldebug-goto-output - " - module " - module "$") nil t) - (match-string 1))))) - (if address (camldebug-call "goto" nil (string-to-int address)) - (error "No time at %s at %s" module camldebug-goto-position)))))) - - -(defun camldebug-delete-filter (string) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (if (not (string-match - (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+[ \t]*in " - (regexp-quote camldebug-delete-file) - ", character " - camldebug-delete-position "\n") - camldebug-filter-accumulator)) nil - (setq camldebug-delete-output - (match-string 2 camldebug-filter-accumulator)) - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator (1- (match-end 0))))) - (if (not (string-match comint-prompt-regexp - camldebug-filter-accumulator)) nil - (setq camldebug-delete-output (or camldebug-delete-output 'fail)) - (setq camldebug-filter-accumulator "")) - (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) - (setq camldebug-filter-accumulator - (match-string 1 camldebug-filter-accumulator))) - "") - - -(def-camldebug "delete" "\C-d") - -(defun camldebug-delete (&optional arg) - "Delete the breakpoint numbered ARG. - -Without ARG, the command behaves as follows: In the camldebug buffer, -try to obtain the time from context around point. In a caml mode -buffer, try to find the breakpoint associated with the current point -location. - -With a negative ARG, look for the -ARGth breakpoint pattern in the -camldebug buffer, then try to obtain the breakpoint info from context -around point." - - (interactive "P") - (cond - (arg - (let ((narg (camldebug-numeric-arg arg))) - (if (> narg 0) (camldebug-call "delete" nil narg) - (save-excursion - (set-buffer current-camldebug-buffer) - (if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file " - nil t (- 1 narg)) - (camldebug-delete nil) - (error "I don't have %d breakpoints in my history" - (- 1 narg))))))) - ((eq (current-buffer) current-camldebug-buffer) - (let* ((bpline "^Breakpoint \\([0-9]+\\) at [0-9]+ : file ") - (arg (cond - ((eobp) - (save-excursion (re-search-backward bpline nil t)) - (string-to-int (match-string 1))) - ((save-excursion - (beginning-of-line 1) - (looking-at bpline)) - (string-to-int (match-string 1))) - ((string-to-int (camldebug-format-command "%e")))))) - (camldebug-call "delete" nil arg))) - (t - (let ((camldebug-delete-file - (concat (camldebug-format-command "%m") ".ml")) - (camldebug-delete-position (camldebug-format-command "%c"))) - (save-excursion - (set-buffer current-camldebug-buffer) - (let ((proc (get-buffer-process (current-buffer))) - (camldebug-filter-function 'camldebug-delete-filter) - (camldebug-delete-output)) - (camldebug-call-1 "info break") - (while (not (and camldebug-delete-output - (zerop (length - camldebug-filter-accumulator)))) - (accept-process-output proc)) - (if (eq camldebug-delete-output 'fail) - (error "No breakpoint in %s at %s" - camldebug-delete-file - camldebug-delete-position) - (camldebug-call "delete" nil - (string-to-int camldebug-delete-output))))))))) - -(defun camldebug-complete-filter (string) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (while (string-match "\\(\n\\|\\`\\)\\(.+\\)\n" - camldebug-filter-accumulator) - (setq camldebug-complete-list - (cons (match-string 2 camldebug-filter-accumulator) - camldebug-complete-list)) - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator - (1- (match-end 0))))) - (if (not (string-match comint-prompt-regexp - camldebug-filter-accumulator)) nil - (setq camldebug-complete-list - (or camldebug-complete-list 'fail)) - (setq camldebug-filter-accumulator "")) - (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) - (setq camldebug-filter-accumulator - (match-string 1 camldebug-filter-accumulator))) - "") - -(defun camldebug-complete () - - "Perform completion on the camldebug command preceding point." - - (interactive) - (let* ((end (point)) - (command (save-excursion - (beginning-of-line) - (and (looking-at comint-prompt-regexp) - (goto-char (match-end 0))) - (buffer-substring (point) end))) - (camldebug-complete-list nil) (command-word)) - - ;; Find the word break. This match will always succeed. - (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) - (setq command-word (match-string 2 command)) - - ;itz 04-21-96 if we are trying to complete a word of nonzero - ;length, chop off the last character. This is a nasty hack, but it - ;works - in general, not just for this set of words: the comint - ;call below will weed out false matches - and it avoids further - ;mucking with camldebug's lexer. - (if (> (length command-word) 0) - (setq command (substring command 0 (1- (length command))))) - - (let ((camldebug-filter-function 'camldebug-complete-filter)) - (camldebug-call-1 (concat "complete " command)) - (set-marker camldebug-delete-prompt-marker nil) - (while (not (and camldebug-complete-list - (zerop (length camldebug-filter-accumulator)))) - (accept-process-output (get-buffer-process - (current-buffer))))) - (if (eq camldebug-complete-list 'fail) - (setq camldebug-complete-list nil)) - (setq camldebug-complete-list - (sort camldebug-complete-list 'string-lessp)) - (comint-dynamic-simple-complete command-word camldebug-complete-list))) - -(define-key camldebug-mode-map "\C-l" 'camldebug-refresh) -(define-key camldebug-mode-map "\t" 'comint-dynamic-complete) -(define-key camldebug-mode-map "\M-?" 'comint-dynamic-list-completions) - -(define-key tuareg-mode-map "\C-x " 'camldebug-break) - - -(defvar current-camldebug-buffer nil) - - -;;;###autoload -(defvar camldebug-command-name "ocamldebug" - "Pathname for executing Caml debugger.") - -;;;###autoload -(defun camldebug (path) - "Run camldebug on program FILE in buffer *camldebug-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for camldebug. If you wish to change this, use -the camldebug commands `cd DIR' and `directory'." - (interactive "fRun camldebug on file: ") - (setq path (expand-file-name path)) - (let ((file (file-name-nondirectory path))) - (pop-to-buffer (concat "*camldebug-" file "*")) - (setq default-directory (file-name-directory path)) - (message "Current directory is %s" default-directory) - (setq camldebug-command-name - (read-from-minibuffer "Caml debugguer to run: " - camldebug-command-name)) - (make-comint (concat "camldebug-" file) - (substitute-in-file-name camldebug-command-name) - nil - "-emacs" "-cd" default-directory path) - (set-process-filter (get-buffer-process (current-buffer)) - 'camldebug-filter) - (set-process-sentinel (get-buffer-process (current-buffer)) - 'camldebug-sentinel) - (camldebug-mode) - (camldebug-set-buffer))) - -(defun camldebug-set-buffer () - (if (eq major-mode 'camldebug-mode) - (setq current-camldebug-buffer (current-buffer)) - (save-selected-window (pop-to-buffer current-camldebug-buffer)))) - -;;; Filter and sentinel. - -(defun camldebug-marker-filter (string) - (setq camldebug-filter-accumulator - (concat camldebug-filter-accumulator string)) - (let ((output "") (begin)) - ;; Process all the complete markers in this chunk. - (while (setq begin - (string-match - "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n" - camldebug-filter-accumulator)) - (setq camldebug-last-frame - (if (char-equal ?H (aref camldebug-filter-accumulator - (1+ (1+ begin)))) nil - (let ((isbefore - (string= "before" - (match-string 5 camldebug-filter-accumulator))) - (startpos (string-to-int - (match-string 3 camldebug-filter-accumulator))) - (endpos (string-to-int - (match-string 4 camldebug-filter-accumulator)))) - (list (match-string 2 camldebug-filter-accumulator) - (if isbefore startpos endpos) - isbefore - startpos - endpos - ))) - output (concat output - (substring camldebug-filter-accumulator - 0 begin)) - ;; Set the accumulator to the remaining text. - camldebug-filter-accumulator (substring - camldebug-filter-accumulator - (match-end 0)) - camldebug-last-frame-displayed-p nil)) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; camldebug-filter-accumulator until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "\032.*\\'" camldebug-filter-accumulator) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring camldebug-filter-accumulator - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq camldebug-filter-accumulator - (substring camldebug-filter-accumulator (match-beginning 0)))) - - (setq output (concat output camldebug-filter-accumulator) - camldebug-filter-accumulator "")) - - output)) - -(defun camldebug-filter (proc string) - (let ((output)) - (if (buffer-name (process-buffer proc)) - (let ((process-window)) - (save-excursion - (set-buffer (process-buffer proc)) - ;; If we have been so requested, delete the debugger prompt. - (if (marker-buffer camldebug-delete-prompt-marker) - (progn - (delete-region (process-mark proc) - camldebug-delete-prompt-marker) - (set-marker camldebug-delete-prompt-marker nil))) - (setq output (funcall camldebug-filter-function string)) - ;; Don't display the specified file unless - ;; (1) point is at or after the position where output appears - ;; and (2) this buffer is on the screen. - (setq process-window (and camldebug-track-frame - (not camldebug-last-frame-displayed-p) - (>= (point) (process-mark proc)) - (get-buffer-window (current-buffer)))) - ;; Insert the text, moving the process-marker. - (comint-output-filter proc output)) - (if process-window - (save-selected-window - (select-window process-window) - (camldebug-display-frame))))))) - -(defun camldebug-sentinel (proc msg) - (cond ((null (buffer-name (process-buffer proc))) - ;; buffer killed - ;; Stop displaying an arrow in a source file. - (camldebug-remove-current-event) - (set-process-buffer proc nil)) - ((memq (process-status proc) '(signal exit)) - ;; Stop displaying an arrow in a source file. - (camldebug-remove-current-event) - ;; Fix the mode line. - (setq mode-line-process - (concat ": " - (symbol-name (process-status proc)))) - (let* ((obuf (current-buffer))) - ;; save-excursion isn't the right thing if - ;; process-buffer is current-buffer - (unwind-protect - (progn - ;; Write something in *compilation* and hack its mode line, - (set-buffer (process-buffer proc)) - ;; Force mode line redisplay soon - (set-buffer-modified-p (buffer-modified-p)) - (if (eobp) - (insert ?\n mode-name " " msg) - (save-excursion - (goto-char (point-max)) - (insert ?\n mode-name " " msg))) - ;; If buffer and mode line will show that the process - ;; is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc)) - ;; Restore old buffer, but don't restore old point - ;; if obuf is the cdb buffer. - (set-buffer obuf)))))) - - -(defun camldebug-refresh (&optional arg) - "Fix up a possibly garbled display, and redraw the mark." - (interactive "P") - (camldebug-display-frame) - (recenter arg)) - -(defun camldebug-display-frame () - "Find, obey and delete the last filename-and-line marker from Caml debugger. -The marker looks like \\032\\032FILENAME:CHARACTER\\n. -Obeying it means displaying in another window the specified file and line." - (interactive) - (camldebug-set-buffer) - (if (not camldebug-last-frame) - (camldebug-remove-current-event) - (camldebug-display-line (nth 0 camldebug-last-frame) - (nth 3 camldebug-last-frame) - (nth 4 camldebug-last-frame) - (nth 2 camldebug-last-frame))) - (setq camldebug-last-frame-displayed-p t)) - -;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen -;; and that its character CHARACTER is visible. -;; Put the mark on this character in that buffer. - -(defun camldebug-display-line (true-file schar echar kind) - (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen - (pop-up-windows t) - (buffer (find-file-noselect true-file)) - (window (display-buffer buffer t)) - (spos) (epos) (pos)) - (save-excursion - (set-buffer buffer) - (save-restriction - (widen) - (setq spos (+ (point-min) schar)) - (setq epos (+ (point-min) echar)) - (setq pos (if kind spos epos)) - (camldebug-set-current-event spos epos (current-buffer) kind)) - (cond ((or (< pos (point-min)) (> pos (point-max))) - (widen) - (goto-char pos)))) - (set-window-point window pos))) - -;;; Events. - -(defun camldebug-remove-current-event () - (if (and (fboundp 'make-overlay) window-system) - (progn - (delete-overlay camldebug-overlay-event) - (delete-overlay camldebug-overlay-under)) - (setq overlay-arrow-position nil))) - -(defun camldebug-set-current-event (spos epos buffer before) - (if window-system - (if before - (progn - (move-overlay camldebug-overlay-event spos (1+ spos) buffer) - (move-overlay camldebug-overlay-under - (+ spos 1) epos buffer)) - (move-overlay camldebug-overlay-event (1- epos) epos buffer) - (move-overlay camldebug-overlay-under spos (- epos 1) buffer)) - (save-excursion - (set-buffer buffer) - (goto-char pos) - (beginning-of-line) - (move-marker camldebug-event-marker (point)) - (setq overlay-arrow-position camldebug-event-marker)))) - -;;; Miscellaneous. - -(defun camldebug-module-name (filename) - (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1))) - -;;; The camldebug-call function must do the right thing whether its -;;; invoking keystroke is from the camldebug buffer itself (via -;;; major-mode binding) or a caml buffer. In the former case, we want -;;; to supply data from camldebug-last-frame. Here's how we do it: - -(defun camldebug-format-command (str) - (let* ((insource (not (eq (current-buffer) current-camldebug-buffer))) - (frame (if insource nil camldebug-last-frame)) (result)) - (while (and str (string-match "\\([^%]*\\)%\\([mdcep]\\)" str)) - (let ((key (string-to-char (substring str (match-beginning 2)))) - (cmd (substring str (match-beginning 1) (match-end 1))) - (subst)) - (setq str (substring str (match-end 2))) - (cond - ((eq key ?m) - (setq subst (camldebug-module-name - (if insource (buffer-file-name) (nth 0 frame))))) - ((eq key ?d) - (setq subst (file-name-directory - (if insource (buffer-file-name) (nth 0 frame))))) - ((eq key ?c) - (setq subst (int-to-string - (if insource (1- (point)) (nth 1 frame))))) - ((eq key ?e) - (setq subst (save-excursion - (skip-chars-backward "_0-9A-Za-z\277-\377") - (looking-at "[_0-9A-Za-z\277-\377]*") - (match-string 0))))) - (setq result (concat result cmd subst)))) - ;; There might be text left in STR when the loop ends. - (concat result str))) - -(defun camldebug-call (command &optional fmt arg) - "Invoke camldebug COMMAND displaying source in other window. - -Certain %-escapes in FMT are interpreted specially if present. -These are: - - %m module name of current module. - %d directory of current source file. - %c number of current character position - %e text of the caml variable surrounding point. - - The `current' source file is the file of the current buffer (if -we're in a caml buffer) or the source file current at the last break -or step (if we're in the camldebug buffer), and the `current' module -name is the filename stripped of any *.ml* suffixes (this assumes the -usual correspondence between module and file naming is observed). The -`current' position is that of the current buffer (if we're in a source -file) or the position of the last break or step (if we're in the -camldebug buffer). - -If ARG is present, it overrides any FMT flags and its string -representation is simply concatenated with the COMMAND." - - ;; Make sure debugger buffer is displayed in a window. - (camldebug-set-buffer) - (message "Command: %s" (camldebug-call-1 command fmt arg))) - -(defun camldebug-call-1 (command &optional fmt arg) - - ;; Record info on the last prompt in the buffer and its position. - (save-excursion - (set-buffer current-camldebug-buffer) - (goto-char (process-mark (get-buffer-process current-camldebug-buffer))) - (let ((pt (point))) - (beginning-of-line) - (if (looking-at comint-prompt-regexp) - (set-marker camldebug-delete-prompt-marker (point))))) - (let ((cmd (cond - (arg (concat command " " (int-to-string arg))) - (fmt (camldebug-format-command - (concat command " " fmt))) - (command)))) - (process-send-string (get-buffer-process current-camldebug-buffer) - (concat cmd "\n")) - cmd)) - - -(provide 'camldebug) diff --git a/emacs/external/tuareg/sym-lock.el b/emacs/external/tuareg/sym-lock.el deleted file mode 100644 index b93c24b..0000000 --- a/emacs/external/tuareg/sym-lock.el +++ /dev/null @@ -1,355 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; sym-lock.el - Extension of Font-Lock mode for symbol fontification. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Copyright © 1997-2004 Albert Cohen, all rights reserved. -;; Copying is covered by the GNU General Public License. -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; History -;; -;; first prototype by wg 5-96 -;; tweaked by Steve Dunham 5-96 -;; rewritten and enhanced by Albert Cohen 3-97 -;; new symbol-face format and ergonomy improvement 2-98 -;; major step towards portability and customization 5-98 -;; removed bug with multiple appends in hook by 3-99 -;; removed use-fonts check (due to incomatibilities) 9-00 -;; new after-change/pre-idle policy 6-01 -;; disable M$ Windows (symbol font problem) and fixed movement bug -;; (incompatibile atomic-extents and paren) 8-01 -;; check for the availability of a symbol font 1-02 -;; patch size inference and use the upper bound (of <= sizes) 1-02 -;; support for custom replacement faces (e.g., for the lambda symbol) 10-04 - -;; look at the symbol font? check out: xfd -fn '-adobe-symbol-*--14-*' - -(require 'cl) -(require 'font-lock) -(require 'atomic-extents) - -(defvar sym-lock-sym-count 0 - "Counter for internal symbols.") - -(defvar sym-lock-ext-start nil "Temporary for atomicization.") -(make-variable-buffer-local 'sym-lock-ext-start) -(defvar sym-lock-ext-end nil "Temporary for atomicization.") -(make-variable-buffer-local 'sym-lock-ext-end) - -(defvar sym-lock-font-size nil - "Default size for Sym-Lock symbol font.") -(make-variable-buffer-local 'sym-lock-font-size) -(put 'sym-lock-font-size 'permanent-local t) - -(defvar sym-lock-keywords nil - "Similar to `font-lock-keywords'.") -(make-variable-buffer-local 'sym-lock-keywords) -(put 'sym-lock-keywords 'permanent-local t) - -(defvar sym-lock-enabled nil - "Sym-Lock switch.") -(make-variable-buffer-local 'sym-lock-enabled) -(put 'sym-lock-enabled 'permanent-local t) - -(defvar sym-lock-color (face-foreground 'default) - "*Sym-Lock default color in `font-lock-use-colors' mode.") -(make-variable-buffer-local 'sym-lock-color) -(put 'sym-lock-color 'permanent-local t) - -(defvar sym-lock-mouse-face-enabled t - "Mouse face switch.") -(make-variable-buffer-local 'sym-lock-mouse-face-enabled) -(put 'sym-lock-mouse-face-enabled 'permanent-local t) - -(defun sym-lock-gen-symbol (&optional prefix) - "Generate a new internal symbol." - ;; where is the standard function to do this ? - (setq sym-lock-sym-count (+ sym-lock-sym-count 1)) - (intern (concat "sym-lock-gen-" (or prefix "") - (int-to-string sym-lock-sym-count)))) - -(defun sym-lock-make-symbols-atomic (&optional begin end) - "Function to make symbol faces atomic." - (if sym-lock-enabled - (map-extents - (lambda (extent maparg) - (let ((face (extent-face extent)) (ext)) - (if (and face (setq ext (face-property face 'sym-lock-remap))) - (progn - (if (numberp ext) - (set-extent-endpoints - extent (- (extent-start-position extent) ext) - (extent-end-position extent))) - (if ext - (progn - (if sym-lock-mouse-face-enabled - (set-extent-property extent 'mouse-face - 'default)) - (set-extent-property extent 'atomic t) - (set-extent-property extent 'start-open t)))))) - nil) - (current-buffer) - (if begin (save-excursion (goto-char begin) (beginning-of-line) (point)) - (point-min)) - (if end (save-excursion (goto-char end) (end-of-line) (point)) - (point-max)) - nil nil))) - -(defun sym-lock-compute-font-size () - "Computes the size of the \"better\" symbol font." - (let ((num (face-height 'default)) - (size) (minsize) - (lf (list-fonts "-adobe-symbol-medium-r-normal--*"))) - (setq minsize 8) - (while lf - (string-match "-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-\\([^-]*\\)-.*" - (car lf)) - (setq size (string-to-number (substring (car lf) - (match-beginning 1) - (match-end 1)))) - (if (and (<= size num) (> size minsize)) - (setq minsize size)) - (setq lf (cdr lf))) - minsize)) - -(defun sym-lock-enable () - "Enable Sym-Lock on this buffer." - (interactive) - (if (not (and (fboundp 'console-type) - (or (eq (console-type) 'x) - (eq (console-type) 'gtk)) - (sym-lock-look-for-symbol-font))) - (setq sym-lock-enabled nil) - ;; X-Window with symbol font - (if (not sym-lock-keywords) - (error "No Sym-Lock keywords defined!") - (setq sym-lock-enabled t) - (if font-lock-mode - (progn - (setq font-lock-keywords nil) ; Font-Lock explicit-defaults bug! - (font-lock-set-defaults t) - (font-lock-fontify-buffer))) - (message "Sym-Lock enabled.")))) - -(defun sym-lock-disable () - "Disable Sym-Lock on this buffer." - (interactive) - (if (not sym-lock-keywords) - (error "No Sym-Lock keywords defined!") - (setq sym-lock-enabled nil) - (if font-lock-mode - (progn - (setq font-lock-keywords nil) ; Font-Lock explicit-defaults bug! - (font-lock-set-defaults t) - (font-lock-fontify-buffer))) - (message "Sym-Lock disabled."))) - -(defvar sym-lock-font-name - (concat "-adobe-symbol-medium-r-normal--" - (if sym-lock-font-size sym-lock-font-size - (number-to-string (sym-lock-compute-font-size))) - "-*-*-*-p-*-adobe-fontspecific") - "Name of the font used by Sym-Lock.") -(make-variable-buffer-local 'sym-lock-font-name) -(put 'sym-lock-font-name 'permanent-local t) - -;;(make-face 'sym-lock-adobe-symbol-face "Face for Sym-Lock symbols") -;;(set-face-property 'sym-lock-adobe-symbol-face 'font sym-lock-font-name) - -(defun sym-lock-look-for-symbol-font () - "Returns whether there is a symbol font registred in the font server, - and sets sym-lock-enabled to false if not." - (if (list-fonts sym-lock-font-name) - t - (setq sym-lock-enabled nil) - nil)) - -(defun sym-lock-set-foreground () - "Set foreground color of Sym-Lock faces." - (if (and (boundp 'sym-lock-defaults) sym-lock-defaults) - (let ((l (car sym-lock-defaults)) - (color (face-foreground 'default) sym-lock-color)) - (if (and (consp l) (eq (car l) 'quote)) (setq l (eval l))) - (if (symbolp l) (setq l (eval l))) - (dolist (c l) - (setq c (nth 2 c)) - (if (consp c) (setq c (eval c))) - (if (string-match "-adobe-symbol-medium-r-normal-" - (font-name (face-font c))) - (set-face-foreground c color)))))) - -(defun sym-lock-remap-face (pat pos obj atomic face) - "Make a temporary face which remaps the POS char of PAT to the -given OBJ under the symbol face and all other characters to -the empty string. OBJ may either be a string or a character." - (let* ((name (sym-lock-gen-symbol "face")) - (table (make-display-table)) - (tface (make-face name "sym-lock-remap-face" t))) - (fillarray table "") - (aset table (string-to-char (substring pat (1- pos) pos)) - (if (stringp obj) obj (make-string 1 obj))) - (if face - (set-face-parent tface face) - (set-face-foreground tface sym-lock-color) - (set-face-property tface 'font sym-lock-font-name)) - (set-face-property tface 'display-table table) - (set-face-property tface 'sym-lock-remap atomic) ; mark it - tface - ;; return face value and not face name - ;; the temporary face would be otherwise GCed - )) - -(defvar sym-lock-clear-face - (let* ((name (sym-lock-gen-symbol "face")) - (table (make-display-table)) - (tface (make-face name "sym-lock-remap-face" t))) - (fillarray table "") - (set-face-property tface 'display-table table) - (set-face-property tface 'sym-lock-remap 1) ; mark it - tface - ;; return face value and not face name - ;; the temporary face would be otherwise GCed - )) - -(defun sym-lock (fl) - "Create font-lock table entries from a list of (PAT NUM POS OBJ) where -PAT (at NUM) is substituted by OBJ under the symbol face. The face's extent -will become atomic." - (if (not (and (fboundp 'console-type) - (or (eq (console-type) 'x) - (eq (console-type) 'gtk)))) - (setq sym-lock-enabled nil) - ;; X-Window - (if (sym-lock-look-for-symbol-font) - (progn - (message "Computing Sym-Lock faces...") - (setq sym-lock-keywords (sym-lock-rec fl)) - (setq sym-lock-enabled t) - (message "Computing Sym-Lock faces... done."))) - ;; ugly hack to make atomic keywords traversable when - ;; paren-highlighting is also using post-command-hook... - ;; it moves atomic-extents post-command-hook to the front - (remove-hook 'post-command-hook 'atomic-extent-post-hook) - (add-hook 'post-command-hook 'atomic-extent-post-hook))) - -(defun sym-lock-rec (fl) - (let ((f (car fl))) - (if f (let* ((pat (car f)) - (pos (caddr f)) - (c (substring pat (1- pos) pos))) - (if (or (string-match c (substring pat pos (length pat))) - (string-match c (substring pat 0 (1- pos)))) - (cons (apply 'sym-lock-atom f) - (cons (apply 'sym-lock-face f) - (sym-lock-rec (cdr fl)))) - (cons (apply 'sym-lock-atom-face f) - (sym-lock-rec (cdr fl)))))))) - -(defun sym-lock-atom-face (pat num pos obj face &optional override) - "Define an entry for the font-lock table which substitutes PAT (at NUM) by -OBJ under the symbol face. The face extent WILL become atomic." - (list pat num (sym-lock-remap-face pat pos obj t face) override)) - -(defun sym-lock-face (pat num pos obj face &optional override) - "Define an entry for the font-lock table which substitutes PAT (at NUM) by -OBJ under symbol face. The face extent will NOT become -atomic." - (list (concat "\\(" (substring pat 0 pos) "\\)" - (substring pat pos (length pat))) - (1+ num) (sym-lock-remap-face pat pos obj nil face) override)) - -(defun sym-lock-atom (pat num pos obj face &optional override) - "Define an entry for the font lock table which substitutes PAT (at NUM) by -a void face. To build the atom, the face extent will be reshaped from -\"begin_point\"-1 to \"end_point\"." - (list (concat (substring pat 0 pos) "\\(" - (substring pat pos (length pat)) "\\)") - (1+ num) sym-lock-clear-face override)) - -(defun sym-lock-after-change-function (beg end old-len) - (when sym-lock-enabled - (setq sym-lock-ext-start (if sym-lock-ext-start - (min beg sym-lock-ext-start) beg)) - (setq sym-lock-ext-end (if sym-lock-ext-end - (max end sym-lock-ext-end) end)))) - -(defun sym-lock-pre-idle-hook-last () - (if sym-lock-enabled - (condition-case nil - (when (and sym-lock-enabled sym-lock-ext-start) - (sym-lock-make-symbols-atomic sym-lock-ext-start sym-lock-ext-end) - (setq sym-lock-ext-start nil) - (setq sym-lock-ext-end nil)) - (error (warn "Error caught in `sym-lock-pre-idle-hook-last'"))))) - -(add-hook 'font-lock-after-fontify-buffer-hook - 'sym-lock-make-symbols-atomic) - -(defun sym-lock-mouse-face-enable () - "Enable special face for symbols under mouse." - (interactive) - (setq sym-lock-mouse-face-enabled t) - (if sym-lock-enabled - (font-lock-fontify-buffer))) - -(defun sym-lock-mouse-face-disable () - "Disable special face for symbols under mouse." - (interactive) - (setq sym-lock-mouse-face-enabled nil) - (if sym-lock-enabled - (font-lock-fontify-buffer))) - -(defun sym-lock-font-lock-hook () - "Function called by `font-lock-mode' for initialization purposes." - (add-hook 'after-change-functions 'sym-lock-after-change-function) - (add-hook 'pre-idle-hook 'sym-lock-pre-idle-hook-last t) - (if (and (featurep 'sym-lock) sym-lock-enabled - font-lock-defaults (boundp 'sym-lock-keywords)) - (progn - (sym-lock-patch-keywords) - (sym-lock-set-foreground)))) - -(defun font-lock-set-defaults (&optional explicit-defaults) - (when - (and - (featurep 'font-lock) - (if font-lock-auto-fontify - (not (memq major-mode font-lock-mode-disable-list)) - (memq major-mode font-lock-mode-enable-list)) - (font-lock-set-defaults-1 explicit-defaults) - (sym-lock-patch-keywords)) - (turn-on-font-lock))) - -(defun sym-lock-patch-keywords () - (if (and font-lock-keywords sym-lock-enabled - (boundp 'sym-lock-keywords) - (listp (car font-lock-keywords)) - (listp (cdar font-lock-keywords)) - (listp (cddar font-lock-keywords)) - (or (listp (caddar font-lock-keywords)) - (not (string-match - "sym-lock" - (symbol-name - (face-name (cadr (cdar font-lock-keywords)))))))) - (setq font-lock-keywords (append sym-lock-keywords - font-lock-keywords))) t) - -(add-menu-button '("Options" "Syntax Highlighting") - ["Sym-Lock" - (if sym-lock-enabled (sym-lock-disable) (sym-lock-enable)) - :style toggle :selected sym-lock-enabled - :active sym-lock-keywords] "Automatic") - -(add-hook 'font-lock-mode-hook 'sym-lock-font-lock-hook) - -(provide 'sym-lock) diff --git a/emacs/external/tuareg/tuareg.el b/emacs/external/tuareg/tuareg.el deleted file mode 100644 index a418ced..0000000 --- a/emacs/external/tuareg/tuareg.el +++ /dev/null @@ -1,3448 +0,0 @@ -;;; tuareg.el --- Caml mode for (X)Emacs. -*- coding: latin-1 -*- - -;; Copyright © 1997-2008 Albert Cohen, all rights reserved. -;; Licensed under the GNU General Public License. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;;; Commentary: - -;;; Code: - -(require 'cl) -(require 'easymenu) - -(defconst tuareg-mode-version "Tuareg Version 1.45.6" - " Copyright © 1997-2008 Albert Cohen, all rights reserved. - Copying is covered by the GNU General Public License. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Emacs versions support - -(defconst tuareg-with-xemacs (featurep 'xemacs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Compatibility functions - -(defalias 'tuareg-match-string - (if (fboundp 'match-string-no-properties) - 'match-string-no-properties - 'match-string)) - -(if (not (fboundp 'read-shell-command)) - (defun read-shell-command (prompt &optional initial-input history) - "Read a string from the minibuffer, using `shell-command-history'." - (read-from-minibuffer prompt initial-input nil nil - (or history 'shell-command-history)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Import types and help features - -(defvar tuareg-with-caml-mode-p - (condition-case nil - (and (require 'caml-types) (require 'caml-help)) - (error nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; User customizable variables - -;; Use the standard `customize' interface or `tuareg-mode-hook' to -;; Configure these variables - -(require 'custom) - -(defgroup tuareg nil - "Support for the Objective Caml language." - :group 'languages) - -;; Comments - -(defcustom tuareg-indent-leading-comments t - "*If true, indent leading comment lines (starting with `(*') like others." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-indent-comments t - "*If true, automatically align multi-line comments." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-comment-end-extra-indent 0 - "*How many spaces to indent a leading comment end `*)'. -If you expect comments to be indented like - (* - ... - *) -even without leading `*', use `tuareg-comment-end-extra-indent' = 1." - :group 'tuareg - :type '(radio :extra-offset 8 - :format "%{Comment End Extra Indent%}: - Comment alignment:\n%v" - (const :tag "align with `(' in comment opening" 0) - (const :tag "align with `*' in comment opening" 1) - (integer :tag "custom alignment" 0))) - -(defcustom tuareg-support-leading-star-comments t - "*Enable automatic intentation of comments of the form - (* - * ... - *) -Documentation comments (** *) are not concerned by this variable -unless `tuareg-leading-star-in-doc' is also set. - -If you do not set this variable and still expect comments to be -indented like - (* - ... - *) -\(without leading `*'), set `tuareg-comment-end-extra-indent' to 1." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-leading-star-in-doc nil - "*Enable automatic intentation of documentation comments of the form - (** - * ... - *)" - :group 'tuareg :type 'boolean) - -;; Indentation defaults - -(defcustom tuareg-default-indent 2 - "*Default indentation. - -Global indentation variable (large values may lead to indentation overflows). -When no governing keyword is found, this value is used to indent the line -if it has to." - :group 'tuareg :type 'integer) - -(defcustom tuareg-lazy-paren nil - "*If true, indent parentheses like a standard keyword." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-support-camllight nil - "*If true, handle Caml Light character syntax (incompatible with labels)." - :group 'tuareg :type 'boolean - :set '(lambda (var val) - (setq tuareg-support-camllight val) - (if (boundp 'tuareg-mode-syntax-table) - (modify-syntax-entry ?` (if val "\"" ".") - tuareg-mode-syntax-table)))) - -(defcustom tuareg-support-metaocaml nil - "*If true, handle MetaOCaml character syntax." - :group 'tuareg :type 'boolean - :set '(lambda (var val) - (setq tuareg-support-metaocaml val) - (if (boundp 'tuareg-font-lock-keywords) - (tuareg-install-font-lock)))) - -(defcustom tuareg-let-always-indent t - "*If true, enforce indentation is at least `tuareg-let-indent' after a `let'. - -As an example, set it to false when you have `tuareg-with-indent' set to 0, -and you want `let x = match ... with' and `match ... with' indent the -same way." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-|-extra-unindent tuareg-default-indent - "*Extra backward indent for Caml lines starting with the `|' operator. - -It is NOT the variable controlling the indentation of the `|' itself: -this value is automatically added to `function', `with', `parse' and -some cases of `type' keywords to leave enough space for `|' backward -indentation. - -For exemple, setting this variable to 0 leads to the following indentation: - match ... with - X -> ... - | Y -> ... - | Z -> ... - -To modify the indentation of lines lead by `|' you need to modify the -indentation variables for `with', `function' and `parse', and possibly -for `type' as well. For example, setting them to 0 (and leaving -`tuareg-|-extra-unindent' to its default value) yields: - match ... with - X -> ... - | Y -> ... - | Z -> ..." - :group 'tuareg :type 'integer) - -(defcustom tuareg-class-indent tuareg-default-indent - "*How many spaces to indent from a `class' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-sig-struct-align t - "*Align `sig' and `struct' keywords with `module'." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-sig-struct-indent tuareg-default-indent - "*How many spaces to indent from a `sig' or `struct' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-method-indent tuareg-default-indent - "*How many spaces to indent from a `method' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-begin-indent tuareg-default-indent - "*How many spaces to indent from a `begin' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-for-while-indent tuareg-default-indent - "*How many spaces to indent from a `for' or `while' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-do-indent tuareg-default-indent - "*How many spaces to indent from a `do' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-fun-indent tuareg-default-indent - "*How many spaces to indent from a `fun' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-function-indent tuareg-default-indent - "*How many spaces to indent from a `function' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-if-then-else-indent tuareg-default-indent - "*How many spaces to indent from an `if', `then' or `else' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-let-indent tuareg-default-indent - "*How many spaces to indent from a `let' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-in-indent tuareg-default-indent - "*How many spaces to indent from a `in' keyword. -A lot of people like formatting `let' ... `in' expressions whithout -indentation: - let x = 0 in - blah x -Set this variable to 0 to get this behaviour. -However, nested declarations are always correctly handled: - let x = 0 in let x = 0 - let y = 0 in or in let y = 0 - let z = 0 ... in let z = 0 ..." - :group 'tuareg :type 'integer) - -(defcustom tuareg-match-indent tuareg-default-indent - "*How many spaces to indent from a `match' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-try-indent tuareg-default-indent - "*How many spaces to indent from a `try' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-with-indent tuareg-default-indent - "*How many spaces to indent from a `with' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-rule-indent tuareg-default-indent - "*How many spaces to indent from a `rule' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-parse-indent tuareg-default-indent - "*How many spaces to indent from a `parse' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-parser-indent tuareg-default-indent - "*How many spaces to indent from a `parser' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-type-indent tuareg-default-indent - "*How many spaces to indent from a `type' keyword." - :group 'tuareg :type 'integer) - -(defcustom tuareg-val-indent tuareg-default-indent - "*How many spaces to indent from a `val' keyword." - :group 'tuareg :type 'integer) - -;; Automatic indentation -;; Using abbrev-mode and electric keys - -(defcustom tuareg-use-abbrev-mode t - "*Non-nil means electrically indent lines starting with leading keywords. -Leading keywords are such as `end', `done', `else' etc. -It makes use of `abbrev-mode'. - -Many people find eletric keywords irritating, so you can disable them by -setting this variable to nil." - :group 'tuareg :type 'boolean - :set '(lambda (var val) - (setq tuareg-use-abbrev-mode val) - (abbrev-mode val))) - -(defcustom tuareg-electric-indent t - "*Non-nil means electrically indent lines starting with `|', `)', `]' or `}'. - -Many people find eletric keys irritating, so you can disable them in -setting this variable to nil." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-electric-close-vector t - "*Non-nil means electrically insert `|' before a vector-closing `]' or -`>' before an object-closing `}'. - -Many people find eletric keys irritating, so you can disable them in -setting this variable to nil. You should probably have this on, -though, if you also have `tuareg-electric-indent' on." - :group 'tuareg :type 'boolean) - -;; Tuareg-Interactive -;; Configure via `tuareg-mode-hook' - -(defcustom tuareg-skip-after-eval-phrase t - "*Non-nil means skip to the end of the phrase after evaluation in the -Caml toplevel." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-interactive-read-only-input nil - "*Non-nil means input sent to the Caml toplevel is read-only." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-interactive-echo-phrase t - "*Non-nil means echo phrases in the toplevel buffer when sending -them to the Caml toplevel." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-interactive-input-font-lock t - "*Non nil means Font-Lock for toplevel input phrases." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-interactive-output-font-lock t - "*Non nil means Font-Lock for toplevel output messages." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-interactive-error-font-lock t - "*Non nil means Font-Lock for toplevel error messages." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-display-buffer-on-eval t - "*Non nil means pop up the Caml toplevel when evaluating code." - :group 'tuareg :type 'boolean) - -(defcustom tuareg-manual-url "http://pauillac.inria.fr/ocaml/htmlman/index.html" - "*URL to the Caml reference manual." - :group 'tuareg :type 'string) - -(defcustom tuareg-browser 'tuareg-netscape-manual - "*Name of function that displays the Caml reference manual. -Valid names are `tuareg-netscape-manual', `tuareg-mmm-manual' -and `tuareg-xemacs-w3-manual' (XEmacs only)." - :group 'tuareg) - -(defcustom tuareg-library-path "/usr/local/lib/ocaml/" - "*Path to the Caml library." - :group 'tuareg :type 'string) - -(defcustom tuareg-definitions-max-items 30 - "*Maximum number of items a definitions menu can contain." - :group 'tuareg :type 'integer) - -(defvar tuareg-options-list - '(("Lazy parentheses indentation" . 'tuareg-lazy-paren) - ("Force indentation after `let'" . 'tuareg-let-always-indent) - "---" - ("Automatic indentation of leading keywords" . 'tuareg-use-abbrev-mode) - ("Electric indentation of ), ] and }" . 'tuareg-electric-indent) - ("Electric matching of [| and {<" . 'tuareg-electric-close-vector) - "---" - ("Indent body of comments" . 'tuareg-indent-comments) - ("Indent first line of comments" . 'tuareg-indent-leading-comments) - ("Leading-`*' comment style" . 'tuareg-support-leading-star-comments)) - "*List of menu-configurable Tuareg options.") - -(defvar tuareg-interactive-options-list - '(("Skip phrase after evaluation" . 'tuareg-skip-after-eval-phrase) - ("Echo phrase in interactive buffer" . 'tuareg-interactive-echo-phrase) - "---" - ("Font-lock interactive input" . 'tuareg-interactive-input-font-lock) - ("Font-lock interactive output" . 'tuareg-interactive-output-font-lock) - ("Font-lock interactive error" . 'tuareg-interactive-error-font-lock) - "---" - ("Read only input" . 'tuareg-interactive-read-only-input)) - "*List of menu-configurable Tuareg options.") - -(defvar tuareg-interactive-program "ocaml" - "*Default program name for invoking a Caml toplevel from Emacs.") -;; Could be interesting to have this variable buffer-local -;; (e.g., ocaml vs. metaocaml buffers) -;; (make-variable-buffer-local 'tuareg-interactive-program) - -;; Backtrack to custom parsing and caching by default, until stable -;;(defvar tuareg-use-syntax-ppss (fboundp 'syntax-ppss) -(defconst tuareg-use-syntax-ppss nil - "*If nil, use our own parsing and caching.") - -(defgroup tuareg-faces nil - "Special faces for the Tuareg mode." - :group 'tuareg) - -(defconst tuareg-faces-inherit-p - (if (boundp 'face-attribute-name-alist) - (assq :inherit face-attribute-name-alist))) - -(defface tuareg-font-lock-governing-face - (if tuareg-faces-inherit-p - '((t :inherit font-lock-keyword-face)) - '((((background light)) (:foreground "darkorange3" :bold t)) - (t (:foreground "orange" :bold t)))) - "Face description for governing/leading keywords." - :group 'tuareg-faces) -(defvar tuareg-font-lock-governing-face - 'tuareg-font-lock-governing-face) - -(defface tuareg-font-lock-multistage-face - '((((background light)) - (:foreground "darkblue" :background "lightgray" :bold t)) - (t (:foreground "steelblue" :background "darkgray" :bold t))) - "Face description for MetaOCaml staging operators." - :group 'tuareg-faces) -(defvar tuareg-font-lock-multistage-face - 'tuareg-font-lock-multistage-face) - -(defface tuareg-font-lock-operator-face - (if tuareg-faces-inherit-p - '((t :inherit font-lock-keyword-face)) - '((((background light)) (:foreground "brown")) - (t (:foreground "khaki")))) - "Face description for all operators." - :group 'tuareg-faces) -(defvar tuareg-font-lock-operator-face - 'tuareg-font-lock-operator-face) - -(defface tuareg-font-lock-error-face - '((t (:foreground "yellow" :background "red" :bold t))) - "Face description for all errors reported to the source." - :group 'tuareg-faces) -(defvar tuareg-font-lock-error-face - 'tuareg-font-lock-error-face) - -(defface tuareg-font-lock-interactive-output-face - '((((background light)) - (:foreground "blue4")) - (t (:foreground "cyan"))) - "Face description for all toplevel outputs." - :group 'tuareg-faces) -(defvar tuareg-font-lock-interactive-output-face - 'tuareg-font-lock-interactive-output-face) - -(defface tuareg-font-lock-interactive-error-face - (if tuareg-faces-inherit-p - '((t :inherit font-lock-warning-face)) - '((((background light)) (:foreground "red3")) - (t (:foreground "red2")))) - "Face description for all toplevel errors." - :group 'tuareg-faces) -(defvar tuareg-font-lock-interactive-error-face - 'tuareg-font-lock-interactive-error-face) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support definitions - -(defun tuareg-leading-star-p () - (and tuareg-support-leading-star-comments - (save-excursion ; this function does not make sense outside of a comment - (tuareg-beginning-of-literal-or-comment) - (and (or tuareg-leading-star-in-doc - (not (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*"))) - (progn - (forward-line 1) - (back-to-indentation) - (looking-at "\\*[^)]")))))) - -(defun tuareg-auto-fill-insert-leading-star (&optional leading-star) - (let ((point-leading-comment (looking-at "(\\*")) (return-leading nil)) - (save-excursion - (back-to-indentation) - (if tuareg-electric-indent - (progn - (if (and (tuareg-in-comment-p) - (or leading-star - (tuareg-leading-star-p))) - (progn - (if (not (looking-at "(?\\*")) - (insert-before-markers "* ")) - (setq return-leading t))) - (if (not point-leading-comment) - ;; Use optional argument to break recursion - (tuareg-indent-command t))))) - return-leading)) - -(defun tuareg-auto-fill-function () - (if (tuareg-in-literal-p) () - (let ((leading-star - (if (not (char-equal ?\n last-command-char)) - (tuareg-auto-fill-insert-leading-star) - nil))) - (do-auto-fill) - (if (not (char-equal ?\n last-command-char)) - (tuareg-auto-fill-insert-leading-star leading-star))))) - -(defun tuareg-forward-char (&optional step) - (if step (goto-char (+ (point) step)) - (goto-char (1+ (point))))) - -(defun tuareg-backward-char (&optional step) - (if step (goto-char (- (point) step)) - (goto-char (1- (point))))) - -(defun tuareg-in-indentation-p () - "Return non-nil if all chars between beginning of line and point are blanks." - (save-excursion - (skip-chars-backward " \t") - (bolp))) - -(defvar tuareg-cache-stop (point-min)) -(make-variable-buffer-local 'tuareg-cache-stop) -(defvar tuareg-cache nil) -(make-variable-buffer-local 'tuareg-cache) -(defvar tuareg-cache-local nil) -(make-variable-buffer-local 'tuareg-cache-local) -(defvar tuareg-cache-last-local nil) -(make-variable-buffer-local 'tuareg-cache-last-local) -(defvar tuareg-last-loc (cons nil nil)) - -(if tuareg-use-syntax-ppss - (progn - (defun tuareg-in-literal-p () - "Returns non-nil if point is inside a Caml literal." - (nth 3 (syntax-ppss))) - (defun tuareg-in-comment-p () - "Returns non-nil if point is inside a Caml comment." - (nth 4 (syntax-ppss))) - (defun tuareg-in-literal-or-comment-p () - "Returns non-nil if point is inside a Caml literal or comment." - (nth 8 (syntax-ppss))) - (defun tuareg-beginning-of-literal-or-comment () - "Skips to the beginning of the current literal or comment (or buffer)." - (interactive) - (goto-char (or (nth 8 (syntax-ppss)) (point)))) - (defun tuareg-beginning-of-literal-or-comment-fast () - (goto-char (or (nth 8 (syntax-ppss)) (point-min)))) - ;; FIXME: not clear if moving out of a string/comment counts as 1 or no. - (defalias 'tuareg-backward-up-list 'backward-up-list)) - - (defun tuareg-before-change-function (begin end) - (setq tuareg-cache-stop - (if (save-excursion (beginning-of-line) (= (point) (point-min))) - (point-min) - (min tuareg-cache-stop (1- begin))))) - - (defun tuareg-in-literal-p () - "Return non-nil if point is inside a Caml literal." - (car (tuareg-in-literal-or-comment))) - (defun tuareg-in-comment-p () - "Return non-nil if point is inside a Caml comment." - (cdr (tuareg-in-literal-or-comment))) - (defun tuareg-in-literal-or-comment-p () - "Return non-nil if point is inside a Caml literal or comment." - (tuareg-in-literal-or-comment) - (or (car tuareg-last-loc) (cdr tuareg-last-loc))) - (defun tuareg-in-literal-or-comment () - "Return the pair `((tuareg-in-literal-p) . (tuareg-in-comment-p))'." - (if (and (<= (point) tuareg-cache-stop) tuareg-cache) - (progn - (if (or (not tuareg-cache-local) (not tuareg-cache-last-local) - (and (>= (point) (caar tuareg-cache-last-local)))) - (setq tuareg-cache-local tuareg-cache)) - (while (and tuareg-cache-local (< (point) (caar tuareg-cache-local))) - (setq tuareg-cache-last-local tuareg-cache-local - tuareg-cache-local (cdr tuareg-cache-local))) - (setq tuareg-last-loc - (if tuareg-cache-local - (cons (eq (cadar tuareg-cache-local) 'b) - (> (cddar tuareg-cache-local) 0)) - (cons nil nil)))) - (let ((flag t) (op (point)) (mp (min (point) (1- (point-max)))) - (balance 0) (end-of-comment nil)) - (while (and tuareg-cache (<= tuareg-cache-stop (caar tuareg-cache))) - (setq tuareg-cache (cdr tuareg-cache))) - (if tuareg-cache - (if (eq (cadar tuareg-cache) 'b) - (progn - (setq tuareg-cache-stop (1- (caar tuareg-cache))) - (goto-char tuareg-cache-stop) - (setq balance (cddar tuareg-cache)) - (setq tuareg-cache (cdr tuareg-cache))) - (setq balance (cddar tuareg-cache)) - (setq tuareg-cache-stop (caar tuareg-cache)) - (goto-char tuareg-cache-stop) - (skip-chars-forward "(")) - (goto-char (point-min))) - (skip-chars-backward "\\\\*") - (while flag - (if end-of-comment (setq balance 0 end-of-comment nil)) - (skip-chars-forward "^\\\\'`\"(\\*") - (cond - ((looking-at "\\\\") - (tuareg-forward-char 2)) - ((looking-at "'\\([^\n\\']\\|\\\\[^ \t\n][^ \t\n]?[^ \t\n]?\\)'") - (setq tuareg-cache (cons (cons (1+ (point)) (cons 'b balance)) - tuareg-cache)) - (goto-char (match-end 0)) - (setq tuareg-cache (cons (cons (point) (cons 'e balance)) - tuareg-cache))) - ((and - tuareg-support-camllight - (looking-at "`\\([^\n\\']\\|\\\\[^ \t\n][^ \t\n]?[^ \t\n]?\\)`")) - (setq tuareg-cache (cons (cons (1+ (point)) (cons 'b balance)) - tuareg-cache)) - (goto-char (match-end 0)) - (setq tuareg-cache (cons (cons (point) (cons 'e balance)) - tuareg-cache))) - ((looking-at "\"") - (tuareg-forward-char) - (setq tuareg-cache (cons (cons (point) (cons 'b balance)) - tuareg-cache)) - (skip-chars-forward "^\\\\\"") - (while (looking-at "\\\\") - (tuareg-forward-char 2) (skip-chars-forward "^\\\\\"")) - (tuareg-forward-char) - (setq tuareg-cache (cons (cons (point) (cons 'e balance)) - tuareg-cache))) - ((looking-at "(\\*") - (setq balance (1+ balance)) - (setq tuareg-cache (cons (cons (point) (cons nil balance)) - tuareg-cache)) - (tuareg-forward-char 2)) - ((looking-at "\\*)") - (tuareg-forward-char 2) - (if (> balance 1) - (progn - (setq balance (1- balance)) - (setq tuareg-cache (cons (cons (point) (cons nil balance)) - tuareg-cache))) - (setq end-of-comment t) - (setq tuareg-cache (cons (cons (point) (cons nil 0)) - tuareg-cache)))) - (t (tuareg-forward-char))) - (setq flag (<= (point) mp))) - (setq tuareg-cache-local tuareg-cache - tuareg-cache-stop (point)) - (goto-char op) - (if tuareg-cache (tuareg-in-literal-or-comment) - (setq tuareg-last-loc (cons nil nil)) - tuareg-last-loc)))) - - (defun tuareg-beginning-of-literal-or-comment () - "Skips to the beginning of the current literal or comment (or buffer)." - (interactive) - (if (tuareg-in-literal-or-comment-p) - (tuareg-beginning-of-literal-or-comment-fast))) - - (defun tuareg-beginning-of-literal-or-comment-fast () - (while (and tuareg-cache-local - (or (eq 'b (cadar tuareg-cache-local)) - (> (cddar tuareg-cache-local) 0))) - (setq tuareg-cache-last-local tuareg-cache-local - tuareg-cache-local (cdr tuareg-cache-local))) - (if tuareg-cache-last-local - (goto-char (caar tuareg-cache-last-local)) - (goto-char (point-min))) - (if (eq 'b (cadar tuareg-cache-last-local)) (tuareg-backward-char))) - - (defun tuareg-backward-up-list () - "Safe up-list regarding comments, literals and errors." - (let ((balance 1) (op (point)) (oc nil)) - (tuareg-in-literal-or-comment) - (while (and (> (point) (point-min)) (> balance 0)) - (setq oc (if tuareg-cache-local (caar tuareg-cache-local) (point-min))) - (condition-case nil (up-list -1) (error (goto-char (point-min)))) - (if (>= (point) oc) (setq balance (1- balance)) - (goto-char op) - (skip-chars-backward "^[]{}()") (tuareg-backward-char) - (if (not (tuareg-in-literal-or-comment-p)) - (cond - ((looking-at "[[{(]") - (setq balance (1- balance))) - ((looking-at "[]})]") - (setq balance (1+ balance)))) - (tuareg-beginning-of-literal-or-comment-fast))) - (setq op (point)))))) ;; End of (if tuareg-use-syntax-ppss - -(defun tuareg-false-=-p () - "Is the underlying `=' the first/second letter of an operator?" - (or (memq (preceding-char) '(?: ?> ?< ?=)) - (char-equal ?= (char-after (1+ (point)))))) - -(defun tuareg-at-phrase-break-p () - "Is the underlying `;' a phrase break?" - (and (char-equal ?\; (following-char)) - (or (and (not (eobp)) - (char-equal ?\; (char-after (1+ (point))))) - (char-equal ?\; (preceding-char))))) - -(defun tuareg-assoc-indent (kwop &optional look-for-let-or-and) - "Return relative indentation of the keyword given in argument." - (let ((ind (symbol-value (cdr (assoc kwop tuareg-keyword-alist)))) - (looking-let-or-and (and look-for-let-or-and - (looking-at "\\<\\(let\\|and\\)\\>")))) - (if (string-match "\\<\\(with\\|function\\|parser?\\)\\>" kwop) - (+ (if (and tuareg-let-always-indent - looking-let-or-and (< ind tuareg-let-indent)) - tuareg-let-indent ind) - tuareg-|-extra-unindent) - ind))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Sym-lock in Emacs - -;; By Stefan Monnier - -(defcustom tuareg-font-lock-symbols nil - "Display fun and -> and such using symbols in fonts. -This may sound like a neat trick, but note that it can change the -alignment and can thus lead to surprises." - :type 'bool) - -(defvar tuareg-font-lock-symbols-alist - (append - ;; The symbols can come from a JIS0208 font. - (and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'japanese-jisx0208) - (list (cons "fun" (make-char 'japanese-jisx0208 38 75)) - (cons "sqrt" (make-char 'japanese-jisx0208 34 101)) - (cons "not" (make-char 'japanese-jisx0208 34 76)) - (cons "or" (make-char 'japanese-jisx0208 34 75)) - (cons "||" (make-char 'japanese-jisx0208 34 75)) - (cons "&&" (make-char 'japanese-jisx0208 34 74)) - ;; (cons "*." (make-char 'japanese-jisx0208 33 95)) - ;; (cons "/." (make-char 'japanese-jisx0208 33 96)) - (cons "->" (make-char 'japanese-jisx0208 34 42)) - (cons "=>" (make-char 'japanese-jisx0208 34 77)) - (cons "<-" (make-char 'japanese-jisx0208 34 43)) - (cons "<>" (make-char 'japanese-jisx0208 33 98)) - (cons "==" (make-char 'japanese-jisx0208 34 97)) - (cons ">=" (make-char 'japanese-jisx0208 33 102)) - (cons "<=" (make-char 'japanese-jisx0208 33 101)) - ;; Some greek letters for type parameters. - (cons "'a" (make-char 'japanese-jisx0208 38 65)) - (cons "'b" (make-char 'japanese-jisx0208 38 66)) - (cons "'c" (make-char 'japanese-jisx0208 38 67)) - (cons "'d" (make-char 'japanese-jisx0208 38 68)))) - ;; Or a unicode font. - (and (fboundp 'decode-char) - (list (cons "fun" (decode-char 'ucs 955)) - (cons "sqrt" (decode-char 'ucs 8730)) - (cons "not" (decode-char 'ucs 172)) - (cons "or" (decode-char 'ucs 8897)) - (cons "&&" (decode-char 'ucs 8896)) - (cons "||" (decode-char 'ucs 8897)) - ;; (cons "*." (decode-char 'ucs 215)) - ;; (cons "/." (decode-char 'ucs 247)) - (cons "->" (decode-char 'ucs 8594)) - (cons "<-" (decode-char 'ucs 8592)) - (cons "<=" (decode-char 'ucs 8804)) - (cons ">=" (decode-char 'ucs 8805)) - (cons "<>" (decode-char 'ucs 8800)) - (cons "==" (decode-char 'ucs 8801)) - ;; Some greek letters for type parameters. - (cons "'a" (decode-char 'ucs 945)) - (cons "'b" (decode-char 'ucs 946)) - (cons "'c" (decode-char 'ucs 947)) - (cons "'d" (decode-char 'ucs 948)) - )))) - -(defun tuareg-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 (if (eq (char-syntax (char-after start)) ?w) - '(?w) '(?. ?\\)))) - (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) - (memq (char-syntax (or (char-after end) ?\ )) syntaxes) - (memq (get-text-property start 'face) - '(tuareg-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 tuareg-font-lock-symbols-keywords () - (when (fboundp 'compose-region) - (let ((alist nil)) - (dolist (x tuareg-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 (tuareg-font-lock-compose-symbol ',alist)))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Font-Lock - -(unless tuareg-use-syntax-ppss - -(defun tuareg-fontify-buffer () - (font-lock-default-fontify-buffer) - (tuareg-fontify (point-min) (point-max))) - -(defun tuareg-fontify-region (begin end &optional verbose) - (font-lock-default-fontify-region begin end verbose) - (tuareg-fontify begin end)) - -(defun tuareg-fontify (begin end) - (if (eq major-mode 'tuareg-mode) - (save-excursion - (let ((modified (buffer-modified-p))) ; Emacs hack (see below) - (goto-char begin) - (beginning-of-line) - (setq begin (point)) - (goto-char (1- end)) - (end-of-line) - ;; Dirty hack to trick `font-lock-default-unfontify-region' - (if (not tuareg-with-xemacs) (forward-line 2)) - (setq end (point)) - (while (> end begin) - (goto-char (1- end)) - (tuareg-in-literal-or-comment) - (cond - ((cdr tuareg-last-loc) - (tuareg-beginning-of-literal-or-comment) - (put-text-property (max begin (point)) end 'face - (if (looking-at - "(\\*[Tt][Ee][Xx]\\|(\\*\\*[^*]") - tuareg-doc-face - 'font-lock-comment-face)) - (setq end (1- (point)))) - ((car tuareg-last-loc) - (tuareg-beginning-of-literal-or-comment) - (put-text-property (max begin (point)) end 'face - 'font-lock-string-face) - (setq end (point))) - (t (while (and tuareg-cache-local - (or (> (caar tuareg-cache-local) end) - (eq 'b (cadar tuareg-cache-local)))) - (setq tuareg-cache-local (cdr tuareg-cache-local))) - (setq end (if tuareg-cache-local - (caar tuareg-cache-local) begin))))) - (if (not (or tuareg-with-xemacs modified)) ; properties taken - (set-buffer-modified-p nil)))))) ; too seriously... - -;; XEmacs and Emacs have different documentation faces... -(defvar tuareg-doc-face (if (facep 'font-lock-doc-face) - 'font-lock-doc-face - 'font-lock-doc-string-face)) - -) ;; End of (unless tuareg-use-syntax-ppss - -;; By Stefan Monnier: redesigned font-lock installation and use char classes - -;; When char classes are not available, character ranges only span -;; ASCII characters for MULE compatibility -(defconst tuareg-use-char-classes (string-match "[[:alpha:]]" "x")) -(defconst tuareg-lower (if tuareg-use-char-classes "[:lower:]" "a-z")) -(defconst tuareg-alpha (if tuareg-use-char-classes "[:alpha:]" "a-zA-Z")) - -(defconst tuareg-font-lock-syntactic-keywords - ;; Char constants start with ' but ' can also appear in identifiers. - ;; Beware not to match things like '*)hel' or '"hel' since the first ' - ;; might be inside a string or comment. - '(("\\<\\('\\)\\([^'\\\n]\\|\\\\.[^\\'\n \")]*\\)\\('\\)" - (1 '(7)) (3 '(7))))) - -(defun tuareg-font-lock-syntactic-face-function (state) - (if (nth 3 state) font-lock-string-face - (let ((start (nth 8 state))) - (if (and (> (point-max) (+ start 2)) - (eq (char-after (+ start 2)) ?*) - (not (eq (char-after (+ start 3)) ?*))) - ;; This is a documentation comment - tuareg-doc-face - font-lock-comment-face)))) - -(when (facep 'font-lock-reference-face) - (defvar font-lock-constant-face) - (if (facep 'font-lock-constant-face) () - (defvar font-lock-constant-face font-lock-reference-face) - (copy-face font-lock-reference-face 'font-lock-constant-face))) -(when (facep 'font-lock-keyword-face) - (defvar font-lock-preprocessor-face) - (if (facep 'font-lock-preprocessor-face) () - (defvar font-lock-preprocessor-face font-lock-keyword-face) - (copy-face font-lock-keyword-face 'font-lock-preprocessor-face))) - -;; Initially empty, set in `tuareg-install-font-lock' -(defvar tuareg-font-lock-keywords - () - "Font-Lock patterns for Tuareg mode.") - -(when (featurep 'sym-lock) - (make-face 'tuareg-font-lock-lambda-face - "Face description for fun keywords (lambda operator).") - (set-face-parent 'tuareg-font-lock-lambda-face - font-lock-function-name-face) - (set-face-font 'tuareg-font-lock-lambda-face - sym-lock-font-name) - - ;; To change this table, xfd -fn '-adobe-symbol-*--12-*' may be - ;; used to determine the symbol character codes. - (defvar tuareg-sym-lock-keywords - '(("<-" 0 1 172 nil) - ("->" 0 1 174 nil) - ("<=" 0 1 163 nil) - (">=" 0 1 179 nil) - ("<>" 0 1 185 nil) - ("==" 0 1 186 nil) - ("||" 0 1 218 nil) - ("&&" 0 1 217 nil) - ("[^*]\\(\\*\\)\\." 1 8 180 nil) - ("\\(/\\)\\." 1 3 184 nil) - (";;" 0 1 191 nil) - ("\\" 0 3 214 nil) - ("\\" 0 3 108 tuareg-font-lock-lambda-face) - ("\\" 0 3 218 nil) - ("\\" 0 3 216 nil)) - "If non nil: Overrides default Sym-Lock patterns for Tuareg.")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Keymap - -(defvar tuareg-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "|" 'tuareg-electric) - (define-key map ")" 'tuareg-electric-rp) - (define-key map "}" 'tuareg-electric-rc) - (define-key map "]" 'tuareg-electric-rb) - (define-key map "\M-q" 'tuareg-indent-phrase) - (define-key map "\C-c\C-q" 'tuareg-indent-phrase) - (define-key map "\M-\C-\\" 'indent-region) - (define-key map "\C-c\C-a" 'tuareg-find-alternate-file) - (define-key map "\C-c\C-c" 'compile) - (define-key map "\C-xnd" 'tuareg-narrow-to-phrase) - (define-key map "\M-\C-x" 'tuareg-eval-phrase) - (define-key map "\C-x\C-e" 'tuareg-eval-phrase) - (define-key map "\C-c\C-e" 'tuareg-eval-phrase) - (define-key map "\C-c\C-r" 'tuareg-eval-region) - (define-key map "\C-c\C-b" 'tuareg-eval-buffer) - (define-key map "\C-c\C-s" 'tuareg-run-caml) - (define-key map "\C-c\C-i" 'tuareg-interrupt-caml) - (define-key map "\C-c\C-k" 'tuareg-kill-caml) - (define-key map "\C-c\C-n" 'tuareg-next-phrase) - (define-key map "\C-c\C-p" 'tuareg-previous-phrase) - (define-key map [(control c) (home)] 'tuareg-move-inside-block-opening) - (define-key map [(control c) (control down)] 'tuareg-next-phrase) - (define-key map [(control c) (control up)] 'tuareg-previous-phrase) - (define-key map [(meta control down)] 'tuareg-next-phrase) - (define-key map [(meta control up)] 'tuareg-previous-phrase) - (define-key map [(meta control h)] 'tuareg-mark-phrase) - (define-key map "\C-c`" 'tuareg-interactive-next-error-source) - (define-key map "\C-c?" 'tuareg-interactive-next-error-source) - (define-key map "\C-c.c" 'tuareg-insert-class-form) - (define-key map "\C-c.b" 'tuareg-insert-begin-form) - (define-key map "\C-c.f" 'tuareg-insert-for-form) - (define-key map "\C-c.w" 'tuareg-insert-while-form) - (define-key map "\C-c.i" 'tuareg-insert-if-form) - (define-key map "\C-c.l" 'tuareg-insert-let-form) - (define-key map "\C-c.m" 'tuareg-insert-match-form) - (define-key map "\C-c.t" 'tuareg-insert-try-form) - (when tuareg-with-caml-mode-p - ;; Trigger caml-types - (define-key map [?\C-c ?\C-t] 'caml-types-show-type) - ;; To prevent misbehavior in case of error during exploration. - (define-key map [(control mouse-2)] 'caml-types-mouse-ignore) - (define-key map [(control down-mouse-2)] 'caml-types-explore) - ;; Trigger caml-help - (define-key map [?\C-c ?i] 'ocaml-add-path) - (define-key map [?\C-c ?\[] 'ocaml-open-module) - (define-key map [?\C-c ?\]] 'ocaml-close-module) - (define-key map [?\C-c ?h] 'caml-help) - (define-key map [?\C-c ?\t] 'caml-complete)) - map) - "Keymap used in Tuareg mode.") - -(defvar tuareg-mode-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?_ "_" st) - (modify-syntax-entry ?? ". p" st) - (modify-syntax-entry ?~ ". p" st) - (modify-syntax-entry ?: "." st) - (modify-syntax-entry ?' "w" st) ; ' is part of words (for primes). - (modify-syntax-entry - ;; ` is punctuation or character delimiter (Caml Light compatibility). - ?` (if tuareg-support-camllight "\"" ".") st) - (modify-syntax-entry ?\" "\"" st) ; " is a string delimiter - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?* ". 23" st) - (condition-case nil - (progn - (modify-syntax-entry ?\( "()1n" st) - (modify-syntax-entry ?\) ")(4n" st)) - (error ;XEmacs signals an error instead of ignoring `n'. - (modify-syntax-entry ?\( "()1" st) - (modify-syntax-entry ?\) ")(4" st))) - st) - "Syntax table in use in Tuareg mode buffers.") - -(defconst tuareg-font-lock-syntax - `((?_ . "w") (?` . ".") - ,@(unless tuareg-use-syntax-ppss - '((?\" . ".") (?\( . ".") (?\) . ".") (?* . ".")))) - "Syntax changes for Font-Lock.") - -(defvar tuareg-mode-abbrev-table () - "Abbrev table used for Tuareg mode buffers.") -(defun tuareg-define-abbrev (keyword) - (define-abbrev tuareg-mode-abbrev-table keyword keyword 'tuareg-abbrev-hook)) -(if tuareg-mode-abbrev-table () - (setq tuareg-mode-abbrev-table (make-abbrev-table)) - (mapcar 'tuareg-define-abbrev - '("module" "class" "functor" "object" "type" "val" "inherit" - "include" "virtual" "constraint" "exception" "external" "open" - "method" "and" "initializer" "to" "downto" "do" "done" "else" - "begin" "end" "let" "in" "then" "with")) - (setq abbrevs-changed nil)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The major mode - -;;;###autoload (add-to-list 'auto-mode-alist '("\\.ml[ily]?\\'" . tuareg-mode)) - -;;;###autoload -(defun tuareg-mode () - "Major mode for editing Caml code. - -Dedicated to Emacs and XEmacs, version 21 and higher. Provides -automatic indentation and compilation interface. Performs font/color -highlighting using Font-Lock. It is designed for Objective Caml but -handles Objective Labl and Caml Light as well. - -Report bugs, remarks and questions to Albert.Cohen@prism.uvsq.fr. - -The Font-Lock minor-mode is used according to your customization -options. Within XEmacs (non-MULE versions only) you may also want to -use Sym-Lock: - -\(if (and (boundp 'window-system) window-system) - (when (string-match \"XEmacs\" emacs-version) - (if (not (and (boundp 'mule-x-win-initted) mule-x-win-initted)) - (require 'sym-lock)) - (require 'font-lock))) - -You have better byte-compile tuareg.el (and sym-lock.el if you use it) -because symbol highlighting is very time consuming. - -For customization purposes, you should use `tuareg-mode-hook' -\(run for every file) or `tuareg-load-hook' (run once) and not patch -the mode itself. You should add to your configuration file something like: - (add-hook 'tuareg-mode-hook - (lambda () - ... ; your customization code - )) -For example you can change the indentation of some keywords, the -`electric' flags, Font-Lock colors... Every customizable variable is -documented, use `C-h-v' or look at the mode's source code. - -A special case is Sym-Lock customization: You may set -`tuareg-sym-lock-keywords' in your `.emacs' configuration file -to override default Sym-Lock patterns. - -`custom-tuareg.el' is a sample customization file for standard changes. -You can append it to your `.emacs' or use it as a tutorial. - -`M-x camldebug' FILE starts the Caml debugger camldebug on the executable -FILE, with input and output in an Emacs buffer named *camldebug-FILE*. - -A Tuareg Interactive Mode to evaluate expressions in a toplevel is included. -Type `M-x tuareg-run-caml' or see special-keys below. - -Some elementary rules have to be followed in order to get the best of -indentation facilities. - - Because the `function' keyword has a special indentation (to handle - case matches) use the `fun' keyword when no case match is performed. - - In OCaml, `;;' is no longer necessary for correct indentation, - except before top level phrases not introduced by `type', `val', `let' - etc. (i.e., phrases used for their side-effects or to be executed - in a top level.) - - Long sequences of `and's may slow down indentation slightly, since - some computations (few) require to go back to the beginning of the - sequence. Some very long nested blocks may also lead to slow - processing of `end's, `else's, `done's... - - Multiline strings are handled properly, but the string concatenation `^' - is preferred to break long strings (the C-j keystroke can help). - -Known bugs: - - When writting a line with mixed code and comments, avoid putting - comments at the beginning or middle of the text. More precisely, - writing comments immediately after `=' or parentheses then writing - some more code on the line leads to indentation errors. You may write - `let x (* blah *) = blah' but should avoid `let x = (* blah *) blah'. - -Special keys for Tuareg mode:\\{tuareg-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'tuareg-mode) - (setq mode-name "Tuareg") - (use-local-map tuareg-mode-map) - (set-syntax-table tuareg-mode-syntax-table) - (setq local-abbrev-table tuareg-mode-abbrev-table) - - (tuareg-build-menu) - - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'require-final-newline) - (setq require-final-newline t) - (make-local-variable 'comment-start) - (setq comment-start "(* ") - (make-local-variable 'comment-end) - (setq comment-end " *)") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "(\\*+[ \t]*") - (make-local-variable 'comment-multi-line) - (setq comment-multi-line t) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'tuareg-indent-command) - (unless tuareg-use-syntax-ppss - (make-local-hook 'before-change-functions) - (add-hook 'before-change-functions 'tuareg-before-change-function nil t)) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'tuareg-auto-fill-function) - - ;; Hooks for tuareg-mode, use them for tuareg-mode configuration - (tuareg-install-font-lock) - (run-hooks 'tuareg-mode-hook) - (if tuareg-use-abbrev-mode (abbrev-mode 1)) - (message - (concat "Major mode for editing and running Caml programs, " - tuareg-mode-version "."))) - -(defun tuareg-install-font-lock (&optional no-sym-lock) - (setq - tuareg-font-lock-keywords - (append - (list - (list "\\<\\(external\\|open\\|include\\|rule\\|s\\(ig\\|truct\\)\\|module\\|functor\\|with[ \t\n]+\\(type\\|module\\)\\|val\\|type\\|method\\|virtual\\|constraint\\|class\\|in\\|inherit\\|initializer\\|let\\|rec\\|and\\|begin\\|object\\|end\\)\\>" - 0 'tuareg-font-lock-governing-face nil nil)) - (if tuareg-support-metaocaml - (list (list "\\.<\\|>\\.\\|\\.~\\|\\.!" - 0 'tuareg-font-lock-multistage-face nil nil)) - ()) - (list - (list "\\<\\(false\\|true\\)\\>" - 0 'font-lock-constant-face nil nil) - (list "\\<\\(as\\|do\\(ne\\|wnto\\)?\\|else\\|for\\|if\\|m\\(atch\\|utable\\)\\|new\\|p\\(arser\\|rivate\\)\\|t\\(hen\\|o\\|ry\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|lazy\\|exception\\|raise\\|failwith\\|exit\\|assert\\|fun\\(ction\\)?\\)\\>" - 0 'font-lock-keyword-face nil nil) - (list "[][;,()|{}]\\|[@^!:*=<>&/%+~?#---]\\.?\\|\\.\\.\\.*\\|\\<\\(asr\\|asl\\|lsr\\|lsl\\|l?or\\|l?and\\|xor\\|not\\|mod\\|of\\|ref\\)\\>" - 0 'tuareg-font-lock-operator-face nil nil) - (list (concat "\\<\\(\\(method\\([ \t\n]+\\(private\\|virtual\\)\\)?\\)\\([ \t\n]+virtual\\)?\\|val\\([ \t\n]+mutable\\)?\\|external\\|and\\|class\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t\n]*\\(['_" tuareg-lower "]\\(\\w\\|[._]\\)*\\)\\>[ \t\n]*\\(\\(\\w\\|[()_?~.'*:--->]\\)+\\|=[ \t\n]*fun\\(ction\\)?\\>\\)") - 8 'font-lock-function-name-face 'keep nil) - (list "\\[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)" - 3 'font-lock-function-name-face 'keep nil) - (list "\\<\\(fun\\(ction\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_ \t()*,]\\)+\\)" - 3 'font-lock-variable-name-face 'keep nil) - (list "\\<\\(val\\([ \t\n]+mutable\\)?\\|external\\|and\\|class\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)" - 4 'font-lock-variable-name-face 'keep nil) - (list "\\<\\(val\\([ \t\n]+mutable\\)?\\|external\\|method\\|and\\|class\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)\\>\\(\\(\\w\\|[->_ \t,?~.]\\|(\\(\\w\\|[--->_ \t,?~.=]\\)*)\\)*\\)" - 6 'font-lock-variable-name-face 'keep nil) - (list "\\<\\(open\\|\\(class\\([ \t\n]+type\\)?\\)\\([ \t\n]+virtual\\)?\\|inherit\\|include\\|module\\([ \t\n]+\\(type\\|rec\\)\\)?\\|type\\)\\>[ \t\n]*\\(['~?]*\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)" - 7 'font-lock-type-face 'keep nil) - (list "[^:>=]:[ \t\n]*\\(['~?]*\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)" - 1 'font-lock-type-face 'keep nil) - (list "\\<\\([A-Z]\\w*\\>\\)[ \t]*\\." - 1 'font-lock-type-face 'keep nil) - (list (concat "\\<\\([?~]?[_" tuareg-alpha "]\\w*\\)[ \t\n]*:[^:>=]") - 1 'font-lock-variable-name-face 'keep nil) - (list (concat "\\[ \t\n]*\\(\\<[_" tuareg-alpha "]\\w*\\>\\)") - 1 'font-lock-variable-name-face 'keep nil) - (list "^#\\w+\\>" - 0 'font-lock-preprocessor-face t nil)) - (if tuareg-font-lock-symbols - (tuareg-font-lock-symbols-keywords) - ()))) - (if (and (not no-sym-lock) - (featurep 'sym-lock)) - (progn - (setq sym-lock-color - (face-foreground 'tuareg-font-lock-operator-face)) - (if (not sym-lock-keywords) - (sym-lock tuareg-sym-lock-keywords)))) - (setq font-lock-defaults - (list* - 'tuareg-font-lock-keywords (not tuareg-use-syntax-ppss) nil - tuareg-font-lock-syntax nil - '(font-lock-syntactic-keywords - . tuareg-font-lock-syntactic-keywords) - '(parse-sexp-lookup-properties - . t) - '(font-lock-syntactic-face-function - . tuareg-font-lock-syntactic-face-function) - (unless tuareg-use-syntax-ppss - '((font-lock-fontify-region-function - . tuareg-fontify-region))))) - (when (and (boundp 'font-lock-fontify-region-function) - (not tuareg-use-syntax-ppss)) - (make-local-variable 'font-lock-fontify-region-function) - (setq font-lock-fontify-region-function 'tuareg-fontify-region))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Error processing - -(require 'compile) - -;; In some versions of Emacs, the regexps in -;; compilation-error-regexp-alist do not match the error messages when -;; the language is not English. Hence we add a regexp. - -(defconst tuareg-error-regexp - "^[^\0-@]+ \"\\([^\"\n]+\\)\", [^\0-@]+ \\([0-9]+\\)[-,:]" - "Regular expression matching the error messages produced by (o)camlc.") - -(if (boundp 'compilation-error-regexp-alist) - (or (assoc tuareg-error-regexp - compilation-error-regexp-alist) - (setq compilation-error-regexp-alist - (cons (list tuareg-error-regexp 1 2) - compilation-error-regexp-alist)))) - -;; A regexp to extract the range info. - -(defconst tuareg-error-chars-regexp - ".*, .*, [^\0-@]+ \\([0-9]+\\)-\\([0-9]+\\):" - "Regexp matching the char numbers in an error message produced by (o)camlc.") - -;; Wrapper around next-error. - -;; itz 04-21-96 instead of defining a new function, use defadvice -;; that way we get our effect even when we do \C-x` in compilation buffer - -(defadvice next-error (after tuareg-next-error activate) - "Read the extra positional information provided by the Caml compiler. - -Puts the point and the mark exactly around the erroneous program -fragment. The erroneous fragment is also temporarily highlighted if -possible." - (if (eq major-mode 'tuareg-mode) - (let ((beg nil) (end nil)) - (save-excursion - (set-buffer compilation-last-buffer) - (save-excursion - (goto-char (window-point (get-buffer-window (current-buffer) t))) - (if (looking-at tuareg-error-chars-regexp) - (setq beg (string-to-number (tuareg-match-string 1)) - end (string-to-number (tuareg-match-string 2)))))) - (beginning-of-line) - (if beg - (progn - (setq beg (+ (point) beg) end (+ (point) end)) - (goto-char beg) (push-mark end t t)))))) - -(defvar tuareg-interactive-error-regexp - (concat "\\(\\(" - "Toplevel input:" - "\\|Entr.e interactive:" - "\\|Characters [0-9-]*:" - "\\|The global value [^ ]* is referenced before being defined." - "\\|La valeur globale [^ ]* est utilis.e avant d'.tre d.finie." - "\\|Reference to undefined global" - "\\|The C primitive \"[^\"]*\" is not available." - "\\|La primitive C \"[^\"]*\" est inconnue." - "\\|Cannot find \\(the compiled interface \\)?file" - "\\|L'interface compil.e [^ ]* est introuvable." - "\\|Le fichier [^ ]* est introuvable." - "\\|Exception non rattrap.e:" - "\\|Uncaught exception:" - "\\)[^#]*\\)" ) - "Regular expression matching the error messages produced by Caml.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Indentation stuff - -(defconst tuareg-keyword-regexp "\\<\\(object\\|initializer\\|and\\|c\\(onstraint\\|lass\\)\\|m\\(atch\\|odule\\|ethod\\|utable\\)\\|s\\(ig\\|truct\\)\\|begin\\|e\\(lse\\|x\\(ception\\|ternal\\)\\)\\|t\\(o\\|hen\\|ry\\|ype\\)\\|v\\(irtual\\|al\\)\\|w\\(h\\(ile\\|en\\)\\|ith\\)\\|i\\(f\\|n\\(herit\\)?\\)\\|f\\(or\\|un\\(ct\\(or\\|ion\\)\\)?\\)\\|let\\|do\\(wnto\\)?\\|parser?\\|rule\\|of\\)\\>\\|->\\|[;,|]" - "Regexp for all recognized keywords.") - -(defconst tuareg-match-|-keyword-regexp - "\\<\\(and\\|fun\\(ction\\)?\\|type\\|with\\|parser?\\)\\>\\|[[({|=]" - "Regexp for keywords supporting case match.") - -(defconst tuareg-operator-regexp "[---+*/=<>@^&|]\\|:>\\|::\\|\\<\\(or\\|l\\(and\\|x?or\\|s[lr]\\)\\|as[lr]\\|mod\\)\\>" - "Regexp for all operators.") - -(defconst tuareg-kwop-regexp (concat tuareg-keyword-regexp "\\|=") - "Regexp for all keywords, and the = operator which is generally -considered as a special keyword.") - -(defconst tuareg-matching-keyword-regexp - "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|then\\|\\(down\\)?to\\)\\>\\|>\\." - "Regexp matching Caml keywords which act as end block delimiters.") - -(defconst tuareg-leading-kwop-regexp - (concat tuareg-matching-keyword-regexp "\\|\\\\|[|>]?\\]\\|>?}\\|[|)]\\|;;") - "Regexp matching Caml keywords which need special indentation.") - -(defconst tuareg-governing-phrase-regexp - "\\<\\(val\\|type\\|m\\(ethod\\|odule\\)\\|c\\(onstraint\\|lass\\)\\|in\\(herit\\|itializer\\)\\|ex\\(ternal\\|ception\\)\\|open\\|let\\|object\\|include\\)\\>" - "Regexp matching tuareg phrase delimitors.") - -(defconst tuareg-governing-phrase-regexp-with-break - (concat tuareg-governing-phrase-regexp "\\|;;")) - -(defconst tuareg-keyword-alist - '(("module" . tuareg-default-indent) - ("class" . tuareg-class-indent) - ("sig" . tuareg-sig-struct-indent) - ("struct" . tuareg-sig-struct-indent) - ("method" . tuareg-method-indent) - ("object" . tuareg-begin-indent) - ("begin" . tuareg-begin-indent) - (".<" . tuareg-begin-indent) - ("for" . tuareg-for-while-indent) - ("while" . tuareg-for-while-indent) - ("do" . tuareg-do-indent) - ("type" . tuareg-type-indent) ; in some cases, `type' acts like a match - ("val" . tuareg-val-indent) - ("fun" . tuareg-fun-indent) - ("if" . tuareg-if-then-else-indent) - ("then" . tuareg-if-then-else-indent) - ("else" . tuareg-if-then-else-indent) - ("let" . tuareg-let-indent) - ("match" . tuareg-match-indent) - ("try" . tuareg-try-indent) - ("rule" . tuareg-rule-indent) - - ;; Case match keywords - ("function" . tuareg-function-indent) - ("with" . tuareg-with-indent) - ("parse" . tuareg-parse-indent) - ("parser" . tuareg-parser-indent) - - ;; Default indentation keywords - ("when" . tuareg-default-indent) - ("functor" . tuareg-default-indent) - ("exception" . tuareg-default-indent) - ("inherit" . tuareg-default-indent) - ("initializer" . tuareg-default-indent) - ("constraint" . tuareg-default-indent) - ("virtual" . tuareg-default-indent) - ("mutable" . tuareg-default-indent) - ("external" . tuareg-default-indent) - ("in" . tuareg-in-indent) - ("of" . tuareg-default-indent) - ("to" . tuareg-default-indent) - ("downto" . tuareg-default-indent) - (".<" . tuareg-default-indent) - ("[" . tuareg-default-indent) - ("(" . tuareg-default-indent) - ("{" . tuareg-default-indent) - ("->" . tuareg-default-indent) - ("|" . tuareg-default-indent)) -"Association list of indentation values based on governing keywords.") - -(defconst tuareg-leading-kwop-alist - '(("|" . tuareg-find-|-match) - ("}" . tuareg-find-match) - (">}" . tuareg-find-match) - (">." . tuareg-find-match) - (")" . tuareg-find-match) - ("]" . tuareg-find-match) - ("|]" . tuareg-find-match) - (">]" . tuareg-find-match) - ("end" . tuareg-find-match) - ("done" . tuareg-find-done-match) - ("in" . tuareg-find-in-match) - ("with" . tuareg-find-with-match) - ("else" . tuareg-find-else-match) - ("then" . tuareg-find-match) - ("do" . tuareg-find-do-match) - ("to" . tuareg-find-match) - ("downto" . tuareg-find-match) - ("and" . tuareg-find-and-match)) - "Association list used in Tuareg mode for skipping back over nested blocks.") - -(defun tuareg-find-meaningful-word () - "Look back for a word, skipping comments and blanks. -Returns the actual text of the word, if found." - (let ((found nil) (kwop nil)) - (while - (and (not found) - (re-search-backward - (concat - "[^ \t\n_0-9" tuareg-alpha "]\\|\\<\\(\\w\\|_\\)+\\>\\|\\*)") - (point-min) t)) - (setq kwop (tuareg-match-string 0)) - (if kwop - (if (tuareg-in-comment-p) - (tuareg-beginning-of-literal-or-comment-fast) - (setq found t)) - (setq found t))) - (if found kwop (goto-char (point-min)) nil))) - -(defconst tuareg-find-kwop-regexp - (concat tuareg-matching-keyword-regexp - "\\|\\<\\(for\\|while\\|do\\|if\\|begin\\|s\\(ig\\|truct\\)\\|object\\)\\>\\|[][(){}]\\|\\*)")) - -(defun tuareg-make-find-kwop-regexp (kwop-regexp) - (concat tuareg-find-kwop-regexp "\\|" kwop-regexp)) - -(defun tuareg-find-kwop (kr &optional do-not-skip-regexp) - "Look back for a Caml keyword or operator matching KWOP-REGEXP. -Skips blocks etc... - -Ignore occurences inside literals and comments. -If found, return the actual text of the keyword or operator." - (let ((found nil) - (kwop nil) - (kwop-regexp (if tuareg-support-metaocaml - (concat kr "\\|\\.<\\|>\\.") kr))) - (while (and (not found) - (re-search-backward kwop-regexp (point-min) t) - (setq kwop (tuareg-match-string 0))) - (cond - ((tuareg-in-literal-or-comment-p) - (tuareg-beginning-of-literal-or-comment-fast)) - ((looking-at "[]})]") - (tuareg-backward-up-list)) - ((tuareg-at-phrase-break-p) - (setq found t)) - ((and do-not-skip-regexp (looking-at do-not-skip-regexp)) - (if (and (string= kwop "|") (char-equal ?| (preceding-char))) - (backward-char) - (setq found t))) - ((looking-at tuareg-matching-keyword-regexp) - (funcall (cdr (assoc (tuareg-match-string 0) - tuareg-leading-kwop-alist)))) - (t (setq found t)))) - (if found kwop (goto-char (point-min)) nil))) - -(defun tuareg-find-match () - (tuareg-find-kwop tuareg-find-kwop-regexp)) - -(defconst tuareg-find-,-match-regexp - (tuareg-make-find-kwop-regexp - "\\<\\(and\\|match\\|begin\\|else\\|exception\\|then\\|try\\|with\\|or\\|fun\\|function\\|let\\|do\\)\\>\\|->\\|[[{(]")) -(defun tuareg-find-,-match () - (tuareg-find-kwop tuareg-find-,-match-regexp)) - -(defconst tuareg-find-with-match-regexp - (tuareg-make-find-kwop-regexp - "\\<\\(match\\|try\\|module\\|begin\\|with\\)\\>\\|[[{(]")) -(defun tuareg-find-with-match () - (let ((kwop (tuareg-find-kwop tuareg-find-with-match-regexp - "\\"))) - (if (string= kwop "with") - (progn - (tuareg-find-with-match) - (tuareg-find-with-match))) - kwop)) - -(defconst tuareg-find-in-match-regexp - (tuareg-make-find-kwop-regexp "\\")) -(defun tuareg-find-in-match () - (let ((kwop (tuareg-find-kwop tuareg-find-in-match-regexp "\\"))) - (cond ((string= kwop "and") (tuareg-find-in-match)) - (t kwop)))) - -(defconst tuareg-find-else-match-regexp - (tuareg-make-find-kwop-regexp ";\\|->\\|\\")) -(defun tuareg-find-else-match () - (let ((kwop (tuareg-find-kwop tuareg-find-else-match-regexp - "->\\|\\<\\(with\\|then\\)\\>"))) - (cond - ((string= kwop "then") - (tuareg-find-match)) - ((string= kwop "with") - (tuareg-find-with-match)) - ((string= kwop "->") - (setq kwop (tuareg-find-->-match)) - (while (string= kwop "|") - (setq kwop (tuareg-find-|-match))) - (if (string= kwop "with") - (tuareg-find-with-match)) - (tuareg-find-else-match)) - ((string= kwop ";") - (tuareg-find-semi-colon-match) - (tuareg-find-else-match))) - kwop)) - -(defun tuareg-find-do-match () - (let ((kwop (tuareg-find-kwop tuareg-find-kwop-regexp - "\\<\\(down\\)?to\\>"))) - (if (or (string= kwop "to") (string= kwop "downto")) - (tuareg-find-match) kwop))) - -(defun tuareg-find-done-match () - (let ((kwop (tuareg-find-kwop tuareg-find-kwop-regexp "\\"))) - (if (string= kwop "do") - (tuareg-find-do-match) kwop))) - -(defconst tuareg-find-and-match-regexp - "\\<\\(do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|then\\|\\(down\\)?to\\)\\>\\|\\<\\(for\\|while\\|do\\|if\\|begin\\|s\\(ig\\|truct\\)\\|class\\)\\>\\|[][(){}]\\|\\*)\\|\\<\\(rule\\|exception\\|let\\|in\\|type\\|val\\|module\\)\\>") -(defconst tuareg-find-and-match-regexp-dnr - (concat tuareg-find-and-match-regexp "\\|\\")) -(defun tuareg-find-and-match (&optional do-not-recurse) - (let* ((kwop (tuareg-find-kwop (if do-not-recurse - tuareg-find-and-match-regexp-dnr - tuareg-find-and-match-regexp) - "\\")) - (old-point (point))) - (cond ((or (string= kwop "type") (string= kwop "module")) - (let ((kwop2 (tuareg-find-meaningful-word))) - (cond ((string= kwop2 "with") - kwop2) - ((string= kwop2 "and") - (tuareg-find-and-match)) - ((and (string= kwop "module") - (string= kwop2 "let")) - kwop2) - (t (goto-char old-point) kwop)))) - (t kwop)))) - -(defconst tuareg-find-=-match-regexp - (tuareg-make-find-kwop-regexp "\\<\\(val\\|let\\|m\\(ethod\\|odule\\)\\|type\\|class\\|when\\|i[fn]\\)\\>\\|=")) -(defun tuareg-find-=-match () - (let ((kwop (tuareg-find-kwop tuareg-find-=-match-regexp - "\\<\\(and\\|in\\)\\>\\|="))) - (cond - ((string= kwop "and") - (tuareg-find-and-match)) - ((and (string= kwop "=") - (not (tuareg-false-=-p))) - (while (and (string= kwop "=") - (not (tuareg-false-=-p))) - (setq kwop (tuareg-find-=-match))) - kwop) - (t kwop)))) - -(defun tuareg-if-when-= () - (save-excursion - (tuareg-find-=-match) - (looking-at "\\<\\(if\\|when\\)\\>"))) - -(defun tuareg-captive-= () - (save-excursion - (tuareg-find-=-match) - (looking-at "\\<\\(let\\|if\\|when\\|module\\|type\\|class\\)\\>"))) - -(defconst tuareg-find-|-match-regexp - (tuareg-make-find-kwop-regexp - "\\<\\(with\\|fun\\(ction\\)?\\|type\\|parser?\\)\\>\\|[=|]")) -(defun tuareg-find-|-match () - (let* ((kwop (tuareg-find-kwop tuareg-find-|-match-regexp - "\\<\\(and\\|with\\)\\>\\||")) - (old-point (point))) - (cond ((string= kwop "and") - (setq old-point (point)) - (setq kwop (tuareg-find-and-match)) - (goto-char old-point) - kwop) - ((and (string= kwop "|") - (looking-at "|[^|]") - (tuareg-in-indentation-p)) - kwop) - ((string= kwop "|") (tuareg-find-|-match)) - ((and (string= kwop "=") - (or (looking-at "=[ \t]*\\((\\*\\|$\\)") - (tuareg-false-=-p) - (not (string= (save-excursion (tuareg-find-=-match)) - "type")))) - (tuareg-find-|-match)) - ((string= kwop "parse") - (if (and (string-match "\\.mll" (buffer-name)) - (save-excursion - (string= (tuareg-find-meaningful-word) "="))) - kwop (tuareg-find-|-match))) - (t kwop)))) - -(defconst tuareg-find-->-match-regexp - (tuareg-make-find-kwop-regexp "\\<\\(external\\|val\\|method\\|let\\|with\\|fun\\(ction\\|ctor\\)?\\|parser\\)\\>\\|[|:;]")) -(defun tuareg-find-->-match () - (let ((kwop (tuareg-find-kwop tuareg-find-->-match-regexp "\\"))) - (cond - ((string= kwop "|") - (if (tuareg-in-indentation-p) - kwop - (progn (forward-char -1) (tuareg-find-->-match)))) - ((not (string= kwop ":")) kwop) - ;; If we get this far, we know we're looking at a colon. - ((or (char-equal (char-before) ?:) - (char-equal (char-after (1+ (point))) ?:) - (char-equal (char-after (1+ (point))) ?>)) - (tuareg-find-->-match)) - ;; Patch by T. Freeman - (t (let ((oldpoint (point)) - (match (tuareg-find-->-match))) - (if (looking-at ":") - match - (progn - ;; Go back to where we were before the recursive call. - (goto-char oldpoint) - kwop))))))) - -(defconst tuareg-find-semi-colon-match-regexp - (tuareg-make-find-kwop-regexp ";[ \t]*\\((\\*\\|$\\)\\|->\\|\\<\\(let\\|method\\|with\\|try\\|initializer\\)\\>")) -(defun tuareg-find-semi-colon-match (&optional leading-semi-colon) - (tuareg-find-kwop tuareg-find-semi-colon-match-regexp - "\\<\\(in\\|end\\|and\\|do\\|with\\)\\>") - ;; We don't need to find the keyword matching `and' since we know it's `let'! - (cond - ((looking-at ";[ \t]*\\((\\*\\|$\\)") - (forward-line 1) - (while (or (tuareg-in-comment-p) - (looking-at "^[ \t]*\\((\\*\\|$\\)")) - (forward-line 1)) - (back-to-indentation) - (current-column)) - ((and leading-semi-colon - (looking-at "\\((\\|\\[[<|]?\\|{[ \t]*\\((\\*\\|$\\)") - (tuareg-back-to-paren-or-indentation) - (+ (current-column) tuareg-method-indent)) - ((looking-at "\\[ \t]*\\((\\*\\|$\\)") - (tuareg-back-to-paren-or-indentation t) - (+ (current-column) tuareg-begin-indent)) - ((looking-at "->") - (if (save-excursion - (tuareg-find-->-match) - (looking-at "\\<\\(with\\|fun\\(ction\\)?\\|parser\\)\\>\\||")) - (progn - (tuareg-back-to-paren-or-indentation) - (+ (current-column) tuareg-default-indent)) - (tuareg-find-semi-colon-match))) - ((looking-at "\\") - (tuareg-find-match) - (tuareg-find-semi-colon-match)) - ((looking-at "\\") - (tuareg-find-in-match) - (tuareg-back-to-paren-or-indentation) - (+ (current-column) tuareg-in-indent)) - ((looking-at "\\") - (+ (current-column) tuareg-let-indent)) - (t (tuareg-back-to-paren-or-indentation t) - (+ (current-column) tuareg-default-indent)))) - -(defconst tuareg-find-phrase-indentation-regexp - (tuareg-make-find-kwop-regexp (concat tuareg-governing-phrase-regexp - "\\|\\"))) -(defconst tuareg-find-phrase-indentation-regexp-pb - (concat tuareg-find-phrase-indentation-regexp "\\|;;")) -(defconst tuareg-find-phrase-indentation-class-regexp - (concat tuareg-matching-keyword-regexp "\\|\\")) -(defun tuareg-find-phrase-indentation (&optional phrase-break) - (if (and (looking-at "\\<\\(type\\|module\\)\\>") (> (point) (point-min)) - (save-excursion - (tuareg-find-meaningful-word) - (looking-at "\\<\\(module\\|with\\|and\\|let\\)\\>"))) - (progn - (tuareg-find-meaningful-word) - (+ (current-column) tuareg-default-indent)) - (let ((looking-at-and (looking-at "\\")) - (kwop (tuareg-find-kwop - (if phrase-break - tuareg-find-phrase-indentation-regexp-pb - tuareg-find-phrase-indentation-regexp) - "\\<\\(end\\|and\\|with\\|in\\)\\>")) - (tmpkwop nil) (curr nil)) - (if (and kwop (string= kwop "and")) - (setq kwop (tuareg-find-and-match))) - (if (not kwop) (current-column) - (cond - ((string= kwop "end") - (if (not (save-excursion - (setq tmpkwop (tuareg-find-match)) - (setq curr (point)) - (string= tmpkwop "object"))) - (progn - (tuareg-find-match) - (tuareg-find-phrase-indentation phrase-break)) - (tuareg-find-kwop tuareg-find-phrase-indentation-class-regexp) - (current-column))) - ((and (string= kwop "with") - (not (save-excursion - (setq tmpkwop (tuareg-find-with-match)) - (setq curr (point)) - (string= tmpkwop "module")))) - (goto-char curr) - (tuareg-find-phrase-indentation phrase-break)) - ((and (string= kwop "in") - (not (save-excursion - (setq tmpkwop (tuareg-find-in-match)) - (if (string= tmpkwop "and") - (setq tmpkwop (tuareg-find-and-match))) - (setq curr (point)) - (and (string= tmpkwop "let") - (not (tuareg-looking-at-expression-let)))))) - (goto-char curr) - (tuareg-find-phrase-indentation phrase-break)) - ((tuareg-at-phrase-break-p) - (end-of-line) - (tuareg-skip-blank-and-comments) - (current-column)) - ((string= kwop "let") - (if (tuareg-looking-at-expression-let) - (tuareg-find-phrase-indentation phrase-break) - (current-column))) - ((string= kwop "with") - (current-column)) - ((string= kwop "end") - (current-column)) - ((string= kwop "in") - (tuareg-find-in-match) - (current-column)) - ((string= kwop "class") - (tuareg-back-to-paren-or-indentation) - (current-column)) - ((looking-at "\\<\\(object\\|s\\(ig\\|truct\\)\\)\\>") - (tuareg-back-to-paren-or-indentation t) - (+ (tuareg-assoc-indent kwop) (current-column))) - ((or (string= kwop "type") (string= kwop "module")) - (if (or (tuareg-looking-at-false-type) - (tuareg-looking-at-false-module)) - (if looking-at-and (current-column) - (tuareg-find-meaningful-word) - (if (looking-at "\\") - (progn - (tuareg-find-and-match) - (tuareg-find-phrase-indentation phrase-break)) - (tuareg-find-phrase-indentation phrase-break))) - (current-column))) - ((looking-at - "\\(\\.<\\|(\\|\\[[<|]?\\|{\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)") -(defconst tuareg-back-to-paren-or-indentation-in-regexp - (concat "\\\\|" tuareg-back-to-paren-or-indentation-regexp)) -(defconst tuareg-back-to-paren-or-indentation-lazy-regexp - "[])}]\\|\\.<\\|>\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)") -(defconst tuareg-back-to-paren-or-indentation-lazy-in-regexp - (concat "\\\\|" tuareg-back-to-paren-or-indentation-regexp)) -(defun tuareg-back-to-paren-or-indentation (&optional forward-in) - "Search backwards for the first open paren in line, or skip to indentation. -Returns t iff skipped to indentation." - (if (or (bolp) (tuareg-in-indentation-p)) (progn (back-to-indentation) t) - (let ((kwop (tuareg-find-kwop - (if tuareg-lazy-paren - (if forward-in - tuareg-back-to-paren-or-indentation-lazy-in-regexp - tuareg-back-to-paren-or-indentation-lazy-regexp) - (if forward-in - tuareg-back-to-paren-or-indentation-in-regexp - tuareg-back-to-paren-or-indentation-regexp)) - "\\")) - (retval)) - (if (string= kwop "with") - (let ((with-point (point))) - (setq kwop (tuareg-find-with-match)) - (if (or (string= kwop "match") (string= kwop "try")) - (tuareg-find-kwop - tuareg-back-to-paren-or-indentation-regexp - "\\") - (setq kwop "with") (goto-char with-point)))) - (setq retval - (cond - ((string= kwop "with") nil) - ((string= kwop "in") (tuareg-in-indentation-p)) - ((looking-at "[[{(]") (tuareg-search-forward-paren) nil) - ((looking-at "\\.<") - (if tuareg-support-metaocaml - (progn - (tuareg-search-forward-paren) nil) - (tuareg-back-to-paren-or-indentation forward-in))) - (t (back-to-indentation) t))) - (cond - ((looking-at "|[^|]") - (re-search-forward "|[^|][ \t]*") nil) - ((and forward-in (string= kwop "in")) - (tuareg-find-in-match) - (tuareg-back-to-paren-or-indentation forward-in) - (if (looking-at "\\<\\(let\\|and\\)\\>") - (forward-char tuareg-in-indent)) nil) - (t retval))))) - -(defun tuareg-search-forward-paren () - (if tuareg-lazy-paren (tuareg-back-to-paren-or-indentation) - (re-search-forward "\\(\\.<\\|(\\|\\[[<|]?\\|{") - (not (looking-at "->[ \t]*\\((\\*.*\\)?$"))) - (let* (matching-kwop matching-pos) - (save-excursion - (setq matching-kwop (tuareg-find-->-match)) - (setq matching-pos (point))) - (cond - ((string= matching-kwop ":") - (goto-char matching-pos) - (tuareg-find-->-match) ; matching `val' or `let' - (+ (current-column) tuareg-val-indent)) - ((string= matching-kwop "|") - (goto-char matching-pos) - (+ (tuareg-add-default-indent leading-operator) - (current-column) tuareg-|-extra-unindent tuareg-default-indent)) - (t - (tuareg-back-to-paren-or-indentation) - (+ (tuareg-add-default-indent leading-operator) (current-column)))))) - ((string= kwop "fun") - (tuareg-back-to-paren-or-indentation t) - (+ (current-column) - (tuareg-assoc-indent kwop))) - ((<= old-point (point)) - (+ (tuareg-add-default-indent leading-operator) (current-column))) - (t - (forward-line 1) - (beginning-of-line) - (while (or (tuareg-in-comment-p) (looking-at "^[ \t]*\\((\\*.*\\)?$")) - (forward-line 1)) - (tuareg-back-to-paren-or-indentation) - (if (save-excursion (goto-char match-end-point) - (looking-at "[ \t]*\\((\\*.*\\)?$")) - (+ (tuareg-add-default-indent leading-operator) - (current-column)) - (current-column)))))) - -(defun tuareg-indent-from-paren (&optional leading-operator) - (if (looking-at - "\\(\\.<\\|(\\|\\[[<|]?\\|{") - (let ((keyword-->-match (save-excursion (tuareg-find-->-match)))) - (cond ((string= keyword-->-match "|") - (tuareg-find-->-match) - (re-search-forward "|[ \t]*") - (+ (current-column) tuareg-default-indent)) - ((string= keyword-->-match ":") - (tuareg-find-->-match) ; slow, better to save the column - (tuareg-find-->-match) ; matching `val' or `let' - (+ (current-column) tuareg-val-indent)) - (t (tuareg-back-to-paren-or-indentation) - (+ tuareg-default-indent (current-column)))))) - ((looking-at tuareg-keyword-regexp) - (cond ((string= kwop ";") - (if (looking-at ";[ \t]*\\((\\*\\|$\\)") - (tuareg-find-semi-colon-match) - (tuareg-back-to-paren-or-indentation t) - (+ (current-column) tuareg-default-indent))) - ((string= kwop ",") - (if (looking-at ",[ \t]*\\((\\*\\|$\\)") - (progn - (setq kwop (tuareg-find-,-match)) - (if (or (looking-at "[[{(]\\|\\.<") - (and (looking-at "[<|]") - (char-equal ?\[ (preceding-char)) - (progn (tuareg-backward-char) t)) - (and (looking-at "<") - (char-equal ?\{ (preceding-char)) - (progn (tuareg-backward-char) t))) - (tuareg-indent-from-paren t) - (tuareg-back-to-paren-or-indentation t) - (+ (current-column) - (tuareg-assoc-indent kwop)))) - (tuareg-back-to-paren-or-indentation t) - (+ (current-column) tuareg-default-indent))) - ((and (looking-at "\\<\\(in\\|begin\\|do\\)\\>\\|->") - (not (looking-at - "\\([a-z]+\\|->\\)[ \t]*\\((\\*\\|$\\)"))) - (if (string= kwop "in") - (re-search-forward "\\[ \t]*") - (tuareg-back-to-paren-or-indentation t)) - (+ (current-column) - (tuareg-add-default-indent leading-operator) - (if (string= kwop "in") 0 ; aligned, do not indent - (tuareg-assoc-indent kwop)))) - ((string= kwop "with") - (if (save-excursion - (let ((tmpkwop (tuareg-find-with-match))) - (or (string= tmpkwop "module") - (string= tmpkwop "{")))) - (progn - (tuareg-back-to-paren-or-indentation) - (+ (current-column) tuareg-default-indent)) - (tuareg-back-to-paren-or-indentation) - (+ (current-column) - (tuareg-assoc-indent kwop t)))) - ((string= kwop "in") - (tuareg-find-in-match) - (tuareg-back-to-paren-or-indentation) - (+ (current-column) tuareg-in-indent)) - ((or (string= kwop "let") (string= kwop "and")) - (tuareg-back-to-paren-or-indentation t) - (+ (current-column) - tuareg-default-indent - (tuareg-assoc-indent kwop t))) - (t (tuareg-back-to-paren-or-indentation t) - (+ (current-column) - (tuareg-assoc-indent kwop t))))) - ((and (looking-at "=") (not (tuareg-false-=-p))) - (let ((current-column-module-type nil)) - (+ - (progn - (tuareg-find-=-match) - (save-excursion - (if (looking-at "\\") (tuareg-find-and-match)) - (cond - ((looking-at "\\") - (tuareg-find-meaningful-word) - (if (looking-at "\\") - (progn - (setq current-column-module-type (current-column)) - tuareg-default-indent) - (if (looking-at "\\<\\(with\\|and\\)\\>") - (progn - (tuareg-find-with-match) - (setq current-column-module-type (current-column)) - tuareg-default-indent) - (re-search-forward "\\") - (beginning-of-line) - (+ tuareg-type-indent - tuareg-|-extra-unindent)))) - ((looking-at - "\\<\\(val\\|let\\|m\\(ethod\\|odule\\)\\|class\\|when\\|\\|for\\|if\\)\\>") - (let ((matched-string (tuareg-match-string 0))) - (tuareg-back-to-paren-or-indentation t) - (setq current-column-module-type (current-column)) - (tuareg-assoc-indent matched-string))) - ((looking-at "\\") - (tuareg-back-to-paren-or-indentation t) - (setq current-column-module-type (current-column)) - (+ (tuareg-assoc-indent "object") - tuareg-default-indent)) - (t (tuareg-back-to-paren-or-indentation t) - (setq current-column-module-type - (+ (current-column) tuareg-default-indent)) - tuareg-default-indent)))) - (if current-column-module-type - current-column-module-type - (current-column))))) - (nil 0) - (t (tuareg-compute-argument-indent leading-operator)))))))) - -(defun tuareg-looking-at-expression-let () - (save-excursion - (tuareg-find-meaningful-word) - (and (not (tuareg-at-phrase-break-p)) - (not (and tuareg-support-metaocaml - (looking-at "\\.") - (char-equal ?> (preceding-char)))) - (or (looking-at "[[({;=]\\|\\<\\(begin\\|i[fn]\\|do\\|t\\(ry\\|hen\\)\\|else\\|match\\|wh\\(ile\\|en\\)\\)\\>") - (looking-at tuareg-operator-regexp))))) - -(defun tuareg-looking-at-false-module () - (save-excursion (tuareg-find-meaningful-word) - (looking-at "\\<\\(let\\|with\\|and\\)\\>"))) - -(defun tuareg-looking-at-false-sig-struct () - (save-excursion (tuareg-find-module) - (looking-at "\\"))) - -(defun tuareg-looking-at-false-type () - (save-excursion (tuareg-find-meaningful-word) - (looking-at "\\<\\(class\\|with\\|module\\|and\\)\\>"))) - -(defun tuareg-looking-at-in-let () - (save-excursion (string= (tuareg-find-meaningful-word) "in"))) - -(defconst tuareg-find-module-regexp - (tuareg-make-find-kwop-regexp "\\")) -(defun tuareg-find-module () - (tuareg-find-kwop tuareg-find-module-regexp)) - -(defun tuareg-modify-syntax () - "Switch to modified internal syntax." - (modify-syntax-entry ?. "w" tuareg-mode-syntax-table) - (modify-syntax-entry ?_ "w" tuareg-mode-syntax-table)) - -(defun tuareg-restore-syntax () - "Switch back to interactive syntax." - (modify-syntax-entry ?. "." tuareg-mode-syntax-table) - (modify-syntax-entry ?_ "_" tuareg-mode-syntax-table)) - -(defun tuareg-indent-command (&optional from-leading-star) - "Indent the current line in Tuareg mode. - -Compute new indentation based on Caml syntax." - (interactive "*") - (if (not from-leading-star) - (tuareg-auto-fill-insert-leading-star)) - (let ((case-fold-search nil)) - (tuareg-modify-syntax) - (save-excursion - (back-to-indentation) - (indent-line-to (tuareg-compute-indent))) - (if (tuareg-in-indentation-p) (back-to-indentation)) - (tuareg-restore-syntax))) - -(defun tuareg-compute-indent () - (save-excursion - (cond - ((tuareg-in-comment-p) - (cond - ((looking-at "(\\*") - (if tuareg-indent-leading-comments - (save-excursion - (while (and (progn (beginning-of-line) - (> (point) 1)) - (progn (forward-line -1) - (back-to-indentation) - (tuareg-in-comment-p)))) - (if (looking-at "[ \t]*$") - (progn - (tuareg-skip-blank-and-comments) - (if (or (looking-at "$") (tuareg-in-comment-p)) - 0 - (tuareg-compute-indent))) - (forward-line 1) - (tuareg-compute-normal-indent))) - (current-column))) - ((looking-at "\\*\\**)") - (tuareg-beginning-of-literal-or-comment-fast) - (if (tuareg-leading-star-p) - (+ (current-column) - (if (save-excursion - (forward-line 1) - (back-to-indentation) - (looking-at "*")) 1 - tuareg-comment-end-extra-indent)) - (+ (current-column) tuareg-comment-end-extra-indent))) - (tuareg-indent-comments - (let ((star (and (tuareg-leading-star-p) - (looking-at "\\*")))) - (tuareg-beginning-of-literal-or-comment-fast) - (if star (re-search-forward "(") (re-search-forward "(\\*+[ \t]*")) - (current-column))) - (t (current-column)))) - ((tuareg-in-literal-p) - (current-column)) - ((looking-at "\\") - (if (tuareg-looking-at-expression-let) - (if (tuareg-looking-at-in-let) - (progn - (tuareg-find-meaningful-word) - (tuareg-find-in-match) - (tuareg-back-to-paren-or-indentation) - (current-column)) - (tuareg-compute-normal-indent)) - (tuareg-find-phrase-indentation))) - ((looking-at tuareg-governing-phrase-regexp-with-break) - (tuareg-find-phrase-indentation)) - ((and tuareg-sig-struct-align (looking-at "\\<\\(sig\\|struct\\)\\>")) - (if (string= (tuareg-find-module) "module") (current-column) - (tuareg-back-to-paren-or-indentation) - (+ tuareg-default-indent (current-column)))) - ((looking-at ";") (tuareg-find-semi-colon-match t)) - ((or (looking-at "%\\|;;") - (and tuareg-support-camllight (looking-at "#")) - (looking-at "#\\<\\(open\\|load\\|use\\)\\>")) 0) - ((or (looking-at tuareg-leading-kwop-regexp) - (and tuareg-support-metaocaml - (looking-at ">\\."))) - (let ((kwop (tuareg-match-string 0))) - (let* ((old-point (point)) - (paren-match-p (looking-at "[|>]?[]})]\\|>\\.")) - (need-not-back-kwop (string= kwop "and")) - (real-| (looking-at "|\\([^|]\\|$\\)")) - (matching-kwop - (if (string= kwop "and") - (tuareg-find-and-match t) - (funcall (cdr (assoc kwop tuareg-leading-kwop-alist))))) - (match-|-keyword-p - (and matching-kwop - (looking-at tuareg-match-|-keyword-regexp)))) - (cond - ((and (string= kwop "|") real-|) - (cond - ((string= matching-kwop "|") - (if (not need-not-back-kwop) - (tuareg-back-to-paren-or-indentation)) - (current-column)) - ((and (string= matching-kwop "=") - (not (tuareg-false-=-p))) - (re-search-forward "=[ \t]*") - (current-column)) - (match-|-keyword-p - (if (not need-not-back-kwop) - (tuareg-back-to-paren-or-indentation)) - (- (+ (tuareg-assoc-indent - matching-kwop t) - (current-column)) - (if (string= matching-kwop "type") 0 - tuareg-|-extra-unindent))) - (t (goto-char old-point) - (tuareg-compute-normal-indent)))) - ((and (string= kwop "|") (not real-|)) - (goto-char old-point) - (tuareg-compute-normal-indent)) - ((and - (looking-at "\\(\\[|?\\|{ operator at beginning of line. -Also, if the matching { is followed by a < and this } is not preceded -by >, insert one >." - (interactive "*") - (let* ((prec (preceding-char)) - (look-bra (and tuareg-electric-close-vector - (not (tuareg-in-literal-or-comment-p)) - (not (char-equal ?> prec)))) - (electric (and tuareg-electric-indent - (or (tuareg-in-indentation-p) - (and (char-equal ?> prec) - (save-excursion (tuareg-backward-char) - (tuareg-in-indentation-p)))) - (not (tuareg-in-literal-or-comment-p))))) - (self-insert-command 1) - (if look-bra - (save-excursion - (let ((inserted-char - (save-excursion - (tuareg-backward-char) - (tuareg-backward-up-list) - (cond ((looking-at "{<") ">") - (t ""))))) - (tuareg-backward-char) - (insert inserted-char)))) - (if electric (indent-according-to-mode)))) - -(defun tuareg-electric-rb () - "If inserting a ] operator at beginning of line, reindent the line. - -Reindent also if ] is inserted after a | operator at beginning of line. -Also, if the matching [ is followed by a | and this ] is not preceded -by |, insert one |." - (interactive "*") - (let* ((prec (preceding-char)) - (look-|-or-bra (and tuareg-electric-close-vector - (not (tuareg-in-literal-or-comment-p)) - (not (and (char-equal ?| prec) - (not (char-equal - (save-excursion - (tuareg-backward-char) - (preceding-char)) ?\[)))))) - (electric (and tuareg-electric-indent - (or (tuareg-in-indentation-p) - (and (char-equal ?| prec) - (save-excursion (tuareg-backward-char) - (tuareg-in-indentation-p)))) - (not (tuareg-in-literal-or-comment-p))))) - (self-insert-command 1) - (if look-|-or-bra - (save-excursion - (let ((inserted-char - (save-excursion - (tuareg-backward-char) - (tuareg-backward-up-list) - (cond ((looking-at "\\[|") "|") - (t ""))))) - (tuareg-backward-char) - (insert inserted-char)))) - (if electric (indent-according-to-mode)))) - -(defun tuareg-abbrev-hook () - "If inserting a leading keyword at beginning of line, reindent the line." - (if (not (tuareg-in-literal-or-comment-p)) - (let* ((bol (save-excursion (beginning-of-line) (point))) - (kw (save-excursion - (and (re-search-backward "^[ \t]*\\(\\w\\|_\\)+\\=" bol t) - (tuareg-match-string 1))))) - (if kw (progn - (insert " ") - (indent-according-to-mode) - (backward-delete-char-untabify 1)))))) - -(defun tuareg-skip-to-end-of-phrase () - (let ((old-point (point))) - (if (and (string= (tuareg-find-meaningful-word) ";") - (char-equal (preceding-char) ?\;)) - (setq old-point (1- (point)))) - (goto-char old-point) - (let ((kwop (tuareg-find-meaningful-word))) - (goto-char (+ (point) (length kwop)))))) - -(defun tuareg-skip-blank-and-comments () - (skip-chars-forward " \t\n") - (while (and (not (eobp)) (tuareg-in-comment-p) - (search-forward "*)" nil t)) - (skip-chars-forward " \t\n"))) - -(defun tuareg-skip-back-blank-and-comments () - (skip-chars-backward " \t\n") - (while (save-excursion (tuareg-backward-char) - (and (> (point) (point-min)) (tuareg-in-comment-p))) - (tuareg-backward-char) - (tuareg-beginning-of-literal-or-comment) (skip-chars-backward " \t\n"))) - -(defconst tuareg-beginning-phrase-regexp - "^#[ \t]*[a-z][_a-z]*\\>\\|\\<\\(end\\|type\\|module\\|sig\\|struct\\|class\\|exception\\|open\\|let\\)\\>\\|;;" - "Regexp matching tuareg phrase delimitors.") -(defun tuareg-find-phrase-beginning () - "Find `real' phrase beginning and return point." - (beginning-of-line) - (tuareg-skip-blank-and-comments) - (end-of-line) - (tuareg-skip-to-end-of-phrase) - (let ((old-point (point))) - (tuareg-find-kwop tuareg-beginning-phrase-regexp) - (while (and (> (point) (point-min)) (< (point) old-point) - (or (not (looking-at tuareg-beginning-phrase-regexp)) - (and (looking-at "\\") - (tuareg-looking-at-expression-let)) - (and (looking-at "\\") - (tuareg-looking-at-false-module)) - (and (looking-at "\\<\\(sig\\|struct\\)\\>") - (tuareg-looking-at-false-sig-struct)) - (and (looking-at "\\") - (tuareg-looking-at-false-type)))) - (if (looking-at "\\") - (tuareg-find-match) - (if (not (bolp)) (tuareg-backward-char)) - (setq old-point (point)) - (tuareg-find-kwop tuareg-beginning-phrase-regexp))) - (if (tuareg-at-phrase-break-p) - (progn (end-of-line) (tuareg-skip-blank-and-comments))) - (back-to-indentation) - (point))) - -(defun tuareg-search-forward-end-iter (begin current) - (let ((found) (move t)) - (while (and move (> (point) current)) - (if (re-search-forward "\\" (point-max) t) - (when (not (tuareg-in-literal-or-comment-p)) - (let ((kwop) (iter)) - (save-excursion - (tuareg-backward-char 3) - (setq kwop (tuareg-find-match)) - (cond - ((looking-at "\\<\\(object\\)\\>") - (tuareg-find-phrase-beginning)) - ((and (looking-at "\\<\\(struct\\|sig\\)\\>") - (tuareg-looking-at-false-sig-struct)) - (tuareg-find-phrase-beginning))) - (if (> (point) begin) - (setq iter t))) - (cond - ((or iter - (and - (string= kwop "sig") - (looking-at "[ \t\n]*\\(\\[ \t\n]*\\\\|=\\)"))) - (if (> (point) current) - (setq current (point)) - (setq found nil move nil))) - (t (setq found t move nil))))) - (setq found nil move nil))) - found)) - -(defun tuareg-search-forward-end () - (tuareg-search-forward-end-iter (point) -1)) - -(defconst tuareg-inside-block-opening "\\<\\(struct\\|sig\\|object\\)\\>") -(defconst tuareg-inside-block-opening-full - (concat tuareg-inside-block-opening "\\|\\<\\(module\\|class\\)\\>")) -(defconst tuareg-inside-block-regexp - (concat tuareg-matching-keyword-regexp "\\|" tuareg-inside-block-opening)) -(defun tuareg-inside-block-find-kwop () - (let ((kwop (tuareg-find-kwop tuareg-inside-block-regexp - "\\<\\(and\\|end\\)\\>"))) - (if (string= kwop "and") (setq kwop (tuareg-find-and-match))) - (if (string= kwop "with") (setq kwop nil)) - (if (string= kwop "end") - (progn - (tuareg-find-match) - (tuareg-find-kwop tuareg-inside-block-regexp) - (tuareg-inside-block-find-kwop)) - kwop))) - -(defun tuareg-inside-block-p () - (if (tuareg-in-literal-or-comment-p) - (tuareg-beginning-of-literal-or-comment)) - (let ((begin) (end) (and-end) (and-iter t) (kwop t)) - (save-excursion - (if (looking-at "\\") - (tuareg-find-and-match)) - (setq begin (point)) - (if (or (and (looking-at "\\") - (save-excursion - (re-search-forward "\\" - (point-max) t) - (while (tuareg-in-literal-or-comment-p) - (re-search-forward "\\" - (point-max) t)) - (tuareg-find-phrase-beginning) - (> (point) begin))) - (and (looking-at "\\") - (save-excursion - (re-search-forward "\\<\\(sig\\|struct\\)\\>" - (point-max) t) - (while (tuareg-in-literal-or-comment-p) - (re-search-forward "\\<\\(sig\\|struct\\)\\>" - (point-max) t)) - (tuareg-find-phrase-beginning) - (> (point) begin)))) () - (if (not (looking-at tuareg-inside-block-opening-full)) - (setq kwop (tuareg-inside-block-find-kwop))) - (if (not kwop) () - (setq begin (point)) - (if (not (tuareg-search-forward-end)) () - (tuareg-backward-char 3) - (if (not (looking-at "\\")) () - (tuareg-forward-char 3) - (setq end (point)) - (setq and-end (point)) - (tuareg-skip-blank-and-comments) - (while (and and-iter (looking-at "\\")) - (setq and-end (point)) - (if (not (tuareg-search-forward-end)) () - (tuareg-backward-char 3) - (if (not (looking-at "\\")) () - (tuareg-forward-char 3) - (setq and-end (point)) - (tuareg-skip-blank-and-comments))) - (if (<= (point) and-end) - (setq and-iter nil))) - (list begin end and-end)))))))) - -(defun tuareg-move-inside-block-opening () - "Go to the beginning of the enclosing module or class. - -Notice that white-lines (or comments) located immediately before a -module/class are considered enclosed in this module/class." - (interactive) - (let* ((old-point (point)) - (kwop (tuareg-inside-block-find-kwop))) - (if (not kwop) - (goto-char old-point)) - (tuareg-find-phrase-beginning))) - -(defun tuareg-discover-phrase (&optional quiet) - (end-of-line) - (let ((end (point)) (case-fold-search nil)) - (tuareg-modify-syntax) - (tuareg-find-phrase-beginning) - (if (> (point) end) (setq end (point))) - (save-excursion - (let ((begin (point)) (cpt 0) (lines-left 0) (stop) - (inside-block (tuareg-inside-block-p)) - (looking-block (looking-at tuareg-inside-block-opening-full))) - (if (and looking-block inside-block) - (progn - (setq begin (nth 0 inside-block)) - (setq end (nth 2 inside-block)) - (goto-char end)) - (if inside-block - (progn - (setq stop (save-excursion (goto-char (nth 1 inside-block)) - (beginning-of-line) (point))) - (if (< stop end) (setq stop (point-max)))) - (setq stop (point-max))) - (save-restriction - (goto-char end) - (while (and (= lines-left 0) - (or (not inside-block) (< (point) stop)) - (<= (save-excursion - (tuareg-find-phrase-beginning)) end)) - (if (not quiet) - (progn - (setq cpt (1+ cpt)) - (if (= 8 cpt) - (message "Looking for enclosing phrase...")))) - (setq end (point)) - (tuareg-skip-to-end-of-phrase) - (beginning-of-line) - (narrow-to-region (point) (point-max)) - (goto-char end) - (setq lines-left (forward-line 1))))) - (if (>= cpt 8) (message "Looking for enclosing phrase... done.")) - (save-excursion (tuareg-skip-blank-and-comments) (setq end (point))) - (tuareg-skip-back-blank-and-comments) - (tuareg-restore-syntax) - (list begin (point) end))))) - -(defun tuareg-mark-phrase () - "Put mark at end of this Caml phrase, point at beginning. -The Caml phrase is the phrase just before the point." - (interactive) - (let ((pair (tuareg-discover-phrase))) - (goto-char (nth 1 pair)) (push-mark (nth 0 pair) t t))) - -(defun tuareg-next-phrase (&optional quiet) - "Skip to the beginning of the next phrase." - (interactive "i") - (goto-char (save-excursion (nth 2 (tuareg-discover-phrase quiet)))) - (if (looking-at "\\") - (tuareg-next-phrase quiet)) - (if (looking-at ";;") - (progn - (forward-char 2) - (tuareg-skip-blank-and-comments)))) - -(defun tuareg-previous-phrase () - "Skip to the beginning of the previous phrase." - (interactive) - (beginning-of-line) - (tuareg-skip-to-end-of-phrase) - (tuareg-discover-phrase)) - -(defun tuareg-indent-phrase () - "Depending of the context: justify and indent a comment, -or indent all lines in the current phrase." - (interactive) - (save-excursion - (back-to-indentation) - (if (tuareg-in-comment-p) - (let* ((cobpoint (save-excursion - (tuareg-beginning-of-literal-or-comment) - (point))) - (begpoint (save-excursion - (while (and (> (point) cobpoint) - (tuareg-in-comment-p) - (not (looking-at "^[ \t]*$"))) - (forward-line -1)) - (max cobpoint (point)))) - (coepoint (save-excursion - (while (tuareg-in-comment-p) - (re-search-forward "\\*)")) - (point))) - (endpoint (save-excursion - (re-search-forward "^[ \t]*$" coepoint 'end) - (beginning-of-line) - (forward-line 1) - (point))) - (leading-star (tuareg-leading-star-p))) - (goto-char begpoint) - (while (and leading-star - (< (point) endpoint) - (not (looking-at "^[ \t]*$"))) - (forward-line 1) - (back-to-indentation) - (if (looking-at "\\*\\**\\([^)]\\|$\\)") - (progn - (delete-char 1) - (setq endpoint (1- endpoint))))) - (goto-char (min (point) endpoint)) - (fill-region begpoint endpoint) - (re-search-forward "\\*)") - (setq endpoint (point)) - (if leading-star - (progn - (goto-char begpoint) - (forward-line 1) - (if (< (point) endpoint) - (tuareg-auto-fill-insert-leading-star t)))) - (indent-region begpoint endpoint nil)) - (let ((pair (tuareg-discover-phrase))) - (indent-region (nth 0 pair) (nth 1 pair) nil))))) - -(defun tuareg-find-alternate-file () - "Switch Implementation/Interface." - (interactive) - (let ((name (buffer-file-name))) - (if (string-match "\\`\\(.*\\)\\.ml\\(i\\)?\\'" name) - (find-file (concat (tuareg-match-string 1 name) - (if (match-beginning 2) ".ml" ".mli")))))) - -(defun tuareg-insert-class-form () - "Insert a nicely formatted class-end form, leaving a mark after end." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "class = object (self)\ninherit as super\nend;;\n") - (end-of-line) - (indent-region old (point) nil) - (indent-according-to-mode) - (push-mark) - (forward-line -2) - (indent-according-to-mode))) - -(defun tuareg-insert-begin-form () - "Insert a nicely formatted begin-end form, leaving a mark after end." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "begin\n\nend\n") - (end-of-line) - (indent-region old (point) nil) - (push-mark) - (forward-line -2) - (indent-according-to-mode))) - -(defun tuareg-insert-for-form () - "Insert a nicely formatted for-to-done form, leaving a mark after done." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "for do\n\ndone\n") - (end-of-line) - (indent-region old (point) nil) - (push-mark) - (forward-line -2) - (indent-according-to-mode) - (beginning-of-line 1) - (backward-char 4))) - -(defun tuareg-insert-while-form () - "Insert a nicely formatted for-to-done form, leaving a mark after done." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "while do\n\ndone\n") - (end-of-line) - (indent-region old (point) nil) - (push-mark) - (forward-line -2) - (indent-according-to-mode) - (beginning-of-line 1) - (backward-char 4))) - -(defun tuareg-insert-if-form () - "Insert a nicely formatted if-then-else form, leaving a mark after else." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "if\n\nthen\n\nelse\n") - (end-of-line) - (indent-region old (point) nil) - (indent-according-to-mode) - (push-mark) - (forward-line -2) - (indent-according-to-mode) - (forward-line -2) - (indent-according-to-mode))) - -(defun tuareg-insert-match-form () - "Insert a nicely formatted math-with form, leaving a mark after with." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "match\n\nwith\n") - (end-of-line) - (indent-region old (point) nil) - (indent-according-to-mode) - (push-mark) - (forward-line -2) - (indent-according-to-mode))) - -(defun tuareg-insert-let-form () - "Insert a nicely formatted let-in form, leaving a mark after in." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "let in\n") - (end-of-line) - (indent-region old (point) nil) - (indent-according-to-mode) - (push-mark) - (beginning-of-line) - (backward-char 4) - (indent-according-to-mode))) - -(defun tuareg-insert-try-form () - "Insert a nicely formatted try-with form, leaving a mark after with." - (interactive "*") - (let ((prec (preceding-char))) - (if (and prec (not (char-equal ?\ (char-syntax prec)))) - (insert " "))) - (let ((old (point))) - (insert "try\n\nwith\n") - (end-of-line) - (indent-region old (point) nil) - (indent-according-to-mode) - (push-mark) - (forward-line -2) - (indent-according-to-mode))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tuareg interactive mode - -;; Augment Tuareg mode with a Caml toplevel. - -(require 'comint) - -(defvar tuareg-interactive-mode-map - (let ((map (copy-keymap comint-mode-map))) - (define-key map "|" 'tuareg-electric) - (define-key map ")" 'tuareg-electric-rp) - (define-key map "}" 'tuareg-electric-rc) - (define-key map "]" 'tuareg-electric-rb) - (define-key map "\C-c\C-i" 'tuareg-interrupt-caml) - (define-key map "\C-c\C-k" 'tuareg-kill-caml) - (define-key map "\C-c`" 'tuareg-interactive-next-error-toplevel) - (define-key map "\C-c?" 'tuareg-interactive-next-error-toplevel) - (define-key map "\C-m" 'tuareg-interactive-send-input) - (define-key map "\C-j" 'tuareg-interactive-send-input-or-indent) - (define-key map "\M-\C-m" 'tuareg-interactive-send-input-end-of-phrase) - (define-key map [kp-enter] 'tuareg-interactive-send-input-end-of-phrase) - map)) - -(defconst tuareg-interactive-buffer-name "*caml-toplevel*") - -(defconst tuareg-interactive-toplevel-error-regexp - "[ \t]*Characters \\([0-9]+\\)-\\([0-9]+\\):" - "Regexp matching the char numbers in ocaml toplevel's error messages.") -(defvar tuareg-interactive-last-phrase-pos-in-source 0) -(defvar tuareg-interactive-last-phrase-pos-in-toplevel 0) - -(defun tuareg-interactive-filter (text) - (when (eq major-mode 'tuareg-interactive-mode) - (save-excursion - (when (>= comint-last-input-end comint-last-input-start) - (if tuareg-interactive-read-only-input - (add-text-properties - comint-last-input-start comint-last-input-end - (list 'read-only t))) - (if (and font-lock-mode tuareg-interactive-input-font-lock) - (progn - (font-lock-fontify-region comint-last-input-start - comint-last-input-end) - (if (featurep 'sym-lock) - (sym-lock-make-symbols-atomic comint-last-input-start - comint-last-input-end)))) - (if tuareg-interactive-output-font-lock - (save-excursion - (goto-char (point-max)) - (re-search-backward comint-prompt-regexp - comint-last-input-end t) - (add-text-properties - comint-last-input-end (point) - '(face tuareg-font-lock-interactive-output-face)))) - (if tuareg-interactive-error-font-lock - (save-excursion - (goto-char comint-last-input-end) - (while (re-search-forward tuareg-interactive-error-regexp () t) - (let ((matchbeg (match-beginning 1)) - (matchend (match-end 1))) - (save-excursion - (goto-char matchbeg) - (put-text-property - matchbeg matchend - 'face 'tuareg-font-lock-interactive-error-face) - (if (looking-at tuareg-interactive-toplevel-error-regexp) - (let ((beg (string-to-number (tuareg-match-string 1))) - (end (string-to-number (tuareg-match-string 2)))) - (put-text-property - (+ comint-last-input-start beg) - (+ comint-last-input-start end) - 'face 'tuareg-font-lock-error-face) - ))))))))))) - -(define-derived-mode tuareg-interactive-mode comint-mode "Tuareg-Interactive" - "Major mode for interacting with a Caml process. -Runs a Caml toplevel as a subprocess of Emacs, with I/O through an -Emacs buffer. A history of input phrases is maintained. Phrases can -be sent from another buffer in Caml mode. - -Special keys for Tuareg interactive mode:\\{tuareg-interactive-mode-map}" - (tuareg-install-font-lock t) - (if (or tuareg-interactive-input-font-lock - tuareg-interactive-output-font-lock - tuareg-interactive-error-font-lock) - (font-lock-mode 1)) - (add-hook 'comint-output-filter-functions 'tuareg-interactive-filter) - (if (not (boundp 'after-change-functions)) () - (make-local-hook 'after-change-functions) - (remove-hook 'after-change-functions 'font-lock-after-change-function t)) - (if (not (boundp 'pre-idle-hook)) () - (make-local-hook 'pre-idle-hook) - (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook t)) - (setq comint-prompt-regexp "^# *") - (setq comint-process-echoes nil) - (setq comint-get-old-input 'tuareg-interactive-get-old-input) - (setq comint-scroll-to-bottom-on-output t) - (set-syntax-table tuareg-mode-syntax-table) - (setq local-abbrev-table tuareg-mode-abbrev-table) - - (make-local-variable 'indent-line-function) - (setq indent-line-function 'tuareg-indent-command) - - (easy-menu-add tuareg-interactive-mode-menu) - (tuareg-update-options-menu)) - -(defun tuareg-run-caml () - "Run a Caml toplevel process. I/O via buffer `*caml-toplevel*'." - (interactive) - (tuareg-run-process-if-needed) - (when tuareg-display-buffer-on-eval - (display-buffer tuareg-interactive-buffer-name))) - -(defun tuareg-run-process-if-needed (&optional cmd) - "Run a Caml toplevel process if needed, with an optional command name. -I/O via buffer `*caml-toplevel*'." - (if cmd - (setq tuareg-interactive-program cmd) - (if (not (comint-check-proc tuareg-interactive-buffer-name)) - (setq tuareg-interactive-program - (read-shell-command "Caml toplevel to run: " - tuareg-interactive-program)))) - (if (not (comint-check-proc tuareg-interactive-buffer-name)) - (let ((cmdlist (tuareg-args-to-list tuareg-interactive-program)) - (process-connection-type nil)) - (set-buffer (apply (function make-comint) "caml-toplevel" - (car cmdlist) nil (cdr cmdlist))) - (tuareg-interactive-mode) - (sleep-for 1)))) - -(defun tuareg-args-to-list (string) - (let ((where (string-match "[ \t]" string))) - (cond ((null where) (list string)) - ((not (= where 0)) - (cons (substring string 0 where) - (tuareg-args-to-list (substring string (+ 1 where) - (length string))))) - (t (let ((pos (string-match "[^ \t]" string))) - (if (null pos) - nil - (tuareg-args-to-list (substring string pos - (length string))))))))) - -(defun tuareg-interactive-get-old-input () - (save-excursion - (let ((end (point))) - (re-search-backward comint-prompt-regexp (point-min) t) - (if (looking-at comint-prompt-regexp) - (re-search-forward comint-prompt-regexp)) - (buffer-substring-no-properties (point) end)))) - -(defun tuareg-interactive-end-of-phrase () - (save-excursion - (end-of-line) - (tuareg-find-meaningful-word) - (tuareg-find-meaningful-word) - (looking-at ";;"))) - -(defun tuareg-interactive-send-input-end-of-phrase () - (interactive) - (goto-char (point-max)) - (if (not (tuareg-interactive-end-of-phrase)) - (insert ";;")) - (comint-send-input)) - -(defconst tuareg-interactive-send-warning - "Note: toplevel processing requires a terminating `;;'") - -(defun tuareg-interactive-send-input () - "Process if the current line ends with `;;' then send the -current phrase else insert a newline." - (interactive) - (if (tuareg-interactive-end-of-phrase) - (progn - (comint-send-input) - (goto-char (point-max))) - (insert "\n") - (message tuareg-interactive-send-warning))) - -(defun tuareg-interactive-send-input-or-indent () - "Process if the current line ends with `;;' then send the -current phrase else insert a newline and indent." - (interactive) - (if (tuareg-interactive-end-of-phrase) - (progn - (goto-char (point-max)) - (comint-send-input)) - (insert "\n") - (indent-according-to-mode) - (message tuareg-interactive-send-warning))) - -(defun tuareg-eval-region (start end) - "Eval the current region in the Caml toplevel." - (interactive "r") - (save-excursion (tuareg-run-process-if-needed)) - (comint-preinput-scroll-to-bottom) - (setq tuareg-interactive-last-phrase-pos-in-source start) - (save-excursion - (goto-char start) - (tuareg-skip-blank-and-comments) - (setq start (point)) - (goto-char end) - (tuareg-skip-to-end-of-phrase) - (setq end (point)) - (let ((text (buffer-substring-no-properties start end))) - (goto-char end) - (if (string= text "") - (message "Cannot send empty commands to Caml toplevel!") - (set-buffer tuareg-interactive-buffer-name) - (goto-char (point-max)) - (setq tuareg-interactive-last-phrase-pos-in-toplevel (point)) - (comint-send-string tuareg-interactive-buffer-name - (concat text ";;")) - (let ((pos (point))) - (comint-send-input) - (if tuareg-interactive-echo-phrase - (save-excursion - (goto-char pos) - (insert (concat text ";;"))))))) - (when tuareg-display-buffer-on-eval - (display-buffer tuareg-interactive-buffer-name)))) - -(defun tuareg-narrow-to-phrase () - "Narrow the editting window to the surrounding Caml phrase (or block)." - (interactive) - (save-excursion - (let ((pair (tuareg-discover-phrase))) - (narrow-to-region (nth 0 pair) (nth 1 pair))))) - -(defun tuareg-eval-phrase () - "Eval the surrounding Caml phrase (or block) in the Caml toplevel." - (interactive) - (let ((end)) - (save-excursion - (let ((pair (tuareg-discover-phrase))) - (setq end (nth 2 pair)) - (tuareg-eval-region (nth 0 pair) (nth 1 pair)))) - (if tuareg-skip-after-eval-phrase - (goto-char end)))) - -(defun tuareg-eval-buffer () - "Send the buffer to the Tuareg Interactive process." - (interactive) - (tuareg-eval-region (point-min) (point-max))) - -(defun tuareg-interactive-next-error-source () - (interactive) - (let ((error-pos) (beg 0) (end 0)) - (save-excursion - (set-buffer tuareg-interactive-buffer-name) - (goto-char tuareg-interactive-last-phrase-pos-in-toplevel) - (setq error-pos - (re-search-forward tuareg-interactive-toplevel-error-regexp - (point-max) t)) - (if error-pos - (progn - (setq beg (string-to-number (tuareg-match-string 1)) - end (string-to-number (tuareg-match-string 2)))))) - (if (not error-pos) - (message "No syntax or typing error in last phrase.") - (setq beg (+ tuareg-interactive-last-phrase-pos-in-source beg) - end (+ tuareg-interactive-last-phrase-pos-in-source end)) - (goto-char beg) - (put-text-property beg end 'face 'tuareg-font-lock-error-face)))) - -(defun tuareg-interactive-next-error-toplevel () - (interactive) - (let ((error-pos) (beg 0) (end 0)) - (save-excursion - (goto-char tuareg-interactive-last-phrase-pos-in-toplevel) - (setq error-pos - (re-search-forward tuareg-interactive-toplevel-error-regexp - (point-max) t)) - (if error-pos - (setq beg (string-to-number (tuareg-match-string 1)) - end (string-to-number (tuareg-match-string 2))))) - (if (not error-pos) - (message "No syntax or typing error in last phrase.") - (setq beg (+ tuareg-interactive-last-phrase-pos-in-toplevel beg) - end (+ tuareg-interactive-last-phrase-pos-in-toplevel end)) - (put-text-property beg end 'face 'tuareg-font-lock-error-face) - (goto-char beg)))) - -(defun tuareg-interrupt-caml () - (interactive) - (if (comint-check-proc tuareg-interactive-buffer-name) - (save-excursion - (set-buffer tuareg-interactive-buffer-name) - (comint-interrupt-subjob)))) - -(defun tuareg-kill-caml () - (interactive) - (if (comint-check-proc tuareg-interactive-buffer-name) - (save-excursion - (set-buffer tuareg-interactive-buffer-name) - (comint-kill-subjob)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Menu support - -(defun tuareg-about () (interactive) - (describe-variable 'tuareg-mode-version)) -(defun tuareg-help () (interactive) - (describe-function 'tuareg-mode)) -(defun tuareg-interactive-help () (interactive) - (describe-function 'tuareg-interactive-mode)) - -(defvar tuareg-definitions-menu-last-buffer nil) -(defvar tuareg-definitions-keymaps nil) - -(defun tuareg-build-menu () - (easy-menu-define - tuareg-mode-menu (list tuareg-mode-map) - "Tuareg Mode Menu." - '("Tuareg" - ("Interactive Mode" - ["Run Caml Toplevel" tuareg-run-caml t] - ["Interrupt Caml Toplevel" tuareg-interrupt-caml - :active (comint-check-proc tuareg-interactive-buffer-name)] - ["Kill Caml Toplevel" tuareg-kill-caml - :active (comint-check-proc tuareg-interactive-buffer-name)] - ["Evaluate Region" tuareg-eval-region - ;; Region-active-p for XEmacs and mark-active for Emacs - :active (if (fboundp 'region-active-p) (region-active-p) mark-active)] - ["Evaluate Phrase" tuareg-eval-phrase t] - ["Evaluate Buffer" tuareg-eval-buffer t]) - ("Caml Forms" - ["try .. with .." tuareg-insert-try-form t] - ["match .. with .." tuareg-insert-match-form t] - ["let .. in .." tuareg-insert-let-form t] - ["if .. then .. else .." tuareg-insert-if-form t] - ["while .. do .. done" tuareg-insert-while-form t] - ["for .. do .. done" tuareg-insert-for-form t] - ["begin .. end" tuareg-insert-begin-form t]) - ["Switch .ml/.mli" tuareg-find-alternate-file t] - "---" - ["Compile..." compile t] - ["Reference Manual..." tuareg-browse-manual t] - ["Caml Library..." tuareg-browse-library t] - ("Definitions" - ["Scan..." tuareg-list-definitions t]) - "---" - [ "Show type at point" caml-types-show-type - tuareg-with-caml-mode-p] - "---" - [ "Complete identifier" caml-complete - tuareg-with-caml-mode-p] - [ "Help for identifier" caml-help - tuareg-with-caml-mode-p] - [ "Add path for documentation" ocaml-add-path - tuareg-with-caml-mode-p] - [ "Open module for documentation" ocaml-open-module - tuareg-with-caml-mode-p] - [ "Close module for documentation" ocaml-close-module - tuareg-with-caml-mode-p] - "---" - ["Customize Tuareg Mode..." (customize-group 'tuareg) t] - ("Tuareg Options" ["Dummy" nil t]) - ("Tuareg Interactive Options" ["Dummy" nil t]) - "---" - ["About" tuareg-about t] - ["Help" tuareg-help t])) - (easy-menu-add tuareg-mode-menu) - (tuareg-update-options-menu) - ;; Save and update definitions menu - (if tuareg-with-xemacs - (add-hook 'activate-menubar-hook 'tuareg-update-definitions-menu) - (if (not (functionp 'easy-menu-create-keymaps)) () - ;; Patch for Emacs - (add-hook 'menu-bar-update-hook - 'tuareg-with-emacs-update-definitions-menu) - (make-local-variable 'tuareg-definitions-keymaps) - (setq tuareg-definitions-keymaps - (cdr (easy-menu-create-keymaps - "Definitions" tuareg-definitions-menu))) - (setq tuareg-definitions-menu-last-buffer nil)))) - -(easy-menu-define - tuareg-interactive-mode-menu tuareg-interactive-mode-map - "Tuareg Interactive Mode Menu." - '("Tuareg" - ("Interactive Mode" - ["Run Caml Toplevel" tuareg-run-caml t] - ["Interrupt Caml Toplevel" tuareg-interrupt-caml - :active (comint-check-proc tuareg-interactive-buffer-name)] - ["Kill Caml Toplevel" tuareg-kill-caml - :active (comint-check-proc tuareg-interactive-buffer-name)] - ["Evaluate Region" tuareg-eval-region :active (region-active-p)] - ["Evaluate Phrase" tuareg-eval-phrase t] - ["Evaluate Buffer" tuareg-eval-buffer t]) - "---" - ["Customize Tuareg Mode..." (customize-group 'tuareg) t] - ("Tuareg Options" ["Dummy" nil t]) - ("Tuareg Interactive Options" ["Dummy" nil t]) - "---" - ["About" tuareg-about t] - ["Help" tuareg-interactive-help t])) - -(defun tuareg-update-definitions-menu () - (if (eq major-mode 'tuareg-mode) - (easy-menu-change - '("Tuareg") "Definitions" - tuareg-definitions-menu))) - -(defun tuareg-with-emacs-update-definitions-menu () - (if (current-local-map) - (let ((keymap - (lookup-key (current-local-map) [menu-bar Tuareg Definitions]))) - (if (and - (keymapp keymap) - (not (eq tuareg-definitions-menu-last-buffer (current-buffer)))) - (setcdr keymap tuareg-definitions-keymaps) - (setq tuareg-definitions-menu-last-buffer (current-buffer)))))) - -(defun tuareg-toggle-option (symbol) - (interactive) - (set symbol (not (symbol-value symbol))) - (if (eq 'tuareg-use-abbrev-mode symbol) - (abbrev-mode tuareg-use-abbrev-mode)) ; toggle abbrev minor mode - (if tuareg-with-xemacs nil (tuareg-update-options-menu))) - -(defun tuareg-update-options-menu () - (easy-menu-change - '("Tuareg") "Tuareg Options" - (mapcar (lambda (pair) - (if (consp pair) - (vector (car pair) - (list 'tuareg-toggle-option (cdr pair)) - ':style 'toggle - ':selected (nth 1 (cdr pair)) - ':active t) - pair)) tuareg-options-list)) - (easy-menu-change - '("Tuareg") "Tuareg Interactive Options" - (mapcar (lambda (pair) - (if (consp pair) - (vector (car pair) - (list 'tuareg-toggle-option (cdr pair)) - ':style 'toggle - ':selected (nth 1 (cdr pair)) - ':active t) - pair)) tuareg-interactive-options-list))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Browse Manual - -;; From M. Quercia - -(defun tuareg-browse-manual () - "*Browse Caml reference manual." - (interactive) - (setq tuareg-manual-url (read-from-minibuffer "URL: " tuareg-manual-url)) - (funcall tuareg-browser tuareg-manual-url)) - -(defun tuareg-xemacs-w3-manual (url) - "*Browse Caml reference manual." - (w3-fetch-other-frame url)) - -(defun tuareg-netscape-manual (url) - "*Browse Caml reference manual." - (start-process-shell-command - "netscape" nil - (concat "netscape -remote 'openURL (" - url ", newwindow)' || netscape " url))) - -(defun tuareg-mmm-manual (url) - "*Browse Caml reference manual." - (start-process-shell-command - "mmm" nil - (concat "mmm_remote " url " || mmm -external " url))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Browse Library - -;; From M. Quercia - -(defun tuareg-browse-library() - "Browse the Caml library." - (interactive) - (let ((buf-name "*caml-library*") (opoint) - (dir (read-from-minibuffer "Library path: " tuareg-library-path))) - (if (and (file-directory-p dir) (file-readable-p dir)) - (progn - (setq tuareg-library-path dir) - ;; List *.ml and *.mli files - (with-output-to-temp-buffer buf-name - (buffer-disable-undo standard-output) - (save-excursion - (set-buffer buf-name) - (kill-all-local-variables) - (make-local-variable 'tuareg-library-path) - (setq tuareg-library-path dir) - ;; Help - (insert "Directory \"" dir "\".\n") - (insert "Select a file with middle mouse button or RETURN.\n\n") - (insert "Interface files (.mli):\n\n") - (insert-directory (concat dir "/*.mli") "-C" t nil) - (insert "\n\nImplementation files (.ml):\n\n") - (insert-directory (concat dir "/*.ml") "-C" t nil) - ;; '.', '-' and '_' are now letters - (modify-syntax-entry ?. "w") - (modify-syntax-entry ?_ "w") - (modify-syntax-entry ?- "w") - ;; Every file name is now mouse-sensitive - (goto-char (point-min)) - (while (< (point) (point-max)) - (re-search-forward "\\.ml.?\\>") - (setq opoint (point)) - (re-search-backward "\\<" (point-min) 1) - (put-text-property (point) opoint 'mouse-face 'highlight) - (goto-char (+ 1 opoint))) - ;; Activate tuareg-library mode - (setq major-mode 'tuareg-library-mode) - (setq mode-name "tuareg-library") - (use-local-map tuareg-library-mode-map) - (setq buffer-read-only t))))))) - -(defvar tuareg-library-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (define-key map [return] 'tuareg-library-find-file) - (define-key map [mouse-2] 'tuareg-library-mouse-find-file) - map)) - -(defun tuareg-library-find-file () - "Load the file whose name is near point." - (interactive) - (save-excursion - (if (text-properties-at (point)) - (let (beg) - (re-search-backward "\\<") (setq beg (point)) - (re-search-forward "\\>") - (find-file-read-only (concat tuareg-library-path "/" - (buffer-substring-no-properties - beg (point)))))))) - -(defun tuareg-library-mouse-find-file (event) - "Visit the file name you click on." - (interactive "e") - (let ((owindow (selected-window))) - (mouse-set-point event) - (tuareg-library-find-file) - (select-window owindow))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Definitions List - -;; Designed from original code by M. Quercia - -(defconst tuareg-definitions-regexp - "\\<\\(and\\|val\\|type\\|module\\|class\\|exception\\|let\\)\\>" - "Regexp matching definition phrases.") - -(defconst tuareg-definitions-bind-skip-regexp - (concat "\\<\\(rec\\|type\\|virtual\\)\\>\\|'[" tuareg-alpha "][0-9_'" - tuareg-alpha "]*\\|('.*)") - "Regexp matching stuff to ignore after a binding keyword.") - -(defvar tuareg-definitions-menu (list ["Scan..." tuareg-list-definitions t]) - "Initial content of the definitions menu.") -(make-variable-buffer-local 'tuareg-definitions-menu) - -(defun tuareg-list-definitions () - "Parse the buffer and gather toplevel definitions for quick -jump via the definitions menu." - (interactive) - (message "Searching definitions...") - (save-excursion - (let ((cpt 0) (kw) (menu) (scan-error) - (value-list) (type-list) (module-list) (class-list) (misc-list)) - (goto-char (point-min)) - (tuareg-skip-blank-and-comments) - (while (and (< (point) (point-max)) (not scan-error)) - (if (looking-at tuareg-definitions-regexp) - (progn - (setq kw (tuareg-match-string 0)) - (if (string= kw "and") - (setq kw (save-match-data - (save-excursion (tuareg-find-and-match))))) - (if (or (string= kw "exception") - (string= kw "val")) (setq kw "let")) - ;; Skip optional elements - (goto-char (match-end 0)) - (tuareg-skip-blank-and-comments) - (if (looking-at tuareg-definitions-bind-skip-regexp) - (goto-char (match-end 0))) - (tuareg-skip-blank-and-comments) - (if (looking-at - (concat "\\<[" tuareg-alpha "][0-9_'" tuareg-alpha "]*\\>")) - ;; Menu item : [name (goto-char ...) t] - (let* ((p (make-marker)) - (ref (vector (tuareg-match-string 0) - (list 'tuareg-goto p) t))) - (setq cpt (1+ cpt)) - (message (concat "Searching definitions... (" - (number-to-string cpt) ")")) - (set-marker p (point)) - (cond - ((string= kw "let") - (setq value-list (cons ref value-list))) - ((string= kw "type") - (setq type-list (cons ref type-list))) - ((string= kw "module") - (setq module-list (cons ref module-list))) - ((string= kw "class") - (setq class-list (cons ref class-list))) - (t (setq misc-list (cons ref misc-list)))))))) - ;; Skip to next phrase or next top-level `and' - (tuareg-forward-char) - (let ((old-point (point)) (last-and)) - (tuareg-next-phrase t) - (setq last-and (point)) - (if (< last-and old-point) - (setq scan-error t) - (save-excursion - (while (and (re-search-backward "\\" old-point t) - (not (tuareg-in-literal-or-comment-p)) - (save-excursion (tuareg-find-and-match) - (>= old-point (point)))) - (setq last-and (point))))) - (goto-char last-and))) - (if scan-error - (message "Parse error when scanning definitions: line %s!" - (if tuareg-with-xemacs - (line-number) - (1+ (count-lines 1 (point))))) - ;; Sort and build lists - (mapcar (lambda (pair) - (if (cdr pair) - (setq menu - (append (tuareg-split-long-list - (car pair) (tuareg-sort-definitions (cdr pair))) - menu)))) - (list (cons "Miscellaneous" misc-list) - (cons "Values" value-list) - (cons "Classes" class-list) - (cons "Types" type-list) - (cons "Modules" module-list))) - ;; Update definitions menu - (setq tuareg-definitions-menu - (append menu (list "---" - ["Rescan..." tuareg-list-definitions t]))) - (if (or tuareg-with-xemacs - (not (functionp 'easy-menu-create-keymaps))) () - ;; Patch for Emacs - (setq tuareg-definitions-keymaps - (cdr (easy-menu-create-keymaps - "Definitions" tuareg-definitions-menu))) - (setq tuareg-definitions-menu-last-buffer nil)) - (message "Searching definitions... done")))) - (tuareg-update-definitions-menu)) - -(defun tuareg-goto (pos) - (goto-char pos) - (recenter)) - -(defun tuareg-sort-definitions (list) - (let* ((last "") (cpt 1) - (list (sort (nreverse list) - (lambda (p q) (string< (elt p 0) (elt q 0))))) - (tail list)) - (while tail - (if (string= (elt (car tail) 0) last) - (progn - (setq cpt (1+ cpt)) - (aset (car tail) 0 (format "%s (%d)" last cpt))) - (setq cpt 1) - (setq last (elt (car tail) 0))) - (setq tail (cdr tail))) - list)) - -;; Look for the (n-1)th or last element of a list -(defun tuareg-nth (n list) - (if (or (<= n 1) (null list) (null (cdr list))) list - (tuareg-nth (1- n) (cdr list)))) - -;; Split a definition list if it is too long -(defun tuareg-split-long-list (title list) - (let ((tail (tuareg-nth tuareg-definitions-max-items list))) - (if (or (null tail) (null (cdr tail))) - ;; List not too long, cons the title - (list (cons title list)) - ;; List too long, split and add initials to the title - (let (lists) - (while list - (let ((beg (substring (elt (car list) 0) 0 1)) - (end (substring (elt (car tail) 0) 0 1))) - (setq lists (cons - (cons (format "%s %s-%s" title beg end) list) - lists)) - (setq list (cdr tail)) - (setcdr tail nil) - (setq tail (tuareg-nth tuareg-definitions-max-items list)))) - (nreverse lists))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Hooks and Exit - -(condition-case nil - (progn (require 'speedbar) - (speedbar-add-supported-extension - '(".ml" ".mli" ".mll" ".mly"))) - (error nil)) - -(defvar tuareg-load-hook nil - "This hook is run when Tuareg is loaded in. It is a good place to put -key-bindings or hack Font-Lock keywords...") - -(run-hooks 'tuareg-load-hook) - -(provide 'tuareg) -;; For compatibility with caml support modes -;; you may also link caml.el to tuareg.el -(provide 'caml) - -;;; tuareg.el ends here diff --git a/emacs/external/twit.el b/emacs/external/twit.el deleted file mode 100644 index 259c456..0000000 --- a/emacs/external/twit.el +++ /dev/null @@ -1,418 +0,0 @@ -;;; twit.el --- interface with twitter.com - -;; Copyright (c) 2007 Theron Tlax -;; Time-stamp: <2007-03-19 18:33:17 thorne> -;; Author: thorne -;; Created: 2007.3.16 -;; Keywords: comm -;; Favorite Poet: E. E. Cummings - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation version 2. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; For a copy of the GNU General Public License, search the Internet, -;; or write to the Free Software Foundation, Inc., 59 Temple Place, -;; Suite 330, Boston, MA 02111-1307 USA - -;;; Commentary: - -;; This is the beginnings of a library for interfacing with -;; twitter.com from Emacs. It is also (more importantly) some -;; interactive functions that use that library. It's a hack, of -;; course; RMS i am not. Maybe one of you real programmers would -;; like to clean it up? - -;; This uses Twitter's XML-based api, not the JSON one because i -;; would like to avoid making the user install third-party libraries -;; to use it. - -;; Use: - -;; FOR POSTING - -;; There are four main interactive functions: - -;; M-x twit-post RET will prompt for you to type your post directly -;; in the minibuffer. - -;; M-x twit-post-region RET will post the region and - -;; M-x twit-post-buffer RET will post the entire contents of the -;; current buffer. - -;; M-X twit-show-recent-tweets RET will create a new buffer and -;; show your most recent messages in it. - -;; M-x twit-mode RET, if you want to bother, just binds the -;; interactive functions to some keys. Do C-h f RET twit-mode RET -;; for more info. - -;; M-x twit-follow-recent-tweets RET will create a new buffer, -;; show the most recent tweets, and update it every 90 seconds (idle) - -;; But remember that your posts can't be longer than 140 characters -;; long. All of these functions will also prompt you for your user -;; name (usually the email address you signed up to twitter with) -;; and password the first time in a given Emacs session. Note that -;; twitter uses `Basic Authentication' for user authentication, -;; which translates to, basically none. It's not secure for -;; anything more than casual attacks. - -;; FOR READING - -;; This is a work in progress. Just stubs. I have to figure out -;; how to make some use out of `xml-parse-fragment'. Until then, -;; `twit-list-followers' is incredibly stupid, but works. - -;; FOR HACKING - -;; See `twit-post-function', which is the backend for posting, and -;; `twit-parse-xml' which grabs an xml file from HTTP and turns it -;; into a list structure (using `xml-parse-fragment'). This is a work -;; in progress. - -;; Installing: - -;; There's not much to it. It you want it always there and ready, you -;; can add something to your .emacs file like: - -;; (load-file "/path/to/twit.el") - -;; or get fancier, to the extent you want and know how (autoloading, -;; keybinding, etc). - -;; Notes: - -;; `twit-user' gets my vote for variable name of the year. Ditto -;; `twit-mode' for mode names. - -;;; History: - -;; 2007-3-16 theron tlax -;; * 0.0.1 -- Initial release. Posting only. -;; 2007-3-17 '' -;; * 0.0.2 -- Near-total rewrite; better documentation; use standard -;; Emacs xml and url packages; minor mode; a little -;; abstraction; some stubs for the reading functions. -;; * 0.0.3 -- Doc and other minor changes. -;; * 0.0.4 -- (released as 0.0.3 -- Added twit-show-recent-tweets -;; by Jonathan Arkell) -;; * 0.0.5 -- Add source parameter to posts -;; * 0.0.6 -- Re-working twit-show-recent-tweets to show more info -;; (and to get it working for me) -- by H Durer -;; * 0.0.7 -- Keymaps in the buffers for twit-show-recent-tweets and -;; twit-list-followers; encode the post argument so that it -;; is a valid post request -;; * 0.0.8 -- faces/overlays to make the *Twit-recent* buffer look -;; prettier and more readable (at least for me) -- by H Durer -;; * 0.0.9 -- follow-recent-tweets function created so automagickally -;; follow tweets every 5 mins. Also removed twit-mode -;; on twit-show-recent-tweets. (it was setting twit-mode -;; globally, and interfering with planner) - -;; Bugs: - -;; * Posts with semicolons are being silently truncated. I don't -;; know why. - -;; `twit-list-followers' may not work if it is the first thing you -;; do. - -;; Report bugs to me at the listed email address. Additionally, -;; report the absence of bugs if you are using a system not in the -;; list below of systems tested at least minimally: - -;; Twit 0.0.2 / Emacs 22.0.93.1 / windows-nt -;; Twit 0.0.2 / Emacs 23.0.51.1 / gnu/linux -;; Twit 0.0.3 / Emacs 22..92.1 / gnu/linux -;; Twit 0.0.6 / Emacs 22.0.90.1 / gnu/linux -;; Twit 0.0.8 / Emacs 22.1.1 / gnu/linux -;; Twit 0.0.8 / Emacs 22.0.99.1 / windows - - - -;;; To do: - -;; Finish reading, and then add a timer for auto-update. - - -;;; Code: - -(require 'xml) -(require 'url) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar twit-version-number "0.0.8") - -(defvar twit-status-mode-map (make-sparse-keymap)) -(defvar twit-followers-mode-map (make-sparse-keymap)) - -;; 'r' key for reloading/refreshing the buffer -(define-key twit-status-mode-map "r" 'twit-show-recent-tweets) -(define-key twit-followers-mode-map "r" 'twit-list-followers) -(dolist (info '(("s" . twit-show-recent-tweets) - ("f" . twit-list-followers) - ("p" . twit-post))) - (define-key twit-status-mode-map (car info) (cdr info)) - (define-key twit-followers-mode-map (car info) (cdr info))) - - -(defvar twit-timer - nil - "Timer object that handles polling the followers") - - -;; Most of this will be used in the yet-to-be-written twitter -;; reading functions. -(defvar twit-base-url "http://twitter.com") - -(defconst twit-follow-idle-interval 90) - -(defconst twit-update-url - (concat twit-base-url "/statuses/update.xml")) -(defconst twit-puplic-timeline-file - (concat twit-base-url "/statuses/public_timeline.xml")) -(defconst twit-friend-timeline-file - (concat twit-base-url "/statuses/friends_timeline.xml")) -(defconst twit-followers-file - (concat twit-base-url "/statuses/followers.xml")) -(defconst twit-friend-list-file - (concat twit-base-url "/statuses/friends.xml")) - -(defconst twit-success-msg - "Post sent (no guarantees, though)") -(defconst twit-too-long-msg - "Post not sent because length exceeds 140 characters") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Faces -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(copy-face 'bold 'twit-message-face) -(set-face-attribute 'twit-message-face nil - :family "helv" - :height 1.2 - :weight 'semi-bold - :width 'semi-condensed) -(copy-face 'bold 'twit-author-face) -(set-face-attribute 'twit-author-face nil - :family 'unspecified - :weight 'semi-bold - :width 'semi-condensed) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; General purpose library to wrap twitter.com's api -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun twit-parse-xml (url) - "Retrieve file at URL and parse with `xml-parse-fragment'. -Emacs' url package will prompt for authentication info if required." - (let ((result nil)) - (save-window-excursion - (set-buffer (url-retrieve-synchronously url)) - (goto-char (point-min)) - (setq result (xml-parse-fragment)) - (kill-buffer (current-buffer))) - result)) - -(defun twit-post-function (url post) - (let ((url-request-method "POST") - (url-request-data (concat "source=twit.el&status=" (url-hexify-string post))) - ;; these headers don't actually do anything (yet?) -- the - ;; source parameter above is what counts - (url-request-extra-headers `(("X-Twitter-Client" . "twit.el") - ("X-Twitter-Client-Version" . ,twit-version-number) - ("X-Twitter-Client-URL" . "http://www.emacswiki.org/cgi-bin/emacs/twit.el")))) - (message "%s" url-request-data) - (url-retrieve url (lambda (arg) (kill-buffer (current-buffer)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Helpers for the interactive functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun twit-query-for-post () - "Query for a Twitter.com post text in the minibuffer." - (read-string "Post (140 char max): ")) - - -(defun twit-write-recent-tweets () - (save-excursion - (delete-region (point-min) (point-max)) - (insert (format-time-string "Last updated: %c\n")) - (labels ((xml-first-child (node attr) - (car (xml-get-children node attr))) - (xml-first-childs-value (node addr) - (car (xml-node-children (xml-first-child node addr))))) - (dolist (status-node (xml-get-children (cadr (twit-parse-xml twit-friend-timeline-file)) 'status)) - (let* ((user-info (xml-first-child status-node 'user)) - (user-id (or (xml-first-childs-value user-info 'screen_name) "??")) - (user-name (xml-first-childs-value user-info 'name)) - (location (xml-first-childs-value user-info 'location)) - (src-info (xml-first-childs-value status-node 'source)) - (timestamp (xml-first-childs-value status-node 'created_at)) - (message (xml-first-childs-value status-node 'text))) - ;; the string-match is a bit weird, as emacswiki.org won't - ;; accept pages with the href in it per se - (when (and src-info (string-match (concat "\\(.*\\)<" "/a>") - src-info)) - ;; remove the HTML link info; leave just the name - (setq src-info (match-string 1 src-info))) - ;; First line: Name and message - (twit-insert-with-overlay-attributes (format "%25s" - (concat user-id - (if user-name - (concat " (" user-name ")") - ""))) - '((face . "twit-author-face"))) - (insert ": ") - (twit-insert-with-overlay-attributes message - '((face . "twit-message-face"))) - (insert "\n") - (when (or timestamp location src-info) - (insert " ") - (when timestamp - (insert (concat " posted " timestamp))) - (when location - (insert (concat " from " location))) - (when src-info - (insert (concat " (via " src-info ")"))) - (insert "\n"))))) - ;; go back to top so we see the latest messages - (beginning-of-buffer))) - -(defun twit-follow-recent-tweets-timer () - "Timer function for recent tweets" - (save-excursion - (set-buffer "*Twit-recent*") - (toggle-read-only 0) - (twit-write-recent-tweets) - (toggle-read-only 1))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Main interactive functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;###autoload -(defun twit-post () - "Send a post to twitter.com. -Prompt the first time for password and username \(unless -`twit-user' and/or `twit-pass' is set\) and for the text of the -post; thereafter just for post text. Posts must be <= 140 chars -long." - (interactive) - (let* ((post (twit-query-for-post))) - (if (> (length post) 140) - (error twit-too-long-msg) - (if (twit-post-function twit-update-url post) - (message twit-success-msg))))) - -;;;###autoload -(defun twit-post-region (start end) - "Send text in the region as a post to twitter.com. -Uses `twit-post-function' to do the dirty work and to obtain -needed user and password information. Posts must be <= 140 chars -long." - (interactive "r") - (let ((post (buffer-substring start end))) - (if (> (length post) 140) - (error twit-too-long-error) - (if (twit-post-function twit-update-url post) - (message twit-success-msg))))) - -;;;###autoload -(defun twit-post-buffer () - "Post the entire contents of the current buffer to twitter.com. -Uses `twit-post-function' to do the dirty work and to obtain -needed user and password information. Posts must be <= 140 chars -long." - (interactive) - (let ((post (buffer-substring (point-min) (point-max)))) - (if (> (length post) 140) - (error twit-too-long-error) - (if (twit-post-function twit-update-url post) - (message twit-success-msg))))) - -;;;###autoload -(defun twit-list-followers () - "Display a list of all your twitter.com followers' names." - (interactive) - (pop-to-buffer "*Twit-followers*") - (kill-region (point-min) (point-max)) - (loop for name in - (loop for name in - (loop for user in - (xml-get-children - (cadr (twit-parse-xml twit-followers-file)) 'user) - collect (sixth user)) - collect (third name)) - do (insert (concat name "\n"))) - ;; set up mode as with twit-show-recent-tweets - (text-mode) - (use-local-map twit-followers-mode-map)) - -;;; Helper function to insert text into buffer, add an overlay and -;;; apply the supplied attributes to the overlay -(defun twit-insert-with-overlay-attributes (text attributes) - (let ((start (point))) - (insert text) - (let ((overlay (make-overlay start (point)))) - (dolist (spec attributes) - (overlay-put overlay (car spec) (cdr spec)))))) - - -;;; Added by Jonathan Arkell -;;;###autoload -(defun twit-follow-recent-tweets () - "Display, and redisplay the tweets. This might suck if it bounces the point to the bottom all the time." - (interactive) - (twit-show-recent-tweets) - (setq twit-timer (run-with-idle-timer twit-follow-idle-interval 1 'twit-follow-recent-tweets-timer))) - -;;;###autoload -(defun twit-show-recent-tweets () - "Display a list of the most recent twewets from your followers." - (interactive) - (pop-to-buffer "*Twit-recent*") - (toggle-read-only 0) - (twit-write-recent-tweets) - ;; set up some sensible mode and useful bindings - (text-mode) - (toggle-read-only 1) - (use-local-map twit-status-mode-map)) - -;;;###autoload -(define-minor-mode twit-mode - "Toggle twit-mode. -Globally binds some keys to Twit's interactive functions. - -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -\\{twit-mode-map}" nil -" Twit" -'(("\C-c\C-tp" . twit-post) - ("\C-c\C-tr" . twit-post-region) - ("\C-c\C-tb" . twit-post-buffer) - ("\C-c\C-tf" . twit-list-followers)) - :global t - :group 'twit - :version twit-version-number) - -(provide 'twit) - -;;; twit.el ends here diff --git a/emacs/external/visual-basic-mode.el b/emacs/external/visual-basic-mode.el deleted file mode 100644 index f74a743..0000000 --- a/emacs/external/visual-basic-mode.el +++ /dev/null @@ -1,944 +0,0 @@ -;;; visual-basic-mode.el -;; This is free software. - -;; A mode for editing Visual Basic programs. -;; Modified version of Fred White's visual-basic-mode.el - -;; Copyright (C) 1996 Fred White -;; Copyright (C) 1998 Free Software Foundation, Inc. -;; (additions by Dave Love) -;; Copyright (C) 2008 Free Software Foundation, Inc. -;; (additions by Randolph Fritz) - -;; Author: Fred White -;; Adapted-by: Dave Love -;; : Kevin Whitefoot -;; : Randolph Fritz -;; Version: 1.4.2 (Mar 10, 2008) -;; Serial Version: %Id: 8% -;; Keywords: languages, basic, Evil - - -;; (Old) LCD Archive Entry: -;; basic-mode|Fred White|fwhite@alum.mit.edu| -;; A mode for editing Visual Basic programs.| -;; 18-Apr-96|1.0|~/modes/basic-mode.el.Z| - -;; This file is NOT part of GNU Emacs but the same permissions apply. -;; -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 2, or (at your -;; option) any later version. -;; -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of the -;; License, or (at your option) any later version. - -;;; Commentary: - -;; Purpose of this package: -;; This is a mode for editing programs written in The World's Most -;; Successful Programming Language. It features automatic -;; indentation, font locking, keyword capitalization, and some minor -;; convenience functions. - -;; Installation instructions -;; Put basic-mode.el somewhere in your path, compile it, and add the -;; following to your init file: - -;; (autoload 'visual-basic-mode "visual-basic-mode" "Visual Basic mode." t) -;; (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\)$" . -;; visual-basic-mode)) auto-mode-alist)) -;; -;; If you are doing Rhino scripts, add: -;; (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\|rvb\\)$" . -;; visual-basic-mode)) auto-mode-alist)) - - -;; Of course, under Windows 3.1, you'll have to name this file -;; something shorter than visual-basic-mode.el - -;; Revisions: -;; 1.0 18-Apr-96 Initial version -;; 1.1 Accomodate emacs 19.29+ font-lock-defaults -;; Simon Marshall -; 1.2 Rename to visual-basic-mode -;; 1.3 Fix some indentation bugs. -;; 1.3+ Changes by Dave Love: [No attempt at compatibility with -;; anything other than Emacs 20, sorry, but little attempt to -;; sanitize for Emacs 20 specifically.] -;; Change `_' syntax only for font-lock and imenu, not generally; -;; provide levels of font-locking in the current fashion; -;; font-lock case-insensitively; use regexp-opt with the font-lok -;; keywords; imenu support; `visual-basic-split-line', bound to -;; C-M-j; account for single-statement `if' in indentation; add -;; keyword "Global"; use local-write-file-hooks, not -;; write-file-hooks. -;; 1.4 September 1998 -;; 1.4 KJW Add begin..end, add extra keywords -;; Add customisation for single line if. Disallow by default. -;; Fix if regexp to require whitespace after if and require then. -;; Add more VB keywords. Make begin..end work as if..endif so -;; that forms are formatted correctly. -;; 1.4.1 KJW Merged Dave Love and KJW versions. -;; Added keywords suggested by Mickey Ferguson -;; -;; Fixed imenu variable to find private variables and enums - -;; Changed syntax class of =, <, > to punctuation to allow dynamic -;; abbreviations to pick up only the word at point rather than the -;; whole expression. - -;; Fixed bug introduced by KJW adding suport for begin...end in -;; forms whereby a single end outdented. - -;; Partially fixed failure to recognise if statements with -;; continuations (still fails on 'single line' if with -;; continuation, ugh). -;; 1.4.2 RF added "class" and "null" keywords, "Rhino" script note. - -;; -;; Notes: -;; Dave Love -;; BTW, here's a script for making tags tables that I (Dave Love) have -;; used with reasonable success. It assumes a hacked version of etags -;; with support for case-folded regexps. I think this is now in the -;; development version at and should -;; make it into Emacs after 20.4. - -;; #! /bin/sh - -;; # etags-vb: (so-called) Visual (so-called) Basic TAGS generation. -;; # Dave Love . Public domain. -;; # 1997-11-21 - -;; if [ $# -lt 1 ]; then -;; echo "Usage: `basename $0` [etags options] VBfile ... [etags options] " 1>&2 -;; exit 1 -;; fi - -;; if [ $1 = "--help" ] || [ $1 = "-h" ]; then -;; echo "Usage: `basename $0` [etags options] VBfile ... [etags options] - -;; " -;; etags --help -;; fi - -;; exec etags --lang=none -c '/\(global\|public\)[ \t]+\(\(const\|type\)[ \t]+\)*\([a-z_0-9]+\)/\4/' \ -;; -c '/public[ \t]+\(sub\|function\|class\)[ \t]+\([a-z_0-9]+\)/\2/' \ -;; "$@" - -;; End Notes Dave Love - - -;; Known bugs: -;; Doesn't know about ":" separated stmts -;; Doesn't recognize single line if statements if these are broken by -;; line continuation characters - - -;; todo: -;; fwd/back-compound-statement -;; completion over OCX methods and properties. -;; IDE integration -;; Change behaviour of ESC-q to recognise words used as paragraph -;; titles and prevent them being dragged into the previous -;; paragraph. -;; etc. - - -;;; Code: - -(provide 'visual-basic-mode) - -(defvar visual-basic-xemacs-p (string-match "XEmacs\\|Lucid" (emacs-version))) -(defvar visual-basic-winemacs-p (string-match "Win-Emacs" (emacs-version))) -(defvar visual-basic-win32-p (eq window-system 'w32)) - -;; Variables you may want to customize. -(defvar visual-basic-mode-indent 8 "*Default indentation per nesting level.") -(defvar visual-basic-fontify-p t "*Whether to fontify Basic buffers.") -(defvar visual-basic-capitalize-keywords-p t - "*Whether to capitalize BASIC keywords.") -(defvar visual-basic-wild-files "*.frm *.bas *.cls" - "*Wildcard pattern for BASIC source files.") -(defvar visual-basic-ide-pathname nil - "*The full pathname of your Visual Basic exe file, if any.") -;; KJW Provide for my preference in if statements -(defvar visual-basic-allow-single-line-if nil - "*Whether to allow single line if") - - -(defvar visual-basic-defn-templates - (list "Public Sub ()\nEnd Sub\n\n" - "Public Function () As Variant\nEnd Function\n\n" - "Public Property Get ()\nEnd Property\n\n") - "*List of function templates though which visual-basic-new-sub cycles.") - -(defvar visual-basic-imenu-generic-expression - '((nil "^\\s-*\\(public\\|private\\)*\\s-+\\(declare\\s-+\\)*\\(sub\\|function\\)\\s-+\\(\\sw+\\>\\)" - 4) - ("Constants" - "^\\s-*\\(private\\|public\\|global\\)*\\s-*\\(const\\s-+\\)\\(\\sw+\\>\\s-*=\\s-*.+\\)$\\|'" - 3) - ("Variables" - "^\\(private\\|public\\|global\\|dim\\)+\\s-+\\(\\sw+\\>\\s-+as\\s-+\\sw+\\>\\)" - 2) - ("Types" "^\\(public\\s-+\\)*type\\s-+\\(\\sw+\\)" 2))) - - - -(defvar visual-basic-mode-syntax-table nil) -(if visual-basic-mode-syntax-table - () - (setq visual-basic-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\' "\<" visual-basic-mode-syntax-table) ; Comment starter - (modify-syntax-entry ?\n ">" visual-basic-mode-syntax-table) - (modify-syntax-entry ?\\ "w" visual-basic-mode-syntax-table) - (modify-syntax-entry ?\= "." visual-basic-mode-syntax-table) - (modify-syntax-entry ?\< "." visual-basic-mode-syntax-table) - (modify-syntax-entry ?\> "." visual-basic-mode-syntax-table)) ; Make =, etc., punctuation so that dynamic abbreviations work properly - - -(defvar visual-basic-mode-map nil) -(if visual-basic-mode-map - () - (setq visual-basic-mode-map (make-sparse-keymap)) - (define-key visual-basic-mode-map "\t" 'visual-basic-indent-line) - (define-key visual-basic-mode-map "\r" 'visual-basic-newline-and-indent) - (define-key visual-basic-mode-map "\M-\C-a" 'visual-basic-beginning-of-defun) - (define-key visual-basic-mode-map "\M-\C-e" 'visual-basic-end-of-defun) - (define-key visual-basic-mode-map "\M-\C-h" 'visual-basic-mark-defun) - (define-key visual-basic-mode-map "\M-\C-\\" 'visual-basic-indent-region) - (define-key visual-basic-mode-map "\M-q" 'visual-basic-fill-or-indent) - (define-key visual-basic-mode-map "\M-\C-j" 'visual-basic-split-line) - (cond (visual-basic-winemacs-p - (define-key visual-basic-mode-map '(control C) 'visual-basic-start-ide)) - (visual-basic-win32-p - (define-key visual-basic-mode-map (read "[?\\S-\\C-c]") 'visual-basic-start-ide))) - (if visual-basic-xemacs-p - (progn - (define-key visual-basic-mode-map "\M-G" 'visual-basic-grep) - (define-key visual-basic-mode-map '(meta backspace) 'backward-kill-word) - (define-key visual-basic-mode-map '(control meta /) 'visual-basic-new-sub)))) - - -;; These abbrevs are valid only in a code context. -(defvar visual-basic-mode-abbrev-table nil) - -(defvar visual-basic-mode-hook ()) - - -;; Is there a way to case-fold all regexp matches? -;; Change KJW Add enum, , change matching from 0 or more to zero or one for public etc. -(eval-and-compile - (defconst visual-basic-defun-start-regexp - (concat - "^[ \t]*\\([Pp]ublic \\|[Pp]rivate \\|[Ss]tatic\\|[Ff]riend \\)?" - "\\([Ss]ub\\|[Ff]unction\\|[Pp]roperty +[GgSsLl]et\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)" - "[ \t]+\\(\\w+\\)[ \t]*(?"))) - - -(defconst visual-basic-defun-end-regexp - "^[ \t]*[Ee]nd \\([Ss]ub\\|[Ff]unction\\|[Pp]roperty\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)") - - -;; Includes the compile-time #if variation. -;; KJW fixed if to require a whitespace so as to avoid matching, for -;; instance, iFileName and to require then. - -;; Two versions; one recognizes single line if just as though it were -;; a multi-line and the other does not. Modified again to remove the -;; requirement for then so as to allow it to match if statements that -;; have continuations. -;;(defconst visual-basic-if-regexp -;; "^[ \t]*#?[Ii]f[ \t]+.*[ \t]+[Tt]hen[ \t]*.*\\('\\|$\\)") -(defconst visual-basic-if-regexp - "^[ \t]*#?[Ii]f[ \t]+.*[ \t_]+") - -(defconst visual-basic-ifthen-regexp "^[ \t]*#?[Ii]f.+\\<[Tt]hen\\>\\s-\\S-+") - -(defconst visual-basic-else-regexp "^[ \t]*#?[Ee]lse\\([Ii]f\\)?") -(defconst visual-basic-endif-regexp "[ \t]*#?[Ee]nd[ \t]*[Ii]f") - -(defconst visual-basic-continuation-regexp "^.*\_[ \t]*$") -(eval-and-compile - (defconst visual-basic-label-regexp "^[ \t]*[a-zA-Z0-9_]+:$")) - -(defconst visual-basic-select-regexp "^[ \t]*[Ss]elect[ \t]+[Cc]ase") -(defconst visual-basic-case-regexp "^[ \t]*[Cc]ase") -(defconst visual-basic-select-end-regexp "^[ \t]*[Ee]nd[ \t]+[Ss]elect") - - -(defconst visual-basic-for-regexp "^[ \t]*[Ff]or\\b") -(defconst visual-basic-next-regexp "^[ \t]*[Nn]ext\\b") - -(defconst visual-basic-do-regexp "^[ \t]*[Dd]o\\b") -(defconst visual-basic-loop-regexp "^[ \t]*[Ll]oop\\b") - -(defconst visual-basic-while-regexp "^[ \t]*[Ww]hile\\b") -(defconst visual-basic-wend-regexp "^[ \t]*[Ww]end\\b") - -;; Added KJW Begin..end for forms -(defconst visual-basic-begin-regexp "^[ \t]*[Bb]egin)?") -;; This has created a bug. End on its own in code should not outdent. -;; How can we fix this? They are used in separate Lisp expressions so -;; add another one. -(defconst visual-basic-end-begin-regexp "^[ \t]*[Ee]nd") - -(defconst visual-basic-with-regexp "^[ \t]*[Ww]ith\\b") -(defconst visual-basic-end-with-regexp "^[ \t]*[Ee]nd[ \t]+[Ww]ith\\b") - -(defconst visual-basic-blank-regexp "^[ \t]*$") -(defconst visual-basic-comment-regexp "^[ \t]*\\s<.*$") - - -;; This is some approximation of the set of reserved words in Visual Basic. -(eval-and-compile - (defvar visual-basic-all-keywords - '("Add" "Aggregate" "And" "App" "AppActivate" "Application" "Array" "As" - "Asc" "AscB" "Atn" "Attribute" - "Beep" "Begin" "BeginTrans" "Boolean" "ByVal" "ByRef" - "CBool" "CByte" "CCur" - "CDate" "CDbl" "CInt" "CLng" "CSng" "CStr" "CVErr" "CVar" "Call" - "Case" "ChDir" "ChDrive" "Character" "Choose" "Chr" "ChrB" "Class" - "ClassModule" "Clipboard" "Close" "Collection" "Column" "Columns" - "Command" "CommitTrans" "CompactDatabase" "Component" "Components" - "Const" "Container" "Containers" "Cos" "CreateDatabase" "CreateObject" - "CurDir" "Currency" - "DBEngine" "DDB" "Data" "Database" "Databases" - "Date" "DateAdd" "DateDiff" "DatePart" "DateSerial" "DateValue" "Day" - "Debug" "Declare" "Deftype" "DeleteSetting" "Dim" "Dir" "Do" - "DoEvents" "Domain" - "Double" "Dynaset" "EOF" "Each" "Else" "End" "EndProperty" - "Enum" "Environ" "Erase" "Err" "Error" "Exit" "Exp" "FV" "False" "Field" - "Fields" "FileAttr" "FileCopy" "FileDateTime" "FileLen" "Fix" "Font" "For" - "Form" "FormTemplate" "Format" "Forms" "FreeFile" "FreeLocks" "Friend" - "Function" - "Get" "GetAllSettings" "GetAttr" "GetObject" "GetSetting" "Global" "GoSub" - "GoTo" "Group" "Groups" "Hex" "Hour" "IIf" "IMEStatus" "IPmt" "IRR" - "If" "Implements" "InStr" "Input" "Int" "Integer" "Is" "IsArray" "IsDate" - "IsEmpty" "IsError" "IsMissing" "IsNull" "IsNumeric" "IsObject" "Kill" - "LBound" "LCase" "LOF" "LSet" "LTrim" "Left" "Len" "Let" "Like" "Line" - "Load" "LoadPicture" "LoadResData" "LoadResPicture" "LoadResString" "Loc" - "Lock" "Log" "Long" "Loop" "MDIForm" "MIRR" "Me" "MenuItems" - "MenuLine" "Mid" "Minute" "MkDir" "Month" "MsgBox" "NPV" "NPer" "Name" - "New" "Next" "Not" "Now" "Nothing" "Null" "Object" "Oct" "On" "Open" - "OpenDatabase" - "Operator" "Option" "Optional" - "Or" "PPmt" "PV" "Parameter" "Parameters" "Partition" - "Picture" "Pmt" "Print" "Printer" "Printers" "Private" "ProjectTemplate" - "Property" - "Properties" "Public" "Put" "QBColor" "QueryDef" "QueryDefs" - "RSet" "RTrim" "Randomize" "Rate" "ReDim" "Recordset" "Recordsets" - "RegisterDatabase" "Relation" "Relations" "Rem" "RepairDatabase" - "Reset" "Resume" "Return" "Right" "RmDir" "Rnd" "Rollback" "RowBuffer" - "SLN" "SYD" "SavePicture" "SaveSetting" "Screen" "Second" "Seek" - "SelBookmarks" "Select" "SelectedComponents" "SendKeys" "Set" - "SetAttr" "SetDataAccessOption" "SetDefaultWorkspace" "Sgn" "Shell" - "Sin" "Single" "Snapshot" "Space" "Spc" "Sqr" "Static" "Step" "Stop" "Str" - "StrComp" "StrConv" "String" "Sub" "SubMenu" "Switch" "Tab" "Table" - "TableDef" "TableDefs" "Tan" "Then" "Time" "TimeSerial" "TimeValue" - "Timer" "To" "Trim" "True" "Type" "TypeName" "UBound" "UCase" "Unload" - "Unlock" "Val" "Variant" "VarType" "Verb" "Weekday" "Wend" - "While" "Width" "With" "Workspace" "Workspaces" "Write" "Year"))) - -(defvar visual-basic-font-lock-keywords-1 - (eval-when-compile - (list - ;; Names of functions. - (list visual-basic-defun-start-regexp - '(1 font-lock-keyword-face nil t) - '(2 font-lock-keyword-face nil t) - '(3 font-lock-function-name-face)) - - ;; Statement labels - (cons visual-basic-label-regexp 'font-lock-keyword-face) - - ;; Case values - ;; String-valued cases get font-lock-string-face regardless. - (list "^[ \t]*case[ \t]+\\([^'\n]+\\)" 1 'font-lock-keyword-face t) - - ;; Any keywords you like. - (list (concat "\\<" (regexp-opt - '("Dim" "If" "Then" "Else" "ElseIf" "End If") t) - "\\>") - 1 'font-lock-keyword-face)))) - -(defvar visual-basic-font-lock-keywords-2 - (append visual-basic-font-lock-keywords-1 - (eval-when-compile - `((,(concat "\\<" (regexp-opt visual-basic-all-keywords t) "\\>") - 1 font-lock-keyword-face))))) - -(defvar visual-basic-font-lock-keywords visual-basic-font-lock-keywords-1) - - -(put 'visual-basic-mode 'font-lock-keywords 'visual-basic-font-lock-keywords) - -(defun visual-basic-mode () - "A mode for editing Microsoft Visual Basic programs. -Features automatic indentation, font locking, keyword capitalization, -and some minor convenience functions. -Commands: -\\{visual-basic-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map visual-basic-mode-map) - (setq major-mode 'visual-basic-mode) - (setq mode-name "Visual Basic") - (set-syntax-table visual-basic-mode-syntax-table) - - (add-hook 'local-write-file-hooks 'visual-basic-untabify) - - (setq local-abbrev-table visual-basic-mode-abbrev-table) - (if visual-basic-capitalize-keywords-p - (progn - (make-local-variable 'pre-abbrev-expand-hook) - (add-hook 'pre-abbrev-expand-hook 'visual-basic-pre-abbrev-expand-hook) - (abbrev-mode 1))) - - (make-local-variable 'comment-start) - (setq comment-start "' ") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "'+ *") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-end) - (setq comment-end "") - - (make-local-variable 'indent-line-function) - (setq indent-line-function 'visual-basic-indent-line) - - (if visual-basic-fontify-p - (visual-basic-enable-font-lock)) - - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression visual-basic-imenu-generic-expression) - - (set (make-local-variable 'imenu-syntax-alist) `((,(string-to-char "_") . "w"))) - (set (make-local-variable 'imenu-case-fold-search) t) - - ;;(make-local-variable 'visual-basic-associated-files) - ;; doing this here means we need not check to see if it is bound later. - (add-hook 'find-file-hooks 'visual-basic-load-associated-files) - - (run-hooks 'visual-basic-mode-hook)) - - -(defun visual-basic-enable-font-lock () - ;; Emacs 19.29 requires a window-system else font-lock-mode errs out. - (cond ((or visual-basic-xemacs-p window-system) - - ;; In win-emacs this sets font-lock-keywords back to nil! - (if visual-basic-winemacs-p - (font-lock-mode 1)) - - ;; Accomodate emacs 19.29+ - ;; From: Simon Marshall - (cond ((boundp 'font-lock-defaults) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - `((visual-basic-font-lock-keywords - visual-basic-font-lock-keywords-1 - visual-basic-font-lock-keywords-2) - nil t ((,(string-to-char "_") . "w"))))) - (t - (make-local-variable 'font-lock-keywords) - (setq font-lock-keywords visual-basic-font-lock-keywords))) - - (if visual-basic-winemacs-p - (font-lock-fontify-buffer) - (font-lock-mode 1))))) - -;; KJW should add some odds and bobs here to cover "end if" one way -;; could be to create the abbreviations by removing whitespace then we -;; could put "end if", "end with" and so on in the keyword table -;; Another idea would be to make it intelligent enough to substitute -;; the correct end for the construct (with, select, if) -;; Is this what the abbrev table hook entry is for? -(defun visual-basic-construct-keyword-abbrev-table () - (if visual-basic-mode-abbrev-table - nil - (let ((words visual-basic-all-keywords) - (word nil) - (list nil)) - (while words - (setq word (car words) - words (cdr words)) - (setq list (cons (list (downcase word) word) list))) - - (define-abbrev-table 'visual-basic-mode-abbrev-table list)))) - -;; Would like to do this at compile-time. -(visual-basic-construct-keyword-abbrev-table) - - -(defun visual-basic-in-code-context-p () - (if (fboundp 'buffer-syntactic-context) ; XEmacs function. - (null (buffer-syntactic-context)) - ;; Attempt to simulate buffer-syntactic-context - ;; I don't know how reliable this is. - (let* ((beg (save-excursion - (beginning-of-line) - (point))) - (list - (parse-partial-sexp beg (point)))) - (and (null (nth 3 list)) ; inside string. - (null (nth 4 list)))))) ; inside comment - - -(defun visual-basic-pre-abbrev-expand-hook () - ;; Allow our abbrevs only in a code context. - (setq local-abbrev-table - (if (visual-basic-in-code-context-p) - visual-basic-mode-abbrev-table))) - - -(defun visual-basic-newline-and-indent (&optional count) - "Insert a newline, updating indentation." - (interactive) - (expand-abbrev) - (save-excursion - (visual-basic-indent-line)) - (call-interactively 'newline-and-indent)) - -(defun visual-basic-beginning-of-defun () - (interactive) - (re-search-backward visual-basic-defun-start-regexp)) - -(defun visual-basic-end-of-defun () - (interactive) - (re-search-forward visual-basic-defun-end-regexp)) - -(defun visual-basic-mark-defun () - (interactive) - (beginning-of-line) - (visual-basic-end-of-defun) - (set-mark (point)) - (visual-basic-beginning-of-defun) - (if visual-basic-xemacs-p - (zmacs-activate-region))) - -(defun visual-basic-indent-defun () - (interactive) - (save-excursion - (visual-basic-mark-defun) - (call-interactively 'visual-basic-indent-region))) - - -(defun visual-basic-fill-long-comment () - "Fills block of comment lines around point." - ;; Derived from code in ilisp-ext.el. - (interactive) - (save-excursion - (beginning-of-line) - (let ((comment-re "^[ \t]*\\s<+[ \t]*")) - (if (looking-at comment-re) - (let ((fill-prefix - (buffer-substring - (progn (beginning-of-line) (point)) - (match-end 0)))) - - (while (and (not (bobp)) - (looking-at visual-basic-comment-regexp)) - (forward-line -1)) - (if (not (bobp)) (forward-line 1)) - - (let ((start (point))) - - ;; Make all the line prefixes the same. - (while (and (not (eobp)) - (looking-at comment-re)) - (replace-match fill-prefix) - (forward-line 1)) - - (if (not (eobp)) - (beginning-of-line)) - - ;; Fill using fill-prefix - (fill-region-as-paragraph start (point)))))))) - - -(defun visual-basic-fill-or-indent () - "Fill long comment around point, if any, else indent current definition." - (interactive) - (cond ((save-excursion - (beginning-of-line) - (looking-at visual-basic-comment-regexp)) - (visual-basic-fill-long-comment)) - (t - (visual-basic-indent-defun)))) - - -(defun visual-basic-new-sub () - "Insert template for a new subroutine. Repeat to cycle through alternatives." - (interactive) - (beginning-of-line) - (let ((templates (cons visual-basic-blank-regexp - visual-basic-defn-templates)) - (tem nil) - (bound (point))) - (while templates - (setq tem (car templates) - templates (cdr templates)) - (cond ((looking-at tem) - (replace-match (or (car templates) - "")) - (setq templates nil)))) - - (search-backward "()" bound t))) - - -(defun visual-basic-untabify () - "Do not allow any tabs into the file." - (if (eq major-mode 'visual-basic-mode) - (untabify (point-min) (point-max))) - nil) - -(defun visual-basic-default-tag () - (if (and (not (bobp)) - (save-excursion - (backward-sexp) - (looking-at "\\w"))) - (backward-word 1)) - (let ((s (point)) - (e (save-excursion - (forward-sexp) - (point)))) - (buffer-substring s e))) - -(defun visual-basic-grep (tag) - "Search BASIC source files in current directory for TAG." - (interactive - (list (let* ((def (visual-basic-default-tag)) - (tag (read-string - (format "Grep for [%s]: " def)))) - (if (string= tag "") def tag)))) - (grep (format "grep -n %s %s" tag visual-basic-wild-files))) - - -;;; IDE Connection. - -(defun visual-basic-buffer-project-file () - "Return a guess as to the project file associated with the current buffer." - (car (directory-files (file-name-directory (buffer-file-name)) t "\\.vbp"))) - -(defun visual-basic-start-ide () - "Start Visual Basic (or your favorite IDE, (after Emacs, of course)) -on the first project file in the current directory. -Note: it's not a good idea to leave Visual Basic running while you -are editing in Emacs, since Visual Basic has no provision for reloading -changed files." - (interactive) - (let (file) - (cond ((null visual-basic-ide-pathname) - (error "No pathname set for Visual Basic. See visual-basic-ide-pathname")) - ((null (setq file (visual-basic-buffer-project-file))) - (error "No project file found")) - ((fboundp 'win-exec) - (iconify-emacs) - (win-exec visual-basic-ide-pathname 'win-show-normal file)) - ((fboundp 'start-process) - (iconify-frame (selected-frame)) - (start-process "*VisualBasic*" nil visual-basic-ide-pathname file)) - (t - (error "No way to spawn process!"))))) - - - -;;; Indentation-related stuff. - -(defun visual-basic-indent-region (start end) - "Perform visual-basic-indent-line on each line in region." - (interactive "r") - (save-excursion - (goto-char start) - (beginning-of-line) - (while (and (not (eobp)) - (< (point) end)) - (if (not (looking-at visual-basic-blank-regexp)) - (visual-basic-indent-line)) - (forward-line 1))) - - (cond ((fboundp 'zmacs-deactivate-region) - (zmacs-deactivate-region)) - ((fboundp 'deactivate-mark) - (deactivate-mark)))) - - - -(defun visual-basic-previous-line-of-code () - (if (not (bobp)) - (forward-line -1)) ; previous-line depends on goal column - (while (and (not (bobp)) - (or (looking-at visual-basic-blank-regexp) - (looking-at visual-basic-comment-regexp))) - (forward-line -1))) - - -(defun visual-basic-find-original-statement () - "If the current line is a continuation, move back to the original stmt." - (let ((here (point))) - (visual-basic-previous-line-of-code) - (while (and (not (bobp)) - (looking-at visual-basic-continuation-regexp)) - (setq here (point)) - (visual-basic-previous-line-of-code)) - (goto-char here))) - -(defun visual-basic-find-matching-stmt (open-regexp close-regexp) - ;; Searching backwards - (let ((level 0)) - (while (and (>= level 0) (not (bobp))) - (visual-basic-previous-line-of-code) - (visual-basic-find-original-statement) - (cond ((looking-at close-regexp) - (setq level (+ level 1))) - ((looking-at open-regexp) - (setq level (- level 1))))))) - -(defun visual-basic-find-matching-if () - (visual-basic-find-matching-stmt visual-basic-if-regexp - visual-basic-endif-regexp)) - -(defun visual-basic-find-matching-select () - (visual-basic-find-matching-stmt visual-basic-select-regexp - visual-basic-select-end-regexp)) - -(defun visual-basic-find-matching-for () - (visual-basic-find-matching-stmt visual-basic-for-regexp - visual-basic-next-regexp)) - -(defun visual-basic-find-matching-do () - (visual-basic-find-matching-stmt visual-basic-do-regexp - visual-basic-loop-regexp)) - -(defun visual-basic-find-matching-while () - (visual-basic-find-matching-stmt visual-basic-while-regexp - visual-basic-wend-regexp)) - -(defun visual-basic-find-matching-with () - (visual-basic-find-matching-stmt visual-basic-with-regexp - visual-basic-end-with-regexp)) - -;;; If this fails it must return the indent of the line preceding the -;;; end not the first line because end without matching begin is a -;;; normal simple statement -(defun visual-basic-find-matching-begin () - (let ((original-point (point))) - (visual-basic-find-matching-stmt visual-basic-begin-regexp - visual-basic-end-begin-regexp) - (if (bobp) ;failed to find a matching begin so assume that it is - ;an end statement instead and use the indent of the - ;preceding line. - (progn (goto-char original-point) - (visual-basic-previous-line-of-code))))) - - -(defun visual-basic-calculate-indent () - (let ((original-point (point))) - (save-excursion - (beginning-of-line) - ;; Some cases depend only on where we are now. - (cond ((or (looking-at visual-basic-defun-start-regexp) - (looking-at visual-basic-label-regexp) - (looking-at visual-basic-defun-end-regexp)) - 0) - - ;; The outdenting stmts, which simply match their original. - ((or (looking-at visual-basic-else-regexp) - (looking-at visual-basic-endif-regexp)) - (visual-basic-find-matching-if) - (current-indentation)) - - ;; All the other matching pairs act alike. - ((looking-at visual-basic-next-regexp) ; for/next - (visual-basic-find-matching-for) - (current-indentation)) - - ((looking-at visual-basic-loop-regexp) ; do/loop - (visual-basic-find-matching-do) - (current-indentation)) - - ((looking-at visual-basic-wend-regexp) ; while/wend - (visual-basic-find-matching-while) - (current-indentation)) - - ((looking-at visual-basic-end-with-regexp) ; with/end with - (visual-basic-find-matching-with) - (current-indentation)) - - ((looking-at visual-basic-select-end-regexp) ; select case/end select - (visual-basic-find-matching-select) - (current-indentation)) - - ;; A case of a select is somewhat special. - ((looking-at visual-basic-case-regexp) - (visual-basic-find-matching-select) - (+ (current-indentation) visual-basic-mode-indent)) - - ;; Added KJW: Make sure that this comes after the cases - ;; for if..endif, end select because end-regexp will also - ;; match "end select" etc. - ((looking-at visual-basic-end-begin-regexp) ; begin/end - (visual-basic-find-matching-begin) - (current-indentation)) - - (t - ;; Other cases which depend on the previous line. - (visual-basic-previous-line-of-code) - - ;; Skip over label lines, which always have 0 indent. - (while (looking-at visual-basic-label-regexp) - (visual-basic-previous-line-of-code)) - - (cond - ((looking-at visual-basic-continuation-regexp) - (visual-basic-find-original-statement) - ;; Indent continuation line under matching open paren, - ;; or else one word in. - (let* ((orig-stmt (point)) - (matching-open-paren - (condition-case () - (save-excursion - (goto-char original-point) - (beginning-of-line) - (backward-up-list 1) - ;; Only if point is now w/in cont. block. - (if (<= orig-stmt (point)) - (current-column))) - (error nil)))) - (cond (matching-open-paren - (1+ matching-open-paren)) - (t - ;; Else, after first word on original line. - (back-to-indentation) - (forward-word 1) - (while (looking-at "[ \t]") - (forward-char 1)) - (current-column))))) - (t - (visual-basic-find-original-statement) - - (let ((indent (current-indentation))) - ;; All the various +indent regexps. - (cond ((looking-at visual-basic-defun-start-regexp) - (+ indent visual-basic-mode-indent)) - - ((and (or (looking-at visual-basic-if-regexp) - (looking-at visual-basic-else-regexp)) - (not (and visual-basic-allow-single-line-if - (looking-at visual-basic-ifthen-regexp)))) - (+ indent visual-basic-mode-indent)) - - ((or (looking-at visual-basic-select-regexp) - (looking-at visual-basic-case-regexp)) - (+ indent visual-basic-mode-indent)) - - ((or (looking-at visual-basic-do-regexp) - (looking-at visual-basic-for-regexp) - (looking-at visual-basic-while-regexp) - (looking-at visual-basic-with-regexp) - (looking-at visual-basic-begin-regexp)) - (+ indent visual-basic-mode-indent)) - - (t - ;; By default, just copy indent from prev line. - indent)))))))))) - -(defun visual-basic-indent-to-column (col) - (let* ((bol (save-excursion - (beginning-of-line) - (point))) - (point-in-whitespace - (<= (point) (+ bol (current-indentation)))) - (blank-line-p - (save-excursion - (beginning-of-line) - (looking-at visual-basic-blank-regexp)))) - - (cond ((/= col (current-indentation)) - (save-excursion - (beginning-of-line) - (back-to-indentation) - (delete-region bol (point)) - (indent-to col)))) - - ;; If point was in the whitespace, move back-to-indentation. - (cond (blank-line-p - (end-of-line)) - (point-in-whitespace - (back-to-indentation))))) - - -(defun visual-basic-indent-line () - "Indent current line for BASIC." - (interactive) - (visual-basic-indent-to-column (visual-basic-calculate-indent))) - - -(defun visual-basic-split-line () - "Split line at point, adding continuation character or continuing a comment. -In Abbrev mode, any abbrev before point will be expanded." - (interactive) - (let ((pps-list (parse-partial-sexp (save-excursion - (beginning-of-line) - (point)) - (point)))) - ;; Dispatch on syntax at this position. - (cond ((equal t (nth 4 pps-list)) ; in comment - (indent-new-comment-line)) - ((equal t (nth 4 pps-list)) ; in string - (error "Can't break line inside a string")) - (t (just-one-space) ; leading space on next line - ; doesn't count, sigh - (insert "_") - (visual-basic-newline-and-indent))))) - -(provide 'visual-basic-mode) - - -;;; Some experimental functions - -;;; Load associated files listed in the file local variables block -(defun visual-basic-load-associated-files () - "Load files that are useful to have around when editing the source of the file that has just been loaded. -The file must have a local variable that lists the files to be loaded. -If the file name is relative it is relative to the directory -containing the current buffer. If the file is already loaded nothing -happens, this prevents circular references causing trouble. After an -associated file is loaded its associated files list will be -processed." - (if (boundp 'visual-basic-associated-files) - (let ((files visual-basic-associated-files) - (file nil)) - (while files - (setq file (car files) - files (cdr files)) - (message "Load associated file: %s" file) - (visual-basic-load-file-ifnotloaded file default-directory))))) - - - -(defun visual-basic-load-file-ifnotloaded (file default-directory) - "Load file if not already loaded. -If file is relative then default-directory provides the path" - (let((file-absolute (expand-file-name file default-directory))) - (if (get-file-buffer file-absolute); don't do anything if the buffer is already loaded - () - (find-file-noselect file-absolute )))) - - - -;;; visual-basic-mode.el ends here diff --git a/emacs/external/yaml-mode.el b/emacs/external/yaml-mode.el deleted file mode 100644 index 85b8da7..0000000 --- a/emacs/external/yaml-mode.el +++ /dev/null @@ -1,392 +0,0 @@ -;;; yaml-mode.el --- Major mode for editing YAML files - -;; Copyright (C) 2006 Yoshiki Kurihara - -;; Author: Yoshiki Kurihara -;; Marshall T. Vandegrift -;; Keywords: data yaml -;; Version: 0.0.3 - -;; This file is not part of 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 -;; 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: - -;; This is a major mode for editing files in the YAML data -;; serialization format. It was initially developed by Yoshiki -;; Kurihara and many features were added by Marshall Vandegrift. As -;; YAML and Python share the fact that indentation determines -;; structure, this mode provides indentation and indentation command -;; behavior very similar to that of python-mode. - -;;; Installation: - -;; To install, just drop this file into a directory in your -;; `load-path' and (optionally) byte-compile it. To automatically -;; handle files ending in '.yml', add something like: -;; -;; (require 'yaml-mode) -;; (add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode)) -;; -;; to your .emacs file. -;; -;; Unlike python-mode, this mode follows the Emacs convention of not -;; binding the ENTER key to `newline-and-indent'. To get this -;; behavior, add the key definition to `yaml-mode-hook': -;; -;; (add-hook 'yaml-mode-hook -;; '(lambda () -;; (define-key yaml-mode-map "\C-m" 'newline-and-indent))) - -;;; Known Bugs: - -;; YAML is easy to write but complex to parse, and this mode doesn't -;; even really try. Indentation and highlighting will break on -;; abnormally complicated structures. - -;;; Code: - - -;; User definable variables - -(defgroup yaml nil - "Support for the YAML serialization format" - :group 'languages - :prefix "yaml-") - -(defcustom yaml-mode-hook nil - "*Hook run by `yaml-mode'." - :type 'hook - :group 'yaml) - -(defcustom yaml-indent-offset 2 - "*Amount of offset per level of indentation." - :type 'integer - :group 'yaml) - -(defcustom yaml-backspace-function 'backward-delete-char-untabify - "*Function called by `yaml-electric-backspace' when deleting backwards." - :type 'function - :group 'yaml) - -(defcustom yaml-block-literal-search-lines 100 - "*Maximum number of lines to search for start of block literals." - :type 'integer - :group 'yaml) - -(defcustom yaml-block-literal-electric-alist - '((?| . "") (?> . "-")) - "*Characters for which to provide electric behavior. -The association list key should be a key code and the associated value -should be a string containing additional characters to insert when -that key is pressed to begin a block literal." - :type 'alist - :group 'yaml) - -(defface yaml-tab-face - '((((class color)) (:background "red" :foreground "red" :bold t)) - (t (:reverse-video t))) - "Face to use for highlighting tabs in YAML files." - :group 'faces - :group 'yaml) - - -;; Constants - -(defconst yaml-mode-version "0.0.3" "Version of `yaml-mode.'") - -(defconst yaml-blank-line-re "^ *$" - "Regexp matching a line containing only (valid) whitespace.") - -(defconst yaml-comment-re "\\(#*.*\\)" - "Regexp matching a line containing a YAML comment or delimiter.") - -(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)" - "Regexp matching a line contatining a YAML directive.") - -(defconst yaml-document-delimiter-re "^ *\\(?:---\\|[.][.][.]\\)" - "Rexexp matching a YAML document delimiter line.") - -(defconst yaml-node-anchor-alias-re "[&*]\\w+" - "Regexp matching a YAML node anchor or alias.") - -(defconst yaml-tag-re "!!?[^ \n]+" - "Rexexp matching a YAML tag.") - -(defconst yaml-bare-scalar-re - "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?" - "Rexexp matching a YAML bare scalar.") - -(defconst yaml-hash-key-re - (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *" - "\\(?:" yaml-tag-re " +\\)?" - "\\(" yaml-bare-scalar-re "\\) *:" - "\\(?: +\\|$\\)") - "Regexp matching a single YAML hash key.") - -(defconst yaml-scalar-context-re - (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *" - "\\(?:" yaml-bare-scalar-re " *: \\)?") - "Regexp indicating the begininng of a scalar context.") - -(defconst yaml-nested-map-re - (concat ".*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$") - "Regexp matching a line beginning a YAML nested structure.") - -(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)" - "Regexp matching the substring start of a block literal.") - -(defconst yaml-block-literal-re - (concat yaml-scalar-context-re - "\\(?:" yaml-tag-re "\\)?" - yaml-block-literal-base-re) - "Regexp matching a line beginning a YAML block literal") - -(defconst yaml-nested-sequence-re - (concat "^\\(?: *- +\\)+" - "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$") - "Regexp matching a line containing one or more nested YAML sequences") - -(defconst yaml-constant-scalars-re - (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *" - (regexp-opt - '("~" "null" "Null" "NULL" - ".nan" ".NaN" ".NAN" - ".inf" ".Inf" ".INF" - "-.inf" "-.Inf" "-.INF" - "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO" - "true" "True" "TRUE" "false" "False" "FALSE" - "on" "On" "ON" "off" "Off" "OFF") t) - " *$") - "Regexp matching certain scalar constants in scalar context") - - -;; Mode setup - -(defvar yaml-mode-map () - "Keymap used in `yaml-mode' buffers.") -(if yaml-mode-map - nil - (setq yaml-mode-map (make-sparse-keymap)) - (define-key yaml-mode-map "|" 'yaml-electric-bar-and-angle) - (define-key yaml-mode-map ">" 'yaml-electric-bar-and-angle) - (define-key yaml-mode-map "-" 'yaml-electric-dash-and-dot) - (define-key yaml-mode-map "." 'yaml-electric-dash-and-dot) - (define-key yaml-mode-map [backspace] 'yaml-electric-backspace) - (define-key yaml-mode-map "\C-j" 'newline-and-indent)) - -(defvar yaml-mode-syntax-table nil - "Syntax table in use in yaml-mode buffers.") -(if yaml-mode-syntax-table - nil - (setq yaml-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\' "\"" yaml-mode-syntax-table) - (modify-syntax-entry ?\" "\"" yaml-mode-syntax-table) - (modify-syntax-entry ?# "<" yaml-mode-syntax-table) - (modify-syntax-entry ?\n ">" yaml-mode-syntax-table) - (modify-syntax-entry ?\\ "\\" yaml-mode-syntax-table) - (modify-syntax-entry ?- "." yaml-mode-syntax-table) - (modify-syntax-entry ?_ "_" yaml-mode-syntax-table) - (modify-syntax-entry ?\( "." yaml-mode-syntax-table) - (modify-syntax-entry ?\) "." yaml-mode-syntax-table) - (modify-syntax-entry ?\{ "(}" yaml-mode-syntax-table) - (modify-syntax-entry ?\} "){" yaml-mode-syntax-table) - (modify-syntax-entry ?\[ "(]" yaml-mode-syntax-table) - (modify-syntax-entry ?\] ")[" yaml-mode-syntax-table)) - -(define-derived-mode yaml-mode fundamental-mode "YAML" - "Simple mode to edit YAML. - -\\{yaml-mode-map}" - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) "#+ *") - (set (make-local-variable 'indent-line-function) 'yaml-indent-line) - (set (make-local-variable 'font-lock-defaults) - '(yaml-font-lock-keywords - nil nil nil nil - (font-lock-syntactic-keywords . yaml-font-lock-syntactic-keywords)))) - - -;; Font-lock support - -(defvar yaml-font-lock-keywords - (list - (cons yaml-comment-re '(1 font-lock-comment-face)) - (cons yaml-constant-scalars-re '(1 font-lock-constant-face)) - (cons yaml-tag-re '(0 font-lock-type-face)) - (cons yaml-node-anchor-alias-re '(0 font-lock-function-name-face t)) - (cons yaml-hash-key-re '(1 font-lock-variable-name-face t)) - (cons yaml-document-delimiter-re '(0 font-lock-comment-face)) - (cons yaml-directive-re '(1 font-lock-builtin-face)) - '(yaml-font-lock-block-literals 0 font-lock-string-face t) - '("^[\t]+" 0 'yaml-tab-face t)) - "Additional expressions to highlight in YAML mode.") - -(defvar yaml-font-lock-syntactic-keywords - (list '(yaml-syntactic-block-literals 0 "." t)) - "Additional syntax features to highlight in YAML mode.") - - -(defun yaml-font-lock-block-literals (bound) - "Find lines within block literals. -Find the next line of the first (if any) block literal after point and -prior to BOUND. Returns the beginning and end of the block literal -line in the match data, as consumed by `font-lock-keywords' matcher -functions. The function begins by searching backwards to determine -whether or not the current line is within a block literal. This could -be time-consuming in large buffers, so the number of lines searched is -artificially limitted to the value of -`yaml-block-literal-search-lines'." - (if (eolp) (goto-char (1+ (point)))) - (unless (or (eobp) (>= (point) bound)) - (let ((begin (point)) - (end (min (1+ (point-at-eol)) bound))) - (goto-char (point-at-bol)) - (while (and (looking-at yaml-blank-line-re) (not (bobp))) - (forward-line -1)) - (let ((nlines yaml-block-literal-search-lines) - (min-level (current-indentation))) - (forward-line -1) - (while (and (/= nlines 0) - (/= min-level 0) - (not (looking-at yaml-block-literal-re)) - (not (bobp))) - (set 'nlines (1- nlines)) - (unless (looking-at yaml-blank-line-re) - (set 'min-level (min min-level (current-indentation)))) - (forward-line -1)) - (cond - ((and (< (current-indentation) min-level) - (looking-at yaml-block-literal-re)) - (goto-char end) (set-match-data (list begin end)) t) - ((progn - (goto-char begin) - (re-search-forward (concat yaml-block-literal-re - " *\\(.*\\)\n") - bound t)) - (set-match-data (nthcdr 2 (match-data))) t)))))) - -(defun yaml-syntactic-block-literals (bound) - "Find quote characters within block literals. -Finds the first quote character within a block literal (if any) after -point and prior to BOUND. Returns the position of the quote character -in the match data, as consumed by matcher functions in -`font-lock-syntactic-keywords'. This allows the mode to treat ['\"] -characters in block literals as punctuation syntax instead of string -syntax, preventing unmatched quotes in block literals from painting -the entire buffer in `font-lock-string-face'." - (let ((found nil)) - (while (and (not found) - (/= (point) bound) - (yaml-font-lock-block-literals bound)) - (let ((begin (match-beginning 0)) (end (match-end 0))) - (goto-char begin) - (cond - ((re-search-forward "['\"]" end t) (setq found t)) - ((goto-char end))))) - found)) - - -;; Indentation and electric keys - -(defun yaml-compute-indentation () - "Calculate the maximum sensible indentation for the current line." - (save-excursion - (beginning-of-line) - (if (looking-at yaml-document-delimiter-re) 0 - (forward-line -1) - (while (and (looking-at yaml-blank-line-re) - (> (point) (point-min))) - (forward-line -1)) - (+ (current-indentation) - (if (looking-at yaml-nested-map-re) yaml-indent-offset 0) - (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0) - (if (looking-at yaml-block-literal-re) yaml-indent-offset 0))))) - -(defun yaml-indent-line () - "Indent the current line. -The first time this command is used, the line will be indented to the -maximum sensible indentation. Each immediately subsequent usage will -back-dent the line by `yaml-indent-offset' spaces. On reaching column -0, it will cycle back to the maximum sensible indentation." - (interactive "*") - (let ((ci (current-indentation)) - (cc (current-column)) - (need (yaml-compute-indentation))) - (save-excursion - (beginning-of-line) - (delete-horizontal-space) - (if (and (equal last-command this-command) (/= ci 0)) - (indent-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset)) - (indent-to need))) - (if (< (current-column) (current-indentation)) - (forward-to-indentation 0)))) - -(defun yaml-electric-backspace (arg) - "Delete characters or back-dent the current line. -If invoked following only whitespace on a line, will back-dent to the -immediately previous multiple of `yaml-indent-offset' spaces." - (interactive "*p") - (if (or (/= (current-indentation) (current-column)) (bolp)) - (funcall yaml-backspace-function arg) - (let ((ci (current-column))) - (beginning-of-line) - (delete-horizontal-space) - (indent-to (* (/ (- ci (* arg yaml-indent-offset)) - yaml-indent-offset) - yaml-indent-offset))))) - -(defun yaml-electric-bar-and-angle (arg) - "Insert the bound key and possibly begin a block literal. -Inserts the bound key. If inserting the bound key causes the current -line to match the initial line of a block literal, then inserts the -matching string from `yaml-block-literal-electric-alist', a newline, -and indents appropriately." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (let ((extra-chars - (assoc last-command-char - yaml-block-literal-electric-alist))) - (cond - ((and extra-chars (not arg) (eolp) - (save-excursion - (beginning-of-line) - (looking-at yaml-block-literal-re))) - (insert (cdr extra-chars)) - (newline-and-indent))))) - -(defun yaml-electric-dash-and-dot (arg) - "Insert the bound key and possibly de-dent line. -Inserts the bound key. If inserting the bound key causes the current -line to match a document delimiter, de-dent the line to the left -margin." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (save-excursion - (beginning-of-line) - (if (and (not arg) (looking-at yaml-document-delimiter-re)) - (delete-horizontal-space)))) - -(defun yaml-mode-version () - "Diplay version of `yaml-mode'." - (interactive) - (message "yaml-mode %s" yaml-mode-version) - yaml-mode-version) - -(provide 'yaml-mode) - -;;; yaml-mode.el ends here -- 2.11.4.GIT